From 1a677d1429d1f9fea2d6b2bc9dd5644a5564cc27 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Tue, 2 Jan 2024 15:32:03 +0200 Subject: treesit--pre-syntax-ppss: Fix args-out-of-range in internal--syntax-propertize * lisp/treesit.el (treesit--pre-syntax-ppss): Make sure the lower bound is still within the current restriction (bug#67977). --- lisp/treesit.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/treesit.el b/lisp/treesit.el index b656040958d..c63bf510a24 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1150,7 +1150,7 @@ START and END mark the current to-be-propertized region." (if (and new-start (< new-start start)) (progn (setq treesit--syntax-propertize-start nil) - (cons new-start end)) + (cons (max new-start (point-min)) end)) nil))) ;;; Indent -- cgit v1.2.3 From ab66b749a276c9fdc70ad2ee114314f0cde862fc Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 3 Jan 2024 15:14:41 +0200 Subject: ; * src/window.c (Fset_window_margins): Doc fix. --- src/window.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/window.c b/src/window.c index 894d9c4fc19..8d4bde8d6db 100644 --- a/src/window.c +++ b/src/window.c @@ -7793,7 +7793,11 @@ means no margin. Leave margins unchanged if WINDOW is not large enough to accommodate margins of the desired width. Return t if any margin was actually -changed and nil otherwise. */) +changed and nil otherwise. + +The margins specified by calling this function may be later overridden +by invoking `set-window-buffer' for the same WINDOW, with its +KEEP-MARGINS argument nil or omitted. */) (Lisp_Object window, Lisp_Object left_width, Lisp_Object right_width) { struct window *w = set_window_margins (decode_live_window (window), -- cgit v1.2.3 From bdfa49502a84f46999c4f207249562f33a119d36 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 4 Jan 2024 03:44:23 +0200 Subject: New feature: etags-regen-mode * lisp/progmodes/etags-regen.el: New file (bug#67687). * etc/NEWS: Mention the addition. * .dir-locals.el: Add this project's settings for etags-regen-regexp-alist and etags-regen-ignores. --- .dir-locals.el | 6 + etc/NEWS | 5 + lisp/progmodes/etags-regen.el | 431 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 442 insertions(+) create mode 100644 lisp/progmodes/etags-regen.el diff --git a/.dir-locals.el b/.dir-locals.el index e087aa89cd1..ce7febca851 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -8,6 +8,12 @@ (vc-git-annotate-switches . "-w") (bug-reference-url-format . "https://debbugs.gnu.org/%s") (diff-add-log-use-relative-names . t) + (etags-regen-regexp-alist + . + ((("c" "objc") . + ("/[ \t]*DEFVAR_[A-Z_ \t(]+\"\\([^\"]+\\)\"/\\1/" + "/[ \t]*DEFVAR_[A-Z_ \t(]+\"[^\"]+\",[ \t]\\([A-Za-z0-9_]+\\)/\\1/")))) + (etags-regen-ignores . ("test/manual/etags/")) (vc-prepare-patches-separately . nil))) (c-mode . ((c-file-style . "GNU") (c-noise-macro-names . ("INLINE" "NO_INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" diff --git a/etc/NEWS b/etc/NEWS index a6b0beb6ee5..1cdb12c3958 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1265,6 +1265,11 @@ the needs of users with red-green or blue-yellow color deficiency. The Info manual "(modus-themes) Top" describes the details and showcases all their customization options. +** New global minor mode 'etags-regen-mode'. +This minor mode generates the tags table automatically based on the +current project configuration, and later updates it as you edit the +files and save the changes. + * Incompatible Lisp Changes in Emacs 30.1 diff --git a/lisp/progmodes/etags-regen.el b/lisp/progmodes/etags-regen.el new file mode 100644 index 00000000000..6cd78d3577a --- /dev/null +++ b/lisp/progmodes/etags-regen.el @@ -0,0 +1,431 @@ +;;; etags-regen.el --- Auto-(re)regenerating tags -*- lexical-binding: t -*- + +;; Copyright (C) 2021-2023 Free Software Foundation, Inc. + +;; Author: Dmitry Gutov +;; Keywords: tools + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Simple automatic tags generation with updates on save. +;; +;; This mode provides automatic indexing for Emacs "go to definition" +;; feature, the `xref-go-forward' command (bound to `M-.' by default). +;; +;; At the moment reindexing works off before/after-save-hook, but to +;; handle more complex changes (for example, the user switching to +;; another branch from the terminal) we can look into plugging into +;; something like `filenotify'. +;; +;; Note that this feature disables itself if the user has some tags +;; table already visited (with `M-x visit-tags-table', or through an +;; explicit prompt triggered by some feature that requires tags). + +;;; Code: + +(require 'cl-lib) + +(defgroup etags-regen nil + "Auto-(re)generating tags." + :group 'tools) + +(defvar etags-regen--tags-file nil) +(defvar etags-regen--tags-root nil) +(defvar etags-regen--new-file nil) + +(declare-function project-root "project") +(declare-function project-files "project") +(declare-function dired-glob-regexp "dired") + +(defcustom etags-regen-program (executable-find "etags") + "Name of the etags program used by `etags-regen-mode'. + +If you only have `ctags' installed, you can also set this to +\"ctags -e\". Some features might not be supported this way." + ;; Always having our 'etags' here would be easier, but we can't + ;; always rely on it being installed. So it might be ctags's etags. + :type 'file + :version "30.1") + +(defcustom etags-regen-tags-file "TAGS" + "Name of the tags file to create inside the project by `etags-regen-mode'. + +The value should either be a simple file name (no directory +specified), or a function that accepts the project root directory +and returns a distinct absolute file name for its tags file. The +latter possibility is useful when you prefer to store the tag +files somewhere else, for example in `temporary-file-directory'." + :type '(choice (string :tag "File name") + (function :tag "Function that returns file name")) + :version "30.1") + +(defcustom etags-regen-program-options nil + "List of additional options for etags program invoked by `etags-regen-mode'." + :type '(repeat string) + :version "30.1") + +(defcustom etags-regen-regexp-alist nil + "Mapping of languages to etags regexps for `etags-regen-mode'. + +These regexps are used in addition to the tags made with the +standard parsing based on the language. + +The value must be a list where each element has the +form (LANGUAGES . TAG-REGEXPS) where both LANGUAGES and +TAG-REGEXPS are lists of strings. + +Each language should be one of the recognized by etags, see +`etags --help'. Each tag regexp should be a string in the format +documented for the `--regex' arguments (without `{language}'). + +We currently support only Emacs's etags program with this option." + :type '(repeat + (cons + :tag "Languages group" + (repeat (string :tag "Language name")) + (repeat (string :tag "Tag Regexp")))) + :version "30.1") + +;;;###autoload +(put 'etags-regen-regexp-alist 'safe-local-variable + (lambda (value) + (and (listp value) + (seq-every-p + (lambda (group) + (and (consp group) + (listp (car group)) + (listp (cdr group)) + (seq-every-p #'stringp (car group)) + (seq-every-p #'stringp (cdr group)))) + value)))) + +;; We have to list all extensions: etags falls back to Fortran +;; when it cannot determine the type of the file. +;; http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00323.html +(defcustom etags-regen-file-extensions + '("rb" "js" "py" "pl" "el" "c" "cpp" "cc" "h" "hh" "hpp" + "java" "go" "cl" "lisp" "prolog" "php" "erl" "hrl" + "F" "f" "f90" "for" "cs" "a" "asm" "ads" "adb" "ada") + "Code file extensions for `etags-regen-mode'. + +File extensions to generate the tags for." + :type '(repeat (string :tag "File extension")) + :version "30.1") + +;;;###autoload +(put 'etags-regen-file-extensions 'safe-local-variable + (lambda (value) (and (listp value) (seq-every-p #'stringp value)))) + +;; FIXME: We don't support root anchoring yet. +(defcustom etags-regen-ignores nil + "Additional ignore rules, in the format of `project-ignores'." + :type '(repeat + (string :tag "Glob to ignore")) + :version "30.1") + +;;;###autoload +(put 'etags-regen-ignores 'safe-local-variable + (lambda (value) (and (listp value) (seq-every-p #'stringp value)))) + +(defvar etags-regen--errors-buffer-name "*etags-regen-tags-errors*") + +(defvar etags-regen--rescan-files-limit 100) + +(defun etags-regen--all-mtimes (proj) + (let ((files (etags-regen--all-files proj)) + (mtimes (make-hash-table :test 'equal)) + file-name-handler-alist) + (dolist (f files) + (condition-case nil + (puthash f + (file-attribute-modification-time + (file-attributes f)) + mtimes) + (file-missing nil))) + mtimes)) + +(defun etags-regen--choose-tags-file (proj) + (if (functionp etags-regen-tags-file) + (funcall etags-regen-tags-file (project-root proj)) + (expand-file-name etags-regen-tags-file (project-root proj)))) + +(defun etags-regen--refresh (proj) + (save-excursion + (let* ((tags-file (etags-regen--choose-tags-file proj)) + (tags-mtime (file-attribute-modification-time + (file-attributes tags-file))) + (all-mtimes (etags-regen--all-mtimes proj)) + added-files + changed-files + removed-files) + (etags-regen--visit-table tags-file (project-root proj)) + (set-buffer (get-file-buffer tags-file)) + (dolist (file (tags-table-files)) + (let ((mtime (gethash file all-mtimes))) + (cond + ((null mtime) + (push file removed-files)) + ((time-less-p tags-mtime mtime) + (push file changed-files) + (remhash file all-mtimes)) + (t + (remhash file all-mtimes))))) + (maphash + (lambda (key _value) + (push key added-files)) + all-mtimes) + (if (> (+ (length added-files) + (length changed-files) + (length removed-files)) + etags-regen--rescan-files-limit) + (progn + (message "etags-regen: Too many changes, falling back to full rescan") + (etags-regen--tags-cleanup)) + (dolist (file (nconc removed-files changed-files)) + (etags-regen--remove-tag file)) + (when (or changed-files added-files) + (apply #'etags-regen--append-tags + (nconc changed-files added-files))) + (when (or changed-files added-files removed-files) + (let ((save-silently t) + (message-log-max nil)) + (save-buffer 0))))))) + +(defun etags-regen--maybe-generate () + (let (proj) + (when (and etags-regen--tags-root + (not (file-in-directory-p default-directory + etags-regen--tags-root))) + (etags-regen--tags-cleanup)) + (when (and (not etags-regen--tags-root) + ;; If existing table is visited that's not generated by + ;; this mode, skip all functionality. + (not (or tags-file-name + tags-table-list)) + (file-exists-p (etags-regen--choose-tags-file + (setq proj (project-current))))) + (message "Found existing tags table, refreshing...") + (etags-regen--refresh proj)) + (when (and (not (or tags-file-name + tags-table-list)) + (setq proj (or proj (project-current)))) + (message "Generating new tags table...") + (let ((start (time-to-seconds))) + (etags-regen--tags-generate proj) + (message "...done (%.2f s)" (- (time-to-seconds) start)))))) + +(defun etags-regen--all-files (proj) + (let* ((root (project-root proj)) + (default-directory root) + ;; TODO: Make the scanning more efficient, e.g. move the + ;; filtering by glob to project (project-files-filtered...). + (files (project-files proj)) + (match-re (concat + "\\." + (regexp-opt etags-regen-file-extensions) + "\\'")) + (ir-start (1- (length root))) + (ignores-regexps + (mapcar #'etags-regen--ignore-regexp + etags-regen-ignores))) + (cl-delete-if + (lambda (f) (or (not (string-match-p match-re f)) + (string-match-p "/\\.#" f) ;Backup files. + (cl-some (lambda (ignore) (string-match ignore f ir-start)) + ignores-regexps))) + files))) + +(defun etags-regen--ignore-regexp (ignore) + (require 'dired) + ;; It's somewhat brittle to rely on Dired. + (let ((re (dired-glob-regexp ignore))) + ;; We could implement root anchoring here, but \\= doesn't work in + ;; string-match :-(. + (concat (unless (eq ?/ (aref re 3)) "/") + ;; Cutting off the anchors added by `dired-glob-regexp'. + (substring re 2 (- (length re) 2)) + ;; This way we allow a glob to match against a directory + ;; name, or a file name. And when it ends with / already, + ;; no need to add the anchoring. + (unless (eq ?/ (aref re (- (length re) 3))) + ;; Either match a full name segment, or eos. + "\\(?:/\\|\\'\\)")))) + +(defun etags-regen--tags-generate (proj) + (let* ((root (project-root proj)) + (default-directory root) + (files (etags-regen--all-files proj)) + (tags-file (etags-regen--choose-tags-file proj)) + (ctags-p (etags-regen--ctags-p)) + (command (format "%s %s %s - -o %s" + etags-regen-program + (mapconcat #'identity + (etags-regen--build-program-options ctags-p) + " ") + ;; ctags's etags requires '-L' for stdin input. + (if ctags-p "-L" "") + tags-file))) + (with-temp-buffer + (mapc (lambda (f) + (insert f "\n")) + files) + (shell-command-on-region (point-min) (point-max) command + nil nil etags-regen--errors-buffer-name t)) + (etags-regen--visit-table tags-file root))) + +(defun etags-regen--visit-table (tags-file root) + ;; Invalidate the scanned tags after any change is written to disk. + (add-hook 'after-save-hook #'etags-regen--update-file) + (add-hook 'before-save-hook #'etags-regen--mark-as-new) + (setq etags-regen--tags-file tags-file + etags-regen--tags-root root) + (visit-tags-table etags-regen--tags-file)) + +(defun etags-regen--ctags-p () + (string-search "Ctags" + (shell-command-to-string + (format "%s --version" etags-regen-program)))) + +(defun etags-regen--build-program-options (ctags-p) + (when (and etags-regen-regexp-alist ctags-p) + (user-error "etags-regen-regexp-alist is not supported with Ctags")) + (nconc + (mapcan + (lambda (group) + (mapcan + (lambda (lang) + (mapcar (lambda (regexp) + (concat "--regex=" + (shell-quote-argument + (format "{%s}%s" lang regexp)))) + (cdr group))) + (car group))) + etags-regen-regexp-alist) + (mapcar #'shell-quote-argument + etags-regen-program-options))) + +(defun etags-regen--update-file () + ;; TODO: Maybe only do this when Emacs is idle for a bit. Or defer + ;; the updates and do them later in bursts when the table is used. + (let* ((file-name buffer-file-name) + (tags-file-buf (and etags-regen--tags-root + (get-file-buffer etags-regen--tags-file))) + (relname (concat "/" (file-relative-name file-name + etags-regen--tags-root))) + (ignores etags-regen-ignores) + pr should-scan) + (save-excursion + (when tags-file-buf + (cond + ((and etags-regen--new-file + (kill-local-variable 'etags-regen--new-file) + (setq pr (project-current)) + (equal (project-root pr) etags-regen--tags-root) + (member file-name (project-files pr))) + (set-buffer tags-file-buf) + (setq should-scan t)) + ((progn (set-buffer tags-file-buf) + (etags-regen--remove-tag file-name)) + (setq should-scan t)))) + (when (and should-scan + (not (cl-some + (lambda (ignore) + (string-match-p + (etags-regen--ignore-regexp ignore) + relname)) + ignores))) + (etags-regen--append-tags file-name) + (let ((save-silently t) + (message-log-max nil)) + (save-buffer 0)))))) + +(defun etags-regen--remove-tag (file-name) + (goto-char (point-min)) + (when (search-forward (format "\f\n%s," file-name) nil t) + (let ((start (match-beginning 0))) + (search-forward "\f\n" nil 'move) + (let ((inhibit-read-only t)) + (delete-region start + (if (eobp) + (point) + (- (point) 2))))) + t)) + +(defun etags-regen--append-tags (&rest file-names) + (goto-char (point-max)) + (let ((options (etags-regen--build-program-options (etags-regen--ctags-p))) + (inhibit-read-only t)) + ;; XXX: call-process is significantly faster, though. + ;; Like 10ms vs 20ms here. But `shell-command' makes it easy to + ;; direct stderr to a separate buffer. + (shell-command + (format "%s %s %s -o -" + etags-regen-program (mapconcat #'identity options " ") + (mapconcat #'identity file-names " ")) + t etags-regen--errors-buffer-name)) + ;; FIXME: Is there a better way to do this? + ;; Completion table is the only remaining place where the + ;; update is not incremental. + (setq-default tags-completion-table nil)) + +(defun etags-regen--mark-as-new () + (when (and etags-regen--tags-root + (not buffer-file-number)) + (setq-local etags-regen--new-file t))) + +(defun etags-regen--tags-cleanup () + (when etags-regen--tags-file + (let ((buffer (get-file-buffer etags-regen--tags-file))) + (and buffer + (kill-buffer buffer))) + (tags-reset-tags-tables) + (setq tags-file-name nil + tags-table-list nil + etags-regen--tags-file nil + etags-regen--tags-root nil)) + (remove-hook 'after-save-hook #'etags-regen--update-file) + (remove-hook 'before-save-hook #'etags-regen--mark-as-new)) + +(defvar etags-regen-mode-map (make-sparse-keymap)) + +;;;###autoload +(define-minor-mode etags-regen-mode + "Minor mode to automatically generate and update tags tables. + +This minor mode generates the tags table automatically based on +the current project configuration, and later updates it as you +edit the files and save the changes. + +If you select a tags table manually (for example, using +\\[visit-tags-table]), then this mode will be effectively +disabled for the entire session. Use \\[tags-reset-tags-tables] +to countermand the effect of a previous \\[visit-tags-table]." + :global t + (if etags-regen-mode + (progn + (advice-add 'etags--xref-backend :before + #'etags-regen--maybe-generate) + (advice-add 'tags-completion-at-point-function :before + #'etags-regen--maybe-generate)) + (advice-remove 'etags--xref-backend #'etags-regen--maybe-generate) + (advice-remove 'tags-completion-at-point-function #'etags-regen--maybe-generate) + (etags-regen--tags-cleanup))) + +(provide 'etags-regen) + +;;; etags-regen.el ends here -- cgit v1.2.3 From 88ed501abe9666fced46703613c000c26e450ad8 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 4 Jan 2024 01:49:34 +0100 Subject: Prefer NILP (x) to EQ (x, Qnil) * src/image.c (anim_prune_animation_cache): Prefer NILP (x) to EQ (x, Qnil). * admin/coccinelle/nilp.cocci: Semantic patch for above change. --- admin/coccinelle/nilp.cocci | 6 ++++++ src/image.c | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) create mode 100644 admin/coccinelle/nilp.cocci diff --git a/admin/coccinelle/nilp.cocci b/admin/coccinelle/nilp.cocci new file mode 100644 index 00000000000..ccebbbe1c80 --- /dev/null +++ b/admin/coccinelle/nilp.cocci @@ -0,0 +1,6 @@ +// Prefer NILP (x) to EQ (x, Qnil) +@@ +expression X; +@@ +- EQ (X, Qnil) ++ NILP (X) diff --git a/src/image.c b/src/image.c index f09552c4017..dea2730832b 100644 --- a/src/image.c +++ b/src/image.c @@ -3561,7 +3561,7 @@ anim_prune_animation_cache (Lisp_Object clear) { struct anim_cache *cache = *pcache; if (EQ (clear, Qt) - || (EQ (clear, Qnil) && timespec_cmp (old, cache->update_time) > 0) + || (NILP (clear) && timespec_cmp (old, cache->update_time) > 0) || EQ (clear, cache->spec)) { if (cache->handle) -- cgit v1.2.3 From d91a4133b0ad6bb5f53fdbd9ae0e4410c1422a64 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 4 Jan 2024 02:24:13 +0100 Subject: Prefer build_unibyte_string where applicable * src/fns.c (syms_of_fns): * src/image.c (slurp_image): Prefer build_unibyte_string (str) to make_unibyte_string (str, strlen (str)). * admin/coccinelle/unibyte_string.cocci: Support string literals. --- admin/coccinelle/unibyte_string.cocci | 6 ++++++ src/fns.c | 2 +- src/image.c | 2 +- 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/admin/coccinelle/unibyte_string.cocci b/admin/coccinelle/unibyte_string.cocci index 0ff8cafa15d..97f87e5a4ca 100644 --- a/admin/coccinelle/unibyte_string.cocci +++ b/admin/coccinelle/unibyte_string.cocci @@ -4,3 +4,9 @@ identifier I; @@ - make_unibyte_string (I, strlen (I)) + build_unibyte_string (I) + +@@ +constant C; +@@ +- make_unibyte_string (C, strlen (C)) ++ build_unibyte_string (C) diff --git a/src/fns.c b/src/fns.c index 05b7fe85601..c03aea02397 100644 --- a/src/fns.c +++ b/src/fns.c @@ -6337,7 +6337,7 @@ The same variable also affects the function `read-answer'. See also DEFVAR_LISP ("yes-or-no-prompt", Vyes_or_no_prompt, doc: /* String to append when `yes-or-no-p' asks a question. For best results this should end in a space. */); - Vyes_or_no_prompt = make_unibyte_string ("(yes or no) ", strlen ("(yes or no) ")); + Vyes_or_no_prompt = build_unibyte_string ("(yes or no) "); defsubr (&Sidentity); defsubr (&Srandom); diff --git a/src/image.c b/src/image.c index dea2730832b..252b83da992 100644 --- a/src/image.c +++ b/src/image.c @@ -4373,7 +4373,7 @@ slurp_image (Lisp_Object filename, ptrdiff_t *size, const char *image_type) char *result = slurp_file (fd, size); if (result == NULL) image_error ("Error loading %s image `%s'", - make_unibyte_string (image_type, strlen (image_type)), + build_unibyte_string (image_type), file); return result; } -- cgit v1.2.3 From 310ed338c195c755b11e0c62bde9629797b644c8 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 4 Jan 2024 02:41:22 +0100 Subject: Remove semantic patch for adjusting `XSAVE_*` * admin/coccinelle/xsave.cocci: Delete file. The corresponding macros were removed in 4139c98eb5f 2018-06-14 "Remove Lisp_Misc_Save_Value". --- admin/coccinelle/xsave.cocci | 11 ----------- 1 file changed, 11 deletions(-) delete mode 100644 admin/coccinelle/xsave.cocci diff --git a/admin/coccinelle/xsave.cocci b/admin/coccinelle/xsave.cocci deleted file mode 100644 index 5172bb55b33..00000000000 --- a/admin/coccinelle/xsave.cocci +++ /dev/null @@ -1,11 +0,0 @@ -// Adjust users of XSAVE_POINTER and XSAVE_INTEGER. -@@ -expression E; -@@ -( -- XSAVE_POINTER (E) -+ XSAVE_POINTER (E, 0) -| -- XSAVE_INTEGER (E) -+ XSAVE_INTEGER (E, 1) -) -- cgit v1.2.3 From a2a6619b2825c3c3d159610f0cd6fd89b791bd3f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 4 Jan 2024 10:17:30 +0200 Subject: Provide decent documentation for 'help-quick' * lisp/help.el (help-quick, help-quick-toggle): Doc fix. * doc/emacs/help.texi (Help Summary, Misc Help): Document 'help-quick-toggle'. --- doc/emacs/help.texi | 15 +++++++++++++++ lisp/help.el | 13 ++++++++++--- 2 files changed, 25 insertions(+), 3 deletions(-) diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 68299c057d7..1330717b758 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -115,6 +115,9 @@ Display a list of commands whose names match @var{topics} Display all active key bindings; minor mode bindings first, then those of the major mode, then global bindings (@code{describe-bindings}). @xref{Misc Help}. +@item C-h C-q +Toggle display of a window showing popular commands and their key +bindings. @xref{Misc Help}. @item C-h c @var{key} Show the name of the command that the key sequence @var{key} is bound to (@code{describe-key-briefly}). Here @kbd{c} stands for @@ -700,6 +703,18 @@ displays the contents of the syntax table, with explanations of each character's syntax (@pxref{Syntax Tables,, Syntax Tables, elisp, The Emacs Lisp Reference Manual}). +@kindex C-h C-q +@findex help-quick-toggle +@findex help-quick +@cindex cheat sheet of popular Emacs commands + @kbd{C-h C-q} (@code{help-quick-toggle}) toggles on and off the +display of a buffer showing the most popular Emacs commands and their +respective key bindings (a.k.a.@: ``cheat sheet''). The contents of +that buffer are created by the command @code{help-quick}. Each key +binding shown in this buffer is a button: click on it with +@kbd{mouse-1} or @kbd{mouse-2} to show the documentation of the +command bound to that key sequence. + @findex describe-prefix-bindings You can get a list of subcommands for a particular prefix key by typing @kbd{C-h}, @kbd{?}, or @key{F1} diff --git a/lisp/help.el b/lisp/help.el index fe80dd3a72d..accd01e56f5 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -171,7 +171,10 @@ buffer.") ;; Inspired by a mg fork (https://github.com/troglobit/mg) (defun help-quick () - "Display a quick-help buffer." + "Display a quick-help buffer showing popular commands and their bindings. +The window showing quick-help can be toggled using \\[help-quick-toggle]. +You can click on a key binding shown in the quick-help buffer to display +the documentation of the command bound to that key sequence." (interactive) (with-current-buffer (get-buffer-create "*Quick Help*") (let ((inhibit-read-only t) (padding 2) blocks) @@ -244,10 +247,14 @@ buffer.") ;; ... and shrink it immediately. (fit-window-to-buffer)) (message - (substitute-command-keys "Toggle the quick help buffer using \\[help-quick-toggle].")))) + (substitute-command-keys "Toggle display of quick-help buffer using \\[help-quick-toggle].")))) (defun help-quick-toggle () - "Toggle the quick-help window." + "Toggle display of a window showing popular commands and their bindings. +This toggles on and off the display of the quick-help buffer, which shows +popular commands and their bindings as produced by `help-quick'. +You can click on a key binding shown in the quick-help buffer to display +the documentation of the command bound to that key sequence." (interactive) (if (and-let* ((window (get-buffer-window "*Quick Help*"))) (quit-window t window)) -- cgit v1.2.3 From ff00b85acf8371a358a055ef3e7325220bb6e362 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 4 Jan 2024 11:34:21 +0200 Subject: Document 'etags-regen-mode' in the Emacs user manual * doc/emacs/maintaining.texi (Create Tags Table): Document 'etags-regen-mode'. --- doc/emacs/maintaining.texi | 34 +++++++++++++++++++++++++++++++++- etc/NEWS | 1 + 2 files changed, 34 insertions(+), 1 deletion(-) diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 8de9cf2c2f3..d3e06fa697b 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -2683,7 +2683,7 @@ use tags, separate from the @command{etags} facility. @menu * Tag Syntax:: Tag syntax for various types of code and text files. -* Create Tags Table:: Creating a tags table with @command{etags}. +* Create Tags Table:: Creating and updating tags tables with @command{etags}. * Etags Regexps:: Create arbitrary tags using regular expressions. @end menu @@ -2999,6 +2999,38 @@ explanation. If followed by one or more @samp{--language=@var{lang}} options, it outputs detailed information about how tags are generated for @var{lang}. +@findex etags-regen-mode + Instead of creating and updating the tags table by manually invoking +@command{etags}, you can ask Emacs to do it for you automatically. +The global minor mode @code{etags-regen-mode}, if enabled, generates +tags tables automatically as needed, and takes care of updating them +when you edit any of the source files that contribute tags. This mode +uses the current project configuration (@pxref{Projects}) to determine +which files to submit to @command{etags} for regenerating the tags +table for the project. You can customize how this minor mode works +using the following user options: + +@vtable @code +@item etags-regen-program +The program to regenerate tags table; defaults to @command{etags}. + +@item etags-regen-program-options +Command-line options to pass to the program which regenerates tags +tables. + +@item etags-regen-ignores +List of glob patterns which specify files to ignore when regenerating +tags tables. +@end vtable + +@cindex tags-reset-tags-tables + If you select a tags table manually, with @kbd{M-x visit-tags-table} +(@pxref{Select Tags Table}), @code{etags-regen-mode} effectively +disables itself: it will no longer automatically create and update +tags tables, assuming that you prefer managing your tags tables +manually. You can cancel this effect of using @code{visit-tags-table} +by invoking the command @code{tags-reset-tags-tables}. + @node Etags Regexps @subsubsection Etags Regexps diff --git a/etc/NEWS b/etc/NEWS index 1cdb12c3958..713581cdcf4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1265,6 +1265,7 @@ the needs of users with red-green or blue-yellow color deficiency. The Info manual "(modus-themes) Top" describes the details and showcases all their customization options. ++++ ** New global minor mode 'etags-regen-mode'. This minor mode generates the tags table automatically based on the current project configuration, and later updates it as you edit the -- cgit v1.2.3 From 9308d9a74ab586e9793b2561da23116f2b4fe205 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 4 Jan 2024 11:06:41 +0100 Subject: * src/comp.c (Fcomp__compile_ctxt_to_file): Fix hash table Qunbound use. --- src/comp.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/comp.c b/src/comp.c index 882b42cdbd5..8428cf9020e 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4964,12 +4964,12 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, struct Lisp_Hash_Table *func_h = XHASH_TABLE (CALL1I (comp-ctxt-funcs-h, Vcomp_ctxt)); for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (func_h); i++) - if (!BASE_EQ (HASH_VALUE (func_h, i), Qunbound)) + if (!BASE_EQ (HASH_KEY (func_h, i), Qunbound)) declare_function (HASH_VALUE (func_h, i)); /* Compile all functions. Can't be done before because the relocation structs has to be already defined. */ for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (func_h); i++) - if (!BASE_EQ (HASH_VALUE (func_h, i), Qunbound)) + if (!BASE_EQ (HASH_KEY (func_h, i), Qunbound)) compile_function (HASH_VALUE (func_h, i)); /* Work around bug#46495 (GCC PR99126). */ -- cgit v1.2.3 From 5765cc3a5a32bdecfb6b28180afda97d4b74ee6a Mon Sep 17 00:00:00 2001 From: Morgan Willcock Date: Sun, 31 Dec 2023 20:47:17 +0000 Subject: Ensure indent-region argument order in tempo.el is correct * lisp/tempo.el (tempo-insert): Call 'indent-region' with the stored region markers to ensure that the start and end arguments are used in the correct order. (Bug#68185) --- lisp/tempo.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/tempo.el b/lisp/tempo.el index df78690bd31..f32313d80d0 100644 --- a/lisp/tempo.el +++ b/lisp/tempo.el @@ -333,7 +333,8 @@ possible." (`(r> . ,rest) (if on-region (progn (goto-char tempo-region-stop) - (indent-region (mark) (point) nil)) + (indent-region tempo-region-start + tempo-region-stop)) (tempo-insert-prompt-compat rest))) (`(s ,name) (tempo-insert-named name)) (`(l . ,rest) (dolist (elt rest) (tempo-insert elt on-region))) @@ -344,7 +345,7 @@ possible." ('r> (if on-region (progn (goto-char tempo-region-stop) - (indent-region (mark) (point) nil)) + (indent-region tempo-region-start tempo-region-stop)) (tempo-insert-mark (point-marker)))) ('> (indent-according-to-mode)) ('& (if (not (or (= (current-column) 0) -- cgit v1.2.3 From d69fb6dab28e55447516341cf28f1b6d06937ad6 Mon Sep 17 00:00:00 2001 From: Morgan Willcock Date: Sun, 31 Dec 2023 20:47:17 +0000 Subject: Fix last change in tempo.el * lisp/tempo.el: Set marker type for tempo-region-start to move when text is inserted at its position. This prevents the template from inserting text into the region. (Bug#68185) --- lisp/tempo.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/tempo.el b/lisp/tempo.el index f32313d80d0..513e778e4ef 100644 --- a/lisp/tempo.el +++ b/lisp/tempo.el @@ -198,6 +198,10 @@ This is an abnormal hook where the functions are called with one argument (defvar-local tempo-region-start (make-marker) "Region start when inserting around the region.") +;; Insertion by the template at the region start position should move +;; the marker to preserve the original region contents. +(set-marker-insertion-type tempo-region-start t) + (defvar-local tempo-region-stop (make-marker) "Region stop when inserting around the region.") -- cgit v1.2.3 From dc99be8e633fa0d8594b72f41584a53590939fde Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 4 Jan 2024 19:20:30 +0200 Subject: Support display-sort-function in completion-category-overrides (bug#68214) * doc/lispref/minibuf.texi (Completion Variables): Add 'display-sort-function' to the table of 'completion-category-overrides'. * lisp/calendar/calendar.el (calendar-read-date): Add metadata category 'calendar-month' for completing-read reading a month name. * lisp/minibuffer.el (completion-category-defaults): Add 'display-sort-function' with identity for the category 'calendar-month'. (completion-category-overrides): Add customization for completion sorting with 'display-sort-function' and a choice like in 'completions-sort'. (completion-metadata-override-get): New function. (minibuffer-completion-help): Use 'completion-metadata-override-get' instead of 'completion-metadata-get' to get sort-fun from 'display-sort-function'. --- doc/lispref/minibuf.texi | 6 ++++++ etc/NEWS | 6 ++++++ lisp/calendar/calendar.el | 6 +++++- lisp/minibuffer.el | 30 +++++++++++++++++++++++++++--- 4 files changed, 44 insertions(+), 4 deletions(-) diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 5c5edf62a8d..65272627660 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1878,6 +1878,12 @@ The value should be a list of completion styles (symbols). The value should be a value for @code{completion-cycle-threshold} (@pxref{Completion Options,,, emacs, The GNU Emacs Manual}) for this category. + +@item display-sort-function +The possible values are: @code{nil} that means to use either the sorting +function from metadata or if it's nil then fall back to @code{completions-sort}; +@code{identity} that means to not use any sorting to keep the original order; +and other values are the same as in @code{completions-sort}. @end table @noindent diff --git a/etc/NEWS b/etc/NEWS index 713581cdcf4..6239af3e138 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -740,6 +740,12 @@ When 'completions-sort' is set to 'historical', completion candidates will be first sorted alphabetically, and then re-sorted by their order in the minibuffer history, with more recent candidates appearing first. ++++ +*** 'completion-category-overrides' supports 'display-sort-function'. +You can now customize the sorting order for any category in +'completion-category-overrides' that will override the sorting order +defined in the metadata or in 'completions-sort'. + ** Pcomplete --- diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index a25684f7b5d..e01d5d792a6 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -2339,7 +2339,11 @@ returned is (month year)." (month (cdr (assoc-string (completing-read (format-prompt "Month name" defmon) - (append month-array nil) + (lambda (string pred action) + (if (eq action 'metadata) + '(metadata (category . calendar-month)) + (complete-with-action + action (append month-array nil) string pred))) nil t nil nil defmon) (calendar-make-alist month-array 1) t))) (defday (calendar-extract-day default-date)) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index fa2dcb4f698..6ead11d81c8 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1135,12 +1135,14 @@ styles for specific categories, such as files, buffers, etc." (project-file (styles . (substring))) (xref-location (styles . (substring))) (info-menu (styles . (basic substring))) - (symbol-help (styles . (basic shorthand substring)))) + (symbol-help (styles . (basic shorthand substring))) + (calendar-month (display-sort-function . identity))) "Default settings for specific completion categories. Each entry has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: - `styles': the list of `completion-styles' to use for that category. - `cycle': the `completion-cycle-threshold' to use for that category. +- `display-sort-function': the sorting function. Categories are symbols such as `buffer' and `file', used when completing buffer and file names, respectively. @@ -1148,10 +1150,16 @@ Also see `completion-category-overrides'.") (defcustom completion-category-overrides nil "List of category-specific user overrides for completion styles. + Each override has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: - `styles': the list of `completion-styles' to use for that category. - `cycle': the `completion-cycle-threshold' to use for that category. +- `display-sort-function': where `nil' means to use either the sorting +function from metadata or if it's nil then fall back to `completions-sort'; +`identity' means to not use any sorting to keep the original order; +and other values are the same as in `completions-sort'. + Categories are symbols such as `buffer' and `file', used when completing buffer and file names, respectively. @@ -1171,12 +1179,28 @@ overrides the default specified in `completion-category-defaults'." ,completion--styles-type) (cons :tag "Completion Cycling" (const :tag "Select one value from the menu." cycle) - ,completion--cycling-threshold-type)))) + ,completion--cycling-threshold-type) + (cons :tag "Completion Sorting" + (const :tag "Select one value from the menu." + display-sort-function) + (choice (const :tag "Use default" nil) + (const :tag "No sorting" identity) + (const :tag "Alphabetical sorting" + minibuffer-sort-alphabetically) + (const :tag "Historical sorting" + minibuffer-sort-by-history) + (function :tag "Custom function")))))) (defun completion--category-override (category tag) (or (assq tag (cdr (assq category completion-category-overrides))) (assq tag (cdr (assq category completion-category-defaults))))) +(defun completion-metadata-override-get (metadata prop) + (if-let ((cat (completion-metadata-get metadata 'category)) + (over (completion--category-override cat prop))) + (cdr over) + (completion-metadata-get metadata prop))) + (defun completion--styles (metadata) (let* ((cat (completion-metadata-get metadata 'category)) (over (completion--category-override cat 'styles))) @@ -2522,7 +2546,7 @@ The candidate will still be chosen by `choose-completion' unless (aff-fun (or (completion-metadata-get all-md 'affixation-function) (plist-get completion-extra-properties :affixation-function))) - (sort-fun (completion-metadata-get all-md 'display-sort-function)) + (sort-fun (completion-metadata-override-get all-md 'display-sort-function)) (group-fun (completion-metadata-get all-md 'group-function)) (mainbuf (current-buffer)) ;; If the *Completions* buffer is shown in a new -- cgit v1.2.3 From df505804ab6e7dc869cfc9db6308a8c568eddd6a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 4 Jan 2024 20:47:06 +0200 Subject: ; Fix documentation of last change * lisp/minibuffer.el (completion-category-overrides): Doc fix. * doc/emacs/mini.texi (Completion Options): Update documentation of 'completions-sort'. * doc/lispref/minibuf.texi (Completion Variables): Fox wording. Add a cross-reference to where 'completions-sort' is documented. --- doc/emacs/mini.texi | 4 +++- doc/lispref/minibuf.texi | 10 ++++++---- lisp/minibuffer.el | 8 ++++---- 3 files changed, 13 insertions(+), 9 deletions(-) diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index 30a61a02f06..aa7144610a6 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -709,7 +709,9 @@ will use just one column. The @code{completions-sort} user option controls the order in which the completions are sorted in the @samp{*Completions*} buffer. The default is @code{alphabetical}, which sorts in alphabetical order. -The value @code{nil} disables sorting. The value can also be a +The value @code{nil} disables sorting; the value @code{historical} +sorts alphabetically first, and then rearranges according to the order +of the candidates in the minibuffer history. The value can also be a function, which will be called with the list of completions, and should return the list in the desired order. diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 65272627660..8aed1515764 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1880,10 +1880,12 @@ The value should be a value for @code{completion-cycle-threshold} category. @item display-sort-function -The possible values are: @code{nil} that means to use either the sorting -function from metadata or if it's nil then fall back to @code{completions-sort}; -@code{identity} that means to not use any sorting to keep the original order; -and other values are the same as in @code{completions-sort}. +The possible values are: @code{nil}, which means to use either the +sorting function from metadata or if that is @code{nil}, fall back to +@code{completions-sort}; @code{identity}, which means not to sort at +all, leaving the original order; or any other value out of those used +in @code{completions-sort} (@pxref{Completion Options,,, emacs, The +GNU Emacs Manual}). @end table @noindent diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 6ead11d81c8..b7aebae63a8 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1155,10 +1155,10 @@ Each override has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: - `styles': the list of `completion-styles' to use for that category. - `cycle': the `completion-cycle-threshold' to use for that category. -- `display-sort-function': where `nil' means to use either the sorting -function from metadata or if it's nil then fall back to `completions-sort'; -`identity' means to not use any sorting to keep the original order; -and other values are the same as in `completions-sort'. +- `display-sort-function': nil means to use either the sorting +function from metadata, or if that is nil, fall back to `completions-sort'; +`identity' disables sorting and keeps the original order; and other +possible values are the same as in `completions-sort'. Categories are symbols such as `buffer' and `file', used when completing buffer and file names, respectively. -- cgit v1.2.3 From 225710ba79c10b53b6ba320327ca31192ca72387 Mon Sep 17 00:00:00 2001 From: Antero Mejr Date: Thu, 4 Jan 2024 19:49:23 +0000 Subject: Add file completion for "git blame" to pcomplete * lisp/pcmpl-git.el (pcomplete/git): Add "blame" to the tracked files clause. (Bug#68245) --- lisp/pcmpl-git.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/pcmpl-git.el b/lisp/pcmpl-git.el index facca4107a1..95b6859dd23 100644 --- a/lisp/pcmpl-git.el +++ b/lisp/pcmpl-git.el @@ -88,7 +88,7 @@ Files listed by `git ls-files ARGS' satisfy the predicate." (pcomplete-entries nil (pcmpl-git--tracked-file-predicate "-m")))) ;; Complete all tracked files - ((or "mv" "rm" "grep" "status") + ((or "mv" "rm" "grep" "status" "blame") (pcomplete-here (pcomplete-entries nil (pcmpl-git--tracked-file-predicate)))) ;; Complete revisions -- cgit v1.2.3 From 5ba75e183c60aff50949587c21066e876dabfbda Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 25 Dec 2023 22:32:17 -0500 Subject: New special form `handler-bind` AFAIK, this provides the same semantics as Common Lisp's `handler-bind`, modulo the differences about how error objects and conditions are represented. * lisp/subr.el (handler-bind): New macro. * src/eval.c (pop_handler): New function. (Fhandler_Bind_1): New function. (signal_or_quit): Handle new handlertypes `HANDLER` and `SKIP_CONDITIONS`. (find_handler_clause): Simplify. (syms_of_eval): Defsubr `Fhandler_bind_1`. * doc/lispref/control.texi (Handling Errors): Add `handler-bind`. * test/src/eval-tests.el (eval-tests--handler-bind): New test. * lisp/emacs-lisp/lisp-mode.el (lisp-font-lock-keywords): Move 'handler-bind' from CL-only to generic Lisp. (handler-bind): Remove indentation setting, it now lives in the macro definition. --- doc/lispref/control.texi | 38 +++++++++++++++++ etc/NEWS | 7 ++++ lisp/emacs-lisp/lisp-mode.el | 5 +-- lisp/subr.el | 22 ++++++++++ src/eval.c | 97 ++++++++++++++++++++++++++++++++++++++------ src/lisp.h | 41 +++++++++++++++++-- test/src/eval-tests.el | 37 +++++++++++++++++ 7 files changed, 227 insertions(+), 20 deletions(-) diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index acf9be5c3ff..6cc25dcdaee 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -2293,6 +2293,44 @@ should be robust if one does occur. Note that this macro uses @code{condition-case-unless-debug} rather than @code{condition-case}. @end defmac +Occasionally, we want to catch some errors and record some information +about the conditions in which they occurred, such as the full +backtrace, or the current buffer. This kinds of information is sadly +not available in the handlers of a @code{condition-case} because the +stack is unwound before running that handler, so the handler is run in +the dynamic context of the @code{condition-case} rather than that of +the place where the error was signaled. For those circumstances, you +can use the following form: + +@defmac handler-bind handlers body@dots{} +This special form runs @var{body} and if it executes without error, +the value it returns becomes the value of the @code{handler-bind} +form. In this case, the @code{handler-bind} has no effect. + +@var{handlers} should be a list of elements of the form +@code{(@var{conditions} @var{handler})} where @var{conditions} is an +error condition name to be handled, or a list of condition names, and +@var{handler} should be a form whose evaluation should return a function. + +Before running @var{body}, @code{handler-bind} evaluates all the +@var{handler} forms and installs those handlers to be active during +the evaluation of @var{body}. These handlers are searched together +with those installed by @code{condition-case}. When the innermost +matching handler is one installed by @code{handler-bind}, the +@var{handler} function is called with a single argument holding the +error description. + +@var{handler} is called in the dynamic context where the error +happened, without first unwinding the stack, meaning that all the +dynamic bindings are still in effect, except that all the error +handlers between the code that signaled the error and the +@code{handler-bind} are temporarily suspended. Like any normal +function, @var{handler} can exit non-locally, typically via +@code{throw}, or it can return normally. If @var{handler} returns +normally, it means the handler @emph{declined} to handle the error and +the search for an error handler is continued where it left off. +@end defmac + @node Error Symbols @subsubsection Error Symbols and Condition Names @cindex error symbol diff --git a/etc/NEWS b/etc/NEWS index 6239af3e138..db3b838c380 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1395,6 +1395,13 @@ This is like 'require', but it checks whether the argument 'feature' is already loaded, in which case it either signals an error or forcibly reloads the file that defines the feature. ++++ +** New special form 'handler-bind'. +Provides a functionality similar to `condition-case` except it runs the +handler code without unwinding the stack, such that we can record the +backtrace and other dynamic state at the point of the error. +See the Info node "(elisp) Handling Errors". + +++ ** New 'pop-up-frames' action alist entry for 'display-buffer'. This has the same effect as the variable of the same name and takes diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 1bb9c2fdc2e..ca207ff548d 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -343,7 +343,7 @@ This will generate compile-time constants from BINDINGS." (lisp-vdefs '("defvar")) (lisp-kw '("cond" "if" "while" "let" "let*" "progn" "prog1" "prog2" "lambda" "unwind-protect" "condition-case" - "when" "unless" "with-output-to-string" + "when" "unless" "with-output-to-string" "handler-bind" "ignore-errors" "dotimes" "dolist" "declare")) (lisp-errs '("warn" "error" "signal")) ;; Elisp constructs. Now they are update dynamically @@ -376,7 +376,7 @@ This will generate compile-time constants from BINDINGS." (cl-kw '("block" "break" "case" "ccase" "compiler-let" "ctypecase" "declaim" "destructuring-bind" "do" "do*" "ecase" "etypecase" "eval-when" "flet" "flet*" - "go" "handler-case" "handler-bind" "in-package" ;; "inline" + "go" "handler-case" "in-package" ;; "inline" "labels" "letf" "locally" "loop" "macrolet" "multiple-value-bind" "multiple-value-prog1" "proclaim" "prog" "prog*" "progv" @@ -1346,7 +1346,6 @@ Lisp function does not specify a special indentation." (put 'catch 'lisp-indent-function 1) (put 'condition-case 'lisp-indent-function 2) (put 'handler-case 'lisp-indent-function 1) ;CL -(put 'handler-bind 'lisp-indent-function 1) ;CL (put 'unwind-protect 'lisp-indent-function 1) (put 'with-output-to-temp-buffer 'lisp-indent-function 1) (put 'closure 'lisp-indent-function 2) diff --git a/lisp/subr.el b/lisp/subr.el index d2b8ea17f74..0519e56e057 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -7497,6 +7497,28 @@ predicate conditions in CONDITION." (push buf bufs))) bufs)) +(defmacro handler-bind (handlers &rest body) + "Setup error HANDLERS around execution of BODY. +HANDLERS is a list of (CONDITIONS HANDLER) where +CONDITIONS should be a list of condition names (symbols) or +a single condition name, and HANDLER is a form whose evaluation +returns a function. +When an error is signaled during execution of BODY, if that +error matches CONDITIONS, then the associated HANDLER +function is called with the error object as argument. +HANDLERs can either transfer the control via a non-local exit, +or return normally. If a handler returns normally, the search for an +error handler continues from where it left off." + ;; FIXME: Completion support as in `condition-case'? + (declare (indent 1) (debug ((&rest (sexp form)) body))) + (let ((args '())) + (dolist (cond+handler handlers) + (let ((handler (car (cdr cond+handler))) + (conds (car cond+handler))) + (push `',(ensure-list conds) args) + (push handler args))) + `(handler-bind-1 (lambda () ,@body) ,@(nreverse args)))) + (defmacro with-memoization (place &rest code) "Return the value of CODE and stash it in PLACE. If PLACE's value is non-nil, then don't bother evaluating CODE diff --git a/src/eval.c b/src/eval.c index 7f67b5a9db8..595267f7686 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1198,6 +1198,12 @@ usage: (catch TAG BODY...) */) #define clobbered_eassert(E) verify (sizeof (E) != 0) +static void +pop_handler (void) +{ + handlerlist = handlerlist->next; +} + /* Set up a catch, then call C function FUNC on argument ARG. FUNC should return a Lisp_Object. This is how catches are done from within C code. */ @@ -1361,6 +1367,43 @@ usage: (condition-case VAR BODYFORM &rest HANDLERS) */) return internal_lisp_condition_case (var, bodyform, handlers); } +DEFUN ("handler-bind-1", Fhandler_bind_1, Shandler_bind_1, 1, MANY, 0, + doc: /* Setup error handlers around execution of BODYFUN. +BODYFUN be a function and it is called with no arguments. +CONDITIONS should be a list of condition names (symbols). +When an error is signaled during executon of BODYFUN, if that +error matches one of CONDITIONS, then the associated HANDLER is +called with the error as argument. +HANDLER should either transfer the control via a non-local exit, +or return normally. +If it returns normally, the search for an error handler continues +from where it left off. + +usage: (handler-bind BODYFUN [CONDITIONS HANDLER]...) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + eassert (nargs >= 1); + Lisp_Object bodyfun = args[0]; + int count = 0; + if (nargs % 2 == 0) + error ("Trailing CONDITIONS withount HANDLER in `handler-bind`"); + for (ptrdiff_t i = nargs - 2; i > 0; i -= 2) + { + Lisp_Object conditions = args[i], handler = args[i + 1]; + if (NILP (conditions)) + continue; + else if (!CONSP (conditions)) + conditions = Fcons (conditions, Qnil); + struct handler *c = push_handler (conditions, HANDLER_BIND); + c->val = handler; + c->bytecode_dest = count++; + } + Lisp_Object ret = call0 (bodyfun); + for (; count > 0; count--) + pop_handler (); + return ret; +} + /* Like Fcondition_case, but the args are separate rather than passed in a list. Used by Fbyte_code. */ @@ -1737,6 +1780,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) = (NILP (error_symbol) ? Fcar (data) : error_symbol); Lisp_Object clause = Qnil; struct handler *h; + int skip; if (gc_in_progress || waiting_for_input) emacs_abort (); @@ -1759,6 +1803,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) /* Edebug takes care of restoring these variables when it exits. */ max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 20); + /* FIXME: 'handler-bind' makes `signal-hook-function' obsolete? */ call2 (Vsignal_hook_function, error_symbol, data); } @@ -1778,16 +1823,42 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) Vsignaling_function = backtrace_function (pdl); } - for (h = handlerlist; h; h = h->next) + for (skip = 0, h = handlerlist; h; skip++, h = h->next) { - if (h->type == CATCHER_ALL) + switch (h->type) { + case CATCHER_ALL: clause = Qt; break; - } - if (h->type != CONDITION_CASE) - continue; - clause = find_handler_clause (h->tag_or_ch, conditions); + case CATCHER: + continue; + case CONDITION_CASE: + clause = find_handler_clause (h->tag_or_ch, conditions); + break; + case HANDLER_BIND: + { + if (!NILP (find_handler_clause (h->tag_or_ch, conditions))) + { + Lisp_Object error_data + = (NILP (error_symbol) + ? data : Fcons (error_symbol, data)); + push_handler (make_fixnum (skip + h->bytecode_dest), + SKIP_CONDITIONS); + call1 (h->val, error_data); + pop_handler (); + } + continue; + } + case SKIP_CONDITIONS: + { + int toskip = XFIXNUM (h->tag_or_ch); + while (toskip-- >= 0) + h = h->next; + continue; + } + default: + abort (); + } if (!NILP (clause)) break; } @@ -1804,7 +1875,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) || (CONSP (clause) && !NILP (Fmemq (Qdebug, clause))) /* Special handler that means "print a message and run debugger if requested". */ - || EQ (h->tag_or_ch, Qerror))) + || EQ (clause, Qerror))) { debugger_called = maybe_call_debugger (conditions, error_symbol, data); @@ -1818,8 +1889,9 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) with debugging. Make sure to use `debug-early' unconditionally to not interfere with ERT or other packages that install custom debuggers. */ + /* FIXME: This could be turned into a `handler-bind` at toplevel? */ if (!debugger_called && !NILP (error_symbol) - && (NILP (clause) || EQ (h->tag_or_ch, Qerror)) + && (NILP (clause) || EQ (clause, Qerror)) && noninteractive && backtrace_on_error_noninteractive && NILP (Vinhibit_debugger) && !NILP (Ffboundp (Qdebug_early))) @@ -1833,6 +1905,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) /* If an error is signaled during a Lisp hook in redisplay, write a backtrace into the buffer *Redisplay-trace*. */ + /* FIXME: Turn this into a `handler-bind` installed during redisplay? */ if (!debugger_called && !NILP (error_symbol) && backtrace_on_redisplay_error && (NILP (clause) || h == redisplay_deep_handler) @@ -2058,13 +2131,10 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions) register Lisp_Object h; /* t is used by handlers for all conditions, set up by C code. */ - if (EQ (handlers, Qt)) - return Qt; - /* error is used similarly, but means print an error message and run the debugger if that is enabled. */ - if (EQ (handlers, Qerror)) - return Qt; + if (!CONSP (handlers)) + return handlers; for (h = handlers; CONSP (h); h = XCDR (h)) { @@ -4494,6 +4564,7 @@ alist of active lexical bindings. */); defsubr (&Sthrow); defsubr (&Sunwind_protect); defsubr (&Scondition_case); + defsubr (&Shandler_bind_1); DEFSYM (QCsuccess, ":success"); defsubr (&Ssignal); defsubr (&Scommandp); diff --git a/src/lisp.h b/src/lisp.h index 10018e4dde7..2b30326abfc 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3543,7 +3543,8 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) } /* This structure helps implement the `catch/throw' and `condition-case/signal' - control structures. A struct handler contains all the information needed to + control structures as well as 'handler-bind'. + A struct handler contains all the information needed to restore the state of the interpreter after a non-local jump. Handler structures are chained together in a doubly linked list; the `next' @@ -3564,9 +3565,41 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) state. Members are volatile if their values need to survive _longjmp when - a 'struct handler' is a local variable. */ - -enum handlertype { CATCHER, CONDITION_CASE, CATCHER_ALL }; + a 'struct handler' is a local variable. + + When running the HANDLER of a 'handler-bind', we need to + temporarily "mute" the CONDITION_CASEs and HANDLERs that are "below" + the current handler, but without hiding any CATCHERs. We do that by + installing a SKIP_CONDITIONS which tells the search to skip the + N next conditions. */ + +enum handlertype { + CATCHER, /* Entry for 'catch'. + 'tag_or_ch' holds the catch's tag. + 'val' holds the retval during longjmp. */ + CONDITION_CASE, /* Entry for 'condition-case'. + 'tag_or_ch' holds the list of conditions. + 'val' holds the retval during longjmp. */ + CATCHER_ALL, /* Wildcard which catches all 'throw's. + 'tag_or_ch' is unused. + 'val' holds the retval during longjmp. */ + HANDLER_BIND, /* Entry for 'handler-bind'. + 'tag_or_ch' holds the list of conditions. + 'val' holds the handler function. + The rest of the handler is unused, + except for 'bytecode_dest' that holds + the number of preceding HANDLER_BIND + entries which belong to the same + 'handler-bind' (and hence need to + be muted together). */ + SKIP_CONDITIONS /* Mask out the N preceding entries. + Used while running the handler of + a HANDLER_BIND to hides the condition + handlers underneath (and including) + the 'handler-bind'. + 'tag_or_ch' holds that number, the rest + is unused. */ +}; enum nonlocal_exit { diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index e4b18ec7849..9ac117859dd 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -303,4 +303,41 @@ expressions works for identifiers starting with period." (should (eq 'bar (default-value 'eval-tests/buffer-local-var))) (should (eq 'bar eval-tests/buffer-local-var))))) +(ert-deftest eval-tests--handler-bind () + ;; A `handler-bind' has no effect if no error is signaled. + (should (equal (catch 'tag + (handler-bind ((error (lambda (_err) (throw 'tag 'wow)))) + 'noerror)) + 'noerror)) + ;; The handler is called from within the dynamic extent where the + ;; error is signaled, unlike `condition-case'. + (should (equal (catch 'tag + (handler-bind ((error (lambda (_err) (throw 'tag 'err)))) + (list 'inner-catch + (catch 'tag + (user-error "hello"))))) + '(inner-catch err))) + ;; But inner condition handlers are temporarily muted. + (should (equal (condition-case nil + (handler-bind + ((error (lambda (_err) + (signal 'wrong-type-argument nil)))) + (list 'result + (condition-case nil + (user-error "hello") + (wrong-type-argument 'inner-handler)))) + (wrong-type-argument 'wrong-type-argument)) + 'wrong-type-argument)) + ;; Handlers do not apply to the code run within the handlers. + (should (equal (condition-case nil + (handler-bind + ((error (lambda (_err) + (signal 'wrong-type-argument nil))) + (wrong-type-argument + (lambda (_err) (user-error "wrong-type-argument")))) + (user-error "hello")) + (wrong-type-argument 'wrong-type-argument) + (error 'plain-error)) + 'wrong-type-argument))) + ;;; eval-tests.el ends here -- cgit v1.2.3 From 7959a63ce258c90eb3c7947ab3318c5531eb37d9 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 18 Dec 2023 23:47:56 -0500 Subject: (eval-expression): Fix bug#67196 * lisp/simple.el (eval-expression--debug): New function. (eval-expression): Use it together with `handler-bind` instead of let-binding `debug-on-error`. --- lisp/simple.el | 29 +++++++++++++---------------- 1 file changed, 13 insertions(+), 16 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index 4f6d2ee12c3..692c0dacefc 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2087,6 +2087,9 @@ of the prefix argument for `eval-expression' and ((= num -1) most-positive-fixnum) (t eval-expression-print-maximum-character))))) +(defun eval-expression--debug (err) + (funcall debugger 'error err :backtrace-base #'eval-expression--debug)) + ;; We define this, rather than making `eval' interactive, ;; for the sake of completion of names like eval-region, eval-buffer. (defun eval-expression (exp &optional insert-value no-truncate char-print-limit) @@ -2120,23 +2123,17 @@ this command arranges for all errors to enter the debugger." (cons (read--expression "Eval: ") (eval-expression-get-print-arguments current-prefix-arg))) - (let (result) + (let* (result + (runfun + (lambda () + (setq result + (values--store-value + (eval (let ((lexical-binding t)) (macroexpand-all exp)) + t)))))) (if (null eval-expression-debug-on-error) - (setq result - (values--store-value - (eval (let ((lexical-binding t)) (macroexpand-all exp)) t))) - (let ((old-value (make-symbol "t")) new-value) - ;; Bind debug-on-error to something unique so that we can - ;; detect when evalled code changes it. - (let ((debug-on-error old-value)) - (setq result - (values--store-value - (eval (let ((lexical-binding t)) (macroexpand-all exp)) t))) - (setq new-value debug-on-error)) - ;; If evalled code has changed the value of debug-on-error, - ;; propagate that change to the global binding. - (unless (eq old-value new-value) - (setq debug-on-error new-value)))) + (funcall runfun) + (handler-bind ((error #'eval-expression--debug)) + (funcall runfun))) (let ((print-length (unless no-truncate eval-expression-print-length)) (print-level (unless no-truncate eval-expression-print-level)) -- cgit v1.2.3 From fe0f15dbc962b37d98507a494fd7720bad584a7a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 18 Dec 2023 23:57:45 -0500 Subject: ert.el: Use `handler-bind` to record backtraces * lisp/emacs-lisp/ert.el (ert--should-signal-hook): Delete function. (ert--expand-should-1): Don't bind `signal-hook-function`. (ert--test-execution-info): Remove `next-debugger` slot. (ert--run-test-debugger): Adjust to new calling convention. Pass the `:backtrace-base` info to the debugger. (ert--run-test-internal): Use `handler-bind` rather than let-binding `debugger` and `debug-on-error`. * lisp/emacs-lisp/ert-x.el (ert-remote-temporary-file-directory): Don't use `defconst` if it's not meant to stay constant (e.g. we let-bind it in tramp-tests.el). --- lisp/emacs-lisp/ert-x.el | 2 +- lisp/emacs-lisp/ert.el | 139 ++++++++++++++++++----------------------------- 2 files changed, 55 insertions(+), 86 deletions(-) diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 05da0f1844e..a6d2fe4a1da 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -543,7 +543,7 @@ The same keyword arguments are supported as in ;; If this defconst is used in a test file, `tramp' shall be loaded ;; prior `ert-x'. There is no default value on w32 systems, which ;; could work out of the box. -(defconst ert-remote-temporary-file-directory +(defvar ert-remote-temporary-file-directory (when (featurep 'tramp) (cond ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY")) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 353c1bd09d2..8ab57d2b238 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -278,14 +278,6 @@ DATA is displayed to the user and should state the reason for skipping." (when ert--should-execution-observer (funcall ert--should-execution-observer form-description))) -;; See Bug#24402 for why this exists -(defun ert--should-signal-hook (error-symbol data) - "Stupid hack to stop `condition-case' from catching ert signals. -It should only be stopped when ran from inside `ert--run-test-internal'." - (when (and (not (symbolp debugger)) ; only run on anonymous debugger - (memq error-symbol '(ert-test-failed ert-test-skipped))) - (funcall debugger 'error (cons error-symbol data)))) - (defun ert--special-operator-p (thing) "Return non-nil if THING is a symbol naming a special operator." (and (symbolp thing) @@ -324,8 +316,7 @@ It should only be stopped when ran from inside `ert--run-test-internal'." (default-value (gensym "ert-form-evaluation-aborted-"))) `(let* ((,fn (function ,fn-name)) (,args (condition-case err - (let ((signal-hook-function #'ert--should-signal-hook)) - (list ,@arg-forms)) + (list ,@arg-forms) (error (progn (setq ,fn #'signal) (list (car err) (cdr err))))))) @@ -728,78 +719,68 @@ in front of the value of MESSAGE-FORM." ;; value and test execution should be terminated. Should not ;; return. (exit-continuation (cl-assert nil)) - ;; The binding of `debugger' outside of the execution of the test. - next-debugger ;; The binding of `ert-debug-on-error' that is in effect for the ;; execution of the current test. We store it to avoid being ;; affected by any new bindings the test itself may establish. (I ;; don't remember whether this feature is important.) ert-debug-on-error) -(defun ert--run-test-debugger (info args) - "During a test run, `debugger' is bound to a closure that calls this function. +(defun ert--run-test-debugger (info condition debugfun) + "Error handler used during the test run. This function records failures and errors and either terminates the test silently or calls the interactive debugger, as appropriate. -INFO is the ert--test-execution-info corresponding to this test -run. ARGS are the arguments to `debugger'." - (cl-destructuring-bind (first-debugger-arg &rest more-debugger-args) - args - (cl-ecase first-debugger-arg - ((lambda debug t exit nil) - (apply (ert--test-execution-info-next-debugger info) args)) - (error - (let* ((condition (car more-debugger-args)) - (type (cl-case (car condition) - ((quit) 'quit) - ((ert-test-skipped) 'skipped) - (otherwise 'failed))) - ;; We store the backtrace in the result object for - ;; `ert-results-pop-to-backtrace-for-test-at-point'. - ;; This means we have to limit `print-level' and - ;; `print-length' when printing result objects. That - ;; might not be worth while when we can also use - ;; `ert-results-rerun-test-at-point-debugging-errors', - ;; (i.e., when running interactively) but having the - ;; backtrace ready for printing is important for batch - ;; use. - ;; - ;; Grab the frames above the debugger. - (backtrace (cdr (backtrace-get-frames debugger))) - (infos (reverse ert--infos))) - (setf (ert--test-execution-info-result info) - (cl-ecase type - (quit - (make-ert-test-quit :condition condition - :backtrace backtrace - :infos infos)) - (skipped - (make-ert-test-skipped :condition condition - :backtrace backtrace - :infos infos)) - (failed - (make-ert-test-failed :condition condition - :backtrace backtrace - :infos infos)))) - ;; Work around Emacs's heuristic (in eval.c) for detecting - ;; errors in the debugger. - (cl-incf num-nonmacro-input-events) - ;; FIXME: We should probably implement more fine-grained - ;; control a la non-t `debug-on-error' here. - (cond - ((ert--test-execution-info-ert-debug-on-error info) - (apply (ert--test-execution-info-next-debugger info) args)) - (t)) - (funcall (ert--test-execution-info-exit-continuation info))))))) +INFO is the `ert--test-execution-info' corresponding to this test run. +ERR is the error object." + (let* ((type (cl-case (car condition) + ((quit) 'quit) + ((ert-test-skipped) 'skipped) + (otherwise 'failed))) + ;; We store the backtrace in the result object for + ;; `ert-results-pop-to-backtrace-for-test-at-point'. + ;; This means we have to limit `print-level' and + ;; `print-length' when printing result objects. That + ;; might not be worth while when we can also use + ;; `ert-results-rerun-test-at-point-debugging-errors', + ;; (i.e., when running interactively) but having the + ;; backtrace ready for printing is important for batch + ;; use. + ;; + ;; Grab the frames above ourselves. + (backtrace (cdr (backtrace-get-frames debugfun))) + (infos (reverse ert--infos))) + (setf (ert--test-execution-info-result info) + (cl-ecase type + (quit + (make-ert-test-quit :condition condition + :backtrace backtrace + :infos infos)) + (skipped + (make-ert-test-skipped :condition condition + :backtrace backtrace + :infos infos)) + (failed + (make-ert-test-failed :condition condition + :backtrace backtrace + :infos infos)))) + ;; FIXME: We should probably implement more fine-grained + ;; control a la non-t `debug-on-error' here. + (cond + ((ert--test-execution-info-ert-debug-on-error info) + ;; The `debugfun' arg tells `debug' which backtrace frame starts + ;; the "entering the debugger" code so it can hide those frames + ;; from the backtrace. + (funcall debugger 'error condition :backtrace-base debugfun)) + (t)) + (funcall (ert--test-execution-info-exit-continuation info)))) (defun ert--run-test-internal (test-execution-info) "Low-level function to run a test according to TEST-EXECUTION-INFO. This mainly sets up debugger-related bindings." - (setf (ert--test-execution-info-next-debugger test-execution-info) debugger - (ert--test-execution-info-ert-debug-on-error test-execution-info) + (setf (ert--test-execution-info-ert-debug-on-error test-execution-info) ert-debug-on-error) (catch 'ert--pass ;; For now, each test gets its own temp buffer and its own @@ -807,26 +788,14 @@ This mainly sets up debugger-related bindings." ;; too expensive, we can remove it. (with-temp-buffer (save-window-excursion - ;; FIXME: Use `signal-hook-function' instead of `debugger' to - ;; handle ert errors. Once that's done, remove - ;; `ert--should-signal-hook'. See Bug#24402 and Bug#11218 for - ;; details. - (let ((lexical-binding t) - (debugger (lambda (&rest args) - (ert--run-test-debugger test-execution-info - args))) - (debug-on-error t) - ;; Don't infloop if the error being called is erroring - ;; out, and we have `debug-on-error' bound to nil inside - ;; the test. - (backtrace-on-error-noninteractive nil) - (debug-on-quit t) - ;; FIXME: Do we need to store the old binding of this - ;; and consider it in `ert--run-test-debugger'? - (debug-ignored-errors nil) + (let ((lexical-binding t) ;;FIXME: Why? (ert--infos '())) - (funcall (ert-test-body (ert--test-execution-info-test - test-execution-info)))))) + (letrec ((debugfun (lambda (err) + (ert--run-test-debugger test-execution-info + err debugfun)))) + (handler-bind (((error quit) debugfun)) + (funcall (ert-test-body (ert--test-execution-info-test + test-execution-info)))))))) (ert-pass)) (setf (ert--test-execution-info-result test-execution-info) (make-ert-test-passed)) -- cgit v1.2.3 From 25ea99c211ecf91735b44172da19fc53b304c5f4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 28 Dec 2023 00:46:36 -0500 Subject: Fix ert-tests.el for the new `handler-bind` code Now that `ert.el` uses `handler-bind` instead of `debugger`, some details of the behavior have changed. More specifically, three tests are now broken, but these basically tested the failure of ERT's machinery to record errors when ERT was run within a `condition-case`. AFAICT, these tests do not check for a behavior that we want, so rather than "fix" them, I deleted them (bug#67862). * test/lisp/emacs-lisp/ert-tests.el (ert-test-error-debug) (ert-test-fail-debug-with-condition-case): Delete. (ert-test-should-failure-debugging): Don't use `ert-debug-on-error`. (ert-test-with-demoted-errors): It now passes. Bug#11218 is fixed! --- test/lisp/emacs-lisp/ert-tests.el | 41 ++++++++------------------------------- 1 file changed, 8 insertions(+), 33 deletions(-) diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 768a3a726aa..1aff73d66f6 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -1,6 +1,6 @@ ;;; ert-tests.el --- ERT's self-tests -*- lexical-binding: t -*- -;; Copyright (C) 2007-2008, 2010-2024 Free Software Foundation, Inc. +;; Copyright (C) 2007-2024 Free Software Foundation, Inc. ;; Author: Christian Ohler @@ -93,16 +93,6 @@ failed or if there was a problem." '(ert-test-failed "failure message")) t)))) -(ert-deftest ert-test-fail-debug-with-condition-case () - (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) - (condition-case condition - (progn - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (cl-assert nil)) - ((error) - (cl-assert (equal condition '(ert-test-failed "failure message")) t))))) - (ert-deftest ert-test-fail-debug-with-debugger-1 () (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) (let ((debugger (lambda (&rest _args) @@ -146,16 +136,6 @@ failed or if there was a problem." '(error "Error message")) t)))) -(ert-deftest ert-test-error-debug () - (let ((test (make-ert-test :body (lambda () (error "Error message"))))) - (condition-case condition - (progn - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (cl-assert nil)) - ((error) - (cl-assert (equal condition '(error "Error message")) t))))) - ;;; Test that `should' works. (ert-deftest ert-test-should () @@ -359,14 +339,10 @@ This macro is used to test if macroexpansion in `should' works." (,(lambda () (let ((_x t)) (should (error "Foo")))) (error "Foo"))) do - (let ((test (make-ert-test :body body))) - (condition-case actual-condition - (progn - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (cl-assert nil)) - ((error) - (should (equal actual-condition expected-condition))))))) + (let* ((test (make-ert-test :body body)) + (result (ert-run-test test))) + (should (ert-test-failed-p result)) + (should (equal (ert-test-failed-condition result) expected-condition))))) (defun ert-test--which-file () "Dummy function to help test `symbol-file' for tests.") @@ -392,9 +368,9 @@ This macro is used to test if macroexpansion in `should' works." (result (ert-run-test test))) (should (ert-test-failed-p result)) (should (memq (backtrace-frame-fun (car (ert-test-failed-backtrace result))) - ;;; This is `ert-fail' on nativecomp and `signal' - ;;; otherwise. It's not clear whether that's a bug - ;;; or not (bug#51308). + ;; This is `ert-fail' on nativecomp and `signal' + ;; otherwise. It's not clear whether that's a bug + ;; or not (bug#51308). '(ert-fail signal))))) (ert-deftest ert-test-messages () @@ -880,7 +856,6 @@ This macro is used to test if macroexpansion in `should' works." (ert-deftest ert-test-with-demoted-errors () "Check that ERT correctly handles `with-demoted-errors'." - :expected-result :failed ;; FIXME! Bug#11218 (should-not (with-demoted-errors "FOO: %S" (error "Foo")))) (ert-deftest ert-test-fail-inside-should () -- cgit v1.2.3 From fa1063774ce32714365cf122b2a8cca2d23fc6cd Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Wed, 27 Dec 2023 11:32:49 +0100 Subject: Use handler-bind to repair bytecomp-tests * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--error-frame, bytecomp--byte-op-error-backtrace): Make test pass again and simplify, using handler-bind instead of the previous debugger hack. --- test/lisp/emacs-lisp/bytecomp-tests.el | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 293d3025420..dcb72e4105a 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -2087,18 +2087,12 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \ (defun bytecomp-tests--error-frame (fun args) "Call FUN with ARGS. Return result or (ERROR . BACKTRACE-FRAME)." - (let* ((debugger - (lambda (&rest args) - ;; Make sure Emacs doesn't think our debugger is buggy. - (cl-incf num-nonmacro-input-events) - (throw 'bytecomp-tests--backtrace - (cons args (cadr (backtrace-get-frames debugger)))))) - (debug-on-error t) - (backtrace-on-error-noninteractive nil) - (debug-on-quit t) - (debug-ignored-errors nil)) + (letrec ((handler (lambda (e) + (throw 'bytecomp-tests--backtrace + (cons e (cadr (backtrace-get-frames handler))))))) (catch 'bytecomp-tests--backtrace - (apply fun args)))) + (handler-bind ((error handler)) + (apply fun args))))) (defconst bytecomp-tests--byte-op-error-cases '(((car a) (wrong-type-argument listp a)) @@ -2143,7 +2137,7 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \ `(lambda ,formals (,fun-sym ,@formals))))))) (error-frame (bytecomp-tests--error-frame fun actuals))) (should (consp error-frame)) - (should (equal (car error-frame) (list 'error expected-error))) + (should (equal (car error-frame) expected-error)) (let ((frame (cdr error-frame))) (should (equal (type-of frame) 'backtrace-frame)) (should (equal (cons (backtrace-frame-fun frame) -- cgit v1.2.3 From 142c90a6f088a6eea66d6b08d05a5ff70c018aa6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 28 Dec 2023 00:49:39 -0500 Subject: emacs-module-tests.el (mod-test-non-local-exit-signal-test): Repair test That test relied on `debugger` and `debug-on-signal` in a way that doesn't work with the new ERT code. * test/src/emacs-module-tests.el (mod-test-non-local-exit-signal-test): Use `handler-bind` rather than the debugger. --- test/src/emacs-module-tests.el | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index b82d4a36304..fd0647275a0 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -114,15 +114,14 @@ changes." (ert-deftest mod-test-non-local-exit-signal-test () (should-error (mod-test-signal)) - (let (debugger-args backtrace) + (let (handler-err backtrace) (should-error - (let ((debugger (lambda (&rest args) - (setq debugger-args args - backtrace (with-output-to-string (backtrace))) - (cl-incf num-nonmacro-input-events))) - (debug-on-signal t)) + (handler-bind + ((error (lambda (err) + (setq handler-err err + backtrace (with-output-to-string (backtrace)))))) (mod-test-signal))) - (should (equal debugger-args '(error (error . 56)))) + (should (equal handler-err '(error . 56))) (should (string-match-p (rx bol " mod-test-signal()" eol) backtrace)))) -- cgit v1.2.3 From 80b081a0ac72a5a9e459af6c96f5b0226a79894f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 19 Dec 2023 19:46:47 -0500 Subject: startup.el: Use `handler-bind` to implement `--debug-init` This provides a more reliable fix for bug#65267 since we don't touch `debug-on-error` nor `debug-ignore-errors` any more. * lisp/startup.el (startup--debug): New function. (startup--load-user-init-file): Use it and `handler-bind` instead of let-binding `debug-on-error`. --- lisp/startup.el | 221 +++++++++++++++++++++++++------------------------------- 1 file changed, 97 insertions(+), 124 deletions(-) diff --git a/lisp/startup.el b/lisp/startup.el index 1abbb260e30..4040d5d3774 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -393,7 +393,7 @@ If this is nil, Emacs uses `system-name'." "The email address of the current user. This defaults to either: the value of EMAIL environment variable; or user@host, using `user-login-name' and `mail-host-address' (or `system-name')." - :initialize 'custom-initialize-delay + :initialize #'custom-initialize-delay :set-after '(mail-host-address) :type 'string :group 'mail) @@ -492,7 +492,7 @@ DIRS are relative." (setq tail (cdr tail))) ;;Splice the new section in. (when tail - (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail)))))) + (setcdr tail (append (mapcar #'expand-file-name dirs) (cdr tail)))))) ;; The default location for XDG-convention Emacs init files. (defconst startup--xdg-config-default "~/.config/emacs/") @@ -1019,6 +1019,9 @@ If STYLE is nil, display appropriately for the terminal." (when standard-display-table (aset standard-display-table char nil))))))) +(defun startup--debug (err) + (funcall debugger 'error err :backtrace-base #'startup--debug)) + (defun startup--load-user-init-file (filename-function &optional alternate-filename-function load-defaults) "Load a user init-file. @@ -1032,124 +1035,94 @@ is non-nil. This function sets `user-init-file' to the name of the loaded init-file, or to a default value if loading is not possible." - (let ((debug-on-error-from-init-file nil) - (debug-on-error-should-be-set nil) - (debug-on-error-initial - (if (eq init-file-debug t) - 'startup--witness ;Dummy but recognizable non-nil value. - init-file-debug)) - (d-i-e-from-init-file nil) - (d-i-e-initial - ;; Use (startup--witness) instead of nil, so we can detect when the - ;; init files set `debug-ignored-errors' to nil. - (if init-file-debug '(startup--witness) debug-ignored-errors)) - (d-i-e-standard debug-ignored-errors) - ;; The init file might contain byte-code with embedded NULs, - ;; which can cause problems when read back, so disable nul - ;; byte detection. (Bug#52554) - (inhibit-null-byte-detection t)) - (let ((debug-on-error debug-on-error-initial) - ;; If they specified --debug-init, enter the debugger - ;; on any error whatsoever. - (debug-ignored-errors d-i-e-initial)) - (condition-case-unless-debug error - (when init-file-user - (let ((init-file-name (funcall filename-function))) - - ;; If `user-init-file' is t, then `load' will store - ;; the name of the file that it loads into - ;; `user-init-file'. - (setq user-init-file t) - (when init-file-name - (load (if (equal (file-name-extension init-file-name) - "el") - (file-name-sans-extension init-file-name) - init-file-name) - 'noerror 'nomessage)) - - (when (and (eq user-init-file t) alternate-filename-function) - (let ((alt-file (funcall alternate-filename-function))) - (unless init-file-name - (setq init-file-name alt-file)) - (and (equal (file-name-extension alt-file) "el") - (setq alt-file (file-name-sans-extension alt-file))) - (load alt-file 'noerror 'nomessage))) - - ;; If we did not find the user's init file, set - ;; user-init-file conclusively. Don't let it be - ;; set from default.el. - (when (eq user-init-file t) - (setq user-init-file init-file-name))) - - ;; If we loaded a compiled file, set `user-init-file' to - ;; the source version if that exists. - (if (equal (file-name-extension user-init-file) "elc") - (let* ((source (file-name-sans-extension user-init-file)) - (alt (concat source ".el"))) - (setq source (cond ((file-exists-p alt) alt) - ((file-exists-p source) source) - (t nil))) - (when source - (when (file-newer-than-file-p source user-init-file) - (message "Warning: %s is newer than %s" - source user-init-file) - (sit-for 1)) - (setq user-init-file source))) - ;; Else, perhaps the user init file was compiled - (when (and (equal (file-name-extension user-init-file) "eln") - ;; The next test is for builds without native - ;; compilation support or builds with unexec. - (boundp 'comp-eln-to-el-h)) - (if-let (source (gethash (file-name-nondirectory user-init-file) - comp-eln-to-el-h)) - ;; source exists or the .eln file would not load - (setq user-init-file source) - (message "Warning: unknown source file for init file %S" - user-init-file) - (sit-for 1)))) - - (when (and load-defaults - (not inhibit-default-init)) - ;; Prevent default.el from changing the value of - ;; `inhibit-startup-screen'. - (let ((inhibit-startup-screen nil)) - (load "default" 'noerror 'nomessage)))) - (error - (display-warning - 'initialization - (format-message "\ + ;; The init file might contain byte-code with embedded NULs, + ;; which can cause problems when read back, so disable nul + ;; byte detection. (Bug#52554) + (let ((inhibit-null-byte-detection t) + (body + (lambda () + (condition-case-unless-debug error + (when init-file-user + (let ((init-file-name (funcall filename-function))) + + ;; If `user-init-file' is t, then `load' will store + ;; the name of the file that it loads into + ;; `user-init-file'. + (setq user-init-file t) + (when init-file-name + (load (if (equal (file-name-extension init-file-name) + "el") + (file-name-sans-extension init-file-name) + init-file-name) + 'noerror 'nomessage)) + + (when (and (eq user-init-file t) alternate-filename-function) + (let ((alt-file (funcall alternate-filename-function))) + (unless init-file-name + (setq init-file-name alt-file)) + (and (equal (file-name-extension alt-file) "el") + (setq alt-file (file-name-sans-extension alt-file))) + (load alt-file 'noerror 'nomessage))) + + ;; If we did not find the user's init file, set + ;; user-init-file conclusively. Don't let it be + ;; set from default.el. + (when (eq user-init-file t) + (setq user-init-file init-file-name))) + + ;; If we loaded a compiled file, set `user-init-file' to + ;; the source version if that exists. + (if (equal (file-name-extension user-init-file) "elc") + (let* ((source (file-name-sans-extension user-init-file)) + (alt (concat source ".el"))) + (setq source (cond ((file-exists-p alt) alt) + ((file-exists-p source) source) + (t nil))) + (when source + (when (file-newer-than-file-p source user-init-file) + (message "Warning: %s is newer than %s" + source user-init-file) + (sit-for 1)) + (setq user-init-file source))) + ;; Else, perhaps the user init file was compiled + (when (and (equal (file-name-extension user-init-file) "eln") + ;; The next test is for builds without native + ;; compilation support or builds with unexec. + (boundp 'comp-eln-to-el-h)) + (if-let (source (gethash (file-name-nondirectory + user-init-file) + comp-eln-to-el-h)) + ;; source exists or the .eln file would not load + (setq user-init-file source) + (message "Warning: unknown source file for init file %S" + user-init-file) + (sit-for 1)))) + + (when (and load-defaults + (not inhibit-default-init)) + ;; Prevent default.el from changing the value of + ;; `inhibit-startup-screen'. + (let ((inhibit-startup-screen nil)) + (load "default" 'noerror 'nomessage)))) + (error + (display-warning + 'initialization + (format-message "\ An error occurred while loading `%s':\n\n%s%s%s\n\n\ To ensure normal operation, you should investigate and remove the cause of the error in your initialization file. Start Emacs with the `--debug-init' option to view a complete error backtrace." - user-init-file - (get (car error) 'error-message) - (if (cdr error) ": " "") - (mapconcat (lambda (s) (prin1-to-string s t)) - (cdr error) ", ")) - :warning) - (setq init-file-had-error t))) - - ;; If we can tell that the init file altered debug-on-error, - ;; arrange to preserve the value that it set up. - (unless (eq debug-ignored-errors d-i-e-initial) - (if (memq 'startup--witness debug-ignored-errors) - ;; The init file wants to add errors to the standard - ;; value, so we need to emulate that. - (setq d-i-e-from-init-file - (list (append d-i-e-standard - (remq 'startup--witness - debug-ignored-errors)))) - ;; The init file _replaces_ the standard value. - (setq d-i-e-from-init-file (list debug-ignored-errors)))) - (or (eq debug-on-error debug-on-error-initial) - (setq debug-on-error-should-be-set t - debug-on-error-from-init-file debug-on-error))) - - (when d-i-e-from-init-file - (setq debug-ignored-errors (car d-i-e-from-init-file))) - (when debug-on-error-should-be-set - (setq debug-on-error debug-on-error-from-init-file)))) + user-init-file + (get (car error) 'error-message) + (if (cdr error) ": " "") + (mapconcat (lambda (s) (prin1-to-string s t)) + (cdr error) ", ")) + :warning) + (setq init-file-had-error t)))))) + (if (eq init-file-debug t) + (handler-bind ((error #'startup--debug)) + (funcall body)) + (funcall body)))) (defvar lisp-directory nil "Directory where Emacs's own *.el and *.elc Lisp files are installed.") @@ -1445,7 +1418,7 @@ please check its value") (error (princ (if (eq (car error) 'error) - (apply 'concat (cdr error)) + (apply #'concat (cdr error)) (if (memq 'file-error (get (car error) 'error-conditions)) (format "%s: %s" (nth 1 error) @@ -1897,10 +1870,10 @@ Each element in the list should be a list of strings or pairs (let ((map (make-sparse-keymap))) (suppress-keymap map) (set-keymap-parent map button-buffer-map) - (define-key map "\C-?" 'scroll-down-command) - (define-key map [?\S-\ ] 'scroll-down-command) - (define-key map " " 'scroll-up-command) - (define-key map "q" 'exit-splash-screen) + (define-key map "\C-?" #'scroll-down-command) + (define-key map [?\S-\ ] #'scroll-down-command) + (define-key map " " #'scroll-up-command) + (define-key map "q" #'exit-splash-screen) map) "Keymap for splash screen buffer.") @@ -2338,7 +2311,7 @@ To quit a partially entered command, type Control-g.\n") ;; If C-h can't be invoked, temporarily disable its ;; binding, so where-is uses alternative bindings. (let ((map (make-sparse-keymap))) - (define-key map [?\C-h] 'undefined) + (define-key map [?\C-h] #'undefined) map)) minor-mode-overriding-map-alist))) @@ -2530,8 +2503,8 @@ A fancy display is used on graphic displays, normal otherwise." (fancy-about-screen) (normal-splash-screen nil))) -(defalias 'about-emacs 'display-about-screen) -(defalias 'display-splash-screen 'display-startup-screen) +(defalias 'about-emacs #'display-about-screen) +(defalias 'display-splash-screen #'display-startup-screen) ;; This avoids byte-compiler warning in the unexec build. (declare-function pdumper-stats "pdumper.c" ()) -- cgit v1.2.3 From 604e34338f3b5a31439020c6704f9f9d07d17d69 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 20 Dec 2023 23:31:39 -0500 Subject: Move batch backtrace code to `top_level_2` Move ad-hoc code meant to ease debugging of bootstrap (and batch mode) to `top_level_2` so it doesn't pollute `signal_or_quit`. * src/lisp.h (pop_handler, push_handler_bind): Declare. * src/keyboard.c (top_level_2): Setup an error handler to call `debug-early` when noninteractive. * src/eval.c (pop_handler): Not static any more. (signal_or_quit): Remove special case for noninteractive use. (push_handler_bind): New function, extracted from `Fhandler_bind_1`. (Fhandler_bind_1): Use it. (syms_of_eval): Declare `Qdebug_early__handler`. * lisp/emacs-lisp/debug-early.el (debug-early-backtrace): Weed out frames below `debug-early`. (debug-early--handler): New function. --- lisp/emacs-lisp/debug-early.el | 4 ++++ src/eval.c | 38 ++++++++++++++------------------------ src/keyboard.c | 12 +++++++++++- src/lisp.h | 2 ++ 4 files changed, 31 insertions(+), 25 deletions(-) diff --git a/lisp/emacs-lisp/debug-early.el b/lisp/emacs-lisp/debug-early.el index f2eb8792bfa..464c2e96927 100644 --- a/lisp/emacs-lisp/debug-early.el +++ b/lisp/emacs-lisp/debug-early.el @@ -94,4 +94,8 @@ available before `debug' was usable.)" (prin1 (cdr (car (cdr args)))) ; The error data. (debug-early-backtrace))) +(defalias 'debug-early--handler ;Called from C. + #'(lambda (err) + (if backtrace-on-error-noninteractive (debug-early 'error err)))) + ;;; debug-early.el ends here. diff --git a/src/eval.c b/src/eval.c index 595267f7686..7e578a1aa05 100644 --- a/src/eval.c +++ b/src/eval.c @@ -317,6 +317,7 @@ call_debugger (Lisp_Object arg) /* Interrupting redisplay and resuming it later is not safe under all circumstances. So, when the debugger returns, abort the interrupted redisplay by going back to the top-level. */ + /* FIXME: Move this to the redisplay code? */ if (debug_while_redisplaying && !EQ (Vdebugger, Qdebug_early)) Ftop_level (); @@ -1198,7 +1199,7 @@ usage: (catch TAG BODY...) */) #define clobbered_eassert(E) verify (sizeof (E) != 0) -static void +void pop_handler (void) { handlerlist = handlerlist->next; @@ -1367,6 +1368,16 @@ usage: (condition-case VAR BODYFORM &rest HANDLERS) */) return internal_lisp_condition_case (var, bodyform, handlers); } +void +push_handler_bind (Lisp_Object conditions, Lisp_Object handler, int skip) +{ + if (!CONSP (conditions)) + conditions = Fcons (conditions, Qnil); + struct handler *c = push_handler (conditions, HANDLER_BIND); + c->val = handler; + c->bytecode_dest = skip; +} + DEFUN ("handler-bind-1", Fhandler_bind_1, Shandler_bind_1, 1, MANY, 0, doc: /* Setup error handlers around execution of BODYFUN. BODYFUN be a function and it is called with no arguments. @@ -1392,11 +1403,7 @@ usage: (handler-bind BODYFUN [CONDITIONS HANDLER]...) */) Lisp_Object conditions = args[i], handler = args[i + 1]; if (NILP (conditions)) continue; - else if (!CONSP (conditions)) - conditions = Fcons (conditions, Qnil); - struct handler *c = push_handler (conditions, HANDLER_BIND); - c->val = handler; - c->bytecode_dest = count++; + push_handler_bind (conditions, handler, count++); } Lisp_Object ret = call0 (bodyfun); for (; count > 0; count--) @@ -1885,24 +1892,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) return Qnil; } - /* If we're in batch mode, print a backtrace unconditionally to help - with debugging. Make sure to use `debug-early' unconditionally - to not interfere with ERT or other packages that install custom - debuggers. */ - /* FIXME: This could be turned into a `handler-bind` at toplevel? */ - if (!debugger_called && !NILP (error_symbol) - && (NILP (clause) || EQ (clause, Qerror)) - && noninteractive && backtrace_on_error_noninteractive - && NILP (Vinhibit_debugger) - && !NILP (Ffboundp (Qdebug_early))) - { - max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); - specpdl_ref count = SPECPDL_INDEX (); - specbind (Qdebugger, Qdebug_early); - call_debugger (list2 (Qerror, Fcons (error_symbol, data))); - unbind_to (count, Qnil); - } - /* If an error is signaled during a Lisp hook in redisplay, write a backtrace into the buffer *Redisplay-trace*. */ /* FIXME: Turn this into a `handler-bind` installed during redisplay? */ @@ -4392,6 +4381,7 @@ before making `inhibit-quit' nil. */); DEFSYM (QCdocumentation, ":documentation"); DEFSYM (Qdebug, "debug"); DEFSYM (Qdebug_early, "debug-early"); + DEFSYM (Qdebug_early__handler, "debug-early--handler"); DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger, doc: /* Non-nil means never enter the debugger. diff --git a/src/keyboard.c b/src/keyboard.c index 4555b71abe7..816147c9130 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1163,7 +1163,17 @@ command_loop_2 (Lisp_Object handlers) static Lisp_Object top_level_2 (void) { - return Feval (Vtop_level, Qnil); + /* If we're in batch mode, print a backtrace unconditionally when + encountering an error, to help with debugging. */ + bool setup_handler = noninteractive; + if (setup_handler) + push_handler_bind (list1 (Qerror), Qdebug_early__handler, 0); + + Lisp_Object res = Feval (Vtop_level, Qnil); + + if (setup_handler) + pop_handler (); + return res; } static Lisp_Object diff --git a/src/lisp.h b/src/lisp.h index 2b30326abfc..0e082d14a40 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4570,6 +4570,8 @@ extern Lisp_Object internal_condition_case_n extern Lisp_Object internal_catch_all (Lisp_Object (*) (void *), void *, Lisp_Object (*) (enum nonlocal_exit, Lisp_Object)); extern struct handler *push_handler (Lisp_Object, enum handlertype) ATTRIBUTE_RETURNS_NONNULL; +extern void pop_handler (void); +extern void push_handler_bind (Lisp_Object, Lisp_Object, int); extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype); extern void specbind (Lisp_Object, Lisp_Object); extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object); -- cgit v1.2.3 From a5dcc1abea32abc906abfb66599c280b01d6ba27 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 25 Dec 2023 23:55:53 -0500 Subject: (macroexp--with-extended-form-stack): Use plain `let` `macroexp--with-extended-form-stack` used manual push/pop so that upon non-local exits the "deeper" value is kept, so the error handler gets to know what was the deeper value, so as to be able to compute more precise error locations. Replace this with a `handler-bind` which catches that "deeper" value more explicitly. * lisp/emacs-lisp/bytecomp.el (bytecomp--displaying-warnings): Use `handler-bind` to catch the value of `byte-compile-form-stack` at the time of the error. Also consolidate the duplicated code. * lisp/emacs-lisp/macroexp.el (macroexp--with-extended-form-stack): Use a plain dynbound let-rebinding. --- lisp/emacs-lisp/bytecomp.el | 41 +++++++++++++++++++++++------------------ lisp/emacs-lisp/macroexp.el | 10 ++-------- 2 files changed, 25 insertions(+), 26 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1ef3f0fba6d..e36a79aaa8e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1874,39 +1874,44 @@ It is too wide if it has any lines longer than the largest of (setq byte-to-native-plist-environment overriding-plist-environment))))) -(defmacro displaying-byte-compile-warnings (&rest body) +(defmacro displaying-byte-compile-warnings (&rest body) ;FIXME: Namespace! (declare (debug (def-body))) `(bytecomp--displaying-warnings (lambda () ,@body))) (defun bytecomp--displaying-warnings (body-fn) - (let* ((warning-series-started + (let* ((wrapped-body + (lambda () + (if byte-compile-debug + (funcall body-fn) + ;; Use a `handler-bind' to remember the `byte-compile-form-stack' + ;; active at the time the error is signaled, so as to + ;; get more precise error locations. + (let ((form-stack nil)) + (condition-case error-info + (handler-bind + ((error (lambda (_err) + (setq form-stack byte-compile-form-stack)))) + (funcall body-fn)) + (error (let ((byte-compile-form-stack form-stack)) + (byte-compile-report-error error-info)))))))) + (warning-series-started (and (markerp warning-series) (eq (marker-buffer warning-series) (get-buffer byte-compile-log-buffer)))) (byte-compile-form-stack byte-compile-form-stack)) - (if (or (eq warning-series 'byte-compile-warning-series) + (if (or (eq warning-series #'byte-compile-warning-series) warning-series-started) ;; warning-series does come from compilation, ;; so don't bind it, but maybe do set it. - (let (tem) - ;; Log the file name. Record position of that text. - (setq tem (byte-compile-log-file)) + (let ((tem (byte-compile-log-file))) ;; Log the file name. (unless warning-series-started - (setq warning-series (or tem 'byte-compile-warning-series))) - (if byte-compile-debug - (funcall body-fn) - (condition-case error-info - (funcall body-fn) - (error (byte-compile-report-error error-info))))) + (setq warning-series (or tem #'byte-compile-warning-series))) + (funcall wrapped-body)) ;; warning-series does not come from compilation, so bind it. (let ((warning-series ;; Log the file name. Record position of that text. - (or (byte-compile-log-file) 'byte-compile-warning-series))) - (if byte-compile-debug - (funcall body-fn) - (condition-case error-info - (funcall body-fn) - (error (byte-compile-report-error error-info)))))))) + (or (byte-compile-log-file) #'byte-compile-warning-series))) + (funcall wrapped-body))))) ;;;###autoload (defun byte-force-recompile (directory) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 0e4fd3ea521..b87b749dd76 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -42,14 +42,8 @@ condition-case handling a signaled error.") (defmacro macroexp--with-extended-form-stack (expr &rest body) "Evaluate BODY with EXPR pushed onto `byte-compile-form-stack'." (declare (indent 1)) - ;; FIXME: We really should just be using a simple dynamic let-binding here, - ;; but these explicit push and pop make the extended stack value visible - ;; to error handlers. Remove that need for that! - `(progn - (push ,expr byte-compile-form-stack) - (prog1 - (progn ,@body) - (pop byte-compile-form-stack)))) + `(let ((byte-compile-form-stack (cons ,expr byte-compile-form-stack))) + ,@body)) ;; Bound by the top-level `macroexpand-all', and modified to include any ;; macros defined by `defmacro'. -- cgit v1.2.3 From 02edbc88a1210b8d5a3e62ca4f03ffd17b23cbf7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 26 Dec 2023 23:56:09 -0500 Subject: eval.c: Add new var `lisp-eval-depth-reserve` Rather than blindly increase `max-lisp-eval-depth` when entering the debugger or running `signal-hook-function`, use this new "reserve" to keep track of how much we have grown the stack for "debugger" purposes so that for example recursive calls to `signal-hook-function` can't eat up the whole C stack. * src/eval.c (max_ensure_room): Rewrite. (restore_stack_limits): Move before `max_ensure_room`. Rewrite. (call_debugger, signal_or_quit): Adjust calls accordingly. Also grow `max-lisp-eval-depth` for `hander-bind` handlers. (init_eval_once): Don't initialize `max_lisp_eval_depth` here. (syms_of_eval): Initialize it here instead. Add new var `lisp-eval-depth-reserve`. * doc/lispref/eval.texi (Eval): Add `lisp-eval-depth-reserve`. --- doc/lispref/eval.texi | 19 +++++++++++++++--- etc/NEWS | 5 +++++ src/eval.c | 55 ++++++++++++++++++++++++++++++--------------------- 3 files changed, 53 insertions(+), 26 deletions(-) diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi index f4c99640143..b42020f43af 100644 --- a/doc/lispref/eval.texi +++ b/doc/lispref/eval.texi @@ -844,11 +844,24 @@ function body forms, as well as explicit calls in Lisp code. The default value of this variable is 1600. If you set it to a value less than 100, Lisp will reset it to 100 if the given value is -reached. Entry to the Lisp debugger increases the value, if there is -little room left, to make sure the debugger itself has room to -execute. +reached. @end defopt +@defopt lisp-eval-depth-reserve +In order to be able to debug infinite recursion errors, when invoking the +Lisp debugger, Emacs increases temporarily the value of +@code{max-lisp-eval-depth}, if there is little room left, to make sure +the debugger itself has room to execute. The same happens when +running the handler of a @code{handler-bind}. @xref{Handling Errors}. + +The variable @code{lisp-eval-depth-reserve} bounds the extra depth +that Emacs can add to @code{max-lisp-eval-depth} for those +exceptional circumstances. + +The default value of this variable is 200. +@end defopt + + @defvar values The value of this variable is a list of the values returned by all the expressions that were read, evaluated, and printed from buffers diff --git a/etc/NEWS b/etc/NEWS index db3b838c380..7bbfbf9512d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1395,6 +1395,11 @@ This is like 'require', but it checks whether the argument 'feature' is already loaded, in which case it either signals an error or forcibly reloads the file that defines the feature. ++++ +** New variable 'lisp-eval-depth-reserve'. +It puts a limit to the amount by which Emacs can temporarily increase +'max-lisp-eval-depth' when handling signals. + +++ ** New special form 'handler-bind'. Provides a functionality similar to `condition-case` except it runs the diff --git a/src/eval.c b/src/eval.c index 7e578a1aa05..b982c124184 100644 --- a/src/eval.c +++ b/src/eval.c @@ -212,7 +212,6 @@ void init_eval_once (void) { /* Don't forget to update docs (lispref node "Eval"). */ - max_lisp_eval_depth = 1600; Vrun_hooks = Qnil; pdumper_do_now_and_after_load (init_eval_once_for_pdumper); } @@ -248,22 +247,29 @@ init_eval (void) redisplay_deep_handler = NULL; } -/* Ensure that *M is at least A + B if possible, or is its maximum - value otherwise. */ - static void -max_ensure_room (intmax_t *m, intmax_t a, intmax_t b) +restore_stack_limits (Lisp_Object data) { - intmax_t sum = ckd_add (&sum, a, b) ? INTMAX_MAX : sum; - *m = max (*m, sum); + intmax_t old_depth; + integer_to_intmax (data, &old_depth); + lisp_eval_depth_reserve += max_lisp_eval_depth - old_depth; + max_lisp_eval_depth = old_depth; } -/* Unwind-protect function used by call_debugger. */ +/* Try and ensure that we have at least B dpeth available. */ static void -restore_stack_limits (Lisp_Object data) +max_ensure_room (intmax_t b) { - integer_to_intmax (data, &max_lisp_eval_depth); + intmax_t sum = ckd_add (&sum, lisp_eval_depth, b) ? INTMAX_MAX : sum; + intmax_t diff = min (sum - max_lisp_eval_depth, lisp_eval_depth_reserve); + if (diff <= 0) + return; + intmax_t old_depth = max_lisp_eval_depth; + max_lisp_eval_depth += diff; + lisp_eval_depth_reserve -= diff; + /* Restore limits after leaving the debugger. */ + record_unwind_protect (restore_stack_limits, make_int (old_depth)); } /* Call the Lisp debugger, giving it argument ARG. */ @@ -274,16 +280,12 @@ call_debugger (Lisp_Object arg) bool debug_while_redisplaying; specpdl_ref count = SPECPDL_INDEX (); Lisp_Object val; - intmax_t old_depth = max_lisp_eval_depth; /* The previous value of 40 is too small now that the debugger prints using cl-prin1 instead of prin1. Printing lists nested 8 deep (which is the value of print-level used in the debugger) currently requires 77 additional frames. See bug#31919. */ - max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); - - /* Restore limits after leaving the debugger. */ - record_unwind_protect (restore_stack_limits, make_int (old_depth)); + max_ensure_room (100); #ifdef HAVE_WINDOW_SYSTEM if (display_hourglass_p) @@ -1802,16 +1804,13 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) /* This hook is used by edebug. */ if (! NILP (Vsignal_hook_function) - && ! NILP (error_symbol) - /* Don't try to call a lisp function if we've already overflowed - the specpdl stack. */ - && specpdl_ptr < specpdl_end) + && ! NILP (error_symbol)) { - /* Edebug takes care of restoring these variables when it exits. */ - max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 20); - + specpdl_ref count = SPECPDL_INDEX (); + max_ensure_room (20); /* FIXME: 'handler-bind' makes `signal-hook-function' obsolete? */ call2 (Vsignal_hook_function, error_symbol, data); + unbind_to (count, Qnil); } conditions = Fget (real_error_symbol, Qerror_conditions); @@ -1849,9 +1848,12 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) Lisp_Object error_data = (NILP (error_symbol) ? data : Fcons (error_symbol, data)); + specpdl_ref count = SPECPDL_INDEX (); + max_ensure_room (20); push_handler (make_fixnum (skip + h->bytecode_dest), SKIP_CONDITIONS); call1 (h->val, error_data); + unbind_to (count, Qnil); pop_handler (); } continue; @@ -1901,8 +1903,8 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) && NILP (Vinhibit_debugger) && !NILP (Ffboundp (Qdebug_early))) { - max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); specpdl_ref count = SPECPDL_INDEX (); + max_ensure_room (100); AUTO_STRING (redisplay_trace, "*Redisplay-trace*"); Lisp_Object redisplay_trace_buffer; AUTO_STRING (gap, "\n\n\n\n"); /* Separates things in *Redisplay-trace* */ @@ -4345,6 +4347,13 @@ actual stack overflow in C, which would be fatal for Emacs. You can safely make it considerably larger than its default value, if that proves inconveniently small. However, if you increase it too far, Emacs could overflow the real C stack, and crash. */); + max_lisp_eval_depth = 1600; + + DEFVAR_INT ("lisp-eval-depth-reserve", lisp_eval_depth_reserve, + doc: /* Extra depth that can be allocated to handle errors. +This is the max depth that the system will add to `max-lisp-eval-depth' +when calling debuggers or `handler-bind' handlers. */); + lisp_eval_depth_reserve = 200; DEFVAR_LISP ("quit-flag", Vquit_flag, doc: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil. -- cgit v1.2.3 From 2ef6e40da88d5b4f070e339a2210f5751ab6a7cb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 27 Dec 2023 15:06:32 -0500 Subject: (signal_or_quit): Preserve error object identity Make sure we build the (ERROR-SYMBOL . ERROR-DATA) object only once when signaling an error, so that its `eq` identity can be used. It also gets us a tiny bit closer to having real "error objects" like in most other current programming languages. * src/eval.c (maybe_call_debugger): Change arglist to receive the error object instead of receiving the signal and the data separately. (signal_or_quit): Build the error object right at the beginning so it stays `eq` to itself. Rename the `keyboard_quit` arg to `continuable` so say what it does rather than what it's used for. (signal_quit_p): Change arg to be the error object rather than just the error-symbol. * src/keyboard.c (cmd_error_internal, menu_item_eval_property_1): Adjust calls to `signal_quit_p` accordingly. * test/src/eval-tests.el (eval-tests--error-id): New test. --- src/eval.c | 66 +++++++++++++++++++++++--------------------------- src/keyboard.c | 4 +-- test/src/eval-tests.el | 10 ++++++++ 3 files changed, 42 insertions(+), 38 deletions(-) diff --git a/src/eval.c b/src/eval.c index b982c124184..1dd797063eb 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1706,8 +1706,7 @@ push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype) static Lisp_Object signal_or_quit (Lisp_Object, Lisp_Object, bool); static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object); -static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, - Lisp_Object data); +static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object error); static void process_quit_flag (void) @@ -1773,20 +1772,25 @@ quit (void) bool backtrace_yet = false; /* Signal an error, or quit. ERROR_SYMBOL and DATA are as with Fsignal. - If KEYBOARD_QUIT, this is a quit; ERROR_SYMBOL should be - Qquit and DATA should be Qnil, and this function may return. + If CONTINUABLE, the caller allows this function to return + (presumably after calling the debugger); Otherwise this function is like Fsignal and does not return. */ static Lisp_Object -signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) +signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable) { /* When memory is full, ERROR-SYMBOL is nil, and DATA is (REAL-ERROR-SYMBOL . REAL-DATA). That is a special case--don't do this in other situations. */ + bool oom = NILP (error_symbol); + Lisp_Object error /* The error object. */ + = oom ? data + : (!SYMBOLP (error_symbol) && NILP (data)) ? error_symbol + : Fcons (error_symbol, data); Lisp_Object conditions; Lisp_Object string; Lisp_Object real_error_symbol - = (NILP (error_symbol) ? Fcar (data) : error_symbol); + = CONSP (error) ? XCAR (error) : error_symbol; Lisp_Object clause = Qnil; struct handler *h; int skip; @@ -1804,11 +1808,13 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) /* This hook is used by edebug. */ if (! NILP (Vsignal_hook_function) - && ! NILP (error_symbol)) + && !oom) { specpdl_ref count = SPECPDL_INDEX (); max_ensure_room (20); /* FIXME: 'handler-bind' makes `signal-hook-function' obsolete? */ + /* FIXME: Here we still "split" the error object + into its error-symbol and its error-data? */ call2 (Vsignal_hook_function, error_symbol, data); unbind_to (count, Qnil); } @@ -1820,7 +1826,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) too. Don't do this when ERROR_SYMBOL is nil, because that is a memory-full error. */ Vsignaling_function = Qnil; - if (!NILP (error_symbol)) + if (!oom) { union specbinding *pdl = backtrace_next (backtrace_top ()); if (backtrace_p (pdl) && EQ (backtrace_function (pdl), Qerror)) @@ -1845,14 +1851,11 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) { if (!NILP (find_handler_clause (h->tag_or_ch, conditions))) { - Lisp_Object error_data - = (NILP (error_symbol) - ? data : Fcons (error_symbol, data)); specpdl_ref count = SPECPDL_INDEX (); max_ensure_room (20); push_handler (make_fixnum (skip + h->bytecode_dest), SKIP_CONDITIONS); - call1 (h->val, error_data); + call1 (h->val, error); unbind_to (count, Qnil); pop_handler (); } @@ -1875,7 +1878,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) bool debugger_called = false; if (/* Don't run the debugger for a memory-full error. (There is no room in memory to do that!) */ - !NILP (error_symbol) + !oom && (!NILP (Vdebug_on_signal) /* If no handler is present now, try to run the debugger. */ || NILP (clause) @@ -1887,17 +1890,17 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) || EQ (clause, Qerror))) { debugger_called - = maybe_call_debugger (conditions, error_symbol, data); + = maybe_call_debugger (conditions, error); /* We can't return values to code which signaled an error, but we can continue code which has signaled a quit. */ - if (keyboard_quit && debugger_called && EQ (real_error_symbol, Qquit)) + if (continuable && debugger_called) return Qnil; } /* If an error is signaled during a Lisp hook in redisplay, write a backtrace into the buffer *Redisplay-trace*. */ /* FIXME: Turn this into a `handler-bind` installed during redisplay? */ - if (!debugger_called && !NILP (error_symbol) + if (!debugger_called && !oom && backtrace_on_redisplay_error && (NILP (clause) || h == redisplay_deep_handler) && NILP (Vinhibit_debugger) @@ -1918,7 +1921,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) backtrace_yet = true; specbind (Qstandard_output, redisplay_trace_buffer); specbind (Qdebugger, Qdebug_early); - call_debugger (list2 (Qerror, Fcons (error_symbol, data))); + call_debugger (list2 (Qerror, error)); unbind_to (count, Qnil); delayed_warning = make_string ("Error in a redisplay Lisp hook. See buffer *Redisplay-trace*", 61); @@ -1929,10 +1932,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) if (!NILP (clause)) { - Lisp_Object unwind_data - = (NILP (error_symbol) ? data : Fcons (error_symbol, data)); - - unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, unwind_data); + unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, error); } else { @@ -1943,10 +1943,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) Fthrow (Qtop_level, Qt); } - if (! NILP (error_symbol)) - data = Fcons (error_symbol, data); - - string = Ferror_message_string (data); + string = Ferror_message_string (error); fatal ("%s", SDATA (string)); } @@ -2071,14 +2068,15 @@ skip_debugger (Lisp_Object conditions, Lisp_Object data) return 0; } -/* Say whether SIGNAL is a `quit' symbol (or inherits from it). */ +/* Say whether SIGNAL is a `quit' error (or inherits from it). */ bool -signal_quit_p (Lisp_Object signal) +signal_quit_p (Lisp_Object error) { + Lisp_Object signal = CONSP (error) ? XCAR (error) : Qnil; Lisp_Object list; return EQ (signal, Qquit) - || (!NILP (Fsymbolp (signal)) + || (SYMBOLP (signal) && CONSP (list = Fget (signal, Qerror_conditions)) && !NILP (Fmemq (Qquit, list))); } @@ -2089,27 +2087,23 @@ signal_quit_p (Lisp_Object signal) = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA). This is for memory-full errors only. */ static bool -maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data) +maybe_call_debugger (Lisp_Object conditions, Lisp_Object error) { - Lisp_Object combined_data; - - combined_data = Fcons (sig, data); - if ( /* Don't try to run the debugger with interrupts blocked. The editing loop would return anyway. */ ! input_blocked_p () && NILP (Vinhibit_debugger) /* Does user want to enter debugger for this kind of error? */ - && (signal_quit_p (sig) + && (signal_quit_p (error) ? debug_on_quit : wants_debugger (Vdebug_on_error, conditions)) - && ! skip_debugger (conditions, combined_data) + && ! skip_debugger (conditions, error) /* See commentary on definition of `internal-when-entered-debugger'. */ && when_entered_debugger < num_nonmacro_input_events) { - call_debugger (list2 (Qerror, combined_data)); + call_debugger (list2 (Qerror, error)); return 1; } diff --git a/src/keyboard.c b/src/keyboard.c index 816147c9130..aa7d732bcc3 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1026,7 +1026,7 @@ cmd_error_internal (Lisp_Object data, const char *context) { /* The immediate context is not interesting for Quits, since they are asynchronous. */ - if (signal_quit_p (XCAR (data))) + if (signal_quit_p (data)) Vsignaling_function = Qnil; Vquit_flag = Qnil; @@ -8619,7 +8619,7 @@ menu_item_eval_property_1 (Lisp_Object arg) { /* If we got a quit from within the menu computation, quit all the way out of it. This takes care of C-] in the debugger. */ - if (CONSP (arg) && signal_quit_p (XCAR (arg))) + if (signal_quit_p (arg)) quit (); return Qnil; diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index 9ac117859dd..e1c90feb09a 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -340,4 +340,14 @@ expressions works for identifiers starting with period." (error 'plain-error)) 'wrong-type-argument))) +(ert-deftest eval-tests--error-id () + (let* (inner-error + (outer-error + (condition-case err + (handler-bind ((error (lambda (err) (setq inner-error err)))) + (car 1)) + (error err)))) + (should (eq inner-error outer-error)))) + + ;;; eval-tests.el ends here -- cgit v1.2.3 From 391c208aecc44fd82c599696d47a18782f2f36da Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 25 Dec 2023 21:41:08 -0500 Subject: (backtrace-on-redisplay-error): Use `handler-bind` Reimplement `backtrace-on-redisplay-error` using `push_handler_bind`. This moves the code from `signal_or_quit` to `xdisp.c` and `debug-early.el`. * lisp/emacs-lisp/debug-early.el (debug-early-backtrace): Add `base` arg to strip "internal" frames. (debug--early): New function, extracted from `debug-early`. (debug-early, debug-early--handler): Use it. (debug-early--muted): New function, extracted (translated) from `signal_or_quit`; trim the buffer to a max of 10 backtraces. * src/xdisp.c (funcall_with_backtraces): New function. (dsafe_calln): Use it. (syms_of_xdisp): Defsym `Qdebug_early__muted`. * src/eval.c (redisplay_deep_handler): Delete var. (init_eval, internal_condition_case_n): Don't set it any more. (backtrace_yet): Delete var. (signal_or_quit): Remove special case for `backtrace_on_redisplay_error`. * src/keyboard.c (command_loop_1): Don't set `backtrace_yet` any more. * src/lisp.h (backtrace_yet): Don't declare. --- lisp/emacs-lisp/debug-early.el | 83 +++++++++++++++++++++++++++++------------- src/eval.c | 67 +++------------------------------- src/keyboard.c | 4 +- src/lisp.h | 1 - src/xdisp.c | 20 +++++++++- 5 files changed, 84 insertions(+), 91 deletions(-) diff --git a/lisp/emacs-lisp/debug-early.el b/lisp/emacs-lisp/debug-early.el index 464c2e96927..8a0dddc2679 100644 --- a/lisp/emacs-lisp/debug-early.el +++ b/lisp/emacs-lisp/debug-early.el @@ -27,14 +27,17 @@ ;; This file dumps a backtrace on stderr when an error is thrown. It ;; has no dependencies on any Lisp libraries and is thus used for ;; generating backtraces for bugs in the early parts of bootstrapping. -;; It is also always used in batch model. It was introduced in Emacs +;; It is also always used in batch mode. It was introduced in Emacs ;; 29, before which there was no backtrace available during early ;; bootstrap. ;;; Code: +;; For bootstrap reasons, we cannot use any macros here since they're +;; not defined yet. + (defalias 'debug-early-backtrace - #'(lambda () + #'(lambda (&optional base) "Print a trace of Lisp function calls currently active. The output stream used is the value of `standard-output'. @@ -51,26 +54,39 @@ of the build process." (require 'cl-print) (error nil))) #'cl-prin1 - #'prin1))) + #'prin1)) + (first t)) (mapbacktrace #'(lambda (evald func args _flags) - (let ((args args)) - (if evald + (if first + ;; The first is the debug-early entry point itself. + (setq first nil) + (let ((args args)) + (if evald + (progn + (princ " ") + (funcall prin1 func) + (princ "(")) (progn - (princ " ") - (funcall prin1 func) - (princ "(")) - (progn - (princ " (") - (setq args (cons func args)))) - (if args - (while (progn - (funcall prin1 (car args)) - (setq args (cdr args))) - (princ " "))) - (princ ")\n"))))))) - -(defalias 'debug-early + (princ " (") + (setq args (cons func args)))) + (if args + (while (progn + (funcall prin1 (car args)) + (setq args (cdr args))) + (princ " "))) + (princ ")\n")))) + base)))) + +(defalias 'debug--early + #'(lambda (error base) + (princ "\nError: ") + (prin1 (car error)) ; The error symbol. + (princ " ") + (prin1 (cdr error)) ; The error data. + (debug-early-backtrace base))) + +(defalias 'debug-early ;Called from C. #'(lambda (&rest args) "Print an error message with a backtrace of active Lisp function calls. The output stream used is the value of `standard-output'. @@ -88,14 +104,31 @@ support the latter, except in batch mode which always uses \(In versions of Emacs prior to Emacs 29, no backtrace was available before `debug' was usable.)" - (princ "\nError: ") - (prin1 (car (car (cdr args)))) ; The error symbol. - (princ " ") - (prin1 (cdr (car (cdr args)))) ; The error data. - (debug-early-backtrace))) + (debug--early (car (cdr args)) #'debug-early))) ; The error object. (defalias 'debug-early--handler ;Called from C. #'(lambda (err) - (if backtrace-on-error-noninteractive (debug-early 'error err)))) + (if backtrace-on-error-noninteractive + (debug--early err #'debug-early--handler)))) + +(defalias 'debug-early--muted ;Called from C. + #'(lambda (err) + (save-current-buffer + (set-buffer (get-buffer-create "*Redisplay-trace*")) + (goto-char (point-max)) + (if (bobp) nil + (let ((separator "\n\n\n\n")) + (save-excursion + ;; The C code tested `backtrace_yet', instead we + ;; keep a max of 10 backtraces. + (if (search-backward separator nil t 10) + (delete-region (point-min) (match-end 0)))) + (insert separator))) + (insert "-- Caught at " (current-time-string) "\n") + (let ((standard-output (current-buffer))) + (debug--early err #'debug-early--muted)) + (setq delayed-warnings-list + (cons '(error "Error in a redisplay Lisp hook. See buffer *Redisplay-trace*") + delayed-warnings-list))))) ;;; debug-early.el ends here. diff --git a/src/eval.c b/src/eval.c index 1dd797063eb..94f6d8e31f8 100644 --- a/src/eval.c +++ b/src/eval.c @@ -57,12 +57,6 @@ Lisp_Object Vrun_hooks; /* FIXME: We should probably get rid of this! */ Lisp_Object Vsignaling_function; -/* The handler structure which will catch errors in Lisp hooks called - from redisplay. We do not use it for this; we compare it with the - handler which is about to be used in signal_or_quit, and if it - matches, cause a backtrace to be generated. */ -static struct handler *redisplay_deep_handler; - /* These would ordinarily be static, but they need to be visible to GDB. */ bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE; Lisp_Object *backtrace_args (union specbinding *) EXTERNALLY_VISIBLE; @@ -244,7 +238,6 @@ init_eval (void) lisp_eval_depth = 0; /* This is less than the initial value of num_nonmacro_input_events. */ when_entered_debugger = -1; - redisplay_deep_handler = NULL; } static void @@ -1611,16 +1604,12 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *), ptrdiff_t nargs, Lisp_Object *args)) { - struct handler *old_deep = redisplay_deep_handler; struct handler *c = push_handler (handlers, CONDITION_CASE); - if (redisplaying_p) - redisplay_deep_handler = c; if (sys_setjmp (c->jmp)) { Lisp_Object val = handlerlist->val; clobbered_eassert (handlerlist == c); handlerlist = handlerlist->next; - redisplay_deep_handler = old_deep; return hfun (val, nargs, args); } else @@ -1628,7 +1617,6 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *), Lisp_Object val = bfun (nargs, args); eassert (handlerlist == c); handlerlist = c->next; - redisplay_deep_handler = old_deep; return val; } } @@ -1766,11 +1754,6 @@ quit (void) return signal_or_quit (Qquit, Qnil, true); } -/* Has an error in redisplay giving rise to a backtrace occurred as - yet in the current command? This gets reset in the command - loop. */ -bool backtrace_yet = false; - /* Signal an error, or quit. ERROR_SYMBOL and DATA are as with Fsignal. If CONTINUABLE, the caller allows this function to return (presumably after calling the debugger); @@ -1897,51 +1880,13 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable) return Qnil; } - /* If an error is signaled during a Lisp hook in redisplay, write a - backtrace into the buffer *Redisplay-trace*. */ - /* FIXME: Turn this into a `handler-bind` installed during redisplay? */ - if (!debugger_called && !oom - && backtrace_on_redisplay_error - && (NILP (clause) || h == redisplay_deep_handler) - && NILP (Vinhibit_debugger) - && !NILP (Ffboundp (Qdebug_early))) - { - specpdl_ref count = SPECPDL_INDEX (); - max_ensure_room (100); - AUTO_STRING (redisplay_trace, "*Redisplay-trace*"); - Lisp_Object redisplay_trace_buffer; - AUTO_STRING (gap, "\n\n\n\n"); /* Separates things in *Redisplay-trace* */ - Lisp_Object delayed_warning; - redisplay_trace_buffer = Fget_buffer_create (redisplay_trace, Qnil); - current_buffer = XBUFFER (redisplay_trace_buffer); - if (!backtrace_yet) /* Are we on the first backtrace of the command? */ - Ferase_buffer (); - else - Finsert (1, &gap); - backtrace_yet = true; - specbind (Qstandard_output, redisplay_trace_buffer); - specbind (Qdebugger, Qdebug_early); - call_debugger (list2 (Qerror, error)); - unbind_to (count, Qnil); - delayed_warning = make_string - ("Error in a redisplay Lisp hook. See buffer *Redisplay-trace*", 61); - - Vdelayed_warnings_list = Fcons (list2 (Qerror, delayed_warning), - Vdelayed_warnings_list); - } - if (!NILP (clause)) - { - unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, error); - } - else - { - if (handlerlist != handlerlist_sentinel) - /* FIXME: This will come right back here if there's no `top-level' - catcher. A better solution would be to abort here, and instead - add a catch-all condition handler so we never come here. */ - Fthrow (Qtop_level, Qt); - } + unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, error); + else if (handlerlist != handlerlist_sentinel) + /* FIXME: This will come right back here if there's no `top-level' + catcher. A better solution would be to abort here, and instead + add a catch-all condition handler so we never come here. */ + Fthrow (Qtop_level, Qt); string = Ferror_message_string (error); fatal ("%s", SDATA (string)); diff --git a/src/keyboard.c b/src/keyboard.c index aa7d732bcc3..e1d738dd6ef 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1167,9 +1167,10 @@ top_level_2 (void) encountering an error, to help with debugging. */ bool setup_handler = noninteractive; if (setup_handler) + /* FIXME: Should we (re)use `list_of_error` from `xdisp.c`? */ push_handler_bind (list1 (Qerror), Qdebug_early__handler, 0); - Lisp_Object res = Feval (Vtop_level, Qnil); + Lisp_Object res = Feval (Vtop_level, Qt); if (setup_handler) pop_handler (); @@ -1365,7 +1366,6 @@ command_loop_1 (void) display_malloc_warning (); Vdeactivate_mark = Qnil; - backtrace_yet = false; /* Don't ignore mouse movements for more than a single command loop. (This flag is set in xdisp.c whenever the tool bar is diff --git a/src/lisp.h b/src/lisp.h index 0e082d14a40..44f69892c6f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4529,7 +4529,6 @@ extern Lisp_Object Vrun_hooks; extern Lisp_Object Vsignaling_function; extern Lisp_Object inhibit_lisp_code; extern bool signal_quit_p (Lisp_Object); -extern bool backtrace_yet; /* To run a normal hook, use the appropriate function from the list below. The calling convention: diff --git a/src/xdisp.c b/src/xdisp.c index aeaf8b34652..f8670c6ecb5 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3072,10 +3072,24 @@ dsafe__call (bool inhibit_quit, Lisp_Object (f) (ptrdiff_t, Lisp_Object *), return val; } +static Lisp_Object +funcall_with_backtraces (ptrdiff_t nargs, Lisp_Object *args) +{ + /* If an error is signaled during a Lisp hook in redisplay, write a + backtrace into the buffer *Redisplay-trace*. */ + push_handler_bind (list_of_error, Qdebug_early__muted, 0); + Lisp_Object res = Ffuncall (nargs, args); + pop_handler (); + return res; +} + #define SAFE_CALLMANY(inhibit_quit, f, array) \ dsafe__call ((inhibit_quit), f, ARRAYELTS (array), array) -#define dsafe_calln(inhibit_quit, ...) \ - SAFE_CALLMANY ((inhibit_quit), Ffuncall, ((Lisp_Object []) {__VA_ARGS__})) +#define dsafe_calln(inhibit_quit, ...) \ + SAFE_CALLMANY ((inhibit_quit), \ + backtrace_on_redisplay_error \ + ? funcall_with_backtraces : Ffuncall, \ + ((Lisp_Object []) {__VA_ARGS__})) static Lisp_Object dsafe_call1 (Lisp_Object f, Lisp_Object arg) @@ -37753,6 +37767,8 @@ cursor shapes. */); DEFSYM (Qthin_space, "thin-space"); DEFSYM (Qzero_width, "zero-width"); + DEFSYM (Qdebug_early__muted, "debug-early--muted"); + DEFVAR_LISP ("pre-redisplay-function", Vpre_redisplay_function, doc: /* Function run just before redisplay. It is called with one argument, which is the set of windows that are to -- cgit v1.2.3 From ae75333ca78f5c45e53e7e5d25f4e04a4d69ad8f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 4 Jan 2024 16:28:39 -0500 Subject: Improve `handler-bind` doc * doc/lispref/control.texi (Handling Errors) : Expand. * doc/lispref/variables.texi (Variable Scoping): Mention static scoping. --- doc/lispref/control.texi | 102 +++++++++++++++++++++++++++++++++++++++------ doc/lispref/variables.texi | 4 +- 2 files changed, 93 insertions(+), 13 deletions(-) diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 6cc25dcdaee..3c9f26262c1 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -1,6 +1,6 @@ @c -*- mode: texinfo; coding: utf-8 -*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990--1995, 1998--1999, 2001--2024 Free Software +@c Copyright (C) 1990--2024 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Control Structures @@ -2311,24 +2311,102 @@ form. In this case, the @code{handler-bind} has no effect. @code{(@var{conditions} @var{handler})} where @var{conditions} is an error condition name to be handled, or a list of condition names, and @var{handler} should be a form whose evaluation should return a function. +As with @code{condition-case}, condition names are symbols. Before running @var{body}, @code{handler-bind} evaluates all the @var{handler} forms and installs those handlers to be active during -the evaluation of @var{body}. These handlers are searched together -with those installed by @code{condition-case}. When the innermost +the evaluation of @var{body}. When an error is signaled, +Emacs searches all the active @code{condition-case} and +@code{handler-bind} forms for a handler that +specifies one or more of these condition names. When the innermost matching handler is one installed by @code{handler-bind}, the @var{handler} function is called with a single argument holding the error description. -@var{handler} is called in the dynamic context where the error -happened, without first unwinding the stack, meaning that all the -dynamic bindings are still in effect, except that all the error -handlers between the code that signaled the error and the -@code{handler-bind} are temporarily suspended. Like any normal -function, @var{handler} can exit non-locally, typically via -@code{throw}, or it can return normally. If @var{handler} returns -normally, it means the handler @emph{declined} to handle the error and -the search for an error handler is continued where it left off. +Contrary to what happens with @code{condition-case}, @var{handler} is +called in the dynamic context where the error happened. This means it +is executed unbinding any variable bindings or running any cleanups of +@code{unwind-protect}, so that all those dynamic bindings are still in +effect. There is one exception: while running the @var{handler} +function, all the error handlers between the code that signaled the +error and the @code{handler-bind} are temporarily suspended, meaning +that when an error is signaled, Emacs will only search the active +@code{condition-case} and @code{handler-bind} forms that are inside +the @var{handler} function or outside of the current +@code{handler-bind}. Note also that lexical variables are not +affected, since they do not have dynamic extent. + +Like any normal function, @var{handler} can exit non-locally, +typically via @code{throw}, or it can return normally. +If @var{handler} returns normally, it means the handler +@emph{declined} to handle the error and the search for an error +handler is continued where it left off. + +For example, if we wanted to keep a log of all the errors that occur +during the execution of a particular piece of code together with the +buffer that's current when the error is signaled, but without +otherwise affecting the behavior of that code, we can do it with: + +@example +@group +(handler-bind + ((error + (lambda (err) + (push (cons err (current-buffer)) my-log-of-errors)))) + @var{body-forms}@dots{}) +@end group +@end example + +This will log only those errors that are not caught internally to +@var{body-forms}@dots{}, in other words errors that ``escape'' from +@var{body-forms}@dots{}, and it will not prevent those errors from +being passed on to surrounding @code{condition-case} handlers (or +@code{handler-bind} handlers for that matter) since the above handler +returns normally. + +We can also use @code{handler-bind} to replace an error with another, +as in the code below which turns all errors of type @code{user-error} +that occur during the execution of @var{body-forms}@dots{} into plain +@code{error}: + +@example +@group +(handler-bind + ((user-error + (lambda (err) + (signal 'error (cdr err))))) + @var{body-forms}@dots{}) +@end group +@end example + +We can get almost the same result with @code{condition-case}: + +@example +@group +(condition-case err + (progn @var{body-forms}@dots{}) + (user-error (signal 'error (cdr err)))) +@end group +@end example + +@noindent +but with the difference that when we (re)signal the new error in +@code{handler-bind} the dynamic environment from the original error is +still active, which means for example that if we enter the +debugger at this point, it will show us a complete backtrace including +the point where we signaled the original error: + +@example +@group +Debugger entered--Lisp error: (error "Oops") + signal(error ("Oops")) + (closure (t) (err) (signal 'error (cdr err)))((user-error "Oops")) + user-error("Oops") + @dots{} + eval((handler-bind ((user-error (lambda (err) @dots{} +@end group +@end example + @end defmac @node Error Symbols diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 705d3260063..4d61d461deb 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990--1995, 1998--2024 Free Software Foundation, Inc. +@c Copyright (C) 1990--2024 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Variables @chapter Variables @@ -978,6 +978,7 @@ program is executing, the binding exists. @cindex lexical binding @cindex lexical scope +@cindex static scope @cindex indefinite extent For historical reasons, there are two dialects of Emacs Lisp, selected via the @code{lexical-binding} buffer-local variable. @@ -989,6 +990,7 @@ binding can also be accessed from the Lisp debugger.}. It also has @dfn{indefinite extent}, meaning that under some circumstances the binding can live on even after the binding construct has finished executing, by means of objects called @dfn{closures}. +Lexical scoping is also commonly called @dfn{static scoping}. @cindex dynamic binding @cindex dynamic scope -- cgit v1.2.3 From 1870e2f48a7874b9a7cd627198a6079d6a3b70c0 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 4 Jan 2024 18:44:43 -0500 Subject: Avoid `defconst` for vars which we modify If we `setq` or let-bind a var, then presumably it's not a const. * lisp/bookmark.el (bookmark-bmenu-buffer): * lisp/char-fold.el (char-fold-table): * lisp/pcmpl-linux.el (pcmpl-linux-fs-modules-path-format) (pcmpl-linux-mtab-file): * lisp/emacs-lisp/bytecomp.el (byte-compile-log-buffer): * lisp/emacs-lisp/check-declare.el (check-declare-warning-buffer): * lisp/emacs-lisp/ert-x.el (ert-remote-temporary-file-directory): * lisp/erc/erc.el (erc-default-port): * lisp/net/tramp.el (tramp-unknown-id-string) (tramp-unknown-id-integer): * lisp/url/url-util.el (url-unreserved-chars): --- lisp/bookmark.el | 2 +- lisp/char-fold.el | 2 +- lisp/emacs-lisp/bytecomp.el | 4 ++-- lisp/emacs-lisp/check-declare.el | 2 +- lisp/emacs-lisp/ert-x.el | 2 +- lisp/erc/erc.el | 2 +- lisp/net/tramp.el | 6 +++--- lisp/pcmpl-linux.el | 4 ++-- lisp/url/url-util.el | 2 +- 9 files changed, 13 insertions(+), 13 deletions(-) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 893fdffb7ce..60dd61a5ac8 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -142,7 +142,7 @@ Nil means don't prompt for confirmation." "Non-nil means show annotations when jumping to a bookmark." :type 'boolean) -(defconst bookmark-bmenu-buffer "*Bookmark List*" +(defvar bookmark-bmenu-buffer "*Bookmark List*" "Name of buffer used for Bookmark List.") (defvar bookmark-bmenu-use-header-line t diff --git a/lisp/char-fold.el b/lisp/char-fold.el index a620d4d8dc3..4d9644216d8 100644 --- a/lisp/char-fold.el +++ b/lisp/char-fold.el @@ -214,7 +214,7 @@ equiv)) equiv))) -(defconst char-fold-table +(defvar char-fold-table (eval-when-compile (char-fold--make-table)) "Used for folding characters of the same group during search. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1ef3f0fba6d..e940a135e51 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -262,7 +262,7 @@ This option is enabled by default because it reduces Emacs memory usage." :type 'boolean) ;;;###autoload(put 'byte-compile-dynamic-docstrings 'safe-local-variable 'booleanp) -(defconst byte-compile-log-buffer "*Compile-Log*" +(defvar byte-compile-log-buffer "*Compile-Log*" "Name of the byte-compiler's log buffer.") (defvar byte-compile--known-dynamic-vars nil @@ -1874,7 +1874,7 @@ It is too wide if it has any lines longer than the largest of (setq byte-to-native-plist-environment overriding-plist-environment))))) -(defmacro displaying-byte-compile-warnings (&rest body) +(defmacro displaying-byte-compile-warnings (&rest body) ;FIXME: namespace! (declare (debug (def-body))) `(bytecomp--displaying-warnings (lambda () ,@body))) diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el index 0362c7d2c24..8e40b227b65 100644 --- a/lisp/emacs-lisp/check-declare.el +++ b/lisp/emacs-lisp/check-declare.el @@ -40,7 +40,7 @@ ;;; Code: -(defconst check-declare-warning-buffer "*Check Declarations Warnings*" +(defvar check-declare-warning-buffer "*Check Declarations Warnings*" "Name of buffer used to display any `check-declare' warnings.") (defun check-declare-locate (file basefile) diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 05da0f1844e..a6d2fe4a1da 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -543,7 +543,7 @@ The same keyword arguments are supported as in ;; If this defconst is used in a test file, `tramp' shall be loaded ;; prior `ert-x'. There is no default value on w32 systems, which ;; could work out of the box. -(defconst ert-remote-temporary-file-directory +(defvar ert-remote-temporary-file-directory (when (featurep 'tramp) (cond ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY")) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 0565440f357..e639a6278fc 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1691,7 +1691,7 @@ Defaults to the server buffer." (defconst erc-default-server "irc.libera.chat" "IRC server to use if it cannot be detected otherwise.") -(defconst erc-default-port 6667 +(defvar erc-default-port 6667 "IRC port to use if it cannot be detected otherwise.") (defconst erc-default-port-tls 6697 diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 2f6b526039f..ad36dd53a32 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1085,10 +1085,10 @@ Derived from `tramp-postfix-host-format'.") (defconst tramp-localname-regexp (rx (* (not (any "\r\n"))) eos) "Regexp matching localnames.") -(defconst tramp-unknown-id-string "UNKNOWN" +(defvar tramp-unknown-id-string "UNKNOWN" "String used to denote an unknown user or group.") -(defconst tramp-unknown-id-integer -1 +(defvar tramp-unknown-id-integer -1 "Integer used to denote an unknown user or group.") ;;;###tramp-autoload @@ -2081,7 +2081,7 @@ without a visible progress reporter." (defmacro with-tramp-timeout (list &rest body) "Like `with-timeout', but allow SECONDS to be nil. -(fn (SECONDS TIMEOUT-FORMS...) BODY)" +\(fn (SECONDS TIMEOUT-FORMS...) BODY)" (declare (indent 1) (debug ((form body) body))) (let ((seconds (car list)) (timeout-forms (cdr list))) diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el index 3aee0b296f6..d0defc54174 100644 --- a/lisp/pcmpl-linux.el +++ b/lisp/pcmpl-linux.el @@ -61,7 +61,7 @@ (pcomplete-opt "hVanfFrsvwt(pcmpl-linux-fs-types)o?L?U?") (while (pcomplete-here (pcomplete-entries) nil #'identity))) -(defconst pcmpl-linux-fs-modules-path-format "/lib/modules/%s/kernel/fs/") +(defvar pcmpl-linux-fs-modules-path-format "/lib/modules/%s/kernel/fs/") (defun pcmpl-linux-fs-types () "Return a list of available fs modules on GNU/Linux systems." @@ -69,7 +69,7 @@ (directory-files (format pcmpl-linux-fs-modules-path-format kernel-ver)))) -(defconst pcmpl-linux-mtab-file "/etc/mtab") +(defvar pcmpl-linux-mtab-file "/etc/mtab") (defun pcmpl-linux-mounted-directories () "Return a list of mounted directory names." diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index 28d1885387d..5f45b98c7a5 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -335,7 +335,7 @@ appropriate coding-system; see `decode-coding-string'." str (substring str (match-end 0))))) (concat tmp str))) -(defconst url-unreserved-chars +(defvar url-unreserved-chars '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 -- cgit v1.2.3 From 1d40c601b3b77d3bf1ad1bdfbaf2f479ba9c4998 Mon Sep 17 00:00:00 2001 From: Graham Marlow Date: Tue, 2 Jan 2024 13:58:22 -0800 Subject: Improve yaml-ts-mode fill-paragraph (bug#68226) When using fill-paragraph on a block_scalar (the element within a block_node) fill the paragraph such that the contents remain within the block_node. This fixes the previous behavior that would clobber a block_node. * lisp/textmodes/yaml-ts-mode.el: Add yaml-ts-mode--fill-paragraph --- lisp/textmodes/yaml-ts-mode.el | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el index 2b57b384300..08fe4c49733 100644 --- a/lisp/textmodes/yaml-ts-mode.el +++ b/lisp/textmodes/yaml-ts-mode.el @@ -117,6 +117,26 @@ '((ERROR) @font-lock-warning-face)) "Tree-sitter font-lock settings for `yaml-ts-mode'.") +(defun yaml-ts-mode--fill-paragraph (&optional justify) + "Fill paragraph. +Behaves like `fill-paragraph', but respects block node +boundaries. JUSTIFY is passed to `fill-paragraph'." + (interactive "*P") + (save-restriction + (widen) + (let ((node (treesit-node-at (point)))) + (when (string= "block_scalar" (treesit-node-type node)) + (let* ((start (treesit-node-start node)) + (end (treesit-node-end node)) + (start-marker (point-marker)) + (fill-paragraph-function nil)) + (save-excursion + (goto-char start) + (forward-line) + (move-marker start-marker (point)) + (narrow-to-region (point) end)) + (fill-region start-marker end justify)))))) + ;;;###autoload (define-derived-mode yaml-ts-mode text-mode "YAML" "Major mode for editing YAML, powered by tree-sitter." @@ -141,6 +161,8 @@ (constant escape-sequence number property) (bracket delimiter error misc-punctuation))) + (setq-local fill-paragraph-function #'yaml-ts-mode--fill-paragraph) + (treesit-major-mode-setup))) (if (treesit-ready-p 'yaml) -- cgit v1.2.3 From ba300c96fa21af2fe7b7f25d16eec0a6c0738a95 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 4 Jan 2024 22:12:14 -0500 Subject: * lisp/startup.el (startup--load-user-init-file): Fix last change Use `condition-case-unless-debug` only in the branch when `--debug-init` is not in use, otherwise it prevents `handler-bind` from triggering the debugger. --- lisp/startup.el | 156 ++++++++++++++++++++++++++++---------------------------- 1 file changed, 78 insertions(+), 78 deletions(-) diff --git a/lisp/startup.el b/lisp/startup.el index 4040d5d3774..23937055f30 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1041,88 +1041,88 @@ init-file, or to a default value if loading is not possible." (let ((inhibit-null-byte-detection t) (body (lambda () - (condition-case-unless-debug error - (when init-file-user - (let ((init-file-name (funcall filename-function))) - - ;; If `user-init-file' is t, then `load' will store - ;; the name of the file that it loads into - ;; `user-init-file'. - (setq user-init-file t) - (when init-file-name - (load (if (equal (file-name-extension init-file-name) - "el") - (file-name-sans-extension init-file-name) - init-file-name) - 'noerror 'nomessage)) - - (when (and (eq user-init-file t) alternate-filename-function) - (let ((alt-file (funcall alternate-filename-function))) - (unless init-file-name - (setq init-file-name alt-file)) - (and (equal (file-name-extension alt-file) "el") - (setq alt-file (file-name-sans-extension alt-file))) - (load alt-file 'noerror 'nomessage))) - - ;; If we did not find the user's init file, set - ;; user-init-file conclusively. Don't let it be - ;; set from default.el. - (when (eq user-init-file t) - (setq user-init-file init-file-name))) - - ;; If we loaded a compiled file, set `user-init-file' to - ;; the source version if that exists. - (if (equal (file-name-extension user-init-file) "elc") - (let* ((source (file-name-sans-extension user-init-file)) - (alt (concat source ".el"))) - (setq source (cond ((file-exists-p alt) alt) - ((file-exists-p source) source) - (t nil))) - (when source - (when (file-newer-than-file-p source user-init-file) - (message "Warning: %s is newer than %s" - source user-init-file) - (sit-for 1)) - (setq user-init-file source))) - ;; Else, perhaps the user init file was compiled - (when (and (equal (file-name-extension user-init-file) "eln") - ;; The next test is for builds without native - ;; compilation support or builds with unexec. - (boundp 'comp-eln-to-el-h)) - (if-let (source (gethash (file-name-nondirectory - user-init-file) - comp-eln-to-el-h)) - ;; source exists or the .eln file would not load - (setq user-init-file source) - (message "Warning: unknown source file for init file %S" - user-init-file) - (sit-for 1)))) - - (when (and load-defaults - (not inhibit-default-init)) - ;; Prevent default.el from changing the value of - ;; `inhibit-startup-screen'. - (let ((inhibit-startup-screen nil)) - (load "default" 'noerror 'nomessage)))) - (error - (display-warning - 'initialization - (format-message "\ + (when init-file-user + (let ((init-file-name (funcall filename-function))) + + ;; If `user-init-file' is t, then `load' will store + ;; the name of the file that it loads into + ;; `user-init-file'. + (setq user-init-file t) + (when init-file-name + (load (if (equal (file-name-extension init-file-name) + "el") + (file-name-sans-extension init-file-name) + init-file-name) + 'noerror 'nomessage)) + + (when (and (eq user-init-file t) alternate-filename-function) + (let ((alt-file (funcall alternate-filename-function))) + (unless init-file-name + (setq init-file-name alt-file)) + (and (equal (file-name-extension alt-file) "el") + (setq alt-file (file-name-sans-extension alt-file))) + (load alt-file 'noerror 'nomessage))) + + ;; If we did not find the user's init file, set + ;; user-init-file conclusively. Don't let it be + ;; set from default.el. + (when (eq user-init-file t) + (setq user-init-file init-file-name))) + + ;; If we loaded a compiled file, set `user-init-file' to + ;; the source version if that exists. + (if (equal (file-name-extension user-init-file) "elc") + (let* ((source (file-name-sans-extension user-init-file)) + (alt (concat source ".el"))) + (setq source (cond ((file-exists-p alt) alt) + ((file-exists-p source) source) + (t nil))) + (when source + (when (file-newer-than-file-p source user-init-file) + (message "Warning: %s is newer than %s" + source user-init-file) + (sit-for 1)) + (setq user-init-file source))) + ;; Else, perhaps the user init file was compiled + (when (and (equal (file-name-extension user-init-file) "eln") + ;; The next test is for builds without native + ;; compilation support or builds with unexec. + (boundp 'comp-eln-to-el-h)) + (if-let (source (gethash (file-name-nondirectory + user-init-file) + comp-eln-to-el-h)) + ;; source exists or the .eln file would not load + (setq user-init-file source) + (message "Warning: unknown source file for init file %S" + user-init-file) + (sit-for 1)))) + + (when (and load-defaults + (not inhibit-default-init)) + ;; Prevent default.el from changing the value of + ;; `inhibit-startup-screen'. + (let ((inhibit-startup-screen nil)) + (load "default" 'noerror 'nomessage))))))) + (if (eq init-file-debug t) + (handler-bind ((error #'startup--debug)) + (funcall body)) + (condition-case-unless-debug error + (funcall body) + (error + (display-warning + 'initialization + (format-message "\ An error occurred while loading `%s':\n\n%s%s%s\n\n\ To ensure normal operation, you should investigate and remove the cause of the error in your initialization file. Start Emacs with the `--debug-init' option to view a complete error backtrace." - user-init-file - (get (car error) 'error-message) - (if (cdr error) ": " "") - (mapconcat (lambda (s) (prin1-to-string s t)) - (cdr error) ", ")) - :warning) - (setq init-file-had-error t)))))) - (if (eq init-file-debug t) - (handler-bind ((error #'startup--debug)) - (funcall body)) - (funcall body)))) + user-init-file + (get (car error) 'error-message) + (if (cdr error) ": " "") + (mapconcat (lambda (s) (prin1-to-string s t)) + (cdr error) ", ")) + :warning) + (setq init-file-had-error t)))))) (defvar lisp-directory nil "Directory where Emacs's own *.el and *.elc Lisp files are installed.") -- cgit v1.2.3 From d490874b3416d702686bb9dd25f75441d135264a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 5 Jan 2024 09:38:58 +0200 Subject: Improve documentation of derived modes and their parents * doc/lispref/modes.texi (Derived Modes): Expand documentation of functions that manipulate parent modes of a derived mode. Document 'provided-mode-derived-p'. Improve indexing. * lisp/subr.el (derived-mode-all-parents) (derived-mode-add-parents, provided-mode-derived-p) (derived-mode-p): Doc fixes. --- doc/lispref/modes.texi | 38 +++++++++++++++++++++++++++++++++----- lisp/subr.el | 13 ++++++++++--- 2 files changed, 43 insertions(+), 8 deletions(-) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 8c5fd63918a..1d961249633 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -809,6 +809,7 @@ modes, rather than those of the current buffer. @node Derived Modes @subsection Defining Derived Modes @cindex derived mode +@cindex parent mode The recommended way to define a new major mode is to derive it from an existing one using @code{define-derived-mode}. If there is no closely @@ -866,6 +867,9 @@ also a special mode (@pxref{Major Mode Conventions}). You can also specify @code{nil} for @var{parent}. This gives the new mode no parent. Then @code{define-derived-mode} behaves as described above, but, of course, omits all actions connected with @var{parent}. +Conversely, you can use @code{derived-mode-set-parent} and +@code{derived-mode-add-parents}, described below, to explicitly set +the ancestry of the new mode. The argument @var{docstring} specifies the documentation string for the new mode. @code{define-derived-mode} adds some general information @@ -932,6 +936,7 @@ Do not write an @code{interactive} spec in the definition; @code{define-derived-mode} does that automatically. @end defmac +@cindex ancestry, of major modes @defun derived-mode-p modes This function returns non-@code{nil} if the current major mode is derived from any of the major modes given by the list of symbols @@ -940,10 +945,28 @@ Instead of a list, @var{modes} can also be a single mode symbol. Furthermore, we still support a deprecated calling convention where the @var{modes} were passed as separate arguments. + +When examining the parent modes of the current major mode, this +function takes into consideration the current mode's parents set by +@code{define-derived-mode}, and also its additional parents set by +@code{derived-mode-add-parents}, described below. +@end defun + +@defun provided-mode-derived-p mode modes +This function returns non-@code{nil} if @var{mode} is derived from any +of the major modes given by the list of symbols in @var{modes}. Like +with @code{derived-mode-p}, @var{modes} can also be a single symbol, +and this function also supports a deprecated calling convention where +the @var{modes} were passed as separate symbol arguments. + +When examining the parent modes of @var{mode}, this function takes +into consideration the parents of @var{mode} set by +@code{define-derived-mode}, and also its additional parents set by +@code{derived-mode-add-parents}, described below. @end defun -The graph of major modes is accessed with the following lower-level -functions: +The graph of a major mode's ancestry can be accessed and modified with +the following lower-level functions: @defun derived-mode-set-parent mode parent This function declares that @var{mode} inherits from @code{parent}. @@ -956,14 +979,19 @@ by reusing @code{parent}. This function makes it possible to register additional parents beside the one that was used when defining @var{mode}. This can be used when the similarity between @var{mode} and the modes in @var{extra-parents} -is such that it makes sense to treat it as a child of those -modes for purposes like applying directory-local variables. +is such that it makes sense to treat @var{mode} as a child of those +modes for purposes like applying directory-local variables and other +mode-specific settings. The additional parent modes are specified as +a list of symbols in @var{extra-parents}. Those additional parent +modes will be considered as one of the @var{mode}s parents by +@code{derived-mode-p} and @code{provided-mode-derived-p}. @end defun @defun derived-mode-all-parents mode This function returns the list of all the modes in the ancestry of @var{mode}, ordered from the most specific to the least specific, and -starting with @var{mode} itself. +starting with @var{mode} itself. This includes the additional parent +modes, if any, added by calling @code{derived-mode-add-parents}. @end defun diff --git a/lisp/subr.el b/lisp/subr.el index 0519e56e057..df28989b399 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2737,6 +2737,8 @@ By default we choose the head of the first list." (defun derived-mode-all-parents (mode &optional known-children) "Return all the parents of MODE, starting with MODE. +This includes the parents set by `define-derived-mode' and additional +ones set by `derived-mode-add-parents'. The returned list is not fresh, don't modify it. \n(fn MODE)" ;`known-children' is for internal use only. ;; Can't use `with-memoization' :-( @@ -2785,7 +2787,9 @@ The returned list is not fresh, don't modify it. (defun provided-mode-derived-p (mode &optional modes &rest old-modes) "Non-nil if MODE is derived from a mode that is a member of the list MODES. MODES can also be a single mode instead of a list. -If you just want to check `major-mode', use `derived-mode-p'. +This examines the parent modes set by `define-derived-mode' and also +additional ones set by `derived-mode-add-parents'. +If you just want to check the current `major-mode', use `derived-mode-p'. We also still support the deprecated calling convention: \(provided-mode-derived-p MODE &rest MODES)." (declare (side-effect-free t) @@ -2799,8 +2803,10 @@ We also still support the deprecated calling convention: (car modes))) (defun derived-mode-p (&optional modes &rest old-modes) - "Non-nil if the current major mode is derived from one of MODES. + "Return non-nil if the current major mode is derived from one of MODES. MODES should be a list of symbols or a single mode symbol instead of a list. +This examines the parent modes set by `define-derived-mode' and also +additional ones set by `derived-mode-add-parents'. We also still support the deprecated calling convention: \(derived-mode-p &rest MODES)." (declare (side-effect-free t) @@ -2820,7 +2826,8 @@ We also still support the deprecated calling convention: (defun derived-mode-add-parents (mode extra-parents) "Add EXTRA-PARENTS to the parents of MODE. Declares the parents of MODE to be its main parent (as defined -in `define-derived-mode') plus EXTRA-PARENTS." +in `define-derived-mode') plus EXTRA-PARENTS, which should be a list +of symbols." (put mode 'derived-mode-extra-parents extra-parents) (derived-mode--flush mode)) -- cgit v1.2.3 From dc9d02f8a01d86ac8ff3fb004bb2f22cf211dcef Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 5 Jan 2024 09:39:04 +0200 Subject: * lisp/isearch.el (isearch-search-and-update): Let-bind 'isearch-cmds'. When 'isearch-wrap-pause' is 'no' or 'no-ding', let-bind 'isearch-cmds' to avoid changing it by 'isearch-push-state' in 'isearch-repeat', so that a later DEL (isearch-delete-char) doesn't stop at the intermediate failing state (bug#68158). --- lisp/isearch.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/isearch.el b/lisp/isearch.el index ee5660309df..f753a5377ca 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2844,7 +2844,8 @@ The command accepts Unicode names like \"smiling face\" or (isearch-search) (when (and (memq isearch-wrap-pause '(no no-ding)) (not isearch-success)) - (isearch-repeat (if isearch-forward 'forward 'backward))))) + (let ((isearch-cmds isearch-cmds)) + (isearch-repeat (if isearch-forward 'forward 'backward)))))) (isearch-push-state) (if isearch-op-fun (funcall isearch-op-fun)) (isearch-update)) -- cgit v1.2.3 From f9acf12f6f17b57265d19079e6973d167a328536 Mon Sep 17 00:00:00 2001 From: Jeremy Bryant Date: Thu, 4 Jan 2024 23:58:19 +0000 Subject: * lisp/mail/rmail.el (rmail-epa-decrypt): Fix typo (bug#68248). --- lisp/mail/rmail.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 74cf297c2fc..fb504055f1d 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4690,7 +4690,7 @@ Argument MIME is non-nil if this is a mime message." (while (search-forward "\r\n" nil t) (delete-region (- (point) 2) (- (point) 1)))))) ))) - ;; User wants to decrypt the message perenently. + ;; User wants to decrypt the message permanently. (when (eq major-mode 'rmail-mode) (rmail-add-label "decrypt")) (setq decrypts (nreverse decrypts)) -- cgit v1.2.3 From 790b5982175b8dcd45fe444379e8039b6cc05e97 Mon Sep 17 00:00:00 2001 From: Nicholas Vollmer Date: Fri, 5 Jan 2024 12:22:10 -0500 Subject: Use special-mode in checkdoc status buffer * lisp/emacs-lisp/checkdoc.el (checkdoc-display-status-buffer): Use `special-mode'. (Bug#68268) --- lisp/emacs-lisp/checkdoc.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 80eaf93c3b7..82c6c03a592 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -556,7 +556,8 @@ the users will view as each check is completed." "Display and update the status buffer for the current checkdoc mode. CHECK is a list of four strings stating the current status of each test; the nth string describes the status of the nth test." - (let (temp-buffer-setup-hook) + (let (temp-buffer-setup-hook + (temp-buffer-show-hook #'special-mode)) (with-output-to-temp-buffer "*Checkdoc Status*" (mapc #'princ (list "Buffer comments and tags: " (nth 0 check) -- cgit v1.2.3 From 2740a3cbfde65a899f2fcefceee9c4bc06eebc2d Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 5 Jan 2024 17:51:40 +0800 Subject: ; Update Android port splash screen message * lisp/term/android-win.el (android-after-splash-screen): Insert missing newline. --- lisp/term/android-win.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index 51163e5b9b2..876b24683bc 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -417,7 +417,7 @@ been denied. Click " :link '("here" android-display-storage-permission-popup) " to grant them.") (insert - "Permissions necessary to access external storage directories have been + "\nPermissions necessary to access external storage directories have been denied. ") (insert-button "Click here to grant them." 'action #'android-display-storage-permission-popup -- cgit v1.2.3 From 37889523278fe65733938fb11c3701898309961c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 6 Jan 2024 08:22:08 +0100 Subject: Add new `swap` macro and use it A `swap` macro prevents programming errors and is more concise. It is a natural addition to our existing `min` and `max` macros. * src/lisp.h (swap): New macro. * lwlib/xlwmenu.c (draw_shadow_rectangle, draw_shadow_rhombus): * src/androidterm.c (android_get_surrounding_text): * src/buffer.c (Fmake_overlay, modify_overlay, Fmove_overlay): * src/dispnew.c (swap_glyphs_in_rows, reverse_rows): * src/editfns.c (Finsert_buffer_substring) (Fcompare_buffer_substrings): * src/eval.c (run_hook_wrapped_funcall): * src/fns.c (extract_data_from_object): * src/regex-emacs.c (forall_firstchar_1): * src/textconv.c (textconv_query, get_extracted_text) (get_surrounding_text): * src/textprop.c (validate_interval_range) (verify_interval_modification): * src/w32uniscribe.c (OTF_INT16_VAL): * src/xfaces.c (load_face_colors): * src/xterm.c (SWAPCARD32): Prefer using above macro to open-coding. --- lwlib/xlwmenu.c | 14 ++------------ src/androidterm.c | 7 +------ src/buffer.c | 16 +++------------- src/dispnew.c | 20 +++----------------- src/editfns.c | 10 +++++----- src/eval.c | 9 +++------ src/fns.c | 6 +----- src/lisp.h | 4 ++++ src/regex-emacs.c | 4 ++-- src/textconv.c | 28 +++++++--------------------- src/textprop.c | 13 ++----------- src/w32uniscribe.c | 4 ++-- src/xfaces.c | 7 +------ src/xterm.c | 10 +++++----- 14 files changed, 41 insertions(+), 111 deletions(-) diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c index 0f8f94b803c..a3d9474bed0 100644 --- a/lwlib/xlwmenu.c +++ b/lwlib/xlwmenu.c @@ -671,12 +671,7 @@ draw_shadow_rectangle (XlwMenuWidget mw, Window window, int x, int y, } if (!erase_p && down_p) - { - GC temp; - temp = top_gc; - top_gc = bottom_gc; - bottom_gc = temp; - } + swap (top_gc, bottom_gc); /* Do draw (or erase) shadows */ points [0].x = x; @@ -757,12 +752,7 @@ draw_shadow_rhombus (XlwMenuWidget mw, Window window, int x, int y, } if (!erase_p && down_p) - { - GC temp; - temp = top_gc; - top_gc = bottom_gc; - bottom_gc = temp; - } + swap (top_gc, bottom_gc); points [0].x = x; points [0].y = y + height / 2; diff --git a/src/androidterm.c b/src/androidterm.c index 2e4ee64f390..34734e63c37 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -5849,7 +5849,6 @@ android_get_surrounding_text (void *data) { struct android_get_surrounding_text_context *request; struct frame *f; - ptrdiff_t temp; request = data; @@ -5870,11 +5869,7 @@ android_get_surrounding_text (void *data) bad input methods. */ if (request->end < request->start) - { - temp = request->start; - request->start = request->end; - request->end = temp; - } + swap (request->start, request->end); /* Retrieve the conversion region. */ diff --git a/src/buffer.c b/src/buffer.c index 352aca8ddfd..14c67224551 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -3591,10 +3591,7 @@ for the rear of the overlay advance when text is inserted there CHECK_FIXNUM_COERCE_MARKER (end); if (XFIXNUM (beg) > XFIXNUM (end)) - { - Lisp_Object temp; - temp = beg; beg = end; end = temp; - } + swap (beg, end); ptrdiff_t obeg = clip_to_bounds (BUF_BEG (b), XFIXNUM (beg), BUF_Z (b)); ptrdiff_t oend = clip_to_bounds (obeg, XFIXNUM (end), BUF_Z (b)); @@ -3614,11 +3611,7 @@ static void modify_overlay (struct buffer *buf, ptrdiff_t start, ptrdiff_t end) { if (start > end) - { - ptrdiff_t temp = start; - start = end; - end = temp; - } + swap (start, end); BUF_COMPUTE_UNCHANGED (buf, start, end); @@ -3658,10 +3651,7 @@ buffer. */) CHECK_FIXNUM_COERCE_MARKER (end); if (XFIXNUM (beg) > XFIXNUM (end)) - { - Lisp_Object temp; - temp = beg; beg = end; end = temp; - } + swap (beg, end); specbind (Qinhibit_quit, Qt); /* FIXME: Why? */ diff --git a/src/dispnew.c b/src/dispnew.c index d0f259eef6c..78ec3537a35 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -649,14 +649,7 @@ reverse_rows (struct glyph_matrix *matrix, int start, int end) int i, j; for (i = start, j = end - 1; i < j; ++i, --j) - { - /* Non-ISO HP/UX compiler doesn't like auto struct - initialization. */ - struct glyph_row temp; - temp = matrix->rows[i]; - matrix->rows[i] = matrix->rows[j]; - matrix->rows[j] = temp; - } + swap (matrix->rows[i], matrix->rows[j]); } @@ -966,9 +959,7 @@ increment_row_positions (struct glyph_row *row, static void swap_glyphs_in_rows (struct glyph_row *a, struct glyph_row *b) { - int area; - - for (area = 0; area < LAST_AREA; ++area) + for (int area = 0; area < LAST_AREA; ++area) { /* Number of glyphs to swap. */ int max_used = max (a->used[area], b->used[area]); @@ -984,12 +975,7 @@ swap_glyphs_in_rows (struct glyph_row *a, struct glyph_row *b) while (glyph_a < glyph_a_end) { - /* Non-ISO HP/UX compiler doesn't like auto struct - initialization. */ - struct glyph temp; - temp = *glyph_a; - *glyph_a = *glyph_b; - *glyph_b = temp; + swap (*glyph_a, *glyph_b); ++glyph_a; ++glyph_b; } diff --git a/src/editfns.c b/src/editfns.c index f3b3cfb7243..2e455a2efed 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -1739,7 +1739,7 @@ versa, strings are converted from unibyte to multibyte or vice versa using `string-make-multibyte' or `string-make-unibyte', which see. */) (Lisp_Object buffer, Lisp_Object start, Lisp_Object end) { - register EMACS_INT b, e, temp; + register EMACS_INT b, e; register struct buffer *bp, *obuf; Lisp_Object buf; @@ -1753,7 +1753,7 @@ using `string-make-multibyte' or `string-make-unibyte', which see. */) b = !NILP (start) ? fix_position (start) : BUF_BEGV (bp); e = !NILP (end) ? fix_position (end) : BUF_ZV (bp); if (b > e) - temp = b, b = e, e = temp; + swap (b, e); if (!(BUF_BEGV (bp) <= b && e <= BUF_ZV (bp))) args_out_of_range (start, end); @@ -1782,7 +1782,7 @@ The value of `case-fold-search' in the current buffer determines whether case is significant or ignored. */) (Lisp_Object buffer1, Lisp_Object start1, Lisp_Object end1, Lisp_Object buffer2, Lisp_Object start2, Lisp_Object end2) { - register EMACS_INT begp1, endp1, begp2, endp2, temp; + register EMACS_INT begp1, endp1, begp2, endp2; register struct buffer *bp1, *bp2; register Lisp_Object trt = (!NILP (Vcase_fold_search) @@ -1808,7 +1808,7 @@ determines whether case is significant or ignored. */) begp1 = !NILP (start1) ? fix_position (start1) : BUF_BEGV (bp1); endp1 = !NILP (end1) ? fix_position (end1) : BUF_ZV (bp1); if (begp1 > endp1) - temp = begp1, begp1 = endp1, endp1 = temp; + swap (begp1, endp1); if (!(BUF_BEGV (bp1) <= begp1 && begp1 <= endp1 @@ -1833,7 +1833,7 @@ determines whether case is significant or ignored. */) begp2 = !NILP (start2) ? fix_position (start2) : BUF_BEGV (bp2); endp2 = !NILP (end2) ? fix_position (end2) : BUF_ZV (bp2); if (begp2 > endp2) - temp = begp2, begp2 = endp2, endp2 = temp; + swap (begp2, endp2); if (!(BUF_BEGV (bp2) <= begp2 && begp2 <= endp2 diff --git a/src/eval.c b/src/eval.c index 94f6d8e31f8..6a866d6cc32 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2794,12 +2794,9 @@ usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */) static Lisp_Object run_hook_wrapped_funcall (ptrdiff_t nargs, Lisp_Object *args) { - Lisp_Object tmp = args[0], ret; - args[0] = args[1]; - args[1] = tmp; - ret = Ffuncall (nargs, args); - args[1] = args[0]; - args[0] = tmp; + swap (args[0], args[1]); + Lisp_Object ret = Ffuncall (nargs, args); + swap (args[1], args[0]); return ret; } diff --git a/src/fns.c b/src/fns.c index c03aea02397..c8adc5cb891 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5674,11 +5674,7 @@ extract_data_from_object (Lisp_Object spec, b = !NILP (start) ? fix_position (start) : BEGV; e = !NILP (end) ? fix_position (end) : ZV; if (b > e) - { - EMACS_INT temp = b; - b = e; - e = temp; - } + swap (b, e); if (!(BEGV <= b && e <= ZV)) args_out_of_range (start, end); diff --git a/src/lisp.h b/src/lisp.h index 44f69892c6f..f96932ab0c1 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -67,6 +67,10 @@ INLINE_HEADER_BEGIN #define max(a, b) ((a) > (b) ? (a) : (b)) #define min(a, b) ((a) < (b) ? (a) : (b)) +/* Swap values of a and b. */ +#define swap(a, b) \ + do { typeof (a) __tmp; __tmp = (a); (a) = (b); (b) = __tmp; } while (0); + /* Number of elements in an array. */ #define ARRAYELTS(arr) (sizeof (arr) / sizeof (arr)[0]) diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 6aa6f4f9b34..fdc2cc63445 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -2839,7 +2839,7 @@ forall_firstchar_1 (re_char *p, re_char *pend, while (true) { - re_char *newp1, *newp2, *tmp; + re_char *newp1, *newp2; re_char *p_orig = p; int offset; @@ -2930,7 +2930,7 @@ forall_firstchar_1 (re_char *p, re_char *pend, /* We have to check that both destinations are safe. Arrange for `newp1` to be the smaller of the two. */ if (newp1 > newp2) - (tmp = newp1, newp1 = newp2, newp2 = tmp); + swap (newp1, newp2); if (newp2 <= p_orig) /* Both destinations go backward! */ { diff --git a/src/textconv.c b/src/textconv.c index 2a7b0ed330d..e0707522d7e 100644 --- a/src/textconv.c +++ b/src/textconv.c @@ -176,7 +176,7 @@ textconv_query (struct frame *f, struct textconv_callback_struct *query, { specpdl_ref count; ptrdiff_t pos, pos_byte, end, end_byte, start; - ptrdiff_t temp, temp1, mark; + ptrdiff_t mark; char *buffer; struct window *w; @@ -383,12 +383,8 @@ textconv_query (struct frame *f, struct textconv_callback_struct *query, if (end < pos) { eassert (end_byte < pos_byte); - temp = pos_byte; - temp1 = pos; - pos_byte = end_byte; - pos = end; - end = temp1; - end_byte = temp; + swap (pos_byte, end_byte); + swap (pos, end); } /* Return the string first. */ @@ -1905,15 +1901,9 @@ get_extracted_text (struct frame *f, ptrdiff_t n, start = marker_position (BVAR (current_buffer, mark)); end = PT; - /* Sort start and end. start_byte is used to hold a - temporary value. */ - + /* Sort start and end. */ if (start > end) - { - start_byte = end; - end = start; - start = start_byte; - } + swap (start, end); } else goto finish; @@ -1979,7 +1969,7 @@ get_surrounding_text (struct frame *f, ptrdiff_t left, ptrdiff_t *end_return) { specpdl_ref count; - ptrdiff_t start, end, start_byte, end_byte, mark, temp; + ptrdiff_t start, end, start_byte, end_byte, mark; char *buffer; if (!WINDOW_LIVE_P (f->old_selected_window)) @@ -2012,11 +2002,7 @@ get_surrounding_text (struct frame *f, ptrdiff_t left, /* Now sort start and end. */ if (end < start) - { - temp = start; - start = end; - end = temp; - } + swap (start, end) /* And subtract left and right. */ diff --git a/src/textprop.c b/src/textprop.c index 7d9aae0d2c5..ec9435219ea 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -142,12 +142,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, return NULL; if (XFIXNUM (*begin) > XFIXNUM (*end)) - { - Lisp_Object n; - n = *begin; - *begin = *end; - *end = n; - } + swap (*begin, *end); if (BUFFERP (object)) { @@ -2201,11 +2196,7 @@ verify_interval_modification (struct buffer *buf, return; if (start > end) - { - ptrdiff_t temp = start; - start = end; - end = temp; - } + swap (start, end); /* For an insert operation, check the two chars around the position. */ if (start == end) diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c index a73c0de06f9..c417159cf9e 100644 --- a/src/w32uniscribe.c +++ b/src/w32uniscribe.c @@ -765,10 +765,10 @@ add_opentype_font_name_to_list (ENUMLOGFONTEX *logical_font, #define OTF_INT16_VAL(TABLE, OFFSET, PTR) \ do { \ - BYTE temp, data[2]; \ + BYTE data[2]; \ if (GetFontData (context, TABLE, OFFSET, data, 2) != 2) \ goto font_table_error; \ - temp = data[0], data[0] = data[1], data[1] = temp; \ + swap (data[0], data[1]); \ memcpy (PTR, data, 2); \ } while (0) diff --git a/src/xfaces.c b/src/xfaces.c index e30c2fac70c..f79eb022e15 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -1357,12 +1357,7 @@ load_face_colors (struct frame *f, struct face *face, /* Swap colors if face is inverse-video. */ if (EQ (attrs[LFACE_INVERSE_INDEX], Qt)) - { - Lisp_Object tmp; - tmp = fg; - fg = bg; - bg = tmp; - } + swap (fg, bg); /* Check for support for foreground, not for background because face_color_supported_p is smart enough to know that grays are diff --git a/src/xterm.c b/src/xterm.c index 1f398b2e39a..0b83b0554b3 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1569,19 +1569,19 @@ typedef enum xm_byte_order #define SWAPCARD32(l) \ { \ struct { unsigned t : 32; } bit32; \ - char n, *tp = (char *) &bit32; \ + char *tp = (char *) &bit32; \ bit32.t = l; \ - n = tp[0]; tp[0] = tp[3]; tp[3] = n; \ - n = tp[1]; tp[1] = tp[2]; tp[2] = n; \ + swap (tp[0], tp[3]); \ + swap (tp[1], tp[2]); \ l = bit32.t; \ } #define SWAPCARD16(s) \ { \ struct { unsigned t : 16; } bit16; \ - char n, *tp = (char *) &bit16; \ + char *tp = (char *) &bit16; \ bit16.t = s; \ - n = tp[0]; tp[0] = tp[1]; tp[1] = n; \ + swap (tp[0], tp[1]); \ s = bit16.t; \ } -- cgit v1.2.3 From 2f59052602e71fb818dd5d671be119793864e712 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 6 Jan 2024 15:24:58 +0800 Subject: Properly parse TTC tables with digital signatures * src/sfnt.c (sfnt_read_ttc_header): Don't inadvertently overwrite first two offsets while reading the digital signature. --- src/sfnt.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/sfnt.c b/src/sfnt.c index aa8b49a9ecd..36240f4cdff 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -6195,7 +6195,7 @@ sfnt_read_ttc_header (int fd) size = (SFNT_ENDOF (struct sfnt_ttc_header, ul_dsig_offset, uint32_t) - offsetof (struct sfnt_ttc_header, ul_dsig_tag)); - rc = read (fd, &ttc->ul_dsig_offset, size); + rc = read (fd, &ttc->ul_dsig_tag, size); if (rc == -1 || rc < size) { xfree (ttc); @@ -20631,8 +20631,8 @@ main (int argc, char **argv) return 1; } -#define FANCY_PPEM 44 -#define EASY_PPEM 44 +#define FANCY_PPEM 14 +#define EASY_PPEM 14 interpreter = NULL; head = sfnt_read_head_table (fd, font); -- cgit v1.2.3 From 657275529e31226bbc6c92eb7f7af887474a0bb8 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 6 Jan 2024 15:28:14 +0800 Subject: Revert "Add new `swap` macro and use it" typeof is an extension which does not exist in Standard C, so macros using it are unsuitable for inclusion in Emacs. This reverts commit 37889523278fe65733938fb11c3701898309961c. --- lwlib/xlwmenu.c | 14 ++++++++++++-- src/androidterm.c | 7 ++++++- src/buffer.c | 16 +++++++++++++--- src/dispnew.c | 20 +++++++++++++++++--- src/editfns.c | 10 +++++----- src/eval.c | 9 ++++++--- src/fns.c | 6 +++++- src/lisp.h | 4 ---- src/regex-emacs.c | 4 ++-- src/textconv.c | 28 +++++++++++++++++++++------- src/textprop.c | 13 +++++++++++-- src/w32uniscribe.c | 4 ++-- src/xfaces.c | 7 ++++++- src/xterm.c | 10 +++++----- 14 files changed, 111 insertions(+), 41 deletions(-) diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c index a3d9474bed0..0f8f94b803c 100644 --- a/lwlib/xlwmenu.c +++ b/lwlib/xlwmenu.c @@ -671,7 +671,12 @@ draw_shadow_rectangle (XlwMenuWidget mw, Window window, int x, int y, } if (!erase_p && down_p) - swap (top_gc, bottom_gc); + { + GC temp; + temp = top_gc; + top_gc = bottom_gc; + bottom_gc = temp; + } /* Do draw (or erase) shadows */ points [0].x = x; @@ -752,7 +757,12 @@ draw_shadow_rhombus (XlwMenuWidget mw, Window window, int x, int y, } if (!erase_p && down_p) - swap (top_gc, bottom_gc); + { + GC temp; + temp = top_gc; + top_gc = bottom_gc; + bottom_gc = temp; + } points [0].x = x; points [0].y = y + height / 2; diff --git a/src/androidterm.c b/src/androidterm.c index 34734e63c37..2e4ee64f390 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -5849,6 +5849,7 @@ android_get_surrounding_text (void *data) { struct android_get_surrounding_text_context *request; struct frame *f; + ptrdiff_t temp; request = data; @@ -5869,7 +5870,11 @@ android_get_surrounding_text (void *data) bad input methods. */ if (request->end < request->start) - swap (request->start, request->end); + { + temp = request->start; + request->start = request->end; + request->end = temp; + } /* Retrieve the conversion region. */ diff --git a/src/buffer.c b/src/buffer.c index 14c67224551..352aca8ddfd 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -3591,7 +3591,10 @@ for the rear of the overlay advance when text is inserted there CHECK_FIXNUM_COERCE_MARKER (end); if (XFIXNUM (beg) > XFIXNUM (end)) - swap (beg, end); + { + Lisp_Object temp; + temp = beg; beg = end; end = temp; + } ptrdiff_t obeg = clip_to_bounds (BUF_BEG (b), XFIXNUM (beg), BUF_Z (b)); ptrdiff_t oend = clip_to_bounds (obeg, XFIXNUM (end), BUF_Z (b)); @@ -3611,7 +3614,11 @@ static void modify_overlay (struct buffer *buf, ptrdiff_t start, ptrdiff_t end) { if (start > end) - swap (start, end); + { + ptrdiff_t temp = start; + start = end; + end = temp; + } BUF_COMPUTE_UNCHANGED (buf, start, end); @@ -3651,7 +3658,10 @@ buffer. */) CHECK_FIXNUM_COERCE_MARKER (end); if (XFIXNUM (beg) > XFIXNUM (end)) - swap (beg, end); + { + Lisp_Object temp; + temp = beg; beg = end; end = temp; + } specbind (Qinhibit_quit, Qt); /* FIXME: Why? */ diff --git a/src/dispnew.c b/src/dispnew.c index 78ec3537a35..d0f259eef6c 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -649,7 +649,14 @@ reverse_rows (struct glyph_matrix *matrix, int start, int end) int i, j; for (i = start, j = end - 1; i < j; ++i, --j) - swap (matrix->rows[i], matrix->rows[j]); + { + /* Non-ISO HP/UX compiler doesn't like auto struct + initialization. */ + struct glyph_row temp; + temp = matrix->rows[i]; + matrix->rows[i] = matrix->rows[j]; + matrix->rows[j] = temp; + } } @@ -959,7 +966,9 @@ increment_row_positions (struct glyph_row *row, static void swap_glyphs_in_rows (struct glyph_row *a, struct glyph_row *b) { - for (int area = 0; area < LAST_AREA; ++area) + int area; + + for (area = 0; area < LAST_AREA; ++area) { /* Number of glyphs to swap. */ int max_used = max (a->used[area], b->used[area]); @@ -975,7 +984,12 @@ swap_glyphs_in_rows (struct glyph_row *a, struct glyph_row *b) while (glyph_a < glyph_a_end) { - swap (*glyph_a, *glyph_b); + /* Non-ISO HP/UX compiler doesn't like auto struct + initialization. */ + struct glyph temp; + temp = *glyph_a; + *glyph_a = *glyph_b; + *glyph_b = temp; ++glyph_a; ++glyph_b; } diff --git a/src/editfns.c b/src/editfns.c index 2e455a2efed..f3b3cfb7243 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -1739,7 +1739,7 @@ versa, strings are converted from unibyte to multibyte or vice versa using `string-make-multibyte' or `string-make-unibyte', which see. */) (Lisp_Object buffer, Lisp_Object start, Lisp_Object end) { - register EMACS_INT b, e; + register EMACS_INT b, e, temp; register struct buffer *bp, *obuf; Lisp_Object buf; @@ -1753,7 +1753,7 @@ using `string-make-multibyte' or `string-make-unibyte', which see. */) b = !NILP (start) ? fix_position (start) : BUF_BEGV (bp); e = !NILP (end) ? fix_position (end) : BUF_ZV (bp); if (b > e) - swap (b, e); + temp = b, b = e, e = temp; if (!(BUF_BEGV (bp) <= b && e <= BUF_ZV (bp))) args_out_of_range (start, end); @@ -1782,7 +1782,7 @@ The value of `case-fold-search' in the current buffer determines whether case is significant or ignored. */) (Lisp_Object buffer1, Lisp_Object start1, Lisp_Object end1, Lisp_Object buffer2, Lisp_Object start2, Lisp_Object end2) { - register EMACS_INT begp1, endp1, begp2, endp2; + register EMACS_INT begp1, endp1, begp2, endp2, temp; register struct buffer *bp1, *bp2; register Lisp_Object trt = (!NILP (Vcase_fold_search) @@ -1808,7 +1808,7 @@ determines whether case is significant or ignored. */) begp1 = !NILP (start1) ? fix_position (start1) : BUF_BEGV (bp1); endp1 = !NILP (end1) ? fix_position (end1) : BUF_ZV (bp1); if (begp1 > endp1) - swap (begp1, endp1); + temp = begp1, begp1 = endp1, endp1 = temp; if (!(BUF_BEGV (bp1) <= begp1 && begp1 <= endp1 @@ -1833,7 +1833,7 @@ determines whether case is significant or ignored. */) begp2 = !NILP (start2) ? fix_position (start2) : BUF_BEGV (bp2); endp2 = !NILP (end2) ? fix_position (end2) : BUF_ZV (bp2); if (begp2 > endp2) - swap (begp2, endp2); + temp = begp2, begp2 = endp2, endp2 = temp; if (!(BUF_BEGV (bp2) <= begp2 && begp2 <= endp2 diff --git a/src/eval.c b/src/eval.c index 6a866d6cc32..94f6d8e31f8 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2794,9 +2794,12 @@ usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */) static Lisp_Object run_hook_wrapped_funcall (ptrdiff_t nargs, Lisp_Object *args) { - swap (args[0], args[1]); - Lisp_Object ret = Ffuncall (nargs, args); - swap (args[1], args[0]); + Lisp_Object tmp = args[0], ret; + args[0] = args[1]; + args[1] = tmp; + ret = Ffuncall (nargs, args); + args[1] = args[0]; + args[0] = tmp; return ret; } diff --git a/src/fns.c b/src/fns.c index c8adc5cb891..c03aea02397 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5674,7 +5674,11 @@ extract_data_from_object (Lisp_Object spec, b = !NILP (start) ? fix_position (start) : BEGV; e = !NILP (end) ? fix_position (end) : ZV; if (b > e) - swap (b, e); + { + EMACS_INT temp = b; + b = e; + e = temp; + } if (!(BEGV <= b && e <= ZV)) args_out_of_range (start, end); diff --git a/src/lisp.h b/src/lisp.h index f96932ab0c1..44f69892c6f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -67,10 +67,6 @@ INLINE_HEADER_BEGIN #define max(a, b) ((a) > (b) ? (a) : (b)) #define min(a, b) ((a) < (b) ? (a) : (b)) -/* Swap values of a and b. */ -#define swap(a, b) \ - do { typeof (a) __tmp; __tmp = (a); (a) = (b); (b) = __tmp; } while (0); - /* Number of elements in an array. */ #define ARRAYELTS(arr) (sizeof (arr) / sizeof (arr)[0]) diff --git a/src/regex-emacs.c b/src/regex-emacs.c index fdc2cc63445..6aa6f4f9b34 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -2839,7 +2839,7 @@ forall_firstchar_1 (re_char *p, re_char *pend, while (true) { - re_char *newp1, *newp2; + re_char *newp1, *newp2, *tmp; re_char *p_orig = p; int offset; @@ -2930,7 +2930,7 @@ forall_firstchar_1 (re_char *p, re_char *pend, /* We have to check that both destinations are safe. Arrange for `newp1` to be the smaller of the two. */ if (newp1 > newp2) - swap (newp1, newp2); + (tmp = newp1, newp1 = newp2, newp2 = tmp); if (newp2 <= p_orig) /* Both destinations go backward! */ { diff --git a/src/textconv.c b/src/textconv.c index e0707522d7e..2a7b0ed330d 100644 --- a/src/textconv.c +++ b/src/textconv.c @@ -176,7 +176,7 @@ textconv_query (struct frame *f, struct textconv_callback_struct *query, { specpdl_ref count; ptrdiff_t pos, pos_byte, end, end_byte, start; - ptrdiff_t mark; + ptrdiff_t temp, temp1, mark; char *buffer; struct window *w; @@ -383,8 +383,12 @@ textconv_query (struct frame *f, struct textconv_callback_struct *query, if (end < pos) { eassert (end_byte < pos_byte); - swap (pos_byte, end_byte); - swap (pos, end); + temp = pos_byte; + temp1 = pos; + pos_byte = end_byte; + pos = end; + end = temp1; + end_byte = temp; } /* Return the string first. */ @@ -1901,9 +1905,15 @@ get_extracted_text (struct frame *f, ptrdiff_t n, start = marker_position (BVAR (current_buffer, mark)); end = PT; - /* Sort start and end. */ + /* Sort start and end. start_byte is used to hold a + temporary value. */ + if (start > end) - swap (start, end); + { + start_byte = end; + end = start; + start = start_byte; + } } else goto finish; @@ -1969,7 +1979,7 @@ get_surrounding_text (struct frame *f, ptrdiff_t left, ptrdiff_t *end_return) { specpdl_ref count; - ptrdiff_t start, end, start_byte, end_byte, mark; + ptrdiff_t start, end, start_byte, end_byte, mark, temp; char *buffer; if (!WINDOW_LIVE_P (f->old_selected_window)) @@ -2002,7 +2012,11 @@ get_surrounding_text (struct frame *f, ptrdiff_t left, /* Now sort start and end. */ if (end < start) - swap (start, end) + { + temp = start; + start = end; + end = temp; + } /* And subtract left and right. */ diff --git a/src/textprop.c b/src/textprop.c index ec9435219ea..7d9aae0d2c5 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -142,7 +142,12 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, return NULL; if (XFIXNUM (*begin) > XFIXNUM (*end)) - swap (*begin, *end); + { + Lisp_Object n; + n = *begin; + *begin = *end; + *end = n; + } if (BUFFERP (object)) { @@ -2196,7 +2201,11 @@ verify_interval_modification (struct buffer *buf, return; if (start > end) - swap (start, end); + { + ptrdiff_t temp = start; + start = end; + end = temp; + } /* For an insert operation, check the two chars around the position. */ if (start == end) diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c index c417159cf9e..a73c0de06f9 100644 --- a/src/w32uniscribe.c +++ b/src/w32uniscribe.c @@ -765,10 +765,10 @@ add_opentype_font_name_to_list (ENUMLOGFONTEX *logical_font, #define OTF_INT16_VAL(TABLE, OFFSET, PTR) \ do { \ - BYTE data[2]; \ + BYTE temp, data[2]; \ if (GetFontData (context, TABLE, OFFSET, data, 2) != 2) \ goto font_table_error; \ - swap (data[0], data[1]); \ + temp = data[0], data[0] = data[1], data[1] = temp; \ memcpy (PTR, data, 2); \ } while (0) diff --git a/src/xfaces.c b/src/xfaces.c index f79eb022e15..e30c2fac70c 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -1357,7 +1357,12 @@ load_face_colors (struct frame *f, struct face *face, /* Swap colors if face is inverse-video. */ if (EQ (attrs[LFACE_INVERSE_INDEX], Qt)) - swap (fg, bg); + { + Lisp_Object tmp; + tmp = fg; + fg = bg; + bg = tmp; + } /* Check for support for foreground, not for background because face_color_supported_p is smart enough to know that grays are diff --git a/src/xterm.c b/src/xterm.c index 0b83b0554b3..1f398b2e39a 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1569,19 +1569,19 @@ typedef enum xm_byte_order #define SWAPCARD32(l) \ { \ struct { unsigned t : 32; } bit32; \ - char *tp = (char *) &bit32; \ + char n, *tp = (char *) &bit32; \ bit32.t = l; \ - swap (tp[0], tp[3]); \ - swap (tp[1], tp[2]); \ + n = tp[0]; tp[0] = tp[3]; tp[3] = n; \ + n = tp[1]; tp[1] = tp[2]; tp[2] = n; \ l = bit32.t; \ } #define SWAPCARD16(s) \ { \ struct { unsigned t : 16; } bit16; \ - char *tp = (char *) &bit16; \ + char n, *tp = (char *) &bit16; \ bit16.t = s; \ - swap (tp[0], tp[1]); \ + n = tp[0]; tp[0] = tp[1]; tp[1] = n; \ s = bit16.t; \ } -- cgit v1.2.3 From 2a861124e89d7a29b19bb9a6f22e962c37444212 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Jan 2024 11:15:31 +0200 Subject: ; Improve documentation of 'buffer-match-p' * doc/lispref/buffers.texi (Buffer List): * doc/lispref/windows.texi (Choosing Window): Add caveats for calling 'buffer-match-p' too early, when CONDITION is 'derived-mode' or 'major-mode'. (Bug#68081) --- doc/lispref/buffers.texi | 13 +++++++++---- doc/lispref/windows.texi | 14 +++++++++----- 2 files changed, 18 insertions(+), 9 deletions(-) diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index b7047a68856..f67a954edc5 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -959,7 +959,7 @@ infinite recursion. @defun buffer-match-p condition buffer-or-name &optional arg This function checks if a buffer designated by @code{buffer-or-name} -satisfies the specified @code{condition}. Optional third argument +satisfies the specified @var{condition}. Optional third argument @var{arg} is passed to the predicate function in @var{condition}. A valid @var{condition} can be one of the following: @itemize @bullet{} @@ -987,10 +987,15 @@ Satisfied if @emph{any} condition in @var{conds} satisfies Satisfied if @emph{all} the conditions in @var{conds} satisfy @code{buffer-match-p}, with the same buffer and @code{arg}. @item derived-mode -Satisfied if the buffer's major mode derives from @var{expr}. +Satisfied if the buffer's major mode derives from @var{expr}. Note +that this condition might fail to report a match if +@code{buffer-match-p} is invoked before the major mode of the buffer +has been established. @item major-mode Satisfied if the buffer's major mode is equal to @var{expr}. Prefer -using @code{derived-mode} instead, when both can work. +using @code{derived-mode} instead, when both can work. Note that this +condition might fail to report a match if @code{buffer-match-p} is +invoked before the major mode of the buffer has been established. @end table @item t Satisfied by any buffer. A convenient alternative to @code{""} (empty @@ -1000,7 +1005,7 @@ string) or @code{(and)} (empty conjunction). @defun match-buffers condition &optional buffer-list arg This function returns a list of all buffers that satisfy the -@code{condition}. If no buffers match, the function returns +@var{condition}. If no buffers match, the function returns @code{nil}. The argument @var{condition} is as defined in @code{buffer-match-p} above. By default, all the buffers are considered, but this can be restricted via the optional argument diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 39e6d1386c6..d72da704f13 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -2629,11 +2629,15 @@ default value is an empty display action, i.e., @w{@code{(nil . nil)}}. @defopt display-buffer-alist The value of this option is an alist mapping conditions to display -actions. Each condition is passed to @code{buffer-match-p}, along -with the buffer name and the @var{action} argument passed to -@code{display-buffer}. If it returns a non-@code{nil} value, then -@code{display-buffer} uses the corresponding display action to display -the buffer. +actions. Each condition is passed to @code{buffer-match-p} +(@pxref{Buffer List}), along with the buffer name and the @var{action} +argument passed to @code{display-buffer}. If it returns a +non-@code{nil} value, then @code{display-buffer} uses the +corresponding display action to display the buffer. Caveat: if you +use @code{derived-mode} or @code{major-mode} as condition, +@code{buffer-match-p} could fail to report a match if +@code{display-buffer} is called before the major mode of the buffer is +set. @end defopt @defopt display-buffer-base-action -- cgit v1.2.3 From d3a4fe5694f7bd1a09546d67d2cddc0f444d41ca Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Wed, 3 Jan 2024 11:35:25 +0100 Subject: Fix use of 'display-buffer-alist' for Info buffers * lisp/info.el (info-pop-to-buffer): New function. (info-other-window, info, Info-find-node, Info-revert-find-node) (Info-next, Info-prev, Info-up, info-display-manual): Call 'info-pop-to-buffer'. (Bug#68081) --- lisp/info.el | 67 +++++++++++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 57 insertions(+), 10 deletions(-) diff --git a/lisp/info.el b/lisp/info.el index 39ca88c358c..f4384934155 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -732,8 +732,53 @@ in `Info-file-supports-index-cookies-list'." (read-file-name "Info file name: " nil nil t)) (if (numberp current-prefix-arg) (format "*info*<%s>" current-prefix-arg)))) - (info-setup file-or-node - (switch-to-buffer-other-window (or buffer "*info*")))) + (info-pop-to-buffer file-or-node buffer t)) + +(defun info-pop-to-buffer (&optional file-or-node buffer-or-name other-window) + "Put Info node FILE-OR-NODE in specified buffer and display it. +Optional argument FILE-OR-NODE is as for `info'. + +If the optional argument BUFFER-OR-NAME is a buffer, use that +buffer. If it is a string, use that string as the name of the +buffer, creating it if it does not exist. Otherwise, use a +buffer with the name `*info*', creating it if it does not exist. + +Optional argument OTHER-WINDOW nil means to prefer the selected +window. OTHER-WINDOW non-nil means to prefer another window. +Select the window used, if it has been made." + (let ((buffer (cond + ((bufferp buffer-or-name) + buffer-or-name) + ((stringp buffer-or-name) + (get-buffer-create buffer-or-name)) + (t + (get-buffer-create "*info*"))))) + (with-current-buffer buffer + (unless (derived-mode-p 'Info-mode) + (Info-mode))) + + (let* ((window + (display-buffer buffer + (if other-window + '(nil (inhibit-same-window . t)) + '(display-buffer-same-window))))) + (with-current-buffer buffer + (if file-or-node + ;; If argument already contains parentheses, don't add another set + ;; since the argument will then be parsed improperly. This also + ;; has the added benefit of allowing node names to be included + ;; following the parenthesized filename. + (Info-goto-node + (if (and (stringp file-or-node) (string-match "(.*)" file-or-node)) + file-or-node + (concat "(" file-or-node ")"))) + (if (and (zerop (buffer-size)) + (null Info-history)) + ;; If we just created the Info buffer, go to the directory. + (Info-directory)))) + + (when window + (select-window window))))) ;;;###autoload (put 'info 'info-file (purecopy "emacs")) ;;;###autoload @@ -768,8 +813,8 @@ See a list of available Info commands in `Info-mode'." ;; of names that might have been wrapped (in emails, etc.). (setq file-or-node (string-replace "\n" " " file-or-node))) - (info-setup file-or-node - (pop-to-buffer-same-window (or buffer "*info*")))) + + (info-pop-to-buffer file-or-node buffer)) (defun info-setup (file-or-node buffer) "Display Info node FILE-OR-NODE in BUFFER." @@ -789,6 +834,8 @@ See a list of available Info commands in `Info-mode'." ;; If we just created the Info buffer, go to the directory. (Info-directory)))) +(make-obsolete 'info-setup "use `info-pop-to-buffer' instead" "30.1") + ;;;###autoload (defun info-emacs-manual () "Display the Emacs manual in Info mode." @@ -927,7 +974,7 @@ If NOERROR, inhibit error messages when we can't find the node." (setq nodename (info--node-canonicalize-whitespace nodename)) (setq filename (Info-find-file filename noerror)) ;; Go into Info buffer. - (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) + (or (derived-mode-p 'Info-mode) (info-pop-to-buffer filename)) ;; Record the node we are leaving, if we were in one. (and (not no-going-back) Info-current-file @@ -957,7 +1004,7 @@ otherwise, that defaults to `Top'." "Go to an Info node FILENAME and NODENAME, re-reading disk contents. When *info* is already displaying FILENAME and NODENAME, the window position is preserved, if possible." - (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) + (or (derived-mode-p 'Info-mode) (info-pop-to-buffer filename)) (let ((old-filename Info-current-file) (old-nodename Info-current-node) (window-selected (eq (selected-window) (get-buffer-window))) @@ -2290,7 +2337,7 @@ This command doesn't descend into sub-nodes, like \\\\[Info-forwa (interactive nil Info-mode) ;; In case another window is currently selected (save-window-excursion - (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) + (or (derived-mode-p 'Info-mode) (info-pop-to-buffer)) (Info-goto-node (Info-extract-pointer "next")))) (defun Info-prev () @@ -2299,7 +2346,7 @@ This command doesn't go up to the parent node, like \\\\[Info-bac (interactive nil Info-mode) ;; In case another window is currently selected (save-window-excursion - (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) + (or (derived-mode-p 'Info-mode) (info-pop-to-buffer)) (Info-goto-node (Info-extract-pointer "prev[ious]*" "previous")))) (defun Info-up (&optional same-file) @@ -2308,7 +2355,7 @@ If SAME-FILE is non-nil, do not move to a different Info file." (interactive nil Info-mode) ;; In case another window is currently selected (save-window-excursion - (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) + (or (derived-mode-p 'Info-mode) (info-pop-to-buffer)) (let ((old-node Info-current-node) (old-file Info-current-file) (node (Info-extract-pointer "up")) p) @@ -5485,7 +5532,7 @@ completion alternatives to currently visited manuals." (raise-frame (window-frame window)) (select-frame-set-input-focus (window-frame window)) (select-window window)) - (switch-to-buffer found))) + (info-pop-to-buffer nil found))) ;; The buffer doesn't exist; create it. (info-initialize) (info (Info-find-file manual) -- cgit v1.2.3 From 471cc26002d3f6028252c77998272fccf73722ec Mon Sep 17 00:00:00 2001 From: Jurgen De Backer Date: Thu, 4 Jan 2024 11:10:56 +0000 Subject: Fix file-name resolution in *compilation* and *grep* buffers Resolving symlinks in file names could lead to non-existent files if some leading directory is a symlink to its parent. In emacs 28 'expand-file-name' was replaced by 'file-truename' to solve bug #8035. * lisp/progmodes/compile.el (safe-expand-file-name): New function. (compilation-find-file-1): Call 'safe-expand-file-name'. (Bug#67930) --- lisp/progmodes/compile.el | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 4af6a96900a..3002cd1b86c 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -3122,7 +3122,16 @@ and overlay is highlighted between MK and END-MK." (cancel-timer next-error-highlight-timer)) (remove-hook 'pre-command-hook #'compilation-goto-locus-delete-o)) - + +(defun safe-expand-file-name (directory filename) + "Expand the specified filename using expand-file-name. If this fails, +retry with file-truename (see bug #8035) +Unlike expand-file-name, file-truename follows symlinks which we try to avoid if possible." + (let* ((expandedname (expand-file-name filename directory))) + (if (file-exists-p expandedname) + expandedname + (file-truename (file-name-concat directory filename))))) + (defun compilation-find-file-1 (marker filename directory &optional formats) (or formats (setq formats '("%s"))) (let ((dirs compilation-search-path) @@ -3143,8 +3152,7 @@ and overlay is highlighted between MK and END-MK." fmts formats) ;; For each directory, try each format string. (while (and fmts (null buffer)) - (setq name (file-truename - (file-name-concat thisdir (format (car fmts) filename))) + (setq name (safe-expand-file-name thisdir (format (car fmts) filename)) buffer (and (file-exists-p name) (find-file-noselect name)) fmts (cdr fmts))) @@ -3166,8 +3174,7 @@ and overlay is highlighted between MK and END-MK." (setq thisdir (car dirs) fmts formats) (while (and fmts (null buffer)) - (setq name (file-truename - (file-name-concat thisdir (format (car fmts) filename))) + (setq name (safe-expand-file-name thisdir (format (car fmts) filename)) buffer (and (file-exists-p name) (find-file-noselect name)) fmts (cdr fmts))) @@ -3227,8 +3234,7 @@ attempts to find a file whose name is produced by (format FMT FILENAME)." (ding) (sit-for 2)) ((and (file-directory-p name) (not (file-exists-p - (setq name (file-truename - (file-name-concat name filename)))))) + (setq name (safe-expand-file-name name filename))))) (message "No `%s' in directory %s" filename origname) (ding) (sit-for 2)) (t -- cgit v1.2.3 From 409985288dc83b20b4af2ce4072177fdc06b6ad7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Jan 2024 12:33:44 +0200 Subject: Fix last change (bug#67930) * lisp/progmodes/compile.el (compilation--expand-fn): Renamed from 'safe-expand-file-name'; all callers changed. Doc fix. --- lisp/progmodes/compile.el | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 3002cd1b86c..e7d4e9966cf 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -3123,10 +3123,10 @@ and overlay is highlighted between MK and END-MK." (remove-hook 'pre-command-hook #'compilation-goto-locus-delete-o)) -(defun safe-expand-file-name (directory filename) - "Expand the specified filename using expand-file-name. If this fails, -retry with file-truename (see bug #8035) -Unlike expand-file-name, file-truename follows symlinks which we try to avoid if possible." +(defun compilation--expand-fn (directory filename) + "Expand FILENAME or resolve its true name. +Unlike `expand-file-name', `file-truename' follows symlinks, which +we try to avoid if possible." (let* ((expandedname (expand-file-name filename directory))) (if (file-exists-p expandedname) expandedname @@ -3152,7 +3152,8 @@ Unlike expand-file-name, file-truename follows symlinks which we try to avoid if fmts formats) ;; For each directory, try each format string. (while (and fmts (null buffer)) - (setq name (safe-expand-file-name thisdir (format (car fmts) filename)) + (setq name (compilation--expand-fn thisdir + (format (car fmts) filename)) buffer (and (file-exists-p name) (find-file-noselect name)) fmts (cdr fmts))) @@ -3174,7 +3175,8 @@ Unlike expand-file-name, file-truename follows symlinks which we try to avoid if (setq thisdir (car dirs) fmts formats) (while (and fmts (null buffer)) - (setq name (safe-expand-file-name thisdir (format (car fmts) filename)) + (setq name (compilation--expand-fn thisdir + (format (car fmts) filename)) buffer (and (file-exists-p name) (find-file-noselect name)) fmts (cdr fmts))) @@ -3234,7 +3236,7 @@ attempts to find a file whose name is produced by (format FMT FILENAME)." (ding) (sit-for 2)) ((and (file-directory-p name) (not (file-exists-p - (setq name (safe-expand-file-name name filename))))) + (setq name (compilation--expand-fn name filename))))) (message "No `%s' in directory %s" filename origname) (ding) (sit-for 2)) (t -- cgit v1.2.3 From d9dabcacefad084cccaa32e4f5fffcb78728fa00 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Jan 2024 12:44:26 +0200 Subject: ; Minor copyedits of doc of 'handler-bind' * doc/lispref/control.texi (Handling Errors): Fix wording and punctuation. --- doc/lispref/control.texi | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 3c9f26262c1..0c6895332a0 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -2325,16 +2325,17 @@ error description. Contrary to what happens with @code{condition-case}, @var{handler} is called in the dynamic context where the error happened. This means it -is executed unbinding any variable bindings or running any cleanups of -@code{unwind-protect}, so that all those dynamic bindings are still in -effect. There is one exception: while running the @var{handler} -function, all the error handlers between the code that signaled the -error and the @code{handler-bind} are temporarily suspended, meaning -that when an error is signaled, Emacs will only search the active -@code{condition-case} and @code{handler-bind} forms that are inside -the @var{handler} function or outside of the current -@code{handler-bind}. Note also that lexical variables are not -affected, since they do not have dynamic extent. +is executed without unbinding any variable bindings or running any +cleanups of @code{unwind-protect}, so that all those dynamic bindings +are still in effect. There is one exception: while running the +@var{handler} function, all the error handlers between the code that +signaled the error and the @code{handler-bind} are temporarily +suspended, meaning that when an error is signaled, Emacs will only +search the active @code{condition-case} and @code{handler-bind} forms +that are inside the @var{handler} function or outside of the current +@code{handler-bind}. Note also that lexically-bound variables +(@pxref{Lexical Binding}) are not affected, since they do not have +dynamic extent. Like any normal function, @var{handler} can exit non-locally, typically via @code{throw}, or it can return normally. @@ -2391,10 +2392,10 @@ We can get almost the same result with @code{condition-case}: @noindent but with the difference that when we (re)signal the new error in -@code{handler-bind} the dynamic environment from the original error is -still active, which means for example that if we enter the -debugger at this point, it will show us a complete backtrace including -the point where we signaled the original error: +@code{handler-bind}, the dynamic environment from the original error +is still active, which means for example that if we enter the debugger +at this point, it will show us a complete backtrace including the +point where we signaled the original error: @example @group -- cgit v1.2.3 From 466d1c98a9ef7490332469165f63a38c2b07a05d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Jan 2024 13:26:29 +0200 Subject: Fix icons.el when icon does not exist as a file * lisp/emacs-lisp/icons.el (icons--create): Handle the case when ICON is a file that doesn't exists or is unreadable. Suggested by David Ponce . (Bug#66846) --- lisp/emacs-lisp/icons.el | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el index a35a00ec1f3..1fc0e39f9fe 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -187,11 +187,13 @@ present if the icon is represented by an image." merged) (cl-defmethod icons--create ((_type (eql 'image)) icon keywords) - (let ((file (if (file-name-absolute-p icon) - icon - (and (fboundp 'image-search-load-path) - (image-search-load-path icon))))) - (and (display-images-p) + (let* ((file (if (file-name-absolute-p icon) + icon + (and (fboundp 'image-search-load-path) + (image-search-load-path icon)))) + (file-exists (and (stringp file) (file-readable-p file)))) + (and file-exists + (display-images-p) (fboundp 'image-supported-file-p) (image-supported-file-p file) (propertize -- cgit v1.2.3 From bf7034048c16a95263e3f7c121dafbf1824ff28f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Jan 2024 13:45:33 +0200 Subject: ; * doc/emacs/custom.texi (Changing a Variable): Update example (bug#68279). --- doc/emacs/custom.texi | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index b45e0ef953d..4bd78f3ce83 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -188,14 +188,15 @@ find with @kbd{M-x customize-browse}. the customization buffer: @smallexample -[Hide] Kill Ring Max: 60 +[Hide] Kill Ring Max: Integer (positive or zero): 120 [State]: STANDARD. Maximum length of kill ring before oldest elements are thrown away. @end smallexample The first line shows that the variable is named @code{kill-ring-max}, formatted as @samp{Kill Ring Max} for easier -viewing. Its value is @samp{120}. The button labeled @samp{[Hide]}, +viewing, and also shows its expected type: a positive integer or zero. +The default value is @samp{120}. The button labeled @samp{[Hide]}, if activated, hides the variable's value and state; this is useful to avoid cluttering up the customization buffer with very long values (for this reason, variables that have very long values may start out -- cgit v1.2.3 From 6184e120c0e1b52d9bbf359131dd8da35654cea1 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Jan 2024 15:25:29 +0200 Subject: ; * doc/lispref/buffers.texi (Buffer List): Fix merge snafu. --- doc/lispref/buffers.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 4994d8c2252..77f5f09c7bd 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -959,8 +959,8 @@ infinite recursion. @defun buffer-match-p condition buffer-or-name &rest args This function checks if a buffer designated by @code{buffer-or-name} -satisfies the specified @var{condition}. Optional third argument -@var{arg} is passed to the predicate function in @var{condition}. A +satisfies the specified @var{condition}. Optional arguments +@var{args} are passed to the predicate function in @var{condition}. A valid @var{condition} can be one of the following: @itemize @bullet{} @item -- cgit v1.2.3 From 16162e0645d959d824d97e3f9908e46d401e8028 Mon Sep 17 00:00:00 2001 From: Steven Allen Date: Fri, 29 Dec 2023 09:53:05 -0800 Subject: Make 'advice-remove' interactive `ad-advice-remove' is already interactive, but it doesn't work with new-style advice. * lisp/emacs-lisp/nadvice.el (advice-remove): Make it interactive (Bug#67926). * doc/lispref/functions.texi (Advising Named Functions): Document that 'advice-remove' is now an interactive command. --- doc/lispref/functions.texi | 8 +++++--- etc/NEWS | 4 ++++ lisp/emacs-lisp/nadvice.el | 26 ++++++++++++++++++++++++++ 3 files changed, 35 insertions(+), 3 deletions(-) diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 2b2c9287d91..29e9f04a076 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -2077,10 +2077,12 @@ Add the advice @var{function} to the named function @var{symbol}. (@pxref{Core Advising Primitives}). @end defun -@defun advice-remove symbol function +@deffn Command advice-remove symbol function Remove the advice @var{function} from the named function @var{symbol}. -@var{function} can also be the @code{name} of a piece of advice. -@end defun +@var{function} can also be the @code{name} of a piece of advice. When +called interactively, prompt for both an advised @var{function} and +the advice to remove. +@end deffn @defun advice-member-p function symbol Return non-@code{nil} if the advice @var{function} is already in the named diff --git a/etc/NEWS b/etc/NEWS index 7bbfbf9512d..3a1168f62b3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -104,6 +104,10 @@ to your init: * Changes in Emacs 30.1 +** 'advice-remove' is now an interactive command. +When called interactively, 'advice-remove' now prompts for an advised +function to the advice to remove. + ** Emacs now supports Unicode Standard version 15.1. ** Network Security Manager diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 0d45b4b95fa..de287e43b21 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -539,6 +539,32 @@ Contrary to `remove-function', this also works when SYMBOL is a macro or an autoload and it preserves `fboundp'. Instead of the actual function to remove, FUNCTION can also be the `name' of the piece of advice." + (interactive + (let* ((pred (lambda (sym) (advice--p (advice--symbol-function sym)))) + (default (when-let* ((f (function-called-at-point)) + ((funcall pred f))) + (symbol-name f))) + (prompt (format-prompt "Remove advice from function" default)) + (symbol (intern (completing-read prompt obarray pred t nil nil default))) + advices) + (advice-mapc (lambda (f p) + (let ((k (or (alist-get 'name p) f))) + (push (cons + ;; "name" (string) and 'name (symbol) are + ;; considered different names so we use + ;; `prin1-to-string' even if the name is + ;; a string to distinguish between these + ;; two cases. + (prin1-to-string k) + ;; We use `k' here instead of `f' because + ;; the same advice can have multiple + ;; names. + k) + advices))) + symbol) + (list symbol (cdr (assoc-string + (completing-read "Advice to remove: " advices nil t) + advices))))) (let ((f (symbol-function symbol))) (remove-function (cond ;This is `advice--symbol-function' but as a "place". ((get symbol 'advice--pending) -- cgit v1.2.3 From 2a8c00bfc073d8c42c5c325289a8eada2ae5b309 Mon Sep 17 00:00:00 2001 From: Jean-Christophe Helary Date: Sat, 6 Jan 2024 15:55:58 +0000 Subject: * doc/emacs/back.texi: Fix a typo. --- doc/emacs/back.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/emacs/back.texi b/doc/emacs/back.texi index b8094c6cf36..ff6905d8b02 100644 --- a/doc/emacs/back.texi +++ b/doc/emacs/back.texi @@ -78,7 +78,7 @@ And much more! Emacs comes with an introductory online tutorial available in many languages, and this nineteenth edition of the manual picks up where that tutorial ends. It explains the full range of the power of Emacs, -now up to @strong[version 27.2,} and contains reference material +now up to @strong{version 27.2,} and contains reference material useful to expert users. It also includes appendices with specific material about X and GTK resources, and with details for users of macOS and Microsoft Windows. -- cgit v1.2.3 From e48a396d4ba1694e083f900dda1f41cc41d00ead Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 6 Jan 2024 18:12:47 +0100 Subject: Adapt Tramp version * doc/misc/trampver.texi: * lisp/net/trampver.el (tramp-version): Adapt Tramp versions. --- doc/misc/trampver.texi | 2 +- lisp/net/trampver.el | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index a239c091889..8cb0e3d574a 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -7,7 +7,7 @@ @c In the Tramp GIT, the version number and the bug report address @c are auto-frobbed from configure.ac. -@set trampver 2.7.0-pre +@set trampver 2.7.0 @set trampurl https://www.gnu.org/software/tramp/ @set tramp-bug-report-address tramp-devel@@gnu.org @set emacsver 27.1 diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index bfabbbeaf34..4b8868561d4 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.7.0-pre +;; Version: 2.7.0 ;; Package-Requires: ((emacs "27.1")) ;; Package-Type: multi ;; URL: https://www.gnu.org/software/tramp/ @@ -40,7 +40,7 @@ ;; ./configure" to change them. ;;;###tramp-autoload -(defconst tramp-version "2.7.0-pre" +(defconst tramp-version "2.7.0" "This version of Tramp.") ;;;###tramp-autoload @@ -78,7 +78,7 @@ ;; Check for Emacs version. (let ((x (if (not (string-version-lessp emacs-version "27.1")) "ok" - (format "Tramp 2.7.0-pre is not fit for %s" + (format "Tramp 2.7.0 is not fit for %s" (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) -- cgit v1.2.3 From 3071f6981d5b93b77abbd5cf4a36e15b0b410f3d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 6 Jan 2024 18:14:15 +0100 Subject: Minor change in tramp.texi * doc/misc/tramp.texi (Obtaining @value{tramp}): Mention the ELPA Tramp manual. --- doc/misc/tramp.texi | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 7e938d0f97f..56945d3071c 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -321,7 +321,7 @@ behind the scenes when you open a file with @value{tramp}. @cindex GNU ELPA @vindex tramp-version -@value{tramp} is included as part of Emacs (since @w{Emacs 22.1}). +@value{tramp} is included as part of Emacs. @value{tramp} is also freely packaged for download on the Internet at @uref{https://ftp.gnu.org/gnu/tramp/}. The version number of @@ -343,10 +343,12 @@ versions packaged with Emacs can be retrieved by @end lisp @value{tramp} is also available as @uref{https://elpa.gnu.org, GNU -ELPA} package. Besides the standalone releases, further minor versions -of @value{tramp} will appear on GNU ELPA, until the next @value{tramp} -release appears. These minor versions have a four-number string, like -``2.4.5.1''. +ELPA} package. Besides the standalone releases, further minor +versions of @value{tramp} will appear on GNU ELPA, until the next +@value{tramp} release appears. These minor versions have a +four-number string, like ``2.4.5.1''. The manual of the latest +@value{tramp} ELPA package is located at +@uref{https://elpa.gnu.org/packages/doc/tramp.html}. @value{tramp} development versions are available on Git servers. Development versions contain new and incomplete features. The -- cgit v1.2.3 From 166b10e9f80dc78147601a87b6425f59860bcfe4 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 6 Jan 2024 18:15:23 +0100 Subject: Complete change of ert-remote-temporary-file-directory * lisp/emacs-lisp/ert-x.el: Adapt comment. * test/lisp/net/tramp-tests.el (ert-remote-temporary-file-directory): Make it a defvar. --- lisp/emacs-lisp/ert-x.el | 2 +- test/lisp/net/tramp-tests.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index a6d2fe4a1da..cd60f9f457f 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -540,7 +540,7 @@ The same keyword arguments are supported as in (when (and (featurep 'tramp) (getenv "EMACS_HYDRA_CI")) (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) -;; If this defconst is used in a test file, `tramp' shall be loaded +;; If this defvar is used in a test file, `tramp' shall be loaded ;; prior `ert-x'. There is no default value on w32 systems, which ;; could work out of the box. (defvar ert-remote-temporary-file-directory diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 3216a8be1b0..91b0542c759 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -134,7 +134,7 @@ A resource file is in the resource directory as per (eval-and-compile ;; There is no default value on w32 systems, which could work out ;; of the box. - (defconst ert-remote-temporary-file-directory + (defvar ert-remote-temporary-file-directory (cond ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY")) ((eq system-type 'windows-nt) null-device) -- cgit v1.2.3 From 8729a2a10d9b8d88f6ba33b5ce62f74d89e7788a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Jan 2024 19:30:16 +0200 Subject: Fix 'rmail-summary-by-thread' * lisp/mail/rmailsum.el (rmail-summary-by-thread): Call 'rmail-new-summary' from the original buffer, not from 'rmail-buffer' to avoid failing the logic in 'rmail-new-summary' that decides whether to pop up a new window. Reported by Andrea Monaco . --- lisp/mail/rmailsum.el | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 30fe75f7e5c..cccd702dae2 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -436,19 +436,19 @@ headers of the messages." (unless (and rmail-summary-message-parents-vector (= (length rmail-summary-message-parents-vector) (1+ rmail-total-messages))) - (rmail-summary-fill-message-parents-and-descs-vectors)) - (let ((enc-msgs (make-bool-vector (1+ rmail-total-messages) nil))) - (rmail-summary--walk-thread-message-recursively msgnum enc-msgs) - (rmail-new-summary (format "thread containing message %d" msgnum) - (list 'rmail-summary-by-thread msgnum) - (if (and rmail-summary-progressively-narrow - (rmail-summary--exists-1)) - (lambda (msg _msgnum) - (and (aref rmail-summary-currently-displayed-msgs msg) - (aref enc-msgs msg))) + (rmail-summary-fill-message-parents-and-descs-vectors))) + (let ((enc-msgs (make-bool-vector (1+ rmail-total-messages) nil))) + (rmail-summary--walk-thread-message-recursively msgnum enc-msgs) + (rmail-new-summary (format "thread containing message %d" msgnum) + (list 'rmail-summary-by-thread msgnum) + (if (and rmail-summary-progressively-narrow + (rmail-summary--exists-1)) (lambda (msg _msgnum) - (aref enc-msgs msg))) - msgnum)))) + (and (aref rmail-summary-currently-displayed-msgs msg) + (aref enc-msgs msg))) + (lambda (msg _msgnum) + (aref enc-msgs msg))) + msgnum))) ;;;###autoload (defun rmail-summary-by-labels (labels) -- cgit v1.2.3 From 0b312e310db2b06113f2b09d90951f82e8edf02f Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 6 Jan 2024 13:38:13 -0800 Subject: Pacify Ubuntu GCC 13.2 in set_marker_internal * src/marker.c (set_marker_internal): Ignore -Wanalyzer-deref-before-check, to work around GCC bug 113253. --- src/marker.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/marker.c b/src/marker.c index 377f6fbe8db..0101e144b4d 100644 --- a/src/marker.c +++ b/src/marker.c @@ -20,6 +20,11 @@ along with GNU Emacs. If not, see . */ #include +/* Work around GCC bug 113253. */ +#if 13 <= __GNUC__ +# pragma GCC diagnostic ignored "-Wanalyzer-deref-before-check" +#endif + #include "lisp.h" #include "character.h" #include "buffer.h" -- cgit v1.2.3 From 4411d98c47576d5d47ea17269617b7c5a0f04f3c Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 6 Jan 2024 13:39:57 -0800 Subject: Pacify Ubuntu GCC 13.2 in x_get_local_selection * src/xselect.c: Ignore -Wanalyzer-null-dereference, to work around GCC bug 102671. --- src/xselect.c | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/xselect.c b/src/xselect.c index bb82798bb62..fd0f06eeed9 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -19,6 +19,12 @@ along with GNU Emacs. If not, see . */ /* Rewritten by jwz */ #include + +/* Work around GCC bug 102671. */ +#if 10 <= __GNUC__ +# pragma GCC diagnostic ignored "-Wanalyzer-null-dereference" +#endif + #include #ifdef HAVE_SYS_TYPES_H -- cgit v1.2.3 From 73cb931e5bab1b956f0569cd542468cfa7f4c9a7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 6 Jan 2024 18:50:25 -0500 Subject: (describe-package-1): Fix bug#68288 Fix support for multiple maintainers in `describe-package` and in `package-report-bug`. * lisp/emacs-lisp/package.el (describe-package-1): There's no `:maintainers:`, instead `:maintainer` can hold a list of maintainers. (package-maintainers): Adapt to the possibility of having multiple maintainers. (package-report-bug): Don't burp if the package is not installed. --- lisp/emacs-lisp/package.el | 38 ++++++++++++++++++++++---------------- 1 file changed, 22 insertions(+), 16 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 8df2088ce43..b21e0f8fc51 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2804,8 +2804,7 @@ Helper function for `describe-package'." (status (if desc (package-desc-status desc) "orphan")) (incompatible-reason (package--incompatible-p desc)) (signed (if desc (package-desc-signed desc))) - (maintainers (or (cdr (assoc :maintainers extras)) - (list (cdr (assoc :maintainer extras))))) + (maintainers (cdr (assoc :maintainer extras))) (authors (cdr (assoc :authors extras))) (news (and-let* (pkg-dir ((not built-in)) @@ -4699,18 +4698,23 @@ will be signaled in that case." (let* ((name (package-desc-name pkg-desc)) (extras (package-desc-extras pkg-desc)) (maint (alist-get :maintainer extras))) + (unless (listp (cdr maint)) + (setq maint (list maint))) (cond ((and (null maint) (null no-error)) (user-error "Package `%s' has no explicit maintainer" name)) ((and (not (progn (require 'ietf-drums) - (ietf-drums-parse-address (cdr maint)))) + (ietf-drums-parse-address (cdar maint)))) (null no-error)) (user-error "Package `%s' has no maintainer address" name)) - ((not (null maint)) + (t (with-temp-buffer - (package--print-email-button maint) - (string-trim (substring-no-properties (buffer-string)))))))) + (mapc #'package--print-email-button maint) + (replace-regexp-in-string + "\n" ", " (string-trim + (buffer-substring-no-properties + (point-min) (point-max))))))))) ;;;###autoload (defun package-report-bug (desc) @@ -4720,17 +4724,19 @@ DESC must be a `package-desc' object." package-menu-mode) (let ((maint (package-maintainers desc)) (name (symbol-name (package-desc-name desc))) + (pkgdir (package-desc-dir desc)) vars) - (dolist-with-progress-reporter (group custom-current-group-alist) - "Scanning for modified user options..." - (when (and (car group) - (file-in-directory-p (car group) (package-desc-dir desc))) - (dolist (ent (get (cdr group) 'custom-group)) - (when (and (custom-variable-p (car ent)) - (boundp (car ent)) - (not (eq (custom--standard-value (car ent)) - (default-toplevel-value (car ent))))) - (push (car ent) vars))))) + (when pkgdir + (dolist-with-progress-reporter (group custom-current-group-alist) + "Scanning for modified user options..." + (when (and (car group) + (file-in-directory-p (car group) pkgdir)) + (dolist (ent (get (cdr group) 'custom-group)) + (when (and (custom-variable-p (car ent)) + (boundp (car ent)) + (not (eq (custom--standard-value (car ent)) + (default-toplevel-value (car ent))))) + (push (car ent) vars)))))) (dlet ((reporter-prompt-for-summary-p t)) (reporter-submit-bug-report maint name vars)))) -- cgit v1.2.3 From b5de9ae8010684a5ed0c6f2703077a61d325ccad Mon Sep 17 00:00:00 2001 From: João Távora Date: Sat, 6 Jan 2024 17:56:33 -0600 Subject: Eglot: careful when invoking code actions on no symbol at all Invoking code actions without a marked region or over a symbol will trip certain servers up since BEG and END in eglot-code-actions will be nil, causing 'eglot--pos-to-lsp-position' to assume point (which is OK) but the 'flymake-diagnostics' call to return all diagnostics. This causes an absolutely undecipherable JavaScript backtrace to be sent back to Eglot from typescript-language-server. Github-reference: https://github.com/joaotavora/eglot/issues/847 * lisp/progmodes/eglot.el (eglot--code-action-bounds): Avoid returning (list nil nil) --- lisp/progmodes/eglot.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index d330e6e23cb..ba2cc72a6b4 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -3605,16 +3605,17 @@ edit proposed by the server." (defun eglot--code-action-bounds () "Calculate appropriate bounds depending on region and point." - (let (diags) + (let (diags boftap) (cond ((use-region-p) `(,(region-beginning) ,(region-end))) ((setq diags (flymake-diagnostics (point))) (cl-loop for d in diags minimizing (flymake-diagnostic-beg d) into beg maximizing (flymake-diagnostic-end d) into end finally (cl-return (list beg end)))) + ((setq boftap (bounds-of-thing-at-point 'sexp)) + (list (car boftap) (cdr boftap))) (t - (let ((boftap (bounds-of-thing-at-point 'sexp))) - (list (car boftap) (cdr boftap))))))) + (list (point) (point)))))) (defun eglot-code-actions (beg &optional end action-kind interactive) "Find LSP code actions of type ACTION-KIND between BEG and END. -- cgit v1.2.3 From f866c85ac4e32df8061b285b6b44b15346994f3d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 7 Jan 2024 00:02:08 -0500 Subject: (jsonrpc--log-event): Try and fix bug#68072 * lisp/jsonrpc.el (jsonrpc--log-event): Force the use of `lisp-indent-function` in `pp-to-string`. --- lisp/jsonrpc.el | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 3f33443f321..f0f5842a0ee 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -1003,16 +1003,17 @@ of the API instead.") (or method "") (if id (format "[%s]" id) ""))))) (msg - (cond ((eq format 'full) - (format "%s%s\n" preamble (or json log-text))) - ((eq format 'short) - (format "%s%s\n" preamble (or log-text ""))) - (t - (format "%s%s" preamble - (or (and foreign-message - (concat "\n" (pp-to-string - foreign-message))) - (concat log-text "\n"))))))) + (pcase format + ('full (format "%s%s\n" preamble (or json log-text))) + ('short (format "%s%s\n" preamble (or log-text ""))) + (_ + (format "%s%s" preamble + (or (and foreign-message + (let ((lisp-indent-function ;bug#68072 + #'lisp-indent-function)) + (concat "\n" (pp-to-string + foreign-message)))) + (concat log-text "\n"))))))) (goto-char (point-max)) ;; XXX: could use `run-at-time' to delay server logs ;; slightly to play nice with verbose servers' stderr. -- cgit v1.2.3 From aadcb906095e8588ed6302920bf835df20ab320f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 7 Jan 2024 12:39:47 +0100 Subject: Handle local default directory in connection-local-value * lisp/files-x.el (connection-local-p, connection-local-value): Handle local `default-directory'. * test/lisp/files-x-tests.el (files-x-test-connection-local-value): Extend test. --- lisp/files-x.el | 27 +++++++++++++++++---------- test/lisp/files-x-tests.el | 43 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 60 insertions(+), 10 deletions(-) diff --git a/lisp/files-x.el b/lisp/files-x.el index fccb2fa4a9f..f70be5f7ff3 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -929,19 +929,23 @@ earlier in the `setq-connection-local'. The return value of the ;;;###autoload (defmacro connection-local-p (variable &optional application) "Non-nil if VARIABLE has a connection-local binding in `default-directory'. +`default-directory' must be a remote file name. If APPLICATION is nil, the value of `connection-local-default-application' is used." (declare (debug (symbolp &optional form))) (unless (symbolp variable) (signal 'wrong-type-argument (list 'symbolp variable))) - `(let (connection-local-variables-alist file-local-variables-alist) - (hack-connection-local-variables - (connection-local-criteria-for-default-directory ,application)) - (and (assq ',variable connection-local-variables-alist) t))) + `(let ((criteria + (connection-local-criteria-for-default-directory ,application)) + connection-local-variables-alist file-local-variables-alist) + (when criteria + (hack-connection-local-variables criteria) + (and (assq ',variable connection-local-variables-alist) t)))) ;;;###autoload (defmacro connection-local-value (variable &optional application) "Return connection-local VARIABLE for APPLICATION in `default-directory'. +`default-directory' must be a remote file name. If APPLICATION is nil, the value of `connection-local-default-application' is used. If VARIABLE does not have a connection-local binding, the return @@ -949,12 +953,15 @@ value is the default binding of the variable." (declare (debug (symbolp &optional form))) (unless (symbolp variable) (signal 'wrong-type-argument (list 'symbolp variable))) - `(let (connection-local-variables-alist file-local-variables-alist) - (hack-connection-local-variables - (connection-local-criteria-for-default-directory ,application)) - (if-let ((result (assq ',variable connection-local-variables-alist))) - (cdr result) - ,variable))) + `(let ((criteria + (connection-local-criteria-for-default-directory ,application)) + connection-local-variables-alist file-local-variables-alist) + (if (not criteria) + ,variable + (hack-connection-local-variables criteria) + (if-let ((result (assq ',variable connection-local-variables-alist))) + (cdr result) + ,variable)))) ;;;###autoload (defun path-separator () diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el index a2f16d5ae35..528467a5641 100644 --- a/test/lisp/files-x-tests.el +++ b/test/lisp/files-x-tests.el @@ -553,6 +553,49 @@ If it's not initialized yet, initialize it." (should-not (boundp 'remote-shell-file-name)) (should (string-equal (symbol-value 'remote-null-device) "null")))) + ;; `connection-local-value' and `connection-local-p' care about a + ;; local default directory. + (with-temp-buffer + (let ((enable-connection-local-variables t) + (default-directory temporary-file-directory) + (remote-null-device "null")) + (should-not connection-local-variables-alist) + (should-not (local-variable-p 'remote-shell-file-name)) + (should-not (local-variable-p 'remote-null-device)) + (should-not (boundp 'remote-shell-file-name)) + (should (string-equal (symbol-value 'remote-null-device) "null")) + + ;; The recent variable values are used. + (should-not (connection-local-p remote-shell-file-name)) + ;; `remote-shell-file-name' is not defined, so we get an error. + (should-error + (connection-local-value remote-shell-file-name) :type 'void-variable) + (should-not (connection-local-p remote-null-device)) + (should + (string-equal + (connection-local-value remote-null-device) remote-null-device)) + (should-not (connection-local-p remote-lazy-var)) + + ;; Run with a different application. + (should-not + (connection-local-p + remote-shell-file-name (cadr files-x-test--application))) + ;; `remote-shell-file-name' is not defined, so we get an error. + (should-error + (connection-local-value + remote-shell-file-name (cadr files-x-test--application)) + :type 'void-variable) + (should-not + (connection-local-p + remote-null-device (cadr files-x-test--application))) + (should + (string-equal + (connection-local-value + remote-null-device (cadr files-x-test--application)) + remote-null-device)) + (should-not + (connection-local-p remote-lazy-var (cadr files-x-test--application))))) + ;; Cleanup. (custom-set-variables `(connection-local-profile-alist ',clpa now) -- cgit v1.2.3 From 1b123972636d717241a38bcd6daa3e3f424fb8b0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 7 Jan 2024 17:15:18 +0200 Subject: ; Don't record multiple versions of use-package * lisp/use-package/use-package-ensure-system-package.el: Remove Version: header, to avoid confusing loaddefs-gene. (Bug#68304) --- lisp/use-package/use-package-ensure-system-package.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/use-package/use-package-ensure-system-package.el b/lisp/use-package/use-package-ensure-system-package.el index 12bf16998a1..3e369d99624 100644 --- a/lisp/use-package/use-package-ensure-system-package.el +++ b/lisp/use-package/use-package-ensure-system-package.el @@ -5,7 +5,6 @@ ;; Author: Justin Talbott ;; Keywords: convenience, tools, extensions ;; URL: https://github.com/waymondo/use-package-ensure-system-package -;; Version: 0.2 ;; Package-Requires: ((use-package "2.1") (system-packages "1.0.4")) ;; Filename: use-package-ensure-system-package.el ;; Package: use-package -- cgit v1.2.3 From 18de131222ee24c4088ac45be1babad26284af5b Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 7 Jan 2024 20:04:06 +0200 Subject: Support more metadata properties in completion-category-overrides (bug#68214) * doc/lispref/minibuf.texi (Completion Variables): Add to the table of completion-category-overrides new items: `cycle-sort-function', `group-function', `annotation-function', `affixation-function'. * lisp/minibuffer.el (completion-metadata-get): Try also to get the property from completion-category-overrides by category. Suggested by Daniel Mendler . (completion-category-defaults): Add new properties to docstring. (completion-category-overrides): Add customization for new properties: `cycle-sort-function', `group-function', `annotation-function', `affixation-function'. (completion-metadata-override-get): Remove function. (minibuffer-completion-help): Replace 'completion-metadata-override-get' with 'completion-metadata-get' for 'display-sort-function'. --- doc/lispref/minibuf.texi | 15 +++++++++++++- etc/NEWS | 10 ++++++---- lisp/minibuffer.el | 51 +++++++++++++++++++++++++++++++++++++----------- 3 files changed, 60 insertions(+), 16 deletions(-) diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 8aed1515764..8d25a53161e 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1879,17 +1879,30 @@ The value should be a value for @code{completion-cycle-threshold} (@pxref{Completion Options,,, emacs, The GNU Emacs Manual}) for this category. +@item cycle-sort-function +The function to sort entries when cycling. + @item display-sort-function +The function to sort entries in the @file{*Completions*} buffer. The possible values are: @code{nil}, which means to use either the sorting function from metadata or if that is @code{nil}, fall back to @code{completions-sort}; @code{identity}, which means not to sort at all, leaving the original order; or any other value out of those used in @code{completions-sort} (@pxref{Completion Options,,, emacs, The GNU Emacs Manual}). + +@item group-function +The function to group completions. + +@item annotation-function +The function to add annotations to completions. + +@item affixation-function +The function to add prefixes and suffixes to completions. @end table @noindent -Additional alist entries may be defined in the future. +See @ref{Programmed Completion}, for a complete list of metadata entries. @end defopt @defvar completion-extra-properties diff --git a/etc/NEWS b/etc/NEWS index 3a1168f62b3..c3d777b971f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -745,10 +745,12 @@ will be first sorted alphabetically, and then re-sorted by their order in the minibuffer history, with more recent candidates appearing first. +++ -*** 'completion-category-overrides' supports 'display-sort-function'. -You can now customize the sorting order for any category in -'completion-category-overrides' that will override the sorting order -defined in the metadata or in 'completions-sort'. +*** 'completion-category-overrides' supports more metadata. +The new supported completion properties are 'cycle-sort-function', +'display-sort-function', 'annotation-function', 'affixation-function', +'group-function'. You can now customize them for any category in +'completion-category-overrides' that will override the properties +defined in completion metadata. ** Pcomplete diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index b7aebae63a8..04b36f03d11 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -151,7 +151,15 @@ The metadata of a completion table should be constant between two boundaries." minibuffer-completion-predicate)) (defun completion-metadata-get (metadata prop) - (cdr (assq prop metadata))) + "Get PROP from completion METADATA. +If the metadata specifies a completion category, the variables +`completion-category-overrides' and +`completion-category-defaults' take precedence." + (if-let (((not (eq prop 'category))) + (cat (alist-get 'category metadata)) + (over (completion--category-override cat prop))) + (cdr over) + (alist-get prop metadata))) (defun complete-with-action (action collection string predicate) "Perform completion according to ACTION. @@ -1138,27 +1146,38 @@ styles for specific categories, such as files, buffers, etc." (symbol-help (styles . (basic shorthand substring))) (calendar-month (display-sort-function . identity))) "Default settings for specific completion categories. + Each entry has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: - `styles': the list of `completion-styles' to use for that category. - `cycle': the `completion-cycle-threshold' to use for that category. -- `display-sort-function': the sorting function. +- `cycle-sort-function': function to sort entries when cycling. +- `display-sort-function': function to sort entries in *Completions*. +- `group-function': function for grouping the completion candidates. +- `annotation-function': function to add annotations in *Completions*. +- `affixation-function': function to prepend/append a prefix/suffix. + Categories are symbols such as `buffer' and `file', used when completing buffer and file names, respectively. Also see `completion-category-overrides'.") (defcustom completion-category-overrides nil - "List of category-specific user overrides for completion styles. + "List of category-specific user overrides for completion metadata. Each override has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: - `styles': the list of `completion-styles' to use for that category. - `cycle': the `completion-cycle-threshold' to use for that category. +- `cycle-sort-function': function to sort entries when cycling. - `display-sort-function': nil means to use either the sorting function from metadata, or if that is nil, fall back to `completions-sort'; `identity' disables sorting and keeps the original order; and other possible values are the same as in `completions-sort'. +- `group-function': function for grouping the completion candidates. +- `annotation-function': function to add annotations in *Completions*. +- `affixation-function': function to prepend/append a prefix/suffix. +See more description of metadata in `completion-metadata'. Categories are symbols such as `buffer' and `file', used when completing buffer and file names, respectively. @@ -1180,6 +1199,10 @@ overrides the default specified in `completion-category-defaults'." (cons :tag "Completion Cycling" (const :tag "Select one value from the menu." cycle) ,completion--cycling-threshold-type) + (cons :tag "Cycle Sorting" + (const :tag "Select one value from the menu." + cycle-sort-function) + (choice (function :tag "Custom function"))) (cons :tag "Completion Sorting" (const :tag "Select one value from the menu." display-sort-function) @@ -1189,18 +1212,24 @@ overrides the default specified in `completion-category-defaults'." minibuffer-sort-alphabetically) (const :tag "Historical sorting" minibuffer-sort-by-history) - (function :tag "Custom function")))))) + (function :tag "Custom function"))) + (cons :tag "Completion Groups" + (const :tag "Select one value from the menu." + group-function) + (choice (function :tag "Custom function"))) + (cons :tag "Completion Annotation" + (const :tag "Select one value from the menu." + annotation-function) + (choice (function :tag "Custom function"))) + (cons :tag "Completion Affixation" + (const :tag "Select one value from the menu." + affixation-function) + (choice (function :tag "Custom function")))))) (defun completion--category-override (category tag) (or (assq tag (cdr (assq category completion-category-overrides))) (assq tag (cdr (assq category completion-category-defaults))))) -(defun completion-metadata-override-get (metadata prop) - (if-let ((cat (completion-metadata-get metadata 'category)) - (over (completion--category-override cat prop))) - (cdr over) - (completion-metadata-get metadata prop))) - (defun completion--styles (metadata) (let* ((cat (completion-metadata-get metadata 'category)) (over (completion--category-override cat 'styles))) @@ -2546,7 +2575,7 @@ The candidate will still be chosen by `choose-completion' unless (aff-fun (or (completion-metadata-get all-md 'affixation-function) (plist-get completion-extra-properties :affixation-function))) - (sort-fun (completion-metadata-override-get all-md 'display-sort-function)) + (sort-fun (completion-metadata-get all-md 'display-sort-function)) (group-fun (completion-metadata-get all-md 'group-function)) (mainbuf (current-buffer)) ;; If the *Completions* buffer is shown in a new -- cgit v1.2.3 From 94f760163e221587fbba08a31e81c19527f037fe Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 6 Jan 2024 13:32:42 -0800 Subject: ; doc/misc/erc.texi: Improve SASL intro. --- doc/misc/erc.texi | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 7fbe6f9766e..52c7477c9dd 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -1048,13 +1048,19 @@ acceptable. @section Authenticating via SASL @cindex SASL -Regardless of the mechanism or the network, you'll likely have to be -registered before first use. Please refer to the network's own +If you've used @acronym{SASL} elsewhere, you can probably skip to the +examples below. Otherwise, if you haven't already registered with +your network, please do so now, referring to the network's own instructions for details. If you're new to IRC and using a bouncer, -know that you probably won't be needing SASL for the client-to-bouncer -connection. To get started, just add @code{sasl} to -@code{erc-modules} like any other module. But before that, please -explore all custom options pertaining to your chosen mechanism. +know that you probably won't be needing this for the client-to-bouncer +connection. + +When you're ready to get started, add @code{sasl} to +@code{erc-modules}, like you would any other module. If unsure which +@dfn{mechanism} to choose, stick with the default of @samp{PLAIN}. +Then try @kbd{C-u M-x erc-tls @key{RET}}, and give your account name +for the @samp{user} parameter and your account password for the +@samp{server password}. @defopt erc-sasl-mechanism The name of an SASL subprotocol type as a @emph{lowercase} symbol. -- cgit v1.2.3 From 74f022b2797567ab04405af37b877d94cc4fdca2 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 1 Jan 2024 00:34:53 -0800 Subject: ; Make erc--send-input-lines a normal function again * lisp/erc/erc.el (erc--send-input-lines): Revert portion of 174b3dd9bd78c662ce9fff78404dcfa02259d21b "Make nested input handling more robust in ERC" that converted this from a function to a method. Instead, defer change until it's needed, likely for bug#49860. Also, don't inadvertently allow overloading of `insertp' because user code can legitimately set that to a function, which we then blindly call. Instead, hard-code it to the only expected alternate display function. --- lisp/erc/erc.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index e639a6278fc..b73e80cedde 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7878,12 +7878,13 @@ queue. Expect LINES-OBJ to be an `erc--input-split' object." (user-error "Multiline command detected" )) lines-obj) -(cl-defmethod erc--send-input-lines (lines-obj) +(defun erc--send-input-lines (lines-obj) "Send lines in `erc--input-split-lines' object LINES-OBJ." (when (erc--input-split-sendp lines-obj) (dolist (line (erc--input-split-lines lines-obj)) (when (erc--input-split-insertp lines-obj) - (if (functionp (erc--input-split-insertp lines-obj)) + (if (eq (erc--input-split-insertp lines-obj) + 'erc--command-indicator-display) (funcall (erc--input-split-insertp lines-obj) line) (erc-display-msg line))) (erc-process-input-line (concat line "\n") -- cgit v1.2.3 From fad2d1e2acc12cf8b1770d821738d924105acd8a Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 1 Jan 2024 23:18:54 -0800 Subject: Use global window hook for erc-keep-place-indicator * lisp/erc/erc-goodies.el (erc--keep-place-indicator-on-window-buffer-change): Expect a frame instead of a window argument for the only parameter, which is now ignored, and exit early when entering a minibuffer. (erc--keep-place-indicator-setup): Remove function because local modules don't need a separate setup function. (erc-keep-place-indicator-mode): Add autoload cookie even though this is a local module, since this particular one is intended for more granular, interactive activation. This is mostly a formality because it only matters in the unlikely event `erc-modules' is missing all other modules defined in `erc-goodies'. (erc-keep-place-indicator-mode, erc-keep-place-indicator-enable, erc-keep-place-indicator-disable): Move functionality from `erc--keep-place-indicator-setup' into enable body. Use global instead of local members for `erc-keep-place-mode-hook' and `window-buffer-change-functions'. (erc--keep-place-indicator-on-global-module): Perform necessary action in all ERC buffers, not just the current one, where the user has ostensibly disabled `erc-keep-place-mode'. * test/lisp/erc/erc-goodies-tests.el (erc-goodies-tests--assert-kp-indicator-on, erc-goodies-tests--assert-kp-indicator-off): Change expected hook membership for dependencies from global to local. (erc-goodies-tests--keep-place-indicator): Use new helpers from the `erc-tests-common' library. (Bug#59943) --- lisp/erc/erc-goodies.el | 84 ++++++++++++++++++++------------------ test/lisp/erc/erc-goodies-tests.el | 18 ++++---- 2 files changed, 52 insertions(+), 50 deletions(-) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index c5ab25bea98..23589657b2d 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -331,14 +331,15 @@ buffer than the window's start." (defvar-local erc--keep-place-indicator-overlay nil "Overlay for `erc-keep-place-indicator-mode'.") -(defun erc--keep-place-indicator-on-window-buffer-change (window) +(defun erc--keep-place-indicator-on-window-buffer-change (_) "Maybe sync `erc--keep-place-indicator-overlay'. Do so only when switching to a new buffer in the same window if the replaced buffer is no longer visible in another window and its `window-start' at the time of switching is strictly greater than the indicator's position." (when-let ((erc-keep-place-indicator-follow) - ((eq window (selected-window))) + (window (selected-window)) + ((not (eq window (active-minibuffer-window)))) (old-buffer (window-old-buffer window)) ((buffer-live-p old-buffer)) ((not (eq old-buffer (current-buffer)))) @@ -352,67 +353,70 @@ than the indicator's position." (with-current-buffer old-buffer (erc-keep-place-move old-start)))) -(defun erc--keep-place-indicator-setup () - "Initialize buffer for maintaining `erc--keep-place-indicator-overlay'." - (require 'fringe) - (erc--restore-initialize-priors erc-keep-place-indicator-mode - erc--keep-place-indicator-overlay (make-overlay 0 0)) - (add-hook 'erc-keep-place-mode-hook - #'erc--keep-place-indicator-on-global-module nil t) - (add-hook 'window-buffer-change-functions - #'erc--keep-place-indicator-on-window-buffer-change 40 t) - (when-let* (((memq erc-keep-place-indicator-style '(t arrow))) - (ov-property (if (zerop (fringe-columns 'left)) - 'after-string - 'before-string)) - (display (if (zerop (fringe-columns 'left)) - `((margin left-margin) ,overlay-arrow-string) - '(left-fringe right-triangle - erc-keep-place-indicator-arrow))) - (bef (propertize " " 'display display))) - (overlay-put erc--keep-place-indicator-overlay ov-property bef)) - (when (memq erc-keep-place-indicator-style '(t face)) - (overlay-put erc--keep-place-indicator-overlay 'face - 'erc-keep-place-indicator-line))) - ;;;###autoload(put 'keep-place-indicator 'erc--feature 'erc-goodies) +;;;###autoload(autoload 'erc-keep-place-indicator-mode "erc-goodies" nil t) (define-erc-module keep-place-indicator nil "Buffer-local `keep-place' with fringe arrow and/or highlighted face. Play nice with global module `keep-place' but don't depend on it. Expect that users may want different combinations of `keep-place' -and `keep-place-indicator' in different buffers. Unlike global -`keep-place', when `switch-to-buffer-preserve-window-point' is -enabled, don't forcibly sync point in all windows where buffer -has previously been shown because that defeats the purpose of -having a placeholder." +and `keep-place-indicator' in different buffers." ((cond (erc-keep-place-mode) ((memq 'keep-place erc-modules) (erc-keep-place-mode +1)) ;; Enable a local version of `keep-place-mode'. (t (add-hook 'erc-insert-pre-hook #'erc-keep-place 65 t))) + (require 'fringe) + (add-hook 'window-buffer-change-functions + #'erc--keep-place-indicator-on-window-buffer-change 40) + (add-hook 'erc-keep-place-mode-hook + #'erc--keep-place-indicator-on-global-module 40) (if (pcase erc-keep-place-indicator-buffer-type ('target erc--target) ('server (not erc--target)) ('t t)) - (erc--keep-place-indicator-setup) + (progn + (erc--restore-initialize-priors erc-keep-place-indicator-mode + erc--keep-place-indicator-overlay (make-overlay 0 0)) + (when-let (((memq erc-keep-place-indicator-style '(t arrow))) + (ov-property (if (zerop (fringe-columns 'left)) + 'after-string + 'before-string)) + (display (if (zerop (fringe-columns 'left)) + `((margin left-margin) ,overlay-arrow-string) + '(left-fringe right-triangle + erc-keep-place-indicator-arrow))) + (bef (propertize " " 'display display))) + (overlay-put erc--keep-place-indicator-overlay ov-property bef)) + (when (memq erc-keep-place-indicator-style '(t face)) + (overlay-put erc--keep-place-indicator-overlay 'face + 'erc-keep-place-indicator-line))) (erc-keep-place-indicator-mode -1))) ((when erc--keep-place-indicator-overlay (delete-overlay erc--keep-place-indicator-overlay)) - (remove-hook 'window-buffer-change-functions - #'erc--keep-place-indicator-on-window-buffer-change t) + (let ((buffer (current-buffer))) + ;; Remove global hooks unless others exist with mode enabled. + (unless (erc-buffer-filter (lambda () + (and (not (eq buffer (current-buffer))) + erc-keep-place-indicator-mode))) + (remove-hook 'erc-keep-place-mode-hook + #'erc--keep-place-indicator-on-global-module) + (remove-hook 'window-buffer-change-functions + #'erc--keep-place-indicator-on-window-buffer-change))) + (when (local-variable-p 'erc-insert-pre-hook) + (remove-hook 'erc-insert-pre-hook #'erc-keep-place t)) (remove-hook 'erc-keep-place-mode-hook #'erc--keep-place-indicator-on-global-module t) - (remove-hook 'erc-insert-pre-hook #'erc-keep-place t) (kill-local-variable 'erc--keep-place-indicator-overlay)) 'local) (defun erc--keep-place-indicator-on-global-module () - "Ensure `keep-place-indicator' can cope with `erc-keep-place-mode'. -That is, ensure the local module can survive a user toggling the -global one." - (if erc-keep-place-mode - (remove-hook 'erc-insert-pre-hook #'erc-keep-place t) - (add-hook 'erc-insert-pre-hook #'erc-keep-place 65 t))) + "Ensure `keep-place-indicator' survives toggling `erc-keep-place-mode'. +Do this by simulating `keep-place' in all buffers where +`keep-place-indicator' is enabled." + (erc-with-all-buffers-of-server nil (lambda () erc-keep-place-indicator-mode) + (if erc-keep-place-mode + (remove-hook 'erc-insert-pre-hook #'erc-keep-place t) + (add-hook 'erc-insert-pre-hook #'erc-keep-place 65 t)))) (defun erc-keep-place-move (pos) "Move keep-place indicator to current line or POS. diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index b8e00c57ef5..170e28bda96 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -251,15 +251,16 @@ (defun erc-goodies-tests--assert-kp-indicator-on () (should erc--keep-place-indicator-overlay) - (should (local-variable-p 'window-buffer-change-functions)) - (should window-configuration-change-hook) + (should (memq 'erc--keep-place-indicator-on-window-buffer-change + window-buffer-change-functions)) (should (memq 'erc-keep-place erc-insert-pre-hook)) (should (eq erc-keep-place-mode (not (local-variable-p 'erc-insert-pre-hook))))) (defun erc-goodies-tests--assert-kp-indicator-off () (should-not (local-variable-p 'erc-insert-pre-hook)) - (should-not (local-variable-p 'window-buffer-change-functions)) + (should-not (memq 'erc--keep-place-indicator-on-window-buffer-change + window-buffer-change-functions)) (should-not erc--keep-place-indicator-overlay)) (defun erc-goodies-tests--kp-indicator-populate () @@ -272,12 +273,9 @@ (goto-char erc-input-marker)) (defun erc-goodies-tests--keep-place-indicator (test) - (with-current-buffer (get-buffer-create "*erc-keep-place-indicator-mode*") - (erc-mode) - (erc--initialize-markers (point) nil) - (setq erc-server-process - (start-process "sleep" (current-buffer) "sleep" "1")) - (set-process-query-on-exit-flag erc-server-process nil) + (erc-keep-place-mode -1) + (with-current-buffer (erc-tests-common-make-server-buf + "*erc-keep-place-indicator-mode*") (let (erc-connect-pre-hook erc-modules) @@ -294,7 +292,7 @@ (should-not (member 'erc-keep-place (default-value 'erc-insert-pre-hook))) (should-not (local-variable-p 'erc-insert-pre-hook)) - (kill-buffer)))) + (erc-tests-common-kill-buffers)))) (ert-deftest erc-keep-place-indicator-mode--no-global () (erc-goodies-tests--keep-place-indicator -- cgit v1.2.3 From d6f9379d1c708dddc0543bf7242ba1ec6aee9746 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 3 Jan 2024 02:00:45 -0800 Subject: Allow setting `erc-split-line-length' to zero * etc/ERC-NEWS: Mention that `erc-flood-protect' no longer affects line splitting. * lisp/erc/erc-backend.el (erc-split-line-length): Mention ways for modules to suppress line splitting entirely. (erc--split-line): Exit loop instead of asserting progress has been made. * lisp/erc/erc.el (erc--split-lines): Don't split input when option `erc-split-line-length' is zero. * test/lisp/erc/erc-tests.el (erc--split-line): Assert behavior when `erc-split-line-length' is 0. (Bug#62947) --- etc/ERC-NEWS | 5 +++++ lisp/erc/erc-backend.el | 9 +++++++-- lisp/erc/erc.el | 2 +- test/lisp/erc/erc-tests.el | 8 ++++++++ 4 files changed, 21 insertions(+), 3 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index c51b6f05458..6cfa704d995 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -560,6 +560,11 @@ third-party code, the key takeaway is that more 'font-lock-face' properties encountered in the wild may be combinations of faces rather than lone ones. +*** 'erc-flood-protect' no longer influences input splitting. +This variable's role has been narrowed to rate limiting only. ERC +used to suppress protocol line-splitting when its value was nil, but +that's now handled by setting 'erc-split-line-length' to zero. + *** 'erc-pre-send-functions' visits prompt input post-split. ERC now adjusts input lines to fall within allowed length limits before showing hook members the result. For compatibility, diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 4162df00595..95207e56fd1 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -433,7 +433,11 @@ and optionally alter the attempts tally." (defcustom erc-split-line-length 440 "The maximum length of a single message. -If a message exceeds this size, it is broken into multiple ones. +ERC normally splits chat input submitted at its prompt into +multiple messages when the initial size exceeds this value in +bytes. Modules can tell ERC to forgo splitting entirely by +setting this to zero locally or, preferably, by binding it around +a remapped `erc-send-current-line' command. IRC allows for lines up to 512 bytes. Two of them are CR LF. And a typical message looks like this: @@ -596,7 +600,8 @@ escape hatch for inhibiting their transmission.") (if (= (car cmp) (point-min)) (goto-char (nth 1 cmp)) (goto-char (car cmp))))) - (cl-assert (/= (point-min) (point))) + (when (= (point-min) (point)) + (goto-char (point-max))) (push (buffer-substring-no-properties (point-min) (point)) out) (delete-region (point-min) (point))) (or (nreverse out) (list ""))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index b73e80cedde..d0c43134f9d 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7821,7 +7821,7 @@ When all lines are empty, remove all but the first." "Partition non-command input into lines of protocol-compliant length." ;; Prior to ERC 5.6, line splitting used to be predicated on ;; `erc-flood-protect' being non-nil. - (unless (erc--input-split-cmdp state) + (unless (or (zerop erc-split-line-length) (erc--input-split-cmdp state)) (setf (erc--input-split-lines state) (mapcan #'erc--split-line (erc--input-split-lines state))))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 2cd47ec3f89..a9aa255718d 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1298,6 +1298,14 @@ (should-not erc-debug-irc-protocol))) (ert-deftest erc--split-line () + (let ((erc-split-line-length 0)) + (should (equal (erc--split-line "") '(""))) + (should (equal (erc--split-line " ") '(" "))) + (should (equal (erc--split-line "1") '("1"))) + (should (equal (erc--split-line " 1") '(" 1"))) + (should (equal (erc--split-line "1 ") '("1 "))) + (should (equal (erc--split-line "abc") '("abc")))) + (let ((erc-default-recipients '("#chan")) (erc-split-line-length 10)) (should (equal (erc--split-line "") '(""))) -- cgit v1.2.3 From 37e87bc3eeb8e62e2900d73cf4dd9fc9e942d66d Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 3 Jan 2024 23:10:55 -0800 Subject: Make ERC's format catalogs more extensible * lisp/erc/erc-common.el (erc--define-catalog): Accept a `:parent' keyword to allow for extending an existing catalog by overriding some subset of defined entries. (erc-define-message-format-catalog): Add edebug spec. * lisp/erc/erc.el (erc-retrieve-catalog-entry): Check parent for definition before looking to `default-toplevel-value'. * test/lisp/erc/erc-tests.el (erc-retrieve-catalog-entry): Add test case for inheritance. * test/lisp/erc/resources/erc-tests-common.el (erc-tests-common-pp-propertized-parts): Fix bug in convenience command. (Bug#67677) --- lisp/erc/erc-common.el | 17 +++++++++++++++-- lisp/erc/erc.el | 6 ++++++ test/lisp/erc/erc-tests.el | 16 +++++++++++++++- test/lisp/erc/resources/erc-tests-common.el | 2 +- 4 files changed, 37 insertions(+), 4 deletions(-) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index b8ba0673355..2581e40f850 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -554,9 +554,21 @@ See `erc-define-message-format-catalog' for the meaning of ENTRIES, an alist, and `erc-tests-common-pp-propertized-parts' in tests/lisp/erc/erc-tests.el for a convenience command to convert a literal string into a sequence of `propertize' forms, which are -much easier to review and edit." +much easier to review and edit. When ENTRIES begins with a +sequence of keyword-value pairs remove them and consider their +evaluated values before processing the alist proper. + +Currently, the only recognized keyword is `:parent', which tells +ERC to search recursively for a given template key using the +keyword's associated value, another catalog symbol, if not found +in catalog NAME." (declare (indent 1)) (let (out) + (while (keywordp (car entries)) + (push (pcase-exhaustive (pop entries) + (:parent `(put ',name 'erc--base-format-catalog + ,(pop entries)))) + out)) (dolist (e entries (cons 'progn (nreverse out))) (push `(defvar ,(intern (format "erc-message-%s-%s" name (car e))) ,(cdr e) @@ -575,7 +587,8 @@ symbol, and FORMAT evaluates to a format string compatible with `format-spec'. Expect modules that only define a handful of entries to do so manually, instead of using this macro, so that the resulting variables will end up with more useful doc strings." - (declare (indent 1)) + (declare (indent 1) + (debug (symbolp [&rest [keywordp form]] &rest (symbolp . form)))) `(erc--define-catalog ,language ,entries)) (defmacro erc--doarray (spec &rest body) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index d0c43134f9d..478683a77f5 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -9320,6 +9320,12 @@ if yet untried." (unless catalog (setq catalog erc-current-message-catalog)) (symbol-value (or (erc--make-message-variable-name catalog key 'softp) + (let ((parent catalog) + last) + (while (and (setq parent (get parent 'erc--base-format-catalog)) + (not (setq last (erc--make-message-variable-name + parent key 'softp))))) + last) (let ((default (default-toplevel-value 'erc-current-message-catalog))) (or (and (not (eq default catalog)) (erc--make-message-variable-name default key 'softp)) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index a9aa255718d..a71cc806f6a 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3533,6 +3533,20 @@ connection." (should (equal (erc-retrieve-catalog-entry 's221) "test-top 221 val")) (makunbound (intern "erc-message-test-top-s221")) - (unintern "erc-message-test-top-s221" obarray)) + (unintern "erc-message-test-top-s221" obarray) + + ;; Inheritance. + (let ((obarray (obarray-make))) + (set (intern "erc-message-test1-abc") "val test1 abc") + (set (intern "erc-message-test2-abc") "val test2 abc") + (set (intern "erc-message-test2-def") "val test2 def") + (put (intern "test0") 'erc--base-format-catalog (intern "test1")) + (put (intern "test1") 'erc--base-format-catalog (intern "test2")) + (should (equal (erc-retrieve-catalog-entry 'abc (intern "test0")) + "val test1 abc")) + (should (equal (erc-retrieve-catalog-entry 'def (intern "test0")) + "val test2 def")) + ;; Terminates. + (should-not (erc-retrieve-catalog-entry 'ghi (intern "test0"))))) ;;; erc-tests.el ends here diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index fc5649798b5..906aa891352 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -150,7 +150,7 @@ between literal strings." For simplicity, assume string evaluates to itself." (interactive "P") (let ((sexp (erc-tests-common-string-to-propertized-parts (pp-last-sexp)))) - (if arg (insert (pp-to-string sexp)) (pp-eval-expression sexp)))) + (if arg (insert (pp-to-string sexp)) (pp-macroexpand-expression sexp)))) ;; The following utilities are meant to help prepare tests for ;; `erc--get-inserted-msg-bounds' and friends. -- cgit v1.2.3 From 50f430ebcd87b77207013f97e6e5d1b8fe93f990 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 5 Jan 2024 07:20:34 -0800 Subject: Clarify purpose of module aliases in ERC * doc/misc/erc.texi: Mention that aliases should not be defined for new modules. * lisp/erc/erc-common.el (define-erc-module): Refactor slightly for readability. (erc-with-all-buffers-of-server): Redo doc string. * lisp/erc/erc-pcomplete.el: Declare `completion' module's feature and group as being `erc-pcomplete'. * test/lisp/erc/erc-tests.el (erc--find-group--real): Assert group lookup works for "normalized" module name `completion' of `erc-pcomplete-mode'. --- doc/misc/erc.texi | 8 ++++++++ lisp/erc/erc-common.el | 31 +++++++++++++++++-------------- lisp/erc/erc-pcomplete.el | 2 ++ test/lisp/erc/erc-tests.el | 1 + 4 files changed, 28 insertions(+), 14 deletions(-) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 52c7477c9dd..f877fb681fe 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -678,6 +678,14 @@ signals an error. Users defining personal modules in an init file should @code{(provide 'erc-my-module)} somewhere to placate ERC. Dynamically generating modules on the fly is not supported. +Some older built-in modules have a second name along with a second +minor-mode toggle, which is just a function alias for its primary +counterpart. For practical reasons, ERC does not define a +corresponding variable alias because contending with indirect +variables complicates bookkeeping tasks, such as persisting module +state across IRC sessions. New modules should definitely avoid +defining aliases without a good reason. + Some packages have been known to autoload a module's definition instead of its minor-mode command, which severs the link between the library and the module. This means that enabling the mode by invoking diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 2581e40f850..28ab6aad466 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -333,6 +333,7 @@ instead of a `set' state, which precludes any actual saving." (read (current-buffer)))) (defmacro erc--find-feature (name alias) + ;; Don't use this outside of the file that defines NAME. `(pcase (erc--find-group ',name ,(and alias (list 'quote alias))) ('erc (and-let* ((file (or (macroexp-file-name) buffer-file-name))) (intern (file-name-base file)))) @@ -350,8 +351,12 @@ See Info node `(elisp) Defining Minor Modes' for more.") (defmacro define-erc-module (name alias doc enable-body disable-body &optional local-p) "Define a new minor mode using ERC conventions. -Symbol NAME is the name of the module. -Symbol ALIAS is the alias to use, or nil. +Expect NAME to be the module's name and ALIAS, when non-nil, to +be a retired name used only for compatibility purposes. In new +code, assume NAME is the same symbol users should specify when +customizing `erc-modules' (see info node `(erc) Module Loading' +for more on naming). + DOC is the documentation string to use for the minor mode. ENABLE-BODY is a list of expressions used to enable the mode. DISABLE-BODY is a list of expressions used to disable the mode. @@ -382,7 +387,10 @@ Example: (let* ((sn (symbol-name name)) (mode (intern (format "erc-%s-mode" (downcase sn)))) (enable (intern (format "erc-%s-enable" (downcase sn)))) - (disable (intern (format "erc-%s-disable" (downcase sn))))) + (disable (intern (format "erc-%s-disable" (downcase sn)))) + (nmodule (erc--normalize-module-symbol name)) + (amod (and alias (intern (format "erc-%s-mode" + (downcase (symbol-name alias))))))) `(progn (define-minor-mode ,mode @@ -399,13 +407,9 @@ if ARG is omitted or nil. (if ,mode (,enable) (,disable)))) ,(erc--assemble-toggle local-p name enable mode t enable-body) ,(erc--assemble-toggle local-p name disable mode nil disable-body) - ,@(and-let* ((alias) - ((not (eq name alias))) - (aname (intern (format "erc-%s-mode" - (downcase (symbol-name alias)))))) - `((defalias ',aname #',mode) - (put ',aname 'erc-module ',(erc--normalize-module-symbol name)))) - (put ',mode 'erc-module ',(erc--normalize-module-symbol name)) + ,@(and amod `((defalias ',amod #',mode) + (put ',amod 'erc-module ',nmodule))) + (put ',mode 'erc-module ',nmodule) ;; For find-function and find-variable. (put ',mode 'definition-name ',name) (put ',enable 'definition-name ',name) @@ -462,10 +466,9 @@ If no server buffer exists, return nil." ,@body))))) (defmacro erc-with-all-buffers-of-server (process pred &rest forms) - "Execute FORMS in all buffers which have same process as this server. -FORMS will be evaluated in all buffers having the process PROCESS and -where PRED matches or in all buffers of the server process if PRED is -nil." + "Evaluate FORMS in all buffers of PROCESS in which PRED returns non-nil. +When PROCESS is nil, do so in all ERC buffers. When PRED is nil, +run FORMS unconditionally." (declare (indent 2) (debug (form form body))) (macroexp-let2 nil pred pred `(erc-buffer-filter (lambda () diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index 52ebdc83e5e..05cbaf3872f 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el @@ -58,7 +58,9 @@ add this string to nicks completed." ;;;###autoload(put 'Completion 'erc--module 'completion) ;;;###autoload(put 'pcomplete 'erc--module 'completion) +;;;###autoload(put 'completion 'erc--feature 'erc-pcomplete) ;;;###autoload(autoload 'erc-completion-mode "erc-pcomplete" nil t) +(put 'completion 'erc-group 'erc-pcomplete) (define-erc-module pcomplete Completion "In ERC Completion mode, the TAB key does completion whenever possible." ((add-hook 'erc-mode-hook #'pcomplete-erc-setup) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index a71cc806f6a..2318fed28f2 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3186,6 +3186,7 @@ (should (eq (erc--find-group 'autojoin) 'erc-autojoin)) (should (eq (erc--find-group 'pcomplete 'Completion) 'erc-pcomplete)) (should (eq (erc--find-group 'capab-identify) 'erc-capab)) + (should (eq (erc--find-group 'completion) 'erc-pcomplete)) ;; No group specified. (should (eq (erc--find-group 'smiley nil) 'erc)) (should (eq (erc--find-group 'unmorse nil) 'erc))) -- cgit v1.2.3 From 6fdf035f62ed3cdd55a5cafe823a2d749637ce25 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 7 Jan 2024 21:43:56 +0100 Subject: ; Delete a superfluous bitwise 'or' * src/xterm.c (x_term_init): Avoid bitwise 'or' using the same variable as both operands (X | X => X). --- src/xterm.c | 1 - 1 file changed, 1 deletion(-) diff --git a/src/xterm.c b/src/xterm.c index 1f398b2e39a..0cbf32ae1ea 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -31503,7 +31503,6 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->selection_tracking_window, selection_name, (XFixesSetSelectionOwnerNotifyMask - | XFixesSetSelectionOwnerNotifyMask | XFixesSelectionClientCloseNotifyMask)); } -- cgit v1.2.3 From c21995ff008d37e768a33412cad5fc9f5c3c2dbb Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 7 Jan 2024 22:07:45 +0100 Subject: Support string literals in build_string.cocci * admin/coccinelle/build_string.cocci: Support string literals. --- admin/coccinelle/build_string.cocci | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/admin/coccinelle/build_string.cocci b/admin/coccinelle/build_string.cocci index d47727018dd..9421a140658 100644 --- a/admin/coccinelle/build_string.cocci +++ b/admin/coccinelle/build_string.cocci @@ -4,3 +4,9 @@ identifier I; @@ - make_string (I, strlen (I)) + build_string (I) + +@@ +constant C; +@@ +- make_string (C, strlen (C)) ++ build_string (C) -- cgit v1.2.3 From 267c9b54b16e50f76e5ce88ff153d1a24d093563 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 7 Jan 2024 22:19:06 +0100 Subject: Remove redundant conversion from bool to bool * src/xdisp.c (maybe_produce_line_number): Remove redundant conversion of the value of an expression from bool to bool. --- src/xdisp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/xdisp.c b/src/xdisp.c index f8670c6ecb5..14cf030ca4e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -24648,7 +24648,7 @@ maybe_produce_line_number (struct it *it) /* Produce the glyphs for the line number. */ struct it tem_it; char lnum_buf[INT_STRLEN_BOUND (ptrdiff_t) + 1]; - bool beyond_zv = IT_BYTEPOS (*it) >= ZV_BYTE ? true : false; + bool beyond_zv = IT_BYTEPOS (*it) >= ZV_BYTE; ptrdiff_t lnum_offset = -1; /* to produce 1-based line numbers */ int lnum_face_id = merge_faces (it->w, Qline_number, 0, DEFAULT_FACE_ID); int current_lnum_face_id -- cgit v1.2.3 From c946efe7b3778302cd64442b451f806f4be7e78e Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 8 Jan 2024 15:26:50 +0800 Subject: ; * etc/PROBLEMS: Remove several resolved problems. --- etc/PROBLEMS | 126 +++++++++++++---------------------------------------------- 1 file changed, 27 insertions(+), 99 deletions(-) diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 4d3b236ab03..7a5f029af65 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -3406,26 +3406,21 @@ this and many other problems do not exist on the regular X builds. ** Text displayed in the default monospace font looks horrible. -Droid Sans Mono (the default Monospace font which comes with Android) -incorporates instruction code designed for Microsoft's proprietary -TrueType font scaler. When this code is executed by Emacs to instruct -a glyph containing more than one component, it tries to address -"reference points" which are set to the values of two extra "phantom -points" in the glyph, that are a proprietary extension of the MS font -scaler. - -Emacs does not support these extensions, and as a result characters -such as - - ĥ - -display incorrectly, with the right most edge of the `h' component -stretched very far out to the right, on some low density displays. - -The solution is to replace the MS-specific hinting code in Droid Sans -Mono with automatically generated code from the FreeType project's -"ttfautohint" program. First, extract -'/system/fonts/DroidSansMono.ttf' from your device: +TrueType fonts incorporate instruction code executed by the font +scaler (the component responsible for transforming outlines into +bitmap images capable of being displayed onscreen), in order that +features of each glyph might be aligned to pixel boundaries +intelligently, preventing faintness while maintaining the shape of its +features. The substandard instruction code provided by the monospace +font distributed with Android misplaces features of such glyphs as "E" +and "F" between point sizes of 16 and 24, resulting in noticeable +whitespace inconsistencies with other glyphs. Furthermore, the +vertical stem in the glyph "T" is positioned too far to the left. + +The remedy for this is to replace the instruction code with +automatically generated code from the FreeType project's "ttfautohint" +program. First, extract '/system/fonts/DroidSansMono.ttf' from your +device: $ adb pull /system/fonts/DroidSansMono.ttf /system/fonts/DroidSansMono.ttf: 1 file pulled, 0 skipped. @@ -3448,85 +3443,18 @@ allowed by free versions of Android, such as Replicant): or to the user fonts directory described in the "Android Fonts" node of the Emacs manual. You may want to perform this procedure even if -you are not seeing problems with character display, as the -automatically generated instructions result in superior display -results that are easier to read. - -We have been told that the default Sans font under Android 2.3.7, -named "Droid Sans", also exhibits this problem. The procedure for -repairing the font is identical to the procedure outlined above, -albeit with "DroidSansMono" replaced by simply "DroidSans". - -** The "Anonymous Pro" font displays incorrectly. - -Glyph instruction code within the Anonymous Pro font relies on -undocumented features of the Microsoft TrueType font scaler, namely -that the scaler always resets the "projection" and "freedom" vector -interpreter control registers after the execution of the font -pre-program, which sets them to a value that is perpendicular to the -horizontal plane of movement. - -Since Emacs does not provide this "feature", various points inside -glyphs are moved vertically rather than horizontally when a glyph -program later executes an instruction such as "MIRP" (Move Indirect -Relative Point) that moves and measures points along the axis -specified by those registers. - -This can be remedied in two ways; the first (and the easiest) is to -replace its instruction code with that supplied by "ttfautohint", as -depicted above. The second is to patch the instruction code inside -the font itself, using the "ttx" utility: - - https://fonttools.readthedocs.io/en/latest/ttx.html - -First, convert the font to its XML representation: - - $ ttx Anonymous_Pro.ttf - -then, find the end of the section labeled 'prep': - - - - [...] - ROUND[01] /* Round */ - RTG[ ] /* RoundToGrid */ - WCVTP[ ] /* WriteCVTInPixels */ - - - -and insert the following instruction immediately before the closing -'/assembly' tag, so as to reset the interpreter control registers back -to their default values prior to the completion of the pre-program: - - SVTCA[1] /* Set Vector registers to Control Axis X */ - -Then, reassemble the font from the modified XML: - - $ ttx Anonymous_Pro.ttx - -which should produce a modified font by the name of -Anonymous_Pro#1.ttf. - -** The "IBM Plex Mono" font displays incorrectly. - -This problem is precipitated by an attempt to exploit the undocumented -feature of the MS font scaler explicated within the previous heading. - -Its remedy is also unsurprisingly alike the fix described there: both -patching the preprogram to reset the point movement vectors and -replacing the instruction code with code generated by "ttfautohint" -will adequately resolve the problem. +you are not experiencing problems with character display, as the +automatically generated instructions result in more legible text. ** Glyphs are missing within the "Arial" font or it does not load. -On account of its origins at Microsoft, instruction code included -within this font is awash with references to behavior specific to the -MS scaler. It is incorrigibly broken, to a degree that even -"ttfautohint" cannot repair; your only recourse is to select some -other font. - -This issue may extend beyond Arial to encompass a larger selection of -fonts designed by Microsoft. +Old versions of this font included instruction code that assumed a +degree of latitude from the Microsoft font scaler, which grants fonts +leave to address nonexistent points without aborting the scaling +process, among other invalid TrueType operations. This issue may +extend beyond Arial to encompass a larger selection of old fonts +designed by Microsoft or Monotype; most of the time, installing newer +versions of such fonts will suffice. ** Some TrueType test fonts don't work. @@ -3554,9 +3482,9 @@ Executing instruction code is not a strict requirement for producing correct display results from most current fonts. If a font's instruction code produces results that are merely unpleasing, but not incorrect, then the font was presumably not designed for Emacs's -scaler. If its uninstructed glyphs are satisfactory (such as if your -screen resolution is high to the extent that scaling artifacts prove -invisible), disable instruction code execution by appending its family +scaler. If its uninstructed glyphs are satisfactory (such as when +your screen resolution is high enough to ameliorate scaling +artifacts), disable instruction code execution by appending its family name to the variable 'sfnt-uninstructable-font-regexp', then restarting Emacs. -- cgit v1.2.3 From 2656d756851d97434da7846a5a30202baafb2241 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 8 Jan 2024 15:32:07 +0800 Subject: Properly instruct Italic Arial or BS Mono at small PPEM sizes * src/sfnt.c (sfnt_read_simple_glyph): Correct alignment errors. (PUSH2_UNCHECKED): Don't shift negative signed value to the left. (SLOOP): Permit LOOP to be set to 0, which inhibits the execution of instructions it affects. (sfnt_address_zp2, sfnt_address_zp1, sfnt_address_zp0): Permit X and Y to be NULL. (sfnt_dot_fix_14): Guarantee that the final value is rounded to negative infinity, not zero. (sfnt_project_zp1_zp0_org): New function. (sfnt_interpret_mdrp): Avoid rounding issues by computing original distance from unscaled coordinates, if at all possible. (sfnt_interpret_simple_glyph, sfnt_interpret_compound_glyph_2): Set zone->simple. (all_tests) : Update test. (sfnt_identify_instruction, main): Adjust tests. * src/sfnt.h (struct sfnt_interpreter_zone): New field simple. --- src/sfnt.c | 161 +++++++++++++++++++++++++++++++++++++++++++++++-------------- src/sfnt.h | 4 ++ 2 files changed, 128 insertions(+), 37 deletions(-) diff --git a/src/sfnt.c b/src/sfnt.c index 36240f4cdff..b300eb4ba89 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -1937,8 +1937,11 @@ sfnt_read_simple_glyph (struct sfnt_glyph *glyph, simple->instructions comes one word past number_of_contours, because end_pts_of_contours also contains the instruction length. */ - simple->instructions = (uint8_t *) (simple->end_pts_of_contours - + glyph->number_of_contours + 1); + + simple->x_coordinates = (int16_t *) (simple->end_pts_of_contours + + glyph->number_of_contours + 1); + simple->y_coordinates = simple->x_coordinates + number_of_points; + simple->instructions = (uint8_t *) (simple->y_coordinates + number_of_points); simple->flags = simple->instructions + simple->instruction_length; /* Read instructions into the glyph. */ @@ -2022,7 +2025,6 @@ sfnt_read_simple_glyph (struct sfnt_glyph *glyph, /* Now that the flags have been decoded, start decoding the vectors. */ - simple->x_coordinates = (int16_t *) (simple->flags + number_of_points); vec_start = flags_start; i = 0; x = 0; @@ -2080,7 +2082,6 @@ sfnt_read_simple_glyph (struct sfnt_glyph *glyph, pointer to the flags for the current vector. */ flags_start = simple->flags; y = 0; - simple->y_coordinates = simple->x_coordinates + i; i = 0; while (i < number_of_points) @@ -6944,7 +6945,7 @@ sfnt_interpret_trap (struct sfnt_interpreter *interpreter, { \ int16_t word; \ \ - word = (((int8_t) high) << 8 | low); \ + word = (((uint8_t) high) << 8 | low); \ PUSH_UNCHECKED (word); \ } \ @@ -7024,14 +7025,18 @@ sfnt_interpret_trap (struct sfnt_interpreter *interpreter, #define SLOOP() \ { \ - uint32_t loop; \ + int32_t loop; \ \ loop = POP (); \ \ - if (!loop) \ - TRAP ("loop set to 0"); \ + if (loop < 0) \ + TRAP ("loop set to invalid value"); \ \ - interpreter->state.loop = loop; \ + /* N.B. loop might be greater than 65535, \ + but no reasonable font should define \ + such values. */ \ + interpreter->state.loop \ + = MIN (65535, loop); \ } #define SMD() \ @@ -8570,8 +8575,11 @@ sfnt_address_zp2 (struct sfnt_interpreter *interpreter, if (number >= interpreter->glyph_zone->num_points) TRAP ("address to ZP2 (glyph zone) out of bounds"); - *x = interpreter->glyph_zone->x_current[number]; - *y = interpreter->glyph_zone->y_current[number]; + if (x && y) + { + *x = interpreter->glyph_zone->x_current[number]; + *y = interpreter->glyph_zone->y_current[number]; + } if (x_org && y_org) { @@ -8618,8 +8626,11 @@ sfnt_address_zp1 (struct sfnt_interpreter *interpreter, if (number >= interpreter->glyph_zone->num_points) TRAP ("address to ZP1 (glyph zone) out of bounds"); - *x = interpreter->glyph_zone->x_current[number]; - *y = interpreter->glyph_zone->y_current[number]; + if (x && y) + { + *x = interpreter->glyph_zone->x_current[number]; + *y = interpreter->glyph_zone->y_current[number]; + } if (x_org && y_org) { @@ -8666,8 +8677,11 @@ sfnt_address_zp0 (struct sfnt_interpreter *interpreter, if (number >= interpreter->glyph_zone->num_points) TRAP ("address to ZP0 (glyph zone) out of bounds"); - *x = interpreter->glyph_zone->x_current[number]; - *y = interpreter->glyph_zone->y_current[number]; + if (x && y) + { + *x = interpreter->glyph_zone->x_current[number]; + *y = interpreter->glyph_zone->y_current[number]; + } if (x_org && y_org) { @@ -10570,6 +10584,7 @@ sfnt_dot_fix_14 (int32_t ax, int32_t ay, int bx, int by) return (int32_t) (((uint32_t) hi << 18) | (l >> 14)); #else int64_t xx, yy; + int64_t temp; xx = (int64_t) ax * bx; yy = (int64_t) ay * by; @@ -10578,7 +10593,12 @@ sfnt_dot_fix_14 (int32_t ax, int32_t ay, int bx, int by) yy = xx >> 63; xx += 0x2000 + yy; - return (int32_t) (xx / (1 << 14)); + /* TrueType fonts rely on "division" here truncating towards + negative infinity, so compute the arithmetic right shift in place + of division. */ + temp = -(xx < 0); + temp = (temp ^ xx) >> 14 ^ temp; + return (int32_t) (temp); #endif } @@ -11412,6 +11432,63 @@ sfnt_interpret_mirp (struct sfnt_interpreter *interpreter, interpreter->state.rp0 = p; } +/* Return the projection of the two points P1 and P2's original values + along the dual projection vector, with P1 inside ZP0 and P2 inside + ZP1. If this zone is the glyph zone and the outline positions of + those points are directly accessible, project their original + positions and scale the result with rounding, so as to prevent + rounding-introduced inaccuracies. + + The scenario where such inaccuracies are significant is generally + where an Italic glyph is being instructed at small PPEM sizes, + during which a point moved by MDAP[rN] is within 1/64th of a + pixel's distance from a point on the grid, yet the measurements + taken between such a point and the reference point against which + the distance to move is computed is such that the position of the + point after applying their rounded values differs by one grid + coordinate from the font designer's intentions, either exaggerating + or neutralizing the slant of the stem to which it belongs. + + This behavior applies only to MDRP, which see. */ + +static sfnt_f26dot6 +sfnt_project_zp1_zp0_org (struct sfnt_interpreter *interpreter, + uint32_t p1, uint32_t p2) +{ + sfnt_fword x1, y1, x2, y2, projection; + struct sfnt_simple_glyph *simple; + sfnt_f26dot6 org_x1, org_y1, org_x2, org_y2; + + /* Addressing the twilight zone, perhaps only partially. */ + if (!interpreter->state.zp0 + || !interpreter->state.zp1 + /* Not interpreting a glyph. */ + || !interpreter->glyph_zone + /* Not interpreting a simple glyph. */ + || !interpreter->glyph_zone->simple + /* P1 or P2 are phantom points. */ + || p1 >= interpreter->glyph_zone->simple->number_of_points + || p2 >= interpreter->glyph_zone->simple->number_of_points) + goto project_normally; + + simple = interpreter->glyph_zone->simple; + x1 = simple->x_coordinates[p1]; + y1 = simple->y_coordinates[p1]; + x2 = simple->x_coordinates[p2]; + y2 = simple->y_coordinates[p2]; + + /* Compute the projection. */ + projection = DUAL_PROJECT (x1 - x2, y1 - y2); + + /* Return the projection, scaled with rounding. */ + return sfnt_mul_fixed_round (projection, interpreter->scale); + + project_normally: + sfnt_address_zp1 (interpreter, p1, NULL, NULL, &org_x1, &org_y1); + sfnt_address_zp0 (interpreter, p2, NULL, NULL, &org_x2, &org_y2); + return DUAL_PROJECT (org_x1 - org_x2, org_y1 - org_y2); +} + /* Interpret an MDRP instruction with the specified OPCODE in INTERPRETER. Pop a point in ZP1, and move the point until its distance from RP0 in ZP0 is the same as in the original outline. @@ -11428,20 +11505,19 @@ sfnt_interpret_mdrp (struct sfnt_interpreter *interpreter, uint32_t p; sfnt_f26dot6 distance, applied; sfnt_f26dot6 current_projection; - sfnt_f26dot6 x, y, org_x, org_y; - sfnt_f26dot6 rx, ry, org_rx, org_ry; + sfnt_f26dot6 x, y, rx, ry; /* Point number. */ p = POP (); /* Load the points. */ - sfnt_address_zp1 (interpreter, p, &x, &y, &org_x, &org_y); + sfnt_address_zp1 (interpreter, p, &x, &y, NULL, NULL); sfnt_address_zp0 (interpreter, interpreter->state.rp0, - &rx, &ry, &org_rx, &org_ry); + &rx, &ry, NULL, NULL); /* Calculate the distance between P and rp0 prior to hinting. */ - distance = DUAL_PROJECT (org_x - org_rx, - org_y - org_ry); + distance = sfnt_project_zp1_zp0_org (interpreter, p, + interpreter->state.rp0); /* Calculate the distance between P and rp0 as of now in the hinting process. */ @@ -12478,6 +12554,7 @@ sfnt_interpret_simple_glyph (struct sfnt_glyph *glyph, zone->y_current = zone->y_points + zone->num_points; zone->flags = (unsigned char *) (zone->y_current + zone->num_points); + zone->simple = glyph->simple; /* Load x_points and x_current. */ for (i = 0; i < glyph->simple->number_of_points; ++i) @@ -12776,6 +12853,7 @@ sfnt_interpret_compound_glyph_2 (struct sfnt_glyph *glyph, zone->y_current = zone->y_points + zone->num_points; zone->flags = (unsigned char *) (zone->y_current + zone->num_points); + zone->simple = NULL; /* Copy and renumber all contour end points to start from base_index. */ @@ -18459,13 +18537,13 @@ static struct sfnt_interpreter_test all_tests[] = "SLOOP", /* PUSHB[0] 2 SLOOP[] - PUSHB[0] 0 + PUSHW[0] 255 255 (-1) SLOOP[] */ (unsigned char []) { 0xb0, 2, 0x17, - 0xb0, 0, + 0xb8, 255, 255, 0x17, }, - 6, + 7, NULL, sfnt_check_sloop, }, @@ -20258,7 +20336,8 @@ sfnt_identify_instruction (struct sfnt_interpreter *interpreter) return buffer; } - if (exec_fpgm->instructions + if (exec_fpgm + && exec_fpgm->instructions && where >= exec_fpgm->instructions && where < (exec_fpgm->instructions + exec_fpgm->num_instructions)) @@ -20529,6 +20608,13 @@ main (int argc, char **argv) if (!interpreter) abort (); + if (getenv ("SFNT_VERBOSE")) + { + interpreter->run_hook = sfnt_verbose; + interpreter->push_hook = sfnt_push_hook; + interpreter->pop_hook = sfnt_pop_hook; + } + for (i = 0; i < ARRAYELTS (all_tests); ++i) sfnt_run_interpreter_test (&all_tests[i], interpreter); @@ -20631,8 +20717,8 @@ main (int argc, char **argv) return 1; } -#define FANCY_PPEM 14 -#define EASY_PPEM 14 +#define FANCY_PPEM 16 +#define EASY_PPEM 16 interpreter = NULL; head = sfnt_read_head_table (fd, font); @@ -21023,6 +21109,16 @@ main (int argc, char **argv) interpreter = sfnt_make_interpreter (maxp, cvt, head, fvar, FANCY_PPEM, FANCY_PPEM); + + if (getenv ("SFNT_DEBUG")) + interpreter->run_hook = sfnt_run_hook; + else if (getenv ("SFNT_VERBOSE")) + { + interpreter->run_hook = sfnt_verbose; + interpreter->push_hook = sfnt_push_hook; + interpreter->pop_hook = sfnt_pop_hook; + } + state = interpreter->state; if (instance && gvar) @@ -21236,15 +21332,6 @@ main (int argc, char **argv) if (interpreter) { - if (getenv ("SFNT_DEBUG")) - interpreter->run_hook = sfnt_run_hook; - else if (getenv ("SFNT_VERBOSE")) - { - interpreter->run_hook = sfnt_verbose; - interpreter->push_hook = sfnt_push_hook; - interpreter->pop_hook = sfnt_pop_hook; - } - if (!sfnt_lookup_glyph_metrics (code, &metrics, hmtx, hhea, maxp)) { diff --git a/src/sfnt.h b/src/sfnt.h index 2b92f9f540a..5b01270e8ce 100644 --- a/src/sfnt.h +++ b/src/sfnt.h @@ -1759,6 +1759,10 @@ struct sfnt_interpreter_zone /* Pointer to the flags associated with this data. */ unsigned char *flags; + + /* If this structure was produced from a simple glyph, pointer to + the simple glyph itself. NULL otherwise. */ + struct sfnt_simple_glyph *simple; }; enum -- cgit v1.2.3 From e2be1987a2e1206b77d2f11c78bb6e770a661452 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 8 Jan 2024 15:40:45 +0800 Subject: ; Fix a crash in sfnt_read_fvar_table * src/sfnt.c (sfnt_read_fvar_table): Derive padding from correct type. --- src/sfnt.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/sfnt.c b/src/sfnt.c index b300eb4ba89..0666bb17cf0 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -14269,7 +14269,7 @@ sfnt_read_fvar_table (int fd, struct sfnt_offset_subtable *subtable) || INT_ADD_WRAPV (min_bytes, temp, &min_bytes)) goto bail; - pad = alignof (struct sfnt_variation_axis); + pad = alignof (struct sfnt_instance); pad -= min_bytes & (pad - 1); if (INT_ADD_WRAPV (min_bytes, pad, &min_bytes)) -- cgit v1.2.3 From d9462e24a967e32d550ee886b5150f0cc78358f6 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 8 Jan 2024 14:52:25 +0100 Subject: Make Tramp more robust * lisp/net/tramp-sh.el (tramp-bundle-read-file-names): Check, that the command finishes successfully. --- lisp/net/tramp-sh.el | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 6489f473634..8ec9467ab45 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3652,20 +3652,20 @@ filled are described in `tramp-bundle-read-file-names'." (dolist (elt - (ignore-errors + (with-current-buffer (tramp-get-connection-buffer vec) ;; We cannot use `tramp-send-command-and-read', because ;; this does not cooperate well with heredoc documents. - (tramp-send-command - vec - (format - "tramp_bundle_read_file_names <<'%s'\n%s\n%s\n" - tramp-end-of-heredoc - (mapconcat #'tramp-shell-quote-argument files "\n") - tramp-end-of-heredoc)) - (with-current-buffer (tramp-get-connection-buffer vec) - ;; Read the expression. - (goto-char (point-min)) - (read (current-buffer))))) + (unless (tramp-send-command-and-check + vec + (format + "tramp_bundle_read_file_names <<'%s'\n%s\n%s\n" + tramp-end-of-heredoc + (mapconcat #'tramp-shell-quote-argument files "\n") + tramp-end-of-heredoc)) + (tramp-error vec 'file-error "%s" (tramp-get-buffer-string))) + ;; Read the expression. + (goto-char (point-min)) + (read (current-buffer)))) (tramp-set-file-property vec (car elt) "file-exists-p" (nth 1 elt)) (tramp-set-file-property vec (car elt) "file-readable-p" (nth 2 elt)) -- cgit v1.2.3 From 774c8ec74c98d69d56b2511a613145f2b69fb2eb Mon Sep 17 00:00:00 2001 From: Harald Jörg Date: Mon, 8 Jan 2024 16:12:19 +0100 Subject: cperl-mode.el: Make sure cperl-file-style is set buffer-local * lisp/progmodes/cperl-mode.el (cperl-file-style): Add description what the options actually do. (cperl-menu): Split the menu entry "Indent styles" into "Default indent styles" and "Indent styles for current buffer" (cperl--set-file-style): call `cperl-file-style' instead of `cperl-set-style'. This completes the fix for Bug#17948. (cperl-set-style): Explain when to use `cperl-file-style'. Use `set-default-toplevel-value' instead of `set'. (cperl-set-style-back): Use `set-default-toplevel-value' instead of `set'. (cperl-file-style): New command to set the file style for the current buffer. * etc/NEWS: Announce the new command cperl-file-style. --- etc/NEWS | 5 +++++ lisp/progmodes/cperl-mode.el | 41 +++++++++++++++++++++++++++++++++++++---- 2 files changed, 42 insertions(+), 4 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index c3d777b971f..f4d008ee2d6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1116,6 +1116,11 @@ value of 'perl-code' is useful for trailing POD and for AutoSplit modules, the value 'comment' makes CPerl mode treat trailers as comment, like Perl mode does. +*** New command 'cperl-file-style'. +This command sets the indentation style for the current buffer. To +change the default style, either use the option with the same name or +use the command cperl-set-style. + *** Commands using the Perl info page are obsolete. The Perl documentation in info format is no longer distributed with Perl or on CPAN since more than 10 years. Perl documentation can be diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 9f7f29b8182..5e435f7133e 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -162,6 +162,9 @@ for constructs with multiline if/unless/while/until/for/foreach condition." (defcustom cperl-file-style nil "Indentation style to use in cperl-mode. +Setting this option will override options as given in +`cperl-style-alist' for the keyword provided here. If nil, then +the individual options as customized are used. \"PBP\" is the style recommended in the Book \"Perl Best Practices\" by Damian Conway. \"CPerl\" is the traditional style of cperl-mode, and \"PerlStyle\" follows the Perl documentation @@ -1130,7 +1133,7 @@ Unless KEEP, removes the old indentation." ["Fix whitespace on indent" cperl-toggle-construct-fix t] ["Auto-help on Perl constructs" cperl-toggle-autohelp t] ["Auto fill" auto-fill-mode t]) - ("Indent styles..." + ("Default indent styles..." ["CPerl" (cperl-set-style "CPerl") t] ["PBP" (cperl-set-style "PBP") t] ["PerlStyle" (cperl-set-style "PerlStyle") t] @@ -1141,6 +1144,15 @@ Unless KEEP, removes the old indentation." ["Whitesmith" (cperl-set-style "Whitesmith") t] ["Memorize Current" (cperl-set-style "Current") t] ["Memorized" (cperl-set-style-back) cperl-old-style]) + ("Indent styles for current buffer..." + ["CPerl" (cperl-set-style "CPerl") t] + ["PBP" (cperl-file-style "PBP") t] + ["PerlStyle" (cperl-file-style "PerlStyle") t] + ["GNU" (cperl-file-style "GNU") t] + ["C++" (cperl-file-style "C++") t] + ["K&R" (cperl-file-style "K&R") t] + ["BSD" (cperl-file-style "BSD") t] + ["Whitesmith" (cperl-file-style "Whitesmith") t]) ("Micro-docs" ["Tips" (describe-variable 'cperl-tips) t] ["Problems" (describe-variable 'cperl-problems) t] @@ -1924,7 +1936,8 @@ or as help on variables `cperl-tips', `cperl-problems', (defun cperl--set-file-style () (when cperl-file-style - (cperl-set-style cperl-file-style))) + (cperl-file-style cperl-file-style))) + ;; Fix for perldb - make default reasonable (defun cperl-db () @@ -6496,6 +6509,10 @@ See examples in `cperl-style-examples'.") (defun cperl-set-style (style) "Set CPerl mode variables to use one of several different indentation styles. +This command sets the default values for the variables. It does +not affect buffers visiting files where the style has been set as +a file or directory variable. To change the indentation style of +a buffer, use the command `cperl-file-style' instead. The arguments are a string representing the desired style. The list of styles is in `cperl-style-alist', available styles are \"CPerl\", \"PBP\", \"PerlStyle\", \"GNU\", \"K&R\", \"BSD\", \"C++\" @@ -6516,7 +6533,8 @@ side-effect of memorizing only. Examples in `cperl-style-examples'." (let ((style (cdr (assoc style cperl-style-alist))) setting) (while style (setq setting (car style) style (cdr style)) - (set (car setting) (cdr setting))))) + (set-default-toplevel-value (car setting) (cdr setting)))) + (set-default-toplevel-value 'cperl-file-style style)) (defun cperl-set-style-back () "Restore a style memorized by `cperl-set-style'." @@ -6526,7 +6544,22 @@ side-effect of memorizing only. Examples in `cperl-style-examples'." (while cperl-old-style (setq setting (car cperl-old-style) cperl-old-style (cdr cperl-old-style)) - (set (car setting) (cdr setting))))) + (set-default-toplevel-value (car setting) (cdr setting))))) + +(defun cperl-file-style (style) + "Set the indentation style for the current buffer to STYLE. +The list of styles is in `cperl-style-alist', available styles +are \"CPerl\", \"PBP\", \"PerlStyle\", \"GNU\", \"K&R\", \"BSD\", \"C++\" +and \"Whitesmith\"." + (interactive + (list (completing-read "Enter style: " cperl-style-alist nil 'insist))) + (dolist (setting (cdr (assoc style cperl-style-alist)) style) + (let ((option (car setting)) + (value (cdr setting))) + (make-variable-buffer-local option) + (set option value))) + (make-variable-buffer-local 'cperl-file-style) + (setq cperl-file-style style)) (declare-function Info-find-node "info" (filename nodename &optional no-going-back strict-case -- cgit v1.2.3 From 79510d81d87488062c41a27279aaf0815c7933bc Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 9 Jan 2024 07:55:51 +0100 Subject: Use `min`/`max` macros in a few more places * src/bidi.c (bidi_set_sos_type): * src/coding.c (consume_chars): * src/dosfns.c (dos_memory_info): * src/emacs.c (sort_args): * src/insdel.c (count_combining_before) (count_combining_after, replace_range, del_range_2): * src/sort.c (tim_sort): * src/w32.c (sys_write): * src/xfaces.c (face_at_buffer_position) (face_for_overlay_string): Prefer using 'min' and 'max' macros. --- src/bidi.c | 2 +- src/coding.c | 3 +-- src/dosfns.c | 5 +---- src/emacs.c | 2 +- src/insdel.c | 13 ++++++------- src/sort.c | 3 +-- src/w32.c | 2 +- src/xfaces.c | 4 ++-- 8 files changed, 14 insertions(+), 20 deletions(-) diff --git a/src/bidi.c b/src/bidi.c index 93bb061ac32..a2b5054cb60 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -420,7 +420,7 @@ bidi_paired_bracket_type (int c) static void bidi_set_sos_type (struct bidi_it *bidi_it, int level_before, int level_after) { - int higher_level = (level_before > level_after ? level_before : level_after); + int higher_level = max (level_before, level_after); /* FIXME: should the default sos direction be user selectable? */ bidi_it->sos = ((higher_level & 1) != 0 ? R2L : L2R); /* X10 */ diff --git a/src/coding.c b/src/coding.c index 219e3554c18..a5bec8b6305 100644 --- a/src/coding.c +++ b/src/coding.c @@ -7658,8 +7658,7 @@ consume_chars (struct coding_system *coding, Lisp_Object translation_table, if (pos == stop_charset) buf = handle_charset_annotation (pos, end_pos, coding, buf, &stop_charset); - stop = (stop_composition < stop_charset - ? stop_composition : stop_charset); + stop = min (stop_composition, stop_charset); } if (! multibytep) diff --git a/src/dosfns.c b/src/dosfns.c index 3eb3b34145e..96087116c19 100644 --- a/src/dosfns.c +++ b/src/dosfns.c @@ -652,10 +652,7 @@ dos_memory_info (unsigned long *totalram, unsigned long *freeram, mem2 *= 4096; /* Surely, the available memory is at least what we have physically available, right? */ - if (mem1 >= mem2) - freemem = mem1; - else - freemem = mem2; + freemem = max (mem1, mem2); *freeram = freemem; *totalswap = ((long)info.max_pages_in_paging_file == -1L) diff --git a/src/emacs.c b/src/emacs.c index eb1871841ec..97c65fbfd33 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2900,7 +2900,7 @@ sort_args (int argc, char **argv) new[to++] = argv[best + i + 1]; } - incoming_used += 1 + (options[best] > 0 ? options[best] : 0); + incoming_used += 1 + max (options[best], 0); /* Clear out this option in ARGV. */ argv[best] = 0; diff --git a/src/insdel.c b/src/insdel.c index e41d9945551..3809f8bc060 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -803,7 +803,7 @@ count_combining_before (const unsigned char *string, ptrdiff_t length, while (!CHAR_HEAD_P (*p) && p < string + length) p++; - return (combining_bytes < p - string ? combining_bytes : p - string); + return min (combining_bytes, p - string); } /* See if the bytes after POS/POS_BYTE combine with bytes @@ -865,7 +865,7 @@ count_combining_after (const unsigned char *string, bufp++, pos_byte++; while (!CHAR_HEAD_P (*bufp)) bufp++, pos_byte++; - return (bytes <= pos_byte - opos_byte ? bytes : pos_byte - opos_byte); + return min (bytes, pos_byte - opos_byte); } #endif @@ -1568,9 +1568,8 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new, /* Relocate point as if it were a marker. */ if (from < PT) - adjust_point ((from + inschars - (PT < to ? PT : to)), - (from_byte + outgoing_insbytes - - (PT_BYTE < to_byte ? PT_BYTE : to_byte))); + adjust_point ((from + inschars - min (PT, to)), + (from_byte + outgoing_insbytes - min (PT_BYTE, to_byte))); check_markers (); @@ -1919,8 +1918,8 @@ del_range_2 (ptrdiff_t from, ptrdiff_t from_byte, /* Relocate point as if it were a marker. */ if (from < PT) - adjust_point (from - (PT < to ? PT : to), - from_byte - (PT_BYTE < to_byte ? PT_BYTE : to_byte)); + adjust_point (from - min (PT, to), + from_byte - min (PT_BYTE, to_byte)); offset_intervals (current_buffer, from, - nchars_del); diff --git a/src/sort.c b/src/sort.c index 5f7a1ee2f53..2f98bfa648c 100644 --- a/src/sort.c +++ b/src/sort.c @@ -946,8 +946,7 @@ tim_sort (Lisp_Object predicate, Lisp_Object *seq, const ptrdiff_t length) /* If the run is short, extend it to min(minrun, nremaining). */ if (n < minrun) { - const ptrdiff_t force = nremaining <= minrun ? - nremaining : minrun; + const ptrdiff_t force = min (nremaining, minrun); binarysort (&ms, lo, lo + force, lo + n); n = force; } diff --git a/src/w32.c b/src/w32.c index f365616db2b..df5465c2135 100644 --- a/src/w32.c +++ b/src/w32.c @@ -9414,7 +9414,7 @@ sys_write (int fd, const void * buffer, unsigned int count) errno = 0; while (count > 0) { - unsigned this_chunk = count < chunk ? count : chunk; + unsigned this_chunk = min (count, chunk); int n = _write (fd, p, this_chunk); if (n > 0) diff --git a/src/xfaces.c b/src/xfaces.c index e30c2fac70c..c9ade2769bd 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -6646,7 +6646,7 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos, /* Get the `face' or `mouse_face' text property at POS, and determine the next position at which the property changes. */ prop = Fget_text_property (position, propname, w->contents); - XSETFASTINT (limit1, (limit < endpos ? limit : endpos)); + XSETFASTINT (limit1, min (limit, endpos)); end = Fnext_single_property_change (position, propname, w->contents, limit1); if (FIXNUMP (end)) endpos = XFIXNUM (end); @@ -6782,7 +6782,7 @@ face_for_overlay_string (struct window *w, ptrdiff_t pos, /* Get the `face' or `mouse_face' text property at POS, and determine the next position at which the property changes. */ prop = Fget_text_property (position, propname, w->contents); - XSETFASTINT (limit1, (limit < endpos ? limit : endpos)); + XSETFASTINT (limit1, min (limit, endpos)); end = Fnext_single_property_change (position, propname, w->contents, limit1); if (FIXNUMP (end)) endpos = XFIXNUM (end); -- cgit v1.2.3 From 0a5ebd444a820308571a659005d094b2dd93fe3f Mon Sep 17 00:00:00 2001 From: Harald Jörg Date: Tue, 9 Jan 2024 11:44:43 +0100 Subject: ; cperl-mode: Fix a compiler warning caused by my previous commit * lisp/progmodes/cperl-mode.el (cperl-file-style): Replace 'make-variable-buffer-local' with 'make.local-variable' --- lisp/progmodes/cperl-mode.el | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 5e435f7133e..bfc1742610c 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6556,10 +6556,8 @@ and \"Whitesmith\"." (dolist (setting (cdr (assoc style cperl-style-alist)) style) (let ((option (car setting)) (value (cdr setting))) - (make-variable-buffer-local option) - (set option value))) - (make-variable-buffer-local 'cperl-file-style) - (setq cperl-file-style style)) + (set (make-local-variable option) value))) + (set (make-local-variable 'cperl-file-style) style)) (declare-function Info-find-node "info" (filename nodename &optional no-going-back strict-case -- cgit v1.2.3 From ee2a8fd4cff84cd5bd672fdde8ec3e0800f132be Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Jan 2024 11:34:05 -0500 Subject: (mouse-wheel-*-event): Minor cleanups * lisp/mwheel.el (mwheel-event-button): Mark as obsolete alias. Change all callers. * lisp/edmacro.el (mouse-wheel-*-event): Move declarations to ... (edmacro-fix-menu-commands): ... where we do know that they should be defined. Obey `mouse-wheel-*-alternate-event`s as well. --- lisp/edmacro.el | 20 +++++++++++++------- lisp/mwheel.el | 18 ++++++------------ 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 362ec0ecbb4..5bd0c1892e5 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -720,17 +720,19 @@ This function assumes that the events can be stored in a string." (setf (aref seq i) (logand (aref seq i) 127))) seq) -;; These are needed in a --without-x build. -(defvar mouse-wheel-down-event) -(defvar mouse-wheel-up-event) -(defvar mouse-wheel-right-event) -(defvar mouse-wheel-left-event) - (defun edmacro-fix-menu-commands (macro &optional noerror) (if (vectorp macro) (let (result) ;; Not preloaded in a --without-x build. (require 'mwheel) + (defvar mouse-wheel-down-event) + (defvar mouse-wheel-up-event) + (defvar mouse-wheel-right-event) + (defvar mouse-wheel-left-event) + (defvar mouse-wheel-down-alternate-event) + (defvar mouse-wheel-up-alternate-event) + (defvar mouse-wheel-right-alternate-event) + (defvar mouse-wheel-left-alternate-event) ;; Make a list of the elements. (setq macro (append macro nil)) (dolist (ev macro) @@ -748,7 +750,11 @@ This function assumes that the events can be stored in a string." (memq (event-basic-type ev) (list mouse-wheel-down-event mouse-wheel-up-event mouse-wheel-right-event - mouse-wheel-left-event))) + mouse-wheel-left-event + mouse-wheel-down-alternate-event + mouse-wheel-up-alternate-event + mouse-wheel-right-alternate-event + mouse-wheel-left-alternate-event))) nil) (noerror nil) (t diff --git a/lisp/mwheel.el b/lisp/mwheel.el index b75b6f27d53..735adf42f68 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -216,15 +216,9 @@ Also see `mouse-wheel-tilt-scroll'." :type 'boolean :version "26.1") -(defun mwheel-event-button (event) - (let ((x (event-basic-type event))) - ;; Map mouse-wheel events to appropriate buttons - (if (eq 'mouse-wheel x) - (let ((amount (car (cdr (cdr (cdr event)))))) - (if (< amount 0) - mouse-wheel-up-event - mouse-wheel-down-event)) - x))) +;; This function used to handle the `mouse-wheel` event which was +;; removed in 2003 by commit 9eb28007fb27, thus making it obsolete. +(define-obsolete-function-alias 'mwheel-event-button #'event-basic-type "30.1") (defun mwheel-event-window (event) (posn-window (event-start event))) @@ -347,7 +341,7 @@ value of ARG, and the command uses it in subsequent scrolls." (when (numberp amt) (setq amt (* amt (event-line-count event)))) (condition-case nil (unwind-protect - (let ((button (mwheel-event-button event))) + (let ((button (event-basic-type event))) (cond ((and (eq amt 'hscroll) (memq button (list mouse-wheel-down-event mouse-wheel-down-alternate-event))) (when (and (natnump arg) (> arg 0)) @@ -434,7 +428,7 @@ See also `text-scale-adjust'." (interactive (list last-input-event)) (let ((selected-window (selected-window)) (scroll-window (mouse-wheel--get-scroll-window event)) - (button (mwheel-event-button event))) + (button (event-basic-type event))) (select-window scroll-window 'mark-for-redisplay) (unwind-protect (cond ((memq button (list mouse-wheel-down-event @@ -450,7 +444,7 @@ See also `text-scale-adjust'." "Increase or decrease the global font size according to the EVENT. This invokes `global-text-scale-adjust', which see." (interactive (list last-input-event)) - (let ((button (mwheel-event-button event))) + (let ((button (event-basic-type event))) (cond ((memq button (list mouse-wheel-down-event mouse-wheel-down-alternate-event)) (global-text-scale-adjust 1)) -- cgit v1.2.3 From 29e59b835c86e1ebac12adcb28ab7e1d0c275b2f Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 9 Jan 2024 19:22:40 +0200 Subject: * lisp/tab-bar.el: Fixes for point in window configuration (bug#68235) (tab-bar--tab): Instead of 'point-marker', use 'copy-marker' with the TYPE argument set to 'window-point-insertion-type'. This will allow point to follow the output after switching tabs when point is at the end of a comint/compilation buffer. (tab-bar-select-tab): Remove ad-hoc rule for the reverted dired buffer. --- lisp/tab-bar.el | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 219f42848ef..3e1d8278b04 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1302,7 +1302,7 @@ tab bar might wrap to the second line when it shouldn't.") (ws . ,(window-state-get (frame-root-window (or frame (selected-frame))) 'writable)) (wc . ,(current-window-configuration)) - (wc-point . ,(point-marker)) + (wc-point . ,(copy-marker (window-point) window-point-insertion-type)) (wc-bl . ,bl) (wc-bbl . ,bbl) ,@(when tab-bar-history-mode @@ -1455,13 +1455,7 @@ Negative TAB-NUMBER counts tabs from the end of the tab bar." ;; set-window-configuration does not restore the value of ;; point in the current buffer, so restore it separately. (when (and (markerp wc-point) - (marker-buffer wc-point) - ;; FIXME: After dired-revert, marker relocates to 1. - ;; window-configuration restores point to global point - ;; in this dired buffer, not to its window point, - ;; but this is slightly better than 1. - ;; Maybe better to save dired-filename in each window? - (not (eq 1 (marker-position wc-point)))) + (marker-buffer wc-point)) (goto-char wc-point)) (when wc-bl (set-frame-parameter nil 'buffer-list wc-bl)) -- cgit v1.2.3 From aff1d53cd466b64ded08d5cf12f83e5746704c07 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 9 Jan 2024 19:57:50 +0200 Subject: Support more metadata properties in completion-extra-properties (bug#68214) * doc/lispref/minibuf.texi (Completion Variables): Add to the table of completion-extra-properties new items: `group-function', `display-sort-function', `cycle-sort-function'. * lisp/icomplete.el (icomplete--augment): Remove unnecessary plist-get from completion-extra-properties since now completion-metadata-get does this. * lisp/minibuffer.el (completion-metadata-get): Use plist-get to get prop from completion-extra-properties and cache the keyword. Thanks to Daniel Mendler . (completion-extra-properties): Mention new properties in docstring. (minibuffer-completion-help): Remove unnecessary plist-get from completion-extra-properties since now completion-metadata-get does this. * lisp/net/eww.el (eww-switch-to-buffer): * test/lisp/minibuffer-tests.el (completions-affixation-navigation-test): Unquote lambda in completion-extra-properties. --- doc/lispref/minibuf.texi | 9 +++++++++ etc/NEWS | 5 +++++ lisp/icomplete.el | 6 ++---- lisp/minibuffer.el | 33 ++++++++++++++++++++++++--------- lisp/net/eww.el | 7 ++++--- test/lisp/minibuffer-tests.el | 10 +++++----- 6 files changed, 49 insertions(+), 21 deletions(-) diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 8d25a53161e..18df44256a8 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1928,6 +1928,15 @@ element of the returned list must be a three-element list, the completion, a prefix string, and a suffix string. This function takes priority over @code{:annotation-function}. +@item :group-function +The function to group completions. + +@item :display-sort-function +The function to sort entries in the @file{*Completions*} buffer. + +@item :cycle-sort-function +The function to sort entries when cycling. + @item :exit-function The value should be a function to run after performing completion. The function should accept two arguments, @var{string} and diff --git a/etc/NEWS b/etc/NEWS index f4d008ee2d6..fcec2ca715a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -752,6 +752,11 @@ The new supported completion properties are 'cycle-sort-function', 'completion-category-overrides' that will override the properties defined in completion metadata. ++++ +*** 'completion-extra-properties' supports more metadata. +The new supported completion properties are 'group-function', +'display-sort-function', 'cycle-sort-function'. + ** Pcomplete --- diff --git a/lisp/icomplete.el b/lisp/icomplete.el index d49714f3204..aa3c5680a7e 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -789,10 +789,8 @@ and SUFFIX, if non-nil, are obtained from `affixation-function' or `group-function'. Consecutive `equal' sections are avoided. COMP is the element in PROSPECTS or a transformation also given by `group-function''s second \"transformation\" protocol." - (let* ((aff-fun (or (completion-metadata-get md 'affixation-function) - (plist-get completion-extra-properties :affixation-function))) - (ann-fun (or (completion-metadata-get md 'annotation-function) - (plist-get completion-extra-properties :annotation-function))) + (let* ((aff-fun (completion-metadata-get md 'affixation-function)) + (ann-fun (completion-metadata-get md 'annotation-function)) (grp-fun (and completions-group (completion-metadata-get md 'group-function))) (annotated diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 04b36f03d11..42d04e0ff96 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -151,15 +151,25 @@ The metadata of a completion table should be constant between two boundaries." minibuffer-completion-predicate)) (defun completion-metadata-get (metadata prop) - "Get PROP from completion METADATA. + "Get property PROP from completion METADATA. If the metadata specifies a completion category, the variables `completion-category-overrides' and -`completion-category-defaults' take precedence." +`completion-category-defaults' take precedence for +category-specific overrides. If the completion metadata does not +specify the property, the `completion-extra-properties' plist is +consulted. Note that the keys of the +`completion-extra-properties' plist are keyword symbols, not +plain symbols." (if-let (((not (eq prop 'category))) (cat (alist-get 'category metadata)) (over (completion--category-override cat prop))) (cdr over) - (alist-get prop metadata))) + (or (alist-get prop metadata) + (plist-get completion-extra-properties + ;; Cache the keyword + (or (get prop 'completion-extra-properties--keyword) + (put prop 'completion-extra-properties--keyword + (intern (concat ":" (symbol-name prop))))))))) (defun complete-with-action (action collection string predicate) "Perform completion according to ACTION. @@ -2447,6 +2457,15 @@ These include: `:annotation-function' when both are provided, so only this function is used. +`:group-function': Function for grouping the completion candidates. + +`:display-sort-function': Function to sort entries in *Completions*. + +`:cycle-sort-function': Function to sort entries when cycling. + +See more information about these functions above +in `completion-metadata'. + `:exit-function': Function to run after completion is performed. The function must accept two arguments, STRING and STATUS. @@ -2569,12 +2588,8 @@ The candidate will still be chosen by `choose-completion' unless base-size md minibuffer-completion-table minibuffer-completion-predicate)) - (ann-fun (or (completion-metadata-get all-md 'annotation-function) - (plist-get completion-extra-properties - :annotation-function))) - (aff-fun (or (completion-metadata-get all-md 'affixation-function) - (plist-get completion-extra-properties - :affixation-function))) + (ann-fun (completion-metadata-get all-md 'annotation-function)) + (aff-fun (completion-metadata-get all-md 'affixation-function)) (sort-fun (completion-metadata-get all-md 'display-sort-function)) (group-fun (completion-metadata-get all-md 'group-function)) (mainbuf (current-buffer)) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 22f07cbc5b4..6c46ef0fedb 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -2064,9 +2064,10 @@ If CHARSET is nil then use UTF-8." "Prompt for an EWW buffer to display in the selected window." (interactive nil eww-mode) (let ((completion-extra-properties - '(:annotation-function (lambda (buf) - (with-current-buffer buf - (format " %s" (eww-current-url)))))) + `(:annotation-function + ,(lambda (buf) + (with-current-buffer buf + (format " %s" (eww-current-url)))))) (curbuf (current-buffer))) (pop-to-buffer-same-window (read-buffer "Switch to EWW buffer: " diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 6dc15d0801f..c1fe3032cb5 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -505,11 +505,11 @@ (ert-deftest completions-affixation-navigation-test () (let ((completion-extra-properties - '(:affixation-function - (lambda (completions) - (mapcar (lambda (c) - (list c "prefix " " suffix")) - completions))))) + `(:affixation-function + ,(lambda (completions) + (mapcar (lambda (c) + (list c "prefix " " suffix")) + completions))))) (completing-read-with-minibuffer-setup '("aa" "ab" "ac") (insert "a") -- cgit v1.2.3 From fccaeabc959f5403ce49744030bd2620352b59f8 Mon Sep 17 00:00:00 2001 From: Harald Jörg Date: Tue, 9 Jan 2024 18:46:41 +0100 Subject: ; cperl-mode-tests.el: Adapt to recent changes in cperl-mode.el The tests need to use the new command cperl-file-style to make sure that settings don't bleed out to following tests. * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-indent-styles, cperl-test-bug-35925) (cperl-test-bug-64364, cperl-test-bug-65834): use cperl-file-style instead of cperl-set-style --- test/lisp/progmodes/cperl-mode-tests.el | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index e3026dbfb5a..62b7fdab7f7 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -111,9 +111,8 @@ end of the statement." (skip-unless (eq cperl-test-mode #'cperl-mode)) (cperl--run-test-cases (ert-resource-file "cperl-indent-styles.pl") - (cperl-set-style "PBP") - (indent-region (point-min) (point-max)) ; here we go! - (cperl-set-style-back))) + (cperl-file-style "PBP") + (indent-region (point-min) (point-max)))) ; here we go! ;;; Fontification tests @@ -1145,17 +1144,16 @@ Perl is not Lisp: An open paren in column 0 does not start a function." (ert-deftest cperl-test-bug-35925 () "Check that indentation is correct after a terminating format declaration." - (cperl-set-style "PBP") ; Make cperl-mode use the same settings as perl-mode. (cperl--run-test-cases (ert-resource-file "cperl-bug-35925.pl") + (cperl-file-style "PBP") ; Make cperl-mode use the same settings as perl-mode. (let ((tab-function (if (equal cperl-test-mode 'perl-mode) #'indent-for-tab-command #'cperl-indent-command))) (goto-char (point-max)) (forward-line -2) - (funcall tab-function))) - (cperl-set-style-back)) + (funcall tab-function)))) (ert-deftest cperl-test-bug-37127 () "Verify that closing a paren in a regex goes without a message. @@ -1363,12 +1361,13 @@ as a regex." (ert-deftest cperl-test-bug-64364 () "Check that multi-line subroutine declarations indent correctly." - (cperl-set-style "PBP") ; make cperl-mode use the same settings as perl-mode (cperl--run-test-cases (ert-resource-file "cperl-bug-64364.pl") + (cperl-file-style "PBP") ; make cperl-mode use the same settings as perl-mode (indent-region (point-min) (point-max))) (cperl--run-test-cases (ert-resource-file "cperl-bug-64364.pl") + (cperl-file-style "PBP") ; make cperl-mode use the same settings as perl-mode (let ((tab-function (if (equal cperl-test-mode 'perl-mode) #'indent-for-tab-command @@ -1376,8 +1375,7 @@ as a regex." (goto-char (point-min)) (while (null (eobp)) (funcall tab-function) - (forward-line 1)))) - (cperl-set-style-back)) + (forward-line 1))))) (ert-deftest cperl-test-bug-65834 () "Verify that CPerl mode identifies a left-shift operator. -- cgit v1.2.3 From d58d0fa52ff22e147b8328759d5f0f762e15bbb5 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Wed, 25 Oct 2023 20:43:57 -0700 Subject: Introduce 'let' using lexical binding in the Lisp Introduction * doc/lispintro/emacs-lisp-intro.texi (Prevent confusion): Rework the explanation to discuss how things work under lexical binding. (How let Binds Variables): Describe the differences between lexical and dynamic binding (including how to configure it). (defvar): Mention that 'defvar' declares variables as always dynamically-bound (bug#66756). --- doc/lispintro/emacs-lisp-intro.texi | 171 +++++++++++++++++++++++++++++++----- 1 file changed, 149 insertions(+), 22 deletions(-) diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 1e10f62104a..b3fe8ce4589 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -3556,6 +3556,7 @@ and the two are not intended to refer to the same value. The * Parts of let Expression:: * Sample let Expression:: * Uninitialized let Variables:: +* How let Binds Variables:: @end menu @ifnottex @@ -3569,24 +3570,26 @@ and the two are not intended to refer to the same value. The @cindex @samp{variable, local}, defined The @code{let} special form prevents confusion. @code{let} creates a name for a @dfn{local variable} that overshadows any use of the same -name outside the @code{let} expression. This is like understanding -that whenever your host refers to ``the house'', he means his house, not -yours. (Symbols used in argument lists work the same way. +name outside the @code{let} expression (in computer science jargon, we +call this @dfn{binding} the variable). This is like understanding +that in your host's home, whenever he refers to ``the house'', he +means his house, not yours. (The symbols used to name function +arguments are bound as local variables in exactly the same way. @xref{defun, , The @code{defun} Macro}.) -Local variables created by a @code{let} expression retain their value -@emph{only} within the @code{let} expression itself (and within -expressions called within the @code{let} expression); the local -variables have no effect outside the @code{let} expression. - -Another way to think about @code{let} is that it is like a @code{setq} -that is temporary and local. The values set by @code{let} are -automatically undone when the @code{let} is finished. The setting -only affects expressions that are inside the bounds of the @code{let} -expression. In computer science jargon, we would say the binding of -a symbol is visible only in functions called in the @code{let} form; -in Emacs Lisp, the default scoping is dynamic, not lexical. (The -non-default lexical binding is not discussed in this manual.) +Another way to think about @code{let} is that it defines a special +region in your code: within the body of the @code{let} expression, the +variables you've named have their own local meaning. Outside of the +@code{let} body, they have other meanings (or they may not be defined +at all). This means that inside the @code{let} body, calling +@code{setq} for a variable named by the @code{let} expression will set +the value of the @emph{local} variable of that name. However, outside +of the @code{let} body (such as when calling a function that was +defined elsewhere), calling @code{setq} for a variable named by the +@code{let} expression will @emph{not} affect that local +variable.@footnote{This describes the behavior of @code{let} when +using a style called ``lexical binding'' (@pxref{How let Binds +Variables}).} @code{let} can create more than one variable at once. Also, @code{let} gives each variable it creates an initial value, either a @@ -3746,6 +3749,128 @@ number is printed in the message using a @samp{%d} rather than a @samp{%s}.) The four variables as a group are put into a list to delimit them from the body of the @code{let}. +@node How let Binds Variables +@subsection How @code{let} Binds Variables + +Emacs Lisp supports two different ways of binding variable names to +their values. These ways affect the parts of your program where a +particular binding is valid. For historical reasons, Emacs Lisp uses +a form of variable binding called @dfn{dynamic binding} by default. +However, in this manual we discuss the preferred form of binding, +called @dfn{lexical binding}, unless otherwise noted (in the future, +the Emacs maintainers plan to change the default to lexical binding). +If you have programmed in other languages before, you're likely +already familiar with how lexical binding behaves. + +In order to use lexical binding in a program, you should add this to +the first line of your Emacs Lisp file: + +@example +;;; -*- lexical-binding: t -*- +@end example + +For more information about this, @pxref{Selecting Lisp Dialect, , , +elisp, The Emacs Lisp Reference Manual}. + +@menu +* Lexical & Dynamic Binding Differences:: +* Lexical vs. Dynamic Binding Example:: +@end menu + +@node Lexical & Dynamic Binding Differences +@unnumberedsubsubsec Differences Between Lexical and Dynamic Binding + +@cindex Lexical binding +@cindex Binding, lexical +As we discussed before (@pxref{Prevent confusion}), when you create +local variables with @code{let} under lexical binding, those variables +are valid only within the body of the @code{let} expression. In other +parts of your code, they have other meanings, so if you call a +function defined elsewhere within the @code{let} body, that function +would be unable to ``see'' the local variables you've created. (On +the other hand, if you call a function that was defined within a +@code{let} body, that function @emph{would} be able to see---and +modify---the local variables from that @code{let} expression.) + +@cindex Dynamic binding +@cindex Binding, dynamic +Under dynamic binding, the rules are different: instead, when you use +@code{let}, the local variables you've created are valid during +execution of the @code{let} expression. This means that, if your +@code{let} expression calls a function, that function can see these +local variables, regardless of where the function is defined +(including in another file entirely). + +Another way to think about @code{let} when using dynamic binding is +that every variable name has a global ``stack'' of bindings, and +whenever you use that variable's name, it refers to the binding on the +top of the stack. (You can imagine this like a stack of papers on +your desk with the values written on them.) When you bind a variable +dynamically with @code{let}, it puts the new binding you've specified +on the top of the stack, and then executes the @code{let} body. Once +the @code{let} body finishes, it takes that binding off of the stack, +revealing the one it had (if any) before the @code{let} expression. + +@node Lexical vs. Dynamic Binding Example +@unnumberedsubsubsec Example of Lexical vs. Dynamic Binding +In some cases, both lexical and dynamic binding behave identically. +However, in other cases, they can change the meaning of your program. +For example, see what happens in this code under lexical binding: + +@example +;;; -*- lexical-binding: t -*- + +(setq x 0) + +(defun getx () + x) + +(setq x 1) + +(let ((x 2)) + (getx)) + @result{} 1 +@end example + +@noindent +Here, the result of @code{(getx)} is @code{1}. Under lexical binding, +@code{getx} doesn't see the value from our @code{let} expression. +That's because the body of @code{getx} is outside of the body of our +@code{let} expression. Since @code{getx} is defined at the top, +global level of our code (i.e.@: not inside the body of any @code{let} +expression), it looks for and finds @code{x} at the global level as +well. When executing @code{getx}, the current global value of +@code{x} is @code{1}, so that's what @code{getx} returns. + +If we use dynamic binding instead, the behavior is different: + +@example +;;; -*- lexical-binding: nil -*- + +(setq x 0) + +(defun getx () + x) + +(setq x 1) + +(let ((x 2)) + (getx)) + @result{} 2 +@end example + +@noindent +Now, the result of @code{(getx)} is @code{2}! That's because under +dynamic binding, when executing @code{getx}, the current binding for +@code{x} at the top of our stack is the one from our @code{let} +binding. This time, @code{getx} doesn't see the global value for +@code{x}, since its binding is below the one from our @code{let} +expression in the stack of bindings. + +(Some variables are also ``special'', and they are always dynamically +bound even when @code{lexical-binding} is @code{t}. @xref{defvar, , +Initializing a Variable with @code{defvar}}.) + @node if @section The @code{if} Special Form @findex if @@ -9101,12 +9226,14 @@ In Emacs Lisp, a variable such as the @code{kill-ring} is created and given an initial value by using the @code{defvar} special form. The name comes from ``define variable''. -The @code{defvar} special form is similar to @code{setq} in that it sets -the value of a variable. It is unlike @code{setq} in two ways: first, -it only sets the value of the variable if the variable does not already -have a value. If the variable already has a value, @code{defvar} does -not override the existing value. Second, @code{defvar} has a -documentation string. +The @code{defvar} special form is similar to @code{setq} in that it +sets the value of a variable. It is unlike @code{setq} in three ways: +first, it marks the variable as ``special'' so that it is always +dynamically bound, even when @code{lexical-binding} is @code{t} +(@pxref{How let Binds Variables}). Second, it only sets the value of +the variable if the variable does not already have a value. If the +variable already has a value, @code{defvar} does not override the +existing value. Third, @code{defvar} has a documentation string. (There is a related macro, @code{defcustom}, designed for variables that people customize. It has more features than @code{defvar}. -- cgit v1.2.3 From 3f303b9cb51306e1f70e2024a31a48a9901585a0 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 10 Jan 2024 11:38:54 +0800 Subject: ; Minor edits to PROBLEMS and sfnt.c * etc/PROBLEMS: Improve description of issues with Droid Sans Mono. * src/sfnt.c (sfnt_poly_edges_exact): Remove extraneous undef. --- etc/PROBLEMS | 15 ++++++++------- src/sfnt.c | 2 -- 2 files changed, 8 insertions(+), 9 deletions(-) diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 7a5f029af65..5166907e463 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -3408,14 +3408,15 @@ this and many other problems do not exist on the regular X builds. TrueType fonts incorporate instruction code executed by the font scaler (the component responsible for transforming outlines into -bitmap images capable of being displayed onscreen), in order that -features of each glyph might be aligned to pixel boundaries -intelligently, preventing faintness while maintaining the shape of its -features. The substandard instruction code provided by the monospace -font distributed with Android misplaces features of such glyphs as "E" -and "F" between point sizes of 16 and 24, resulting in noticeable +bitmap images capable of being displayed onscreen) to align features +of each glyph to pixel boundaries while maintaining their shape, in +order to alleviate visual imperfections produced by scaling. The +substandard instruction code provided by the Android "Droid Sans Mono" +font misplaces features of glyphs containing, as components, "E" and +"F", between PPEM sizes of 16 and 24, resulting in noticeable whitespace inconsistencies with other glyphs. Furthermore, the -vertical stem in the glyph "T" is positioned too far to the left. +vertical stem in the glyph "T" is positioned too far to the left at +PPEM sizes of 12. The remedy for this is to replace the instruction code with automatically generated code from the FreeType project's "ttfautohint" diff --git a/src/sfnt.c b/src/sfnt.c index 0666bb17cf0..f4c023f35c6 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -5474,8 +5474,6 @@ be as well. */ next = next->next; xfree (last); } - -#undef ONE_PIXEL } /* Apply winding rule to the coverage value VALUE. Convert VALUE to a -- cgit v1.2.3 From 7755f7172748b2d337fa53434c1f678269cc5c45 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 10 Jan 2024 09:34:47 +0200 Subject: Support :category in completion-extra-properties (bug#68214) * doc/lispref/minibuf.texi (Completion Variables): Add :category to the table of completion-extra-properties. * lisp/minibuffer.el (completion--metadata-get-1): New internal function. (completion-metadata-get): Use 'completion--metadata-get-1'. Thanks to Daniel Mendler . (completion-extra-properties): Mention :category in the docstring. * lisp/calendar/calendar.el (calendar-read-date): Use more user-friendly let-binding of completion-extra-properties with :category. --- doc/lispref/minibuf.texi | 6 ++++++ etc/NEWS | 4 ++-- lisp/calendar/calendar.el | 14 ++++++-------- lisp/minibuffer.el | 20 +++++++++++++------- 4 files changed, 27 insertions(+), 17 deletions(-) diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 18df44256a8..aa27de72ba0 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1912,6 +1912,12 @@ completion commands. Its value should be a list of property and value pairs. The following properties are supported: @table @code +@item :category +The value should be a symbol describing what kind of text the +completion function is trying to complete. If the symbol matches one +of the keys in @code{completion-category-overrides}, the usual +completion behavior is overridden. @xref{Completion Variables}. + @item :annotation-function The value should be a function to add annotations in the completions buffer. This function must accept one argument, a completion, and diff --git a/etc/NEWS b/etc/NEWS index fcec2ca715a..4559c67d4ae 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -754,8 +754,8 @@ defined in completion metadata. +++ *** 'completion-extra-properties' supports more metadata. -The new supported completion properties are 'group-function', -'display-sort-function', 'cycle-sort-function'. +The new supported completion properties are 'category', +'group-function', 'display-sort-function', 'cycle-sort-function'. ** Pcomplete diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index e01d5d792a6..2c3e7d28301 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -2337,14 +2337,12 @@ returned is (month year)." (defmon (aref month-array (1- (calendar-extract-month default-date)))) (completion-ignore-case t) (month (cdr (assoc-string - (completing-read - (format-prompt "Month name" defmon) - (lambda (string pred action) - (if (eq action 'metadata) - '(metadata (category . calendar-month)) - (complete-with-action - action (append month-array nil) string pred))) - nil t nil nil defmon) + (let ((completion-extra-properties + '(:category calendar-month))) + (completing-read + (format-prompt "Month name" defmon) + (append month-array nil) + nil t nil nil defmon)) (calendar-make-alist month-array 1) t))) (defday (calendar-extract-day default-date)) (last (calendar-last-day-of-month month year))) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 42d04e0ff96..45aab398078 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -150,6 +150,14 @@ The metadata of a completion table should be constant between two boundaries." minibuffer-completion-table minibuffer-completion-predicate)) +(defun completion--metadata-get-1 (metadata prop) + (or (alist-get prop metadata) + (plist-get completion-extra-properties + ;; Cache the keyword + (or (get prop 'completion-extra-properties--keyword) + (put prop 'completion-extra-properties--keyword + (intern (concat ":" (symbol-name prop)))))))) + (defun completion-metadata-get (metadata prop) "Get property PROP from completion METADATA. If the metadata specifies a completion category, the variables @@ -161,15 +169,10 @@ consulted. Note that the keys of the `completion-extra-properties' plist are keyword symbols, not plain symbols." (if-let (((not (eq prop 'category))) - (cat (alist-get 'category metadata)) + (cat (completion--metadata-get-1 metadata 'category)) (over (completion--category-override cat prop))) (cdr over) - (or (alist-get prop metadata) - (plist-get completion-extra-properties - ;; Cache the keyword - (or (get prop 'completion-extra-properties--keyword) - (put prop 'completion-extra-properties--keyword - (intern (concat ":" (symbol-name prop))))))))) + (completion--metadata-get-1 metadata prop))) (defun complete-with-action (action collection string predicate) "Perform completion according to ACTION. @@ -2442,6 +2445,9 @@ candidates." "Property list of extra properties of the current completion job. These include: +`:category': the kind of objects returned by `all-completions'. + Used by `completion-category-overrides'. + `:annotation-function': Function to annotate the completions buffer. The function must accept one argument, a completion string, and return either nil or a string which is to be displayed -- cgit v1.2.3 From eb913c7501489e1eae475cae843fccdf14cc24d8 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 10 Jan 2024 09:25:41 +0100 Subject: Handle package versions that are not version strings * lisp/emacs-lisp/package.el (package-menu--version-predicate): Ignore any errors raised by 'version-to-list', thus falling back to the default version list. (Bug#68317) --- lisp/emacs-lisp/package.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index b21e0f8fc51..868373f46c2 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -4069,8 +4069,8 @@ invocations." (defun package-menu--version-predicate (A B) "Predicate to sort \"*Packages*\" buffer by the version column. This is used for `tabulated-list-format' in `package-menu-mode'." - (let ((vA (or (version-to-list (aref (cadr A) 1)) '(0))) - (vB (or (version-to-list (aref (cadr B) 1)) '(0)))) + (let ((vA (or (ignore-error error (version-to-list (aref (cadr A) 1))) '(0))) + (vB (or (ignore-error error (version-to-list (aref (cadr B) 1))) '(0)))) (if (version-list-= vA vB) (package-menu--name-predicate A B) (version-list-< vA vB)))) -- cgit v1.2.3 From cf887b7eb08a7ed0859b3fa2e1c4e54d787d2f9d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 10 Jan 2024 12:49:08 +0100 Subject: Fix file name completion with Tramp on MS Windoes * doc/misc/trampver.texi: * lisp/net/trampver.el (tramp-version): Adapt Tramp versions. * lisp/net/tramp.el (tramp-build-completion-file-name-regexp): Do not use `tramp-volume-letter-regexp'. (Bug#68320) (tramp-completion-handle-expand-file-name): Simplify regexp. * test/lisp/net/tramp-tests.el (tramp-test26-file-name-completion) (tramp-test26-interactive-file-name-completion): Run also on MS Windows. --- doc/misc/trampver.texi | 2 +- lisp/net/tramp.el | 11 +---- lisp/net/trampver.el | 6 +-- test/lisp/net/tramp-tests.el | 100 +++++++++++++++++++++---------------------- 4 files changed, 54 insertions(+), 65 deletions(-) diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 8cb0e3d574a..bf5c90ee8a9 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -7,7 +7,7 @@ @c In the Tramp GIT, the version number and the bug report address @c are auto-frobbed from configure.ac. -@set trampver 2.7.0 +@set trampver 2.7.1-pre @set trampurl https://www.gnu.org/software/tramp/ @set tramp-bug-report-address tramp-devel@@gnu.org @set emacsver 27.1 diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ad36dd53a32..f943bd81a51 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1205,14 +1205,7 @@ The `ftp' syntax does not support methods.") ;; FIXME: This shouldn't be necessary. (rx bos "/" (? "[" (* (not "]"))) eos) (rx - bos - ;; `file-name-completion' uses absolute paths for matching. - ;; This means that on W32 systems, something like - ;; "/ssh:host:~/path" becomes "c:/ssh:host:~/path". See also - ;; `tramp-drop-volume-letter'. - (? (regexp tramp-volume-letter-regexp)) - ;; We cannot use `tramp-prefix-regexp', because it starts with `bol'. - (literal tramp-prefix-format) + (regexp tramp-prefix-regexp) ;; Optional multi-hops. (* (regexp tramp-remote-file-name-spec-regexp) @@ -2666,7 +2659,7 @@ not in completion mode." (string-match-p (rx (regexp tramp-postfix-host-regexp) eos) dir)) (concat dir filename)) ((string-match-p - (rx bos (regexp tramp-prefix-regexp) + (rx (regexp tramp-prefix-regexp) (* (regexp tramp-remote-file-name-spec-regexp) (regexp tramp-postfix-hop-regexp)) (? (regexp tramp-method-regexp) (regexp tramp-postfix-method-regexp) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 4b8868561d4..c131d39c110 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.7.0 +;; Version: 2.7.1-pre ;; Package-Requires: ((emacs "27.1")) ;; Package-Type: multi ;; URL: https://www.gnu.org/software/tramp/ @@ -40,7 +40,7 @@ ;; ./configure" to change them. ;;;###tramp-autoload -(defconst tramp-version "2.7.0" +(defconst tramp-version "2.7.1-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -78,7 +78,7 @@ ;; Check for Emacs version. (let ((x (if (not (string-version-lessp emacs-version "27.1")) "ok" - (format "Tramp 2.7.0 is not fit for %s" + (format "Tramp 2.7.1-pre is not fit for %s" (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 91b0542c759..2a3b3e16891 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4719,57 +4719,55 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check `file-name-completion' and `file-name-all-completions'." (skip-unless (tramp--test-enabled)) - ;; Method and host name in completion mode. This kind of completion - ;; does not work on MS Windows. - (unless (memq system-type '(cygwin windows-nt)) - (let ((tramp-fuse-remove-hidden-files t) - (method (file-remote-p ert-remote-temporary-file-directory 'method)) - (host (file-remote-p ert-remote-temporary-file-directory 'host)) - (orig-syntax tramp-syntax) - (minibuffer-completing-file-name t)) - (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) - (setq host (match-string 1 host))) + ;; Method and host name in completion mode. + (let ((tramp-fuse-remove-hidden-files t) + (method (file-remote-p ert-remote-temporary-file-directory 'method)) + (host (file-remote-p ert-remote-temporary-file-directory 'host)) + (orig-syntax tramp-syntax) + (minibuffer-completing-file-name t)) + (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) + (setq host (match-string 1 host))) - (unwind-protect - (dolist (syntax (if (tramp--test-expensive-test-p) - (tramp-syntax-values) `(,orig-syntax))) - (tramp-change-syntax syntax) - ;; This has cleaned up all connection data, which are used - ;; for completion. We must refill the cache. - (tramp-set-connection-property tramp-test-vec "property" nil) - - (let (;; This is needed for the `separate' syntax. - (prefix-format (substring tramp-prefix-format 1)) - ;; This is needed for the IPv6 host name syntax. - (ipv6-prefix - (and (string-match-p tramp-ipv6-regexp host) - tramp-prefix-ipv6-format)) - (ipv6-postfix - (and (string-match-p tramp-ipv6-regexp host) - tramp-postfix-ipv6-format))) - ;; Complete method name. - (unless (or (tramp-string-empty-or-nil-p method) - (string-empty-p tramp-method-regexp)) - (should - (member - (concat prefix-format method tramp-postfix-method-format) - (file-name-all-completions - (concat prefix-format (substring method 0 1)) "/")))) - ;; Complete host name. - (unless (or (tramp-string-empty-or-nil-p method) - (string-empty-p tramp-method-regexp) - (tramp-string-empty-or-nil-p host)) - (should - (member - (concat - prefix-format method tramp-postfix-method-format - ipv6-prefix host ipv6-postfix tramp-postfix-host-format) - (file-name-all-completions - (concat prefix-format method tramp-postfix-method-format) - "/")))))) + (unwind-protect + (dolist (syntax (if (tramp--test-expensive-test-p) + (tramp-syntax-values) `(,orig-syntax))) + (tramp-change-syntax syntax) + ;; This has cleaned up all connection data, which are used + ;; for completion. We must refill the cache. + (tramp-set-connection-property tramp-test-vec "property" nil) - ;; Cleanup. - (tramp-change-syntax orig-syntax)))) + (let (;; This is needed for the `separate' syntax. + (prefix-format (substring tramp-prefix-format 1)) + ;; This is needed for the IPv6 host name syntax. + (ipv6-prefix + (and (string-match-p tramp-ipv6-regexp host) + tramp-prefix-ipv6-format)) + (ipv6-postfix + (and (string-match-p tramp-ipv6-regexp host) + tramp-postfix-ipv6-format))) + ;; Complete method name. + (unless (or (tramp-string-empty-or-nil-p method) + (string-empty-p tramp-method-regexp)) + (should + (member + (concat prefix-format method tramp-postfix-method-format) + (file-name-all-completions + (concat prefix-format (substring method 0 1)) "/")))) + ;; Complete host name. + (unless (or (tramp-string-empty-or-nil-p method) + (string-empty-p tramp-method-regexp) + (tramp-string-empty-or-nil-p host)) + (should + (member + (concat + prefix-format method tramp-postfix-method-format + ipv6-prefix host ipv6-postfix tramp-postfix-host-format) + (file-name-all-completions + (concat prefix-format method tramp-postfix-method-format) + "/")))))) + + ;; Cleanup. + (tramp-change-syntax orig-syntax))) (dolist (non-essential '(nil t)) (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) @@ -4851,9 +4849,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; and Bug#60505. (ert-deftest tramp-test26-interactive-file-name-completion () "Check interactive completion with different `completion-styles'." - ;; Method, user and host name in completion mode. This kind of - ;; completion does not work on MS Windows. - (skip-unless (not (memq system-type '(cygwin windows-nt)))) + ;; Method, user and host name in completion mode. (tramp-cleanup-connection tramp-test-vec nil 'keep-password) (let ((method (file-remote-p ert-remote-temporary-file-directory 'method)) -- cgit v1.2.3 From 83ee584052f063cc802fca427c42ece2d5091ca5 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 10 Jan 2024 12:49:46 +0100 Subject: ; Adapt TODO list of tramp-compat.el --- lisp/net/tramp-compat.el | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 8065ba01734..87b20b982f9 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -330,6 +330,16 @@ Also see `ignore'." ;;; TODO: ;; ;; * Starting with Emacs 27.1, there's no need to escape open -;; parentheses with a backslash in docstrings anymore. +;; parentheses with a backslash in docstrings anymore. However, +;; `outline-minor-mode' has still problems with this. Since there +;; are developers using `outline-minor-mode' in Lisp files, we still +;; keep this quoting. +;; +;; * Starting with Emacs 29.1, use `buffer-match-p'. +;; +;; * Starting with Emacs 30.1, there is `handler-bind'. Use it +;; instead of `condition-case' when the origin of an error shall be +;; kept, for example when the HANDLER propagates the error with +;; `(signal (car err) (cdr err)'. ;;; tramp-compat.el ends here -- cgit v1.2.3 From 1a2fa8f413ffacc2490f4c46b3bbfc37b16fbd04 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Jan 2024 08:18:22 +0100 Subject: Remove redundant casts from void* with malloc functions * src/msdos.c (IT_menu_make_room): * src/pgtkterm.c (pgtk_define_fringe_bitmap): * src/w16select.c (set_clipboard_data): * src/w32term.c (w32_define_fringe_bitmap): * src/w32uniscribe.c (uniscribe_shape): Remove redundant cast from void* with xrealloc. * admin/coccinelle/alloc_cast.cocci: New semantic patch. --- admin/coccinelle/alloc_cast.cocci | 6 ++++++ src/msdos.c | 12 ++++-------- src/pgtkterm.c | 4 +--- src/w16select.c | 2 +- src/w32term.c | 2 +- src/w32uniscribe.c | 3 +-- 6 files changed, 14 insertions(+), 15 deletions(-) create mode 100644 admin/coccinelle/alloc_cast.cocci diff --git a/admin/coccinelle/alloc_cast.cocci b/admin/coccinelle/alloc_cast.cocci new file mode 100644 index 00000000000..91810dbc7e4 --- /dev/null +++ b/admin/coccinelle/alloc_cast.cocci @@ -0,0 +1,6 @@ +// Remove redundant casts from memory allocation functions. +@@ +type T; +@@ +-(T *) + \(xmalloc\|xzalloc\|xrealloc\|xpalloc\|xnrealloc\)(...) diff --git a/src/msdos.c b/src/msdos.c index bdacda50975..1f82d4029d7 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -2811,14 +2811,10 @@ IT_menu_make_room (XMenu *menu) else if (menu->allocated == menu->count) { int count = menu->allocated = menu->allocated + 10; - menu->text - = (char **) xrealloc (menu->text, count * sizeof (char *)); - menu->submenu - = (XMenu **) xrealloc (menu->submenu, count * sizeof (XMenu *)); - menu->panenumber - = (int *) xrealloc (menu->panenumber, count * sizeof (int)); - menu->help_text - = (const char **) xrealloc (menu->help_text, count * sizeof (char *)); + menu->text = xrealloc (menu->text, count * sizeof (char *)); + menu->submenu = xrealloc (menu->submenu, count * sizeof (XMenu *)); + menu->panenumber = xrealloc (menu->panenumber, count * sizeof (int)); + menu->help_text = xrealloc (menu->help_text, count * sizeof (char *)); } } diff --git a/src/pgtkterm.c b/src/pgtkterm.c index d938427c75a..2f7a390d22d 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -3471,9 +3471,7 @@ pgtk_define_fringe_bitmap (int which, unsigned short *bits, int h, int wd) i = max_fringe_bmp; max_fringe_bmp = which + 20; fringe_bmp - = (cairo_pattern_t **) xrealloc (fringe_bmp, - max_fringe_bmp * - sizeof (cairo_pattern_t *)); + = xrealloc (fringe_bmp, max_fringe_bmp * sizeof (cairo_pattern_t *)); while (i < max_fringe_bmp) fringe_bmp[i++] = 0; } diff --git a/src/w16select.c b/src/w16select.c index c8b91bfa883..ed450c665ff 100644 --- a/src/w16select.c +++ b/src/w16select.c @@ -275,7 +275,7 @@ set_clipboard_data (unsigned Format, void *Data, unsigned Size, int Raw) { clipboard_storage_size = truelen + 100; last_clipboard_text = - (char *) xrealloc (last_clipboard_text, clipboard_storage_size); + xrealloc (last_clipboard_text, clipboard_storage_size); } if (last_clipboard_text) dosmemget (xbuf_addr, truelen, last_clipboard_text); diff --git a/src/w32term.c b/src/w32term.c index 816584a13be..f5611772637 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -949,7 +949,7 @@ w32_define_fringe_bitmap (int which, unsigned short *bits, int h, int wd) { int i = max_fringe_bmp; max_fringe_bmp = which + 20; - fringe_bmp = (HBITMAP *) xrealloc (fringe_bmp, max_fringe_bmp * sizeof (HBITMAP)); + fringe_bmp = xrealloc (fringe_bmp, max_fringe_bmp * sizeof (HBITMAP)); while (i < max_fringe_bmp) fringe_bmp[i++] = 0; } diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c index a73c0de06f9..84d0d95b2ab 100644 --- a/src/w32uniscribe.c +++ b/src/w32uniscribe.c @@ -330,8 +330,7 @@ uniscribe_shape (Lisp_Object lgstring, Lisp_Object direction) { /* If that wasn't enough, keep trying with one more run. */ max_items++; - items = (SCRIPT_ITEM *) xrealloc (items, - sizeof (SCRIPT_ITEM) * max_items + 1); + items = xrealloc (items, sizeof (SCRIPT_ITEM) * max_items + 1); } if (FAILED (result)) -- cgit v1.2.3 From 3d412395246599bf633efd3ecd7f33c2bb97f66b Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Jan 2024 10:24:33 +0100 Subject: Fix use after free in androidvfs.c * src/androidvfs.c (android_afs_opendir, android_saf_tree_opendir): Fix use after free. --- src/androidvfs.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/androidvfs.c b/src/androidvfs.c index 3377683c84f..78f6b6da6a8 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -2388,8 +2388,8 @@ android_afs_opendir (struct android_vnode *vnode) and as such can be exactly one byte past directory_tree. */ if (dir->asset_limit > directory_tree + directory_tree_size) { - xfree (dir); xfree (dir->asset_file); + xfree (dir); errno = EACCES; return NULL; } @@ -5547,8 +5547,8 @@ android_saf_tree_opendir (struct android_vnode *vnode) if (!cursor) { - xfree (dir); xfree (dir->name); + xfree (dir); return NULL; } -- cgit v1.2.3 From cd0eb055fd4ebc3f7f7f5f5617549f963fe8ecff Mon Sep 17 00:00:00 2001 From: Rudolf Adamkovič Date: Tue, 3 Oct 2023 09:07:40 +0200 Subject: Make Compilation mode recognize Lua errors Emacs comes with built-in support for the Lua programming language in the form of the Lua mode and now also the Lua Tree-sitter mode. This patch further improves Lua support in Emacs by making the Compilation mode recognize Lua errors and stack traces. * lisp/progmodes/compile.el (compilation-error-regexp-alist-alist): Add regexps to aid Lua development, namely the 'lua' regexp that matches Lua errors and the 'lua-stack' regexp that matches Lua stack frames. (Bug#60830) * etc/compilation.txt (Lua): Add an example of a Lua error message with a stack trace. * test/lisp/progmodes/compile-tests.el (compile-tests--test-regexps-data): (compile-test-error-regexps): Test the new 'lua' and 'lua-stack' regexps added to the 'compilation-error-regexp-alist-alist'. --- etc/NEWS | 5 +++++ etc/compilation.txt | 13 +++++++++++++ lisp/progmodes/compile.el | 8 ++++++++ test/lisp/progmodes/compile-tests.el | 31 +++++++++++++++++++++++++++++-- 4 files changed, 55 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 4559c67d4ae..bce33f96aee 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -452,6 +452,11 @@ This is because it partly acts by modifying other rules which may occasionally be surprising. It can be re-enabled by adding 'omake' to 'compilation-error-regexp-alist'. +*** Lua errors and stack traces are now recognized. +Compilation mode now recognizes Lua language errors and stack traces. +Every Lua error is recognized as a compilation error, and every Lua +stack frame is recognized as a compilation info. + ** Project +++ diff --git a/etc/compilation.txt b/etc/compilation.txt index c03d30afa79..05f0829864c 100644 --- a/etc/compilation.txt +++ b/etc/compilation.txt @@ -344,6 +344,19 @@ In /home/janneke/vc/guile/examples/gud-break.scm: 1033: 0 [stderr "~a:hello world\n" (# # #)] +* Lua 5.1, 5.2, 5.3, 5.4, and LuaJIT 2.1 + +/usr/bin/lua: database.lua:31: assertion failed! +stack traceback: + [C]: in function 'assert' + database.lua:31: in field 'statement' + database.lua:42: in field 'table' + database.lua:55: in field 'row' + database.lua:63: in field 'value' + io.lua: in main chunk + [C]: in ? + + * Lucid Compiler, lcc 3.x symbol: lcc diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index e7d4e9966cf..797e594c0c5 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -362,6 +362,14 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) (ruby-Test::Unit "^ [[ ]?\\([^ (].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:in " 1 2) + ;; Tested with Lua 5.1, 5.2, 5.3, 5.4, and LuaJIT 2.1. + (lua + "^[^\n\t]+?: \\([^\n\t]+?\\):\\([0-9]+?\\): .+\nstack traceback:\n\t" + 1 2 nil 2 1) + (lua-stack + "^\t\\(?:\\[C\\]:\\|\\([^\n\t]+?\\):\\(?:\\([0-9]+?\\):\\)?\\) in " + 1 2 nil 0 1) + (gmake ;; Set GNU make error messages as INFO level. ;; It starts with the name of the make program which is variable, diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index f5b5cad9c0b..20beed955d2 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -206,6 +206,33 @@ 1 0 31 "/usr/include/c++/3.3/backward/iostream.h") (gcc-include " from test_clt.cc:1:" 1 nil 1 "test_clt.cc") + ;; Lua + (lua "lua: database.lua:10: assertion failed!\nstack traceback:\n\t" + 6 nil 10 "database.lua") + (lua "lua 5.4: database 2.lua:10: assertion failed!\nstack traceback:\n\t" + 10 nil 10 "database 2.lua") + (lua "/usr/local/bin/lua: core/database.lua:20: assertion failed!\nstack traceback:\n\t" + 21 nil 20 "core/database.lua") + (lua "C:\\Lua\\Lua.exe: Core\\Database.lua:20: assertion failed!\nstack traceback:\n\t" + 17 nil 20 "Core\\Database.lua") + (lua "lua: /tmp/database.lua:20: assertion failed!\nstack traceback:\n\t" + 6 nil 20 "/tmp/database.lua") + (lua "Lua.exe: C:\\Temp\\Database.lua:20: assertion failed!\nstack traceback:\n\t" + 10 nil 20 "C:\\Temp\\Database.lua") + (lua-stack " database.lua: in field 'statement'" + 2 nil nil "database.lua" 0) + (lua-stack " database.lua:10: in field 'statement'" + 2 nil 10 "database.lua" 0) + (lua-stack " core/database.lua:20: in field 'statement'" + 2 nil 20 "core/database.lua" 0) + (lua-stack " database 2.lua: in field 'statement'" + 2 nil nil "database 2.lua" 0) + (lua-stack " Core\\Database.lua:20: in field 'statement'" + 2 nil 20 "Core\\Database.lua" 0) + (lua-stack " /tmp/database.lua: in field 'statement'" + 2 nil nil "/tmp/database.lua" 0) + (lua-stack " C:\\Core\\Database.lua: in field 'statement'" + 2 nil nil "C:\\Core\\Database.lua" 0) ;; gmake (gmake "make: *** [Makefile:20: all] Error 2" 12 nil 20 "Makefile" 0) (gmake "make[4]: *** [sub/make.mk:19: all] Error 127" 15 nil 19 @@ -507,9 +534,9 @@ The test data is in `compile-tests--test-regexps-data'." 1 15 5 "alpha.c"))) (compile--test-error-line test)) - (should (eq compilation-num-errors-found 100)) + (should (eq compilation-num-errors-found 106)) (should (eq compilation-num-warnings-found 35)) - (should (eq compilation-num-infos-found 28))))) + (should (eq compilation-num-infos-found 35))))) (ert-deftest compile-test-grep-regexps () "Test the `grep-regexp-alist' regexps. -- cgit v1.2.3 From 5567ce1a9ff8d893348ac8a3f64953426e2a7c86 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 10 Jan 2024 09:25:41 +0100 Subject: Handle package versions that are not version strings * lisp/emacs-lisp/package.el (package-menu--version-predicate): Ignore any errors raised by 'version-to-list', thus falling back to the default version list. (Bug#68317) (cherry picked from commit eb913c7501489e1eae475cae843fccdf14cc24d8) --- lisp/emacs-lisp/package.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index c7769d5430c..608306c8254 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -4003,8 +4003,8 @@ invocations." (defun package-menu--version-predicate (A B) "Predicate to sort \"*Packages*\" buffer by the version column. This is used for `tabulated-list-format' in `package-menu-mode'." - (let ((vA (or (version-to-list (aref (cadr A) 1)) '(0))) - (vB (or (version-to-list (aref (cadr B) 1)) '(0)))) + (let ((vA (or (ignore-error error (version-to-list (aref (cadr A) 1))) '(0))) + (vB (or (ignore-error error (version-to-list (aref (cadr B) 1))) '(0)))) (if (version-list-= vA vB) (package-menu--name-predicate A B) (version-list-< vA vB)))) -- cgit v1.2.3 From 29af214a75a3d77e603c377e1247a3ca85c130c5 Mon Sep 17 00:00:00 2001 From: Stephen Berman Date: Wed, 10 Jan 2024 16:24:53 +0100 Subject: Fix fontification of cgroup2 in fstab (bug#68367) * lisp/generic-x.el (etc-fstab-generic-mode): Add cgroup2. --- lisp/generic-x.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/generic-x.el b/lisp/generic-x.el index b4ae0225943..373bfad92dd 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -1491,6 +1491,7 @@ like an INI file. You can add this hook to `find-file-hook'." "cd9660" "cfs" "cgroup" + "cgroup2" "cifs" "coda" "coherent" -- cgit v1.2.3 From 492ba5721cbac0a374d785297401a1ac4b9eef37 Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Tue, 26 Dec 2023 17:49:34 +0100 Subject: Fix window setting in register preview (bug#67882) and allow configuring it if needed. * lisp/register.el (register-preview-display-buffer-alist): New user var. (register-preview,register-preview-1): Use it. --- lisp/register.el | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/lisp/register.el b/lisp/register.el index baad2c2a05d..f5b0365dec2 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -386,18 +386,21 @@ Format of each entry is controlled by the variable `register-preview-function'." (setq register-preview-function (register--preview-function register--read-with-preview-function))) (when (or show-empty (consp register-alist)) - (with-current-buffer-window - buffer - (cons 'display-buffer-below-selected - '((window-height . fit-window-to-buffer) - (preserve-size . (nil . t)))) - nil - (with-current-buffer standard-output - (setq cursor-in-non-selected-windows nil) - (mapc (lambda (elem) - (when (get-register (car elem)) - (insert (funcall register-preview-function elem)))) - register-alist))))) + (with-current-buffer-window buffer + register-preview-display-buffer-alist + nil + (with-current-buffer standard-output + (setq cursor-in-non-selected-windows nil) + (mapc (lambda (elem) + (when (get-register (car elem)) + (insert (funcall register-preview-function elem)))) + register-alist))))) + +(defcustom register-preview-display-buffer-alist '(display-buffer-at-bottom + (window-height . fit-window-to-buffer) + (preserve-size . (nil . t))) + "Window configuration for the register preview buffer." + :type display-buffer--action-custom-type) (defun register-preview-1 (buffer &optional show-empty types) "Pop up a window showing the preview of registers in BUFFER. @@ -415,9 +418,7 @@ Format of each entry is controlled by the variable `register-preview-function'." (when (or show-empty (consp registers)) (with-current-buffer-window buffer - (cons 'display-buffer-below-selected - '((window-height . fit-window-to-buffer) - (preserve-size . (nil . t)))) + register-preview-display-buffer-alist nil (with-current-buffer standard-output (setq cursor-in-non-selected-windows nil) -- cgit v1.2.3 From d7d9bf1fe35e81e4bd37c326ebe569ab38043640 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Wed, 10 Jan 2024 16:55:14 +0100 Subject: Lua compilation-mode rules adjustments (bug#60830) * lisp/progmodes/compile.el (compilation-error-regexp-alist-alist): Translate `lua' and `lua-stack' to rx, and change two unnecessary non-greedy operators to greedy. --- lisp/progmodes/compile.el | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 797e594c0c5..51c81b9d2f6 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -364,10 +364,24 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) ;; Tested with Lua 5.1, 5.2, 5.3, 5.4, and LuaJIT 2.1. (lua - "^[^\n\t]+?: \\([^\n\t]+?\\):\\([0-9]+?\\): .+\nstack traceback:\n\t" + ,(rx bol + (+? (not (in "\t\n"))) + ": " + (group (+? (not (in "\t\n")))) + ":" + (group (+ (in "0-9"))) + ": " + (+ nonl) + "\nstack traceback:\n\t") 1 2 nil 2 1) (lua-stack - "^\t\\(?:\\[C\\]:\\|\\([^\n\t]+?\\):\\(?:\\([0-9]+?\\):\\)?\\) in " + ,(rx bol "\t" + (| "[C]:" + (: (group (+? (not (in "\t\n")))) + ":" + (? (group (+ (in "0-9"))) + ":"))) + " in ") 1 2 nil 0 1) (gmake -- cgit v1.2.3 From c78e2f341299fd089bd265b9ac26767361f33820 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Wed, 10 Jan 2024 12:15:36 -0500 Subject: Esplain how to turn off GDB display of inferior-events --- src/.gdbinit | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/.gdbinit b/src/.gdbinit index bc6cad0560e..6c4dda67f06 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -15,6 +15,10 @@ # You should have received a copy of the GNU General Public License # along with GNU Emacs. If not, see . +# If you don't want messages from GDB to interfere with ordinary editing +# whenever it creates a subprocess, uncomment the following line. +### set print inferior-events off + # Force loading of symbols, enough to give us VALBITS etc. set $dummy = main + 8 # With some compilers, we need this to give us struct Lisp_Symbol etc.: -- cgit v1.2.3 From 093ecb2aca1fa6d00f212b2426ddb7601fdbcfd2 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Jan 2024 18:19:03 +0100 Subject: ; Clarify detail in Start Emacs maximized FAQ * doc/misc/efaq.texi (Start Emacs maximized): Explain that the sexp should be put at the top of the file. --- doc/misc/efaq.texi | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 25e6551f34b..5b722f9fd77 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -3119,8 +3119,8 @@ escape sequences. It is enabled by default. @cindex Fullscreen mode Run Emacs with the @samp{--maximized} command-line option or put the -following form in your early init file (@pxref{Early Init File,,, -emacs, The GNU Emacs Manual}). +following form at the top of your early init file (@pxref{Early Init +File,,, emacs, The GNU Emacs Manual}). @lisp (push '(fullscreen . maximized) default-frame-alist) @@ -3128,9 +3128,9 @@ emacs, The GNU Emacs Manual}). Note that while some customizations of @code{default-frame-alist} could have undesirable effects when modified in the early init file, -it is okay to do it in this particular case. Adding it to the normal -init file will also work, but leads to a visible resizing of the -window that some find distracting. +it is okay to do it in this particular case. Adding it to the top of +your normal init file will also work, but leads to a visible resizing +of the window that some find distracting. @node Emacs in a Linux console @section How can I alleviate the limitations of the Linux console? -- cgit v1.2.3 From 1bbb610821eb143e0828d2541a3f856d29d67b6f Mon Sep 17 00:00:00 2001 From: Mauro Aranda Date: Sun, 5 Nov 2023 07:23:55 -0300 Subject: Implement missing functions for custom-icon widget * lisp/cus-edit.el (custom-icon-reset-saved, custom-icon-mark-to-save) (custom-icon-state-set-and-redraw, custom-icon-reset-standard) (custom-icon-mark-to-reset-standard): New functions. (custom-icon, custom-icon-extended-menu): Register and add them to the menu. (Bug#66947) --- lisp/cus-edit.el | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 55 insertions(+), 3 deletions(-) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 62564f6dfcb..12eea0fa0e5 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -5348,9 +5348,49 @@ The following properties have special meanings for this widget: :hidden-states '(standard) :action #'custom-icon-action :custom-set #'custom-icon-set - :custom-reset-current #'custom-redraw) - ;; Not implemented yet. - ;; :custom-reset-saved 'custom-icon-reset-saved) + :custom-mark-to-save #'custom-icon-mark-to-save + :custom-reset-current #'custom-redraw + :custom-reset-saved #'custom-icon-reset-saved + :custom-state-set-and-redraw #'custom-icon-state-set-and-redraw + :custom-reset-standard #'custom-icon-reset-standard + :custom-mark-to-reset-standard #'custom-icon-mark-to-reset-standard) + +(defun custom-icon-mark-to-save (widget) + "Mark user customization for icon edited by WIDGET to be saved later." + (let* ((icon (widget-value widget)) + (value (custom--icons-widget-value + (car (widget-get widget :children))))) + (custom-push-theme 'theme-icon icon 'user 'set value))) + +(defun custom-icon-reset-saved (widget) + "Restore icon customized by WIDGET to the icon's default attributes. + +If there's a theme value for the icon, resets to that. Otherwise, resets to +its standard value." + (let* ((icon (widget-value widget))) + (custom-push-theme 'theme-icon icon 'user 'reset) + (custom-icon-state-set widget) + (custom-redraw widget))) + +(defun custom-icon-state-set-and-redraw (widget) + "Set state of icon widget WIDGET and redraw it with up-to-date settings." + (custom-icon-state-set widget) + (custom-redraw-magic widget)) + +(defun custom-icon-reset-standard (widget) + "Reset icon edited by WIDGET to its standard value." + (let* ((icon (widget-value widget)) + (themes (get icon 'theme-icon))) + (dolist (theme themes) + (custom-push-theme 'theme-icon icon (car theme) 'reset)) + (custom-save-all)) + (widget-put widget :custom-state 'unknown) + (custom-redraw widget)) + +(defun custom-icon-mark-to-reset-standard (widget) + "Reset icon edited by WIDGET to its standard value." + ;; Don't mark for now, there aren't that many icons. + (custom-icon-reset-standard widget)) (defvar custom-icon-extended-menu (let ((map (make-sparse-keymap))) @@ -5369,6 +5409,18 @@ The following properties have special meanings for this widget: :enable (memq (widget-get custom-actioned-widget :custom-state) '(modified changed)))) + (define-key-after map [custom-icon-reset-saved] + '(menu-item "Revert This Session's Customization" + custom-icon-reset-saved + :enable (memq + (widget-get custom-actioned-widget :custom-state) + '(modified set changed rogue)))) + (when (or custom-file init-file-user) + (define-key-after map [custom-icon-reset-standard] + '(menu-item "Erase Customization" custom-icon-reset-standard + :enable (memq + (widget-get custom-actioned-widget :custom-state) + '(modified set changed saved rogue))))) map) "A menu for `custom-icon' widgets. Used in `custom-icon-action' to show a menu to the user.") -- cgit v1.2.3 From 820f0793f0b46448928905552726c1f1b999062f Mon Sep 17 00:00:00 2001 From: Xi Lu Date: Tue, 10 Oct 2023 22:20:05 +0800 Subject: Fix man.el shell injection vulnerability * lisp/man.el (Man-translate-references): Fix shell injection vulnerability. (Bug#66390) * test/lisp/man-tests.el (man-tests-Man-translate-references): New test. --- lisp/man.el | 6 +++++- test/lisp/man-tests.el | 12 ++++++++++++ 2 files changed, 17 insertions(+), 1 deletion(-) diff --git a/lisp/man.el b/lisp/man.el index 55cb9383bec..d96396483d3 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -761,7 +761,11 @@ and the `Man-section-translations-alist' variables)." (setq name (match-string 2 ref) section (match-string 1 ref)))) (if (string= name "") - ref ; Return the reference as is + ;; see Bug#66390 + (mapconcat 'identity + (mapcar #'shell-quote-argument + (split-string ref "\\s-+")) + " ") ; Return the reference as is (if Man-downcase-section-letters-flag (setq section (downcase section))) (while slist diff --git a/test/lisp/man-tests.el b/test/lisp/man-tests.el index 140482ee622..11f5f805e43 100644 --- a/test/lisp/man-tests.el +++ b/test/lisp/man-tests.el @@ -161,6 +161,18 @@ DESCRIPTION (let ((button (button-at (match-beginning 0)))) (should (and button (eq 'Man-xref-header-file (button-type button)))))))))) +(ert-deftest man-tests-Man-translate-references () + (should (equal (Man-translate-references "basename") + "basename")) + (should (equal (Man-translate-references "basename(3)") + "3 basename")) + (should (equal (Man-translate-references "basename(3v)") + "3v basename")) + (should (equal (Man-translate-references ";id") + "\\;id")) + (should (equal (Man-translate-references "-k basename") + "-k basename"))) + (provide 'man-tests) ;;; man-tests.el ends here -- cgit v1.2.3 From 4fadbfe300a338f8e6e167331bc7ca0bbca26dbc Mon Sep 17 00:00:00 2001 From: Mauro Aranda Date: Fri, 22 Sep 2023 20:45:00 -0300 Subject: Add examples to the Widget manual * doc/misc/widget.texi (Widget Gallery, Defining New Widgets): Add examples. (Bug#66229) --- doc/misc/widget.texi | 206 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 206 insertions(+) diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi index 93b7606b01e..82d89449dd2 100644 --- a/doc/misc/widget.texi +++ b/doc/misc/widget.texi @@ -1384,6 +1384,15 @@ a specific way. If present, @var{value} is used to initialize the @code{:value} property. When created, it inserts the value as a string in the buffer. +@noindent +Example: + +@lisp +(widget-create 'item :tag "Today is" :format "%t: %v\n" + (format-time-string "%d-%m-%Y")) +@end lisp + + By default, it has the following properties: @table @code @@ -1428,6 +1437,20 @@ The @var{value}, if present, is used to initialize the @code{:value} property. The value should be a string, which will be inserted in the buffer. +@noindent +Example: + +@lisp +(widget-create 'link + :button-prefix "" + :button-suffix "" + :tag "Mail yourself" + :action #'(lambda (widget &optional _event) + (compose-mail-other-window (widget-value widget))) + user-mail-address) +@end lisp + + By default, it has the following properties: @table @code @@ -1471,6 +1494,29 @@ A widget to represent a link to a web page. Its super is the It overrides the @code{:action} property to open up the @var{url} specified. +@noindent +Example: + +@lisp +(widget-create 'url-link + :button-prefix "" + :button-suffix "" + ;; Return appropriate face. + :button-face-get (lambda (widget) + (if (widget-get widget :visited) + 'link-visited + 'link)) + :format "%[%t%]" + :tag "Browse this manual" + :action (lambda (widget &optional _event) + (widget-put widget :visited t) + ;; Takes care of redrawing the widget. + (widget-value-set widget (widget-value widget)) + ;; And then call the original function. + (widget-url-link-action widget)) + "https://www.gnu.org/software/emacs/manual/html_mono/widget.html") +@end lisp + @node info-link @subsection The @code{info-link} Widget @findex info-link@r{ widget} @@ -1487,6 +1533,17 @@ A widget to represent a link to an info file. Its super is the It overrides the @code{:action} property, to a function to start the built-in Info reader on @var{address}, when invoked. +@noindent +Example: + +@lisp +(widget-create 'info-link + :button-prefix "" + :button-suffix "" + :tag "Browse this manual" + "(widget) info-link"))) +@end lisp + @node function-link @subsection The @code{function-link} Widget @findex function-link@r{ widget} @@ -1502,6 +1559,17 @@ A widget to represent a link to an Emacs function. Its super is the It overrides the @code{:action} property, to a function to describe @var{function}. +@noindent +Example: + +@lisp +(widget-create 'function-link + :button-prefix "" + :button-suffix "" + :tag "Describe the function that gets called" + #'widget-function-link-action) +@end lisp + @node variable-link @subsection The @code{variable-link} Widget @findex variable-link@r{ widget} @@ -1517,6 +1585,17 @@ A widget to represent a link to an Emacs variable. Its super is the It overrides the @code{:action} property, to a function to describe @var{var}. +@noindent +Example: + +@lisp +(widget-create 'variable-link + :button-prefix "" + :button-suffix "" + :tag "What setting controlls button-prefix?" + 'widget-button-prefix) +@end lisp + @node face-link @subsection The @code{face-link} Widget @findex face-link@r{ widget} @@ -1532,6 +1611,17 @@ A widget to represent a link to an Emacs face. Its super is the It overrides the @code{:action} property, to a function to describe @var{face}. +@noindent +Example: + +@lisp +(widget-create 'face-link + :button-prefix "" + :button-suffix "" + :tag "Which face is this one?" + 'widget-button) +@end lisp + @node file-link @subsection The @code{file-link} Widget @findex file-link@r{ widget} @@ -1547,6 +1637,19 @@ A widget to represent a link to a file. Its super is the It overrides the @code{:action} property, to a function to find the file @var{file}. +@noindent +Example: + +@lisp +(let ((elisp-files (directory-files user-emacs-directory t ".el$"))) + (dolist (file elisp-files) + (widget-create 'file-link + :button-prefix "" + :button-suffix "" + file) + (widget-insert "\n"))) +@end lisp + @node emacs-library-link @subsection The @code{emacs-library-link} Widget @findex emacs-library-link@r{ widget} @@ -1562,6 +1665,17 @@ A widget to represent a link to an Emacs Lisp file. Its super is the It overrides the @code{:action} property, to a function to find the file @var{file}. +@noindent +Example: + +@lisp +(widget-create 'emacs-library-link + :button-prefix "" + :button-suffix "" + :tag "Show yourself, Widget Library!" + "wid-edit.el") +@end lisp + @node emacs-commentary-link @subsection The @code{emacs-commentary-link} Widget @findex emacs-commentary-link@r{ widget} @@ -1577,6 +1691,17 @@ file. Its super is the @code{link} widget. It overrides the @code{:action} property, to a function to find the file @var{file} and put point in the Comment section. +@noindent +Example: + +@lisp +(widget-create 'emacs-commentary-link + :button-prefix "" + :button-suffix "" + :tag "Check our good friend Customize" + "cus-edit.el") +@end lisp + @node push-button @subsection The @code{push-button} Widget @findex push-button@r{ widget} @@ -2009,6 +2134,29 @@ A widget that can toggle between two states. Its super is the The widget has two possible states, @samp{on} and @samp{off}, which correspond to a @code{t} or @code{nil} value, respectively. +@noindent +Example: + +@lisp +(widget-insert "Press the button to activate/deactivate the field: ") +(widget-create 'toggle + :notify (lambda (widget &rest _ignored) + (widget-apply widget-example-field + (if (widget-value widget) + :activate + :deactivate)))) +(widget-insert "\n") +(setq widget-example-field + (widget-create 'editable-field + :deactivate (lambda (widget) + (widget-specify-inactive + widget + (widget-field-start widget) + (widget-get widget :to))))) +(widget-apply widget-example-field :deactivate))) +@end lisp + + It either overrides or adds the following properties: @table @code @@ -2148,6 +2296,21 @@ The @var{type} arguments represent each checklist item. The widget's value will be a list containing the values of all checked @var{type} arguments. +@noindent +Example: + +@lisp +(widget-create 'checklist + :notify (lambda (widget child &optional _event) + (funcall + (widget-value (widget-get-sibling child)) + 'toggle)) + :value (list 'tool-bar-mode 'menu-bar-mode) + '(item :tag "Tool-bar" tool-bar-mode) + '(item :tag "Menu-bar" menu-bar-mode)))) +@end lisp + + It either overrides or adds the following properties: @table @code @@ -2899,6 +3062,49 @@ The predefined functions @code{widget-types-convert-widget} and @code{widget-value-convert-widget} can be used here. @end table +@noindent +Example: + +@lisp +(defvar widget-ranged-integer-map + (let ((map (copy-keymap widget-keymap))) + (define-key map [up] #'widget-ranged-integer-increase) + (define-key map [down] #'widget-ranged-integer-decrease) + map)) + +(define-widget 'ranged-integer 'integer + "A ranged integer widget." + :min-value most-negative-fixnum + :max-value most-positive-fixnum + :keymap widget-ranged-integer-map) + +(defun widget-ranged-integer-change (widget how) + "Change the value of the ranged-integer WIDGET, according to HOW." + (let* ((value (widget-value widget)) + (newval (cond + ((eq how 'up) + (if (< (1+ value) (widget-get widget :max-value)) + (1+ value) + (widget-get widget :max-value))) + ((eq how 'down) + (if (> (1- value) (widget-get widget :min-value)) + (1- value) + (widget-get widget :min-value))) + (t (error "HOW has a bad value")))) + (inhibit-read-only t)) + (widget-value-set widget newval))) + +(defun widget-ranged-integer-increase (widget) + "Increase the value of the ranged-integer WIDGET." + (interactive (list (widget-at))) + (widget-ranged-integer-change widget 'up)) + +(defun widget-ranged-integer-decrease (widget) + "Decrease the value of the ranged-integer WIDGET." + (interactive (list (widget-at))) + (widget-ranged-integer-change widget 'down)) +@end lisp + @node Inspecting Widgets @chapter Inspecting Widgets @cindex widget browser -- cgit v1.2.3 From a0133f63450e5458dc5b6d0bb7c91a00ef7e3aa3 Mon Sep 17 00:00:00 2001 From: john muhl Date: Mon, 4 Sep 2023 12:08:34 -0500 Subject: Add Ruby to the tree-sitter build-module script * admin/notes/tree-sitter/build-module/batch.sh (languages): Add Ruby. (Bug#65739) --- admin/notes/tree-sitter/build-module/batch.sh | 1 + 1 file changed, 1 insertion(+) diff --git a/admin/notes/tree-sitter/build-module/batch.sh b/admin/notes/tree-sitter/build-module/batch.sh index 9988d1eae4e..012b5882e83 100755 --- a/admin/notes/tree-sitter/build-module/batch.sh +++ b/admin/notes/tree-sitter/build-module/batch.sh @@ -18,6 +18,7 @@ languages=( 'json' 'lua' 'python' + 'ruby' 'rust' 'toml' 'tsx' -- cgit v1.2.3 From c12166de380397168e374931c4e59bbb3a09bf21 Mon Sep 17 00:00:00 2001 From: Augusto Stoffel Date: Wed, 27 Sep 2023 18:35:32 +0200 Subject: Use auth-info-mode for non-hidden authinfo and netrc files * files.el (auto-mode-alist): Match non-hidden authinfo and netrc files, since it is reasonable to store passwords in ~/.emacs.d/authinfo.gpg or a similarly named file. (Bug#66241) --- lisp/files.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/files.el b/lisp/files.el index 8b4e4394e5a..9c8914bfc50 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3059,7 +3059,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" . ("\\.docbook\\'" . sgml-mode) ("\\.com\\'" . dcl-mode) ("/config\\.\\(?:bat\\|log\\)\\'" . fundamental-mode) - ("/\\.\\(authinfo\\|netrc\\)\\'" . authinfo-mode) + ("/\\.?\\(authinfo\\|netrc\\)\\'" . authinfo-mode) ;; Windows candidates may be opened case sensitively on Unix ("\\.\\(?:[iI][nN][iI]\\|[lL][sS][tT]\\|[rR][eE][gG]\\|[sS][yY][sS]\\)\\'" . conf-mode) ("\\.la\\'" . conf-unix-mode) -- cgit v1.2.3 From 9eed00c8e5ac697203dc24331c60bd2bb0b90b5d Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Tue, 14 Feb 2023 09:18:37 +0200 Subject: Handle anonymous commands in C-h K * lisp/info.el (Info-goto-emacs-key-command-node): Don't call Info-goto-emacs-command-node for anonymous commands. (Bug#61505) --- lisp/info.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/info.el b/lisp/info.el index f4384934155..02ba8b0eff9 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -4733,8 +4733,11 @@ the variable `Info-file-list-for-emacs'." (eq command 'execute-extended-command)) (Info-goto-emacs-command-node (read-command "Find documentation for command: "))) + ((symbolp command) + (Info-goto-emacs-command-node command)) (t - (Info-goto-emacs-command-node command))))) + (message "%s invokes an anonymous command" + (key-description key)))))) (defvar Info-link-keymap (let ((keymap (make-sparse-keymap))) -- cgit v1.2.3 From 6a645cd53289853bc2239657d2b0bb6384875903 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Jan 2024 23:50:16 +0100 Subject: ; Clarify message in last change * lisp/info.el (Info-goto-emacs-key-command-node): Clarify message in last change. --- lisp/info.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lisp/info.el b/lisp/info.el index 02ba8b0eff9..e56344825b9 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -4736,8 +4736,11 @@ the variable `Info-file-list-for-emacs'." ((symbolp command) (Info-goto-emacs-command-node command)) (t - (message "%s invokes an anonymous command" - (key-description key)))))) + (message + (substitute-command-keys + (format + "\\`%s' invokes an anonymous command defined with `lambda'" + (key-description key)))))))) (defvar Info-link-keymap (let ((keymap (make-sparse-keymap))) -- cgit v1.2.3 From 1ecb53ad2fc9888ce0d0073c8fc3f36d63394dcd Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 11 Jan 2024 01:21:14 +0200 Subject: vc-log-mergebase: Fix the printing of buttons at the bottom * lisp/vc/vc.el (vc-print-log-setup-buttons): Fix when LIMIT is a string (bug#68364). (vc-print-log-internal): Update docstring. --- lisp/vc/vc.el | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index b8cc44fc3dc..94bc3f0911a 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2703,20 +2703,22 @@ Not all VC backends support short logs!") (defun vc-print-log-setup-buttons (working-revision is-start-revision limit pl-return) "Insert at the end of the current buffer buttons to show more log entries. In the new log, leave point at WORKING-REVISION (if non-nil). -LIMIT is the current maximum number of entries shown. Does -nothing if IS-START-REVISION is non-nil and LIMIT is 1, or if -LIMIT is nil, or if PL-RETURN is `limit-unsupported'." +LIMIT is the current maximum number of entries shown, or the +revision (string) before which to stop. Does nothing if +IS-START-REVISION is non-nil and LIMIT is 1, or if LIMIT is nil, +or if PL-RETURN is `limit-unsupported'." ;; LIMIT=1 is set by vc-annotate-show-log-revision-at-line ;; or by vc-print-root-log with current-prefix-arg=1. ;; In either case only one revision is wanted, no buttons. (when (and limit (not (eq 'limit-unsupported pl-return)) (not (and is-start-revision - (= limit 1)))) + (eql limit 1)))) (let ((entries 0)) (goto-char (point-min)) (while (re-search-forward log-view-message-re nil t) (cl-incf entries)) - (if (< entries limit) + (if (or (stringp limit) + (< entries limit)) ;; The log has been printed in full. Perhaps it started ;; with a copy or rename? ;; FIXME: We'd probably still want this button even when @@ -2811,7 +2813,8 @@ button for. Same for CURRENT-REVISION. LIMIT means the usual." Leave point at WORKING-REVISION, if it is non-nil. If IS-START-REVISION is non-nil, start the log from WORKING-REVISION \(not all backends support this); i.e., show only WORKING-REVISION and -earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." +earlier revisions. Show up to LIMIT entries (non-nil means unlimited). +LIMIT can also be a string, which means the revision before which to stop." ;; Don't switch to the output buffer before running the command, ;; so that any buffer-local settings in the vc-controlled ;; buffer can be accessed by the command. -- cgit v1.2.3 From c7c143b019d5cad8d44a2511953ac76bc4278aa1 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 11 Jan 2024 01:24:17 +0200 Subject: ; (vc-print-log-internal): Update docstring further --- lisp/vc/vc.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 94bc3f0911a..f612daaa569 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2813,7 +2813,7 @@ button for. Same for CURRENT-REVISION. LIMIT means the usual." Leave point at WORKING-REVISION, if it is non-nil. If IS-START-REVISION is non-nil, start the log from WORKING-REVISION \(not all backends support this); i.e., show only WORKING-REVISION and -earlier revisions. Show up to LIMIT entries (non-nil means unlimited). +earlier revisions. Show up to LIMIT entries (nil means unlimited). LIMIT can also be a string, which means the revision before which to stop." ;; Don't switch to the output buffer before running the command, ;; so that any buffer-local settings in the vc-controlled -- cgit v1.2.3 From 824cf54951c076e2b6a0e3a8e6fb1342cf58b8b6 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 11 Jan 2024 00:25:38 +0100 Subject: ; * etc/TODO: Add item to make play-sound non-blocking. --- etc/TODO | 2 ++ 1 file changed, 2 insertions(+) diff --git a/etc/TODO b/etc/TODO index ee069e3930b..a672b6b5b72 100644 --- a/etc/TODO +++ b/etc/TODO @@ -156,6 +156,8 @@ from. ** Make back_comment use syntax-ppss or equivalent +* Make play-sound asynchronous and non-blocking + ** Consider improving src/sysdep.c's search for a fqdn https://lists.gnu.org/r/emacs-devel/2007-04/msg00782.html -- cgit v1.2.3 From 63411709a8dbad8b17c7f1e0cfed99f4aeb174a1 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 11 Jan 2024 00:32:15 +0100 Subject: ; Fix typos --- doc/misc/widget.texi | 2 +- etc/TODO | 2 +- lisp/progmodes/python.el | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi index 82d89449dd2..d4f2ba1e76c 100644 --- a/doc/misc/widget.texi +++ b/doc/misc/widget.texi @@ -1592,7 +1592,7 @@ Example: (widget-create 'variable-link :button-prefix "" :button-suffix "" - :tag "What setting controlls button-prefix?" + :tag "What setting controls button-prefix?" 'widget-button-prefix) @end lisp diff --git a/etc/TODO b/etc/TODO index a672b6b5b72..9b3796515d2 100644 --- a/etc/TODO +++ b/etc/TODO @@ -156,7 +156,7 @@ from. ** Make back_comment use syntax-ppss or equivalent -* Make play-sound asynchronous and non-blocking +** Make play-sound asynchronous and non-blocking ** Consider improving src/sysdep.c's search for a fqdn https://lists.gnu.org/r/emacs-devel/2007-04/msg00782.html diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 3247291b6ee..9849fde8588 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1107,7 +1107,7 @@ fontified." (defun python--treesit-fontify-union-types (node override start end &optional type-regex &rest _) "Fontify nested union types in the type hints. -For examlpe, Lvl1 | Lvl2[Lvl3[Lvl4[Lvl5 | None]], Lvl2]. This +For example, Lvl1 | Lvl2[Lvl3[Lvl4[Lvl5 | None]], Lvl2]. This structure is represented via nesting binary_operator and subscript nodes. This function iterates over all levels and highlight identifier nodes. If TYPE-REGEX is not nil fontify type @@ -1265,7 +1265,7 @@ fontified." (subscript (identifier) @font-lock-type-face) (subscript (attribute attribute: (identifier) @font-lock-type-face))])) - ;; Patern matching: case [str(), pack0.Type0()]. Take only the + ;; Pattern matching: case [str(), pack0.Type0()]. Take only the ;; last identifier. (class_pattern (dotted_name (identifier) @font-lock-type-face :anchor)) -- cgit v1.2.3 From cfa64bdc84d18dba55443939b37107e0b3524f08 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 9 Jan 2024 14:50:43 -0800 Subject: ; Fix overridden erc--input-split slot definition * lisp/erc/erc-common.el (erc--input-split): Don't set the default value to `:read-only'. * test/lisp/erc/erc-tests.el (erc--channel-modes, erc--channel-modes/graphic-p): Use `char-displayable-p' instead of `display-graphic-p' to prevent the first test from failing on Unicode terminal emulators. --- lisp/erc/erc-common.el | 2 +- test/lisp/erc/erc-tests.el | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 28ab6aad466..e7e70fffd3a 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -52,7 +52,7 @@ string insertp sendp) (cl-defstruct (erc--input-split (:include erc-input - (string :read-only) + (string "" :read-only t) (insertp erc-insert-this) (sendp (with-suppressed-warnings ((obsolete erc-send-this)) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 2318fed28f2..b3912cab33d 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -849,7 +849,7 @@ ;; truncation ellipsis when run interactively. Rather than have ;; hard-to-read "nondeterministic" comparisons against sets of ;; acceptable values, we use separate tests. - (when (display-graphic-p) (ert-pass)) + (when (char-displayable-p ?…) (ert-pass)) ;; Truncation cache populated and used. (let ((cache (erc--channel-mode-types-shortargs erc--channel-mode-types)) @@ -877,7 +877,7 @@ (ert-deftest erc--channel-modes/graphic-p () :tags `(:unstable ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) - (unless (display-graphic-p) (ert-skip "See non-/graphic-p variant")) + (unless (char-displayable-p ?…) (ert-skip "See non-/graphic-p variant")) (erc-tests-common-init-server-proc "sleep" "1") (setq erc--isupport-params (make-hash-table) -- cgit v1.2.3 From 70a09325d658b4618856adac82abc5f66a11a22f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 11 Jan 2024 08:22:14 +0200 Subject: ; Fix last change in widget.texi * doc/misc/widget.texi (url-link, toggle, Defining New Widgets): Divide @example's into @group's. (Bug#66229) --- doc/misc/widget.texi | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi index d4f2ba1e76c..cfb9d2211cf 100644 --- a/doc/misc/widget.texi +++ b/doc/misc/widget.texi @@ -1498,6 +1498,7 @@ specified. Example: @lisp +@group (widget-create 'url-link :button-prefix "" :button-suffix "" @@ -1515,6 +1516,7 @@ Example: ;; And then call the original function. (widget-url-link-action widget)) "https://www.gnu.org/software/emacs/manual/html_mono/widget.html") +@end group @end lisp @node info-link @@ -2138,6 +2140,7 @@ correspond to a @code{t} or @code{nil} value, respectively. Example: @lisp +@group (widget-insert "Press the button to activate/deactivate the field: ") (widget-create 'toggle :notify (lambda (widget &rest _ignored) @@ -2146,6 +2149,8 @@ Example: :activate :deactivate)))) (widget-insert "\n") +@end group +@group (setq widget-example-field (widget-create 'editable-field :deactivate (lambda (widget) @@ -2154,6 +2159,7 @@ Example: (widget-field-start widget) (widget-get widget :to))))) (widget-apply widget-example-field :deactivate))) +@end group @end lisp @@ -3066,18 +3072,23 @@ The predefined functions @code{widget-types-convert-widget} and Example: @lisp +@group (defvar widget-ranged-integer-map (let ((map (copy-keymap widget-keymap))) (define-key map [up] #'widget-ranged-integer-increase) (define-key map [down] #'widget-ranged-integer-decrease) map)) +@end group +@group (define-widget 'ranged-integer 'integer "A ranged integer widget." :min-value most-negative-fixnum :max-value most-positive-fixnum :keymap widget-ranged-integer-map) +@end group +@group (defun widget-ranged-integer-change (widget how) "Change the value of the ranged-integer WIDGET, according to HOW." (let* ((value (widget-value widget)) @@ -3093,16 +3104,21 @@ Example: (t (error "HOW has a bad value")))) (inhibit-read-only t)) (widget-value-set widget newval))) +@end group +@group (defun widget-ranged-integer-increase (widget) "Increase the value of the ranged-integer WIDGET." (interactive (list (widget-at))) (widget-ranged-integer-change widget 'up)) +@end group +@group (defun widget-ranged-integer-decrease (widget) "Decrease the value of the ranged-integer WIDGET." (interactive (list (widget-at))) (widget-ranged-integer-change widget 'down)) +@end group @end lisp @node Inspecting Widgets -- cgit v1.2.3 From dc1f18e9d0863a03e00134b36279101f0747fcfb Mon Sep 17 00:00:00 2001 From: Gabriel do Nascimento Ribeiro Date: Sat, 23 Sep 2023 04:32:02 -0300 Subject: Consider outline-heading-end-regexp in outline-font-lock-keywords * lisp/outline.el (outline-font-lock-keywords): Add outline-heading-end-regexp to regexp (bug#66166). --- lisp/outline.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/outline.el b/lisp/outline.el index 96e0d0df205..b50708c1a7b 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -260,7 +260,7 @@ non-nil and point is located on the heading line.") '( ;; Highlight headings according to the level. (eval . (list (or outline-search-function - (concat "^\\(?:" outline-regexp "\\).*")) + (concat "^\\(?:" outline-regexp "\\).*" outline-heading-end-regexp)) 0 '(if outline-minor-mode (if outline-minor-mode-highlight (list 'face (outline-font-lock-face))) -- cgit v1.2.3 From 0c01f97b73cffc373944fd2720e42520e86bc2e4 Mon Sep 17 00:00:00 2001 From: Xiyue Deng Date: Wed, 27 Dec 2023 12:35:39 -0800 Subject: Wrap @pxref of Abbrevs in parentheses (bug#68375) * doc/lispref/symbols.texi (Shorthands): Wrap `@pxref{Abbrevs}' in parentheses. Copyright-paperwork-exempt: yes --- doc/lispref/symbols.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index dccd9694b2e..dfbcf903e7d 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -669,7 +669,7 @@ name} (@pxref{Symbol Components}). It is useful to think of shorthands as @emph{abbreviating} the full names of intended symbols. Despite this, do not confuse shorthands with the -Abbrev system @pxref{Abbrevs}. +Abbrev system (@pxref{Abbrevs}). @cindex namespace etiquette Shorthands make Emacs Lisp's @dfn{namespacing etiquette} easier to work -- cgit v1.2.3 From 99efe5c80f9d90de6540ef6f78504c0413947a25 Mon Sep 17 00:00:00 2001 From: Xiyue Deng Date: Tue, 2 Jan 2024 16:31:30 -0800 Subject: Fix count of no-op functions (bug#68375) It looks like there are actually three kinds of no-op functions. * doc/lispref/functions.texi (Calling Functions): Fix count and plural of no-op functions. Copyright-paperwork-exempt: yes --- doc/lispref/functions.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index a32b92955c5..eac5b91e76a 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -980,8 +980,8 @@ lists) and call them using @code{funcall} or @code{apply}. Functions that accept function arguments are often called @dfn{functionals}. Sometimes, when you call a functional, it is useful to supply a no-op -function as the argument. Here are two different kinds of no-op -function: +function as the argument. Here are three different kinds of no-op +functions: @defun identity argument This function returns @var{argument} and has no side effects. -- cgit v1.2.3 From c7aa5c6d2b838e2fd84db4cbdafdbd546dd87832 Mon Sep 17 00:00:00 2001 From: Jared Finder Date: Mon, 8 Jan 2024 13:20:25 -0800 Subject: Populate tool-bar bindings on text terminals * lisp/tool-bar.el (tool-bar-make-keymap-1): Populate on text terminals. (Bug#68334) --- lisp/tool-bar.el | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index 4ca81fb01e0..96b61c7b229 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -165,6 +165,8 @@ color capability and based on the available image libraries." base-keymap) base-keymap))) +;; This function should return binds even if images can not be +;; displayed so the tool bar can still be displayed on terminals. (defun tool-bar-make-keymap-1 (&optional map) "Generate an actual keymap from `tool-bar-map', without caching. MAP is either a keymap to use as a source for menu items, or nil, @@ -180,15 +182,14 @@ in which case the value of `tool-bar-map' is used instead." (consp image-exp) (not (eq (car image-exp) 'image)) (fboundp (car image-exp))) - (if (not (display-images-p)) - (setq bind nil) - (let ((image (eval image-exp))) - (unless (and image (image-mask-p image)) - (setq image (append image '(:mask heuristic)))) - (setq bind (copy-sequence bind) - plist (nthcdr (if (consp (nth 4 bind)) 5 4) - bind)) - (plist-put plist :image image)))) + (let ((image (and (display-images-p) + (eval image-exp)))) + (unless (and image (image-mask-p image)) + (setq image (append image '(:mask heuristic)))) + (setq bind (copy-sequence bind) + plist (nthcdr (if (consp (nth 4 bind)) 5 4) + bind)) + (plist-put plist :image image))) bind)) (or map tool-bar-map))) -- cgit v1.2.3 From ef08f94cbec1a9fb98bc1bbfcc88cd399b7ff8d0 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 11 Jan 2024 12:30:05 +0100 Subject: Support numeric port numbers in auth-source-macos-keychain * lisp/auth-source.el (auth-source-macos-keychain-search): Support numeric port numbers (bug#68376). (auth-source-macos-keychain-search-items): Make regexp more robust. * test/lisp/auth-source-tests.el (test-macos-keychain-search): Extend test. --- lisp/auth-source.el | 14 ++++++++------ test/lisp/auth-source-tests.el | 28 ++++++++++++++++++---------- 2 files changed, 26 insertions(+), 16 deletions(-) diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 369cf4dca2e..cf93cb05fba 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -1946,18 +1946,20 @@ entries for git.gnus.org: (returned-keys (delete-dups (append '(:host :login :port :secret) search-keys))) - ;; Extract host and port from spec + ;; Extract host, port and user from spec (hosts (plist-get spec :host)) - (hosts (if (and hosts (listp hosts)) hosts `(,hosts))) + (hosts (if (consp hosts) hosts `(,hosts))) (ports (plist-get spec :port)) - (ports (if (and ports (listp ports)) ports `(,ports))) + (ports (if (consp ports) ports `(,ports))) (users (plist-get spec :user)) - (users (if (and users (listp users)) users `(,users))) + (users (if (consp users) users `(,users))) ;; Loop through all combinations of host/port and pass each of these to - ;; auth-source-macos-keychain-search-items + ;; auth-source-macos-keychain-search-items. Convert numeric port to + ;; string (bug#68376). (items (catch 'match (dolist (host hosts) (dolist (port ports) + (when (numberp port) (setq port (number-to-string port))) (dolist (user users) (let ((items (apply #'auth-source-macos-keychain-search-items @@ -2019,7 +2021,7 @@ entries for git.gnus.org: (when port (if keychain-generic (setq args (append args (list "-s" port))) - (setq args (append args (if (string-match "[0-9]+" port) + (setq args (append args (if (string-match-p "\\`[[:digit:]]+\\'" port) (list "-P" port) (list "-r" (substring (format "%-4s" port) diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index 5452501b861..2ff76977174 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -442,18 +442,26 @@ machine c1 port c2 user c3 password c4\n" (cl-letf (((symbol-function 'call-process) (lambda (_program _infile _destination _display &rest args) - ;; Arguments must be all strings + ;; Arguments must be all strings. (should (cl-every #'stringp args)) - ;; Argument number should be even + ;; Argument number should be even. (should (cl-evenp (length args))) - (should (cond ((string= (car args) "find-internet-password") - (let ((protocol (cl-member "-r" args :test #'string=))) - (if protocol - (= 4 (length (cadr protocol))) - t))) - ((string= (car args) "find-generic-password") - t)))))) - (auth-source-search :user '("a" "b") :host '("example.org") :port '("irc" "ftp" "https"))))) + (should + (cond + ((string= (car args) "find-internet-password") + (let ((protocol-r (cl-member "-r" args :test #'string=)) + (protocol-P (cl-member "-P" args :test #'string=))) + (cond (protocol-r + (= 4 (length (cadr protocol-r)))) + (protocol-P + (string-match-p + "\\`[[:digit:]]+\\'" (cadr protocol-P))) + (t)))) + ((string= (car args) "find-generic-password") + t)))))) + (auth-source-search + :user '("a" "b") :host '("example.org") + :port '("irc" "ftp" "https" 123))))) (provide 'auth-source-tests) ;;; auth-source-tests.el ends here -- cgit v1.2.3 From 5df57f1792ee31fd3a00734dd754cc11bba9dd9c Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 11 Jan 2024 12:45:03 +0100 Subject: Adapt test names in auth-source-tests.el * test/lisp/auth-source-tests.el (auth-source-test-netrc-credentials) (auth-source-test-netrc-credentials-2) (auth-source-test-macos-keychain-search): Adapt test names. --- test/lisp/auth-source-tests.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index 2ff76977174..0a3c1cce590 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -411,7 +411,7 @@ machine c1 port c2 user c3 password c4\n" ;; this is actually the same as `auth-source-search'. (should (equal found expected))))) -(ert-deftest test-netrc-credentials () +(ert-deftest auth-source-test-netrc-credentials () (let ((data (auth-source-netrc-parse-all (ert-resource-file "authinfo")))) (should data) (let ((imap (seq-find (lambda (elem) @@ -427,7 +427,7 @@ machine c1 port c2 user c3 password c4\n" (should (equal (cdr (assoc "login" imap)) "jrh")) (should (equal (cdr (assoc "password" imap)) "*baz*"))))) -(ert-deftest test-netrc-credentials-2 () +(ert-deftest auth-source-test-netrc-credentials-2 () (let ((data (auth-source-netrc-parse-all (ert-resource-file "netrc-folding")))) (should @@ -435,7 +435,7 @@ machine c1 port c2 user c3 password c4\n" '((("machine" . "XM") ("login" . "XL") ("password" . "XP")) (("machine" . "YM") ("login" . "YL") ("password" . "YP"))))))) -(ert-deftest test-macos-keychain-search () +(ert-deftest auth-source-test-macos-keychain-search () "Test if the constructed command line arglist is correct." (let ((auth-sources '(macos-keychain-internet macos-keychain-generic))) ;; Redefine `call-process' to check command line arguments. -- cgit v1.2.3 From b825962ea840348bbde0c834ca398458a06fbb8b Mon Sep 17 00:00:00 2001 From: Xiyue Deng Date: Thu, 11 Jan 2024 14:41:41 +0100 Subject: Fix typo in lispref "Creating Strings" section * doc/lispref/strings.texi (String Basics): Fix typo. --- doc/lispref/strings.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 7097de49064..4fe94f78cba 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -43,7 +43,7 @@ integer is a character or not is determined only by how it is used. Emacs. A string is a fixed sequence of characters. It is a type of -sequence called a @dfn{array}, meaning that its length is fixed and +sequence called an @dfn{array}, meaning that its length is fixed and cannot be altered once it is created (@pxref{Sequences Arrays Vectors}). Unlike in C, Emacs Lisp strings are @emph{not} terminated by a distinguished character code. -- cgit v1.2.3 From aa26852f31984c4354a8348ac778904fb8e52640 Mon Sep 17 00:00:00 2001 From: Stephen Berman Date: Thu, 11 Jan 2024 15:12:00 +0100 Subject: Revert "Fix typo in lispref 'Creating Strings' section" This reverts commit b825962ea840348bbde0c834ca398458a06fbb8b which was mistakenly installed in master instead of emacs-29. --- doc/lispref/strings.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 4fe94f78cba..7097de49064 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -43,7 +43,7 @@ integer is a character or not is determined only by how it is used. Emacs. A string is a fixed sequence of characters. It is a type of -sequence called an @dfn{array}, meaning that its length is fixed and +sequence called a @dfn{array}, meaning that its length is fixed and cannot be altered once it is created (@pxref{Sequences Arrays Vectors}). Unlike in C, Emacs Lisp strings are @emph{not} terminated by a distinguished character code. -- cgit v1.2.3 From 26eb9d3a8a670a1ce2e8b4f0c6418d39329ec41a Mon Sep 17 00:00:00 2001 From: Xiyue Deng Date: Thu, 11 Jan 2024 15:18:37 +0100 Subject: Fix typo in lispref "Creating Strings" section * doc/lispref/strings.texi (String Basics): Fix typo (bug#68375). --- doc/lispref/strings.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index ff5da15fe54..a364fef3aab 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -43,7 +43,7 @@ integer is a character or not is determined only by how it is used. Emacs. A string is a fixed sequence of characters. It is a type of -sequence called a @dfn{array}, meaning that its length is fixed and +sequence called an @dfn{array}, meaning that its length is fixed and cannot be altered once it is created (@pxref{Sequences Arrays Vectors}). Unlike in C, Emacs Lisp strings are @emph{not} terminated by a distinguished character code. -- cgit v1.2.3 From fbc4a3c7de60d766c4b7c639985fecddc4f60604 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 11 Jan 2024 17:27:04 +0200 Subject: Fix man-tests.el * test/lisp/man-tests.el (man-tests-Man-translate-references): Fix test for MS-Windows and MS-DOS. --- test/lisp/man-tests.el | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/test/lisp/man-tests.el b/test/lisp/man-tests.el index 11f5f805e43..ecda189b6b2 100644 --- a/test/lisp/man-tests.el +++ b/test/lisp/man-tests.el @@ -163,15 +163,21 @@ DESCRIPTION (ert-deftest man-tests-Man-translate-references () (should (equal (Man-translate-references "basename") - "basename")) + (if (memq system-type '(ms-dos windows-nt)) + "\"basename\"" + "basename"))) (should (equal (Man-translate-references "basename(3)") "3 basename")) (should (equal (Man-translate-references "basename(3v)") "3v basename")) (should (equal (Man-translate-references ";id") - "\\;id")) + (if (memq system-type '(ms-dos windows-nt)) + "\";id\"" + "\\;id"))) (should (equal (Man-translate-references "-k basename") - "-k basename"))) + (if (memq system-type '(ms-dos windows-nt)) + "\"-k\" \"basename\"" + "-k basename")))) (provide 'man-tests) -- cgit v1.2.3 From 07bb8dc0afaef5ec7a7e194df42cc019ce8604d4 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Thu, 11 Jan 2024 17:54:47 +0000 Subject: Bind cross-buffer buffer-local variable correctly. This fixes bug#68200. * lisp/emacs-lisp/bytecomp.el (byte-compile-output-docform): Note that let-binding a buffer local variable leaves it buffer local, hence to transfer the binding of byte-compile-dynamic-docstrings to the output buffer, an intermediate variable is needed. Implement this. --- lisp/emacs-lisp/bytecomp.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 2bc8d54ba77..ea9298c6646 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2605,9 +2605,10 @@ 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 ((byte-compile-dynamic-docstrings byte-compile-dynamic-docstrings)) + (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) (with-current-buffer byte-compile--outbuffer - (let ((position (point)) + (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 -- cgit v1.2.3 From a66069c50c8eaf4a3ee253e7b7e47af48e721585 Mon Sep 17 00:00:00 2001 From: john muhl Date: Sat, 6 Jan 2024 09:36:33 -0600 Subject: Support indented continuation lines in lua-ts-mode * lisp/progmodes/lua-ts-mode.el (lua-ts--simple-indent-rules): Add a rule to indent multi-line assignments and if statements. (lua-ts-indent-continuation-lines): New user option. * test/lisp/progmodes/lua-ts-mode-resources/indent.erts: Add tests. (Bug#68279) --- lisp/progmodes/lua-ts-mode.el | 49 ++++++++++ .../progmodes/lua-ts-mode-resources/indent.erts | 106 +++++++++++++++++++++ 2 files changed, 155 insertions(+) diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 3b600f59521..05a3ff6d7c6 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -122,6 +122,28 @@ :group 'lua-ts :version "30.1") +(defcustom lua-ts-indent-continuation-lines t + "Controls how multi-line if/else statements are aligned. + +If t, then continuation lines are indented by `lua-ts-indent-offset': + + if a + and b then + print(1) + end + +If nil, then continuation lines are aligned with the beginning of +the statement: + + if a + and b then + print(1) + end" + :type 'boolean + :safe 'booleanp + :group 'lua-ts + :version "30.1") + (defvar lua-ts--builtins '("assert" "bit32" "collectgarbage" "coroutine" "debug" "dofile" "error" "getmetatable" "io" "ipairs" "load" "loadfile" @@ -329,6 +351,17 @@ values of OVERRIDE." ((or (match "end" "function_definition") (node-is "end")) standalone-parent 0) + ((n-p-gp "expression_list" "assignment_statement" "variable_declaration") + lua-ts--variable-declaration-continuation-anchor + lua-ts-indent-offset) + ((and (parent-is "binary_expression") + lua-ts--variable-declaration-continuation) + lua-ts--variable-declaration-continuation-anchor + lua-ts-indent-offset) + ((and (lambda (&rest _) lua-ts-indent-continuation-lines) + (parent-is "binary_expression")) + standalone-parent lua-ts-indent-offset) + ((parent-is "binary_expression") standalone-parent 0) ((or (parent-is "function_declaration") (parent-is "function_definition") (parent-is "do_statement") @@ -415,6 +448,22 @@ values of OVERRIDE." (treesit-induce-sparse-tree parent #'lua-ts--function-definition-p))) (= 1 (length (cadr sparse-tree))))) +(defun lua-ts--variable-declaration-continuation (node &rest _) + "Matches if NODE is part of a multi-line variable declaration." + (treesit-parent-until node + (lambda (p) + (equal "variable_declaration" + (treesit-node-type p))))) + +(defun lua-ts--variable-declaration-continuation-anchor (node &rest _) + "Return the start position of the variable declaration for NODE." + (save-excursion + (goto-char (treesit-node-start + (lua-ts--variable-declaration-continuation node))) + (when (looking-back (rx bol (* whitespace)) + (line-beginning-position)) + (point)))) + (defvar lua-ts--syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?+ "." table) diff --git a/test/lisp/progmodes/lua-ts-mode-resources/indent.erts b/test/lisp/progmodes/lua-ts-mode-resources/indent.erts index 9797467bbe5..48184160b4d 100644 --- a/test/lisp/progmodes/lua-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/lua-ts-mode-resources/indent.erts @@ -529,6 +529,58 @@ local Other = { } =-=-= +Name: Continuation Indent + +=-= +local very_long_variable_name = +"ok".. + "ok" +local n = a + +b * +c / +1 +local x = "A".. +"B" +.."C" +if a + and b + and c then + if x + and y then + local x = 1 + +2 * + 3 + end +elseif a + or b + or c then +end +=-= +local very_long_variable_name = + "ok".. + "ok" +local n = a + + b * + c / + 1 +local x = "A".. + "B" + .."C" +if a + and b + and c then + if x + and y then + local x = 1 + + 2 * + 3 + end +elseif a + or b + or c then +end +=-=-= + Code: (lambda () (setq indent-tabs-mode nil) @@ -677,3 +729,57 @@ function e (n, t) end)(i(...)) end end end =-=-= + +Code: + (lambda () + (setq indent-tabs-mode nil) + (setq lua-ts-indent-continuation-lines nil) + (setq lua-ts-indent-offset 2) + (lua-ts-mode) + (indent-region (point-min) (point-max))) + +Name: Unaligned Continuation Indent + +=-= +local n = a + + b * + c / + 1 +if a + and b +and c then + if x + and y then + local x = 1 + + 2 * + 3 + end +elseif a + or b + or c then + if x + or y + end +end +=-= +local n = a + + b * + c / + 1 +if a +and b +and c then + if x + and y then + local x = 1 + + 2 * + 3 + end +elseif a +or b +or c then + if x + or y + end +end +=-=-= -- cgit v1.2.3 From e4e89e2cb663c730fd563d89228fe3a9a34e63e5 Mon Sep 17 00:00:00 2001 From: Alyssa Ross Date: Thu, 9 Nov 2023 15:46:30 +0100 Subject: Add autoload cookie to vc-git-grep * lisp/vc/vc-git.el (vc-git-grep): Add autoload cookie. (Bug#67018) --- lisp/vc/vc-git.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index fed15ae2033..456417e566e 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1982,6 +1982,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (defvar compilation-environment) ;; Derived from `lgrep'. +;;;###autoload (defun vc-git-grep (regexp &optional files dir) "Run git grep, searching for REGEXP in FILES in directory DIR. The search is limited to file names matching shell pattern FILES. -- cgit v1.2.3 From c4b4948845508d599f6176441a833ae1a2cb6d40 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 11 Jan 2024 22:36:33 +0100 Subject: Don't recommend inverse-video for debugging * etc/DEBUG: Don't recommend 'inverse-video', which has been broken for 20 years, give or take. (Bug#11430) --- etc/DEBUG | 5 ----- 1 file changed, 5 deletions(-) diff --git a/etc/DEBUG b/etc/DEBUG index dd699f962ba..9dae54aeabd 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -864,11 +864,6 @@ in your ~/.emacs file. When the problem happens, exit the Emacs that you were running, kill it, and rename the two files. Then you can start another Emacs without clobbering those files, and use it to examine them. -An easy way to see if too much text is being redrawn on a terminal is to -evaluate '(setq inverse-video t)' before you try the operation you think -will cause too much redrawing. This doesn't refresh the screen, so only -newly drawn text is in inverse video. - ** Debugging LessTif If you encounter bugs whereby Emacs built with LessTif grabs all mouse -- cgit v1.2.3 From bfb486d8026424ec0859036b3686df9cab1383df Mon Sep 17 00:00:00 2001 From: Slava Akhmechet Date: Thu, 11 Jan 2024 15:50:08 -0600 Subject: Eglot: Simplify overlay handling in manual example * doc/misc/eglot.texi (Extending Eglot): Simplify. Copyright-paperwork-exempt: yes --- doc/misc/eglot.texi | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index a5c3a967af1..85fef6be553 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -1405,8 +1405,6 @@ The remainder of the implementation consists of standard Elisp techniques to loop over arrays, manage buffers and overlays. @lisp -(defvar-local eglot-clangd-inactive-region-overlays '()) - (cl-defmethod eglot-handle-notification (_server (_method (eql textDocument/inactiveRegions)) &key regions textDocument &allow-other-keys) @@ -1414,14 +1412,14 @@ techniques to loop over arrays, manage buffers and overlays. (cl-getf textDocument :uri)))) (buffer (find-buffer-visiting path))) (with-current-buffer buffer - (mapc #'delete-overlay eglot-clangd-inactive-region-overlays) + (remove-overlays nil nil 'inactive-code t) (cl-loop for r across regions for (beg . end) = (eglot-range-region r) for ov = (make-overlay beg end) do (overlay-put ov 'face 'shadow) - (push ov eglot-clangd-inactive-region-overlays))))) + (overlay-put ov 'inactive-code t))))) @end lisp @end itemize -- cgit v1.2.3 From eac3f2a80778b3904c55ae7b65ff862a79eebf2a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 11 Jan 2024 22:12:34 -0500 Subject: sh-script.el: Add support for `case FOO {...}` (bug#55764) * lisp/progmodes/sh-script.el (sh-font-lock-paren): Also recognize `FOO)` after `{`. (sh-smie-sh-rules): Make `for` rule apply to `case FOO { ...}` as well. * test/manual/indent/shell.sh: Add new test case. --- lisp/progmodes/sh-script.el | 7 ++++--- test/manual/indent/shell.sh | 7 +++++++ 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 0562415b4e5..2a650fe0ea6 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1054,7 +1054,8 @@ subshells can nest." ;; a normal command rather than the real `in' keyword. ;; I.e. we should look back to try and find the ;; corresponding `case'. - (and (looking-at ";\\(?:;&?\\|[&|]\\)\\|\\_ Date: Fri, 12 Jan 2024 10:03:08 +0200 Subject: Improve documentation of Ispell commands * doc/emacs/fixit.texi (Spelling): Document "C-u M-$" and warn against modifications in recursive-edit. (Bug#14192) --- doc/emacs/fixit.texi | 28 ++++++++++++++++++++++++---- 1 file changed, 24 insertions(+), 4 deletions(-) diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi index 13c79b237da..a972ed698f7 100644 --- a/doc/emacs/fixit.texi +++ b/doc/emacs/fixit.texi @@ -274,6 +274,9 @@ you can control which one is used by customizing the variable @item M-$ Check and correct spelling of the word at point (@code{ispell-word}). If the region is active, do it for all words in the region instead. +@item C-u M-$ +If a previous spelling operation was interrupted, continue that +operation (@code{ispell-continue}). @item M-x ispell Check and correct spelling of all words in the buffer. If the region is active, do it for all words in the region instead. @@ -305,12 +308,16 @@ Enable Flyspell mode for comments and strings only. @kindex M-$ @findex ispell-word +@findex ispell-continue To check the spelling of the word around or before point, and optionally correct it as well, type @kbd{M-$} (@code{ispell-word}). If a region is active, @kbd{M-$} checks the spelling of all words within the region. @xref{Mark}. (When Transient Mark mode is off, @kbd{M-$} always acts on the word around or before point, ignoring the -region; @pxref{Disabled Transient Mark}.) +region; @pxref{Disabled Transient Mark}.) When invoked with a prefix +argument, @kbd{C-u M-$}, this calls @code{ispell-continue}, which +continues the spelling operation, if any, which was interrupted with +@kbd{X} or @kbd{C-g}. @findex ispell @findex ispell-buffer @@ -383,9 +390,9 @@ wildcard. @item C-g @itemx X -Quit interactive spell-checking, leaving point at the word that was -being checked. You can restart checking again afterward with @w{@kbd{C-u -M-$}}. +Interrupt the interactive spell-checking, leaving point at the word +that was being checked. You can restart checking again afterward with +@w{@kbd{C-u M-$}}. @item x Quit interactive spell-checking and move point back to where it was @@ -394,6 +401,19 @@ when you started spell-checking. @item q Quit interactive spell-checking and kill the spell-checker subprocess. +@item C-r +Enter recursive-edit (@pxref{Recursive Editing}). When you exit +recursive-edit with @kbd{C-M-c}, the interactive spell-checking will +resume. This allows you to consult the buffer text without +interrupting the spell-checking. Do @emph{not} modify the buffer in +the recursive editing, and especially don't modify the misspelled +word, as the edits will be undone when you exit recursive-edit. If +you need to edit the misspelled word, use @kbd{r} or @kbd{R} instead, +or use @kbd{X}, edit the buffer, then resume with @w{@kbd{C-u M-$}}. + +@item C-z +Suspend Emacs or iconify the selected frame. + @item ? Show the list of options. @end table -- cgit v1.2.3 From 10cfbda88413c8ac0d254553fd537447b890a885 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 12 Jan 2024 16:19:42 +0100 Subject: * src/nsfont.m (nsfont_open): Fix Ffont_xlfd_name args. --- src/nsfont.m | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/nsfont.m b/src/nsfont.m index 1205fbe5263..2679a42e1e1 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -1035,7 +1035,7 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size) font->underline_position = lrint (font_info->underpos); font->underline_thickness = lrint (font_info->underwidth); - font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil); + font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil, Qnil); font->props[FONT_FULLNAME_INDEX] = build_unibyte_string (font_info->name); } unblock_input (); -- cgit v1.2.3 From 228e9000181b06e5fd3d775c4c9a31c48ee2a231 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 6 Nov 2023 13:25:07 +0100 Subject: Add internal hash-table debug functions These are useful for measuring hashing and collisions. * src/fns.c (Finternal__hash_table_histogram) (Finternal__hash_table_buckets, Finternal__hash_table_index_size): New. --- src/fns.c | 65 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 65 insertions(+) diff --git a/src/fns.c b/src/fns.c index c03aea02397..4ce855827c9 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5560,6 +5560,68 @@ returns nil, then (funcall TEST x1 x2) also returns nil. */) return Fput (name, Qhash_table_test, list2 (test, hash)); } +DEFUN ("internal--hash-table-histogram", + Finternal__hash_table_histogram, + Sinternal__hash_table_histogram, + 1, 1, 0, + doc: /* Bucket size histogram of HASH-TABLE. Internal use only. */) + (Lisp_Object hash_table) +{ + struct Lisp_Hash_Table *h = check_hash_table (hash_table); + ptrdiff_t size = HASH_TABLE_SIZE (h); + ptrdiff_t *freq = xzalloc (size * sizeof *freq); + ptrdiff_t index_size = ASIZE (h->index); + for (ptrdiff_t i = 0; i < index_size; i++) + { + ptrdiff_t n = 0; + for (ptrdiff_t j = HASH_INDEX (h, i); j != -1; j = HASH_NEXT (h, j)) + n++; + if (n > 0) + freq[n - 1]++; + } + Lisp_Object ret = Qnil; + for (ptrdiff_t i = 0; i < size; i++) + if (freq[i] > 0) + ret = Fcons (Fcons (make_int (i + 1), make_int (freq[i])), + ret); + xfree (freq); + return Fnreverse (ret); +} + +DEFUN ("internal--hash-table-buckets", + Finternal__hash_table_buckets, + Sinternal__hash_table_buckets, + 1, 1, 0, + doc: /* (KEY . HASH) in HASH-TABLE, grouped by bucket. +Internal use only. */) + (Lisp_Object hash_table) +{ + struct Lisp_Hash_Table *h = check_hash_table (hash_table); + Lisp_Object ret = Qnil; + ptrdiff_t index_size = ASIZE (h->index); + for (ptrdiff_t i = 0; i < index_size; i++) + { + Lisp_Object bucket = Qnil; + for (ptrdiff_t j = HASH_INDEX (h, i); j != -1; j = HASH_NEXT (h, j)) + bucket = Fcons (Fcons (HASH_KEY (h, j), HASH_HASH (h, j)), + bucket); + if (!NILP (bucket)) + ret = Fcons (Fnreverse (bucket), ret); + } + return Fnreverse (ret); +} + +DEFUN ("internal--hash-table-index-size", + Finternal__hash_table_index_size, + Sinternal__hash_table_index_size, + 1, 1, 0, + doc: /* Index size of HASH-TABLE. Internal use only. */) + (Lisp_Object hash_table) +{ + struct Lisp_Hash_Table *h = check_hash_table (hash_table); + ptrdiff_t index_size = ASIZE (h->index); + return make_int (index_size); +} /************************************************************************ @@ -6250,6 +6312,9 @@ syms_of_fns (void) defsubr (&Sremhash); defsubr (&Smaphash); defsubr (&Sdefine_hash_table_test); + defsubr (&Sinternal__hash_table_histogram); + defsubr (&Sinternal__hash_table_buckets); + defsubr (&Sinternal__hash_table_index_size); defsubr (&Sstring_search); defsubr (&Sobject_intervals); defsubr (&Sline_number_at_pos); -- cgit v1.2.3 From 8acd89e955f9422c5201d0db102d3a5ac05f3094 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 29 Dec 2023 15:32:18 +0100 Subject: ; * src/pdumper.c (dump_hash_table): Remove unused argument. --- src/pdumper.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/pdumper.c b/src/pdumper.c index ba318605773..c72db7f3ea3 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2708,9 +2708,7 @@ hash_table_thaw (Lisp_Object hash) } static dump_off -dump_hash_table (struct dump_context *ctx, - Lisp_Object object, - dump_off offset) +dump_hash_table (struct dump_context *ctx, Lisp_Object object) { #if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_6D63EDB618 # error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h." @@ -3026,7 +3024,7 @@ dump_vectorlike (struct dump_context *ctx, case PVEC_BOOL_VECTOR: return dump_bool_vector(ctx, v); case PVEC_HASH_TABLE: - return dump_hash_table (ctx, lv, offset); + return dump_hash_table (ctx, lv); case PVEC_BUFFER: return dump_buffer (ctx, XBUFFER (lv)); case PVEC_SUBR: -- cgit v1.2.3 From 22201dde773e5404f80baa1f59768e88d97a322a Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Wed, 1 Nov 2023 16:42:59 +0100 Subject: Decouple profiler from Lisp hash table internals The profiler stored data being collected in Lisp hash tables but relied heavily on their exact internal representation, which made it difficult and error-prone to change the hash table implementation. In particular, the profiler has special run-time requirements that are not easily met using standard Lisp data structures: accesses and updates are made from async signal handlers in almost any messy context you can think of and are therefore very constrained in what they can do. The new profiler tables are designed specifically for their purpose and are more efficient and, by not being coupled to Lisp hash tables, easier to keep safe. The old profiler morphed internal hash tables to ones usable from Lisp and thereby made them impossible to use internally; now export_log just makes new hash table objects for Lisp. The Lisp part of the profiler remains entirely unchanged. * src/alloc.c (garbage_collect): Mark profiler tables. * src/eval.c (get_backtrace): Fill an array of Lisp values instead of a Lisp vector. * src/profiler.c (log_t): No longer a Lisp hash table but a custom data structure: a fully associative fixed-sized cache that maps fixed-size arrays of Lisp objects to counts. (make_log): Build new struct. (mark_log, free_log, get_log_count, set_log_count, get_key_vector) (log_hash_index, remove_log_entry, trace_equal, trace_hash) (make_profiler_log, free_profiler_log, mark_profiler): New. (cmpfn_profiler, hashtest_profiler, hashfn_profiler) (syms_of_profiler_for_pdumper): Remove. (approximate_median, evict_lower_half, record_backtrace, export_log) (Fprofiler_cpu_log, Fprofiler_memory_log, syms_of_profiler): Adapt to the new data structure. --- src/alloc.c | 1 + src/eval.c | 23 ++- src/lisp.h | 3 +- src/profiler.c | 487 +++++++++++++++++++++++++++++++++------------------------ 4 files changed, 295 insertions(+), 219 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 53ba85d88b7..fae76d24189 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6541,6 +6541,7 @@ garbage_collect (void) mark_terminals (); mark_kboards (); mark_threads (); + mark_profiler (); #ifdef HAVE_PGTK mark_pgtkterm (); #endif diff --git a/src/eval.c b/src/eval.c index 94f6d8e31f8..c995183ceb8 100644 --- a/src/eval.c +++ b/src/eval.c @@ -4250,23 +4250,18 @@ mark_specpdl (union specbinding *first, union specbinding *ptr) } } +/* Fill ARRAY of size SIZE with backtrace entries, most recent call first. + Truncate the backtrace if longer than SIZE; pad with nil if shorter. */ void -get_backtrace (Lisp_Object array) +get_backtrace (Lisp_Object *array, ptrdiff_t size) { - union specbinding *pdl = backtrace_top (); - ptrdiff_t i = 0, asize = ASIZE (array); - /* Copy the backtrace contents into working memory. */ - for (; i < asize; i++) - { - if (backtrace_p (pdl)) - { - ASET (array, i, backtrace_function (pdl)); - pdl = backtrace_next (pdl); - } - else - ASET (array, i, Qnil); - } + union specbinding *pdl = backtrace_top (); + ptrdiff_t i = 0; + for (; i < size && backtrace_p (pdl); i++, pdl = backtrace_next (pdl)) + array[i] = backtrace_function (pdl); + for (; i < size; i++) + array[i] = Qnil; } Lisp_Object backtrace_top_function (void) diff --git a/src/lisp.h b/src/lisp.h index 44f69892c6f..5ec895ecc81 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4608,7 +4608,7 @@ extern void init_eval (void); extern void syms_of_eval (void); extern void prog_ignore (Lisp_Object); extern void mark_specpdl (union specbinding *first, union specbinding *ptr); -extern void get_backtrace (Lisp_Object array); +extern void get_backtrace (Lisp_Object *array, ptrdiff_t size); Lisp_Object backtrace_top_function (void); extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); void do_debug_on_call (Lisp_Object code, specpdl_ref count); @@ -5225,6 +5225,7 @@ void syms_of_dbusbind (void); extern bool profiler_memory_running; extern void malloc_probe (size_t); extern void syms_of_profiler (void); +extern void mark_profiler (void); #ifdef DOS_NT diff --git a/src/profiler.c b/src/profiler.c index 243a34872c2..48a042cc8aa 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -34,23 +34,152 @@ saturated_add (EMACS_INT a, EMACS_INT b) /* Logs. */ -typedef struct Lisp_Hash_Table log_t; +/* A fully associative cache of size SIZE, mapping vectors of DEPTH + Lisp objects to counts. */ +typedef struct { + /* We use `int' throughout for table indices because anything bigger + is overkill. (Maybe we should make a typedef, but int is short.) */ + int size; /* number of entries */ + int depth; /* elements in each key vector */ + int index_size; /* size of index */ + Lisp_Object *trace; /* working trace, `depth' elements */ + int *index; /* `index_size' indices or -1 if nothing */ + int *next; /* `size' indices to next bucket or -1 */ + EMACS_UINT *hash; /* `size' hash values */ + Lisp_Object *keys; /* `size' keys of `depth' objects each */ + EMACS_INT *counts; /* `size' entries, 0 indicates unused entry */ + int next_free; /* next free entry, -1 if all taken */ +} log_t; -static Lisp_Object cmpfn_profiler (Lisp_Object, Lisp_Object, - struct Lisp_Hash_Table *); -static Lisp_Object hashfn_profiler (Lisp_Object, struct Lisp_Hash_Table *); +static void +mark_log (log_t *log) +{ + if (log == NULL) + return; + int size = log->size; + int depth = log->depth; + for (int i = 0; i < size; i++) + if (log->counts[i] > 0) /* Only mark valid keys. */ + mark_objects (log->keys + i * depth, depth); +} + +static log_t * +make_log (int size, int depth) +{ + log_t *log = xmalloc (sizeof *log); + log->size = size; + log->depth = depth; + + /* The index size is arbitrary but for there to be any point it should be + bigger than SIZE. FIXME: make it a power of 2 or a (pseudo)prime. */ + int index_size = size * 2 + 1; + log->index_size = index_size; + + log->trace = xmalloc (depth * sizeof *log->trace); + + log->index = xmalloc (index_size * sizeof *log->index); + for (int i = 0; i < index_size; i++) + log->index[i] = -1; + + log->next = xmalloc (size * sizeof *log->next); + for (int i = 0; i < size - 1; i++) + log->next[i] = i + 1; + log->next[size - 1] = -1; + log->next_free = 0; + + log->hash = xmalloc (size * sizeof *log->hash); + log->keys = xzalloc (size * depth * sizeof *log->keys); + log->counts = xzalloc (size * sizeof *log->counts); + + return log; +} + +static void +free_log (log_t *log) +{ + xfree (log->trace); + xfree (log->index); + xfree (log->next); + xfree (log->hash); + xfree (log->keys); + xfree (log->counts); + xfree (log); +} + +static inline EMACS_INT +get_log_count (log_t *log, int idx) +{ + eassume (idx >= 0 && idx < log->size); + return log->counts[idx]; +} + +static inline void +set_log_count (log_t *log, int idx, EMACS_INT val) +{ + eassume (idx >= 0 && idx < log->size && val >= 0); + log->counts[idx] = val; +} + +static inline Lisp_Object * +get_key_vector (log_t *log, int idx) +{ + eassume (idx >= 0 && idx < log->size); + return log->keys + idx * log->depth; +} + +static inline int +log_hash_index (log_t *log, EMACS_UINT hash) +{ + /* FIXME: avoid division. */ + return hash % log->index_size; +} + +static void +remove_log_entry (log_t *log, int idx) +{ + eassume (idx >= 0 && idx < log->size); + /* Remove from index. */ + int hidx = log_hash_index (log, log->hash[idx]); + int *p = &log->index[hidx]; + while (*p != idx) + { + eassert (*p >= 0 && *p < log->size); + p = &log->next[*p]; + } + *p = log->next[*p]; + /* Invalidate entry and put it on the free list. */ + log->counts[idx] = 0; + log->next[idx] = log->next_free; + log->next_free = idx; +} -static const struct hash_table_test hashtest_profiler = - { - LISPSYM_INITIALLY (Qprofiler_backtrace_equal), - LISPSYM_INITIALLY (Qnil) /* user_hash_function */, - LISPSYM_INITIALLY (Qnil) /* user_cmp_function */, - cmpfn_profiler, - hashfn_profiler, - }; +static bool +trace_equal (Lisp_Object *bt1, Lisp_Object *bt2, int depth) +{ + for (int i = 0; i < depth; i++) + if (!BASE_EQ (bt1[i], bt2[i]) && NILP (Ffunction_equal (bt1[i], bt2[i]))) + return false; + return true; +} + +static EMACS_UINT +trace_hash (Lisp_Object *trace, int depth) +{ + EMACS_UINT hash = 0; + for (int i = 0; i < depth; i++) + { + Lisp_Object f = trace[i]; + EMACS_UINT hash1 + = (COMPILEDP (f) ? XHASH (AREF (f, COMPILED_BYTECODE)) + : (CONSP (f) && CONSP (XCDR (f)) && BASE_EQ (Qclosure, XCAR (f))) + ? XHASH (XCDR (XCDR (f))) : XHASH (f)); + hash = sxhash_combine (hash, hash1); + } + return hash; +} struct profiler_log { - Lisp_Object log; + log_t *log; EMACS_INT gc_count; /* Samples taken during GC. */ EMACS_INT discarded; /* Samples evicted during table overflow. */ }; @@ -58,32 +187,22 @@ struct profiler_log { static Lisp_Object export_log (struct profiler_log *); static struct profiler_log -make_log (void) -{ - /* We use a standard Elisp hash-table object, but we use it in - a special way. This is OK as long as the object is not exposed - to Elisp, i.e. until it is returned by *-profiler-log, after which - it can't be used any more. */ - EMACS_INT heap_size - = clip_to_bounds (0, profiler_log_size, MOST_POSITIVE_FIXNUM); - ptrdiff_t max_stack_depth - = clip_to_bounds (0, profiler_max_stack_depth, PTRDIFF_MAX);; - struct profiler_log log - = { make_hash_table (hashtest_profiler, heap_size, - DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, - Qnil, false), - 0, 0 }; - struct Lisp_Hash_Table *h = XHASH_TABLE (log.log); - - /* What is special about our hash-tables is that the values are pre-filled - with the vectors we'll use as keys. */ - ptrdiff_t i = ASIZE (h->key_and_value) >> 1; - while (i > 0) - set_hash_value_slot (h, --i, make_nil_vector (max_stack_depth)); - return log; +make_profiler_log (void) +{ + int size = clip_to_bounds (0, profiler_log_size, + min (MOST_POSITIVE_FIXNUM, INT_MAX)); + int max_stack_depth = clip_to_bounds (0, profiler_max_stack_depth, INT_MAX); + return (struct profiler_log){make_log (size, max_stack_depth), 0, 0}; } +static void +free_profiler_log (struct profiler_log *plog) +{ + free_log (plog->log); + plog->log = NULL; +} + + /* Evict the least used half of the hash_table. When the table is full, we have to evict someone. @@ -100,22 +219,22 @@ make_log (void) cost of O(1) and we get O(N) time for a new entry to grow larger than the other least counts before a new round of eviction. */ -static EMACS_INT approximate_median (log_t *log, - ptrdiff_t start, ptrdiff_t size) +static EMACS_INT +approximate_median (log_t *log, int start, int size) { eassert (size > 0); if (size < 2) - return XFIXNUM (HASH_VALUE (log, start)); + return get_log_count (log, start); if (size < 3) /* Not an actual median, but better for our application than choosing either of the two numbers. */ - return ((XFIXNUM (HASH_VALUE (log, start)) - + XFIXNUM (HASH_VALUE (log, start + 1))) + return ((get_log_count (log, start) + + get_log_count (log, start + 1)) / 2); else { - ptrdiff_t newsize = size / 3; - ptrdiff_t start2 = start + newsize; + int newsize = size / 3; + int start2 = start + newsize; EMACS_INT i1 = approximate_median (log, start, newsize); EMACS_INT i2 = approximate_median (log, start2, newsize); EMACS_INT i3 = approximate_median (log, start2 + newsize, @@ -126,34 +245,24 @@ static EMACS_INT approximate_median (log_t *log, } } -static void evict_lower_half (struct profiler_log *plog) +static void +evict_lower_half (struct profiler_log *plog) { - log_t *log = XHASH_TABLE (plog->log); - ptrdiff_t size = ASIZE (log->key_and_value) / 2; + log_t *log = plog->log; + int size = log->size; EMACS_INT median = approximate_median (log, 0, size); - for (ptrdiff_t i = 0; i < size; i++) - /* Evict not only values smaller but also values equal to the median, - so as to make sure we evict something no matter what. */ - if (XFIXNUM (HASH_VALUE (log, i)) <= median) - { - Lisp_Object key = HASH_KEY (log, i); - EMACS_INT count = XFIXNUM (HASH_VALUE (log, i)); - plog->discarded = saturated_add (plog->discarded, count); - { /* FIXME: we could make this more efficient. */ - Lisp_Object tmp; - XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr. */ - Fremhash (key, tmp); + for (int i = 0; i < size; i++) + { + EMACS_INT count = get_log_count (log, i); + /* Evict not only values smaller but also values equal to the median, + so as to make sure we evict something no matter what. */ + if (count <= median) + { + plog->discarded = saturated_add (plog->discarded, count); + remove_log_entry (log, i); } - eassert (BASE_EQ (Qunbound, HASH_KEY (log, i))); - eassert (log->next_free == i); - - eassert (VECTORP (key)); - for (ptrdiff_t j = 0; j < ASIZE (key); j++) - ASET (key, j, Qnil); - - set_hash_value_slot (log, i, key); - } + } } /* Record the current backtrace in LOG. COUNT is the weight of this @@ -163,54 +272,52 @@ static void evict_lower_half (struct profiler_log *plog) static void record_backtrace (struct profiler_log *plog, EMACS_INT count) { - eassert (HASH_TABLE_P (plog->log)); - log_t *log = XHASH_TABLE (plog->log); + log_t *log = plog->log; + get_backtrace (log->trace, log->depth); + EMACS_UINT hash = trace_hash (log->trace, log->depth); + int hidx = log_hash_index (log, hash); + int idx = log->index[hidx]; + while (idx >= 0) + { + if (log->hash[idx] == hash + && trace_equal (log->trace, get_key_vector (log, idx), log->depth)) + { + /* Found existing entry. */ + set_log_count (log, idx, + saturated_add (get_log_count (log, idx), count)); + return; + } + idx = log->next[idx]; + } + + /* Add new entry. */ if (log->next_free < 0) evict_lower_half (plog); - ptrdiff_t index = log->next_free; - - /* Get a "working memory" vector. */ - Lisp_Object backtrace = HASH_VALUE (log, index); - eassert (BASE_EQ (Qunbound, HASH_KEY (log, index))); - get_backtrace (backtrace); - - { /* We basically do a `gethash+puthash' here, except that we have to be - careful to avoid memory allocation since we're in a signal - handler, and we optimize the code to try and avoid computing the - hash+lookup twice. See fns.c:Fputhash for reference. */ - Lisp_Object hash; - ptrdiff_t j = hash_lookup (log, backtrace, &hash); - if (j >= 0) - { - EMACS_INT old_val = XFIXNUM (HASH_VALUE (log, j)); - EMACS_INT new_val = saturated_add (old_val, count); - set_hash_value_slot (log, j, make_fixnum (new_val)); - } - else - { /* BEWARE! hash_put in general can allocate memory. - But currently it only does that if log->next_free is -1. */ - eassert (0 <= log->next_free); - ptrdiff_t j = hash_put (log, backtrace, make_fixnum (count), hash); - /* Let's make sure we've put `backtrace' right where it - already was to start with. */ - eassert (index == j); - - /* FIXME: If the hash-table is almost full, we should set - some global flag so that some Elisp code can offload its - data elsewhere, so as to avoid the eviction code. - There are 2 ways to do that, AFAICT: - - Set a flag checked in maybe_quit, such that maybe_quit can then - call Fprofiler_cpu_log and stash the full log for later use. - - Set a flag check in post-gc-hook, so that Elisp code can call - profiler-cpu-log. That gives us more flexibility since that - Elisp code can then do all kinds of fun stuff like write - the log to disk. Or turn it right away into a call tree. - Of course, using Elisp is generally preferable, but it may - take longer until we get a chance to run the Elisp code, so - there's more risk that the table will get full before we - get there. */ - } - } + idx = log->next_free; + eassert (idx >= 0); + log->next_free = log->next[idx]; + log->next[idx] = log->index[hidx]; + log->index[hidx] = idx; + eassert (log->counts[idx] == 0); + log->hash[idx] = hash; + memcpy (get_key_vector (log, idx), log->trace, + log->depth * sizeof *log->trace); + log->counts[idx] = count; + + /* FIXME: If the hash-table is almost full, we should set + some global flag so that some Elisp code can offload its + data elsewhere, so as to avoid the eviction code. + There are 2 ways to do that: + - Set a flag checked in maybe_quit, such that maybe_quit can then + call Fprofiler_cpu_log and stash the full log for later use. + - Set a flag check in post-gc-hook, so that Elisp code can call + profiler-cpu-log. That gives us more flexibility since that + Elisp code can then do all kinds of fun stuff like write + the log to disk. Or turn it right away into a call tree. + Of course, using Elisp is generally preferable, but it may + take longer until we get a chance to run the Elisp code, so + there's more risk that the table will get full before we + get there. */ } /* Sampling profiler. */ @@ -234,6 +341,9 @@ add_sample (struct profiler_log *plog, EMACS_INT count) #ifdef PROFILER_CPU_SUPPORT +/* The sampling interval specified. */ +static Lisp_Object profiler_cpu_interval = LISPSYM_INITIALLY (Qnil); + /* The profiler timer and whether it was properly initialized, if POSIX timers are available. */ #ifdef HAVE_ITIMERSPEC @@ -356,8 +466,8 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */) if (profiler_cpu_running) error ("CPU profiler is already running"); - if (NILP (cpu.log)) - cpu = make_log (); + if (cpu.log == NULL) + cpu = make_profiler_log (); int status = setup_cpu_timer (sampling_interval); if (status < 0) @@ -367,6 +477,7 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */) } else { + profiler_cpu_interval = sampling_interval; profiler_cpu_running = status; if (! profiler_cpu_running) error ("Unable to start profiler timer"); @@ -428,30 +539,51 @@ of functions, where the last few elements may be nil. Before returning, a new log is allocated for future samples. */) (void) { - return (export_log (&cpu)); + /* Temporarily stop profiling to avoid it interfering with our data + access. */ + bool prof_cpu = profiler_cpu_running; + if (prof_cpu) + Fprofiler_cpu_stop (); + + Lisp_Object ret = export_log (&cpu); + + if (prof_cpu) + Fprofiler_cpu_start (profiler_cpu_interval); + + return ret; } #endif /* PROFILER_CPU_SUPPORT */ +/* Extract log data to a Lisp hash table. The log data is then erased. */ static Lisp_Object -export_log (struct profiler_log *log) +export_log (struct profiler_log *plog) { - Lisp_Object result = log->log; - if (log->gc_count) + log_t *log = plog->log; + /* The returned hash table uses `equal' as key equivalence predicate + which is more discriminating than the `function-equal' used by + the log but close enough, and will never confuse two distinct + keys in the log. */ + Lisp_Object h = make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, + DEFAULT_REHASH_SIZE, + DEFAULT_REHASH_THRESHOLD, + Qnil, false); + for (int i = 0; i < log->size; i++) + { + int count = get_log_count (log, i); + if (count > 0) + Fputhash (Fvector (log->depth, get_key_vector (log, i)), + make_fixnum (count), h); + } + if (plog->gc_count) Fputhash (CALLN (Fvector, QAutomatic_GC, Qnil), - make_fixnum (log->gc_count), - result); - if (log->discarded) + make_fixnum (plog->gc_count), + h); + if (plog->discarded) Fputhash (CALLN (Fvector, QDiscarded_Samples, Qnil), - make_fixnum (log->discarded), - result); -#ifdef PROFILER_CPU_SUPPORT - /* Here we're making the log visible to Elisp, so it's not safe any - more for our use afterwards since we can't rely on its special - pre-allocated keys anymore. So we have to allocate a new one. */ - if (profiler_cpu_running) - *log = make_log (); -#endif /* PROFILER_CPU_SUPPORT */ - return result; + make_fixnum (plog->discarded), + h); + free_profiler_log (plog); + return h; } /* Memory profiler. */ @@ -474,8 +606,8 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */) if (profiler_memory_running) error ("Memory profiler is already running"); - if (NILP (memory.log)) - memory = make_log (); + if (memory.log == NULL) + memory = make_profiler_log (); profiler_memory_running = true; @@ -514,7 +646,16 @@ of functions, where the last few elements may be nil. Before returning, a new log is allocated for future samples. */) (void) { - return (export_log (&memory)); + bool prof_mem = profiler_memory_running; + if (prof_mem) + Fprofiler_memory_stop (); + + Lisp_Object ret = export_log (&memory); + + if (prof_mem) + Fprofiler_memory_start (); + + return ret; } @@ -547,50 +688,15 @@ the same lambda expression, or are really unrelated function. */) return res ? Qt : Qnil; } -static Lisp_Object -cmpfn_profiler (Lisp_Object bt1, Lisp_Object bt2, struct Lisp_Hash_Table *h) -{ - if (EQ (bt1, bt2)) - return Qt; - else if (VECTORP (bt1) && VECTORP (bt2)) - { - ptrdiff_t l = ASIZE (bt1); - if (l != ASIZE (bt2)) - return Qnil; - for (ptrdiff_t i = 0; i < l; i++) - if (NILP (Ffunction_equal (AREF (bt1, i), AREF (bt2, i)))) - return Qnil; - return Qt; - } - else - return Qnil; -} - -static Lisp_Object -hashfn_profiler (Lisp_Object bt, struct Lisp_Hash_Table *h) +void +mark_profiler (void) { - EMACS_UINT hash; - if (VECTORP (bt)) - { - hash = 0; - ptrdiff_t l = ASIZE (bt); - for (ptrdiff_t i = 0; i < l; i++) - { - Lisp_Object f = AREF (bt, i); - EMACS_UINT hash1 - = (COMPILEDP (f) ? XHASH (AREF (f, COMPILED_BYTECODE)) - : (CONSP (f) && CONSP (XCDR (f)) && EQ (Qclosure, XCAR (f))) - ? XHASH (XCDR (XCDR (f))) : XHASH (f)); - hash = sxhash_combine (hash, hash1); - } - } - else - hash = XHASH (bt); - return make_ufixnum (SXHASH_REDUCE (hash)); +#ifdef PROFILER_CPU_SUPPORT + mark_log (cpu.log); +#endif + mark_log (memory.log); } -static void syms_of_profiler_for_pdumper (void); - void syms_of_profiler (void) { @@ -603,47 +709,20 @@ If the log gets full, some of the least-seen call-stacks will be evicted to make room for new entries. */); profiler_log_size = 10000; - DEFSYM (Qprofiler_backtrace_equal, "profiler-backtrace-equal"); DEFSYM (QDiscarded_Samples, "Discarded Samples"); defsubr (&Sfunction_equal); #ifdef PROFILER_CPU_SUPPORT profiler_cpu_running = NOT_RUNNING; - cpu.log = Qnil; - staticpro (&cpu.log); defsubr (&Sprofiler_cpu_start); defsubr (&Sprofiler_cpu_stop); defsubr (&Sprofiler_cpu_running_p); defsubr (&Sprofiler_cpu_log); #endif profiler_memory_running = false; - memory.log = Qnil; - staticpro (&memory.log); defsubr (&Sprofiler_memory_start); defsubr (&Sprofiler_memory_stop); defsubr (&Sprofiler_memory_running_p); defsubr (&Sprofiler_memory_log); - - pdumper_do_now_and_after_load (syms_of_profiler_for_pdumper); -} - -static void -syms_of_profiler_for_pdumper (void) -{ - if (dumped_with_pdumper_p ()) - { -#ifdef PROFILER_CPU_SUPPORT - cpu.log = Qnil; -#endif - memory.log = Qnil; - } - else - { -#ifdef PROFILER_CPU_SUPPORT - eassert (NILP (cpu.log)); -#endif - eassert (NILP (memory.log)); - } - } -- cgit v1.2.3 From 3da324fbd3c7e8e282585ed617efe6ae740acf1a Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 30 Oct 2023 12:34:26 +0100 Subject: Refactor: less layering violation in composite.h Avoid using hash table internals directly. * src/composite.h (COMPOSITION_KEY): New. (COMPOSITION_GLYPH, COMPOSITION_RULE): Use COMPOSITION_KEY. --- src/composite.h | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/src/composite.h b/src/composite.h index c99888ccec2..4fe49b764e4 100644 --- a/src/composite.h +++ b/src/composite.h @@ -84,23 +84,21 @@ composition_registered_p (Lisp_Object prop) ? XCDR (XCDR (XCDR (prop))) \ : CONSP (prop) ? XCDR (prop) : Qnil) +#define COMPOSITION_KEY(cmp) \ + HASH_KEY (XHASH_TABLE (composition_hash_table), (cmp)->hash_index) + /* Return the Nth glyph of composition specified by CMP. CMP is a pointer to `struct composition'. */ #define COMPOSITION_GLYPH(cmp, n) \ - XFIXNUM (XVECTOR (XVECTOR (XHASH_TABLE (composition_hash_table) \ - ->key_and_value) \ - ->contents[cmp->hash_index * 2]) \ - ->contents[cmp->method == COMPOSITION_WITH_RULE_ALTCHARS \ - ? (n) * 2 : (n)]) + XFIXNUM (AREF (COMPOSITION_KEY (cmp), \ + (cmp)->method == COMPOSITION_WITH_RULE_ALTCHARS \ + ? (n) * 2 : (n))) /* Return the encoded composition rule to compose the Nth glyph of rule-base composition specified by CMP. CMP is a pointer to `struct composition'. */ -#define COMPOSITION_RULE(cmp, n) \ - XFIXNUM (XVECTOR (XVECTOR (XHASH_TABLE (composition_hash_table) \ - ->key_and_value) \ - ->contents[cmp->hash_index * 2]) \ - ->contents[(n) * 2 - 1]) +#define COMPOSITION_RULE(cmp, n) \ + XFIXNUM (AREF (COMPOSITION_KEY (cmp), (n) * 2 - 1)) /* Decode encoded composition rule RULE_CODE into GREF (global reference point code), NREF (new ref. point code). Don't check RULE_CODE; -- cgit v1.2.3 From 0bc13945acb8d18bc18b5abc5c5cf9adebc46ca6 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 11 Nov 2023 17:42:51 +0100 Subject: ; * src/fns.c (collect_interval): Move misplaced function. --- src/fns.c | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/fns.c b/src/fns.c index 4ce855827c9..33ee7c3d36e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4765,15 +4765,6 @@ check_mutable_hash_table (Lisp_Object obj, struct Lisp_Hash_Table *h) eassert (!PURE_P (h)); } -static void -collect_interval (INTERVAL interval, Lisp_Object collector) -{ - nconc2 (collector, - list1(list3 (make_fixnum (interval->position), - make_fixnum (interval->position + LENGTH (interval)), - interval->plist))); -} - /* Put an entry into hash table H that associates KEY with VALUE. HASH is a previously computed hash code of KEY. Value is the index of the entry in H matching KEY. */ @@ -5198,6 +5189,15 @@ sxhash_obj (Lisp_Object obj, int depth) } } +static void +collect_interval (INTERVAL interval, Lisp_Object collector) +{ + nconc2 (collector, + list1(list3 (make_fixnum (interval->position), + make_fixnum (interval->position + LENGTH (interval)), + interval->plist))); +} + /*********************************************************************** -- cgit v1.2.3 From 462b3e6ae4eefeb65a2dc7b144db3e1af9a7720d Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 29 Oct 2023 12:27:04 +0100 Subject: Refactor: extract hash and index computations to functions * src/lisp.h (hash_from_key): * src/fns.c (hash_index_index): New. (hash_table_rehash, hash_lookup, hash_remove_from_table): (maybe_resize_hash_table, hash_put): * src/composite.c (composition_gstring_put_cache): Use them. --- src/composite.c | 2 +- src/fns.c | 34 ++++++++++++++++++---------------- src/lisp.h | 7 +++++++ 3 files changed, 26 insertions(+), 17 deletions(-) diff --git a/src/composite.c b/src/composite.c index 91836fa2a8f..7c7f4720514 100644 --- a/src/composite.c +++ b/src/composite.c @@ -653,7 +653,7 @@ composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len) { struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table); Lisp_Object header = LGSTRING_HEADER (gstring); - Lisp_Object hash = h->test.hashfn (header, h); + Lisp_Object hash = hash_from_key (h, header); if (len < 0) { ptrdiff_t glyph_len = LGSTRING_GLYPH_LEN (gstring); diff --git a/src/fns.c b/src/fns.c index 33ee7c3d36e..207094909f4 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4631,6 +4631,13 @@ copy_hash_table (struct Lisp_Hash_Table *h1) } +/* Compute index into the index vector from a hash value. */ +static inline ptrdiff_t +hash_index_index (struct Lisp_Hash_Table *h, Lisp_Object hash_code) +{ + return XUFIXNUM (hash_code) % ASIZE (h->index); +} + /* Resize hash table H if it's too full. If H cannot be resized because it's already too large, throw an error. */ @@ -4689,8 +4696,8 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) for (ptrdiff_t i = 0; i < old_size; i++) if (!NILP (HASH_HASH (h, i))) { - EMACS_UINT hash_code = XUFIXNUM (HASH_HASH (h, i)); - ptrdiff_t start_of_bucket = hash_code % ASIZE (h->index); + Lisp_Object hash_code = HASH_HASH (h, i); + ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); set_hash_index_slot (h, start_of_bucket, i); } @@ -4718,8 +4725,8 @@ hash_table_rehash (Lisp_Object hash) for (i = 0; i < count; i++) { Lisp_Object key = HASH_KEY (h, i); - Lisp_Object hash_code = h->test.hashfn (key, h); - ptrdiff_t start_of_bucket = XUFIXNUM (hash_code) % ASIZE (h->index); + Lisp_Object hash_code = hash_from_key (h, key); + ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); set_hash_hash_slot (h, i, hash_code); set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); set_hash_index_slot (h, start_of_bucket, i); @@ -4738,15 +4745,12 @@ hash_table_rehash (Lisp_Object hash) ptrdiff_t hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object *hash) { - ptrdiff_t start_of_bucket, i; - - Lisp_Object hash_code; - hash_code = h->test.hashfn (key, h); + Lisp_Object hash_code = hash_from_key (h, key); if (hash) *hash = hash_code; - start_of_bucket = XUFIXNUM (hash_code) % ASIZE (h->index); - + ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); + ptrdiff_t i; for (i = HASH_INDEX (h, start_of_bucket); 0 <= i; i = HASH_NEXT (h, i)) if (EQ (key, HASH_KEY (h, i)) || (h->test.cmpfn @@ -4773,14 +4777,12 @@ ptrdiff_t hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, Lisp_Object hash) { - ptrdiff_t start_of_bucket, i; - /* Increment count after resizing because resizing may fail. */ maybe_resize_hash_table (h); h->count++; /* Store key/value in the key_and_value vector. */ - i = h->next_free; + ptrdiff_t i = h->next_free; eassert (NILP (HASH_HASH (h, i))); eassert (BASE_EQ (Qunbound, (HASH_KEY (h, i)))); h->next_free = HASH_NEXT (h, i); @@ -4791,7 +4793,7 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, set_hash_hash_slot (h, i, hash); /* Add new entry to its collision chain. */ - start_of_bucket = XUFIXNUM (hash) % ASIZE (h->index); + ptrdiff_t start_of_bucket = hash_index_index (h, hash); set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); set_hash_index_slot (h, start_of_bucket, i); return i; @@ -4803,8 +4805,8 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, void hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) { - Lisp_Object hash_code = h->test.hashfn (key, h); - ptrdiff_t start_of_bucket = XUFIXNUM (hash_code) % ASIZE (h->index); + Lisp_Object hash_code = hash_from_key (h, key); + ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); ptrdiff_t prev = -1; for (ptrdiff_t i = HASH_INDEX (h, start_of_bucket); diff --git a/src/lisp.h b/src/lisp.h index 5ec895ecc81..a34726adbcb 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2524,6 +2524,13 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) return size; } +/* Compute hash value for KEY in hash table H. */ +INLINE Lisp_Object +hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) +{ + return h->test.hashfn (key, h); +} + void hash_table_rehash (Lisp_Object); /* Default size for hash tables if not specified. */ -- cgit v1.2.3 From 43127e5ec110debadef5e823ee8adbfc561bb708 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 28 Oct 2023 12:07:42 +0200 Subject: Refactor hash table vector reallocation * src/fns.c (larger_vecalloc): Remove. (larger_vector): Simplify. (alloc_larger_vector): New. (maybe_resize_hash_table): Use alloc_larger_vector as a simpler and faster replacement for larger_vecalloc. --- src/fns.c | 60 +++++++++++++++++++++++++++++------------------------------- 1 file changed, 29 insertions(+), 31 deletions(-) diff --git a/src/fns.c b/src/fns.c index 207094909f4..56b4e9a18c0 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4339,11 +4339,10 @@ get_key_arg (Lisp_Object key, ptrdiff_t nargs, Lisp_Object *args, char *used) /* Return a Lisp vector which has the same contents as VEC but has at least INCR_MIN more entries, where INCR_MIN is positive. If NITEMS_MAX is not -1, do not grow the vector to be any larger - than NITEMS_MAX. New entries in the resulting vector are - uninitialized. */ + than NITEMS_MAX. New entries in the resulting vector are nil. */ -static Lisp_Object -larger_vecalloc (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) +Lisp_Object +larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) { struct Lisp_Vector *v; ptrdiff_t incr, incr_max, old_size, new_size; @@ -4360,23 +4359,11 @@ larger_vecalloc (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) new_size = old_size + incr; v = allocate_vector (new_size); memcpy (v->contents, XVECTOR (vec)->contents, old_size * sizeof *v->contents); + memclear (v->contents + old_size, (new_size - old_size) * word_size); XSETVECTOR (vec, v); return vec; } -/* Likewise, except set new entries in the resulting vector to nil. */ - -Lisp_Object -larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) -{ - ptrdiff_t old_size = ASIZE (vec); - Lisp_Object v = larger_vecalloc (vec, incr_min, nitems_max); - ptrdiff_t new_size = ASIZE (v); - memclear (XVECTOR (v)->contents + old_size, - (new_size - old_size) * word_size); - return v; -} - /*********************************************************************** Low-level Functions @@ -4631,6 +4618,20 @@ copy_hash_table (struct Lisp_Hash_Table *h1) } +/* Allocate a Lisp vector of NEW_SIZE elements. + Copy elements from VEC and leave the rest undefined. */ +static Lisp_Object +alloc_larger_vector (Lisp_Object vec, ptrdiff_t new_size) +{ + eassert (VECTORP (vec)); + ptrdiff_t old_size = ASIZE (vec); + eassert (new_size >= old_size); + struct Lisp_Vector *v = allocate_vector (new_size); + memcpy (v->contents, XVECTOR (vec)->contents, old_size * sizeof *v->contents); + XSETVECTOR (vec, v); + return vec; +} + /* Compute index into the index vector from a hash value. */ static inline ptrdiff_t hash_index_index (struct Lisp_Hash_Table *h, Lisp_Object hash_code) @@ -4666,26 +4667,23 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) new_size = old_size + 1; /* Allocate all the new vectors before updating *H, to - avoid problems if memory is exhausted. larger_vecalloc - finishes computing the size of the replacement vectors. */ - Lisp_Object next = larger_vecalloc (h->next, new_size - old_size, - new_size); - ptrdiff_t next_size = ASIZE (next); - for (ptrdiff_t i = old_size; i < next_size - 1; i++) + avoid problems if memory is exhausted. */ + Lisp_Object next = alloc_larger_vector (h->next, new_size); + for (ptrdiff_t i = old_size; i < new_size - 1; i++) ASET (next, i, make_fixnum (i + 1)); - ASET (next, next_size - 1, make_fixnum (-1)); + ASET (next, new_size - 1, make_fixnum (-1)); /* Build the new&larger key_and_value vector, making sure the new fields are initialized to `unbound`. */ Lisp_Object key_and_value - = larger_vecalloc (h->key_and_value, 2 * (next_size - old_size), - 2 * next_size); - for (ptrdiff_t i = 2 * old_size; i < 2 * next_size; i++) + = alloc_larger_vector (h->key_and_value, 2 * new_size); + for (ptrdiff_t i = 2 * old_size; i < 2 * new_size; i++) ASET (key_and_value, i, Qunbound); - Lisp_Object hash = larger_vector (h->hash, next_size - old_size, - next_size); - ptrdiff_t index_size = hash_index_size (h, next_size); + Lisp_Object hash = alloc_larger_vector (h->hash, new_size); + memclear (XVECTOR (hash)->contents + old_size, + (new_size - old_size) * word_size); + ptrdiff_t index_size = hash_index_size (h, new_size); h->index = make_vector (index_size, make_fixnum (-1)); h->key_and_value = key_and_value; h->hash = hash; @@ -4704,7 +4702,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) #ifdef ENABLE_CHECKING if (HASH_TABLE_P (Vpurify_flag) && XHASH_TABLE (Vpurify_flag) == h) - message ("Growing hash table to: %"pD"d", next_size); + message ("Growing hash table to: %"pD"d", new_size); #endif } } -- cgit v1.2.3 From 484e04efa4fcb81968cba8e05835812c62856287 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Tue, 28 Nov 2023 13:54:26 +0100 Subject: ; * src/alloc.c (purecopy_hash_table): Simplify Copy the entire struct, then take care of fields needing special treatment. --- src/alloc.c | 20 +++++--------------- 1 file changed, 5 insertions(+), 15 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index fae76d24189..af9c169a3a0 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5891,26 +5891,16 @@ purecopy_hash_table (struct Lisp_Hash_Table *table) eassert (table->purecopy); struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike); - struct hash_table_test pure_test = table->test; + *pure = *table; + pure->mutable = false; - /* Purecopy the hash table test. */ - pure_test.name = purecopy (table->test.name); - pure_test.user_hash_function = purecopy (table->test.user_hash_function); - pure_test.user_cmp_function = purecopy (table->test.user_cmp_function); - - pure->header = table->header; - pure->weak = purecopy (Qnil); + pure->test.name = purecopy (table->test.name); + pure->test.user_hash_function = purecopy (table->test.user_hash_function); + pure->test.user_cmp_function = purecopy (table->test.user_cmp_function); pure->hash = purecopy (table->hash); pure->next = purecopy (table->next); pure->index = purecopy (table->index); - pure->count = table->count; - pure->next_free = table->next_free; - pure->purecopy = table->purecopy; - eassert (!pure->mutable); - pure->rehash_threshold = table->rehash_threshold; - pure->rehash_size = table->rehash_size; pure->key_and_value = purecopy (table->key_and_value); - pure->test = pure_test; return pure; } -- cgit v1.2.3 From 29e3d1c56f07a53d1955c9a71e68f70f3b901728 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 28 Dec 2023 19:04:43 +0100 Subject: Abstract predicate and constant for unused hash keys Qunbound is used for many things; using a predicate and constant for the specific purpose of unused hash entry keys allows us to locate them and make changes much more easily. * src/lisp.h (HASH_UNUSED_ENTRY_KEY, hash_unused_entry_key_p): New constant and function. * src/comp.c (compile_function, Fcomp__compile_ctxt_to_file): * src/composite.c (composition_gstring_cache_clear_font): * src/emacs-module.c (module_global_reference_p): * src/fns.c (make_hash_table, maybe_resize_hash_table, hash_put) (hash_remove_from_table, hash_clear, sweep_weak_table, Fmaphash): * src/json.c (lisp_to_json_nonscalar_1): * src/minibuf.c (Ftry_completion, Fall_completions, Ftest_completion): * src/print.c (print, print_object): Use them. --- src/comp.c | 8 ++++---- src/composite.c | 2 +- src/emacs-module.c | 2 +- src/fns.c | 14 +++++++------- src/json.c | 2 +- src/lisp.h | 12 +++++++++++- src/minibuf.c | 10 +++++----- src/print.c | 4 ++-- 8 files changed, 32 insertions(+), 22 deletions(-) diff --git a/src/comp.c b/src/comp.c index 347f8924793..2872c28a2b1 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4334,7 +4334,7 @@ compile_function (Lisp_Object func) { Lisp_Object block_name = HASH_KEY (ht, i); if (!EQ (block_name, Qentry) - && !BASE_EQ (block_name, Qunbound)) + && !hash_unused_entry_key_p (block_name)) declare_block (block_name); } @@ -4347,7 +4347,7 @@ compile_function (Lisp_Object func) for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (ht); i++) { Lisp_Object block_name = HASH_KEY (ht, i); - if (!BASE_EQ (block_name, Qunbound)) + if (!hash_unused_entry_key_p (block_name)) { Lisp_Object block = HASH_VALUE (ht, i); Lisp_Object insns = CALL1I (comp-block-insns, block); @@ -4966,12 +4966,12 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, struct Lisp_Hash_Table *func_h = XHASH_TABLE (CALL1I (comp-ctxt-funcs-h, Vcomp_ctxt)); for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (func_h); i++) - if (!BASE_EQ (HASH_KEY (func_h, i), Qunbound)) + if (!hash_unused_entry_key_p (HASH_KEY (func_h, i))) declare_function (HASH_VALUE (func_h, i)); /* Compile all functions. Can't be done before because the relocation structs has to be already defined. */ for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (func_h); i++) - if (!BASE_EQ (HASH_KEY (func_h, i), Qunbound)) + if (!hash_unused_entry_key_p (HASH_KEY (func_h, i))) compile_function (HASH_VALUE (func_h, i)); /* Work around bug#46495 (GCC PR99126). */ diff --git a/src/composite.c b/src/composite.c index 7c7f4720514..ed1aeb380a0 100644 --- a/src/composite.c +++ b/src/composite.c @@ -690,7 +690,7 @@ composition_gstring_cache_clear_font (Lisp_Object font_object) { Lisp_Object k = HASH_KEY (h, i); - if (!BASE_EQ (k, Qunbound)) + if (!hash_unused_entry_key_p (k)) { Lisp_Object gstring = HASH_VALUE (h, i); diff --git a/src/emacs-module.c b/src/emacs-module.c index 46bd732e8eb..283703b3651 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -412,7 +412,7 @@ module_global_reference_p (emacs_value v, ptrdiff_t *n) reference that's identical to some global reference. */ for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) { - if (!BASE_EQ (HASH_KEY (h, i), Qunbound) + if (!hash_unused_entry_key_p (HASH_KEY (h, i)) && &XMODULE_GLOBAL_REFERENCE (HASH_VALUE (h, i))->value == v) return true; } diff --git a/src/fns.c b/src/fns.c index 56b4e9a18c0..d8da8992ce9 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4575,7 +4575,7 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, h->rehash_threshold = rehash_threshold; h->rehash_size = rehash_size; h->count = 0; - h->key_and_value = make_vector (2 * size, Qunbound); + h->key_and_value = make_vector (2 * size, HASH_UNUSED_ENTRY_KEY); h->hash = make_nil_vector (size); h->next = make_vector (size, make_fixnum (-1)); h->index = make_vector (hash_index_size (h, size), make_fixnum (-1)); @@ -4678,7 +4678,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) Lisp_Object key_and_value = alloc_larger_vector (h->key_and_value, 2 * new_size); for (ptrdiff_t i = 2 * old_size; i < 2 * new_size; i++) - ASET (key_and_value, i, Qunbound); + ASET (key_and_value, i, HASH_UNUSED_ENTRY_KEY); Lisp_Object hash = alloc_larger_vector (h->hash, new_size); memclear (XVECTOR (hash)->contents + old_size, @@ -4782,7 +4782,7 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, /* Store key/value in the key_and_value vector. */ ptrdiff_t i = h->next_free; eassert (NILP (HASH_HASH (h, i))); - eassert (BASE_EQ (Qunbound, (HASH_KEY (h, i)))); + eassert (hash_unused_entry_key_p (HASH_KEY (h, i))); h->next_free = HASH_NEXT (h, i); set_hash_key_slot (h, i, key); set_hash_value_slot (h, i, value); @@ -4824,7 +4824,7 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) /* Clear slots in key_and_value and add the slots to the free list. */ - set_hash_key_slot (h, i, Qunbound); + set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); set_hash_hash_slot (h, i, Qnil); set_hash_next_slot (h, i, h->next_free); @@ -4851,7 +4851,7 @@ hash_clear (struct Lisp_Hash_Table *h) for (ptrdiff_t i = 0; i < size; i++) { set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1); - set_hash_key_slot (h, i, Qunbound); + set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); } @@ -4922,7 +4922,7 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) h->next_free = i; /* Clear key, value, and hash. */ - set_hash_key_slot (h, i, Qunbound); + set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); if (!NILP (h->hash)) set_hash_hash_slot (h, i, Qnil); @@ -5535,7 +5535,7 @@ FUNCTION is called with two arguments, KEY and VALUE. for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) { Lisp_Object k = HASH_KEY (h, i); - if (!BASE_EQ (k, Qunbound)) + if (!hash_unused_entry_key_p (k)) call2 (function, k, HASH_VALUE (h, i)); } diff --git a/src/json.c b/src/json.c index af5f30c7275..d98b312ecc9 100644 --- a/src/json.c +++ b/src/json.c @@ -364,7 +364,7 @@ lisp_to_json_nonscalar_1 (Lisp_Object lisp, for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) { Lisp_Object key = HASH_KEY (h, i); - if (!BASE_EQ (key, Qunbound)) + if (!hash_unused_entry_key_p (key)) { CHECK_STRING (key); Lisp_Object ekey = json_encode (key); diff --git a/src/lisp.h b/src/lisp.h index a34726adbcb..549b51d3f7f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2462,7 +2462,7 @@ struct Lisp_Hash_Table /* Vector of keys and values. The key of item I is found at index 2 * I, the value is found at index 2 * I + 1. - If the key is equal to Qunbound, then this slot is unused. + If the key is HASH_UNUSED_ENTRY_KEY, then this slot is unused. This is gc_marked specially if the table is weak. */ Lisp_Object key_and_value; @@ -2478,6 +2478,16 @@ struct Lisp_Hash_Table /* Sanity-check pseudovector layout. */ verify (offsetof (struct Lisp_Hash_Table, weak) == header_size); +/* Key value that marks an unused hash table entry. */ +#define HASH_UNUSED_ENTRY_KEY Qunbound + +/* KEY is a key of an unused hash table entry. */ +INLINE bool +hash_unused_entry_key_p (Lisp_Object key) +{ + return BASE_EQ (key, HASH_UNUSED_ENTRY_KEY); +} + INLINE bool HASH_TABLE_P (Lisp_Object a) { diff --git a/src/minibuf.c b/src/minibuf.c index f4f9da9c3f9..22bb8fa1d75 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1680,8 +1680,8 @@ or from one of the possible completions. */) else /* if (type == hash_table) */ { while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection)) - && BASE_EQ (HASH_KEY (XHASH_TABLE (collection), idx), - Qunbound)) + && hash_unused_entry_key_p (HASH_KEY (XHASH_TABLE (collection), + idx))) idx++; if (idx >= HASH_TABLE_SIZE (XHASH_TABLE (collection))) break; @@ -1918,8 +1918,8 @@ with a space are ignored unless STRING itself starts with a space. */) else /* if (type == 3) */ { while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection)) - && BASE_EQ (HASH_KEY (XHASH_TABLE (collection), idx), - Qunbound)) + && hash_unused_entry_key_p (HASH_KEY (XHASH_TABLE (collection), + idx))) idx++; if (idx >= HASH_TABLE_SIZE (XHASH_TABLE (collection))) break; @@ -2117,7 +2117,7 @@ the values STRING, PREDICATE and `lambda'. */) for (i = 0; i < HASH_TABLE_SIZE (h); ++i) { tem = HASH_KEY (h, i); - if (BASE_EQ (tem, Qunbound)) continue; + if (hash_unused_entry_key_p (tem)) continue; Lisp_Object strkey = (SYMBOLP (tem) ? Fsymbol_name (tem) : tem); if (!STRINGP (strkey)) continue; if (BASE_EQ (Fcompare_strings (string, Qnil, Qnil, diff --git a/src/print.c b/src/print.c index 26ed52b4653..e22f3b6778c 100644 --- a/src/print.c +++ b/src/print.c @@ -1290,7 +1290,7 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) for (i = 0; i < HASH_TABLE_SIZE (h); ++i) { Lisp_Object key = HASH_KEY (h, i); - if (!BASE_EQ (key, Qunbound) + if (!hash_unused_entry_key_p (key) && EQ (HASH_VALUE (h, i), Qt)) Fremhash (key, Vprint_number_table); } @@ -2770,7 +2770,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) { Lisp_Object key; ptrdiff_t idx = e->u.hash.idx; - while (BASE_EQ ((key = HASH_KEY (h, idx)), Qunbound)) + while (hash_unused_entry_key_p ((key = HASH_KEY (h, idx)))) idx++; e->u.hash.idx = idx; obj = key; -- cgit v1.2.3 From 4b7985db11c0fd3a3346a05f271eff9ad687851b Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 30 Nov 2023 14:57:51 +0100 Subject: ; * src/fns.c (Fmake_hash_table): ensure `test` is a bare symbol --- src/fns.c | 25 +++++++++++-------------- src/lisp.h | 2 +- 2 files changed, 12 insertions(+), 15 deletions(-) diff --git a/src/fns.c b/src/fns.c index d8da8992ce9..b1d152a15a9 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5299,10 +5299,6 @@ in an error. usage: (make-hash-table &rest KEYWORD-ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { - Lisp_Object test, weak; - bool purecopy; - struct hash_table_test testdesc; - ptrdiff_t i; USE_SAFE_ALLOCA; /* The vector `used' is used to keep track of arguments that @@ -5311,20 +5307,21 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) memset (used, 0, nargs * sizeof *used); /* See if there's a `:test TEST' among the arguments. */ - i = get_key_arg (QCtest, nargs, args, used); - test = i ? args[i] : Qeql; - if (EQ (test, Qeq)) + ptrdiff_t i = get_key_arg (QCtest, nargs, args, used); + Lisp_Object test = i ? args[i] : Qeql; + if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (test)) + test = SYMBOL_WITH_POS_SYM (test); + struct hash_table_test testdesc; + if (BASE_EQ (test, Qeq)) testdesc = hashtest_eq; - else if (EQ (test, Qeql)) + else if (BASE_EQ (test, Qeql)) testdesc = hashtest_eql; - else if (EQ (test, Qequal)) + else if (BASE_EQ (test, Qequal)) testdesc = hashtest_equal; else { /* See if it is a user-defined test. */ - Lisp_Object prop; - - prop = Fget (test, Qhash_table_test); + Lisp_Object prop = Fget (test, Qhash_table_test); if (!CONSP (prop) || !CONSP (XCDR (prop))) signal_error ("Invalid hash table test", test); testdesc.name = test; @@ -5336,7 +5333,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) /* See if there's a `:purecopy PURECOPY' argument. */ i = get_key_arg (QCpurecopy, nargs, args, used); - purecopy = i && !NILP (args[i]); + bool purecopy = i && !NILP (args[i]); /* See if there's a `:size SIZE' argument. */ i = get_key_arg (QCsize, nargs, args, used); Lisp_Object size_arg = i ? args[i] : Qnil; @@ -5370,7 +5367,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) /* Look for `:weakness WEAK'. */ i = get_key_arg (QCweakness, nargs, args, used); - weak = i ? args[i] : Qnil; + Lisp_Object weak = i ? args[i] : Qnil; if (EQ (weak, Qt)) weak = Qkey_and_value; if (!NILP (weak) diff --git a/src/lisp.h b/src/lisp.h index 549b51d3f7f..0421cb68c10 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2387,7 +2387,7 @@ struct Lisp_Hash_Table; struct hash_table_test { - /* Name of the function used to compare keys. */ + /* Function used to compare keys; always a bare symbol. */ Lisp_Object name; /* User-supplied hash function, or nil. */ -- cgit v1.2.3 From 8b7a6d7b6deca9346092501dbfa679e3e5ea5892 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 7 Jan 2024 18:52:48 +0100 Subject: ; * src/lisp.h (struct Lisp_Hash_Table): Add ASCII art. --- src/lisp.h | 28 +++++++++++++++++++++++++--- 1 file changed, 25 insertions(+), 3 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index 0421cb68c10..e80a6388657 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2405,11 +2405,33 @@ struct hash_table_test struct Lisp_Hash_Table { - /* Change pdumper.c if you change the fields here. */ - - /* This is for Lisp; the hash table code does not refer to it. */ union vectorlike_header header; + /* Hash table internal structure: + + Lisp key index table + | vector + | hash fn hash key value next + v +--+ +------+-------+------+----+ + hash value |-1| | C351 | cow | moo | -1 |<- + | +--+ +------+-------+------+----+ | + ------------>| -------->| 07A8 | cat | meow | -1 | | + range +--+ +------+-------+------+----+ | + reduction |-1| ->| 91D2 | dog | woof | ---- + +--+ | +------+-------+------+----+ + | ------ | ? |unbound| ? | -1 |<- + +--+ +------+-------+------+----+ | + | -------->| F6B0 | duck |quack | -1 | | + +--+ +------+-------+------+----+ | + |-1| ->| ? |unbound| ? | ---- + +--+ | +------+-------+------+----+ + : : | : : : : : + | + next_free + + The table is physically split into three vectors (hash, next, + key_and_value) which may or may not be beneficial. */ + /* Nil if table is non-weak. Otherwise a symbol describing the weakness of the table. */ Lisp_Object weak; -- cgit v1.2.3 From a764b503e126a60ff4ea1266da924de7b020637e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Jan 2024 17:50:09 -0500 Subject: (mwheel--is-dir-p): New macro to reduce code duplication It also slightly reduces memory allocation. * lisp/mwheel.el (mwheel--is-dir-p): New macro. (mwheel-scroll, mouse-wheel-text-scale) (mouse-wheel-global-text-scale): Use it. --- lisp/mwheel.el | 45 +++++++++++++++++++++++---------------------- 1 file changed, 23 insertions(+), 22 deletions(-) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 735adf42f68..84679f5c33f 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -305,6 +305,15 @@ active window." frame nil t))))) (mwheel-event-window event))) +(defmacro mwheel--is-dir-p (dir button) + (declare (debug (sexp form))) + (let ((custom-var (intern (format "mouse-wheel-%s-event" dir))) + (custom-var-alt (intern (format "mouse-wheel-%s-alternate-event" dir)))) + (macroexp-let2 nil butsym button + `(or (eq ,butsym ,custom-var) + ;; We presume here `button' is never nil. + (eq ,butsym ,custom-var-alt))))) + (defun mwheel-scroll (event &optional arg) "Scroll up or down according to the EVENT. This should be bound only to mouse buttons 4, 5, 6, and 7 on @@ -342,16 +351,14 @@ value of ARG, and the command uses it in subsequent scrolls." (condition-case nil (unwind-protect (let ((button (event-basic-type event))) - (cond ((and (eq amt 'hscroll) (memq button (list mouse-wheel-down-event - mouse-wheel-down-alternate-event))) + (cond ((and (eq amt 'hscroll) (mwheel--is-dir-p down button)) (when (and (natnump arg) (> arg 0)) (setq mouse-wheel-scroll-amount-horizontal arg)) (funcall (if mouse-wheel-flip-direction mwheel-scroll-left-function mwheel-scroll-right-function) mouse-wheel-scroll-amount-horizontal)) - ((memq button (list mouse-wheel-down-event - mouse-wheel-down-alternate-event)) + ((mwheel--is-dir-p down button) (condition-case nil (funcall mwheel-scroll-down-function amt) ;; Make sure we do indeed scroll to the beginning of ;; the buffer. @@ -366,31 +373,29 @@ value of ARG, and the command uses it in subsequent scrolls." ;; for a reason that escapes me. This problem seems ;; to only affect scroll-down. --Stef (set-window-start (selected-window) (point-min)))))) - ((and (eq amt 'hscroll) (memq button (list mouse-wheel-up-event - mouse-wheel-up-alternate-event))) + ((and (eq amt 'hscroll) (mwheel--is-dir-p up button)) (when (and (natnump arg) (> arg 0)) (setq mouse-wheel-scroll-amount-horizontal arg)) (funcall (if mouse-wheel-flip-direction mwheel-scroll-right-function mwheel-scroll-left-function) mouse-wheel-scroll-amount-horizontal)) - ((memq button (list mouse-wheel-up-event - mouse-wheel-up-alternate-event)) + ((mwheel--is-dir-p up button) (condition-case nil (funcall mwheel-scroll-up-function amt) ;; Make sure we do indeed scroll to the end of the buffer. (end-of-buffer (while t (funcall mwheel-scroll-up-function))))) - ((memq button (list mouse-wheel-left-event - mouse-wheel-left-alternate-event)) ; for tilt scroll + ((mwheel--is-dir-p left button) ; for tilt scroll (when mouse-wheel-tilt-scroll (funcall (if mouse-wheel-flip-direction mwheel-scroll-right-function - mwheel-scroll-left-function) amt))) - ((memq button (list mouse-wheel-right-event - mouse-wheel-right-alternate-event)) ; for tilt scroll + mwheel-scroll-left-function) + amt))) + ((mwheel--is-dir-p right button) ; for tilt scroll (when mouse-wheel-tilt-scroll (funcall (if mouse-wheel-flip-direction mwheel-scroll-left-function - mwheel-scroll-right-function) amt))) + mwheel-scroll-right-function) + amt))) (t (error "Bad binding in mwheel-scroll")))) (if (eq scroll-window selected-window) ;; If there is a temporarily active region, deactivate it if @@ -431,11 +436,9 @@ See also `text-scale-adjust'." (button (event-basic-type event))) (select-window scroll-window 'mark-for-redisplay) (unwind-protect - (cond ((memq button (list mouse-wheel-down-event - mouse-wheel-down-alternate-event)) + (cond ((mwheel--is-dir-p down button) (text-scale-increase 1)) - ((memq button (list mouse-wheel-up-event - mouse-wheel-up-alternate-event)) + ((mwheel--is-dir-p up button) (text-scale-decrease 1))) (select-window selected-window)))) @@ -445,11 +448,9 @@ See also `text-scale-adjust'." This invokes `global-text-scale-adjust', which see." (interactive (list last-input-event)) (let ((button (event-basic-type event))) - (cond ((memq button (list mouse-wheel-down-event - mouse-wheel-down-alternate-event)) + (cond ((mwheel--is-dir-p down button) (global-text-scale-adjust 1)) - ((memq button (list mouse-wheel-up-event - mouse-wheel-up-alternate-event)) + ((mwheel--is-dir-p up button) (global-text-scale-adjust -1))))) (defun mouse-wheel--add-binding (key fun) -- cgit v1.2.3 From 4edb77132de731f9d4cb2cffee2f8847eafdcc72 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 13 Jan 2024 09:51:59 +0800 Subject: Properly sort results for partial font specs * src/sfntfont.c (sfntfont_compare_font_entities): New function. (sfntfont_list): Sort matching font entities by the number of fields set, and mention why. --- src/sfntfont.c | 49 +++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 47 insertions(+), 2 deletions(-) diff --git a/src/sfntfont.c b/src/sfntfont.c index 1ad41deac70..860fc446184 100644 --- a/src/sfntfont.c +++ b/src/sfntfont.c @@ -1939,13 +1939,51 @@ sfntfont_desc_to_entity (struct sfnt_font_desc *desc, int instance) return entity; } +/* Return whether fewer fields inside the font entity A are set than + there are set inside the font entity B. */ + +static Lisp_Object +sfntfont_compare_font_entities (Lisp_Object a, Lisp_Object b) +{ + ptrdiff_t count_a, count_b, i; + + count_a = 0; + count_b = 0; + + for (i = 0; i < FONT_ENTITY_MAX; ++i) + { + if (!NILP (AREF (a, i))) + count_a++; + } + + for (i = 0; i < FONT_ENTITY_MAX; ++i) + { + if (!NILP (AREF (b, i))) + count_b++; + } + + return count_a < count_b ? Qt : Qnil; +} + +/* Function that compares two font entities to return whether fewer + fields are set within the first than in the second. */ + +static union Aligned_Lisp_Subr Scompare_font_entities = + { + { + { PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS), }, + { .a2 = sfntfont_compare_font_entities, }, + 2, 2, "sfntfont_compare_font_entities", {0}, lisp_h_Qnil, + }, + }; + /* Return a list of font-entities matching the specified FONT_SPEC. */ Lisp_Object sfntfont_list (struct frame *f, Lisp_Object font_spec) { - Lisp_Object matching, tem; + Lisp_Object matching, tem, compare_font_entities; struct sfnt_font_desc *desc; int i, rc, instances[100]; @@ -1982,9 +2020,16 @@ sfntfont_list (struct frame *f, Lisp_Object font_spec) matching); } } - unblock_input (); + /* Sort matching by the number of fields set inside each element, so + that values of FONT_SPECs that leave a number of fields + unspecified will yield a list with the closest matches (that is + to say, those whose fields are precisely as specified by the + caller) ordered first. */ + + XSETSUBR (compare_font_entities, &Scompare_font_entities.s); + matching = Fsort (matching, compare_font_entities); return matching; } -- cgit v1.2.3 From ec16b69e7f0b9437e998688cb2877cc425edb70b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 13 Jan 2024 08:30:50 +0200 Subject: * src/fns.c (maybe_resize_hash_table): Fix EMACS_INT format specifier. --- src/fns.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fns.c b/src/fns.c index b1d152a15a9..89434e02ca3 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4702,7 +4702,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) #ifdef ENABLE_CHECKING if (HASH_TABLE_P (Vpurify_flag) && XHASH_TABLE (Vpurify_flag) == h) - message ("Growing hash table to: %"pD"d", new_size); + message ("Growing hash table to: %"pI"d", new_size); #endif } } -- cgit v1.2.3 From 1bfc7fd33d78ff29ee62f5a6b7d7769c1f8099c8 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 13 Jan 2024 10:18:03 +0100 Subject: Prefer AREF in GET_TRANSLATION_TABLE * src/ccl.c (GET_TRANSLATION_TABLE): Prefer using AREF to depending on vector internals. --- src/ccl.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ccl.c b/src/ccl.c index 1d3ad010382..b4dda404b95 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -873,7 +873,7 @@ static struct ccl_prog_stack ccl_prog_stack_struct[256]; static inline Lisp_Object GET_TRANSLATION_TABLE (int id) { - return XCDR (XVECTOR (Vtranslation_table_vector)->contents[id]); + return XCDR (AREF (Vtranslation_table_vector, id)); } void -- cgit v1.2.3 From 893829021bd50604b035c058814f280c7386aa46 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 13 Jan 2024 10:20:41 +0100 Subject: Fix NULL dereference in w32notify.c * src/w32notify.c (start_watching): Return NULL instead of freed pointer. (add_watch): Fix NULL dereference. --- src/w32notify.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/w32notify.c b/src/w32notify.c index 9f8a62a1daa..c93e8796fe2 100644 --- a/src/w32notify.c +++ b/src/w32notify.c @@ -350,6 +350,7 @@ start_watching (const char *file, HANDLE hdir, BOOL subdirs, DWORD flags) xfree (dirwatch->io_info); xfree (dirwatch->watchee); xfree (dirwatch); + return NULL; } return dirwatch; } @@ -412,10 +413,7 @@ add_watch (const char *parent_dir, const char *file, BOOL subdirs, DWORD flags) return NULL; if ((dirwatch = start_watching (file, hdir, subdirs, flags)) == NULL) - { - CloseHandle (hdir); - dirwatch->dir = NULL; - } + CloseHandle (hdir); return dirwatch; } -- cgit v1.2.3 From a08e6423ccc94ff51367768c2d13e549204f9f46 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 13 Jan 2024 11:23:43 +0200 Subject: ; * doc/emacs/fixit.texi (Spelling): Fix last change. --- doc/emacs/fixit.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi index a972ed698f7..6fa707ba2cc 100644 --- a/doc/emacs/fixit.texi +++ b/doc/emacs/fixit.texi @@ -402,7 +402,7 @@ when you started spell-checking. Quit interactive spell-checking and kill the spell-checker subprocess. @item C-r -Enter recursive-edit (@pxref{Recursive Editing}). When you exit +Enter recursive-edit (@pxref{Recursive Edit}). When you exit recursive-edit with @kbd{C-M-c}, the interactive spell-checking will resume. This allows you to consult the buffer text without interrupting the spell-checking. Do @emph{not} modify the buffer in -- cgit v1.2.3 From f2cc8ee2a1a106f9045447a1a025572d7938647e Mon Sep 17 00:00:00 2001 From: kobarity Date: Sat, 6 Jan 2024 22:04:42 +0900 Subject: Fix 'python-info-docstring-p' bug in the 2nd line of a buffer * lisp/progmodes/python.el (python-info-docstring-p): Add 'looking-at-p' check when bobp. * test/lisp/progmodes/python-tests.el (python-font-lock-operator-1) (python-font-lock-operator-2): Restoration of ERTs deleted by mistake. (python-font-lock-escape-sequence-bytes-newline) (python-font-lock-escape-sequence-hex-octal) (python-font-lock-escape-sequence-unicode) (python-font-lock-raw-escape-sequence): Change 'font-lock-doc-face' to 'font-lock-string-face' and remove :expected-result :failed. (python-info-docstring-p-8): New test. (Bug#68284) --- lisp/progmodes/python.el | 4 +- test/lisp/progmodes/python-tests.el | 73 +++++++++++++++++++++++++------------ 2 files changed, 53 insertions(+), 24 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 1148da11a06..a44d4215d7c 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -6260,7 +6260,9 @@ point's current `syntax-ppss'." counter))) (python-util-forward-comment -1) (python-nav-beginning-of-statement) - (cond ((bobp)) + (cond ((and (bobp) (save-excursion + (python-util-forward-comment) + (looking-at-p re)))) ((python-info-assignment-statement-p) t) ((python-info-looking-at-beginning-of-defun)) (t nil)))))) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 1df0c42a0ce..97ffd5fe20f 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -474,6 +474,28 @@ def f(x: CustomInt) -> CustomInt: (136 . font-lock-operator-face) (137) (144 . font-lock-keyword-face) (150)))) +(ert-deftest python-font-lock-operator-1 () + (python-tests-assert-faces + "1 << 2 ** 3 == +4%-5|~6&7^8%9" + '((1) + (3 . font-lock-operator-face) (5) + (8 . font-lock-operator-face) (10) + (13 . font-lock-operator-face) (15) + (16 . font-lock-operator-face) (17) + (18 . font-lock-operator-face) (20) + (21 . font-lock-operator-face) (23) + (24 . font-lock-operator-face) (25) + (26 . font-lock-operator-face) (27) + (28 . font-lock-operator-face) (29)))) + +(ert-deftest python-font-lock-operator-2 () + "Keyword operators are font-locked as keywords." + (python-tests-assert-faces + "is_ is None" + '((1) + (5 . font-lock-keyword-face) (7) + (8 . font-lock-constant-face)))) + (ert-deftest python-font-lock-escape-sequence-string-newline () (python-tests-assert-faces "'\\n' @@ -585,62 +607,58 @@ u\"\\n\"" (845 . font-lock-string-face) (886)))) (ert-deftest python-font-lock-escape-sequence-bytes-newline () - :expected-result :failed (python-tests-assert-faces "b'\\n' b\"\\n\"" '((1) - (2 . font-lock-doc-face) + (2 . font-lock-string-face) (3 . font-lock-constant-face) - (5 . font-lock-doc-face) (6) - (8 . font-lock-doc-face) + (5 . font-lock-string-face) (6) + (8 . font-lock-string-face) (9 . font-lock-constant-face) - (11 . font-lock-doc-face)))) + (11 . font-lock-string-face)))) (ert-deftest python-font-lock-escape-sequence-hex-octal () - :expected-result :failed (python-tests-assert-faces "b'\\x12 \\777 \\1\\23' '\\x12 \\777 \\1\\23'" '((1) - (2 . font-lock-doc-face) + (2 . font-lock-string-face) (3 . font-lock-constant-face) - (7 . font-lock-doc-face) + (7 . font-lock-string-face) (8 . font-lock-constant-face) - (12 . font-lock-doc-face) + (12 . font-lock-string-face) (13 . font-lock-constant-face) - (18 . font-lock-doc-face) (19) - (20 . font-lock-doc-face) + (18 . font-lock-string-face) (19) + (20 . font-lock-string-face) (21 . font-lock-constant-face) - (25 . font-lock-doc-face) + (25 . font-lock-string-face) (26 . font-lock-constant-face) - (30 . font-lock-doc-face) + (30 . font-lock-string-face) (31 . font-lock-constant-face) - (36 . font-lock-doc-face)))) + (36 . font-lock-string-face)))) (ert-deftest python-font-lock-escape-sequence-unicode () - :expected-result :failed (python-tests-assert-faces "b'\\u1234 \\U00010348 \\N{Plus-Minus Sign}' '\\u1234 \\U00010348 \\N{Plus-Minus Sign}'" '((1) - (2 . font-lock-doc-face) (41) - (42 . font-lock-doc-face) + (2 . font-lock-string-face) (41) + (42 . font-lock-string-face) (43 . font-lock-constant-face) - (49 . font-lock-doc-face) + (49 . font-lock-string-face) (50 . font-lock-constant-face) - (60 . font-lock-doc-face) + (60 . font-lock-string-face) (61 . font-lock-constant-face) - (80 . font-lock-doc-face)))) + (80 . font-lock-string-face)))) (ert-deftest python-font-lock-raw-escape-sequence () - :expected-result :failed (python-tests-assert-faces "rb'\\x12 \123 \\n' r'\\x12 \123 \\n \\u1234 \\U00010348 \\N{Plus-Minus Sign}'" '((1) - (3 . font-lock-doc-face) (14) - (16 . font-lock-doc-face)))) + (3 . font-lock-string-face) (14) + (16 . font-lock-string-face)))) ;;; Indentation @@ -6647,6 +6665,15 @@ class Class: (python-tests-look-at "Also not a docstring") (should-not (python-info-docstring-p)))) +(ert-deftest python-info-docstring-p-8 () + "Test string in the 2nd line of a buffer." + (python-tests-with-temp-buffer + "import sys +'''Not a docstring.''' +" + (python-tests-look-at "Not a docstring") + (should-not (python-info-docstring-p)))) + (ert-deftest python-info-triple-quoted-string-p-1 () "Test triple quoted string." (python-tests-with-temp-buffer -- cgit v1.2.3 From 9b8b352ebc09de3259f655fa4d491507109044b3 Mon Sep 17 00:00:00 2001 From: Steven Allen Date: Sat, 6 Jan 2024 09:19:12 -0800 Subject: Set the 'name' prop in 'define-advice' In addition to naming the advice function `symbol@name', set the 'name' property to NAME. * lisp/emacs-lisp/nadvice.el (define-advice): set the 'name' property to NAME (requested in Bug#68114). Fixes Bug#68294. * doc/lispref/functions.texi (Advising Named Functions): Document that 'define-advice' installs the advice with the specified name. --- doc/lispref/functions.texi | 7 ++++--- etc/NEWS | 6 ++++++ lisp/emacs-lisp/nadvice.el | 8 +++++--- 3 files changed, 15 insertions(+), 6 deletions(-) diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 29e9f04a076..29061e6561c 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -2066,9 +2066,10 @@ code) obey the advice and other calls (from C code) do not. @defmac define-advice symbol (where lambda-list &optional name depth) &rest body This macro defines a piece of advice and adds it to the function named -@var{symbol}. The advice is an anonymous function if @var{name} is -@code{nil} or a function named @code{symbol@@name}. See -@code{advice-add} for explanation of other arguments. +@var{symbol}. If @var{name} is non-nil, the advice is named +@code{@var{symbol}@@@var{name}} and installed with the name @var{name}; otherwise, +the advice is anonymous. See @code{advice-add} for explanation of +other arguments. @end defmac @defun advice-add symbol where function &optional props diff --git a/etc/NEWS b/etc/NEWS index bce33f96aee..5cf3e821627 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1410,6 +1410,12 @@ values. * Lisp Changes in Emacs 30.1 ++++ +** 'define-advice' now sets the new advice's 'name' property to NAME +Named advice defined with 'define-advice' can now be removed with +'(advice-remove SYMBOL NAME)' in addition to '(advice-remove SYMBOL +SYMBOL@NAME)'. + +++ ** New function 'require-with-check' to detect new versions shadowing. This is like 'require', but it checks whether the argument 'feature' diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index de287e43b21..7524ab18e58 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -585,8 +585,8 @@ of the piece of advice." (defmacro define-advice (symbol args &rest body) "Define an advice and add it to function named SYMBOL. See `advice-add' and `add-function' for explanation on the -arguments. Note if NAME is nil the advice is anonymous; -otherwise it is named `SYMBOL@NAME'. +arguments. If NAME is non-nil, the advice is named `SYMBOL@NAME' +and installed with the name NAME; otherwise, the advice is anonymous. \(fn SYMBOL (HOW LAMBDA-LIST &optional NAME DEPTH) &rest BODY)" (declare (indent 2) (doc-string 3) (debug (sexp sexp def-body))) @@ -597,7 +597,9 @@ otherwise it is named `SYMBOL@NAME'. (lambda-list (nth 1 args)) (name (nth 2 args)) (depth (nth 3 args)) - (props (and depth `((depth . ,depth)))) + (props (append + (and depth `((depth . ,depth))) + (and name `((name . ,name))))) (advice (cond ((null name) `(lambda ,lambda-list ,@body)) ((or (stringp name) (symbolp name)) (intern (format "%s@%s" symbol name))) -- cgit v1.2.3 From c494a6e879dfeecb0cec3e9ae7bc0d3c682a9185 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 13 Jan 2024 12:01:47 +0200 Subject: Improve documentation of 'emacs_function' in modules * doc/lispref/internals.texi (Module Functions): Warn about accessing the ARGS array in module functions. --- doc/lispref/internals.texi | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 41777a7a303..333a5897837 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1371,6 +1371,15 @@ objects between Emacs and the module (@pxref{Module Values}). The provides facilities for conversion between basic C data types and the corresponding @code{emacs_value} objects. +In the module function's body, do @emph{not} attempt to access +elements of the @var{args} array beyond the index +@code{@var{nargs}-1}: memory for the @var{args} array is allocated +exactly to accommodate @var{nargs} values, and accessing beyond that +will most probably crash your module. In particular, if the value of +@var{nargs} passed to the function at run time is zero, it must not +access @var{args} at all, as no memory will have been allocated for it +in that case. + A module function always returns a value. If the function returns normally, the Lisp code which called it will see the Lisp object corresponding to the @code{emacs_value} value the function returned. -- cgit v1.2.3 From 740953d1a2f4ea4a200637872b9ecb7dfddfdbe4 Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Tue, 2 Jan 2024 09:06:13 +0100 Subject: Fix 'what-page' * lisp/textmodes/page.el (page--what-page): Adjust for 1st line on page, and use 'count-lines' again. (Bug#68215) * test/lisp/textmodes/page-tests.el (page-tests-what-page): Update test. --- lisp/textmodes/page.el | 8 +++++--- test/lisp/textmodes/page-tests.el | 6 +++++- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el index e8621ee0383..1c7561d71c6 100644 --- a/lisp/textmodes/page.el +++ b/lisp/textmodes/page.el @@ -159,21 +159,23 @@ point, respectively." total before after))) (defun page--what-page () - "Return a list of the page and line number of point." + "Return a list of the page and line number of point. +The line number is relative to the start of the page." (save-restriction (widen) (save-excursion (let ((count 1) + (adjust (if (or (bolp) (looking-back page-delimiter)) 1 0)) (opoint (point))) (goto-char (point-min)) (while (re-search-forward page-delimiter opoint t) (when (= (match-beginning 0) (match-end 0)) (forward-char)) (setq count (1+ count))) - (list count (line-number-at-pos opoint)))))) + (list count (+ adjust (count-lines (point) opoint))))))) (defun what-page () - "Print page and line number of point." + "Display the page number, and the line number within that page." (interactive) (apply #'message (cons "Page %d, line %d" (page--what-page)))) diff --git a/test/lisp/textmodes/page-tests.el b/test/lisp/textmodes/page-tests.el index f3a2c5fbe00..617b59a54fb 100644 --- a/test/lisp/textmodes/page-tests.el +++ b/test/lisp/textmodes/page-tests.el @@ -106,10 +106,14 @@ (insert "foo\n \nbar\n \nbaz") (goto-char (point-min)) (should (equal (page--what-page) '(1 1))) + (forward-char) + (should (equal (page--what-page) '(1 1))) (forward-page) + (should (equal (page--what-page) '(2 1))) + (next-line) (should (equal (page--what-page) '(2 2))) (forward-page) - (should (equal (page--what-page) '(3 4))))) + (should (equal (page--what-page) '(3 1))))) ;;; page-tests.el ends here -- cgit v1.2.3 From 106cd9aafe8248ef91d7e89161adc5f912ea54eb Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 13 Jan 2024 12:45:10 +0200 Subject: ; * lisp/textmodes/page.el (page--what-page): Fix last change. --- lisp/textmodes/page.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el index 1c7561d71c6..a5de354fc0a 100644 --- a/lisp/textmodes/page.el +++ b/lisp/textmodes/page.el @@ -165,7 +165,7 @@ The line number is relative to the start of the page." (widen) (save-excursion (let ((count 1) - (adjust (if (or (bolp) (looking-back page-delimiter)) 1 0)) + (adjust (if (or (bolp) (looking-back page-delimiter nil)) 1 0)) (opoint (point))) (goto-char (point-min)) (while (re-search-forward page-delimiter opoint t) -- cgit v1.2.3 From aaf3b633978f44a4e0647161e06c7dbb54ad9d5c Mon Sep 17 00:00:00 2001 From: Xiyue Deng Date: Sat, 13 Jan 2024 18:08:49 +0100 Subject: Fix typo in lispref "Creating Strings" section * doc/lispref/strings.texi (String Basics): Fix typo (bug#68375). --- doc/lispref/strings.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 7097de49064..4fe94f78cba 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -43,7 +43,7 @@ integer is a character or not is determined only by how it is used. Emacs. A string is a fixed sequence of characters. It is a type of -sequence called a @dfn{array}, meaning that its length is fixed and +sequence called an @dfn{array}, meaning that its length is fixed and cannot be altered once it is created (@pxref{Sequences Arrays Vectors}). Unlike in C, Emacs Lisp strings are @emph{not} terminated by a distinguished character code. -- cgit v1.2.3 From 51f391998b19a94d35d743952006afd71ad7f545 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 13 Jan 2024 20:11:21 +0200 Subject: Add @kindex in manuals for existing keybindings on 'C-x x/w' (bug#13167) * doc/emacs/buffers.texi (Misc Buffer): Add @kindex for 'C-x x r', 'C-x x u', 'C-x x i'. * doc/emacs/display.texi (Line Truncation): Add @kindex for 'C-x x t'. * doc/emacs/files.texi (Reverting): Add @kindex for 'C-x x g'. * doc/emacs/windows.texi (Change Window): Use new keybinding 'C-x w 0' instead of 'M-x delete-windows-on'. * doc/misc/info.texi (Create Info buffer): Add @kindex for 'C-x x n'. --- doc/emacs/buffers.texi | 3 +++ doc/emacs/display.texi | 1 + doc/emacs/files.texi | 1 + doc/emacs/windows.texi | 2 +- doc/misc/info.texi | 1 + 5 files changed, 7 insertions(+), 1 deletion(-) diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi index c592eec555d..8542243dadf 100644 --- a/doc/emacs/buffers.texi +++ b/doc/emacs/buffers.texi @@ -262,12 +262,14 @@ non-@code{nil}. If you change the option @code{view-read-only} to a non-@code{nil} value, making the buffer read-only with @kbd{C-x C-q} also enables View mode in the buffer (@pxref{View Mode}). +@kindex C-x x r @findex rename-buffer @kbd{C-x x r} (@code{rename-buffer} changes the name of the current buffer. You specify the new name as a minibuffer argument; there is no default. If you specify a name that is in use for some other buffer, an error happens and no renaming is done. +@kindex C-x x u @findex rename-uniquely @kbd{C-x x u} (@code{rename-uniquely}) renames the current buffer to a similar name with a numeric suffix added to make it both different @@ -282,6 +284,7 @@ buffers with particular names. (With some of these features, such as buffer before using the command again, otherwise it will reuse the current buffer despite the name change.) +@kindex C-x x i The commands @kbd{M-x append-to-buffer} and @kbd{C-x x i} (@code{insert-buffer}) can also be used to copy text from one buffer to another. @xref{Accumulating Text}. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index e6a43bf74a8..6db9e8344c6 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1986,6 +1986,7 @@ the fringe indicates truncation at either end of the line. On text terminals, this is indicated with @samp{$} signs in the rightmost and/or leftmost columns. +@kindex C-x x t @vindex truncate-lines @findex toggle-truncate-lines Horizontal scrolling automatically causes line truncation diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 44c58800197..36f72d42ba2 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1062,6 +1062,7 @@ revert it automatically if it has changed---provided the buffer itself is not modified. (If you have edited the text, it would be wrong to discard your changes.) +@kindex C-x x g @vindex revert-buffer-quick-short-answers @findex revert-buffer-quick The @kbd{C-x x g} keystroke is bound to the diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi index db3dea1d06e..302d3dcbf8c 100644 --- a/doc/emacs/windows.texi +++ b/doc/emacs/windows.texi @@ -287,7 +287,7 @@ Delete all windows in the selected frame except the selected window Delete the selected window and kill the buffer that was showing in it (@code{kill-buffer-and-window}). The last character in this key sequence is a zero. -@item M-x delete-windows-on @key{RET} @var{buffer} @key{RET} +@item C-x w 0 @key{RET} @var{buffer} @key{RET} Delete windows showing the specified @var{buffer}. @item C-x ^ Make selected window taller (@code{enlarge-window}). diff --git a/doc/misc/info.texi b/doc/misc/info.texi index 31b314cb9a0..01c7f614e7d 100644 --- a/doc/misc/info.texi +++ b/doc/misc/info.texi @@ -1148,6 +1148,7 @@ move between menu items. @section @kbd{M-n} creates a new independent Info buffer in Emacs @kindex M-n @r{(Info mode)} +@kindex C-x x n @findex clone-buffer @cindex multiple Info buffers If you are reading Info in Emacs, you can select a new independent -- cgit v1.2.3 From 76904626b36910b511d3b0a3e56cc80af90d9361 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 13 Jan 2024 20:16:42 +0200 Subject: * lisp/window.el (window-prefix-map): Bind C-x w q to quit-window (bug#13167) --- lisp/window.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/window.el b/lisp/window.el index e100f25526b..23977691f50 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -10813,7 +10813,8 @@ Used in `repeat-mode'." "^ f" #'tear-off-window "^ t" #'tab-window-detach "-" #'fit-window-to-buffer - "0" #'delete-windows-on) + "0" #'delete-windows-on + "q" #'quit-window) (define-key ctl-x-map "w" window-prefix-map) (provide 'window) -- cgit v1.2.3 From 1f97a8787957e49f1893b9ac73c95228f6ac1a13 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 13 Jan 2024 20:38:34 +0200 Subject: Fix info-xref-tests * doc/lispintro/emacs-lisp-intro.texi (How let Binds Variables): Fix cross-reference. (Bug#68428) * test/lisp/info-xref-tests.el (info-xref-test-write-file): Fix test on MS-Windows when run from MSYS Bash. --- doc/lispintro/emacs-lisp-intro.texi | 2 +- test/lisp/info-xref-tests.el | 10 +++++++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index b3fe8ce4589..a06822ce539 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -3769,7 +3769,7 @@ the first line of your Emacs Lisp file: ;;; -*- lexical-binding: t -*- @end example -For more information about this, @pxref{Selecting Lisp Dialect, , , +For more information about this, @pxref{Variable Scoping, , , elisp, The Emacs Lisp Reference Manual}. @menu diff --git a/test/lisp/info-xref-tests.el b/test/lisp/info-xref-tests.el index 72b6706a22c..c8eb18501f3 100644 --- a/test/lisp/info-xref-tests.el +++ b/test/lisp/info-xref-tests.el @@ -92,7 +92,15 @@ text. " ) (write-region nil nil file nil 'silent)) - (should (equal 0 (call-process "makeinfo" file)))) + (if (and (eq system-type 'windows-nt) + (executable-find "sh")) + ;; If we are running from MSYS Bash, makeinfo.bat might find the + ;; wrong version of Perl, so make sure to run the shell script + ;; named just 'makeinfo' instead, because it names the correct + ;; Perl. + (should (equal 0 (call-process "sh" nil t nil + "-c" (format "makeinfo '%s'" file)))) + (should (equal 0 (call-process "makeinfo" file))))) (ert-deftest info-xref-test-makeinfo () "Test that info-xref can parse basic makeinfo output." -- cgit v1.2.3 From 4ba6954e69528f89dc12bf968dec845601b1b24b Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 26 Oct 2023 18:04:11 +0200 Subject: * src/print.c (print_object): Don't print hash table test if `eql`. Since `eql` is the default, this ensures bidirectional compatibility while reducing the size of the external representation. --- src/print.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/print.c b/src/print.c index e22f3b6778c..0a5f2ee48d4 100644 --- a/src/print.c +++ b/src/print.c @@ -2580,7 +2580,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) HASH_TABLE_SIZE (h)); strout (buf, len, len, printcharfun); - if (!NILP (h->test.name)) + if (!BASE_EQ (h->test.name, Qeql)) { print_c_string (" test ", printcharfun); print_object (h->test.name, printcharfun, escapeflag); -- cgit v1.2.3 From a09619f2598a1658feac6794e85bc61a07c4855f Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 2 Nov 2023 11:10:24 +0100 Subject: * src/print.c (print_object): Don't print empty hash-table data Since no data is the default, this preserves bidirectional compatibility. --- src/print.c | 37 +++++++++++++++++++++++-------------- test/src/print-tests.el | 7 ------- 2 files changed, 23 insertions(+), 21 deletions(-) diff --git a/src/print.c b/src/print.c index 0a5f2ee48d4..d011962d85b 100644 --- a/src/print.c +++ b/src/print.c @@ -2603,21 +2603,30 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) if (h->purecopy) print_c_string (" purecopy t", printcharfun); - print_c_string (" data (", printcharfun); - ptrdiff_t size = h->count; - /* Don't print more elements than the specified maximum. */ - if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size) - size = XFIXNAT (Vprint_length); - - print_stack_push ((struct print_stack_entry){ - .type = PE_hash, - .u.hash.obj = obj, - .u.hash.nobjs = size * 2, - .u.hash.idx = 0, - .u.hash.printed = 0, - .u.hash.truncated = (size < h->count), - }); + if (size > 0) + { + print_c_string (" data (", printcharfun); + + /* Don't print more elements than the specified maximum. */ + if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size) + size = XFIXNAT (Vprint_length); + + print_stack_push ((struct print_stack_entry){ + .type = PE_hash, + .u.hash.obj = obj, + .u.hash.nobjs = size * 2, + .u.hash.idx = 0, + .u.hash.printed = 0, + .u.hash.truncated = (size < h->count), + }); + } + else + { + /* Empty table: we can omit the data entirely. */ + printchar (')', printcharfun); + --print_depth; /* Done with this. */ + } goto next_obj; } diff --git a/test/src/print-tests.el b/test/src/print-tests.el index aedaa9a4e06..ff3a6fe7483 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -367,13 +367,6 @@ otherwise, use a different charset." (remhash 1 h) (format "%S" h)))) - (should - (string-match - "data ()" - (let ((h (make-hash-table))) - (let ((print-length 0)) - (format "%S" h))))) - (should (string-match "data (99 99)" -- cgit v1.2.3 From 3f9c81a87f7bce854489b8232d817b536ccf349b Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 26 Oct 2023 18:36:05 +0200 Subject: Don't print or read the hash table size parameter It's not a meaningful part of the external representation. This allows for faster printing and reading, smaller external representation, and less memory consumption. * src/print.c (print_object): Omit size. * src/lread.c (hash_table_from_plist): Take size from the data. --- src/lread.c | 17 +++++++++-------- src/print.c | 7 ++----- 2 files changed, 11 insertions(+), 13 deletions(-) diff --git a/src/lread.c b/src/lread.c index e95dafcf222..18894801376 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3426,7 +3426,6 @@ hash_table_from_plist (Lisp_Object plist) } \ } while (0) - ADDPARAM (size); ADDPARAM (test); ADDPARAM (weakness); ADDPARAM (rehash_size); @@ -3434,23 +3433,25 @@ hash_table_from_plist (Lisp_Object plist) ADDPARAM (purecopy); Lisp_Object data = plist_get (plist, Qdata); + if (!(NILP (data) || CONSP (data))) + error ("Hash table data is not a list"); + ptrdiff_t data_len = list_length (data); + if (data_len & 1) + error ("Hash table data length is odd"); + *par++ = QCsize; + *par++ = make_fixnum (data_len / 2); /* Now use params to make a new hash table and fill it. */ Lisp_Object ht = Fmake_hash_table (par - params, params); - Lisp_Object last = data; - FOR_EACH_TAIL_SAFE (data) + while (!NILP (data)) { Lisp_Object key = XCAR (data); data = XCDR (data); - if (!CONSP (data)) - break; Lisp_Object val = XCAR (data); - last = XCDR (data); Fputhash (key, val, ht); + data = XCDR (data); } - if (!NILP (last)) - error ("Hash table data is not a list of even length"); return ht; } diff --git a/src/print.c b/src/print.c index d011962d85b..c1c91b2383a 100644 --- a/src/print.c +++ b/src/print.c @@ -2574,11 +2574,8 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) { struct Lisp_Hash_Table *h = XHASH_TABLE (obj); /* Implement a readable output, e.g.: - #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */ - /* Always print the size. */ - int len = sprintf (buf, "#s(hash-table size %"pD"d", - HASH_TABLE_SIZE (h)); - strout (buf, len, len, printcharfun); + #s(hash-table test equal data (k1 v1 k2 v2)) */ + print_c_string ("#s(hash-table", printcharfun); if (!BASE_EQ (h->test.name, Qeql)) { -- cgit v1.2.3 From c6bdc1ea1dc7f9a0b6d92d443f34c42affde73d1 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 26 Oct 2023 15:49:32 +0200 Subject: Represent hash table weakness as an enum internally This takes less space (saves an entire word) and is more type-safe. No change in behaviour. * src/lisp.h (hash_table_weakness_t): New. (struct Lisp_Hash_Table): Replace Lisp object `weak` with enum `weakness`. * src/fns.c (keep_entry_p, hash_table_weakness_symbol): New. (make_hash_table): Retype argument. All callers updated. (sweep_weak_table, Fmake_hash_table, Fhash_table_weakness): * src/alloc.c (purecopy_hash_table, purecopy, process_mark_stack): * src/pdumper.c (dump_hash_table): * src/print.c (print_object): Use retyped field. --- src/alloc.c | 6 ++--- src/category.c | 2 +- src/emacs-module.c | 2 +- src/fns.c | 77 ++++++++++++++++++++++++++++++++++++------------------ src/frame.c | 2 +- src/image.c | 2 +- src/lisp.h | 24 ++++++++++++----- src/lread.c | 8 +++--- src/pdumper.c | 1 + src/pgtkterm.c | 3 ++- src/print.c | 5 ++-- src/profiler.c | 2 +- src/xfaces.c | 2 +- src/xterm.c | 2 +- 14 files changed, 89 insertions(+), 49 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index af9c169a3a0..17ed711a318 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5887,7 +5887,7 @@ make_pure_vector (ptrdiff_t len) static struct Lisp_Hash_Table * purecopy_hash_table (struct Lisp_Hash_Table *table) { - eassert (NILP (table->weak)); + eassert (table->weakness == Weak_None); eassert (table->purecopy); struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike); @@ -5960,7 +5960,7 @@ purecopy (Lisp_Object obj) /* Do not purify hash tables which haven't been defined with :purecopy as non-nil or are weak - they aren't guaranteed to not change. */ - if (!NILP (table->weak) || !table->purecopy) + if (table->weakness != Weak_None || !table->purecopy) { /* Instead, add the hash table to the list of pinned objects, so that it will be marked during GC. */ @@ -7233,7 +7233,7 @@ process_mark_stack (ptrdiff_t base_sp) mark_stack_push_value (h->test.name); mark_stack_push_value (h->test.user_hash_function); mark_stack_push_value (h->test.user_cmp_function); - if (NILP (h->weak)) + if (h->weakness == Weak_None) mark_stack_push_value (h->key_and_value); else { diff --git a/src/category.c b/src/category.c index b539bad31eb..67429e82571 100644 --- a/src/category.c +++ b/src/category.c @@ -53,7 +53,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set) (table, 1, make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false)); + Weak_None, false)); struct Lisp_Hash_Table *h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); Lisp_Object hash; ptrdiff_t i = hash_lookup (h, category_set, &hash); diff --git a/src/emacs-module.c b/src/emacs-module.c index 283703b3651..44c3efd1440 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1699,7 +1699,7 @@ syms_of_module (void) Vmodule_refs_hash = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false); + Weak_None, false); DEFSYM (Qmodule_load_failed, "module-load-failed"); Fput (Qmodule_load_failed, Qerror_conditions, diff --git a/src/fns.c b/src/fns.c index 89434e02ca3..5837795f838 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4541,8 +4541,7 @@ hash_index_size (struct Lisp_Hash_Table *h, ptrdiff_t size) be resized when the approximate ratio of table entries to table size exceeds REHASH_THRESHOLD. - WEAK specifies the weakness of the table. If non-nil, it must be - one of the symbols `key', `value', `key-or-value', or `key-and-value'. + WEAK specifies the weakness of the table. If PURECOPY is non-nil, the table can be copied to pure storage via `purecopy' when Emacs is being dumped. Such tables can no longer be @@ -4551,7 +4550,7 @@ hash_index_size (struct Lisp_Hash_Table *h, ptrdiff_t size) Lisp_Object make_hash_table (struct hash_table_test test, EMACS_INT size, float rehash_size, float rehash_threshold, - Lisp_Object weak, bool purecopy) + hash_table_weakness_t weak, bool purecopy) { struct Lisp_Hash_Table *h; Lisp_Object table; @@ -4571,7 +4570,7 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, /* Initialize hash table slots. */ h->test = test; - h->weak = weak; + h->weakness = weak; h->rehash_threshold = rehash_threshold; h->rehash_size = rehash_size; h->count = 0; @@ -4869,6 +4868,23 @@ hash_clear (struct Lisp_Hash_Table *h) Weak Hash Tables ************************************************************************/ +/* Whether to keep an entry whose key and value are known to be retained + if STRONG_KEY and STRONG_VALUE, respectively, are true. */ +static inline bool +keep_entry_p (hash_table_weakness_t weakness, + bool strong_key, bool strong_value) +{ + switch (weakness) + { + case Weak_None: return true; + case Weak_Key: return strong_key; + case Weak_Value: return strong_value; + case Weak_Key_Or_Value: return strong_key || strong_value; + case Weak_Key_And_Value: return strong_key && strong_value; + } + emacs_abort(); +} + /* Sweep weak hash table H. REMOVE_ENTRIES_P means remove entries from the table that don't survive the current GC. !REMOVE_ENTRIES_P means mark entries that are in use. Value is @@ -4890,18 +4906,9 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) { bool key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i)); bool value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i)); - bool remove_p; - - if (EQ (h->weak, Qkey)) - remove_p = !key_known_to_survive_p; - else if (EQ (h->weak, Qvalue)) - remove_p = !value_known_to_survive_p; - else if (EQ (h->weak, Qkey_or_value)) - remove_p = !(key_known_to_survive_p || value_known_to_survive_p); - else if (EQ (h->weak, Qkey_and_value)) - remove_p = !(key_known_to_survive_p && value_known_to_survive_p); - else - emacs_abort (); + bool remove_p = !keep_entry_p (h->weakness, + key_known_to_survive_p, + value_known_to_survive_p); next = HASH_NEXT (h, i); @@ -5367,15 +5374,20 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) /* Look for `:weakness WEAK'. */ i = get_key_arg (QCweakness, nargs, args, used); - Lisp_Object weak = i ? args[i] : Qnil; - if (EQ (weak, Qt)) - weak = Qkey_and_value; - if (!NILP (weak) - && !EQ (weak, Qkey) - && !EQ (weak, Qvalue) - && !EQ (weak, Qkey_or_value) - && !EQ (weak, Qkey_and_value)) - signal_error ("Invalid hash table weakness", weak); + Lisp_Object weakness = i ? args[i] : Qnil; + hash_table_weakness_t weak; + if (NILP (weakness)) + weak = Weak_None; + else if (EQ (weakness, Qkey)) + weak = Weak_Key; + else if (EQ (weakness, Qvalue)) + weak = Weak_Value; + else if (EQ (weakness, Qkey_or_value)) + weak = Weak_Key_Or_Value; + else if (EQ (weakness, Qt) || EQ (weakness, Qkey_and_value)) + weak = Weak_Key_And_Value; + else + signal_error ("Invalid hash table weakness", weakness); /* Now, all args should have been used up, or there's a problem. */ for (i = 0; i < nargs; ++i) @@ -5449,13 +5461,26 @@ DEFUN ("hash-table-test", Fhash_table_test, Shash_table_test, 1, 1, 0, return check_hash_table (table)->test.name; } +Lisp_Object +hash_table_weakness_symbol (hash_table_weakness_t weak) +{ + switch (weak) + { + case Weak_None: return Qnil; + case Weak_Key: return Qkey; + case Weak_Value: return Qvalue; + case Weak_Key_And_Value: return Qkey_and_value; + case Weak_Key_Or_Value: return Qkey_or_value; + } + emacs_abort (); +} DEFUN ("hash-table-weakness", Fhash_table_weakness, Shash_table_weakness, 1, 1, 0, doc: /* Return the weakness of TABLE. */) (Lisp_Object table) { - return check_hash_table (table)->weak; + return hash_table_weakness_symbol (check_hash_table (table)->weakness); } diff --git a/src/frame.c b/src/frame.c index f5b07e212f2..41b0f2f5764 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1041,7 +1041,7 @@ make_frame (bool mini_p) fset_face_hash_table (f, make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Qnil, false)); + DEFAULT_REHASH_THRESHOLD, Weak_None, false)); if (mini_p) { diff --git a/src/image.c b/src/image.c index 252b83da992..92e1e0b0be7 100644 --- a/src/image.c +++ b/src/image.c @@ -6071,7 +6071,7 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object, const char *, int, *get_func = xpm_get_color_table_h; return make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false); + Weak_None, false); } static void diff --git a/src/lisp.h b/src/lisp.h index e80a6388657..480d963e63d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2403,6 +2403,18 @@ struct hash_table_test Lisp_Object (*hashfn) (Lisp_Object, struct Lisp_Hash_Table *); }; +typedef enum { + Weak_None, /* No weak references. */ + Weak_Key, /* Reference to key is weak. */ + Weak_Value, /* Reference to value is weak. */ + Weak_Key_Or_Value, /* References to key or value are weak: + element kept as long as strong reference to + either key or value remains. */ + Weak_Key_And_Value, /* References to key and value are weak: + element kept as long as strong references to + both key and value remain. */ +} hash_table_weakness_t; + struct Lisp_Hash_Table { union vectorlike_header header; @@ -2432,10 +2444,6 @@ struct Lisp_Hash_Table The table is physically split into three vectors (hash, next, key_and_value) which may or may not be beneficial. */ - /* Nil if table is non-weak. Otherwise a symbol describing the - weakness of the table. */ - Lisp_Object weak; - /* Vector of hash codes, or nil if the table needs rehashing. If the I-th entry is unused, then hash[I] should be nil. */ Lisp_Object hash; @@ -2462,6 +2470,9 @@ struct Lisp_Hash_Table /* Index of first free entry in free list, or -1 if none. */ ptrdiff_t next_free; + /* Weakness of the table. */ + hash_table_weakness_t weakness : 8; + /* True if the table can be purecopied. The table cannot be changed afterwards. */ bool purecopy; @@ -2498,7 +2509,7 @@ struct Lisp_Hash_Table } GCALIGNED_STRUCT; /* Sanity-check pseudovector layout. */ -verify (offsetof (struct Lisp_Hash_Table, weak) == header_size); +verify (offsetof (struct Lisp_Hash_Table, hash) == header_size); /* Key value that marks an unused hash table entry. */ #define HASH_UNUSED_ENTRY_KEY Qunbound @@ -4050,7 +4061,8 @@ EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object); Lisp_Object hashfn_user_defined (Lisp_Object, struct Lisp_Hash_Table *); Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float, - Lisp_Object, bool); + hash_table_weakness_t, bool); +Lisp_Object hash_table_weakness_symbol (hash_table_weakness_t weak); ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object *); ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, Lisp_Object); diff --git a/src/lread.c b/src/lread.c index 18894801376..6d3c06265e0 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2546,13 +2546,13 @@ readevalloop (Lisp_Object readcharfun, read_objects_map = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false); + Weak_None, false); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false); + Weak_None, false); if (!NILP (Vpurify_flag) && c == '(') val = read0 (readcharfun, false); else @@ -2797,12 +2797,12 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end, || XHASH_TABLE (read_objects_map)->count) read_objects_map = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Qnil, false); + DEFAULT_REHASH_THRESHOLD, Weak_None, false); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Qnil, false); + DEFAULT_REHASH_THRESHOLD, Weak_None, false); if (STRINGP (stream) || ((CONSP (stream) && STRINGP (XCAR (stream))))) diff --git a/src/pdumper.c b/src/pdumper.c index c72db7f3ea3..982b991dc63 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2726,6 +2726,7 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object) them as close to the hash table as possible. */ DUMP_FIELD_COPY (out, hash, count); DUMP_FIELD_COPY (out, hash, next_free); + DUMP_FIELD_COPY (out, hash, weakness); DUMP_FIELD_COPY (out, hash, purecopy); DUMP_FIELD_COPY (out, hash, mutable); DUMP_FIELD_COPY (out, hash, rehash_threshold); diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 2f7a390d22d..b45cf56135d 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -7179,7 +7179,8 @@ If set to a non-float value, there will be no wait at all. */); DEFVAR_LISP ("pgtk-keysym-table", Vpgtk_keysym_table, doc: /* Hash table of character codes indexed by X keysym codes. */); Vpgtk_keysym_table = make_hash_table (hashtest_eql, 900, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Qnil, false); + DEFAULT_REHASH_THRESHOLD, + Weak_None, false); window_being_scrolled = Qnil; staticpro (&window_being_scrolled); diff --git a/src/print.c b/src/print.c index c1c91b2383a..9c361444458 100644 --- a/src/print.c +++ b/src/print.c @@ -2583,10 +2583,11 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) print_object (h->test.name, printcharfun, escapeflag); } - if (!NILP (h->weak)) + if (h->weakness != Weak_None) { print_c_string (" weakness ", printcharfun); - print_object (h->weak, printcharfun, escapeflag); + print_object (hash_table_weakness_symbol (h->weakness), + printcharfun, escapeflag); } print_c_string (" rehash-size ", printcharfun); diff --git a/src/profiler.c b/src/profiler.c index 48a042cc8aa..a75998c7c40 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -566,7 +566,7 @@ export_log (struct profiler_log *plog) Lisp_Object h = make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false); + Weak_None, false); for (int i = 0; i < log->size; i++) { int count = get_log_count (log, i); diff --git a/src/xfaces.c b/src/xfaces.c index c9ade2769bd..7c3dd7ebc15 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -7334,7 +7334,7 @@ only for this purpose. */); Vface_new_frame_defaults = /* 33 entries is enough to fit all basic faces */ make_hash_table (hashtest_eq, 33, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Qnil, false); + DEFAULT_REHASH_THRESHOLD, Weak_None, false); DEFVAR_LISP ("face-default-stipple", Vface_default_stipple, doc: /* Default stipple pattern used on monochrome displays. diff --git a/src/xterm.c b/src/xterm.c index 0cbf32ae1ea..98f8c8afb3b 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -32557,7 +32557,7 @@ If set to a non-float value, there will be no wait at all. */); Vx_keysym_table = make_hash_table (hashtest_eql, 900, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false); + Weak_None, false); DEFVAR_BOOL ("x-frame-normalize-before-maximize", x_frame_normalize_before_maximize, -- cgit v1.2.3 From c3d0cc50faf588479db62e20ceabe044dd89e244 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 26 Oct 2023 17:17:01 +0200 Subject: Remove rehash-threshold and rehash-size struct members These parameters have no visible semantics and are hardly ever used, so just use the default values for all hash tables. This saves memory, shrinks the external representation, and will improve performance. * src/fns.c (std_rehash_size, std_rehash_threshold): New. (hash_index_size): Use std_rehash_threshold. Remove table argument. All callers updated. (make_hash_table): Remove rehash_size and rehash_threshold args. All callers updated. (maybe_resize_hash_table) (Fhash_table_rehash_size, Fhash_table_rehash_threshold): Use std_rehash_size and std_rehash_threshold. (Fmake_hash_table): Ignore :rehash-size and :rehash-threshold args. * src/lisp.h (struct Lisp_Hash_Table): Remove rehash_size and rehash_threshold fields. (DEFAULT_REHASH_THRESHOLD, DEFAULT_REHASH_SIZE): Remove. * src/lread.c (hash_table_from_plist): Don't read rehash-size or rehash-threshold. (syms_of_lread): Remove unused symbols. * src/print.c (print_object): Don't print rehash-size or rehash-threshold. * src/pdumper.c (dump_hash_table): Don't dump removed fields. --- src/category.c | 4 +-- src/emacs-module.c | 4 +-- src/fns.c | 101 ++++++++++++++++------------------------------------- src/frame.c | 3 +- src/image.c | 4 +-- src/lisp.h | 23 +----------- src/lread.c | 20 +++-------- src/pdumper.c | 2 -- src/pgtkterm.c | 4 +-- src/print.c | 8 ----- src/profiler.c | 2 -- src/xfaces.c | 3 +- src/xterm.c | 5 +-- 13 files changed, 43 insertions(+), 140 deletions(-) diff --git a/src/category.c b/src/category.c index 67429e82571..583cdb3eebb 100644 --- a/src/category.c +++ b/src/category.c @@ -51,9 +51,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set) if (NILP (XCHAR_TABLE (table)->extras[1])) set_char_table_extras (table, 1, - make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, - DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Weak_None, false)); + make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false)); struct Lisp_Hash_Table *h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); Lisp_Object hash; ptrdiff_t i = hash_lookup (h, category_set, &hash); diff --git a/src/emacs-module.c b/src/emacs-module.c index 44c3efd1440..60aed68f2cd 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1697,9 +1697,7 @@ syms_of_module (void) { staticpro (&Vmodule_refs_hash); Vmodule_refs_hash - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, - DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Weak_None, false); + = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); DEFSYM (Qmodule_load_failed, "module-load-failed"); Fput (Qmodule_load_failed, Qerror_conditions, diff --git a/src/fns.c b/src/fns.c index 5837795f838..efec74d4959 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4509,11 +4509,17 @@ allocate_hash_table (void) - header_size - GCALIGNMENT) \ / word_size))) +/* Default factor by which to increase the size of a hash table. */ +static const double std_rehash_size = 1.5; + +/* Resize hash table when number of entries / table size is >= this + ratio. */ +static const double std_rehash_threshold = 0.8125; + static ptrdiff_t -hash_index_size (struct Lisp_Hash_Table *h, ptrdiff_t size) +hash_index_size (ptrdiff_t size) { - double threshold = h->rehash_threshold; - double index_float = size / threshold; + double index_float = size * (1.0 / std_rehash_threshold); ptrdiff_t index_size = (index_float < INDEX_SIZE_BOUND + 1 ? next_almost_prime (index_float) : INDEX_SIZE_BOUND + 1); @@ -4531,16 +4537,6 @@ hash_index_size (struct Lisp_Hash_Table *h, ptrdiff_t size) Give the table initial capacity SIZE, 0 <= SIZE <= MOST_POSITIVE_FIXNUM. - If REHASH_SIZE is equal to a negative integer, this hash table's - new size when it becomes full is computed by subtracting - REHASH_SIZE from its old size. Otherwise it must be positive, and - the table's new size is computed by multiplying its old size by - REHASH_SIZE + 1. - - REHASH_THRESHOLD must be a float <= 1.0, and > 0. The table will - be resized when the approximate ratio of table entries to table - size exceeds REHASH_THRESHOLD. - WEAK specifies the weakness of the table. If PURECOPY is non-nil, the table can be copied to pure storage via @@ -4549,7 +4545,6 @@ hash_index_size (struct Lisp_Hash_Table *h, ptrdiff_t size) Lisp_Object make_hash_table (struct hash_table_test test, EMACS_INT size, - float rehash_size, float rehash_threshold, hash_table_weakness_t weak, bool purecopy) { struct Lisp_Hash_Table *h; @@ -4559,8 +4554,6 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, /* Preconditions. */ eassert (SYMBOLP (test.name)); eassert (0 <= size && size <= MOST_POSITIVE_FIXNUM); - eassert (rehash_size <= -1 || 0 < rehash_size); - eassert (0 < rehash_threshold && rehash_threshold <= 1); if (size == 0) size = 1; @@ -4571,13 +4564,11 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, /* Initialize hash table slots. */ h->test = test; h->weakness = weak; - h->rehash_threshold = rehash_threshold; - h->rehash_size = rehash_size; h->count = 0; h->key_and_value = make_vector (2 * size, HASH_UNUSED_ENTRY_KEY); h->hash = make_nil_vector (size); h->next = make_vector (size, make_fixnum (-1)); - h->index = make_vector (hash_index_size (h, size), make_fixnum (-1)); + h->index = make_vector (hash_index_size (size), make_fixnum (-1)); h->next_weak = NULL; h->purecopy = purecopy; h->mutable = true; @@ -4648,18 +4639,12 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) { ptrdiff_t old_size = HASH_TABLE_SIZE (h); EMACS_INT new_size; - double rehash_size = h->rehash_size; - if (rehash_size < 0) - new_size = old_size - rehash_size; + double float_new_size = old_size * std_rehash_size; + if (float_new_size < EMACS_INT_MAX) + new_size = float_new_size; else - { - double float_new_size = old_size * (rehash_size + 1); - if (float_new_size < EMACS_INT_MAX) - new_size = float_new_size; - else - new_size = EMACS_INT_MAX; - } + new_size = EMACS_INT_MAX; if (PTRDIFF_MAX < new_size) new_size = PTRDIFF_MAX; if (new_size <= old_size) @@ -4682,7 +4667,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) Lisp_Object hash = alloc_larger_vector (h->hash, new_size); memclear (XVECTOR (hash)->contents + old_size, (new_size - old_size) * word_size); - ptrdiff_t index_size = hash_index_size (h, new_size); + ptrdiff_t index_size = hash_index_size (new_size); h->index = make_vector (index_size, make_fixnum (-1)); h->key_and_value = key_and_value; h->hash = hash; @@ -5281,15 +5266,6 @@ keys. Default is `eql'. Predefined are the tests `eq', `eql', and :size SIZE -- A hint as to how many elements will be put in the table. Default is 65. -:rehash-size REHASH-SIZE - Indicates how to expand the table when it -fills up. If REHASH-SIZE is an integer, increase the size by that -amount. If it is a float, it must be > 1.0, and the new size is the -old size multiplied by that factor. Default is 1.5. - -:rehash-threshold THRESHOLD -- THRESHOLD must a float > 0, and <= 1.0. -Resize the hash table when the ratio (table entries / table size) -exceeds an approximation to THRESHOLD. Default is 0.8125. - :weakness WEAK -- WEAK must be one of nil, t, `key', `value', `key-or-value', or `key-and-value'. If WEAK is not nil, the table returned is a weak table. Key/value pairs are removed from a weak @@ -5303,6 +5279,9 @@ to pure storage when Emacs is being dumped, making the contents of the table read only. Any further changes to purified tables will result in an error. +The keywords arguments :rehash-threshold and :rehash-size are obsolete +and ignored. + usage: (make-hash-table &rest KEYWORD-ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { @@ -5352,26 +5331,6 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) else signal_error ("Invalid hash table size", size_arg); - /* Look for `:rehash-size SIZE'. */ - float rehash_size; - i = get_key_arg (QCrehash_size, nargs, args, used); - if (!i) - rehash_size = DEFAULT_REHASH_SIZE; - else if (FIXNUMP (args[i]) && 0 < XFIXNUM (args[i])) - rehash_size = - XFIXNUM (args[i]); - else if (FLOATP (args[i]) && 0 < (float) (XFLOAT_DATA (args[i]) - 1)) - rehash_size = (float) (XFLOAT_DATA (args[i]) - 1); - else - signal_error ("Invalid hash table rehash size", args[i]); - - /* Look for `:rehash-threshold THRESHOLD'. */ - i = get_key_arg (QCrehash_threshold, nargs, args, used); - float rehash_threshold = (!i ? DEFAULT_REHASH_THRESHOLD - : !FLOATP (args[i]) ? 0 - : (float) XFLOAT_DATA (args[i])); - if (! (0 < rehash_threshold && rehash_threshold <= 1)) - signal_error ("Invalid hash table rehash threshold", args[i]); - /* Look for `:weakness WEAK'. */ i = get_key_arg (QCweakness, nargs, args, used); Lisp_Object weakness = i ? args[i] : Qnil; @@ -5392,11 +5351,16 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) /* Now, all args should have been used up, or there's a problem. */ for (i = 0; i < nargs; ++i) if (!used[i]) - signal_error ("Invalid argument list", args[i]); + { + /* Ignore obsolete arguments. */ + if (EQ (args[i], QCrehash_threshold) || EQ (args[i], QCrehash_size)) + i++; + else + signal_error ("Invalid argument list", args[i]); + } SAFE_FREE (); - return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak, - purecopy); + return make_hash_table (testdesc, size, weak, purecopy); } @@ -5422,14 +5386,8 @@ DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, doc: /* Return the current rehash size of TABLE. */) (Lisp_Object table) { - double rehash_size = check_hash_table (table)->rehash_size; - if (rehash_size < 0) - { - EMACS_INT s = -rehash_size; - return make_fixnum (min (s, MOST_POSITIVE_FIXNUM)); - } - else - return make_float (rehash_size + 1); + CHECK_HASH_TABLE (table); + return make_float (std_rehash_size); } @@ -5438,7 +5396,8 @@ DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, doc: /* Return the current rehash threshold of TABLE. */) (Lisp_Object table) { - return make_float (check_hash_table (table)->rehash_threshold); + CHECK_HASH_TABLE (table); + return make_float (std_rehash_threshold); } diff --git a/src/frame.c b/src/frame.c index 41b0f2f5764..08057736272 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1040,8 +1040,7 @@ make_frame (bool mini_p) rw->pixel_height = rw->total_lines * FRAME_LINE_HEIGHT (f); fset_face_hash_table - (f, make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Weak_None, false)); + (f, make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false)); if (mini_p) { diff --git a/src/image.c b/src/image.c index 92e1e0b0be7..9c100213590 100644 --- a/src/image.c +++ b/src/image.c @@ -6069,9 +6069,7 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object, const char *, int, { *put_func = xpm_put_color_table_h; *get_func = xpm_get_color_table_h; - return make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, - DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Weak_None, false); + return make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false); } static void diff --git a/src/lisp.h b/src/lisp.h index 480d963e63d..48e1f943ed8 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2482,17 +2482,6 @@ struct Lisp_Hash_Table immutable for recursive attempts to mutate it. */ bool mutable; - /* Resize hash table when number of entries / table size is >= this - ratio. */ - float rehash_threshold; - - /* Used when the table is resized. If equal to a negative integer, - the user rehash-size is the integer -REHASH_SIZE, and the new - size is the old size plus -REHASH_SIZE. If positive, the user - rehash-size is the floating-point value REHASH_SIZE + 1, and the - new size is the old size times REHASH_SIZE + 1. */ - float rehash_size; - /* Vector of keys and values. The key of item I is found at index 2 * I, the value is found at index 2 * I + 1. If the key is HASH_UNUSED_ENTRY_KEY, then this slot is unused. @@ -2580,16 +2569,6 @@ void hash_table_rehash (Lisp_Object); enum DEFAULT_HASH_SIZE { DEFAULT_HASH_SIZE = 65 }; -/* Default threshold specifying when to resize a hash table. The - value gives the ratio of current entries in the hash table and the - size of the hash table. */ - -static float const DEFAULT_REHASH_THRESHOLD = 0.8125; - -/* Default factor by which to increase the size of a hash table, minus 1. */ - -static float const DEFAULT_REHASH_SIZE = 1.5 - 1; - /* Combine two integers X and Y for hashing. The result might exceed INTMASK. */ @@ -4060,7 +4039,7 @@ extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *); EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object); Lisp_Object hashfn_user_defined (Lisp_Object, struct Lisp_Hash_Table *); -Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float, +Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, hash_table_weakness_t, bool); Lisp_Object hash_table_weakness_symbol (hash_table_weakness_t weak); ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object *); diff --git a/src/lread.c b/src/lread.c index 6d3c06265e0..284536fc81f 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2544,15 +2544,11 @@ readevalloop (Lisp_Object readcharfun, if (! HASH_TABLE_P (read_objects_map) || XHASH_TABLE (read_objects_map)->count) read_objects_map - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, - DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Weak_None, false); + = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, - DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Weak_None, false); + = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (!NILP (Vpurify_flag) && c == '(') val = read0 (readcharfun, false); else @@ -2796,13 +2792,11 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end, if (! HASH_TABLE_P (read_objects_map) || XHASH_TABLE (read_objects_map)->count) read_objects_map - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Weak_None, false); + = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Weak_None, false); + = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (STRINGP (stream) || ((CONSP (stream) && STRINGP (XCAR (stream))))) @@ -3412,7 +3406,7 @@ read_string_literal (Lisp_Object readcharfun) static Lisp_Object hash_table_from_plist (Lisp_Object plist) { - Lisp_Object params[12]; + Lisp_Object params[4 * 2]; Lisp_Object *par = params; /* This is repetitive but fast and simple. */ @@ -3428,8 +3422,6 @@ hash_table_from_plist (Lisp_Object plist) ADDPARAM (test); ADDPARAM (weakness); - ADDPARAM (rehash_size); - ADDPARAM (rehash_threshold); ADDPARAM (purecopy); Lisp_Object data = plist_get (plist, Qdata); @@ -5998,8 +5990,6 @@ that are loaded before your customizations are read! */); DEFSYM (Qsize, "size"); DEFSYM (Qpurecopy, "purecopy"); DEFSYM (Qweakness, "weakness"); - DEFSYM (Qrehash_size, "rehash-size"); - DEFSYM (Qrehash_threshold, "rehash-threshold"); DEFSYM (Qchar_from_name, "char-from-name"); diff --git a/src/pdumper.c b/src/pdumper.c index 982b991dc63..8072148c542 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2729,8 +2729,6 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object) DUMP_FIELD_COPY (out, hash, weakness); DUMP_FIELD_COPY (out, hash, purecopy); DUMP_FIELD_COPY (out, hash, mutable); - DUMP_FIELD_COPY (out, hash, rehash_threshold); - DUMP_FIELD_COPY (out, hash, rehash_size); dump_field_lv (ctx, out, hash, &hash->key_and_value, WEIGHT_STRONG); dump_field_lv (ctx, out, hash, &hash->test.name, WEIGHT_STRONG); dump_field_lv (ctx, out, hash, &hash->test.user_hash_function, diff --git a/src/pgtkterm.c b/src/pgtkterm.c index b45cf56135d..57ea82daa5e 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -7178,9 +7178,7 @@ If set to a non-float value, there will be no wait at all. */); DEFVAR_LISP ("pgtk-keysym-table", Vpgtk_keysym_table, doc: /* Hash table of character codes indexed by X keysym codes. */); - Vpgtk_keysym_table = make_hash_table (hashtest_eql, 900, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, - Weak_None, false); + Vpgtk_keysym_table = make_hash_table (hashtest_eql, 900, Weak_None, false); window_being_scrolled = Qnil; staticpro (&window_being_scrolled); diff --git a/src/print.c b/src/print.c index 9c361444458..cc8df639f4f 100644 --- a/src/print.c +++ b/src/print.c @@ -2590,14 +2590,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) printcharfun, escapeflag); } - print_c_string (" rehash-size ", printcharfun); - print_object (Fhash_table_rehash_size (obj), - printcharfun, escapeflag); - - print_c_string (" rehash-threshold ", printcharfun); - print_object (Fhash_table_rehash_threshold (obj), - printcharfun, escapeflag); - if (h->purecopy) print_c_string (" purecopy t", printcharfun); diff --git a/src/profiler.c b/src/profiler.c index a75998c7c40..06ffecf41e3 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -564,8 +564,6 @@ export_log (struct profiler_log *plog) the log but close enough, and will never confuse two distinct keys in the log. */ Lisp_Object h = make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, - DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Weak_None, false); for (int i = 0; i < log->size; i++) { diff --git a/src/xfaces.c b/src/xfaces.c index 7c3dd7ebc15..c9dd0f90feb 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -7333,8 +7333,7 @@ only for this purpose. */); doc: /* Hash table of global face definitions (for internal use only.) */); Vface_new_frame_defaults = /* 33 entries is enough to fit all basic faces */ - make_hash_table (hashtest_eq, 33, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Weak_None, false); + make_hash_table (hashtest_eq, 33, Weak_None, false); DEFVAR_LISP ("face-default-stipple", Vface_default_stipple, doc: /* Default stipple pattern used on monochrome displays. diff --git a/src/xterm.c b/src/xterm.c index 98f8c8afb3b..e4139a79a6e 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -32554,10 +32554,7 @@ If set to a non-float value, there will be no wait at all. */); DEFVAR_LISP ("x-keysym-table", Vx_keysym_table, doc: /* Hash table of character codes indexed by X keysym codes. */); - Vx_keysym_table = make_hash_table (hashtest_eql, 900, - DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, - Weak_None, false); + Vx_keysym_table = make_hash_table (hashtest_eql, 900, Weak_None, false); DEFVAR_BOOL ("x-frame-normalize-before-maximize", x_frame_normalize_before_maximize, -- cgit v1.2.3 From d3cefd3e98354929d96c9396e5920e8a123784dc Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 4 Nov 2023 16:34:09 +0100 Subject: Leaner hash table dumping and thawing Only dump the actual data, and the test encoded as an enum. This simplifies dumping, makes dump files smaller and saves space at run time. * src/lisp.h (hash_table_std_test_t): New enum. (struct Lisp_Hash_Table): Add frozen_test member, consuming no extra space. * src/fns.c (hashfn_user_defined): Now static. (hash_table_test_from_std): New. (hash_table_rehash): Rename to... (hash_table_thaw): ...this and rewrite. * src/pdumper.c (hash_table_contents): Only include actual data, not unused space. (hash_table_std_test): New. (hash_table_freeze): Set frozen_test from test. (dump_hash_table): Dump frozen_test, not the whole test struct. Don't bother other dumping fields that can be derived. --- src/fns.c | 53 ++++++++++++++++++++++++++++++------------------- src/lisp.h | 12 ++++++++++-- src/pdumper.c | 63 +++++++++++++++++++++++++---------------------------------- 3 files changed, 70 insertions(+), 58 deletions(-) diff --git a/src/fns.c b/src/fns.c index efec74d4959..74fdf29417e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4474,7 +4474,7 @@ hashfn_eql (Lisp_Object key, struct Lisp_Hash_Table *h) /* Given H, return a hash code for KEY which uses a user-defined function to compare keys. */ -Lisp_Object +static Lisp_Object hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h) { Lisp_Object args[] = { h->test.user_hash_function, key }; @@ -4638,11 +4638,10 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) if (h->next_free < 0) { ptrdiff_t old_size = HASH_TABLE_SIZE (h); - EMACS_INT new_size; - - double float_new_size = old_size * std_rehash_size; - if (float_new_size < EMACS_INT_MAX) - new_size = float_new_size; + /* FIXME: better growth management, ditch std_rehash_size */ + EMACS_INT new_size = old_size * std_rehash_size; + if (new_size < EMACS_INT_MAX) + new_size = max (new_size, 32); /* avoid slow initial growth */ else new_size = EMACS_INT_MAX; if (PTRDIFF_MAX < new_size) @@ -4691,20 +4690,39 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) } } -/* Recompute the hashes (and hence also the "next" pointers). - Normally there's never a need to recompute hashes. - This is done only on first access to a hash-table loaded from - the "pdump", because the objects' addresses may have changed, thus - affecting their hashes. */ +static const struct hash_table_test * +hash_table_test_from_std (hash_table_std_test_t test) +{ + switch (test) + { + case Test_eq: return &hashtest_eq; + case Test_eql: return &hashtest_eql; + case Test_equal: return &hashtest_equal; + } + emacs_abort(); +} + +/* Rebuild a hash table from its frozen (dumped) form. */ void -hash_table_rehash (Lisp_Object hash) +hash_table_thaw (Lisp_Object hash_table) { - struct Lisp_Hash_Table *h = XHASH_TABLE (hash); - ptrdiff_t i, count = h->count; + struct Lisp_Hash_Table *h = XHASH_TABLE (hash_table); + + /* Freezing discarded most non-essential information; recompute it. + The allocation is minimal with no room for growth. */ + h->test = *hash_table_test_from_std (h->frozen_test); + ptrdiff_t size = ASIZE (h->key_and_value) / 2; + h->count = size; + ptrdiff_t index_size = hash_index_size (size); + h->next_free = -1; + + h->hash = make_nil_vector (size); + h->next = make_vector (size, make_fixnum (-1)); + h->index = make_vector (index_size, make_fixnum (-1)); /* Recompute the actual hash codes for each entry in the table. Order is still invalid. */ - for (i = 0; i < count; i++) + for (ptrdiff_t i = 0; i < size; i++) { Lisp_Object key = HASH_KEY (h, i); Lisp_Object hash_code = hash_from_key (h, key); @@ -4712,12 +4730,7 @@ hash_table_rehash (Lisp_Object hash) set_hash_hash_slot (h, i, hash_code); set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); set_hash_index_slot (h, start_of_bucket, i); - eassert (HASH_NEXT (h, i) != i); /* Stop loops. */ } - - ptrdiff_t size = ASIZE (h->next); - for (; i + 1 < size; i++) - set_hash_next_slot (h, i, i + 1); } /* Lookup KEY in hash table H. If HASH is non-null, return in *HASH diff --git a/src/lisp.h b/src/lisp.h index 48e1f943ed8..d9b828b0328 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2385,6 +2385,12 @@ INLINE int struct Lisp_Hash_Table; +typedef enum { + Test_eql, + Test_eq, + Test_equal, +} hash_table_std_test_t; + struct hash_table_test { /* Function used to compare keys; always a bare symbol. */ @@ -2473,6 +2479,9 @@ struct Lisp_Hash_Table /* Weakness of the table. */ hash_table_weakness_t weakness : 8; + /* Hash table test (only used when frozen in dump) */ + hash_table_std_test_t frozen_test : 8; + /* True if the table can be purecopied. The table cannot be changed afterwards. */ bool purecopy; @@ -2563,7 +2572,7 @@ hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) return h->test.hashfn (key, h); } -void hash_table_rehash (Lisp_Object); +void hash_table_thaw (Lisp_Object hash_table); /* Default size for hash tables if not specified. */ @@ -4038,7 +4047,6 @@ extern void hexbuf_digest (char *, void const *, int); extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *); EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object); -Lisp_Object hashfn_user_defined (Lisp_Object, struct Lisp_Hash_Table *); Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, hash_table_weakness_t, bool); Lisp_Object hash_table_weakness_symbol (hash_table_weakness_t weak); diff --git a/src/pdumper.c b/src/pdumper.c index 8072148c542..e4349f0cb17 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2646,34 +2646,26 @@ dump_vectorlike_generic (struct dump_context *ctx, return offset; } -/* Return a vector of KEY, VALUE pairs in the given hash table H. The - first H->count pairs are valid, and the rest are unbound. */ +/* Return a vector of KEY, VALUE pairs in the given hash table H. + No room for growth is included. */ static Lisp_Object hash_table_contents (struct Lisp_Hash_Table *h) { - if (h->test.hashfn == hashfn_user_defined) - error ("cannot dump hash tables with user-defined tests"); /* Bug#36769 */ - - ptrdiff_t size = HASH_TABLE_SIZE (h); + ptrdiff_t old_size = HASH_TABLE_SIZE (h); + ptrdiff_t size = h->count; Lisp_Object key_and_value = make_uninit_vector (2 * size); ptrdiff_t n = 0; /* Make sure key_and_value ends up in the same order; charset.c relies on it by expecting hash table indices to stay constant across the dump. */ - for (ptrdiff_t i = 0; i < size; i++) + for (ptrdiff_t i = 0; i < old_size; i++) if (!NILP (HASH_HASH (h, i))) { ASET (key_and_value, n++, HASH_KEY (h, i)); ASET (key_and_value, n++, HASH_VALUE (h, i)); } - while (n < 2 * size) - { - ASET (key_and_value, n++, Qunbound); - ASET (key_and_value, n++, Qnil); - } - return key_and_value; } @@ -2686,25 +2678,32 @@ dump_hash_table_list (struct dump_context *ctx) return 0; } -static void -hash_table_freeze (struct Lisp_Hash_Table *h) +static hash_table_std_test_t +hash_table_std_test (const struct hash_table_test *t) { - ptrdiff_t npairs = ASIZE (h->key_and_value) / 2; - h->key_and_value = hash_table_contents (h); - h->next = h->hash = make_fixnum (npairs); - h->index = make_fixnum (ASIZE (h->index)); - h->next_free = (npairs == h->count ? -1 : h->count); + if (BASE_EQ (t->name, Qeq)) + return Test_eq; + if (BASE_EQ (t->name, Qeql)) + return Test_eql; + if (BASE_EQ (t->name, Qequal)) + return Test_equal; + error ("cannot dump hash tables with user-defined tests"); /* Bug#36769 */ } +/* Compact contents and discard inessential information from a hash table, + preparing it for dumping. + See `hash_table_thaw' for the code that restores the object to a usable + state. */ static void -hash_table_thaw (Lisp_Object hash) +hash_table_freeze (struct Lisp_Hash_Table *h) { - struct Lisp_Hash_Table *h = XHASH_TABLE (hash); - h->hash = make_nil_vector (XFIXNUM (h->hash)); - h->next = Fmake_vector (h->next, make_fixnum (-1)); - h->index = Fmake_vector (h->index, make_fixnum (-1)); - - hash_table_rehash (hash); + h->key_and_value = hash_table_contents (h); + eassert (ASIZE (h->key_and_value) == h->count * 2); + h->next = Qnil; + h->hash = Qnil; + h->index = Qnil; + h->count = 0; + h->frozen_test = hash_table_std_test (&h->test); } static dump_off @@ -2724,19 +2723,11 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object) dump_pseudovector_lisp_fields (ctx, &out->header, &hash->header); /* TODO: dump the hash bucket vectors synchronously here to keep them as close to the hash table as possible. */ - DUMP_FIELD_COPY (out, hash, count); - DUMP_FIELD_COPY (out, hash, next_free); DUMP_FIELD_COPY (out, hash, weakness); DUMP_FIELD_COPY (out, hash, purecopy); DUMP_FIELD_COPY (out, hash, mutable); + DUMP_FIELD_COPY (out, hash, frozen_test); dump_field_lv (ctx, out, hash, &hash->key_and_value, WEIGHT_STRONG); - dump_field_lv (ctx, out, hash, &hash->test.name, WEIGHT_STRONG); - dump_field_lv (ctx, out, hash, &hash->test.user_hash_function, - WEIGHT_STRONG); - dump_field_lv (ctx, out, hash, &hash->test.user_cmp_function, - WEIGHT_STRONG); - dump_field_emacs_ptr (ctx, out, hash, &hash->test.cmpfn); - dump_field_emacs_ptr (ctx, out, hash, &hash->test.hashfn); eassert (hash->next_weak == NULL); return finish_dump_pvec (ctx, &out->header); } -- cgit v1.2.3 From 49fd4d120deb0b878ad262aea7d849c7275bc12c Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 4 Nov 2023 15:16:38 +0100 Subject: Allow zero hash table size This avoids any extra allocation for such vectors, including empty tables read by the Lisp reader, and provides extra safety essentially for free. * src/fns.c (make_hash_table): Allow tables to be 0-sized. The index will always have at least one entry, to avoid extra look-up costs. * src/alloc.c (process_mark_stack): Don't mark pure objects, because empty vectors are pure. --- src/alloc.c | 3 ++- src/fns.c | 7 +++---- src/lisp.h | 4 +--- 3 files changed, 6 insertions(+), 8 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 17ed711a318..636b4972c84 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -7242,7 +7242,8 @@ process_mark_stack (ptrdiff_t base_sp) eassert (h->next_weak == NULL); h->next_weak = weak_hash_tables; weak_hash_tables = h; - set_vector_marked (XVECTOR (h->key_and_value)); + if (!PURE_P (h->key_and_value)) + set_vector_marked (XVECTOR (h->key_and_value)); } break; } diff --git a/src/fns.c b/src/fns.c index 74fdf29417e..a1659884b5e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4555,9 +4555,6 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, eassert (SYMBOLP (test.name)); eassert (0 <= size && size <= MOST_POSITIVE_FIXNUM); - if (size == 0) - size = 1; - /* Allocate a table and initialize it. */ h = allocate_hash_table (); @@ -4576,7 +4573,9 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, /* Set up the free list. */ for (i = 0; i < size - 1; ++i) set_hash_next_slot (h, i, i + 1); - h->next_free = 0; + if (size > 0) + set_hash_next_slot (h, size - 1, -1); + h->next_free = size > 0 ? 0 : -1; XSET_HASH_TABLE (table, h); eassert (HASH_TABLE_P (table)); diff --git a/src/lisp.h b/src/lisp.h index d9b828b0328..f863df6bca0 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2560,9 +2560,7 @@ HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx) INLINE ptrdiff_t HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) { - ptrdiff_t size = ASIZE (h->next); - eassume (0 < size); - return size; + return ASIZE (h->next); } /* Compute hash value for KEY in hash table H. */ -- cgit v1.2.3 From fa5c07fc87d557e642fc325852e8d0c87a9c176e Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 27 Oct 2023 22:15:09 +0200 Subject: Use non-Lisp allocation for internal hash-table vectors Using xmalloc for allocating these arrays is much cheaper than using Lisp vectors since they are no longer marked or swept by the GC, and deallocated much sooner. This makes GC faster and less frequent, and improves temporal locality. Zero-sized tables use NULL for their (0-length) vectors except the index vector which has size 1 and uses a shared constant static vector since it cannot be modified anyway. This makes creation and destruction of zero-sized hash tables very fast; they consume no memory outside the base object. * src/lisp.h (struct Lisp_Hash_Table): Retype the index, next, hash and key_and_value vectors from Lisp_Object to appropriately typed arrays (although hash values are still stored as Lisp fixnums). Add explicit table_size and index_size members. All users updated. * src/alloc.c (gcstat): Add total_hash_table_bytes. (hash_table_allocated_bytes): New. (cleanup_vector): Free hash table vectors when sweeping the object. (hash_table_alloc_bytes, hash_table_free_bytes): New. (sweep_vectors): Update gcstat.total_hash_table_bytes. (total_bytes_of_live_objects): Use it. (purecopy_hash_table): Adapt allocation of hash table vectors. (process_mark_stack): No more Lisp slots in the struct to trace. * src/fns.c (empty_hash_index_vector): New. (allocate_hash_table): Allocate without automatically GCed slots. (alloc_larger_vector): Remove. (make_hash_table, copy_hash_table, maybe_resize_hash_table): Adapt vector allocation and initialisation. * src/pdumper.c (hash_table_freeze, hash_table_thaw, dump_hash_table) (dump_hash_table_contents): Adapt dumping and loading to field changes. --- src/alloc.c | 86 ++++++++++++++++++++--- src/fns.c | 217 ++++++++++++++++++++++++++++++++++++---------------------- src/lisp.h | 61 ++++++++++------- src/pdumper.c | 56 +++++++++++---- src/print.c | 4 +- 5 files changed, 290 insertions(+), 134 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 636b4972c84..7432163db25 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -359,8 +359,16 @@ static struct gcstat object_ct total_floats, total_free_floats; object_ct total_intervals, total_free_intervals; object_ct total_buffers; + + /* Size of the ancillary arrays of live hash-table objects. + The objects themselves are not included (counted as vectors above). */ + byte_ct total_hash_table_bytes; } gcstat; +/* Total size of ancillary arrays of all allocated hash-table objects, + both dead and alive. This number is always kept up-to-date. */ +static ptrdiff_t hash_table_allocated_bytes = 0; + /* Points to memory space allocated as "spare", to be freed if we run out of memory. We keep one large block, four cons-blocks, and two string blocks. */ @@ -3430,6 +3438,23 @@ cleanup_vector (struct Lisp_Vector *vector) } #endif break; + case PVEC_HASH_TABLE: + { + struct Lisp_Hash_Table *h = PSEUDOVEC_STRUCT (vector, Lisp_Hash_Table); + if (h->table_size > 0) + { + eassert (h->index_size > 1); + xfree (h->index); + xfree (h->key_and_value); + xfree (h->next); + xfree (h->hash); + ptrdiff_t bytes = (h->table_size * (2 * sizeof *h->key_and_value + + sizeof *h->hash + + sizeof *h->next) + + h->index_size * sizeof *h->index); + hash_table_allocated_bytes -= bytes; + } + } /* Keep the switch exhaustive. */ case PVEC_NORMAL_VECTOR: case PVEC_FREE: @@ -3440,7 +3465,6 @@ cleanup_vector (struct Lisp_Vector *vector) case PVEC_WINDOW: case PVEC_BOOL_VECTOR: case PVEC_BUFFER: - case PVEC_HASH_TABLE: case PVEC_TERMINAL: case PVEC_WINDOW_CONFIGURATION: case PVEC_OTHER: @@ -3554,6 +3578,8 @@ sweep_vectors (void) lisp_free (lv); } } + + gcstat.total_hash_table_bytes = hash_table_allocated_bytes; } /* Maximum number of elements in a vector. This is a macro so that it @@ -5606,6 +5632,28 @@ valid_lisp_object_p (Lisp_Object obj) return 0; } +/* Like xmalloc, but makes allocation count toward the total consing. + Return NULL for a zero-sized allocation. */ +void * +hash_table_alloc_bytes (ptrdiff_t nbytes) +{ + if (nbytes == 0) + return NULL; + tally_consing (nbytes); + hash_table_allocated_bytes += nbytes; + return xmalloc (nbytes); +} + +/* Like xfree, but makes allocation count toward the total consing. */ +void +hash_table_free_bytes (void *p, ptrdiff_t nbytes) +{ + tally_consing (-nbytes); + hash_table_allocated_bytes -= nbytes; + xfree (p); +} + + /*********************************************************************** Pure Storage Management ***********************************************************************/ @@ -5897,10 +5945,28 @@ purecopy_hash_table (struct Lisp_Hash_Table *table) pure->test.name = purecopy (table->test.name); pure->test.user_hash_function = purecopy (table->test.user_hash_function); pure->test.user_cmp_function = purecopy (table->test.user_cmp_function); - pure->hash = purecopy (table->hash); - pure->next = purecopy (table->next); - pure->index = purecopy (table->index); - pure->key_and_value = purecopy (table->key_and_value); + + if (table->table_size > 0) + { + ptrdiff_t hash_bytes = table->table_size * sizeof *table->hash; + pure->hash = pure_alloc (hash_bytes, -(int)sizeof *table->hash); + memcpy (pure->hash, table->hash, hash_bytes); + + ptrdiff_t next_bytes = table->table_size * sizeof *table->next; + pure->next = pure_alloc (next_bytes, -(int)sizeof *table->next); + memcpy (pure->next, table->next, next_bytes); + + ptrdiff_t nvalues = table->table_size * 2; + ptrdiff_t kv_bytes = nvalues * sizeof *table->key_and_value; + pure->key_and_value = pure_alloc (kv_bytes, + -(int)sizeof *table->key_and_value); + for (ptrdiff_t i = 0; i < nvalues; i++) + pure->key_and_value[i] = purecopy (table->key_and_value[i]); + + ptrdiff_t index_bytes = table->index_size * sizeof *table->index; + pure->index = pure_alloc (index_bytes, -(int)sizeof *table->index); + memcpy (pure->index, table->index, index_bytes); + } return pure; } @@ -6084,6 +6150,7 @@ total_bytes_of_live_objects (void) tot += object_bytes (gcstat.total_floats, sizeof (struct Lisp_Float)); tot += object_bytes (gcstat.total_intervals, sizeof (struct interval)); tot += object_bytes (gcstat.total_strings, sizeof (struct Lisp_String)); + tot += gcstat.total_hash_table_bytes; return tot; } @@ -7227,23 +7294,20 @@ process_mark_stack (ptrdiff_t base_sp) case PVEC_HASH_TABLE: { struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *)ptr; - ptrdiff_t size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK; set_vector_marked (ptr); - mark_stack_push_values (ptr->contents, size); mark_stack_push_value (h->test.name); mark_stack_push_value (h->test.user_hash_function); mark_stack_push_value (h->test.user_cmp_function); if (h->weakness == Weak_None) - mark_stack_push_value (h->key_and_value); + mark_stack_push_values (h->key_and_value, + 2 * h->table_size); else { - /* For weak tables, mark only the vector and not its + /* For weak tables, don't mark the contents --- that's what makes it weak. */ eassert (h->next_weak == NULL); h->next_weak = weak_hash_tables; weak_hash_tables = h; - if (!PURE_P (h->key_and_value)) - set_vector_marked (XVECTOR (h->key_and_value)); } break; } diff --git a/src/fns.c b/src/fns.c index a1659884b5e..3aca588a8a5 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4275,17 +4275,20 @@ CHECK_HASH_TABLE (Lisp_Object x) static void set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) { - gc_aset (h->next, idx, make_fixnum (val)); + eassert (idx >= 0 && idx < h->table_size); + h->next[idx] = val; } static void set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) { - gc_aset (h->hash, idx, val); + eassert (idx >= 0 && idx < h->table_size); + h->hash[idx] = val; } static void set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) { - gc_aset (h->index, idx, make_fixnum (val)); + eassert (idx >= 0 && idx < h->index_size); + h->index[idx] = val; } /* If OBJ is a Lisp hash table, return a pointer to its struct @@ -4375,7 +4378,8 @@ larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) static ptrdiff_t HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx) { - return XFIXNUM (AREF (h->next, idx)); + eassert (idx >= 0 && idx < h->table_size); + return h->next[idx]; } /* Return the index of the element in hash table H that is the start @@ -4384,7 +4388,8 @@ HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx) static ptrdiff_t HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) { - return XFIXNUM (AREF (h->index, idx)); + eassert (idx >= 0 && idx < h->index_size); + return h->index[idx]; } /* Restore a hash table's mutability after the critical section exits. */ @@ -4495,8 +4500,7 @@ struct hash_table_test const static struct Lisp_Hash_Table * allocate_hash_table (void) { - return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table, - index, PVEC_HASH_TABLE); + return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Hash_Table, PVEC_HASH_TABLE); } /* An upper bound on the size of a hash table index. It must fit in @@ -4528,6 +4532,10 @@ hash_index_size (ptrdiff_t size) return index_size; } +/* Constant hash index vector used when the table size is zero. + This avoids allocating it from the heap. */ +static const ptrdiff_t empty_hash_index_vector[] = {-1}; + /* Create and initialize a new hash table. TEST specifies the test the hash table will use to compare keys. @@ -4547,36 +4555,54 @@ Lisp_Object make_hash_table (struct hash_table_test test, EMACS_INT size, hash_table_weakness_t weak, bool purecopy) { - struct Lisp_Hash_Table *h; - Lisp_Object table; - ptrdiff_t i; - - /* Preconditions. */ eassert (SYMBOLP (test.name)); - eassert (0 <= size && size <= MOST_POSITIVE_FIXNUM); + eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX)); - /* Allocate a table and initialize it. */ - h = allocate_hash_table (); + struct Lisp_Hash_Table *h = allocate_hash_table (); - /* Initialize hash table slots. */ h->test = test; h->weakness = weak; h->count = 0; - h->key_and_value = make_vector (2 * size, HASH_UNUSED_ENTRY_KEY); - h->hash = make_nil_vector (size); - h->next = make_vector (size, make_fixnum (-1)); - h->index = make_vector (hash_index_size (size), make_fixnum (-1)); + h->table_size = size; + int index_size = hash_index_size (size); + h->index_size = index_size; + + if (size == 0) + { + h->key_and_value = NULL; + h->hash = NULL; + h->next = NULL; + eassert (index_size == 1); + h->index = (ptrdiff_t *)empty_hash_index_vector; + h->next_free = -1; + } + else + { + h->key_and_value = hash_table_alloc_bytes (2 * size + * sizeof *h->key_and_value); + for (ptrdiff_t i = 0; i < 2 * size; i++) + h->key_and_value[i] = HASH_UNUSED_ENTRY_KEY; + + h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); + memclear (h->hash, size * sizeof *h->hash); + + h->next = hash_table_alloc_bytes (size * sizeof *h->next); + for (ptrdiff_t i = 0; i < size - 1; i++) + h->next[i] = i + 1; + h->next[size - 1] = -1; + + h->index = hash_table_alloc_bytes (index_size * sizeof *h->index); + for (ptrdiff_t i = 0; i < index_size; i++) + h->index[i] = -1; + + h->next_free = 0; + } + h->next_weak = NULL; h->purecopy = purecopy; h->mutable = true; - /* Set up the free list. */ - for (i = 0; i < size - 1; ++i) - set_hash_next_slot (h, i, i + 1); - if (size > 0) - set_hash_next_slot (h, size - 1, -1); - h->next_free = size > 0 ? 0 : -1; - + Lisp_Object table; XSET_HASH_TABLE (table, h); eassert (HASH_TABLE_P (table)); eassert (XHASH_TABLE (table) == h); @@ -4597,35 +4623,37 @@ copy_hash_table (struct Lisp_Hash_Table *h1) h2 = allocate_hash_table (); *h2 = *h1; h2->mutable = true; - h2->key_and_value = Fcopy_sequence (h1->key_and_value); - h2->hash = Fcopy_sequence (h1->hash); - h2->next = Fcopy_sequence (h1->next); - h2->index = Fcopy_sequence (h1->index); + + if (h1->table_size > 0) + { + ptrdiff_t kv_bytes = 2 * h1->table_size * sizeof *h1->key_and_value; + h2->key_and_value = hash_table_alloc_bytes (kv_bytes); + memcpy (h2->key_and_value, h1->key_and_value, kv_bytes); + + ptrdiff_t hash_bytes = h1->table_size * sizeof *h1->hash; + h2->hash = hash_table_alloc_bytes (hash_bytes); + memcpy (h2->hash, h1->hash, hash_bytes); + + ptrdiff_t next_bytes = h1->table_size * sizeof *h1->next; + h2->next = hash_table_alloc_bytes (next_bytes); + memcpy (h2->next, h1->next, next_bytes); + + ptrdiff_t index_bytes = h1->index_size * sizeof *h1->index; + h2->index = hash_table_alloc_bytes (index_bytes); + memcpy (h2->index, h1->index, index_bytes); + } XSET_HASH_TABLE (table, h2); return table; } -/* Allocate a Lisp vector of NEW_SIZE elements. - Copy elements from VEC and leave the rest undefined. */ -static Lisp_Object -alloc_larger_vector (Lisp_Object vec, ptrdiff_t new_size) -{ - eassert (VECTORP (vec)); - ptrdiff_t old_size = ASIZE (vec); - eassert (new_size >= old_size); - struct Lisp_Vector *v = allocate_vector (new_size); - memcpy (v->contents, XVECTOR (vec)->contents, old_size * sizeof *v->contents); - XSETVECTOR (vec, v); - return vec; -} - /* Compute index into the index vector from a hash value. */ static inline ptrdiff_t hash_index_index (struct Lisp_Hash_Table *h, Lisp_Object hash_code) { - return XUFIXNUM (hash_code) % ASIZE (h->index); + eassert (h->index_size > 0); + return XUFIXNUM (hash_code) % h->index_size; } /* Resize hash table H if it's too full. If H cannot be resized @@ -4650,37 +4678,56 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) /* Allocate all the new vectors before updating *H, to avoid problems if memory is exhausted. */ - Lisp_Object next = alloc_larger_vector (h->next, new_size); + ptrdiff_t *next = hash_table_alloc_bytes (new_size * sizeof *next); for (ptrdiff_t i = old_size; i < new_size - 1; i++) - ASET (next, i, make_fixnum (i + 1)); - ASET (next, new_size - 1, make_fixnum (-1)); + next[i] = i + 1; + next[new_size - 1] = -1; - /* Build the new&larger key_and_value vector, making sure the new - fields are initialized to `unbound`. */ - Lisp_Object key_and_value - = alloc_larger_vector (h->key_and_value, 2 * new_size); + Lisp_Object *key_and_value + = hash_table_alloc_bytes (2 * new_size * sizeof *key_and_value); + memcpy (key_and_value, h->key_and_value, + 2 * old_size * sizeof *key_and_value); for (ptrdiff_t i = 2 * old_size; i < 2 * new_size; i++) - ASET (key_and_value, i, HASH_UNUSED_ENTRY_KEY); + key_and_value[i] = HASH_UNUSED_ENTRY_KEY; - Lisp_Object hash = alloc_larger_vector (h->hash, new_size); - memclear (XVECTOR (hash)->contents + old_size, - (new_size - old_size) * word_size); + Lisp_Object *hash = hash_table_alloc_bytes (new_size * sizeof *hash); + memcpy (hash, h->hash, old_size * sizeof *hash); + memclear (hash + old_size, (new_size - old_size) * word_size); + + ptrdiff_t old_index_size = h->index_size; ptrdiff_t index_size = hash_index_size (new_size); - h->index = make_vector (index_size, make_fixnum (-1)); + ptrdiff_t *index = hash_table_alloc_bytes (index_size * sizeof *index); + for (ptrdiff_t i = 0; i < index_size; i++) + index[i] = -1; + + h->index_size = index_size; + h->table_size = new_size; + h->next_free = old_size; + + if (old_index_size > 1) + hash_table_free_bytes (h->index, old_index_size * sizeof *h->index); + h->index = index; + + hash_table_free_bytes (h->key_and_value, + 2 * old_size * sizeof *h->key_and_value); h->key_and_value = key_and_value; + + hash_table_free_bytes (h->hash, old_size * sizeof *h->hash); h->hash = hash; + + hash_table_free_bytes (h->next, old_size * sizeof *h->next); h->next = next; - h->next_free = old_size; - /* Rehash. */ + h->key_and_value = key_and_value; + + /* Rehash: all data occupy entries 0..old_size-1. */ for (ptrdiff_t i = 0; i < old_size; i++) - if (!NILP (HASH_HASH (h, i))) - { - Lisp_Object hash_code = HASH_HASH (h, i); - ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); - set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); - set_hash_index_slot (h, start_of_bucket, i); - } + { + Lisp_Object hash_code = HASH_HASH (h, i); + ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); + set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); + set_hash_index_slot (h, start_of_bucket, i); + } #ifdef ENABLE_CHECKING if (HASH_TABLE_P (Vpurify_flag) && XHASH_TABLE (Vpurify_flag) == h) @@ -4710,14 +4757,22 @@ hash_table_thaw (Lisp_Object hash_table) /* Freezing discarded most non-essential information; recompute it. The allocation is minimal with no room for growth. */ h->test = *hash_table_test_from_std (h->frozen_test); - ptrdiff_t size = ASIZE (h->key_and_value) / 2; - h->count = size; + ptrdiff_t size = h->count; + h->table_size = size; ptrdiff_t index_size = hash_index_size (size); + h->index_size = index_size; h->next_free = -1; - h->hash = make_nil_vector (size); - h->next = make_vector (size, make_fixnum (-1)); - h->index = make_vector (index_size, make_fixnum (-1)); + h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); + memclear (h->hash, size * sizeof *h->hash); + + h->next = hash_table_alloc_bytes (size * sizeof *h->next); + for (ptrdiff_t i = 0; i < size; i++) + h->next[i] = -1; + + h->index = hash_table_alloc_bytes (index_size * sizeof *h->index); + for (ptrdiff_t i = 0; i < index_size; i++) + h->index[i] = -1; /* Recompute the actual hash codes for each entry in the table. Order is still invalid. */ @@ -4843,7 +4898,7 @@ hash_clear (struct Lisp_Hash_Table *h) if (h->count > 0) { ptrdiff_t size = HASH_TABLE_SIZE (h); - memclear (xvector_contents (h->hash), size * word_size); + memclear (h->hash, size * word_size); for (ptrdiff_t i = 0; i < size; i++) { set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1); @@ -4851,8 +4906,8 @@ hash_clear (struct Lisp_Hash_Table *h) set_hash_value_slot (h, i, Qnil); } - for (ptrdiff_t i = 0; i < ASIZE (h->index); i++) - ASET (h->index, i, make_fixnum (-1)); + for (ptrdiff_t i = 0; i < h->index_size; i++) + h->index[i] = -1; h->next_free = 0; h->count = 0; @@ -4890,7 +4945,7 @@ keep_entry_p (hash_table_weakness_t weakness, bool sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) { - ptrdiff_t n = gc_asize (h->index); + ptrdiff_t n = h->index_size; bool marked = false; for (ptrdiff_t bucket = 0; bucket < n; ++bucket) @@ -4928,8 +4983,7 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) /* Clear key, value, and hash. */ set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); - if (!NILP (h->hash)) - set_hash_hash_slot (h, i, Qnil); + set_hash_hash_slot (h, i, Qnil); eassert (h->count != 0); h->count--; @@ -5563,7 +5617,7 @@ DEFUN ("internal--hash-table-histogram", struct Lisp_Hash_Table *h = check_hash_table (hash_table); ptrdiff_t size = HASH_TABLE_SIZE (h); ptrdiff_t *freq = xzalloc (size * sizeof *freq); - ptrdiff_t index_size = ASIZE (h->index); + ptrdiff_t index_size = h->index_size; for (ptrdiff_t i = 0; i < index_size; i++) { ptrdiff_t n = 0; @@ -5591,7 +5645,7 @@ Internal use only. */) { struct Lisp_Hash_Table *h = check_hash_table (hash_table); Lisp_Object ret = Qnil; - ptrdiff_t index_size = ASIZE (h->index); + ptrdiff_t index_size = h->index_size; for (ptrdiff_t i = 0; i < index_size; i++) { Lisp_Object bucket = Qnil; @@ -5612,8 +5666,7 @@ DEFUN ("internal--hash-table-index-size", (Lisp_Object hash_table) { struct Lisp_Hash_Table *h = check_hash_table (hash_table); - ptrdiff_t index_size = ASIZE (h->index); - return make_int (index_size); + return make_int (h->index_size); } diff --git a/src/lisp.h b/src/lisp.h index f863df6bca0..dd457392cca 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2450,25 +2450,28 @@ struct Lisp_Hash_Table The table is physically split into three vectors (hash, next, key_and_value) which may or may not be beneficial. */ - /* Vector of hash codes, or nil if the table needs rehashing. - If the I-th entry is unused, then hash[I] should be nil. */ - Lisp_Object hash; + /* Bucket vector. An entry of -1 indicates no item is present, + and a nonnegative entry is the index of the first item in + a collision chain. + This vector is index_size entries long. + If index_size is 1 (and table_size is 0), then this is the + constant read-only vector {-1}, shared between all instances. + Otherwise it is heap-allocated. */ + ptrdiff_t *index; + ptrdiff_t index_size; /* Size of the index vector. */ + + ptrdiff_t table_size; /* Size of the next and hash vectors. */ + + /* Vector of hash codes. Each entry is either a fixnum, or nil if unused. + This vector is table_size entries long. */ + Lisp_Object *hash; /* Vector used to chain entries. If entry I is free, next[I] is the entry number of the next free item. If entry I is non-free, next[I] is the index of the next entry in the collision chain, - or -1 if there is such entry. */ - Lisp_Object next; - - /* Bucket vector. An entry of -1 indicates no item is present, - and a nonnegative entry is the index of the first item in - a collision chain. This vector's size can be larger than the - hash table size to reduce collisions. */ - Lisp_Object index; - - /* Only the fields above are traced normally by the GC. The ones after - 'index' are special and are either ignored by the GC or traced in - a special way (e.g. because of weakness). */ + or -1 if there is no such entry. + This vector is table_size entries long. */ + ptrdiff_t *next; /* Number of key/value entries in the table. */ ptrdiff_t count; @@ -2494,8 +2497,9 @@ struct Lisp_Hash_Table /* Vector of keys and values. The key of item I is found at index 2 * I, the value is found at index 2 * I + 1. If the key is HASH_UNUSED_ENTRY_KEY, then this slot is unused. - This is gc_marked specially if the table is weak. */ - Lisp_Object key_and_value; + This is gc_marked specially if the table is weak. + This vector is 2 * table_size entries long. */ + Lisp_Object *key_and_value; /* The comparison and hash functions. */ struct hash_table_test test; @@ -2506,9 +2510,6 @@ struct Lisp_Hash_Table struct Lisp_Hash_Table *next_weak; } GCALIGNED_STRUCT; -/* Sanity-check pseudovector layout. */ -verify (offsetof (struct Lisp_Hash_Table, hash) == header_size); - /* Key value that marks an unused hash table entry. */ #define HASH_UNUSED_ENTRY_KEY Qunbound @@ -2539,28 +2540,31 @@ XHASH_TABLE (Lisp_Object a) INLINE Lisp_Object HASH_KEY (const struct Lisp_Hash_Table *h, ptrdiff_t idx) { - return AREF (h->key_and_value, 2 * idx); + eassert (idx >= 0 && idx < h->table_size); + return h->key_and_value[2 * idx]; } /* Value is the value part of entry IDX in hash table H. */ INLINE Lisp_Object HASH_VALUE (const struct Lisp_Hash_Table *h, ptrdiff_t idx) { - return AREF (h->key_and_value, 2 * idx + 1); + eassert (idx >= 0 && idx < h->table_size); + return h->key_and_value[2 * idx + 1]; } /* Value is the hash code computed for entry IDX in hash table H. */ INLINE Lisp_Object HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx) { - return AREF (h->hash, idx); + eassert (idx >= 0 && idx < h->table_size); + return h->hash[idx]; } /* Value is the size of hash table H. */ INLINE ptrdiff_t HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) { - return ASIZE (h->next); + return h->table_size; } /* Compute hash value for KEY in hash table H. */ @@ -3781,13 +3785,15 @@ vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object const *args, INLINE void set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) { - gc_aset (h->key_and_value, 2 * idx, val); + eassert (idx >= 0 && idx < h->table_size); + h->key_and_value[2 * idx] = val; } INLINE void set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) { - gc_aset (h->key_and_value, 2 * idx + 1, val); + eassert (idx >= 0 && idx < h->table_size); + h->key_and_value[2 * idx + 1] = val;; } /* Use these functions to set Lisp_Object @@ -4458,6 +4464,9 @@ extern void syms_of_alloc (void); extern struct buffer *allocate_buffer (void) ATTRIBUTE_RETURNS_NONNULL; extern int valid_lisp_object_p (Lisp_Object); +void *hash_table_alloc_bytes (ptrdiff_t nbytes); +void hash_table_free_bytes (void *p, ptrdiff_t nbytes); + /* Defined in gmalloc.c. */ #if !defined DOUG_LEA_MALLOC && !defined HYBRID_MALLOC && !defined SYSTEM_MALLOC extern size_t __malloc_extra_blocks; diff --git a/src/pdumper.c b/src/pdumper.c index e4349f0cb17..8a93c45e07b 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2648,12 +2648,13 @@ dump_vectorlike_generic (struct dump_context *ctx, /* Return a vector of KEY, VALUE pairs in the given hash table H. No room for growth is included. */ -static Lisp_Object +static Lisp_Object * hash_table_contents (struct Lisp_Hash_Table *h) { ptrdiff_t old_size = HASH_TABLE_SIZE (h); ptrdiff_t size = h->count; - Lisp_Object key_and_value = make_uninit_vector (2 * size); + Lisp_Object *key_and_value = hash_table_alloc_bytes (2 * size + * sizeof *key_and_value); ptrdiff_t n = 0; /* Make sure key_and_value ends up in the same order; charset.c @@ -2662,8 +2663,8 @@ hash_table_contents (struct Lisp_Hash_Table *h) for (ptrdiff_t i = 0; i < old_size; i++) if (!NILP (HASH_HASH (h, i))) { - ASET (key_and_value, n++, HASH_KEY (h, i)); - ASET (key_and_value, n++, HASH_VALUE (h, i)); + key_and_value[n++] = HASH_KEY (h, i); + key_and_value[n++] = HASH_VALUE (h, i); } return key_and_value; @@ -2698,14 +2699,37 @@ static void hash_table_freeze (struct Lisp_Hash_Table *h) { h->key_and_value = hash_table_contents (h); - eassert (ASIZE (h->key_and_value) == h->count * 2); - h->next = Qnil; - h->hash = Qnil; - h->index = Qnil; - h->count = 0; + h->next = NULL; + h->hash = NULL; + h->index = NULL; + h->table_size = 0; + h->index_size = 0; h->frozen_test = hash_table_std_test (&h->test); } +static dump_off +dump_hash_table_contents (struct dump_context *ctx, struct Lisp_Hash_Table *h) +{ + dump_align_output (ctx, DUMP_ALIGNMENT); + dump_off start_offset = ctx->offset; + ptrdiff_t n = 2 * h->count; + + struct dump_flags old_flags = ctx->flags; + ctx->flags.pack_objects = true; + + for (ptrdiff_t i = 0; i < n; i++) + { + Lisp_Object out; + const Lisp_Object *slot = &h->key_and_value[i]; + dump_object_start (ctx, &out, sizeof out); + dump_field_lv (ctx, &out, slot, slot, WEIGHT_STRONG); + dump_object_finish (ctx, &out, sizeof out); + } + + ctx->flags = old_flags; + return start_offset; +} + static dump_off dump_hash_table (struct dump_context *ctx, Lisp_Object object) { @@ -2721,15 +2745,21 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object) START_DUMP_PVEC (ctx, &hash->header, struct Lisp_Hash_Table, out); dump_pseudovector_lisp_fields (ctx, &out->header, &hash->header); - /* TODO: dump the hash bucket vectors synchronously here to keep - them as close to the hash table as possible. */ + DUMP_FIELD_COPY (out, hash, count); DUMP_FIELD_COPY (out, hash, weakness); DUMP_FIELD_COPY (out, hash, purecopy); DUMP_FIELD_COPY (out, hash, mutable); DUMP_FIELD_COPY (out, hash, frozen_test); - dump_field_lv (ctx, out, hash, &hash->key_and_value, WEIGHT_STRONG); + if (hash->key_and_value) + dump_field_fixup_later (ctx, out, hash, &hash->key_and_value); eassert (hash->next_weak == NULL); - return finish_dump_pvec (ctx, &out->header); + dump_off offset = finish_dump_pvec (ctx, &out->header); + if (hash->key_and_value) + dump_remember_fixup_ptr_raw + (ctx, + offset + dump_offsetof (struct Lisp_Hash_Table, key_and_value), + dump_hash_table_contents (ctx, hash)); + return offset; } static dump_off diff --git a/src/print.c b/src/print.c index cc8df639f4f..c27c66ae40a 100644 --- a/src/print.c +++ b/src/print.c @@ -1455,8 +1455,8 @@ print_preprocess (Lisp_Object obj) if (HASH_TABLE_P (obj)) { struct Lisp_Hash_Table *h = XHASH_TABLE (obj); - obj = h->key_and_value; - continue; + pp_stack_push_values (h->key_and_value, + 2 * h->table_size); } break; } -- cgit v1.2.3 From a3ae5653cfe1ab2b3eb4c77ce729844ad442b562 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 29 Oct 2023 11:57:06 +0100 Subject: Store hash values as integers instead of Lisp_Object This improves typing, saves pointless tagging and untagging, and prepares for further changes. The new typedef hash_hash_t is an alias for EMACS_UINT, and hash values are still limited to the fixnum range. We now use hash_unused instead of Qnil to mark unused entries. * src/lisp.h (hash_hash_t): New typedef for EMACS_UINT. (hash_unused): New constant. (struct hash_table_test): `hashfn` now returns hash_hash_t. All callers and implementations changed. (struct Lisp_Hash_Table): Retype hash vector to an array of hash_hash_t. All code using it changed accordingly. (HASH_HASH, hash_from_key): * src/fns.c (set_hash_index_slot, hash_index_index) (hash_lookup_with_hash, hash_lookup_get_hash, hash_put): (hash_lookup, hash_put): Retype hash value arguments and return values. All callers adapted. --- src/category.c | 2 +- src/charset.c | 2 +- src/composite.c | 5 ++-- src/emacs-module.c | 3 ++- src/fns.c | 74 ++++++++++++++++++++++++++++-------------------------- src/image.c | 3 ++- src/json.c | 3 ++- src/lisp.h | 25 ++++++++++++------ src/lread.c | 8 +++--- src/macfont.m | 5 ++-- src/pdumper.c | 2 +- 11 files changed, 75 insertions(+), 57 deletions(-) diff --git a/src/category.c b/src/category.c index 583cdb3eebb..e7fbf1ff500 100644 --- a/src/category.c +++ b/src/category.c @@ -53,7 +53,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set) (table, 1, make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false)); struct Lisp_Hash_Table *h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); - Lisp_Object hash; + hash_hash_t hash; ptrdiff_t i = hash_lookup (h, category_set, &hash); if (i >= 0) return HASH_KEY (h, i); diff --git a/src/charset.c b/src/charset.c index 3aa105e57bd..add3bf846f8 100644 --- a/src/charset.c +++ b/src/charset.c @@ -850,7 +850,6 @@ usage: (define-charset-internal ...) */) /* Charset attr vector. */ Lisp_Object attrs; Lisp_Object val; - Lisp_Object hash_code; struct Lisp_Hash_Table *hash_table = XHASH_TABLE (Vcharset_hash_table); int i, j; struct charset charset; @@ -1108,6 +1107,7 @@ usage: (define-charset-internal ...) */) CHECK_LIST (args[charset_arg_plist]); ASET (attrs, charset_plist, args[charset_arg_plist]); + hash_hash_t hash_code; charset.hash_index = hash_lookup (hash_table, args[charset_arg_name], &hash_code); if (charset.hash_index >= 0) diff --git a/src/composite.c b/src/composite.c index ed1aeb380a0..bd69a953e3f 100644 --- a/src/composite.c +++ b/src/composite.c @@ -166,7 +166,7 @@ ptrdiff_t get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, Lisp_Object prop, Lisp_Object string) { - Lisp_Object id, length, components, key, *key_contents, hash_code; + Lisp_Object id, length, components, key, *key_contents; ptrdiff_t glyph_len; struct Lisp_Hash_Table *hash_table = XHASH_TABLE (composition_hash_table); ptrdiff_t hash_index; @@ -240,6 +240,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, else goto invalid_composition; + hash_hash_t hash_code; hash_index = hash_lookup (hash_table, key, &hash_code); if (hash_index >= 0) { @@ -653,7 +654,7 @@ composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len) { struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table); Lisp_Object header = LGSTRING_HEADER (gstring); - Lisp_Object hash = hash_from_key (h, header); + EMACS_UINT hash = hash_from_key (h, header); if (len < 0) { ptrdiff_t glyph_len = LGSTRING_GLYPH_LEN (gstring); diff --git a/src/emacs-module.c b/src/emacs-module.c index 60aed68f2cd..728da8c2882 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -427,7 +427,8 @@ module_make_global_ref (emacs_env *env, emacs_value value) { MODULE_FUNCTION_BEGIN (NULL); struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); - Lisp_Object new_obj = value_to_lisp (value), hashcode; + Lisp_Object new_obj = value_to_lisp (value); + hash_hash_t hashcode; ptrdiff_t i = hash_lookup (h, new_obj, &hashcode); /* Note: This approach requires the garbage collector to never move diff --git a/src/fns.c b/src/fns.c index 3aca588a8a5..5a3c51c8412 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2759,7 +2759,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, case Lisp_Cons: case Lisp_Vectorlike: { struct Lisp_Hash_Table *h = XHASH_TABLE (ht); - Lisp_Object hash; + hash_hash_t hash; ptrdiff_t i = hash_lookup (h, o1, &hash); if (i >= 0) { /* `o1' was seen already. */ @@ -4279,7 +4279,7 @@ set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) h->next[idx] = val; } static void -set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) +set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, hash_hash_t val) { eassert (idx >= 0 && idx < h->table_size); h->hash[idx] = val; @@ -4450,41 +4450,42 @@ cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2, /* Ignore H and return a hash code for KEY which uses 'eq' to compare keys. */ -static Lisp_Object +static hash_hash_t hashfn_eq (Lisp_Object key, struct Lisp_Hash_Table *h) { if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (key)) key = SYMBOL_WITH_POS_SYM (key); - return make_ufixnum (XHASH (key) ^ XTYPE (key)); + return XHASH (key) ^ XTYPE (key); } /* Ignore H and return a hash code for KEY which uses 'equal' to compare keys. The hash code is at most INTMASK. */ -static Lisp_Object +static hash_hash_t hashfn_equal (Lisp_Object key, struct Lisp_Hash_Table *h) { - return make_ufixnum (sxhash (key)); + return sxhash (key); } /* Ignore H and return a hash code for KEY which uses 'eql' to compare keys. The hash code is at most INTMASK. */ -static Lisp_Object +static hash_hash_t hashfn_eql (Lisp_Object key, struct Lisp_Hash_Table *h) { - return (FLOATP (key) || BIGNUMP (key) ? hashfn_equal : hashfn_eq) (key, h); + return (FLOATP (key) || BIGNUMP (key) + ? hashfn_equal (key, h) : hashfn_eq (key, h)); } /* Given H, return a hash code for KEY which uses a user-defined function to compare keys. */ -static Lisp_Object +static hash_hash_t hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h) { Lisp_Object args[] = { h->test.user_hash_function, key }; Lisp_Object hash = hash_table_user_defined_call (ARRAYELTS (args), args, h); - return FIXNUMP (hash) ? hash : make_ufixnum (sxhash (hash)); + return FIXNUMP (hash) ? XUFIXNUM(hash) : sxhash (hash); } struct hash_table_test const @@ -4584,7 +4585,8 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, h->key_and_value[i] = HASH_UNUSED_ENTRY_KEY; h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); - memclear (h->hash, size * sizeof *h->hash); + for (ptrdiff_t i = 0; i < size; i++) + h->hash[i] = hash_unused; h->next = hash_table_alloc_bytes (size * sizeof *h->next); for (ptrdiff_t i = 0; i < size - 1; i++) @@ -4650,10 +4652,10 @@ copy_hash_table (struct Lisp_Hash_Table *h1) /* Compute index into the index vector from a hash value. */ static inline ptrdiff_t -hash_index_index (struct Lisp_Hash_Table *h, Lisp_Object hash_code) +hash_index_index (struct Lisp_Hash_Table *h, hash_hash_t hash) { eassert (h->index_size > 0); - return XUFIXNUM (hash_code) % h->index_size; + return hash % h->index_size; } /* Resize hash table H if it's too full. If H cannot be resized @@ -4690,9 +4692,10 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) for (ptrdiff_t i = 2 * old_size; i < 2 * new_size; i++) key_and_value[i] = HASH_UNUSED_ENTRY_KEY; - Lisp_Object *hash = hash_table_alloc_bytes (new_size * sizeof *hash); + hash_hash_t *hash = hash_table_alloc_bytes (new_size * sizeof *hash); memcpy (hash, h->hash, old_size * sizeof *hash); - memclear (hash + old_size, (new_size - old_size) * word_size); + for (ptrdiff_t i = old_size; i < new_size; i++) + hash[i] = hash_unused; ptrdiff_t old_index_size = h->index_size; ptrdiff_t index_size = hash_index_size (new_size); @@ -4723,7 +4726,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) /* Rehash: all data occupy entries 0..old_size-1. */ for (ptrdiff_t i = 0; i < old_size; i++) { - Lisp_Object hash_code = HASH_HASH (h, i); + hash_hash_t hash_code = HASH_HASH (h, i); ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); set_hash_index_slot (h, start_of_bucket, i); @@ -4764,7 +4767,8 @@ hash_table_thaw (Lisp_Object hash_table) h->next_free = -1; h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); - memclear (h->hash, size * sizeof *h->hash); + for (ptrdiff_t i = 0; i < size; i++) + h->hash[i] = hash_unused; h->next = hash_table_alloc_bytes (size * sizeof *h->next); for (ptrdiff_t i = 0; i < size; i++) @@ -4779,7 +4783,7 @@ hash_table_thaw (Lisp_Object hash_table) for (ptrdiff_t i = 0; i < size; i++) { Lisp_Object key = HASH_KEY (h, i); - Lisp_Object hash_code = hash_from_key (h, key); + hash_hash_t hash_code = hash_from_key (h, key); ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); set_hash_hash_slot (h, i, hash_code); set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); @@ -4792,9 +4796,9 @@ hash_table_thaw (Lisp_Object hash_table) matching KEY, or -1 if not found. */ ptrdiff_t -hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object *hash) +hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, hash_hash_t *hash) { - Lisp_Object hash_code = hash_from_key (h, key); + hash_hash_t hash_code = hash_from_key (h, key); if (hash) *hash = hash_code; @@ -4803,7 +4807,7 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object *hash) for (i = HASH_INDEX (h, start_of_bucket); 0 <= i; i = HASH_NEXT (h, i)) if (EQ (key, HASH_KEY (h, i)) || (h->test.cmpfn - && EQ (hash_code, HASH_HASH (h, i)) + && hash_code == HASH_HASH (h, i) && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), h)))) break; @@ -4824,7 +4828,7 @@ check_mutable_hash_table (Lisp_Object obj, struct Lisp_Hash_Table *h) ptrdiff_t hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, - Lisp_Object hash) + hash_hash_t hash) { /* Increment count after resizing because resizing may fail. */ maybe_resize_hash_table (h); @@ -4832,7 +4836,7 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, /* Store key/value in the key_and_value vector. */ ptrdiff_t i = h->next_free; - eassert (NILP (HASH_HASH (h, i))); + eassert (HASH_HASH (h, i) == hash_unused); eassert (hash_unused_entry_key_p (HASH_KEY (h, i))); h->next_free = HASH_NEXT (h, i); set_hash_key_slot (h, i, key); @@ -4854,8 +4858,8 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, void hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) { - Lisp_Object hash_code = hash_from_key (h, key); - ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); + hash_hash_t hashval = hash_from_key (h, key); + ptrdiff_t start_of_bucket = hash_index_index (h, hashval); ptrdiff_t prev = -1; for (ptrdiff_t i = HASH_INDEX (h, start_of_bucket); @@ -4864,7 +4868,7 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) { if (EQ (key, HASH_KEY (h, i)) || (h->test.cmpfn - && EQ (hash_code, HASH_HASH (h, i)) + && hashval == HASH_HASH (h, i) && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), h)))) { /* Take entry out of collision chain. */ @@ -4877,7 +4881,7 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) the free list. */ set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); - set_hash_hash_slot (h, i, Qnil); + set_hash_hash_slot (h, i, hash_unused); set_hash_next_slot (h, i, h->next_free); h->next_free = i; h->count--; @@ -4898,9 +4902,9 @@ hash_clear (struct Lisp_Hash_Table *h) if (h->count > 0) { ptrdiff_t size = HASH_TABLE_SIZE (h); - memclear (h->hash, size * word_size); for (ptrdiff_t i = 0; i < size; i++) { + set_hash_hash_slot (h, i, hash_unused); set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1); set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); @@ -4983,7 +4987,7 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) /* Clear key, value, and hash. */ set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); - set_hash_hash_slot (h, i, Qnil); + set_hash_hash_slot (h, i, hash_unused); eassert (h->count != 0); h->count--; @@ -5269,7 +5273,7 @@ If (eq A B), then (= (sxhash-eq A) (sxhash-eq B)). Hash codes are not guaranteed to be preserved across Emacs sessions. */) (Lisp_Object obj) { - return hashfn_eq (obj, NULL); + return make_ufixnum (hashfn_eq (obj, NULL)); } DEFUN ("sxhash-eql", Fsxhash_eql, Ssxhash_eql, 1, 1, 0, @@ -5280,7 +5284,7 @@ isn't necessarily true. Hash codes are not guaranteed to be preserved across Emacs sessions. */) (Lisp_Object obj) { - return hashfn_eql (obj, NULL); + return make_ufixnum (hashfn_eql (obj, NULL)); } DEFUN ("sxhash-equal", Fsxhash_equal, Ssxhash_equal, 1, 1, 0, @@ -5291,7 +5295,7 @@ opposite isn't necessarily true. Hash codes are not guaranteed to be preserved across Emacs sessions. */) (Lisp_Object obj) { - return hashfn_equal (obj, NULL); + return make_ufixnum (hashfn_equal (obj, NULL)); } DEFUN ("sxhash-equal-including-properties", Fsxhash_equal_including_properties, @@ -5315,7 +5319,7 @@ Hash codes are not guaranteed to be preserved across Emacs sessions. */) sxhash (CDR (collector))))); } - return hashfn_equal (obj, NULL); + return make_ufixnum (hashfn_equal (obj, NULL)); } DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0, @@ -5549,7 +5553,7 @@ VALUE. In any case, return VALUE. */) struct Lisp_Hash_Table *h = check_hash_table (table); check_mutable_hash_table (table, h); - Lisp_Object hash; + EMACS_UINT hash; ptrdiff_t i = hash_lookup (h, key, &hash); if (i >= 0) set_hash_value_slot (h, i, value); @@ -5650,7 +5654,7 @@ Internal use only. */) { Lisp_Object bucket = Qnil; for (ptrdiff_t j = HASH_INDEX (h, i); j != -1; j = HASH_NEXT (h, j)) - bucket = Fcons (Fcons (HASH_KEY (h, j), HASH_HASH (h, j)), + bucket = Fcons (Fcons (HASH_KEY (h, j), make_int (HASH_HASH (h, j))), bucket); if (!NILP (bucket)) ret = Fcons (Fnreverse (bucket), ret); diff --git a/src/image.c b/src/image.c index 9c100213590..55b027d568b 100644 --- a/src/image.c +++ b/src/image.c @@ -6079,8 +6079,9 @@ xpm_put_color_table_h (Lisp_Object color_table, Lisp_Object color) { struct Lisp_Hash_Table *table = XHASH_TABLE (color_table); - Lisp_Object chars = make_unibyte_string (chars_start, chars_len), hash_code; + Lisp_Object chars = make_unibyte_string (chars_start, chars_len); + hash_hash_t hash_code; hash_lookup (table, chars, &hash_code); hash_put (table, chars, color, hash_code); } diff --git a/src/json.c b/src/json.c index d98b312ecc9..1bea4baa8ba 100644 --- a/src/json.c +++ b/src/json.c @@ -879,7 +879,8 @@ json_to_lisp (json_t *json, const struct json_configuration *conf) json_t *value; json_object_foreach (json, key_str, value) { - Lisp_Object key = build_string_from_utf8 (key_str), hash; + Lisp_Object key = build_string_from_utf8 (key_str); + hash_hash_t hash; ptrdiff_t i = hash_lookup (h, key, &hash); /* Keys in JSON objects are unique, so the key can't be present yet. */ diff --git a/src/lisp.h b/src/lisp.h index dd457392cca..474498094c9 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2385,6 +2385,10 @@ INLINE int struct Lisp_Hash_Table; +/* The type of a hash value stored in the table. + It's unsigned and a subtype of EMACS_UINT. */ +typedef EMACS_UINT hash_hash_t; + typedef enum { Test_eql, Test_eq, @@ -2406,7 +2410,7 @@ struct hash_table_test Lisp_Object (*cmpfn) (Lisp_Object, Lisp_Object, struct Lisp_Hash_Table *); /* C function to compute hash code. */ - Lisp_Object (*hashfn) (Lisp_Object, struct Lisp_Hash_Table *); + hash_hash_t (*hashfn) (Lisp_Object, struct Lisp_Hash_Table *); }; typedef enum { @@ -2421,6 +2425,11 @@ typedef enum { both key and value remain. */ } hash_table_weakness_t; +/* An value that marks an unused hash entry. + Any hash_hash_t value that is not a valid fixnum will do here. */ +enum { hash_unused = (hash_hash_t)MOST_POSITIVE_FIXNUM + 1 }; +verify (FIXNUM_OVERFLOW_P (hash_unused)); + struct Lisp_Hash_Table { union vectorlike_header header; @@ -2462,9 +2471,9 @@ struct Lisp_Hash_Table ptrdiff_t table_size; /* Size of the next and hash vectors. */ - /* Vector of hash codes. Each entry is either a fixnum, or nil if unused. + /* Vector of hash codes. The value hash_unused marks an unused table entry. This vector is table_size entries long. */ - Lisp_Object *hash; + hash_hash_t *hash; /* Vector used to chain entries. If entry I is free, next[I] is the entry number of the next free item. If entry I is non-free, @@ -2553,7 +2562,7 @@ HASH_VALUE (const struct Lisp_Hash_Table *h, ptrdiff_t idx) } /* Value is the hash code computed for entry IDX in hash table H. */ -INLINE Lisp_Object +INLINE hash_hash_t HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx) { eassert (idx >= 0 && idx < h->table_size); @@ -2567,8 +2576,8 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) return h->table_size; } -/* Compute hash value for KEY in hash table H. */ -INLINE Lisp_Object +/* Hash value for KEY in hash table H. */ +INLINE hash_hash_t hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) { return h->test.hashfn (key, h); @@ -4054,9 +4063,9 @@ EMACS_UINT sxhash (Lisp_Object); Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, hash_table_weakness_t, bool); Lisp_Object hash_table_weakness_symbol (hash_table_weakness_t weak); -ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object *); +ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, hash_hash_t *); ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, - Lisp_Object); + hash_hash_t); void hash_remove_from_table (struct Lisp_Hash_Table *, Lisp_Object); extern struct hash_table_test const hashtest_eq, hashtest_eql, hashtest_equal; extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object, diff --git a/src/lread.c b/src/lread.c index 284536fc81f..9ad4d35c0c2 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4255,7 +4255,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) struct Lisp_Hash_Table *h = XHASH_TABLE (read_objects_map); Lisp_Object number = make_fixnum (n); - Lisp_Object hash; + hash_hash_t hash; ptrdiff_t i = hash_lookup (h, number, &hash); if (i >= 0) /* Not normal, but input could be malformed. */ @@ -4571,7 +4571,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) struct Lisp_Hash_Table *h2 = XHASH_TABLE (read_objects_completed); - Lisp_Object hash; + hash_hash_t hash; ptrdiff_t i = hash_lookup (h2, placeholder, &hash); eassert (i < 0); hash_put (h2, placeholder, Qnil, hash); @@ -4586,7 +4586,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) { struct Lisp_Hash_Table *h2 = XHASH_TABLE (read_objects_completed); - Lisp_Object hash; + hash_hash_t hash; ptrdiff_t i = hash_lookup (h2, obj, &hash); eassert (i < 0); hash_put (h2, obj, Qnil, hash); @@ -4598,7 +4598,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) /* ...and #n# will use the real value from now on. */ struct Lisp_Hash_Table *h = XHASH_TABLE (read_objects_map); - Lisp_Object hash; + hash_hash_t hash; ptrdiff_t i = hash_lookup (h, e->u.numbered.number, &hash); eassert (i >= 0); set_hash_value_slot (h, i, obj); diff --git a/src/macfont.m b/src/macfont.m index 8aba440d196..dcaa85bea05 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -980,7 +980,7 @@ macfont_invalidate_family_cache (void) ptrdiff_t i, size = HASH_TABLE_SIZE (h); for (i = 0; i < size; ++i) - if (!NILP (HASH_HASH (h, i))) + if (HASH_HASH (h, i) != hash_unused) { Lisp_Object value = HASH_VALUE (h, i); @@ -1017,12 +1017,13 @@ macfont_set_family_cache (Lisp_Object symbol, CFStringRef string) { struct Lisp_Hash_Table *h; ptrdiff_t i; - Lisp_Object hash, value; + Lisp_Object value; if (!HASH_TABLE_P (macfont_family_cache)) macfont_family_cache = CALLN (Fmake_hash_table, QCtest, Qeq); h = XHASH_TABLE (macfont_family_cache); + hash_hash_t hash; i = hash_lookup (h, symbol, &hash); value = string ? make_mint_ptr ((void *) CFRetain (string)) : Qnil; if (i >= 0) diff --git a/src/pdumper.c b/src/pdumper.c index 8a93c45e07b..5ed91c668df 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2661,7 +2661,7 @@ hash_table_contents (struct Lisp_Hash_Table *h) relies on it by expecting hash table indices to stay constant across the dump. */ for (ptrdiff_t i = 0; i < old_size; i++) - if (!NILP (HASH_HASH (h, i))) + if (HASH_HASH (h, i) != hash_unused) { key_and_value[n++] = HASH_KEY (h, i); key_and_value[n++] = HASH_VALUE (h, i); -- cgit v1.2.3 From 3b00255a4c70bc1075446c94a8ff65c987ac143f Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Tue, 21 Nov 2023 12:27:42 +0100 Subject: Inlined and specialised hash table look-up This improves performance in several ways. Separate functions are used depending on whether the caller has a hash value computed or not. * src/fns.c (hash_lookup_with_hash, hash_lookup_get_hash): New. (hash_lookup): Remove hash return argument. All callers adapted. hash_lookup_with_hash hash_hash_t arg --- src/bytecode.c | 2 +- src/category.c | 2 +- src/ccl.c | 4 ++-- src/charset.c | 4 ++-- src/charset.h | 2 +- src/coding.h | 2 +- src/composite.c | 4 ++-- src/emacs-module.c | 4 ++-- src/fns.c | 59 +++++++++++++++++++++++++++++++++++------------------- src/image.c | 4 ++-- src/json.c | 2 +- src/lisp.h | 4 +++- src/lread.c | 13 ++++++------ src/macfont.m | 4 ++-- src/minibuf.c | 2 +- 15 files changed, 66 insertions(+), 46 deletions(-) diff --git a/src/bytecode.c b/src/bytecode.c index e989e5fadf0..a0f02d518b7 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1751,7 +1751,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, break; } else - i = hash_lookup (h, v1, NULL); + i = hash_lookup (h, v1); if (i >= 0) { diff --git a/src/category.c b/src/category.c index e7fbf1ff500..3a406a567a1 100644 --- a/src/category.c +++ b/src/category.c @@ -54,7 +54,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set) make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false)); struct Lisp_Hash_Table *h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); hash_hash_t hash; - ptrdiff_t i = hash_lookup (h, category_set, &hash); + ptrdiff_t i = hash_lookup_get_hash (h, category_set, &hash); if (i >= 0) return HASH_KEY (h, i); hash_put (h, category_set, Qnil, hash); diff --git a/src/ccl.c b/src/ccl.c index b4dda404b95..7df50ba7022 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -1380,7 +1380,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size eop = (FIXNUM_OVERFLOW_P (reg[RRR]) ? -1 - : hash_lookup (h, make_fixnum (reg[RRR]), NULL)); + : hash_lookup (h, make_fixnum (reg[RRR]))); if (eop >= 0) { Lisp_Object opl; @@ -1409,7 +1409,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size eop = (FIXNUM_OVERFLOW_P (i) ? -1 - : hash_lookup (h, make_fixnum (i), NULL)); + : hash_lookup (h, make_fixnum (i))); if (eop >= 0) { Lisp_Object opl; diff --git a/src/charset.c b/src/charset.c index add3bf846f8..6a74f294ad8 100644 --- a/src/charset.c +++ b/src/charset.c @@ -1108,8 +1108,8 @@ usage: (define-charset-internal ...) */) ASET (attrs, charset_plist, args[charset_arg_plist]); hash_hash_t hash_code; - charset.hash_index = hash_lookup (hash_table, args[charset_arg_name], - &hash_code); + charset.hash_index = hash_lookup_get_hash (hash_table, args[charset_arg_name], + &hash_code); if (charset.hash_index >= 0) { new_definition_p = 0; diff --git a/src/charset.h b/src/charset.h index 1743eb4c909..91454d3d73e 100644 --- a/src/charset.h +++ b/src/charset.h @@ -286,7 +286,7 @@ extern int emacs_mule_charset[256]; /* Return an index to Vcharset_hash_table of the charset whose symbol is SYMBOL. */ #define CHARSET_SYMBOL_HASH_INDEX(symbol) \ - hash_lookup (XHASH_TABLE (Vcharset_hash_table), symbol, NULL) + hash_lookup (XHASH_TABLE (Vcharset_hash_table), symbol) /* Return the attribute vector of CHARSET. */ #define CHARSET_ATTRIBUTES(charset) \ diff --git a/src/coding.h b/src/coding.h index e9b72403c6b..9beb4350bbf 100644 --- a/src/coding.h +++ b/src/coding.h @@ -194,7 +194,7 @@ enum coding_attr_index #define CODING_SYSTEM_ID(coding_system_symbol) \ hash_lookup (XHASH_TABLE (Vcoding_system_hash_table), \ - coding_system_symbol, NULL) + coding_system_symbol) /* Return true if CODING_SYSTEM_SYMBOL is a coding system. */ diff --git a/src/composite.c b/src/composite.c index bd69a953e3f..78c884dd72d 100644 --- a/src/composite.c +++ b/src/composite.c @@ -241,7 +241,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, goto invalid_composition; hash_hash_t hash_code; - hash_index = hash_lookup (hash_table, key, &hash_code); + hash_index = hash_lookup_get_hash (hash_table, key, &hash_code); if (hash_index >= 0) { /* We have already registered the same composition. Change PROP @@ -644,7 +644,7 @@ Lisp_Object composition_gstring_lookup_cache (Lisp_Object header) { struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table); - ptrdiff_t i = hash_lookup (h, header, NULL); + ptrdiff_t i = hash_lookup (h, header); return (i >= 0 ? HASH_VALUE (h, i) : Qnil); } diff --git a/src/emacs-module.c b/src/emacs-module.c index 728da8c2882..e78391b3a71 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -429,7 +429,7 @@ module_make_global_ref (emacs_env *env, emacs_value value) struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); Lisp_Object new_obj = value_to_lisp (value); hash_hash_t hashcode; - ptrdiff_t i = hash_lookup (h, new_obj, &hashcode); + ptrdiff_t i = hash_lookup_get_hash (h, new_obj, &hashcode); /* Note: This approach requires the garbage collector to never move objects. */ @@ -468,7 +468,7 @@ module_free_global_ref (emacs_env *env, emacs_value global_value) MODULE_FUNCTION_BEGIN (); struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); Lisp_Object obj = value_to_lisp (global_value); - ptrdiff_t i = hash_lookup (h, obj, NULL); + ptrdiff_t i = hash_lookup (h, obj); if (module_assertions) { diff --git a/src/fns.c b/src/fns.c index 5a3c51c8412..9d802bba0e2 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2731,6 +2731,10 @@ equal_no_quit (Lisp_Object o1, Lisp_Object o2) return internal_equal (o1, o2, EQUAL_NO_QUIT, 0, Qnil); } +static ptrdiff_t hash_lookup_with_hash (struct Lisp_Hash_Table *h, + Lisp_Object key, hash_hash_t hash); + + /* Return true if O1 and O2 are equal. EQUAL_KIND specifies what kind of equality test to use: if it is EQUAL_NO_QUIT, do not check for cycles or large arguments or quits; if EQUAL_PLAIN, do ordinary @@ -2759,8 +2763,8 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, case Lisp_Cons: case Lisp_Vectorlike: { struct Lisp_Hash_Table *h = XHASH_TABLE (ht); - hash_hash_t hash; - ptrdiff_t i = hash_lookup (h, o1, &hash); + hash_hash_t hash = hash_from_key (h, o1); + ptrdiff_t i = hash_lookup_with_hash (h, o1, hash); if (i >= 0) { /* `o1' was seen already. */ Lisp_Object o2s = HASH_VALUE (h, i); @@ -4791,27 +4795,40 @@ hash_table_thaw (Lisp_Object hash_table) } } -/* Lookup KEY in hash table H. If HASH is non-null, return in *HASH - the hash code of KEY. Value is the index of the entry in H - matching KEY, or -1 if not found. */ - -ptrdiff_t -hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, hash_hash_t *hash) +/* Look up KEY with hash HASH in table H. + Return entry index or -1 if none. */ +static ptrdiff_t +hash_lookup_with_hash (struct Lisp_Hash_Table *h, + Lisp_Object key, hash_hash_t hash) { - hash_hash_t hash_code = hash_from_key (h, key); - if (hash) - *hash = hash_code; - - ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); - ptrdiff_t i; - for (i = HASH_INDEX (h, start_of_bucket); 0 <= i; i = HASH_NEXT (h, i)) + ptrdiff_t start_of_bucket = hash_index_index (h, hash); + for (ptrdiff_t i = HASH_INDEX (h, start_of_bucket); + 0 <= i; i = HASH_NEXT (h, i)) if (EQ (key, HASH_KEY (h, i)) || (h->test.cmpfn - && hash_code == HASH_HASH (h, i) + && hash == HASH_HASH (h, i) && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), h)))) - break; + return i; - return i; + return -1; +} + +/* Look up KEY in table H. Return entry index or -1 if none. */ +ptrdiff_t +hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key) +{ + return hash_lookup_with_hash (h, key, hash_from_key (h, key)); +} + +/* Look up KEY in hash table H. Return its hash value in *PHASH. + Value is the index of the entry in H matching KEY, or -1 if not found. */ +ptrdiff_t +hash_lookup_get_hash (struct Lisp_Hash_Table *h, Lisp_Object key, + hash_hash_t *phash) +{ + EMACS_UINT hash = hash_from_key (h, key); + *phash = hash; + return hash_lookup_with_hash (h, key, hash); } static void @@ -5539,7 +5556,7 @@ If KEY is not found, return DFLT which defaults to nil. */) (Lisp_Object key, Lisp_Object table, Lisp_Object dflt) { struct Lisp_Hash_Table *h = check_hash_table (table); - ptrdiff_t i = hash_lookup (h, key, NULL); + ptrdiff_t i = hash_lookup_with_hash (h, key, hash_from_key (h, key)); return i >= 0 ? HASH_VALUE (h, i) : dflt; } @@ -5553,8 +5570,8 @@ VALUE. In any case, return VALUE. */) struct Lisp_Hash_Table *h = check_hash_table (table); check_mutable_hash_table (table, h); - EMACS_UINT hash; - ptrdiff_t i = hash_lookup (h, key, &hash); + EMACS_UINT hash = hash_from_key (h, key); + ptrdiff_t i = hash_lookup_with_hash (h, key, hash); if (i >= 0) set_hash_value_slot (h, i, value); else diff --git a/src/image.c b/src/image.c index 55b027d568b..74d4b6c0bfe 100644 --- a/src/image.c +++ b/src/image.c @@ -6082,7 +6082,7 @@ xpm_put_color_table_h (Lisp_Object color_table, Lisp_Object chars = make_unibyte_string (chars_start, chars_len); hash_hash_t hash_code; - hash_lookup (table, chars, &hash_code); + hash_lookup_get_hash (table, chars, &hash_code); hash_put (table, chars, color, hash_code); } @@ -6093,7 +6093,7 @@ xpm_get_color_table_h (Lisp_Object color_table, { struct Lisp_Hash_Table *table = XHASH_TABLE (color_table); ptrdiff_t i = - hash_lookup (table, make_unibyte_string (chars_start, chars_len), NULL); + hash_lookup (table, make_unibyte_string (chars_start, chars_len)); return i >= 0 ? HASH_VALUE (table, i) : Qnil; } diff --git a/src/json.c b/src/json.c index 1bea4baa8ba..266905f1c34 100644 --- a/src/json.c +++ b/src/json.c @@ -881,7 +881,7 @@ json_to_lisp (json_t *json, const struct json_configuration *conf) { Lisp_Object key = build_string_from_utf8 (key_str); hash_hash_t hash; - ptrdiff_t i = hash_lookup (h, key, &hash); + ptrdiff_t i = hash_lookup_get_hash (h, key, &hash); /* Keys in JSON objects are unique, so the key can't be present yet. */ eassert (i < 0); diff --git a/src/lisp.h b/src/lisp.h index 474498094c9..02d9c98da22 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4063,7 +4063,9 @@ EMACS_UINT sxhash (Lisp_Object); Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, hash_table_weakness_t, bool); Lisp_Object hash_table_weakness_symbol (hash_table_weakness_t weak); -ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, hash_hash_t *); +ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object); +ptrdiff_t hash_lookup_get_hash (struct Lisp_Hash_Table *h, Lisp_Object key, + hash_hash_t *phash); ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, hash_hash_t); void hash_remove_from_table (struct Lisp_Hash_Table *, Lisp_Object); diff --git a/src/lread.c b/src/lread.c index 9ad4d35c0c2..b76fde3f266 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4256,7 +4256,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) = XHASH_TABLE (read_objects_map); Lisp_Object number = make_fixnum (n); hash_hash_t hash; - ptrdiff_t i = hash_lookup (h, number, &hash); + ptrdiff_t i = hash_lookup_get_hash (h, number, &hash); if (i >= 0) /* Not normal, but input could be malformed. */ set_hash_value_slot (h, i, placeholder); @@ -4274,7 +4274,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) /* #N# -- reference to numbered object */ struct Lisp_Hash_Table *h = XHASH_TABLE (read_objects_map); - ptrdiff_t i = hash_lookup (h, make_fixnum (n), NULL); + ptrdiff_t i = hash_lookup (h, make_fixnum (n)); if (i < 0) invalid_syntax ("#", readcharfun); obj = HASH_VALUE (h, i); @@ -4572,7 +4572,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) struct Lisp_Hash_Table *h2 = XHASH_TABLE (read_objects_completed); hash_hash_t hash; - ptrdiff_t i = hash_lookup (h2, placeholder, &hash); + ptrdiff_t i = hash_lookup_get_hash (h2, placeholder, &hash); eassert (i < 0); hash_put (h2, placeholder, Qnil, hash); obj = placeholder; @@ -4587,7 +4587,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) struct Lisp_Hash_Table *h2 = XHASH_TABLE (read_objects_completed); hash_hash_t hash; - ptrdiff_t i = hash_lookup (h2, obj, &hash); + ptrdiff_t i = hash_lookup_get_hash (h2, obj, &hash); eassert (i < 0); hash_put (h2, obj, Qnil, hash); } @@ -4599,7 +4599,8 @@ read0 (Lisp_Object readcharfun, bool locate_syms) /* ...and #n# will use the real value from now on. */ struct Lisp_Hash_Table *h = XHASH_TABLE (read_objects_map); hash_hash_t hash; - ptrdiff_t i = hash_lookup (h, e->u.numbered.number, &hash); + ptrdiff_t i = hash_lookup_get_hash (h, e->u.numbered.number, + &hash); eassert (i >= 0); set_hash_value_slot (h, i, obj); } @@ -4653,7 +4654,7 @@ substitute_object_recurse (struct subst *subst, Lisp_Object subtree) by #n=, which means that we can find it as a value in COMPLETED. */ if (EQ (subst->completed, Qt) - || hash_lookup (XHASH_TABLE (subst->completed), subtree, NULL) >= 0) + || hash_lookup (XHASH_TABLE (subst->completed), subtree) >= 0) subst->seen = Fcons (subtree, subst->seen); /* Recurse according to subtree's type. diff --git a/src/macfont.m b/src/macfont.m index dcaa85bea05..48502c2ec00 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -997,7 +997,7 @@ macfont_get_family_cache_if_present (Lisp_Object symbol, CFStringRef *string) if (HASH_TABLE_P (macfont_family_cache)) { struct Lisp_Hash_Table *h = XHASH_TABLE (macfont_family_cache); - ptrdiff_t i = hash_lookup (h, symbol, NULL); + ptrdiff_t i = hash_lookup (h, symbol); if (i >= 0) { @@ -1024,7 +1024,7 @@ macfont_set_family_cache (Lisp_Object symbol, CFStringRef string) h = XHASH_TABLE (macfont_family_cache); hash_hash_t hash; - i = hash_lookup (h, symbol, &hash); + i = hash_lookup_get_hash (h, symbol, &hash); value = string ? make_mint_ptr ((void *) CFRetain (string)) : Qnil; if (i >= 0) { diff --git a/src/minibuf.c b/src/minibuf.c index 22bb8fa1d75..8198dc0f360 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -2107,7 +2107,7 @@ the values STRING, PREDICATE and `lambda'. */) else if (HASH_TABLE_P (collection)) { struct Lisp_Hash_Table *h = XHASH_TABLE (collection); - i = hash_lookup (h, string, NULL); + i = hash_lookup (h, string); if (i >= 0) { tem = HASH_KEY (h, i); -- cgit v1.2.3 From 0a998938ca1b7e5e6f09d14b4a62ec7089be2af6 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 5 Nov 2023 12:10:34 +0100 Subject: Use hash_idx_t for storing hash indices Now hash_idx_t is a typedef for ptrdiff_t so there is no actual code change, but this allows us to decouple the index width from the Lisp word size. * src/lisp.h (hash_idx_t): New typedef for ptrdiff_t. (struct Lisp_Hash_Table): Use it for indices and sizes: index, next, table_size, index_size, count and next_free. All uses adapted. --- src/fns.c | 8 ++++---- src/lisp.h | 18 +++++++++++------- src/pdumper.c | 2 +- 3 files changed, 16 insertions(+), 12 deletions(-) diff --git a/src/fns.c b/src/fns.c index 9d802bba0e2..c4e7a98a4d3 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4539,7 +4539,7 @@ hash_index_size (ptrdiff_t size) /* Constant hash index vector used when the table size is zero. This avoids allocating it from the heap. */ -static const ptrdiff_t empty_hash_index_vector[] = {-1}; +static const hash_idx_t empty_hash_index_vector[] = {-1}; /* Create and initialize a new hash table. @@ -4578,7 +4578,7 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, h->hash = NULL; h->next = NULL; eassert (index_size == 1); - h->index = (ptrdiff_t *)empty_hash_index_vector; + h->index = (hash_idx_t *)empty_hash_index_vector; h->next_free = -1; } else @@ -4684,7 +4684,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) /* Allocate all the new vectors before updating *H, to avoid problems if memory is exhausted. */ - ptrdiff_t *next = hash_table_alloc_bytes (new_size * sizeof *next); + hash_idx_t *next = hash_table_alloc_bytes (new_size * sizeof *next); for (ptrdiff_t i = old_size; i < new_size - 1; i++) next[i] = i + 1; next[new_size - 1] = -1; @@ -4703,7 +4703,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) ptrdiff_t old_index_size = h->index_size; ptrdiff_t index_size = hash_index_size (new_size); - ptrdiff_t *index = hash_table_alloc_bytes (index_size * sizeof *index); + hash_idx_t *index = hash_table_alloc_bytes (index_size * sizeof *index); for (ptrdiff_t i = 0; i < index_size; i++) index[i] = -1; diff --git a/src/lisp.h b/src/lisp.h index 02d9c98da22..33c1e345f7a 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2430,6 +2430,10 @@ typedef enum { enum { hash_unused = (hash_hash_t)MOST_POSITIVE_FIXNUM + 1 }; verify (FIXNUM_OVERFLOW_P (hash_unused)); +/* The type of a hash table index, both for table indices and index + (hash) indices. It's signed and a subtype of ptrdiff_t. */ +typedef ptrdiff_t hash_idx_t; + struct Lisp_Hash_Table { union vectorlike_header header; @@ -2459,6 +2463,9 @@ struct Lisp_Hash_Table The table is physically split into three vectors (hash, next, key_and_value) which may or may not be beneficial. */ + hash_idx_t index_size; /* Size of the index vector. */ + hash_idx_t table_size; /* Size of the next and hash vectors. */ + /* Bucket vector. An entry of -1 indicates no item is present, and a nonnegative entry is the index of the first item in a collision chain. @@ -2466,10 +2473,7 @@ struct Lisp_Hash_Table If index_size is 1 (and table_size is 0), then this is the constant read-only vector {-1}, shared between all instances. Otherwise it is heap-allocated. */ - ptrdiff_t *index; - ptrdiff_t index_size; /* Size of the index vector. */ - - ptrdiff_t table_size; /* Size of the next and hash vectors. */ + hash_idx_t *index; /* Vector of hash codes. The value hash_unused marks an unused table entry. This vector is table_size entries long. */ @@ -2480,13 +2484,13 @@ struct Lisp_Hash_Table next[I] is the index of the next entry in the collision chain, or -1 if there is no such entry. This vector is table_size entries long. */ - ptrdiff_t *next; + hash_idx_t *next; /* Number of key/value entries in the table. */ - ptrdiff_t count; + hash_idx_t count; /* Index of first free entry in free list, or -1 if none. */ - ptrdiff_t next_free; + hash_idx_t next_free; /* Weakness of the table. */ hash_table_weakness_t weakness : 8; diff --git a/src/pdumper.c b/src/pdumper.c index 5ed91c668df..6b053c5b601 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -1226,7 +1226,7 @@ dump_queue_dequeue (struct dump_queue *dump_queue, dump_off basis) dump_tailq_length (&dump_queue->zero_weight_objects), dump_tailq_length (&dump_queue->one_weight_normal_objects), dump_tailq_length (&dump_queue->one_weight_strong_objects), - XHASH_TABLE (dump_queue->link_weights)->count); + (ptrdiff_t) XHASH_TABLE (dump_queue->link_weights)->count); static const int nr_candidates = 3; struct candidate -- cgit v1.2.3 From 7d93a0147a14e14d6964bf93ba11cf494b9d49fd Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 2 Nov 2023 17:05:26 +0100 Subject: Share hash table test structs This saves several words in the hash table object at the cost of an indirection at runtime. This seems to be a gain in overall performance. FIXME: We cache hash test objects in a rather clumsy way. A better solution is sought. * src/lisp.h (struct Lisp_Hash_Table): Use a pointer to the test struct. All references adapted. * src/alloc.c (garbage_collect): * src/fns.c (struct hash_table_user_test, hash_table_user_tests) (mark_fns, get_hash_table_user_test): New state for caching test structs, and functions managing it. --- src/alloc.c | 8 +---- src/bytecode.c | 2 +- src/category.c | 2 +- src/emacs-module.c | 2 +- src/fns.c | 92 +++++++++++++++++++++++++++++++++++++++--------------- src/frame.c | 2 +- src/image.c | 2 +- src/lisp.h | 8 +++-- src/lread.c | 8 ++--- src/pdumper.c | 3 +- src/pgtkterm.c | 2 +- src/print.c | 4 +-- src/profiler.c | 2 +- src/xfaces.c | 2 +- src/xterm.c | 2 +- 15 files changed, 90 insertions(+), 51 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 7432163db25..16aaa32e15f 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5942,10 +5942,6 @@ purecopy_hash_table (struct Lisp_Hash_Table *table) *pure = *table; pure->mutable = false; - pure->test.name = purecopy (table->test.name); - pure->test.user_hash_function = purecopy (table->test.user_hash_function); - pure->test.user_cmp_function = purecopy (table->test.user_cmp_function); - if (table->table_size > 0) { ptrdiff_t hash_bytes = table->table_size * sizeof *table->hash; @@ -6630,6 +6626,7 @@ garbage_collect (void) #ifdef HAVE_NS mark_nsterm (); #endif + mark_fns (); /* Everything is now marked, except for the data in font caches, undo lists, and finalizers. The first two are compacted by @@ -7295,9 +7292,6 @@ process_mark_stack (ptrdiff_t base_sp) { struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *)ptr; set_vector_marked (ptr); - mark_stack_push_value (h->test.name); - mark_stack_push_value (h->test.user_hash_function); - mark_stack_push_value (h->test.user_cmp_function); if (h->weakness == Weak_None) mark_stack_push_values (h->key_and_value, 2 * h->table_size); diff --git a/src/bytecode.c b/src/bytecode.c index a0f02d518b7..ed6e2b34e77 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1743,7 +1743,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, /* h->count is a faster approximation for HASH_TABLE_SIZE (h) here. */ - if (h->count <= 5 && !h->test.cmpfn) + if (h->count <= 5 && !h->test->cmpfn) { /* Do a linear search if there are not many cases FIXME: 5 is arbitrarily chosen. */ for (i = h->count; 0 <= --i; ) diff --git a/src/category.c b/src/category.c index 3a406a567a1..498b6a2a1c9 100644 --- a/src/category.c +++ b/src/category.c @@ -51,7 +51,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set) if (NILP (XCHAR_TABLE (table)->extras[1])) set_char_table_extras (table, 1, - make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false)); + make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false)); struct Lisp_Hash_Table *h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); hash_hash_t hash; ptrdiff_t i = hash_lookup_get_hash (h, category_set, &hash); diff --git a/src/emacs-module.c b/src/emacs-module.c index e78391b3a71..00ae33dfa2c 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1698,7 +1698,7 @@ syms_of_module (void) { staticpro (&Vmodule_refs_hash); Vmodule_refs_hash - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); DEFSYM (Qmodule_load_failed, "module-load-failed"); Fput (Qmodule_load_failed, Qerror_conditions, diff --git a/src/fns.c b/src/fns.c index c4e7a98a4d3..e491202cf54 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4448,7 +4448,7 @@ static Lisp_Object cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2, struct Lisp_Hash_Table *h) { - Lisp_Object args[] = { h->test.user_cmp_function, key1, key2 }; + Lisp_Object args[] = { h->test->user_cmp_function, key1, key2 }; return hash_table_user_defined_call (ARRAYELTS (args), args, h); } @@ -4487,7 +4487,7 @@ hashfn_eql (Lisp_Object key, struct Lisp_Hash_Table *h) static hash_hash_t hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h) { - Lisp_Object args[] = { h->test.user_hash_function, key }; + Lisp_Object args[] = { h->test->user_hash_function, key }; Lisp_Object hash = hash_table_user_defined_call (ARRAYELTS (args), args, h); return FIXNUMP (hash) ? XUFIXNUM(hash) : sxhash (hash); } @@ -4557,10 +4557,10 @@ static const hash_idx_t empty_hash_index_vector[] = {-1}; changed after purecopy. */ Lisp_Object -make_hash_table (struct hash_table_test test, EMACS_INT size, +make_hash_table (const struct hash_table_test *test, EMACS_INT size, hash_table_weakness_t weak, bool purecopy) { - eassert (SYMBOLP (test.name)); + eassert (SYMBOLP (test->name)); eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX)); struct Lisp_Hash_Table *h = allocate_hash_table (); @@ -4763,7 +4763,7 @@ hash_table_thaw (Lisp_Object hash_table) /* Freezing discarded most non-essential information; recompute it. The allocation is minimal with no room for growth. */ - h->test = *hash_table_test_from_std (h->frozen_test); + h->test = hash_table_test_from_std (h->frozen_test); ptrdiff_t size = h->count; h->table_size = size; ptrdiff_t index_size = hash_index_size (size); @@ -4805,9 +4805,9 @@ hash_lookup_with_hash (struct Lisp_Hash_Table *h, for (ptrdiff_t i = HASH_INDEX (h, start_of_bucket); 0 <= i; i = HASH_NEXT (h, i)) if (EQ (key, HASH_KEY (h, i)) - || (h->test.cmpfn + || (h->test->cmpfn && hash == HASH_HASH (h, i) - && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), h)))) + && !NILP (h->test->cmpfn (key, HASH_KEY (h, i), h)))) return i; return -1; @@ -4884,9 +4884,9 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) i = HASH_NEXT (h, i)) { if (EQ (key, HASH_KEY (h, i)) - || (h->test.cmpfn + || (h->test->cmpfn && hashval == HASH_HASH (h, i) - && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), h)))) + && !NILP (h->test->cmpfn (key, HASH_KEY (h, i), h)))) { /* Take entry out of collision chain. */ if (prev < 0) @@ -5339,6 +5339,58 @@ Hash codes are not guaranteed to be preserved across Emacs sessions. */) return make_ufixnum (hashfn_equal (obj, NULL)); } + +/* This is a cache of hash_table_test structures so that they can be + shared between hash tables using the same test. + FIXME: This way of storing and looking up hash_table_test structs + isn't wonderful. Find a better solution. */ +struct hash_table_user_test +{ + struct hash_table_test test; + struct hash_table_user_test *next; +}; + +static struct hash_table_user_test *hash_table_user_tests = NULL; + +void +mark_fns (void) +{ + for (struct hash_table_user_test *ut = hash_table_user_tests; + ut; ut = ut->next) + { + mark_object (ut->test.name); + mark_object (ut->test.user_cmp_function); + mark_object (ut->test.user_hash_function); + } +} + +static struct hash_table_test * +get_hash_table_user_test (Lisp_Object test) +{ + Lisp_Object prop = Fget (test, Qhash_table_test); + if (!CONSP (prop) || !CONSP (XCDR (prop))) + signal_error ("Invalid hash table test", 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) + && EQ (hash_fn, ut->test.user_hash_function))) + ut = ut->next; + if (!ut) + { + ut = xmalloc (sizeof *ut); + ut->test.name = test; + ut->test.user_cmp_function = equal_fn; + ut->test.user_hash_function = hash_fn; + ut->test.hashfn = hashfn_user_defined; + ut->test.cmpfn = cmpfn_user_defined; + ut->next = hash_table_user_tests; + hash_table_user_tests = ut; + } + return &ut->test; +} + DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0, doc: /* Create and return a new hash table. @@ -5384,25 +5436,15 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) Lisp_Object test = i ? args[i] : Qeql; if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (test)) test = SYMBOL_WITH_POS_SYM (test); - struct hash_table_test testdesc; + const struct hash_table_test *testdesc; if (BASE_EQ (test, Qeq)) - testdesc = hashtest_eq; + testdesc = &hashtest_eq; else if (BASE_EQ (test, Qeql)) - testdesc = hashtest_eql; + testdesc = &hashtest_eql; else if (BASE_EQ (test, Qequal)) - testdesc = hashtest_equal; + testdesc = &hashtest_equal; else - { - /* See if it is a user-defined test. */ - Lisp_Object prop = Fget (test, Qhash_table_test); - if (!CONSP (prop) || !CONSP (XCDR (prop))) - signal_error ("Invalid hash table test", test); - testdesc.name = test; - testdesc.user_cmp_function = XCAR (prop); - testdesc.user_hash_function = XCAR (XCDR (prop)); - testdesc.hashfn = hashfn_user_defined; - testdesc.cmpfn = cmpfn_user_defined; - } + testdesc = get_hash_table_user_test (test); /* See if there's a `:purecopy PURECOPY' argument. */ i = get_key_arg (QCpurecopy, nargs, args, used); @@ -5504,7 +5546,7 @@ DEFUN ("hash-table-test", Fhash_table_test, Shash_table_test, 1, 1, 0, doc: /* Return the test TABLE uses. */) (Lisp_Object table) { - return check_hash_table (table)->test.name; + return check_hash_table (table)->test->name; } Lisp_Object diff --git a/src/frame.c b/src/frame.c index 08057736272..abd6ef00901 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1040,7 +1040,7 @@ make_frame (bool mini_p) rw->pixel_height = rw->total_lines * FRAME_LINE_HEIGHT (f); fset_face_hash_table - (f, make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false)); + (f, make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false)); if (mini_p) { diff --git a/src/image.c b/src/image.c index 74d4b6c0bfe..66838adbb2a 100644 --- a/src/image.c +++ b/src/image.c @@ -6069,7 +6069,7 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object, const char *, int, { *put_func = xpm_put_color_table_h; *get_func = xpm_get_color_table_h; - return make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false); + return make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false); } static void diff --git a/src/lisp.h b/src/lisp.h index 33c1e345f7a..b11237381d9 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2397,6 +2397,7 @@ typedef enum { struct hash_table_test { + /* FIXME: reorder for efficiency */ /* Function used to compare keys; always a bare symbol. */ Lisp_Object name; @@ -2515,7 +2516,7 @@ struct Lisp_Hash_Table Lisp_Object *key_and_value; /* The comparison and hash functions. */ - struct hash_table_test test; + const struct hash_table_test *test; /* Next weak hash table if this is a weak hash table. The head of the list is in weak_hash_tables. Used only during garbage @@ -2584,7 +2585,7 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) INLINE hash_hash_t hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) { - return h->test.hashfn (key, h); + return h->test->hashfn (key, h); } void hash_table_thaw (Lisp_Object hash_table); @@ -4064,7 +4065,7 @@ extern void hexbuf_digest (char *, void const *, int); extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *); EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object); -Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, +Lisp_Object make_hash_table (const struct hash_table_test *, EMACS_INT, hash_table_weakness_t, bool); Lisp_Object hash_table_weakness_symbol (hash_table_weakness_t weak); ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object); @@ -4098,6 +4099,7 @@ extern Lisp_Object plist_put (Lisp_Object plist, Lisp_Object prop, Lisp_Object val); extern Lisp_Object plist_member (Lisp_Object plist, Lisp_Object prop); extern void syms_of_fns (void); +extern void mark_fns (void); /* Defined in sort.c */ extern void tim_sort (Lisp_Object, Lisp_Object *, const ptrdiff_t); diff --git a/src/lread.c b/src/lread.c index b76fde3f266..2c6a444ec56 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2544,11 +2544,11 @@ readevalloop (Lisp_Object readcharfun, if (! HASH_TABLE_P (read_objects_map) || XHASH_TABLE (read_objects_map)->count) read_objects_map - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (!NILP (Vpurify_flag) && c == '(') val = read0 (readcharfun, false); else @@ -2792,11 +2792,11 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end, if (! HASH_TABLE_P (read_objects_map) || XHASH_TABLE (read_objects_map)->count) read_objects_map - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); if (STRINGP (stream) || ((CONSP (stream) && STRINGP (XCAR (stream))))) diff --git a/src/pdumper.c b/src/pdumper.c index 6b053c5b601..13077526776 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2704,7 +2704,8 @@ hash_table_freeze (struct Lisp_Hash_Table *h) h->index = NULL; h->table_size = 0; h->index_size = 0; - h->frozen_test = hash_table_std_test (&h->test); + h->frozen_test = hash_table_std_test (h->test); + h->test = NULL; } static dump_off diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 57ea82daa5e..b731f52983d 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -7178,7 +7178,7 @@ If set to a non-float value, there will be no wait at all. */); DEFVAR_LISP ("pgtk-keysym-table", Vpgtk_keysym_table, doc: /* Hash table of character codes indexed by X keysym codes. */); - Vpgtk_keysym_table = make_hash_table (hashtest_eql, 900, Weak_None, false); + Vpgtk_keysym_table = make_hash_table (&hashtest_eql, 900, Weak_None, false); window_being_scrolled = Qnil; staticpro (&window_being_scrolled); diff --git a/src/print.c b/src/print.c index c27c66ae40a..58a23b79d5d 100644 --- a/src/print.c +++ b/src/print.c @@ -2577,10 +2577,10 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) #s(hash-table test equal data (k1 v1 k2 v2)) */ print_c_string ("#s(hash-table", printcharfun); - if (!BASE_EQ (h->test.name, Qeql)) + if (!BASE_EQ (h->test->name, Qeql)) { print_c_string (" test ", printcharfun); - print_object (h->test.name, printcharfun, escapeflag); + print_object (h->test->name, printcharfun, escapeflag); } if (h->weakness != Weak_None) diff --git a/src/profiler.c b/src/profiler.c index 06ffecf41e3..5a6a8b48f6b 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -563,7 +563,7 @@ export_log (struct profiler_log *plog) which is more discriminating than the `function-equal' used by the log but close enough, and will never confuse two distinct keys in the log. */ - Lisp_Object h = make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, + Lisp_Object h = make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false); for (int i = 0; i < log->size; i++) { diff --git a/src/xfaces.c b/src/xfaces.c index c9dd0f90feb..2ca2c30636c 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -7333,7 +7333,7 @@ only for this purpose. */); doc: /* Hash table of global face definitions (for internal use only.) */); Vface_new_frame_defaults = /* 33 entries is enough to fit all basic faces */ - make_hash_table (hashtest_eq, 33, Weak_None, false); + make_hash_table (&hashtest_eq, 33, Weak_None, false); DEFVAR_LISP ("face-default-stipple", Vface_default_stipple, doc: /* Default stipple pattern used on monochrome displays. diff --git a/src/xterm.c b/src/xterm.c index e4139a79a6e..77d6550c8b9 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -32554,7 +32554,7 @@ If set to a non-float value, there will be no wait at all. */); DEFVAR_LISP ("x-keysym-table", Vx_keysym_table, doc: /* Hash table of character codes indexed by X keysym codes. */); - Vx_keysym_table = make_hash_table (hashtest_eql, 900, Weak_None, false); + Vx_keysym_table = make_hash_table (&hashtest_eql, 900, Weak_None, false); DEFVAR_BOOL ("x-frame-normalize-before-maximize", x_frame_normalize_before_maximize, -- cgit v1.2.3 From 47502c55b0ce2e4cd3f43fefb77d9c2c11ed7c0a Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 3 Nov 2023 16:02:56 +0100 Subject: ; Reorder struct Lisp_Hash_Table and struct hash_table_test Mainly for efficiency, to keep frequently used fields together. --- src/fns.c | 12 ++++++------ src/lisp.h | 35 +++++++++++++++++------------------ 2 files changed, 23 insertions(+), 24 deletions(-) diff --git a/src/fns.c b/src/fns.c index e491202cf54..3e650b13c1f 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4493,12 +4493,12 @@ hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h) } struct hash_table_test const - hashtest_eq = { LISPSYM_INITIALLY (Qeq), LISPSYM_INITIALLY (Qnil), - LISPSYM_INITIALLY (Qnil), 0, hashfn_eq }, - hashtest_eql = { LISPSYM_INITIALLY (Qeql), LISPSYM_INITIALLY (Qnil), - LISPSYM_INITIALLY (Qnil), cmpfn_eql, hashfn_eql }, - hashtest_equal = { LISPSYM_INITIALLY (Qequal), LISPSYM_INITIALLY (Qnil), - LISPSYM_INITIALLY (Qnil), cmpfn_equal, hashfn_equal }; + hashtest_eq = { .name = LISPSYM_INITIALLY (Qeq), + .cmpfn = 0, .hashfn = hashfn_eq }, + hashtest_eql = { .name = LISPSYM_INITIALLY (Qeql), + .cmpfn = cmpfn_eql, .hashfn = hashfn_eql }, + hashtest_equal = { .name = LISPSYM_INITIALLY (Qequal), + .cmpfn = cmpfn_equal, .hashfn = hashfn_equal }; /* Allocate basically initialized hash table. */ diff --git a/src/lisp.h b/src/lisp.h index b11237381d9..658bcd8b780 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2397,9 +2397,11 @@ typedef enum { struct hash_table_test { - /* FIXME: reorder for efficiency */ - /* Function used to compare keys; always a bare symbol. */ - Lisp_Object name; + /* C function to compute hash code. */ + hash_hash_t (*hashfn) (Lisp_Object, struct Lisp_Hash_Table *); + + /* C function to compare two keys. */ + Lisp_Object (*cmpfn) (Lisp_Object, Lisp_Object, struct Lisp_Hash_Table *); /* User-supplied hash function, or nil. */ Lisp_Object user_hash_function; @@ -2407,11 +2409,8 @@ struct hash_table_test /* User-supplied key comparison function, or nil. */ Lisp_Object user_cmp_function; - /* C function to compare two keys. */ - Lisp_Object (*cmpfn) (Lisp_Object, Lisp_Object, struct Lisp_Hash_Table *); - - /* C function to compute hash code. */ - hash_hash_t (*hashfn) (Lisp_Object, struct Lisp_Hash_Table *); + /* Function used to compare keys; always a bare symbol. */ + Lisp_Object name; }; typedef enum { @@ -2480,6 +2479,16 @@ struct Lisp_Hash_Table This vector is table_size entries long. */ hash_hash_t *hash; + /* Vector of keys and values. The key of item I is found at index + 2 * I, the value is found at index 2 * I + 1. + If the key is HASH_UNUSED_ENTRY_KEY, then this slot is unused. + This is gc_marked specially if the table is weak. + This vector is 2 * table_size entries long. */ + Lisp_Object *key_and_value; + + /* The comparison and hash functions. */ + const struct hash_table_test *test; + /* Vector used to chain entries. If entry I is free, next[I] is the entry number of the next free item. If entry I is non-free, next[I] is the index of the next entry in the collision chain, @@ -2508,16 +2517,6 @@ struct Lisp_Hash_Table immutable for recursive attempts to mutate it. */ bool mutable; - /* Vector of keys and values. The key of item I is found at index - 2 * I, the value is found at index 2 * I + 1. - If the key is HASH_UNUSED_ENTRY_KEY, then this slot is unused. - This is gc_marked specially if the table is weak. - This vector is 2 * table_size entries long. */ - Lisp_Object *key_and_value; - - /* The comparison and hash functions. */ - const struct hash_table_test *test; - /* Next weak hash table if this is a weak hash table. The head of the list is in weak_hash_tables. Used only during garbage collection --- at other times, it is NULL. */ -- cgit v1.2.3 From ed06de52a53135ee42e528496fdddbf3d74b0479 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 4 Nov 2023 18:21:06 +0100 Subject: Faster hash table growth, starting at zero size The algorithms no longer use the rehash_threshold and rehash_size float constants, but vary depending on size. In particular, the table now grows faster, especially from smaller sizes. The default size is now 0, starting empty, which effectively postpones allocation until the first insertion (unless make-hash-table was called with a positive :size); this is a clear gain as long as the table remains empty. The first inserted item will use an initial size of 8 because most tables are small. * src/fns.c (std_rehash_size, std_rehash_threshold): Remove. (hash_index_size): Integer-only computation. (maybe_resize_hash_table): Grow more aggressively. (Fhash_table_rehash_size, Fhash_table_rehash_threshold): Use the constants directly. * src/lisp.h (DEFAULT_HASH_SIZE): New value. --- src/fns.c | 60 ++++++++++++++++++++++++------------------------------------ src/lisp.h | 2 +- 2 files changed, 25 insertions(+), 37 deletions(-) diff --git a/src/fns.c b/src/fns.c index 3e650b13c1f..4a38126d9dc 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4508,31 +4508,18 @@ allocate_hash_table (void) return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Hash_Table, PVEC_HASH_TABLE); } -/* An upper bound on the size of a hash table index. It must fit in - ptrdiff_t and be a valid Emacs fixnum. This is an upper bound on - VECTOR_ELTS_MAX (see alloc.c) and gets as close as we can without - violating modularity. */ -#define INDEX_SIZE_BOUND \ - ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, \ - ((min (PTRDIFF_MAX, SIZE_MAX) \ - - header_size - GCALIGNMENT) \ - / word_size))) - -/* Default factor by which to increase the size of a hash table. */ -static const double std_rehash_size = 1.5; - -/* Resize hash table when number of entries / table size is >= this - ratio. */ -static const double std_rehash_threshold = 0.8125; - +/* Compute the size of the index from the table capacity. */ static ptrdiff_t hash_index_size (ptrdiff_t size) { - double index_float = size * (1.0 / std_rehash_threshold); - ptrdiff_t index_size = (index_float < INDEX_SIZE_BOUND + 1 - ? next_almost_prime (index_float) - : INDEX_SIZE_BOUND + 1); - if (INDEX_SIZE_BOUND < index_size) + /* An upper bound on the size of a hash table index. It must fit in + ptrdiff_t and be a valid Emacs fixnum. */ + ptrdiff_t upper_bound = min (MOST_POSITIVE_FIXNUM, + PTRDIFF_MAX / sizeof (ptrdiff_t)); + ptrdiff_t index_size = size + (size >> 2); /* 1.25x larger */ + if (index_size < upper_bound) + index_size = next_almost_prime (index_size); + if (index_size > upper_bound) error ("Hash table too large"); return index_size; } @@ -4671,16 +4658,12 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) if (h->next_free < 0) { ptrdiff_t old_size = HASH_TABLE_SIZE (h); - /* FIXME: better growth management, ditch std_rehash_size */ - EMACS_INT new_size = old_size * std_rehash_size; - if (new_size < EMACS_INT_MAX) - new_size = max (new_size, 32); /* avoid slow initial growth */ - else - new_size = EMACS_INT_MAX; - if (PTRDIFF_MAX < new_size) - new_size = PTRDIFF_MAX; - if (new_size <= old_size) - new_size = old_size + 1; + ptrdiff_t base_size = min (max (old_size, 8), PTRDIFF_MAX / 2); + /* Grow aggressively at small sizes, then just double. */ + ptrdiff_t new_size = + old_size == 0 + ? 8 + : (base_size <= 64 ? base_size * 4 : base_size * 2); /* Allocate all the new vectors before updating *H, to avoid problems if memory is exhausted. */ @@ -4738,7 +4721,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) #ifdef ENABLE_CHECKING if (HASH_TABLE_P (Vpurify_flag) && XHASH_TABLE (Vpurify_flag) == h) - message ("Growing hash table to: %"pI"d", new_size); + message ("Growing hash table to: %"pD"d", new_size); #endif } } @@ -5403,7 +5386,8 @@ keys. Default is `eql'. Predefined are the tests `eq', `eql', and `define-hash-table-test'. :size SIZE -- A hint as to how many elements will be put in the table. -Default is 65. +The table will always grow as needed; this argument may help performance +slightly if the size is known in advance but is never required. :weakness WEAK -- WEAK must be one of nil, t, `key', `value', `key-or-value', or `key-and-value'. If WEAK is not nil, the table @@ -5516,7 +5500,9 @@ DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, (Lisp_Object table) { CHECK_HASH_TABLE (table); - return make_float (std_rehash_size); + /* Nominal factor by which to increase the size of a hash table. + No longer used; this is for compatibility. */ + return make_float (1.5); } @@ -5526,7 +5512,9 @@ DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, (Lisp_Object table) { CHECK_HASH_TABLE (table); - return make_float (std_rehash_threshold); + /* Nominal threshold for when to resize a hash table. + No longer used; this is for compatibility. */ + return make_float (0.8125); } diff --git a/src/lisp.h b/src/lisp.h index 658bcd8b780..5b70e96d6a1 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2591,7 +2591,7 @@ void hash_table_thaw (Lisp_Object hash_table); /* Default size for hash tables if not specified. */ -enum DEFAULT_HASH_SIZE { DEFAULT_HASH_SIZE = 65 }; +enum DEFAULT_HASH_SIZE { DEFAULT_HASH_SIZE = 0 }; /* Combine two integers X and Y for hashing. The result might exceed INTMASK. */ -- cgit v1.2.3 From 68f8bc3111424527205ebfe4498e5bebf50f50bf Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Tue, 21 Nov 2023 19:26:23 +0100 Subject: Change hash_idx_t to int32_t on all platforms * src/lisp.h (hash_idx_t): Change to int32_t. * src/fns.c (hash_index_size): Adapt to new index type. --- src/fns.c | 3 ++- src/lisp.h | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/fns.c b/src/fns.c index 4a38126d9dc..3acbc7f86a1 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4515,7 +4515,8 @@ hash_index_size (ptrdiff_t size) /* An upper bound on the size of a hash table index. It must fit in ptrdiff_t and be a valid Emacs fixnum. */ ptrdiff_t upper_bound = min (MOST_POSITIVE_FIXNUM, - PTRDIFF_MAX / sizeof (ptrdiff_t)); + min (TYPE_MAXIMUM (hash_idx_t), + PTRDIFF_MAX / sizeof (ptrdiff_t))); ptrdiff_t index_size = size + (size >> 2); /* 1.25x larger */ if (index_size < upper_bound) index_size = next_almost_prime (index_size); diff --git a/src/lisp.h b/src/lisp.h index 5b70e96d6a1..f27f506b58f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2432,7 +2432,7 @@ verify (FIXNUM_OVERFLOW_P (hash_unused)); /* The type of a hash table index, both for table indices and index (hash) indices. It's signed and a subtype of ptrdiff_t. */ -typedef ptrdiff_t hash_idx_t; +typedef int32_t hash_idx_t; struct Lisp_Hash_Table { -- cgit v1.2.3 From 7ad5d427730fea3865bc678c6673ffd58b6af653 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Wed, 22 Nov 2023 13:47:56 +0100 Subject: Don't dump Qunbound The dumper uses a hash table to keep track of dumped objects but as this clashes with the use of Qunbound for marking unused hash table entries, don't dump that value at all. The symbol name is fixed up after loading. An alternative solution would be to use a different unique value for unused entries. * src/pdumper.c (dump_object_needs_dumping_p): Skip Qunbound. (dump_vectorlike_generic): New function. (pdumper_load): Call it. --- src/fns.c | 1 + src/pdumper.c | 19 ++++++++++++++++++- 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/src/fns.c b/src/fns.c index 3acbc7f86a1..b68fb393703 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4831,6 +4831,7 @@ ptrdiff_t hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, hash_hash_t hash) { + eassert (!BASE_EQ (key, Qunbound)); /* Increment count after resizing because resizing may fail. */ maybe_resize_hash_table (h); h->count++; diff --git a/src/pdumper.c b/src/pdumper.c index 13077526776..38682816f0a 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -1337,7 +1337,9 @@ dump_object_needs_dumping_p (Lisp_Object object) included in the dump despite all references to them being bitwise-invariant. */ return (!dump_object_self_representing_p (object) - || dump_object_emacs_ptr (object)); + || (dump_object_emacs_ptr (object) + /* Don't dump Qunbound -- it's not a legal hash table key. */ + && !BASE_EQ (object, Qunbound))); } static void @@ -2551,6 +2553,19 @@ dump_symbol (struct dump_context *ctx, return offset; } +/* Give Qunbound its name. + All other symbols are dumped and loaded but not Qunbound because it + cannot be used as a key in a hash table. + FIXME: A better solution would be to use a value other than Qunbound + as a marker for unused entries in hash tables. */ +static void +pdumper_init_symbol_unbound (void) +{ + eassert (NILP (SYMBOL_NAME (Qunbound))); + const char *name = "unbound"; + init_symbol (Qunbound, make_pure_c_string (name, strlen (name))); +} + static dump_off dump_vectorlike_generic (struct dump_context *ctx, const union vectorlike_header *header) @@ -5749,6 +5764,8 @@ pdumper_load (const char *dump_filename, char *argv0) for (int i = 0; i < nr_dump_hooks; ++i) dump_hooks[i] (); + pdumper_init_symbol_unbound (); + #ifdef HAVE_NATIVE_COMP pdumper_set_emacs_execdir (argv0); #else -- cgit v1.2.3 From 11e467eb6004286765c1d8c408f8d773d9113aca Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Tue, 21 Nov 2023 22:12:08 +0100 Subject: Use key Qunbound instead of hash value hash_unused for free entries Previously, free hash table entries were indicated by both hash value hash_unused and key Qunbound; we now rely on the latter only. This allows us to change the hash representation to one that does not have an unused value. * src/lisp.h (hash_unused): Remove. All uses adapted to calling hash_unused_entry_key_p on the key instead. The hash values for unused hash table entries are now undefined; all initialisation and assignment to hash_unused has been removed. --- src/fns.c | 14 ++------------ src/lisp.h | 7 +------ src/macfont.m | 2 +- src/pdumper.c | 13 ++++++++----- 4 files changed, 12 insertions(+), 24 deletions(-) diff --git a/src/fns.c b/src/fns.c index b68fb393703..ed7b7bb2024 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4577,8 +4577,6 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size, h->key_and_value[i] = HASH_UNUSED_ENTRY_KEY; h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); - for (ptrdiff_t i = 0; i < size; i++) - h->hash[i] = hash_unused; h->next = hash_table_alloc_bytes (size * sizeof *h->next); for (ptrdiff_t i = 0; i < size - 1; i++) @@ -4682,8 +4680,6 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) hash_hash_t *hash = hash_table_alloc_bytes (new_size * sizeof *hash); memcpy (hash, h->hash, old_size * sizeof *hash); - for (ptrdiff_t i = old_size; i < new_size; i++) - hash[i] = hash_unused; ptrdiff_t old_index_size = h->index_size; ptrdiff_t index_size = hash_index_size (new_size); @@ -4755,8 +4751,6 @@ hash_table_thaw (Lisp_Object hash_table) h->next_free = -1; h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); - for (ptrdiff_t i = 0; i < size; i++) - h->hash[i] = hash_unused; h->next = hash_table_alloc_bytes (size * sizeof *h->next); for (ptrdiff_t i = 0; i < size; i++) @@ -4831,14 +4825,13 @@ ptrdiff_t hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, hash_hash_t hash) { - eassert (!BASE_EQ (key, Qunbound)); + eassert (!hash_unused_entry_key_p (key)); /* Increment count after resizing because resizing may fail. */ maybe_resize_hash_table (h); h->count++; /* Store key/value in the key_and_value vector. */ ptrdiff_t i = h->next_free; - eassert (HASH_HASH (h, i) == hash_unused); eassert (hash_unused_entry_key_p (HASH_KEY (h, i))); h->next_free = HASH_NEXT (h, i); set_hash_key_slot (h, i, key); @@ -4883,7 +4876,6 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) the free list. */ set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); - set_hash_hash_slot (h, i, hash_unused); set_hash_next_slot (h, i, h->next_free); h->next_free = i; h->count--; @@ -4906,7 +4898,6 @@ hash_clear (struct Lisp_Hash_Table *h) ptrdiff_t size = HASH_TABLE_SIZE (h); for (ptrdiff_t i = 0; i < size; i++) { - set_hash_hash_slot (h, i, hash_unused); set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1); set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); @@ -4986,10 +4977,9 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) set_hash_next_slot (h, i, h->next_free); h->next_free = i; - /* Clear key, value, and hash. */ + /* Clear key and value. */ set_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY); set_hash_value_slot (h, i, Qnil); - set_hash_hash_slot (h, i, hash_unused); eassert (h->count != 0); h->count--; diff --git a/src/lisp.h b/src/lisp.h index f27f506b58f..0701028c14c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2425,11 +2425,6 @@ typedef enum { both key and value remain. */ } hash_table_weakness_t; -/* An value that marks an unused hash entry. - Any hash_hash_t value that is not a valid fixnum will do here. */ -enum { hash_unused = (hash_hash_t)MOST_POSITIVE_FIXNUM + 1 }; -verify (FIXNUM_OVERFLOW_P (hash_unused)); - /* The type of a hash table index, both for table indices and index (hash) indices. It's signed and a subtype of ptrdiff_t. */ typedef int32_t hash_idx_t; @@ -2475,7 +2470,7 @@ struct Lisp_Hash_Table Otherwise it is heap-allocated. */ hash_idx_t *index; - /* Vector of hash codes. The value hash_unused marks an unused table entry. + /* Vector of hash codes. Unused entries have undefined values. This vector is table_size entries long. */ hash_hash_t *hash; diff --git a/src/macfont.m b/src/macfont.m index 48502c2ec00..6f192b00f1b 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -980,7 +980,7 @@ macfont_invalidate_family_cache (void) ptrdiff_t i, size = HASH_TABLE_SIZE (h); for (i = 0; i < size; ++i) - if (HASH_HASH (h, i) != hash_unused) + if (!hash_unused_entry_key_p (HASH_KEY (h, i))) { Lisp_Object value = HASH_VALUE (h, i); diff --git a/src/pdumper.c b/src/pdumper.c index 38682816f0a..54f0f2bca13 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2676,11 +2676,14 @@ hash_table_contents (struct Lisp_Hash_Table *h) relies on it by expecting hash table indices to stay constant across the dump. */ for (ptrdiff_t i = 0; i < old_size; i++) - if (HASH_HASH (h, i) != hash_unused) - { - key_and_value[n++] = HASH_KEY (h, i); - key_and_value[n++] = HASH_VALUE (h, i); - } + { + Lisp_Object key = HASH_KEY (h, i); + if (!hash_unused_entry_key_p (key)) + { + key_and_value[n++] = key; + key_and_value[n++] = HASH_VALUE (h, i); + } + } return key_and_value; } -- cgit v1.2.3 From 1998039f7a8f2ecc884a6fed85c0cc1ce06f83e2 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Wed, 22 Nov 2023 14:54:34 +0100 Subject: Change hash_hash_t to uint32_t This saves a lot of memory and is quite sufficient. Hash functions are adapted to produce a hash_hash_t eventually, which eliminates some useless and information-destroying intermediate hash reduction steps. We still use EMACS_UINT for most of the actual hashing steps before producing the final value; this may be slightly wasteful on 32-bit platforms with 64-bit EMACS_UINT. * src/lisp.h (hash_hash_t): Change to uint32_t. * src/fns.c (reduce_emacs_uint_to_hash_hash): New. (hashfn_eq, hashfn_equal, hashfn_user_defined): Reduce return values to hash_hash_t. (sxhash_string): Remove. Caller changed to hash_string. (sxhash_float, sxhash_list, sxhash_vector, sxhash_bool_vector) (sxhash_bignum): Remove wasteful calls to SXHASH_REDUCE. (hash_hash_to_fixnum): New. (Fsxhash_eq, Fsxhash_eql, Fsxhash_equal) (Fsxhash_equal_including_properties): Convert return values to fixnum. --- src/fns.c | 77 ++++++++++++++++++++++++++++++++++---------------------------- src/lisp.h | 2 +- 2 files changed, 43 insertions(+), 36 deletions(-) diff --git a/src/fns.c b/src/fns.c index ed7b7bb2024..3765fc74967 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4452,6 +4452,16 @@ cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2, return hash_table_user_defined_call (ARRAYELTS (args), args, h); } +/* Reduce an EMACS_UINT hash value to hash_hash_t. */ +static inline hash_hash_t +reduce_emacs_uint_to_hash_hash (EMACS_UINT x) +{ + verify (sizeof x <= 2 * sizeof (hash_hash_t)); + return (sizeof x == sizeof (hash_hash_t) + ? x + : x ^ (x >> (8 * (sizeof x - sizeof (hash_hash_t))))); +} + /* Ignore H and return a hash code for KEY which uses 'eq' to compare keys. */ static hash_hash_t @@ -4459,21 +4469,18 @@ hashfn_eq (Lisp_Object key, struct Lisp_Hash_Table *h) { if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (key)) key = SYMBOL_WITH_POS_SYM (key); - return XHASH (key) ^ XTYPE (key); + return reduce_emacs_uint_to_hash_hash (XHASH (key) ^ XTYPE (key)); } -/* Ignore H and return a hash code for KEY which uses 'equal' to compare keys. - The hash code is at most INTMASK. */ - +/* Ignore H and return a hash code for KEY which uses 'equal' to + compare keys. */ static hash_hash_t hashfn_equal (Lisp_Object key, struct Lisp_Hash_Table *h) { - return sxhash (key); + return reduce_emacs_uint_to_hash_hash (sxhash (key)); } -/* Ignore H and return a hash code for KEY which uses 'eql' to compare keys. - The hash code is at most INTMASK. */ - +/* Ignore H and return a hash code for KEY which uses 'eql' to compare keys. */ static hash_hash_t hashfn_eql (Lisp_Object key, struct Lisp_Hash_Table *h) { @@ -4489,7 +4496,8 @@ hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h) { Lisp_Object args[] = { h->test->user_hash_function, key }; Lisp_Object hash = hash_table_user_defined_call (ARRAYELTS (args), args, h); - return FIXNUMP (hash) ? XUFIXNUM(hash) : sxhash (hash); + return reduce_emacs_uint_to_hash_hash (FIXNUMP (hash) + ? XUFIXNUM(hash) : sxhash (hash)); } struct hash_table_test const @@ -5061,16 +5069,6 @@ hash_string (char const *ptr, ptrdiff_t len) return hash; } -/* Return a hash for string PTR which has length LEN. The hash - code returned is at most INTMASK. */ - -static EMACS_UINT -sxhash_string (char const *ptr, ptrdiff_t len) -{ - EMACS_UINT hash = hash_string (ptr, len); - return SXHASH_REDUCE (hash); -} - /* Return a hash for the floating point value VAL. */ static EMACS_UINT @@ -5080,7 +5078,7 @@ sxhash_float (double val) union double_and_words u = { .val = val }; for (int i = 0; i < WORDS_PER_DOUBLE; i++) hash = sxhash_combine (hash, u.word[i]); - return SXHASH_REDUCE (hash); + return hash; } /* Return a hash for list LIST. DEPTH is the current depth in the @@ -5107,7 +5105,7 @@ sxhash_list (Lisp_Object list, int depth) hash = sxhash_combine (hash, hash2); } - return SXHASH_REDUCE (hash); + return hash; } @@ -5127,7 +5125,7 @@ sxhash_vector (Lisp_Object vec, int depth) hash = sxhash_combine (hash, hash2); } - return SXHASH_REDUCE (hash); + return hash; } /* Return a hash for bool-vector VECTOR. */ @@ -5143,7 +5141,7 @@ sxhash_bool_vector (Lisp_Object vec) for (i = 0; i < n; ++i) hash = sxhash_combine (hash, bool_vector_data (vec)[i]); - return SXHASH_REDUCE (hash); + return hash; } /* Return a hash for a bignum. */ @@ -5158,19 +5156,18 @@ sxhash_bignum (Lisp_Object bignum) for (i = 0; i < nlimbs; ++i) hash = sxhash_combine (hash, mpz_getlimbn (*n, i)); - return SXHASH_REDUCE (hash); + return hash; } - -/* Return a hash code for OBJ. DEPTH is the current depth in the Lisp - structure. Value is an unsigned integer clipped to INTMASK. */ - EMACS_UINT sxhash (Lisp_Object obj) { return sxhash_obj (obj, 0); } +/* Return a hash code for OBJ. DEPTH is the current depth in the Lisp + structure. */ + static EMACS_UINT sxhash_obj (Lisp_Object obj, int depth) { @@ -5186,7 +5183,7 @@ sxhash_obj (Lisp_Object obj, int depth) return XHASH (obj); case Lisp_String: - return sxhash_string (SSDATA (obj), SBYTES (obj)); + return hash_string (SSDATA (obj), SBYTES (obj)); case Lisp_Vectorlike: { @@ -5213,7 +5210,7 @@ sxhash_obj (Lisp_Object obj, int depth) = XMARKER (obj)->buffer ? XMARKER (obj)->bytepos : 0; EMACS_UINT hash = sxhash_combine ((intptr_t) XMARKER (obj)->buffer, bytepos); - return SXHASH_REDUCE (hash); + return hash; } else if (pvec_type == PVEC_BOOL_VECTOR) return sxhash_bool_vector (obj); @@ -5222,7 +5219,7 @@ sxhash_obj (Lisp_Object obj, int depth) EMACS_UINT hash = OVERLAY_START (obj); hash = sxhash_combine (hash, OVERLAY_END (obj)); hash = sxhash_combine (hash, sxhash_obj (XOVERLAY (obj)->plist, depth)); - return SXHASH_REDUCE (hash); + return hash; } else if (symbols_with_pos_enabled && pvec_type == PVEC_SYMBOL_WITH_POS) return sxhash_obj (XSYMBOL_WITH_POS (obj)->sym, depth + 1); @@ -5258,6 +5255,15 @@ collect_interval (INTERVAL interval, Lisp_Object collector) Lisp Interface ***********************************************************************/ +/* Reduce X to a Lisp fixnum. */ +static inline Lisp_Object +hash_hash_to_fixnum (hash_hash_t x) +{ + return make_ufixnum (FIXNUM_BITS < 8 * sizeof x + ? (x ^ x >> (8 * sizeof x - FIXNUM_BITS)) & INTMASK + : x); +} + DEFUN ("sxhash-eq", Fsxhash_eq, Ssxhash_eq, 1, 1, 0, doc: /* Return an integer hash code for OBJ suitable for `eq'. If (eq A B), then (= (sxhash-eq A) (sxhash-eq B)). @@ -5265,7 +5271,7 @@ If (eq A B), then (= (sxhash-eq A) (sxhash-eq B)). Hash codes are not guaranteed to be preserved across Emacs sessions. */) (Lisp_Object obj) { - return make_ufixnum (hashfn_eq (obj, NULL)); + return hash_hash_to_fixnum (hashfn_eq (obj, NULL)); } DEFUN ("sxhash-eql", Fsxhash_eql, Ssxhash_eql, 1, 1, 0, @@ -5276,7 +5282,7 @@ isn't necessarily true. Hash codes are not guaranteed to be preserved across Emacs sessions. */) (Lisp_Object obj) { - return make_ufixnum (hashfn_eql (obj, NULL)); + return hash_hash_to_fixnum (hashfn_eql (obj, NULL)); } DEFUN ("sxhash-equal", Fsxhash_equal, Ssxhash_equal, 1, 1, 0, @@ -5287,7 +5293,7 @@ opposite isn't necessarily true. Hash codes are not guaranteed to be preserved across Emacs sessions. */) (Lisp_Object obj) { - return make_ufixnum (hashfn_equal (obj, NULL)); + return hash_hash_to_fixnum (hashfn_equal (obj, NULL)); } DEFUN ("sxhash-equal-including-properties", Fsxhash_equal_including_properties, @@ -5302,6 +5308,7 @@ Hash codes are not guaranteed to be preserved across Emacs sessions. */) { if (STRINGP (obj)) { + /* FIXME: This is very wasteful. We needn't cons at all. */ Lisp_Object collector = Fcons (Qnil, Qnil); traverse_intervals (string_intervals (obj), 0, collect_interval, collector); @@ -5311,7 +5318,7 @@ Hash codes are not guaranteed to be preserved across Emacs sessions. */) sxhash (CDR (collector))))); } - return make_ufixnum (hashfn_equal (obj, NULL)); + return hash_hash_to_fixnum (hashfn_equal (obj, NULL)); } diff --git a/src/lisp.h b/src/lisp.h index 0701028c14c..64492361e64 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2387,7 +2387,7 @@ struct Lisp_Hash_Table; /* The type of a hash value stored in the table. It's unsigned and a subtype of EMACS_UINT. */ -typedef EMACS_UINT hash_hash_t; +typedef uint32_t hash_hash_t; typedef enum { Test_eql, -- cgit v1.2.3 From 519c7ca7356fc7f9707b97c143c9495deea5b272 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 30 Dec 2023 15:54:32 +0100 Subject: Don't pretend that hash-table-size is useful * lisp/emacs-lisp/shortdoc.el (hash-table): Remove hash-table-size entry. * doc/lispref/hash.texi (Other Hash): * src/fns.c (Fhash_table_size): Make it clear that hash-table-size is probably not worth using. --- doc/lispref/hash.texi | 3 ++- lisp/emacs-lisp/shortdoc.el | 5 +---- src/fns.c | 12 ++++++++---- 3 files changed, 11 insertions(+), 9 deletions(-) diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi index ff9d1799a60..aeaeab27fc0 100644 --- a/doc/lispref/hash.texi +++ b/doc/lispref/hash.texi @@ -386,5 +386,6 @@ This returns the rehash threshold of @var{table}. @end defun @defun hash-table-size table -This returns the current nominal size of @var{table}. +This returns the current allocation size of @var{table}. Since hash table +allocation is managed automatically, this is rarely of interest. @end defun diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 17cbf6b2d31..a6a49c72f74 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -572,10 +572,7 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :result-string "#s(hash-table ...)") (hash-table-count :no-eval (hash-table-count table) - :eg-result 15) - (hash-table-size - :no-eval (hash-table-size table) - :eg-result 65)) + :eg-result 15)) (define-short-documentation-group list "Making Lists" diff --git a/src/fns.c b/src/fns.c index 3765fc74967..70288590e24 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5518,10 +5518,14 @@ DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, DEFUN ("hash-table-size", Fhash_table_size, Shash_table_size, 1, 1, 0, - doc: /* Return the size of TABLE. -The size can be used as an argument to `make-hash-table' to create -a hash table than can hold as many elements as TABLE holds -without need for resizing. */) + doc: /* Return the current allocation size of TABLE. + +This is probably not the function that you are looking for. To get the +number of entries in a table, use `hash-table-count' instead. + +The returned value is the number of entries that TABLE can currently +hold without growing, but since hash tables grow automatically, this +number is rarely of interest. */) (Lisp_Object table) { struct Lisp_Hash_Table *h = check_hash_table (table); -- cgit v1.2.3 From d2c3a983146b7c0fb0f8b855268effb695d0bbf5 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 30 Dec 2023 16:00:28 +0100 Subject: Hash-table documentation updates (bug#68244) * doc/lispref/hash.texi (Creating Hash, Other Hash): Manual updates for make-hash-table, hash-table-rehash-size and hash-table-rehash-threshold. * doc/lispref/objects.texi (Hash Table Type): Update example. * src/fns.c (Fhash_table_rehash_size, Fhash_table_rehash_threshold): Update doc strings. * etc/NEWS: Announce changes. --- doc/lispref/hash.texi | 47 ++++++++--------------------------------------- doc/lispref/objects.texi | 3 +-- etc/NEWS | 15 +++++++++++++++ lisp/emacs-lisp/comp.el | 2 +- src/fns.c | 16 ++++++++-------- 5 files changed, 33 insertions(+), 50 deletions(-) diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi index aeaeab27fc0..3d3fe3e3be2 100644 --- a/doc/lispref/hash.texi +++ b/doc/lispref/hash.texi @@ -121,32 +121,10 @@ referenced in the hash table are preserved from garbage collection. @item :size @var{size} This specifies a hint for how many associations you plan to store in the hash table. If you know the approximate number, you can make things a -little more efficient by specifying it this way. If you specify too -small a size, the hash table will grow automatically when necessary, but -doing that takes some extra time. - -The default size is 65. - -@item :rehash-size @var{rehash-size} -When you add an association to a hash table and the table is full, -it grows automatically. This value specifies how to make the hash table -larger, at that time. - -If @var{rehash-size} is an integer, it should be positive, and the hash -table grows by adding approximately that much to the nominal size. If -@var{rehash-size} is floating point, it had better be greater -than 1, and the hash table grows by multiplying the old size by -approximately that number. - -The default value is 1.5. - -@item :rehash-threshold @var{threshold} -This specifies the criterion for when the hash table is full (so -it should be made larger). The value, @var{threshold}, should be a -positive floating-point number, no greater than 1. The hash table is -full whenever the actual number of entries exceeds the nominal size -multiplied by an approximation to this value. The default for -@var{threshold} is 0.8125. +little more efficient by specifying it this way but since the hash +table memory is managed automatically, the gain in speed is rarely +significant. + @end table @end defun @@ -159,7 +137,7 @@ the following specifies a hash table containing the keys (a symbol) and @code{300} (a number) respectively. @example -#s(hash-table size 30 data (key1 val1 key2 300)) +#s(hash-table data (key1 val1 key2 300)) @end example Note, however, that when using this in Emacs Lisp code, it's @@ -172,12 +150,11 @@ The printed representation for a hash table consists of @samp{#s} followed by a list beginning with @samp{hash-table}. The rest of the list should consist of zero or more property-value pairs specifying the hash table's properties and initial contents. The properties and -values are read literally. Valid property names are @code{size}, -@code{test}, @code{weakness}, @code{rehash-size}, -@code{rehash-threshold}, and @code{data}. The @code{data} property +values are read literally. Valid property names are @code{test}, +@code{weakness} and @code{data}. The @code{data} property should be a list of key-value pairs for the initial contents; the other properties have the same meanings as the matching -@code{make-hash-table} keywords (@code{:size}, @code{:test}, etc.), +@code{make-hash-table} keywords (@code{:test} and @code{:weakness}), described above. Note that you cannot specify a hash table whose initial contents @@ -377,14 +354,6 @@ This function returns the @var{weak} value that was specified for hash table @var{table}. @end defun -@defun hash-table-rehash-size table -This returns the rehash size of @var{table}. -@end defun - -@defun hash-table-rehash-threshold table -This returns the rehash threshold of @var{table}. -@end defun - @defun hash-table-size table This returns the current allocation size of @var{table}. Since hash table allocation is managed automatically, this is rarely of interest. diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 111beb5e5b0..07ceb0d7a98 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -1373,8 +1373,7 @@ and contents, like this: @example (make-hash-table) - @result{} #s(hash-table size 65 test eql rehash-size 1.5 - rehash-threshold 0.8125 data ()) + @result{} #s(hash-table) @end example @noindent diff --git a/etc/NEWS b/etc/NEWS index 5cf3e821627..da0253e97dc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1806,6 +1806,21 @@ The former macro returns non-nil if a variable has a connection-local binding. The latter macro returns the connection-local value of a variable if any, or its current value. +** Hash tables + ++++ +*** ':rehash-size' and ':rehash-threshold' args no longer have any effect. +These keyword arguments are now ignored by 'make-hash-table'. Emacs +manages the memory for all hash table objects in the same way. +The functions 'hash-table-rehash-size' and 'hash-table-rehash-threshold' +remain for compatibility but now always return the old default values. + ++++ +*** The printed representation has been shrunk and simplified. +The 'test' parameter is omitted if it is 'eql' (the default), as is +'data' if empty. 'rehash-size', 'rehash-threshold' and 'size' are +always omitted, and ignored if present when the object is read back in. + * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 260bd2f1acb..8441b228898 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1134,7 +1134,7 @@ Return value is the fall-through block name." (defun comp-jump-table-optimizable (jmp-table) "Return t if JMP-TABLE can be optimized out." ;; Identify LAP sequences like: - ;; (byte-constant #s(hash-table size 3 test eq rehash-size 1.5 rehash-threshold 0.8125 purecopy t data (created 126 deleted 126 changed 126)) . 24) + ;; (byte-constant #s(hash-table test eq purecopy t data (created 126 deleted 126 changed 126)) . 24) ;; (byte-switch) ;; (TAG 126 . 10) (let ((targets (hash-table-values jmp-table))) diff --git a/src/fns.c b/src/fns.c index 70288590e24..2905c3f1b86 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5495,25 +5495,25 @@ DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0, DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, Shash_table_rehash_size, 1, 1, 0, - doc: /* Return the current rehash size of TABLE. */) + doc: /* Return the rehash size of TABLE. +This function is for compatibility only; it returns a nominal value +without current significance. */) (Lisp_Object table) { CHECK_HASH_TABLE (table); - /* Nominal factor by which to increase the size of a hash table. - No longer used; this is for compatibility. */ - return make_float (1.5); + return make_float (1.5); /* The old default rehash-size value. */ } DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, Shash_table_rehash_threshold, 1, 1, 0, - doc: /* Return the current rehash threshold of TABLE. */) + doc: /* Return the rehash threshold of TABLE. +This function is for compatibility only; it returns a nominal value +without current significance. */) (Lisp_Object table) { CHECK_HASH_TABLE (table); - /* Nominal threshold for when to resize a hash table. - No longer used; this is for compatibility. */ - return make_float (0.8125); + return make_float (0.8125); /* The old default rehash-threshold value. */ } -- cgit v1.2.3 From c566ee9d06caa80c120dd8631eb3dee17e152fc9 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 14 Jan 2024 08:26:27 +0800 Subject: Fix bug#65116 * src/xterm.c (xi_focus_handle_for_device): Correct typo. (x_focus_frame): Don't focus frames Emacs believes to be focused if they are frames with independent minibuffer frames. (bug#65116) --- src/xterm.c | 34 ++++++++++++++++++++++++++++++---- 1 file changed, 30 insertions(+), 4 deletions(-) diff --git a/src/xterm.c b/src/xterm.c index 77d6550c8b9..fe398171754 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -13370,13 +13370,12 @@ xi_focus_handle_for_device (struct x_display_info *dpyinfo, frame's user time. */ x_display_set_last_user_time (dpyinfo, event->time, event->send_event, false); - device->focus_frame = NULL; /* So, unfortunately, the X Input Extension is implemented such - that means XI_Leave events will not have their focus field - set if the core focus is transferred to another window after - an entry event that pretends to (or really does) set the + that XI_Leave events will not have their focus field set if + the core focus is transferred to another window after an + entry event that pretends to (or really does) set the implicit focus. In addition, if the core focus is set, but the extension focus on the client pointer is not, all XI_Enter events will have their focus fields set, despite not @@ -28805,6 +28804,33 @@ x_focus_frame (struct frame *f, bool noactivate) friends being set. */ block_input (); +#ifdef HAVE_GTK3 + /* read_minibuf assumes that calling Fx_focus_frame on a frame that + is already selected won't move the focus elsewhere, and thereby + disrupt any focus redirection to e.g. a minibuffer frame that + might be activated between that call being made and the + consequent XI_FocusIn/Out events arriving. This is true whether + the focus is ultimately transferred back to the frame it was + initially on or not. + + GTK 3 moves the keyboard focus to the edit widget's window + whenever it receives a FocusIn event targeting the outer window. + This operation gives rise to a FocusOut event that clears + device->focus_frame, which in turn prompts xi_handle_focus_change + to clear the display's focus frame. The next FocusIn event + destined for the same frame registers as a new focus, which + cancels any focus redirection from that frame. + + To prevent this chain of events from disrupting focus redirection + when the minibuffer is activated twice in rapid succession while + configured to redirect focus to a minibuffer frame, ignore frames + which hold the input focus and are connected to a minibuffer + window. (bug#65116)*/ + + if (f == dpyinfo->x_focus_frame && !FRAME_HAS_MINIBUF_P (f)) + return; +#endif /* HAVE_GTK3 */ + if (FRAME_X_EMBEDDED_P (f)) /* For Xembedded frames, normally the embedder forwards key events. See XEmbed Protocol Specification at -- cgit v1.2.3 From dd83db2e23062642ab964bad226146a8bdac1349 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 14 Jan 2024 21:06:10 +0800 Subject: Correct implementations of FLIPRGON and FLIPRGOFF * src/sfnt.c (sfnt_interpret_fliprgoff) (sfnt_interpret_fliprgon): Reorder arguments to match the order in which arguments are popped by macro wrappers. Fix sundry typos. --- src/sfnt.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/sfnt.c b/src/sfnt.c index f4c023f35c6..2f0153b9a75 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -8966,7 +8966,7 @@ sfnt_dual_project_vector (struct sfnt_interpreter *interpreter, static void sfnt_interpret_fliprgoff (struct sfnt_interpreter *interpreter, - uint32_t l, uint32_t h) + uint32_t h, uint32_t l) { uint32_t i; @@ -8976,7 +8976,7 @@ sfnt_interpret_fliprgoff (struct sfnt_interpreter *interpreter, if (!interpreter->state.zp0) return; - for (i = l; i < h; ++i) + for (i = l; i <= h; ++i) interpreter->glyph_zone->flags[i] &= ~01; } @@ -8985,7 +8985,7 @@ sfnt_interpret_fliprgoff (struct sfnt_interpreter *interpreter, static void sfnt_interpret_fliprgon (struct sfnt_interpreter *interpreter, - uint32_t l, uint32_t h) + uint32_t h, uint32_t l) { uint32_t i; @@ -8995,8 +8995,8 @@ sfnt_interpret_fliprgon (struct sfnt_interpreter *interpreter, if (!interpreter->state.zp0) return; - for (i = l; i < h; ++i) - interpreter->glyph_zone->flags[i] |= ~01; + for (i = l; i <= h; ++i) + interpreter->glyph_zone->flags[i] |= 01; } /* Interpret a FLIPPT instruction in INTERPRETER. For loop times, pop -- cgit v1.2.3 From a9cee9c6675a7002441bdd186402f45eb5379172 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 14 Jan 2024 11:58:33 +0100 Subject: Retype traverse_interval arg type from Lisp_Object to void * This is a refactoring. It eliminates a few unnecessary conses and allows for further improvements. * src/intervals.c (traverse_intervals): Change argument type. All callers adapted. * src/fns.c (collect_interval, Fsxhash_equal_including_properties) (Fobject_intervals): * src/print.c (print_check_string_charset_prop) (print_prune_string_charset, print_object, print_interval): Pass a pointer to a Lisp_Object instead of a Lisp_Object. --- src/fns.c | 24 +++++++++++++----------- src/intervals.c | 2 +- src/intervals.h | 4 ++-- src/print.c | 15 ++++++++------- 4 files changed, 24 insertions(+), 21 deletions(-) diff --git a/src/fns.c b/src/fns.c index 2905c3f1b86..f7c36aacea6 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5241,12 +5241,14 @@ sxhash_obj (Lisp_Object obj, int depth) } static void -collect_interval (INTERVAL interval, Lisp_Object collector) +collect_interval (INTERVAL interval, void *arg) { - nconc2 (collector, - list1(list3 (make_fixnum (interval->position), - make_fixnum (interval->position + LENGTH (interval)), - interval->plist))); + Lisp_Object *collector = arg; + *collector = + nconc2 (*collector, + list1(list3 (make_fixnum (interval->position), + make_fixnum (interval->position + LENGTH (interval)), + interval->plist))); } @@ -5309,13 +5311,13 @@ Hash codes are not guaranteed to be preserved across Emacs sessions. */) if (STRINGP (obj)) { /* FIXME: This is very wasteful. We needn't cons at all. */ - Lisp_Object collector = Fcons (Qnil, Qnil); + Lisp_Object collector = Qnil; traverse_intervals (string_intervals (obj), 0, collect_interval, - collector); + &collector); return make_ufixnum ( SXHASH_REDUCE (sxhash_combine (sxhash (obj), - sxhash (CDR (collector))))); + sxhash (collector)))); } return hash_hash_to_fixnum (hashfn_equal (obj, NULL)); @@ -6304,7 +6306,7 @@ Altering this copy does not change the layout of the text properties in OBJECT. */) (register Lisp_Object object) { - Lisp_Object collector = Fcons (Qnil, Qnil); + Lisp_Object collector = Qnil; INTERVAL intervals; if (STRINGP (object)) @@ -6317,8 +6319,8 @@ in OBJECT. */) if (! intervals) return Qnil; - traverse_intervals (intervals, 0, collect_interval, collector); - return CDR (collector); + traverse_intervals (intervals, 0, collect_interval, &collector); + return collector; } DEFUN ("line-number-at-pos", Fline_number_at_pos, diff --git a/src/intervals.c b/src/intervals.c index 1b1fb3b8181..2ab19c2cc56 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -256,7 +256,7 @@ traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, void *), void traverse_intervals (INTERVAL tree, ptrdiff_t position, - void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg) + void (*function) (INTERVAL, void *), void *arg) { while (tree) { diff --git a/src/intervals.h b/src/intervals.h index aa7502b4f68..610c803cc77 100644 --- a/src/intervals.h +++ b/src/intervals.h @@ -245,8 +245,8 @@ extern INTERVAL create_root_interval (Lisp_Object); extern void copy_properties (INTERVAL, INTERVAL); extern bool intervals_equal (INTERVAL, INTERVAL); extern void traverse_intervals (INTERVAL, ptrdiff_t, - void (*) (INTERVAL, Lisp_Object), - Lisp_Object); + void (*) (INTERVAL, void *), + void *); extern void traverse_intervals_noorder (INTERVAL, void (*) (INTERVAL, void *), void *); extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t) diff --git a/src/print.c b/src/print.c index 58a23b79d5d..0899dcdeb03 100644 --- a/src/print.c +++ b/src/print.c @@ -87,7 +87,7 @@ static struct print_buffer print_buffer; print_number_index holds the largest N already used. N has to be strictly larger than 0 since we need to distinguish -N. */ static ptrdiff_t print_number_index; -static void print_interval (INTERVAL interval, Lisp_Object printcharfun); +static void print_interval (INTERVAL interval, void *pprintcharfun); /* GDB resets this to zero on W32 to disable OutputDebugString calls. */ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1; @@ -1493,8 +1493,6 @@ print_preprocess_string (INTERVAL interval, void *arg) print_preprocess (interval->plist); } -static void print_check_string_charset_prop (INTERVAL interval, Lisp_Object string); - #define PRINT_STRING_NON_CHARSET_FOUND 1 #define PRINT_STRING_UNSAFE_CHARSET_FOUND 2 @@ -1502,7 +1500,7 @@ static void print_check_string_charset_prop (INTERVAL interval, Lisp_Object stri static int print_check_string_result; static void -print_check_string_charset_prop (INTERVAL interval, Lisp_Object string) +print_check_string_charset_prop (INTERVAL interval, void *pstring) { Lisp_Object val; @@ -1526,6 +1524,7 @@ print_check_string_charset_prop (INTERVAL interval, Lisp_Object string) if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND)) { ptrdiff_t charpos = interval->position; + Lisp_Object string = *(Lisp_Object *)pstring; ptrdiff_t bytepos = string_char_to_byte (string, charpos); Lisp_Object charset = XCAR (XCDR (val)); @@ -1550,7 +1549,7 @@ print_prune_string_charset (Lisp_Object string) { print_check_string_result = 0; traverse_intervals (string_intervals (string), 0, - print_check_string_charset_prop, string); + print_check_string_charset_prop, &string); if (NILP (Vprint_charset_text_property) || ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND)) { @@ -2401,8 +2400,9 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) if (string_intervals (obj)) { + Lisp_Object pcf = printcharfun; traverse_intervals (string_intervals (obj), - 0, print_interval, printcharfun); + 0, print_interval, &pcf); printchar (')', printcharfun); } } @@ -2792,10 +2792,11 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) This is part of printing a string that has text properties. */ static void -print_interval (INTERVAL interval, Lisp_Object printcharfun) +print_interval (INTERVAL interval, void *pprintcharfun) { if (NILP (interval->plist)) return; + Lisp_Object printcharfun = *(Lisp_Object *)pprintcharfun; printchar (' ', printcharfun); print_object (make_fixnum (interval->position), printcharfun, 1); printchar (' ', printcharfun); -- cgit v1.2.3 From 3869944bb4f9434e0c49063a291ed8a0a33cba50 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 14 Jan 2024 12:33:12 +0100 Subject: Speed up sxhash-equal-including-properties This function now no longer conses at all. Previously, it constructed a list structure of all string intervals for the sole purpose of hashing. * src/fns.c (hash_interval): New. (Fsxhash_equal_including_properties): Use it instead of collect_interval. --- src/fns.c | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/src/fns.c b/src/fns.c index f7c36aacea6..07bb5115b6c 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5240,6 +5240,17 @@ sxhash_obj (Lisp_Object obj, int depth) } } +static void +hash_interval (INTERVAL interval, void *arg) +{ + EMACS_UINT *phash = arg; + EMACS_UINT hash = *phash; + hash = sxhash_combine (hash, interval->position); + hash = sxhash_combine (hash, LENGTH (interval)); + hash = sxhash_combine (hash, sxhash_obj (interval->plist, 0)); + *phash = hash; +} + static void collect_interval (INTERVAL interval, void *arg) { @@ -5310,14 +5321,9 @@ Hash codes are not guaranteed to be preserved across Emacs sessions. */) { if (STRINGP (obj)) { - /* FIXME: This is very wasteful. We needn't cons at all. */ - Lisp_Object collector = Qnil; - traverse_intervals (string_intervals (obj), 0, collect_interval, - &collector); - return - make_ufixnum ( - SXHASH_REDUCE (sxhash_combine (sxhash (obj), - sxhash (collector)))); + EMACS_UINT hash = 0; + traverse_intervals (string_intervals (obj), 0, hash_interval, &hash); + return make_ufixnum (SXHASH_REDUCE (sxhash_combine (sxhash (obj), hash))); } return hash_hash_to_fixnum (hashfn_equal (obj, NULL)); -- cgit v1.2.3 From cd0855cbd81b5fd3866c9a3242f0490c938b6d4d Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 14 Jan 2024 12:50:36 +0100 Subject: Make object-intervals linear instead of quadratic * src/fns.c (collect_interval, Fobject_intervals): Build the returned list in reverse instead of appending single elements. --- src/fns.c | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/fns.c b/src/fns.c index 07bb5115b6c..acfedbfa922 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5255,11 +5255,11 @@ static void collect_interval (INTERVAL interval, void *arg) { Lisp_Object *collector = arg; - *collector = - nconc2 (*collector, - list1(list3 (make_fixnum (interval->position), - make_fixnum (interval->position + LENGTH (interval)), - interval->plist))); + *collector = Fcons (list3 (make_fixnum (interval->position), + make_fixnum (interval->position + + LENGTH (interval)), + interval->plist), + *collector); } @@ -6312,7 +6312,6 @@ Altering this copy does not change the layout of the text properties in OBJECT. */) (register Lisp_Object object) { - Lisp_Object collector = Qnil; INTERVAL intervals; if (STRINGP (object)) @@ -6325,8 +6324,9 @@ in OBJECT. */) if (! intervals) return Qnil; + Lisp_Object collector = Qnil; traverse_intervals (intervals, 0, collect_interval, &collector); - return collector; + return Fnreverse (collector); } DEFUN ("line-number-at-pos", Fline_number_at_pos, -- cgit v1.2.3 From d4b1e2c3b630ec3b38fb1e6592ba253452c52052 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 14 Jan 2024 13:37:44 +0100 Subject: Use forward-line instead of next-line in noninteractive test * test/lisp/textmodes/page-tests.el (page-tests-what-page): Silence byte-compiler warning; forward-line works nicely here. --- test/lisp/textmodes/page-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/lisp/textmodes/page-tests.el b/test/lisp/textmodes/page-tests.el index 617b59a54fb..fdefca36c0b 100644 --- a/test/lisp/textmodes/page-tests.el +++ b/test/lisp/textmodes/page-tests.el @@ -110,7 +110,7 @@ (should (equal (page--what-page) '(1 1))) (forward-page) (should (equal (page--what-page) '(2 1))) - (next-line) + (forward-line) (should (equal (page--what-page) '(2 2))) (forward-page) (should (equal (page--what-page) '(3 1))))) -- cgit v1.2.3 From a83e60eccbc16613fc3da85f46a3fb032c098a82 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 14 Jan 2024 14:10:17 +0100 Subject: Fix recent ses-tests mistakes (bug#5852) * test/lisp/ses-tests.el (ses-set-formula-write-cells-with-changed-references): Quote constant list. Remove unused variable. --- test/lisp/ses-tests.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/lisp/ses-tests.el b/test/lisp/ses-tests.el index be6784be7a0..a916aed9eb3 100644 --- a/test/lisp/ses-tests.el +++ b/test/lisp/ses-tests.el @@ -246,7 +246,7 @@ to `ses--bar' and inserting a row, makes A2 value empty, and `ses--bar' equal to When setting a formula has some cell with changed references, this cell has to be rewritten to data area." (let ((ses-initial-size '(4 . 3)) - ses-after-entry-functions beg) + (ses-after-entry-functions nil)) (with-temp-buffer (ses-mode) (dolist (c '((0 1 1); B1 @@ -257,7 +257,7 @@ cell has to be rewritten to data area." (apply 'ses-calculate-cell (list (car c) (cadr c) nil))) (ses-cell-set-formula 2 1 '(+ B2 A3)); B3 (ses-command-hook) - (ses-cell-set-formula 3 1 (+ B3 A4)); B4 + (ses-cell-set-formula 3 1 '(+ B3 A4)); B4 (ses-command-hook) (should (equal (ses-cell-references 1 1) '(B3))) (ses-mode) -- cgit v1.2.3 From 7d869a04029798410773fe6071e76b556d3a9ee2 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 14 Jan 2024 14:47:39 +0100 Subject: Doc fix in auth-source-read-char-choice * lisp/auth-source.el (auth-source-read-char-choice): Don't document 'dropdown-list', which was removed in 2011. --- lisp/auth-source.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 5776b6acb8c..5969cdbf9f8 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -330,7 +330,6 @@ If the value is not a list, symmetric encryption will be used." (defun auth-source-read-char-choice (prompt choices) "Read one of CHOICES by `read-char-choice', or `read-char'. -`dropdown-list' support is disabled because it doesn't work reliably. Only one of CHOICES will be returned. The PROMPT is augmented with \"[a/b/c] \" if CHOICES is \(?a ?b ?c)." (when choices -- cgit v1.2.3 From 6653ee66ca5ebd42322613a09d4c0d2e35af924b Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 14 Jan 2024 14:52:17 +0100 Subject: Improve two docstrings in ox-latex * lisp/org/ox-latex.el (org-latex-src-block-backend) (org-latex-engraved-theme): Improve docstring; mention that engrave-faces is a GNU ELPA package. --- lisp/org/ox-latex.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index 9989a9bae5c..f44b50c99ea 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -978,7 +978,7 @@ The most comprehensive option can be set with, which causes source code to be run through `engrave-faces-latex-buffer', which generates colorings using Emacs' font-lock information. This requires the Emacs package -engrave-faces (available from ELPA), and the LaTeX package +engrave-faces (available from GNU ELPA), and the LaTeX package fvextra be installed. The styling of the engraved result can be customized with @@ -1262,9 +1262,10 @@ block-specific options, you may use the following syntax: (defcustom org-latex-engraved-theme nil "The theme that should be used for engraved code, when non-nil. -This can be set to any theme defined in `engrave-faces-themes' or -loadable by Emacs. When set to t, the current Emacs theme is -used. When nil, no theme is applied." +This can be set to any theme defined in `engrave-faces-themes' +(from the engrave-faces package) or loadable by Emacs. When set +to t, the current Emacs theme is used. When nil, no theme is +applied." :group 'org-export-latex :package-version '(Org . "9.6") :type 'symbol) -- cgit v1.2.3 From 725a3f32f8ba78ac5fffcd03be5b82cbc2c1b275 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 14 Jan 2024 14:56:06 +0100 Subject: ; Fix typos in symbol names --- admin/cus-test.el | 2 +- lisp/abbrev.el | 2 +- lisp/calendar/todo-mode.el | 2 +- lisp/erc/erc.el | 2 +- lisp/jsonrpc.el | 2 +- lisp/leim/quail/cyrillic.el | 4 ++-- lisp/org/org-element.el | 2 +- lisp/org/org-fold-core.el | 2 +- lisp/org/org-macs.el | 2 +- lisp/org/ox-latex.el | 2 +- lisp/progmodes/eglot.el | 2 +- lisp/term.el | 2 +- lisp/term/pc-win.el | 2 +- lisp/treesit.el | 2 +- lisp/window.el | 2 +- 15 files changed, 16 insertions(+), 16 deletions(-) diff --git a/admin/cus-test.el b/admin/cus-test.el index 62fec77c16f..64c742ea855 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -146,7 +146,7 @@ Names should be as they appear in loaddefs.el.") (defvar cus-test-errors nil "List of problematic variables found by `cus-test-apropos'. -Each element is (VARIABLE . PROBLEM); see `cus-test--format-problem'.") +Each element is (VARIABLE . PROBLEM); see `cus-test--format-errors'.") (defvar cus-test-tested-variables nil "List of options tested by last call of `cus-test-apropos'.") diff --git a/lisp/abbrev.el b/lisp/abbrev.el index c4eac8c5c39..9afa617908e 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -1275,7 +1275,7 @@ which see." (setq font-lock-multiline nil)) (defun abbrev--possibly-save (query &optional arg) - "Hook function for use by `save-some-buffer-functions'. + "Hook function for use by `save-some-buffers-functions'. Maybe save abbrevs, and record whether we either saved them or asked to." ;; Query mode. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 20e056c2521..9ef473b1b43 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -1516,7 +1516,7 @@ the archive of the file moved to, creating it if it does not exist." (prin1 todo-categories (current-buffer))) ;; If archive was just created, save it to avoid "File ;; no longer exists!" message on invoking - ;; `todo-view-archived-items'. + ;; `todo-find-archive'. (unless (file-exists-p (buffer-file-name)) (save-buffer)) (todo-category-number (or new cat)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 4171ba3cb1d..88e41e96a82 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2192,7 +2192,7 @@ parameters SERVER and NICK." ;; (bug#60428). (defun erc--warn-unencrypted () ;; Remove unconditionally to avoid wrong context due to races from - ;; simultaneous dialing or aborting (e.g., via `keybaord-quit'). + ;; simultaneous dialing or aborting (e.g., via `keyboard-quit'). (remove-hook 'erc--server-post-connect-hook #'erc--warn-unencrypted) (when (and (process-contact erc-server-process :nowait) (equal erc-session-server erc-default-server) diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 2ccb528fee9..f2060d3faa1 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -555,7 +555,7 @@ With optional CLEANUP, kill any associated buffers." "Called when new data STRING has arrived for PROC." (when jsonrpc--in-process-filter ;; Problematic recursive process filters may happen if - ;; `jsonrpc--connection-receive', called by us, eventually calls + ;; `jsonrpc-connection-receive', called by us, eventually calls ;; client code which calls `process-send-string' (which see) to, ;; say send a follow-up message. If that happens to writes enough ;; bytes for pending output to be received, we will lose JSONRPC diff --git a/lisp/leim/quail/cyrillic.el b/lisp/leim/quail/cyrillic.el index 577898f82bd..60c88221a65 100644 --- a/lisp/leim/quail/cyrillic.el +++ b/lisp/leim/quail/cyrillic.el @@ -1101,9 +1101,9 @@ as follows. ;; Ognyan Kulev wrote: ;; I would suggest future `cyrillic-translit' to be with the -;; modification of `cyrillic-translit-bulgarian' applied and the +;; modification of `cyrillic-translit-bulgarian' (now deleted) applied and the ;; latter to disappear. It could be used by people who write -;; bulgarian e-mails with latin letters for kick start (phonetic input +;; Bulgarian e-mails with latin letters for kick start (phonetic input ;; method is not so obvious as translit input method but each letter ;; is one keypress and a *lot* of people know it). diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index ff587bba38c..796191dd386 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -6556,7 +6556,7 @@ the expected result." (error "org-element: Parsing aborted by user. Cache has been cleared. If you observe Emacs hangs frequently, please report this to Org mode mailing list (M-x org-submit-bug-report).")) (message (substitute-command-keys - "`org-element--parse-buffer': Suppressed `\\[keyboard-quit]'. Press `\\[keyboard-quit]' %d more times to force interruption.") + "`org-element--parse-to': Suppressed `\\[keyboard-quit]'. Press `\\[keyboard-quit]' %d more times to force interruption.") (- org-element--cache-interrupt-C-g-max-count org-element--cache-interrupt-C-g-count))) (unless element diff --git a/lisp/org/org-fold-core.el b/lisp/org/org-fold-core.el index 73b3c9bbf8c..be90ca398a1 100644 --- a/lisp/org/org-fold-core.el +++ b/lisp/org/org-fold-core.el @@ -433,7 +433,7 @@ Return nil when there is no matching folding spec." (org-fold-core-get-folding-spec-from-alias spec-or-alias)) (defsubst org-fold-core--check-spec (spec-or-alias) - "Throw an error if SPEC-OR-ALIAS is not in `org-fold-core--spec-priority-list'." + "Throw an error if SPEC-OR-ALIAS is not in `org-fold-core-folding-spec-list'." (unless (org-fold-core-folding-spec-p spec-or-alias) (error "%s is not a valid folding spec" spec-or-alias))) diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 55541834784..b891284a8bb 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -1072,7 +1072,7 @@ Return width in pixels when PIXELS is non-nil." ;; FIXME: Fallback to old limited version, because ;; `window-pixel-width' is buggy in older Emacs. (org--string-width-1 string) - ;; Wrap/line prefix will make `window-text-pizel-size' return too + ;; Wrap/line prefix will make `window-text-pixel-size' return too ;; large value including the prefix. (remove-text-properties 0 (length string) '(wrap-prefix t line-prefix t) diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index f44b50c99ea..c83728a8f09 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -3667,7 +3667,7 @@ CONTENTS is the contents of the object." ;; takes care of tables with a "verbatim" mode. Otherwise, it ;; delegates the job to either `org-latex--table.el-table', ;; `org-latex--org-table', `org-latex--math-table' or -;; `org-latex--org-tabbing' functions, +;; `org-latex--org-align-string-tabbing' functions, ;; depending of the type of the table and the mode requested. ;; ;; `org-latex--align-string' is a subroutine used to build alignment diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 64fd548e824..1e90e26a537 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1592,7 +1592,7 @@ If optional MARKER, return a marker instead" (let ((vec (copy-sequence url-path-allowed-chars))) (aset vec ?: nil) ;; see github#639 vec) - "Like `url-path-allows-chars' but more restrictive.") + "Like `url-path-allowed-chars' but more restrictive.") (defun eglot--path-to-uri (path) "URIfy PATH." diff --git a/lisp/term.el b/lisp/term.el index e3dedf247d1..647938c3b86 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -1109,7 +1109,7 @@ variable `term-input-autoexpand', and addition is controlled by the variable `term-input-ignoredups'. Input to, and output from, the subprocess can cause the window to scroll to -the end of the buffer. See variables `term-scroll-to-bottom-on-input', +the end of the buffer. See variables `term-scroll-snap-to-bottom', and `term-scroll-to-bottom-on-output'. If you accidentally suspend your process, use \\[term-continue-subjob] diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el index 02ad6b85c37..92d65c75816 100644 --- a/lisp/term/pc-win.el +++ b/lisp/term/pc-win.el @@ -47,7 +47,7 @@ ;; This was copied from etc/rgb.txt, except that some values were changed ;; a bit to make them consistent with DOS console colors, and the RGB -;; values were scaled up to 16 bits, as `tty-define-color' requires. +;; values were scaled up to 16 bits, as `tty-color-define' requires. ;;; ;; The mapping between the 16 standard EGA/VGA colors and X color names ;; was done by running a Unix version of Emacs inside an X client and a diff --git a/lisp/treesit.el b/lisp/treesit.el index c63bf510a24..2676ed932dc 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1422,7 +1422,7 @@ no-node comment-end - Matches if text after point matches `treesit-comment-end'. + Matches if text after point matches `comment-end-skip'. catch-all diff --git a/lisp/window.el b/lisp/window.el index c7cd32e6200..13fe1feba10 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -8528,7 +8528,7 @@ buffer. ALIST is a buffer display action alist as compiled by canonical frame lines. If it is the constant `full-height', prefer a full-height window. -If ALIST contains a non-nil `inhibit-same--window' entry, do not +If ALIST contains a non-nil `inhibit-same-window' entry, do not return the selected window." (let ((windows (window-list-1 nil 'nomini (cdr (assq 'lru-frames alist)))) -- cgit v1.2.3 From 78ddb32fadb61b3e78047400e257d57b2cff7cd8 Mon Sep 17 00:00:00 2001 From: Daniel Martín Date: Sun, 14 Jan 2024 15:36:16 +0100 Subject: Fix documentation of icon-elements * lisp/emacs-lisp/icons.el (icon-elements): The plist key it returns is `image', not `display'. (Bug#68451) --- lisp/emacs-lisp/icons.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el index 1fc0e39f9fe..f9591661688 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -164,7 +164,7 @@ If OBJECT is an icon, return the icon properties." (defun icon-elements (name) "Return the elements of icon NAME. The elements are represented as a plist where the keys are -`string', `face' and `display'. The `image' element is only +`string', `face' and `image'. The `image' element is only present if the icon is represented by an image." (let ((string (icon-string name))) (list 'face (get-text-property 0 'face string) -- cgit v1.2.3 From 5bb5590dec95e813ed120b3f09734451b4ebb18f Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Thu, 11 Jan 2024 23:38:22 +0000 Subject: Fix blunder in labeled_narrow_to_region * src/editfns.c (labeled_narrow_to_region): Record point before, instead of after, calling narrow-to-region; otherwise point may already have been changed. Fixes bug#66764. --- src/editfns.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/editfns.c b/src/editfns.c index 063dfc6d131..6ddee0840c2 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2870,9 +2870,9 @@ void labeled_narrow_to_region (Lisp_Object begv, Lisp_Object zv, Lisp_Object label) { - Finternal__labeled_narrow_to_region (begv, zv, label); record_unwind_protect (restore_point_unwind, Fpoint_marker ()); record_unwind_protect (unwind_labeled_narrow_to_region, label); + Finternal__labeled_narrow_to_region (begv, zv, label); } DEFUN ("widen", Fwiden, Swiden, 0, 0, "", -- cgit v1.2.3 From 0d336507dfe34a36916c00add3b89abe396fea33 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Mon, 15 Jan 2024 00:53:36 +0000 Subject: ; * admin/git-bisect-start: Update failing commits --- admin/git-bisect-start | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/admin/git-bisect-start b/admin/git-bisect-start index 069f66515ba..f9933b3ae4d 100755 --- a/admin/git-bisect-start +++ b/admin/git-bisect-start @@ -84,7 +84,7 @@ done # SKIP-BRANCH 58cc931e92ece70c3e64131ee12a799d65409100 ## The list below is the exhaustive list of all commits between Dec 1 -## 2016 and Oct 2 2023 on which building Emacs with the default +## 2016 and Jan 13 2024 on which building Emacs with the default ## options, on a GNU/Linux computer and with GCC, fails. It is ## possible (though unlikely) that building Emacs with non-default ## options, with other compilers, or on other platforms, would succeed @@ -1788,3 +1788,9 @@ $REAL_GIT bisect skip $(cat $0 | grep '^# SKIP-SINGLE ' | sed 's/^# SKIP-SINGLE # SKIP-SINGLE f7fd21b06865d20a16c11e20776e843db24d4b14 # SKIP-SINGLE 35fbf6f15830f576fd1909f4a8d30e7ba1d777bd # SKIP-SINGLE 0e44ab5f061c81874dd8298a0f3318f14ef95a24 +# SKIP-SINGLE 4675aff76828b0747d1ac900d65d4a92a457ebf5 +# SKIP-SINGLE bf4d4ab4ddecffbee6d740f9c271dcca514d6a3d +# SKIP-SINGLE 2a8e6c8c84ed33674e525625644d5ce84ee8c59a +# SKIP-SINGLE fa5f06c1251ff717d661f05fcd240b4792054aae +# SKIP-SINGLE d3cefd3e98354929d96c9396e5920e8a123784dc +# SKIP-SINGLE 486094126ba77e45c50acb87f5ad3e4147608446 -- cgit v1.2.3 From 314c939d1e182b8d015fc9c63d445274e0494748 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 14 Jan 2024 22:17:13 -0500 Subject: (js-json-mode): Don't derive from `js-mode` (bug#67463) * lisp/progmodes/js.el (js--mode-setup): New function, extracted from `js-mode`. (js-mode): Use it. (js-json-mode): Use it instead of inheriting from `js-mode`. --- etc/NEWS | 5 +++++ lisp/progmodes/js.el | 7 ++++++- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index da0253e97dc..03b8c3b517a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1002,6 +1002,11 @@ which calls 'xref-find-definitions'. If the previous one worked better for you, use 'define-key' in your init script to bind 'js-find-symbol' to that combination again. +** Json mode +`js-json-mode` does not derive from `js-mode` any more so as not +to confuse tools like Eglot or YASnippet into thinking that those +buffers contain Javascript code. + ** Python mode --- diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 0115feb0e97..947d91c9b1a 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3702,6 +3702,9 @@ Currently there are `js-mode' and `js-ts-mode'." (define-derived-mode js-mode js-base-mode "JavaScript" "Major mode for editing JavaScript." :group 'js + (js--mode-setup)) + +(defun js--mode-setup () ;; Ensure all CC Mode "lang variables" are set to valid values. (c-init-language-vars js-mode) (setq-local indent-line-function #'js-indent-line) @@ -3924,7 +3927,9 @@ See `treesit-thing-settings' for more information.") (put-text-property (1- ne) ne 'syntax-table syntax))))) ;;;###autoload -(define-derived-mode js-json-mode js-mode "JSON" +(define-derived-mode js-json-mode prog-mode "JSON" + :syntax-table js-mode-syntax-table + (js--mode-setup) ;Reuse most of `js-mode', but not as parent (bug#67463). (setq-local js-enabled-frameworks nil) ;; Speed up `syntax-ppss': JSON files can be big but can't hold ;; regexp matchers nor #! thingies (and `js-enabled-frameworks' is nil). -- cgit v1.2.3 From c11cdf1858cc89464cd7118d6109c7472c50e652 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 15 Jan 2024 14:32:26 +0800 Subject: ; * src/xterm.c (x_focus_frame): Insert missing unblock_input. --- src/xterm.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/xterm.c b/src/xterm.c index fe398171754..c8a43785564 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -28828,7 +28828,10 @@ x_focus_frame (struct frame *f, bool noactivate) window. (bug#65116)*/ if (f == dpyinfo->x_focus_frame && !FRAME_HAS_MINIBUF_P (f)) - return; + { + unblock_input (); + return; + } #endif /* HAVE_GTK3 */ if (FRAME_X_EMBEDDED_P (f)) -- cgit v1.2.3 From 43612103c221ffb300536798e2b8a8adb753f594 Mon Sep 17 00:00:00 2001 From: João Távora Date: Mon, 15 Jan 2024 06:32:51 -0600 Subject: Jsonrpc: fix bug in jsonrpc--remove * lisp/jsonrpc.el (jsonrpc--remove): Check timer before cancelling it. (Version): Bump to 1.2.24 See https://github.com/joaotavora/eglot/issues/1342 --- lisp/jsonrpc.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index f0f5842a0ee..7ff57daeb7d 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -4,7 +4,7 @@ ;; Author: João Távora ;; Keywords: processes, languages, extensions -;; Version: 1.0.23 +;; Version: 1.0.24 ;; Package-Requires: ((emacs "25.2")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -782,7 +782,7 @@ Return the full continuation (ID SUCCESS-FN ERROR-FN TIMER)" (if deferred-spec (remhash deferred-spec defs)) (when-let ((ass (assq id conts))) (cl-destructuring-bind (_ _ _ _ timer) ass - (cancel-timer timer)) + (when timer (cancel-timer timer))) (setf conts (delete ass conts)) ass))) -- cgit v1.2.3 From 53b5b77010117e2f58565dacf96fddeb734b6021 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Wed, 16 Aug 2023 15:58:29 +0000 Subject: Simplify 'without-restriction' This simplification is symmetrical to 01fb898420. * src/editfns.c: (Finternal__labeled_widen): Add a call to 'Fwiden', and rename from 'internal--unlabel-restriction'. (unwind_labeled_narrow_to_region): Use the renamed function, and remove the call to 'Fwiden'. (syms_of_editfns): Rename the symbol. * lisp/subr.el (internal--without-restriction): Use the renamed function. (cherry picked from commit 9e9e11648d3d5514de85edfb69f0949a062f4716) --- lisp/subr.el | 5 +++-- src/editfns.c | 16 ++++++++-------- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index e8a6bb01c1e..d9df8d1a458 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4013,8 +4013,9 @@ by `with-restriction' with the same LABEL argument are lifted. (defun internal--without-restriction (body &optional label) "Helper function for `without-restriction', which see." (save-restriction - (if label (internal--unlabel-restriction label)) - (widen) + (if label + (internal--labeled-widen label) + (widen)) (funcall body))) (defun find-tag-default-bounds () diff --git a/src/editfns.c b/src/editfns.c index 6ddee0840c2..85f7739df07 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2684,7 +2684,7 @@ DEFUN ("delete-and-extract-region", Fdelete_and_extract_region, labeled restriction was entered (which may be a narrowing that was set by the user and is visible on display). This alist is used internally by narrow-to-region, internal--labeled-narrow-to-region, - widen, internal--unlabel-restriction and save-restriction. For + widen, internal--labeled-widen and save-restriction. For efficiency reasons, an alist is used instead of a buffer-local variable: otherwise reset_outermost_restrictions, which is called during each redisplay cycle, would have to loop through all live @@ -2860,8 +2860,7 @@ labeled_restrictions_restore (Lisp_Object buf_and_restrictions) static void unwind_labeled_narrow_to_region (Lisp_Object label) { - Finternal__unlabel_restriction (label); - Fwiden (); + Finternal__labeled_widen (label); } /* Narrow current_buffer to BEGV-ZV with a restriction labeled with @@ -2984,7 +2983,7 @@ argument. To gain access to other portions of the buffer, use DEFUN ("internal--labeled-narrow-to-region", Finternal__labeled_narrow_to_region, Sinternal__labeled_narrow_to_region, 3, 3, 0, - doc: /* Restrict editing in this buffer to START-END, and label the restriction with LABEL. + doc: /* Restrict this buffer to START-END, and label the restriction with LABEL. This is an internal function used by `with-restriction'. */) (Lisp_Object start, Lisp_Object end, Lisp_Object label) @@ -3002,9 +3001,9 @@ This is an internal function used by `with-restriction'. */) return Qnil; } -DEFUN ("internal--unlabel-restriction", Finternal__unlabel_restriction, - Sinternal__unlabel_restriction, 1, 1, 0, - doc: /* If the current restriction is labeled with LABEL, remove its label. +DEFUN ("internal--labeled-widen", Finternal__labeled_widen, + Sinternal__labeled_widen, 1, 1, 0, + doc: /* Remove the current restriction if it is labeled with LABEL, and widen. This is an internal function used by `without-restriction'. */) (Lisp_Object label) @@ -3012,6 +3011,7 @@ This is an internal function used by `without-restriction'. */) Lisp_Object buf = Fcurrent_buffer (); if (EQ (labeled_restrictions_peek_label (buf), label)) labeled_restrictions_pop (buf); + Fwiden (); return Qnil; } @@ -4951,7 +4951,7 @@ it to be non-nil. */); defsubr (&Swiden); defsubr (&Snarrow_to_region); defsubr (&Sinternal__labeled_narrow_to_region); - defsubr (&Sinternal__unlabel_restriction); + defsubr (&Sinternal__labeled_widen); defsubr (&Ssave_restriction); defsubr (&Stranspose_regions); } -- cgit v1.2.3 From 2ef3111b136599ee26ec4316199677107bffedbc Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 15 Jan 2024 16:55:27 +0100 Subject: * lisp/info-xref.el (info-xref-subfile-p): Avoid false positives. (Bug#68428) --- lisp/info-xref.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/info-xref.el b/lisp/info-xref.el index 7887909037b..95e9a1e55f7 100644 --- a/lisp/info-xref.el +++ b/lisp/info-xref.el @@ -79,9 +79,11 @@ If removing the last \"-\" from the filename gives a file which exists, then consider FILENAME a subfile. This is an imperfect test, probably ought to open up the purported top file and see what subfiles it says." - (and (string-match "\\`\\(\\([^-]*-\\)*[^-]*\\)-[0-9]+\\(.*\\)\\'" filename) - (file-exists-p (concat (match-string 1 filename) - (match-string 3 filename))))) + (let ((nondir (file-name-nondirectory filename))) + (and (string-match "\\`\\(\\([^-]*-\\)*[^-]*\\)-[0-9]+\\(.*\\)\\'" nondir) + (file-exists-p (concat (file-name-directory filename) + (match-string 1 nondir) + (match-string 3 nondir)))))) (defmacro info-xref-with-file (filename &rest body) ;; checkdoc-params: (filename body) -- cgit v1.2.3 From 27ff4d9c4956fe06c59f342def8b35d32bbc3b50 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 15 Jan 2024 19:00:50 -0500 Subject: * lisp/help-fns.el (help-fns--parent-mode): Mention the extra parents As suggested by Stefan Kangas in bug#68246. --- lisp/help-fns.el | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index ca21408f6c3..99642d08bbd 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -741,18 +741,28 @@ the C sources, too." (defun help-fns--parent-mode (function) ;; If this is a derived mode, link to the parent. - (let ((parent-mode (and (symbolp function) - ;; FIXME: Should we mention other parent modes? - (get function - 'derived-mode-parent)))) + (when (symbolp function) + (let ((parent-mode (get function 'derived-mode-parent)) + (extra-parents (get function 'derived-mode-extra-parents))) (when parent-mode (insert (substitute-quotes " Parent mode: `")) (let ((beg (point))) - (insert (format "%s" parent-mode)) + (insert (format "%S" parent-mode)) (make-text-button beg (point) 'type 'help-function 'help-args (list parent-mode))) - (insert (substitute-quotes "'.\n"))))) + (insert (substitute-quotes "'.\n"))) + (when extra-parents + (insert (format " Extra parent mode%s:" (if (cdr extra-parents) "s" ""))) + (dolist (parent extra-parents) + (insert (substitute-quotes " `")) + (let ((beg (point))) + (insert (format "%S" parent)) + (make-text-button beg (point) + 'type 'help-function + 'help-args (list parent))) + (insert (substitute-quotes "'"))) + (insert ".\n"))))) (defun help-fns--obsolete (function) ;; Ignore lambda constructs, keyboard macros, etc. -- cgit v1.2.3 From e6a2901b1be6b4aa01f8bf0d3c6e06344ce8d366 Mon Sep 17 00:00:00 2001 From: Mike Kupfer Date: Mon, 15 Jan 2024 11:47:43 -0800 Subject: Fix folder creation error (Bug#67361) * lisp/mh-e/mh-funcs.el (mh-kill-folder), lisp/mh-e/mh-search.el (mh-index-new-folder), lisp/mh-e/mh-utils.el (mh-prompt-for-folder): Check for existence of speedbar-buffer rather than mh-speed-folder-map. The latter can exist if mh-speed has only been loaded but not displayed. --- lisp/mh-e/mh-funcs.el | 2 +- lisp/mh-e/mh-search.el | 2 +- lisp/mh-e/mh-utils.el | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el index 2684722eb26..bb3e67467d5 100644 --- a/lisp/mh-e/mh-funcs.el +++ b/lisp/mh-e/mh-funcs.el @@ -108,7 +108,7 @@ folder. This is useful for folders that are easily regenerated." (window-config mh-previous-window-config)) (mh-set-folder-modified-p t) ; lock folder to kill it (mh-exec-cmd-daemon "rmf" 'mh-rmf-daemon folder) - (when (boundp 'mh-speed-folder-map) + (when (and (boundp 'speedbar-buffer) speedbar-buffer) (mh-speed-invalidate-map folder)) (mh-remove-from-sub-folders-cache folder) (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index f475973631c..59dad161c11 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -1569,7 +1569,7 @@ If the folder returned doesn't exist then it is created." (save-excursion (mh-exec-cmd-quiet nil "rmf" chosen-name)) (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name) (mh-remove-from-sub-folders-cache chosen-name) - (when (boundp 'mh-speed-folder-map) + (when (and (boundp 'speedbar-buffer) speedbar-buffer) (mh-speed-add-folder chosen-name)) chosen-name)) diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index 7943879d887..9d5711105ba 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -795,7 +795,7 @@ used in searching." (message "Creating %s" folder-name) (mh-exec-cmd-error nil "folder" folder-name) (mh-remove-from-sub-folders-cache folder-name) - (when (boundp 'mh-speed-folder-map) + (when (and (boundp 'speedbar-buffer) speedbar-buffer) (mh-speed-add-folder folder-name)) (message "Creating %s...done" folder-name)) (new-file-flag -- cgit v1.2.3 From 44fcab04f6a346e602f00a6d9f5b0e6f0dbeb5e0 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 16 Jan 2024 10:59:34 +0800 Subject: Enable the system's Arabic and Khmer fonts under Android * lisp/international/fontset.el (setup-default-fontset): If `android', search for Arabic or Khmer fonts with script tags, not OTF features. --- lisp/international/fontset.el | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 2c461a7f7ab..33e444507c4 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -645,8 +645,14 @@ (nil . "microsoft-cp1251") (nil . "koi8-r")) - (arabic ,(font-spec :registry "iso10646-1" - :otf '(arab nil (init medi fina liga))) + (arabic ,(if (featurep 'android) + ;; The Android font driver does not support the + ;; detection of OTF tags but all fonts installed on + ;; Android with Arabic characters provide shaping + ;; information required for displaying Arabic text. + (font-spec :registry "iso10646-1" :script 'arabic) + (font-spec :registry "iso10646-1" + :otf '(arab nil (init medi fina liga)))) (nil . "MuleArabic-0") (nil . "MuleArabic-1") (nil . "MuleArabic-2") @@ -657,7 +663,9 @@ (hebrew ,(font-spec :registry "iso10646-1" :script 'hebrew) (nil . "ISO8859-8")) - (khmer ,(font-spec :registry "iso10646-1" :otf '(khmr nil (pres)))) + (khmer ,(if (featurep 'android) + (font-spec :registry "iso10646-1" :script 'khmer) + (font-spec :registry "iso10646-1" :otf '(khmr nil (pres))))) (kana (nil . "JISX0208*") (nil . "GB2312.1980-0") -- cgit v1.2.3 From d4b9cb6b5b640e8d769c82289e4308407be12ba9 Mon Sep 17 00:00:00 2001 From: Mike Kupfer Date: Mon, 15 Jan 2024 11:47:43 -0800 Subject: Fix folder creation error (Bug#67361) * lisp/mh-e/mh-funcs.el (mh-kill-folder) * lisp/mh-e/mh-search.el (mh-index-new-folder) * lisp/mh-e/mh-utils.el (mh-prompt-for-folder): Check for existence of 'speedbar-buffer' rather than 'mh-speed-folder-map'. The latter can exist if 'mh-speed' has only been loaded but not displayed. (cherry picked from commit e6a2901b1be6b4aa01f8bf0d3c6e06344ce8d366) --- lisp/mh-e/mh-funcs.el | 2 +- lisp/mh-e/mh-search.el | 2 +- lisp/mh-e/mh-utils.el | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el index 2684722eb26..bb3e67467d5 100644 --- a/lisp/mh-e/mh-funcs.el +++ b/lisp/mh-e/mh-funcs.el @@ -108,7 +108,7 @@ folder. This is useful for folders that are easily regenerated." (window-config mh-previous-window-config)) (mh-set-folder-modified-p t) ; lock folder to kill it (mh-exec-cmd-daemon "rmf" 'mh-rmf-daemon folder) - (when (boundp 'mh-speed-folder-map) + (when (and (boundp 'speedbar-buffer) speedbar-buffer) (mh-speed-invalidate-map folder)) (mh-remove-from-sub-folders-cache folder) (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index f475973631c..59dad161c11 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -1569,7 +1569,7 @@ If the folder returned doesn't exist then it is created." (save-excursion (mh-exec-cmd-quiet nil "rmf" chosen-name)) (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name) (mh-remove-from-sub-folders-cache chosen-name) - (when (boundp 'mh-speed-folder-map) + (when (and (boundp 'speedbar-buffer) speedbar-buffer) (mh-speed-add-folder chosen-name)) chosen-name)) diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index 7943879d887..9d5711105ba 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -795,7 +795,7 @@ used in searching." (message "Creating %s" folder-name) (mh-exec-cmd-error nil "folder" folder-name) (mh-remove-from-sub-folders-cache folder-name) - (when (boundp 'mh-speed-folder-map) + (when (and (boundp 'speedbar-buffer) speedbar-buffer) (mh-speed-add-folder folder-name)) (message "Creating %s...done" folder-name)) (new-file-flag -- cgit v1.2.3 From 6f75d0f36dd44fa794ed264042bb6edb4d897bec Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 16 Jan 2024 18:54:04 +0200 Subject: New display action alist entry 'post-command-select-window' (bug#67993) * doc/lispref/windows.texi (Buffer Display Action Alists): Add 'post-command-select-window'. * lisp/window.el (display-buffer): Add 'post-command-select-window' to the docstring and handle at the end of function. --- doc/lispref/windows.texi | 10 ++++++++++ etc/NEWS | 6 ++++++ lisp/window.el | 19 +++++++++++++++++++ 3 files changed, 35 insertions(+) diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 93b25cbe67f..f14e74bc785 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -3344,6 +3344,16 @@ It is called @emph{after} the buffer is displayed, and @emph{before} the entries @code{window-height}, @code{window-width} and @code{preserve-size} are applied that could resize the window to fit it to the inserted contents. + +@vindex post-command-select-window@r{, a buffer display action alist entry} +@item post-command-select-window +If the value is non-@code{nil}, the buffer displayed by @code{display-buffer} +is selected after the current command is executed by running the hook +@code{post-command-hook} (@pxref{Command Overview}). +If the value is @code{nil}, the buffer selected by such functions as +@code{pop-to-buffer} is deselected, and the window that was selected +before calling this function will remain selected regardless of which +windows were selected afterwards within this command. @end table By convention, the entries @code{window-height}, @code{window-width} diff --git a/etc/NEWS b/etc/NEWS index 03b8c3b517a..939caed14f6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -262,6 +262,12 @@ Anything following the symbol 'mode-line-format-right-align' in right-aligned to is controlled by the new user option 'mode-line-right-align-edge'. +** Windows + +*** New buffer display action alist entry 'post-command-select-window'. +It specifies whether the window of the displayed buffer should be +selected or deselected at the end of executing the current command. + ** Tab Bars and Tab Lines *** New user option 'tab-bar-tab-name-format-functions'. diff --git a/lisp/window.el b/lisp/window.el index 23977691f50..65651b2931b 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -7798,6 +7798,14 @@ Action alist entries are: and `preserve-size' are applied. The function is supposed to fill the window body with some contents that might depend on dimensions of the displayed window. + `post-command-select-window' -- A non-nil value means that after the + current command is executed and the hook `post-command-hook' is called, + the window displayed by this function will be selected. A nil value + means that if functions like `pop-to-buffer' selected another window, + at the end of this command that window will be deselected, and the + window that was selected before calling this function will remain + selected regardless of which windows were selected afterwards within + this command. The entries `window-height', `window-width', `window-size' and `preserve-size' are applied only when the window used for @@ -7853,6 +7861,17 @@ specified by the ACTION argument." (while (and functions (not window)) (setq window (funcall (car functions) buffer alist) functions (cdr functions))) + (when-let ((select (assq 'post-command-select-window alist))) + (letrec ((old-selected-window (selected-window)) + (postfun + (lambda () + (if (cdr select) + (when (window-live-p window) + (select-window window)) + (when (window-live-p old-selected-window) + (select-window old-selected-window))) + (remove-hook 'post-command-hook postfun)))) + (add-hook 'post-command-hook postfun))) (and (windowp window) window)))) (defun display-buffer-other-frame (buffer) -- cgit v1.2.3 From 0b8fe3c73ce4e9a2a8f025655970e86e0d81a0aa Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 16 Jan 2024 19:14:09 +0200 Subject: ; * etc/NEWS: Fix wording of recently-added entry. --- etc/NEWS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index 939caed14f6..735a05f6579 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -264,7 +264,7 @@ right-aligned to is controlled by the new user option ** Windows -*** New buffer display action alist entry 'post-command-select-window'. +*** New action alist entry 'post-command-select-window' for display-buffer. It specifies whether the window of the displayed buffer should be selected or deselected at the end of executing the current command. -- cgit v1.2.3 From b96aa528f642f69e2b42620807d53f8d9bbd9623 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 16 Jan 2024 19:51:18 +0200 Subject: * lisp/net/eww.el (eww-retrieve): Fix args of eww-render for sync (bug#68336). Suggested by Phil Sainty . --- lisp/net/eww.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index d127d819f26..7be65dc1e82 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -427,7 +427,7 @@ For more information, see Info node `(eww) Top'." ((eq eww-retrieve-command 'sync) (let ((data-buffer (url-retrieve-synchronously url))) (with-current-buffer data-buffer - (apply #'eww-render nil url cbargs)))) + (apply #'eww-render nil cbargs)))) (t (let ((buffer (generate-new-buffer " *eww retrieve*")) (error-buffer (generate-new-buffer " *eww error*"))) -- cgit v1.2.3 From dc404c5d0caac798627751bfd77ed005629abd4e Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 15 Jan 2024 10:58:59 +0100 Subject: More efficient hash table thawing * src/fns.c (hash_table_thaw): Don't allocate anything for empty tables. Don't initialise the next vector twice. (maybe_resize_hash_table): Factor out min_size constant. --- src/fns.c | 52 +++++++++++++++++++++++++++++++--------------------- 1 file changed, 31 insertions(+), 21 deletions(-) diff --git a/src/fns.c b/src/fns.c index acfedbfa922..5bedf49ef36 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4665,11 +4665,12 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) if (h->next_free < 0) { ptrdiff_t old_size = HASH_TABLE_SIZE (h); - ptrdiff_t base_size = min (max (old_size, 8), PTRDIFF_MAX / 2); + ptrdiff_t min_size = 8; + ptrdiff_t base_size = min (max (old_size, min_size), PTRDIFF_MAX / 2); /* Grow aggressively at small sizes, then just double. */ ptrdiff_t new_size = old_size == 0 - ? 8 + ? min_size : (base_size <= 64 ? base_size * 4 : base_size * 2); /* Allocate all the new vectors before updating *H, to @@ -4754,30 +4755,39 @@ hash_table_thaw (Lisp_Object hash_table) h->test = hash_table_test_from_std (h->frozen_test); ptrdiff_t size = h->count; h->table_size = size; - ptrdiff_t index_size = hash_index_size (size); - h->index_size = index_size; h->next_free = -1; - h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); + if (size == 0) + { + h->key_and_value = NULL; + h->hash = NULL; + h->next = NULL; + h->index_size = 1; + h->index = (hash_idx_t *)empty_hash_index_vector; + } + else + { + ptrdiff_t index_size = hash_index_size (size); + h->index_size = index_size; - h->next = hash_table_alloc_bytes (size * sizeof *h->next); - for (ptrdiff_t i = 0; i < size; i++) - h->next[i] = -1; + h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); - h->index = hash_table_alloc_bytes (index_size * sizeof *h->index); - for (ptrdiff_t i = 0; i < index_size; i++) - h->index[i] = -1; + h->next = hash_table_alloc_bytes (size * sizeof *h->next); - /* Recompute the actual hash codes for each entry in the table. - Order is still invalid. */ - for (ptrdiff_t i = 0; i < size; i++) - { - Lisp_Object key = HASH_KEY (h, i); - hash_hash_t hash_code = hash_from_key (h, key); - ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); - set_hash_hash_slot (h, i, hash_code); - set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); - set_hash_index_slot (h, start_of_bucket, i); + h->index = hash_table_alloc_bytes (index_size * sizeof *h->index); + for (ptrdiff_t i = 0; i < index_size; i++) + h->index[i] = -1; + + /* Recompute the hash codes for each entry in the table. */ + for (ptrdiff_t i = 0; i < size; i++) + { + Lisp_Object key = HASH_KEY (h, i); + hash_hash_t hash_code = hash_from_key (h, key); + ptrdiff_t start_of_bucket = hash_index_index (h, hash_code); + set_hash_hash_slot (h, i, hash_code); + set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); + set_hash_index_slot (h, start_of_bucket, i); + } } } -- cgit v1.2.3 From f19f5604deb72c4d548702b2d9b8565805ffbca1 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 15 Jan 2024 14:58:43 +0100 Subject: Update pdumper hashes for buffer and Lisp_Hash_Table * src/pdumper.c (dump_hash_table): Update for changes in recent hash-table patch suites (bug#68244). (dump_buffer): Update for case-fold-search changes (bug#66117). --- src/pdumper.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/pdumper.c b/src/pdumper.c index 54f0f2bca13..4602931b63a 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2752,7 +2752,7 @@ dump_hash_table_contents (struct dump_context *ctx, struct Lisp_Hash_Table *h) static dump_off dump_hash_table (struct dump_context *ctx, Lisp_Object object) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_6D63EDB618 +#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_313A489F0A # error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object); @@ -2784,7 +2784,7 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object) static dump_off dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) { -#if CHECK_STRUCTS && !defined HASH_buffer_EB0A5191C5 +#if CHECK_STRUCTS && !defined HASH_buffer_EBBA38AEFA # error "buffer changed. See CHECK_STRUCTS comment in config.h." #endif struct buffer munged_buffer = *in_buffer; -- cgit v1.2.3 From daec3e7b410cdb8deefbb241d056f8b42dfb40ac Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 17 Jan 2024 09:30:47 +0800 Subject: Increase accuracy of IP instruction * src/sfnt.c (sfnt_interpret_ip): Avoid precision loss by retrieving original positions from the unscaled outline, whenever possible. --- src/sfnt.c | 86 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 83 insertions(+), 3 deletions(-) diff --git a/src/sfnt.c b/src/sfnt.c index 2f0153b9a75..ca4c60e8e3a 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -9640,6 +9640,8 @@ sfnt_interpret_ip (struct sfnt_interpreter *interpreter) sfnt_f26dot6 new_distance; uint32_t p; sfnt_f26dot6 x, y, original_x, original_y; + struct sfnt_interpreter_zone *zone; + bool scale; /* First load both reference points. */ sfnt_address_zp0 (interpreter, interpreter->state.rp1, @@ -9649,6 +9651,57 @@ sfnt_interpret_ip (struct sfnt_interpreter *interpreter) &rp2x, &rp2y, &rp2_original_x, &rp2_original_y); + /* If RP1, RP2, and all arguments all fall within the glyph zone and + a simple glyph is loaded, replace their original coordinates as + loaded here with coordinates from the unscaled glyph outline. */ + + zone = interpreter->glyph_zone; + scale = false; + + if (zone && zone->simple + && interpreter->state.zp0 + && interpreter->state.zp1 + && interpreter->state.zp2) + { + p = interpreter->state.rp1; + + /* If P is a phantom point... */ + if (p >= zone->simple->number_of_points) + { + /* ...scale the phantom point to the size of the original + outline. */ + rp1_original_x = sfnt_div_fixed (rp1_original_x, + interpreter->scale); + rp1_original_y = sfnt_div_fixed (rp1_original_y, + interpreter->scale); + } + else + { + rp1_original_x = zone->simple->x_coordinates[p]; + rp1_original_y = zone->simple->y_coordinates[p]; + } + + p = interpreter->state.rp2; + + /* If P is a phantom point... */ + if (p >= zone->simple->number_of_points) + { + /* ...scale the phantom point to the size of the original + outline. */ + rp2_original_x = sfnt_div_fixed (rp2_original_x, + interpreter->scale); + rp2_original_y = sfnt_div_fixed (rp2_original_y, + interpreter->scale); + } + else + { + rp2_original_x = zone->simple->x_coordinates[p]; + rp2_original_y = zone->simple->y_coordinates[p]; + } + + scale = true; + } + /* Get the original distance between of RP1 and RP2 measured relative to the dual projection vector. */ range = sfnt_dual_project_vector (interpreter, @@ -9657,6 +9710,9 @@ sfnt_interpret_ip (struct sfnt_interpreter *interpreter) sfnt_sub (rp2_original_y, rp1_original_y)); + if (scale) + range = sfnt_mul_fixed_round (range, interpreter->scale); + /* Get the new distance. */ new_range = sfnt_dual_project_vector (interpreter, sfnt_sub (rp2x, rp1x), @@ -9670,6 +9726,25 @@ sfnt_interpret_ip (struct sfnt_interpreter *interpreter) sfnt_address_zp2 (interpreter, p, &x, &y, &original_x, &original_y); + if (scale) + { + /* If P is a phantom point... */ + if (p >= zone->simple->number_of_points) + { + /* ...scale the phantom point to the size of the original + outline. */ + original_x = sfnt_div_fixed (original_x, + interpreter->scale); + original_y = sfnt_div_fixed (original_y, + interpreter->scale); + } + else + { + original_x = zone->simple->x_coordinates[p]; + original_y = zone->simple->y_coordinates[p]; + } + } + /* Now compute the old distance from this point to rp1. */ org_distance = sfnt_dual_project_vector (interpreter, @@ -9678,6 +9753,10 @@ sfnt_interpret_ip (struct sfnt_interpreter *interpreter) sfnt_sub (original_y, rp1_original_y)); + if (scale) + org_distance = sfnt_mul_fixed_round (org_distance, + interpreter->scale); + /* And the current distance from this point to rp1, so how much to move can be determined. */ cur_distance @@ -11447,7 +11526,8 @@ sfnt_interpret_mirp (struct sfnt_interpreter *interpreter, coordinate from the font designer's intentions, either exaggerating or neutralizing the slant of the stem to which it belongs. - This behavior applies only to MDRP, which see. */ + This behavior applies only to MDRP (which see), although a similar + strategy is also applied while interpreting IP instructions. */ static sfnt_f26dot6 sfnt_project_zp1_zp0_org (struct sfnt_interpreter *interpreter, @@ -20715,8 +20795,8 @@ main (int argc, char **argv) return 1; } -#define FANCY_PPEM 16 -#define EASY_PPEM 16 +#define FANCY_PPEM 14 +#define EASY_PPEM 14 interpreter = NULL; head = sfnt_read_head_table (fd, font); -- cgit v1.2.3 From c5031a52c5c6ad74fab27d3754700e7457717516 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 17 Jan 2024 15:28:43 +0100 Subject: * Update a comp test (bug#68523) * test/src/comp-tests.el (comp-tests-ret-type-spec-71): Update a test due to new 'sxhash-equal' behaviour. --- test/src/comp-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 0aa9e76fa2d..f479d175c43 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -1421,7 +1421,7 @@ Return a list of results." (if (= x 0.0) x (error ""))) - '(or (member -0.0 0.0) (integer 0 0))) + '(or (member 0.0 -0.0) (integer 0 0))) ;; 72 ((defun comp-tests-ret-type-spec-f (x) -- cgit v1.2.3 From 5f5faad249747ce5bd4b7f2968f737206c136265 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Wed, 17 Jan 2024 09:32:18 -0800 Subject: ; Fix test failures from the fix for bug#67661 * test/lisp/eshell/em-cmpl-tests.el (em-cmpl-test/file-completion/non-unique): Make test more robust. --- test/lisp/eshell/em-cmpl-tests.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/test/lisp/eshell/em-cmpl-tests.el b/test/lisp/eshell/em-cmpl-tests.el index 13e42ffac88..f778816c4e1 100644 --- a/test/lisp/eshell/em-cmpl-tests.el +++ b/test/lisp/eshell/em-cmpl-tests.el @@ -175,18 +175,18 @@ ACTUAL and EXPECTED should both be lists of strings." (ert-with-temp-directory default-directory (write-region nil nil (expand-file-name "file.txt")) (write-region nil nil (expand-file-name "file.el")) + ;; Complete the first time. This should insert the common prefix + ;; of our completions. (should (equal (eshell-insert-and-complete "echo fi") "echo file.")) + ;; Make sure the completions buffer isn't displayed. + (should-not (get-buffer-window "*Completions*")) ;; Now try completing again. (let ((minibuffer-message-timeout 0) (inhibit-message t)) (completion-at-point)) - ;; FIXME: We can't use `current-message' here. - (with-current-buffer (messages-buffer) - (save-excursion - (goto-char (point-max)) - (forward-line -1) - (should (looking-at "Complete, but not unique"))))))) + ;; This time, we should display the completions buffer. + (should (get-buffer-window "*Completions*"))))) (ert-deftest em-cmpl-test/file-completion/glob () "Test completion of file names using a glob." -- cgit v1.2.3 From 2cb1b76696b56fe01eb70d623b602dfe00613511 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 18 Jan 2024 01:25:24 +0200 Subject: diff-mode: Support committing diff with file deletions * lisp/vc/diff-mode.el (diff-vc-deduce-fileset): Remove nil elements from the result (bug#68443). --- lisp/vc/diff-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 2b9d12a5756..4f150dc7f36 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2955,7 +2955,7 @@ hunk text is not found in the source file." (goto-char (point-min)) (while (progn (diff-file-next) (not (eobp))) (push (diff-find-file-name nil t) files))) - (list backend (nreverse files) nil nil 'patch))) + (list backend (delete nil (nreverse files)) nil nil 'patch))) (defun diff--filter-substring (str) (when diff-font-lock-prettify -- cgit v1.2.3 From d4d5830f8a071a3634926adeeaedaf573d49a063 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 18 Jan 2024 10:32:50 +0800 Subject: ; * src/androidterm.c (handle_one_android_event): Fix typo. --- src/androidterm.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/androidterm.c b/src/androidterm.c index 2e4ee64f390..8632df1d4fc 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -938,9 +938,9 @@ handle_one_android_event (struct android_display_info *dpyinfo, sure it is processed before any subsequent edits. */ textconv_barrier (f, event->xkey.counter); - wchar_t copy_buffer[129]; + wchar_t copy_buffer[512]; wchar_t *copy_bufptr = copy_buffer; - int copy_bufsiz = 128 * sizeof (wchar_t); + int copy_bufsiz = 512; event->xkey.state |= android_emacs_to_android_modifiers (dpyinfo, -- cgit v1.2.3 From 314ac2e4317650a5135b950374118bbc38e8207f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Jan 2024 08:29:34 +0200 Subject: ; * lisp/mail/rmail.el (rmail-show-message-verbose-min): Doc fix (bug#68369). --- lisp/mail/rmail.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index b6c36c2f76c..5747091c498 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -2684,7 +2684,9 @@ N defaults to the current message." (and (string-match text-regexp content-type-header) t))))) (defcustom rmail-show-message-verbose-min 200000 - "Message size at which to show progress messages for displaying it." + "Message size at which to show progress messages for displaying it. +Messages longer than this (in characters) will produce echo-area +messages when Rmail processes such a message for display." :type 'integer :group 'rmail :version "23.1") -- cgit v1.2.3 From 92a7132bd6c76a43860fa01ca3363857d8dfc8f3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Jan 2024 03:47:49 -0500 Subject: ; * etc/NEWS: Clean up for Emacs 29.2. --- etc/NEWS | 20 +------------------- 1 file changed, 1 insertion(+), 19 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 069661866ce..1a0e1f37366 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -15,12 +15,6 @@ in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' with a prefix argument or by typing 'C-u C-h C-n'. -Temporary note: -+++ indicates that all relevant manuals in doc/ have been updated. ---- means no change in the manuals is needed. -When you add a new item, use the appropriate mark if you are sure it -applies, and please also update docstrings as needed. - * Installation Changes in Emacs 29.2 @@ -43,36 +37,24 @@ more details. * Changes in Emacs 29.2 - -* Editing Changes in Emacs 29.2 +This is a bug-fix release with no new features. * Changes in Specialized Modes and Packages in Emacs 29.2 ** Tramp -+++ *** New user option 'tramp-show-ad-hoc-proxies'. When non-nil, ad-hoc definitions are kept in remote file names instead of showing the shortcuts. - -* New Modes and Packages in Emacs 29.2 - * Incompatible Lisp Changes in Emacs 29.2 -+++ ** 'with-sqlite-transaction' rolls back changes if its BODY fails. If the BODY of the macro signals an error, or committing the results of the transaction fails, the changes will now be rolled back. - -* Lisp Changes in Emacs 29.2 - - -* Changes in Emacs 29.2 on Non-Free Operating Systems - * Installation Changes in Emacs 29.1 -- cgit v1.2.3 From 20125ad97b4592d7f9ae815aff2ca68cda7a4c31 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Jan 2024 04:23:04 -0500 Subject: ; admin/authors.el (authors-aliases): Update for Emacs 29.2. --- admin/authors.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/admin/authors.el b/admin/authors.el index de1b6ec1d7f..083023a3dad 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -250,6 +250,8 @@ files.") ("Simen Heggestøyl" "simenheg@gmail\\.com") (nil "prime.wizard") ("Shun-ichi Goto" "Shun-ichi GOTO") + ;; The trailing dash is a kludge, so this contributor is not ignored. + ("skykanin-" "skykanin@users\\.noreply\\.github\\.com") ;; There are other Stefans. ;;; ("Stefan Monnier" "Stefan") (nil "ssnnoo") -- cgit v1.2.3 From 1ab88d8aa52453d2839435e495b47e74673a38c7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Jan 2024 04:29:44 -0500 Subject: Bump Emacs version to 29.2 * README: * configure.ac: * nt/README.W32: * msdos/sed2v2.inp: Bump Emacs version to 29.2. --- README | 2 +- configure.ac | 2 +- msdos/sed2v2.inp | 2 +- nt/README.W32 | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/README b/README index 65629dd8e66..1ec182e7497 100644 --- a/README +++ b/README @@ -2,7 +2,7 @@ Copyright (C) 2001-2024 Free Software Foundation, Inc. See the end of the file for license conditions. -This directory tree holds version 29.1.90 of GNU Emacs, the extensible, +This directory tree holds version 29.2 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. The file INSTALL in this directory says how to build and install GNU diff --git a/configure.ac b/configure.ac index 42e99408199..8c98e8153f2 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ dnl along with GNU Emacs. If not, see . AC_PREREQ([2.65]) dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el. -AC_INIT([GNU Emacs], [29.1.90], [bug-gnu-emacs@gnu.org], [], +AC_INIT([GNU Emacs], [29.2], [bug-gnu-emacs@gnu.org], [], [https://www.gnu.org/software/emacs/]) dnl Set emacs_config_options to the options of 'configure', quoted for the shell, diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index da2031b4020..9790cf55f3d 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -67,7 +67,7 @@ /^#undef PACKAGE_NAME/s/^.*$/#define PACKAGE_NAME ""/ /^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/ /^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/ -/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "29.1.90"/ +/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "29.2"/ /^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/ /^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/ /^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/ diff --git a/nt/README.W32 b/nt/README.W32 index 1f299d7f5d8..00ec926ef7f 100644 --- a/nt/README.W32 +++ b/nt/README.W32 @@ -1,7 +1,7 @@ Copyright (C) 2001-2024 Free Software Foundation, Inc. See the end of the file for license conditions. - Emacs version 29.1.90 for MS-Windows + Emacs version 29.2 for MS-Windows This README file describes how to set up and run a precompiled distribution of the latest version of GNU Emacs for MS-Windows. You -- cgit v1.2.3 From c633c90993f069123c788900a39031ca32c8a1d9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Jan 2024 04:39:57 -0500 Subject: * Update etc/HISTORY and ChangeLog.4 for 29.2 release. --- ChangeLog.4 | 1548 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- etc/HISTORY | 2 + 2 files changed, 1549 insertions(+), 1 deletion(-) diff --git a/ChangeLog.4 b/ChangeLog.4 index 70194a469cf..3600f764292 100644 --- a/ChangeLog.4 +++ b/ChangeLog.4 @@ -1,3 +1,1549 @@ +2024-01-18 Eli Zaretskii + + * Version 29.2 released. + +2024-01-17 Dmitry Gutov + + diff-mode: Support committing diff with file deletions + + * lisp/vc/diff-mode.el (diff-vc-deduce-fileset): + Remove nil elements from the result (bug#68443). + +2024-01-16 Juri Linkov + + * lisp/net/eww.el (eww-retrieve): Fix args of eww-render for sync (bug#68336). + + Suggested by Phil Sainty . + +2024-01-16 Mike Kupfer + + Fix folder creation error (Bug#67361) + + * lisp/mh-e/mh-funcs.el (mh-kill-folder) + * lisp/mh-e/mh-search.el (mh-index-new-folder) + * lisp/mh-e/mh-utils.el (mh-prompt-for-folder): + Check for existence of 'speedbar-buffer' rather than + 'mh-speed-folder-map'. The latter can exist if + 'mh-speed' has only been loaded but not displayed. + + (cherry picked from commit e6a2901b1be6b4aa01f8bf0d3c6e06344ce8d366) + +2024-01-15 Gregory Heytings + + Simplify 'without-restriction' + + This simplification is symmetrical to 01fb898420. + + * src/editfns.c: (Finternal__labeled_widen): Add a call to + 'Fwiden', and rename from 'internal--unlabel-restriction'. + (unwind_labeled_narrow_to_region): Use the renamed function, and + remove the call to 'Fwiden'. + (syms_of_editfns): Rename the symbol. + + * lisp/subr.el (internal--without-restriction): Use the renamed + function. + + (cherry picked from commit 9e9e11648d3d5514de85edfb69f0949a062f4716) + +2024-01-14 Gregory Heytings + + Fix blunder in labeled_narrow_to_region + + * src/editfns.c (labeled_narrow_to_region): Record point before, + instead of after, calling narrow-to-region; otherwise point may + already have been changed. Fixes bug#66764. + +2024-01-14 Daniel Martín + + Fix documentation of icon-elements + + * lisp/emacs-lisp/icons.el (icon-elements): The plist key it returns + is `image', not `display'. (Bug#68451) + +2024-01-14 Stefan Kangas + + Improve two docstrings in ox-latex + + * lisp/org/ox-latex.el (org-latex-src-block-backend) + (org-latex-engraved-theme): Improve docstring; mention that + engrave-faces is a GNU ELPA package. + +2024-01-14 Stefan Kangas + + Doc fix in auth-source-read-char-choice + + * lisp/auth-source.el (auth-source-read-char-choice): Don't + document 'dropdown-list', which was removed in 2011. + +2024-01-13 Eli Zaretskii + + Fix info-xref-tests + + * doc/lispintro/emacs-lisp-intro.texi (How let Binds Variables): + Fix cross-reference. (Bug#68428) + + * test/lisp/info-xref-tests.el (info-xref-test-write-file): Fix + test on MS-Windows when run from MSYS Bash. + +2024-01-13 Juri Linkov + + Add @kindex in manuals for existing keybindings on 'C-x x/w' (bug#13167) + + * doc/emacs/buffers.texi (Misc Buffer): Add @kindex for 'C-x x r', + 'C-x x u', 'C-x x i'. + + * doc/emacs/display.texi (Line Truncation): Add @kindex for 'C-x x t'. + + * doc/emacs/files.texi (Reverting): Add @kindex for 'C-x x g'. + + * doc/emacs/windows.texi (Change Window): Use new keybinding 'C-x w 0' + instead of 'M-x delete-windows-on'. + + * doc/misc/info.texi (Create Info buffer): Add @kindex for 'C-x x n'. + +2024-01-13 Eli Zaretskii + + Improve documentation of 'emacs_function' in modules + + * doc/lispref/internals.texi (Module Functions): Warn about + accessing the ARGS array in module functions. + +2024-01-12 Eli Zaretskii + + Improve documentation of Ispell commands + + * doc/emacs/fixit.texi (Spelling): Document "C-u M-$" and warn + against modifications in recursive-edit. (Bug#14192) + +2024-01-11 Stefan Kangas + + Don't recommend inverse-video for debugging + + * etc/DEBUG: Don't recommend 'inverse-video', which has been broken + for 20 years, give or take. (Bug#11430) + +2024-01-11 Xiyue Deng + + Fix typo in lispref "Creating Strings" section + + * doc/lispref/strings.texi (String Basics): Fix typo (bug#68375). + +2024-01-11 Xiyue Deng (tiny change) + + Fix count of no-op functions (bug#68375) + + It looks like there are actually three kinds of no-op functions. + + * doc/lispref/functions.texi (Calling Functions): Fix count and + plural of no-op functions. + +2024-01-11 Xiyue Deng (tiny change) + + Wrap @pxref of Abbrevs in parentheses (bug#68375) + + * doc/lispref/symbols.texi (Shorthands): Wrap `@pxref{Abbrevs}' in + parentheses. + +2024-01-10 Mauro Aranda + + Add examples to the Widget manual + + * doc/misc/widget.texi (Widget Gallery, Defining New Widgets): Add + examples. (Bug#66229) + +2024-01-10 Mauro Aranda + + Implement missing functions for custom-icon widget + + * lisp/cus-edit.el (custom-icon-reset-saved, custom-icon-mark-to-save) + (custom-icon-state-set-and-redraw, custom-icon-reset-standard) + (custom-icon-mark-to-reset-standard): New functions. + (custom-icon, custom-icon-extended-menu): Register and add them to the + menu. (Bug#66947) + +2024-01-10 Stephen Berman + + Fix fontification of cgroup2 in fstab (bug#68367) + + * lisp/generic-x.el (etc-fstab-generic-mode): Add cgroup2. + +2024-01-10 Philip Kaludercic + + Handle package versions that are not version strings + + * lisp/emacs-lisp/package.el (package-menu--version-predicate): Ignore + any errors raised by 'version-to-list', thus falling back to the + default version list. (Bug#68317) + + (cherry picked from commit eb913c7501489e1eae475cae843fccdf14cc24d8) + +2024-01-09 Jim Porter + + Introduce 'let' using lexical binding in the Lisp Introduction + + * doc/lispintro/emacs-lisp-intro.texi (Prevent confusion): Rework the + explanation to discuss how things work under lexical binding. + (How let Binds Variables): Describe the differences between lexical + and dynamic binding (including how to configure it). + (defvar): Mention that 'defvar' declares variables as always + dynamically-bound (bug#66756). + +2024-01-06 Eli Zaretskii + + Fix 'rmail-summary-by-thread' + + * lisp/mail/rmailsum.el (rmail-summary-by-thread): Call + 'rmail-new-summary' from the original buffer, not from + 'rmail-buffer' to avoid failing the logic in 'rmail-new-summary' + that decides whether to pop up a new window. Reported by Andrea + Monaco . + +2024-01-06 Jean-Christophe Helary + + * doc/emacs/back.texi: Fix a typo. + +2024-01-06 Eli Zaretskii + + Fix icons.el when icon does not exist as a file + + * lisp/emacs-lisp/icons.el (icons--create): Handle the case when + ICON is a file that doesn't exists or is unreadable. Suggested by + David Ponce . (Bug#66846) + +2024-01-05 Juri Linkov + + * lisp/isearch.el (isearch-search-and-update): Let-bind 'isearch-cmds'. + + When 'isearch-wrap-pause' is 'no' or 'no-ding', let-bind 'isearch-cmds' + to avoid changing it by 'isearch-push-state' in 'isearch-repeat', + so that a later DEL (isearch-delete-char) doesn't stop at the + intermediate failing state (bug#68158). + +2024-01-04 Andrea Corallo + + * src/comp.c (Fcomp__compile_ctxt_to_file): Fix hash table Qunbound use. + +2024-01-04 Eli Zaretskii + + Provide decent documentation for 'help-quick' + + * lisp/help.el (help-quick, help-quick-toggle): Doc fix. + + * doc/emacs/help.texi (Help Summary, Misc Help): Document + 'help-quick-toggle'. + +2024-01-02 Dmitry Gutov + + treesit--pre-syntax-ppss: Fix args-out-of-range in internal--syntax-propertize + + * lisp/treesit.el (treesit--pre-syntax-ppss): Make sure the lower + bound is still within the current restriction (bug#67977). + +2024-01-01 Mike Kupfer + + Fix mangled Subject header field when forwarding (Bug#67360) + + * lisp/mh-e/mh-comp.el (mh-forward): Overwrite subject when + forwarding. + +2024-01-01 Kyle Meyer + + Update to Org 9.6.15 + +2023-12-31 Eli Zaretskii + + * doc/emacs/custom.texi (Modifier Keys): Fix markup (bug#68164). + + Suggested by Jens Quade . + +2023-12-30 Stefan Kangas + + org-protocol: Minor copy-edits to Commentary + + * lisp/org/org-protocol.el: Minor copy-edits to Commentary. + +2023-12-30 Denis Zubarev + + Improve syntax highlighting for python-ts-mode + + Fix fontification of strings inside of f-strings interpolation, e.g. for + f"beg {'nested'}" - 'nested' was not fontified as string. Do not + override the face of builtin functions (all, bytes etc.) with the + function call face. Add missing assignment expressions (:= *=). + Fontify built-ins (dict,list,etc.) as types when they are used in type + hints. Highlight union types (type1|type2). Highlight base class names + in the class definition. Fontify class patterns in case statements. + Highlight the second argument as a type in isinstance/issubclass call. + Highlight dotted decorator names. + + * lisp/progmodes/python.el (python--treesit-keywords): Add compound + keyword "is not". + (python--treesit-builtin-types): New variable that stores all python + built-in types. + (python--treesit-type-regex): New variable. Regex matches if text is + either built-in type or text starts with capital letter. + (python--treesit-builtins): Extract built-in types to other variable. + (python--treesit-fontify-string): fix f-string interpolation. Enable + interpolation highlighting only if string-interpolation is presented + on the enabled levels of treesit-font-lock-feature-list. + (python--treesit-fontify-string-interpolation): Remove function. + (python--treesit-fontify-union-types): Fontify nested union types. + (python--treesit-fontify-union-types-strict): Fontify nested union + types, only if type identifier matches against + python--treesit-type-regex. + (python--treesit-fontify-dotted-decorator): Fontify all parts of + dotted decorator name. + (python--treesit-settings): Change/add rules. (Bug#67061) + + * test/lisp/progmodes/python-tests.el + (python-ts-tests-with-temp-buffer): Function for setting up test + buffer. + (python-ts-mode-compound-keywords-face) + (python-ts-mode-named-assignement-face-1) + (python-ts-mode-assignement-face-2) + (python-ts-mode-nested-types-face-1) + (python-ts-mode-union-types-face-1) + (python-ts-mode-union-types-face-2) + (python-ts-mode-types-face-1) + (python-ts-mode-types-face-2) + (python-ts-mode-types-face-3) + (python-ts-mode-isinstance-type-face-1) + (python-ts-mode-isinstance-type-face-2) + (python-ts-mode-isinstance-type-face-3) + (python-ts-mode-superclass-type-face) + (python-ts-mode-class-patterns-face) + (python-ts-mode-dotted-decorator-face-1) + (python-ts-mode-dotted-decorator-face-2) + (python-ts-mode-builtin-call-face) + (python-ts-mode-interpolation-nested-string) + (python-ts-mode-disabled-string-interpolation) + (python-ts-mode-interpolation-doc-string): Add tests. + +2023-12-29 Yuan Fu + + Revert "Fix treesit-node-field-name and friends (bug#66674)" + + This reverts commit 9874561f39e62c1c9fada6c2e013f93d9ea65729. + + See bug#67990. Basically our original code is correct, the error is + in libtree-sitter, which only manifests in certain cases. + + https://github.com/tree-sitter/tree-sitter/pull/2104 + +2023-12-25 Stefan Kangas + + Explain status "r" in `epa-list-keys` + + * lisp/epa.el (epa-list-keys): Add revoked status to description. + Suggested by CHENG Gao . + +2023-12-25 Jared Finder + + Fix mouse clicks on directory line in Dired + + The option 'dired-kill-when-opening-new-dired-buffer' should be + also honored when clicking the mouse to kill prev buffer. + * lisp/dired.el (dired--make-directory-clickable): Call + 'dired--find-possibly-alternative-file' instead of 'dired', in + the click callback. (Bug#67856) + +2023-12-25 Eli Zaretskii + + Fix 'split-root-window-right' and 'split-root-window-below' + + * lisp/window.el (split-root-window-right) + (split-root-window-below): Fix the 'interactive' spec to avoid + misbehaving when invoked with no prefix argument. (Bug#67452) + +2023-12-24 Stefan Kangas + + Mark icalendar.el as maintained by emacs-devel + + * lisp/calendar/icalendar.el: Mark emacs-devel as the maintainer. + Ref: https://debbugs.gnu.org/34315#152 + +2023-12-24 Xiyue Deng + + Fix usage of `setq-default' and offer more suggestions + + cd61af0 changed from default-major-mode to major-mode in the first + code sample but didn't change the rest. This patch fixes this and add + some explanations of why use `setq-default' instead of `setq'. In + addition, it gives background on suggesting using text-mode as default + mode and suggest other alternatives. + + * doc/lispintro/emacs-lisp-intro.texi (Text and Auto-fill): Fix usage + of `setq-default' and offer more suggestions. (Bug#67848) + +2023-12-23 Yuan Fu + + Fix python-ts-mode triple quote syntax (bug#67262) + + * lisp/progmodes/python.el (python--treesit-syntax-propertize): New function. + (python-ts-mode): Activate python--treesit-syntax-propertize. + +2023-12-23 Yuan Fu + + Increment parser timestamp when narrowing changes (bug#67977) + + When narrowing changes, parse reparses, so the timestamp should + definitely increment, just like in ts_record_changes. + + Failing to increment this timestamp, outdated nodes would think they + are still up-to-date, and try to print their type name. Printing + their type name involves accessing the old parse tree, which is + already freed during the last reparse. + + I also found that we don't increment timestamp when changing parser + ranges and fixed that as well. + + * src/treesit.c (treesit_sync_visible_region): + (Ftreesit_parser_set_included_ranges): Increment timestamp. + * src/treesit.h (Lisp_TS_Parser): Add some comments. + +2023-12-23 Dmitry Gutov + + ruby-ts-mode: Fix indentation for string_array closer + + * lisp/progmodes/ruby-ts-mode.el (ruby-ts--indent-rules): + Fix indentation for string_array closer. + +2023-12-23 Dmitry Gutov + + treesit-major-mode-setup: Use 'treesit--syntax-propertize-notifier' + + * lisp/treesit.el (treesit-major-mode-setup): Make sure + 'treesit--syntax-propertize-notifier' is used (bug#66732) + +2023-12-23 Dmitry Gutov + + ruby-ts-mode: Fix an out-of-bounds error with heredoc at eob + + * lisp/progmodes/ruby-ts-mode.el (ruby-ts--syntax-propertize): + Fix an out-of-bounds error with heredoc at eob. + +2023-12-23 Yuan Fu + + Correctly refontify changed region in tree-sitter modes (bug#66732) + + We already have treesit--font-lock-notifier that should mark changed + regions to be refontified, but it's called too late in the redsiplay & + fontification pipeline. Here we add treesit--pre-redisplay that + forces reparse and calls notifier functions in + pre-redisplay-functions, which is early enough for the marking to take + effect. + + Similarly, we force reparse in + syntax-propertize-extend-region-functions so syntax-ppss will have the + up-to-date syntax information when it scans the buffer text. We also + record the lowest start position of the affected regions, and make + sure next syntex-propertize starts from that position. + + * lisp/treesit.el (treesit--pre-redisplay-tick): + (treesit--syntax-propertize-start): New variable. + (treesit--syntax-propertize-notifier): + (treesit--pre-redisplay): + (treesit--pre-syntax-ppss): New functions. + (treesit-major-mode-setup): Add hooks. + + * lisp/progmodes/ruby-ts-mode.el (ruby-ts-mode): Remove notifier. + (ruby-ts--parser-after-change): Remove notifier function. + +2023-12-23 Michael Albinus + + * doc/man/emacsclient.1: Fix --tramp option. + +2023-12-23 Peter Oliver (tiny change) + + * doc/man/emacsclient.1: Add missing sections (bug#66598) + +2023-12-23 Xiyue Deng + + Add explanation for extra parentheses in ELisp Introduction + + * doc/lispintro/emacs-lisp-intro.texi (fwd-para while): Add + a note to explain the extra parentheses. (Bug#67820) + +2023-12-23 Xiyue Deng + + Add sample code to the "let*" section in "forward-paragraph" + + * doc/lispintro/emacs-lisp-intro.texi (fwd-para let): Add code + sample. (Bug#67817) + +2023-12-23 Denis Zubarev + + Fix treesit test (bug#67117) + + * test/src/treesit-tests.el (treesit-search-subtree-forward-1): + (treesit-search-subtree-backward-1): Replace treesit--thing-at with + treesit-query-capture (treesit--thing-at isn't available in Emacs 29). + +2023-12-23 Yuan Fu + + Fix c++-ts-mode indentation (bug#67975) + + * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): Make indent + rule match precise so it doesn't match declaration_list. + +2023-12-22 Stefan Kangas + + Recommend customizing eglot for python-base-mode + + * doc/misc/eglot.texi (Project-specific configuration): Recommend + setting directory local variables for 'python-base-mode' instead of + 'python-mode'. This makes any customizations effective also for + 'python-ts-mode'. + +2023-12-22 Eli Zaretskii + + Improve documentation of new native-compilation commands + + * lisp/progmodes/elisp-mode.el (emacs-lisp-mode-menu) + (emacs-lisp-native-compile, emacs-lisp-native-compile-and-load): + Doc fixes. + + * doc/lispref/compile.texi (Native-Compilation Functions): + Document 'emacs-lisp-native-compile' and + 'emacs-lisp-native-compile-and-load'. + +2023-12-21 Stefan Monnier + + doc/lispintro: Don't mention `set` (bug#67734) + + * doc/lispintro/emacs-lisp-intro.texi (Using set): Delete. + (Using setq): Adjust accordingly. + (setq): Rename from "set & setq" and don't refer to `set` any more. + (Review): Don't mention `set` any more. + +2023-12-20 Eli Zaretskii + + Fix script for some characters + + * lisp/international/characters.el (char-script-table): Fix script + for 2 characters. + + * admin/unidata/blocks.awk: Fix script for Yijing Hexagram + Symbols. (Bug#67924) + +2023-12-18 Denis Zubarev + + Fix an issue when searching subtree backward (bug#67117) + + * src/treesit.c (treesit_traverse_child_helper): + Do not call treesit_traverse_sibling_helper when the named node is + required and the last child is the named node. + Otherwise treesit_traverse_sibling_helper will move cursor to the + previous sibling and last node will be skipped. + * test/src/treesit-tests.el (treesit-search-subtree-forward-1): + (treesit-search-subtree-backward-1): + Add tests. + +2023-12-18 Christophe Deleuze (tiny change) + + Fix passive mode for tnftp client in ange-ftp.el. + + * lisp/net/ange-ftp.el (ange-ftp-passive-mode): Fix passive mode + result string for tnftp client. (Bug#67865) + +2023-12-16 Stefan Kangas + + Fix using disabled command without a docstring + + * lisp/novice.el (disabled-command-function): Fix error when the + disable command has no docstring. (Bug#67835) + +2023-12-16 Eli Zaretskii + + Improve documentation of text properties handling when yanking + + * doc/lispref/text.texi (Text Properties): Mention special + handling of text properties while yanking. + +2023-12-16 skykanin <3789764+skykanin@users.noreply.github.com> (tiny change) + + Eglot: Add Uiua language server + + * lisp/progmodes/eglot.el (eglot-server-programs): Add Uiua language + server. (Bug#67850) + +2023-12-16 Eli Zaretskii + + Fix shaping of Sinhala text + + * lisp/language/sinhala.el (composition-function-table): Allow + U+200D U+0DCA as well as U+0DCA U+200D between consonants. + Suggested by Richard Wordingham . + (Bug#67828) + +2023-12-16 Jeremy Bryant + Eli Zaretskii + + Add use cases of (fn) documentation facility. + + * doc/lispref/functions.texi (Function Documentation): Add examples. + (Bug#67499) + +2023-12-16 Eli Zaretskii + + Fix pasting into terminal-mode on term.el + + * lisp/term.el (term--xterm-paste): Read pasted text from the + input event. Suggested by Jared Finder . + (Bug#49253) + +2023-12-16 Eli Zaretskii + + Fix opening directory trees from Filesets menu + + In bug#976, the code was fixed, but the cautious condition in + the original author's code, which catered to invoking + 'filelists-open' from the menu-bar menu, was omitted, which made + that invocation, which did work before, broken. + * lisp/filesets.el (filesets-get-filelist): Fix opening directory + trees from the Filesets menu-bar menu. (Bug#67658) + +2023-12-16 Niall Dooley (tiny change) + + Eglot: Add ruff-lsp as an alternative Python server + + ruff-lsp [1] is an LSP server for Ruff [2], [3], a fast Python linter + and code formatter. + + It supports surfacing Ruff diagnostics and providing Code Actions to + fix them, but is intended to be used alongside another Python LSP in + order to support features like navigation and autocompletion. + + [1]: https://github.com/astral-sh/ruff-lsp + [2]: https://github.com/astral-sh/ruff + [3]: https://docs.astral.sh/ruff/ + + * lisp/progmodes/eglot.el (eglot-server-programs): Add ruff-lsp. + +2023-12-14 Adam Porter + + Fix symbol name in Multisession Variables examples + + * doc/lispref/variables.texi (Multisession Variables): Fix symbol + name. (Bug#67823) + +2023-12-12 Dmitry Gutov + + js-ts-mode: Fix font-lock rules conflict + + * lisp/progmodes/js.el (js--treesit-font-lock-settings): Move + 'property' to after 'jsx'. Stop using predicate (bug#67684). + (js--treesit-property-not-function-p): Delete. + +2023-12-11 Noah Peart + + Add indentation rules for bracketless statements in js-ts-mode + + * lisp/progmodes/js.el (js--treesit-indent-rules): Add indentation + rules to handle bracketless statements (bug#67758). + * test/lisp/progmodes/js-tests.el (js-ts-mode-test-indentation): + New test for js-ts-mode indentation. + * test/lisp/progmodes/js-resources/js-ts-indents.erts: New file + with indentation tests for js-ts-mode. + +2023-12-10 Yuan Fu + + Fix c-ts-mode bracketless indentation for BSD style (bug#66152) + + * lisp/progmodes/c-ts-mode.el: + (c-ts-mode--indent-styles): Make sure the BSD rules only apply to + opening bracket (compound_statement), then bracketless statements will + fallback to common rules. + * test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts: Copy the + bracketless test from indent.erts to here. + +2023-12-10 Augustin Chéneau + + Add missing indent rules in c-ts-mode (bug#66152) + + Example: + + static myttype * + variable_name; + + * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): Add rules. + +2023-12-10 Yuan Fu + + Fix treesit-default-defun-skipper (bug#66711) + + * lisp/treesit.el: + (treesit-default-defun-skipper): Add bol to the rx pattern. + +2023-12-10 Yuan Fu + + Fix treesit-node-field-name and friends (bug#66674) + + So turns out ts_node_field_name_for_child takes a named node index, + but we were passing it normal index that counts both named and + anonymous nodes. That's what makes the field name all wrong in + treesit explorer. + + * doc/lispref/parsing.texi: + (Accessing Node Information): Update docstring. + * lisp/treesit.el (treesit-node-index): Add some unrelated comment. + (treesit-node-field-name): Get named node index rather than all node + index. + * src/treesit.c (Ftreesit_node_field_name_for_child): Update + docstring, use ts_node_named_child_count. + +2023-12-10 Maciej Kalandyk + + python-ts-mode: Highlight default parameters + + * lisp/progmodes/python.el (python--treesit-settings): + Highlight default parameters (bug#67703). + +2023-12-10 Kyle Meyer + + Update to Org 9.6.13 + +2023-12-10 Yuan Fu + + Fix c-ts-mode indent heuristic (bug#67417) + + This is a continuation of the first two patches for bug#67417. The + c-ts-mode--prev-line-match heuristic we added is too broad, so for now + we are just adding a very specific heuristic for the else case. + + * lisp/progmodes/c-ts-mode.el: + (c-ts-mode--prev-line-match): Remove function. + (c-ts-mode--else-heuristic): New function. + (c-ts-mode--indent-styles): Use c-ts-mode--else-heuristic. + +2023-12-10 nverno + + Fix c-ts-mode indentation (bug#67357) + + 1. In a compund_statement, we indent the first sibling against the + parent, and the rest siblings against their previous sibling. But + this strategy falls apart when the first sibling is not on its own + line. We should regard the first sibling that is on its own line as + the "first sibling"", and indent it against the parent. + + 2. In linux style, in a do-while statement, if the do-body is + bracket-less, the "while" keyword is indented to the same level as the + do-body. It should be indented to align with the "do" keyword + instead. + + * lisp/progmodes/c-ts-mode.el: + (c-ts-mode--no-prev-standalone-sibling): New function. + (c-ts-mode--indent-styles): Use + c-ts-mode--no-prev-standalone-sibling. Add while keyword indent rule. + * test/lisp/progmodes/c-ts-mode-resources/indent.erts: New tests. + +2023-12-09 nverno + + Add font-locking for hash-bang lines in typescript-ts-mode. + + * lisp/progmodes/typescript-ts-mode.el + (typescript-ts-mode--font-lock-settings): + Add font-lock for hash bang line. + +2023-12-09 nverno + + Add font-locking for hash-bang lines in js-ts-mode + + * lisp/progmodes/js.el (js--treesit-font-lock-settings): + Add font-lock for hash bang line. + +2023-12-09 Dmitry Gutov + + ruby-mode: Better detect regexp vs division (bug#67569) + + * lisp/progmodes/ruby-mode.el (ruby-syntax-before-regexp-re): + Add grouping around methods from the whitelist. + (ruby-syntax-propertize): Also look for spaces around the slash. + +2023-12-09 Jared Finder + + Fix dragging mode line on text terminals with a mouse (bug#67457) + + * lisp/xt-mouse.el (xterm-mouse-translate-1): Fix the 'event-kind' + property of mouse-movement symbols emitted by xt-mouse. + * lisp/term/linux.el (terminal-init-linux): Call 'gpm-mouse-mode' + to set up the terminal for the mouse, if needed. + +2023-12-08 Christophe TROESTLER + + (rust-ts-mode): Set electric-indent-chars + + * lisp/progmodes/rust-ts-mode.el (rust-ts-mode): + Set electric-indent-chars (bug#67701). + +2023-12-07 Dmitry Gutov + + js-ts-mode: Highlight function parameters inside destructuring + + * lisp/progmodes/js.el (js--treesit-font-lock-settings): + Highlight function parameters declared using destructuring syntax. + +2023-12-07 Dmitry Gutov + + js-ts-mode: Highlight property shorthands in assignments + + * lisp/progmodes/js.el (js--treesit-lhs-identifier-query): Match + property shorthands (which turn into variable reference). + (js--treesit-fontify-assignment-lhs): Use the matches. + +2023-12-07 Dmitry Gutov + + (js--treesit-font-lock-settings): Highlight parameters in function expression + + * lisp/progmodes/js.el (js--treesit-font-lock-settings): + Highlight parameters in a function expression (the node type + 'function'). Make the matcher for 'formal_parameters' independent + of the parent, that just created duplication. + +2023-12-07 Dmitry Gutov + + (js--treesit-font-lock-settings): Remove some duplicates + + * lisp/progmodes/js.el (js--treesit-font-lock-settings): + Remove queries from 'function' that duplicate entries in + 'definition' (one of them with a typo). + +2023-12-04 Philipp Stephani + + Don't claim to signal an error when deleting a nonexisting file. + + The behavior has changed in commit + 1a65afb7ecc2a52127d6164bad19313440237f9d to no longer signal an error + on ENOENT. + + * doc/lispref/files.texi (Changing Files): Fix documentation about + error reporting. + +2023-12-04 Eli Zaretskii + + * lisp/indent.el (indent-rigidly): Improve prompt (bug#67620). + +2023-12-03 Christophe Troestler + + rust-ts-mode--comment-docstring: Handle block doc comments + + * lisp/progmodes/rust-ts-mode.el + (rust-ts-mode--comment-docstring): Handle block doc comments. + Inhibit match-data modification. + +2023-12-02 Christophe TROESTLER + + rust-ts-mode--comment-docstring: Fix/improve the previous change + + * lisp/progmodes/rust-ts-mode.el + (rust-ts-mode--comment-docstring): Match also "inner" line docs. + Stop rebinding 'end' and use the argument's value in the + 'treesit-fontify-with-override' call. + +2023-12-02 Eli Zaretskii + + Fix 'Info-goto-node-web' when NODE is given in various forms + + * lisp/info.el (Info-goto-node-web): Support all forms of node + input, per 'Info-read-node-name's documentation, and extract + FILENAME from NODE if given there. Default NODE to "Top" if not + provided by the user. (Bug#67531) + (Info-url-for-node): Support browsing the "Top" node. + +2023-12-02 Eli Zaretskii + + Fix setting cursor when the window's op line has 'line-prefix' + + * src/xdisp.c (set_cursor_from_row): Skip glyphs that come from a + string if their 'avoid_cursor_p' flag is set. (Bug#67486) + +2023-12-02 Xiyue Deng (tiny change) + + Drop extra parenthesis in example code in Emacs Lisp Introduction + + * doc/lispintro/emacs-lisp-intro.texi (Small buffer case): Drop + trailing unmatched parenthesis. (Bug#67576) + +2023-12-01 Christophe Troestler + + rust-ts-mode: appropriately fontify doc strings + + * lisp/progmodes/rust-ts-mode.el + (rust-ts-mode--comment-docstring): New function. + (rust-ts-mode--font-lock-settings): Use it + (https://lists.gnu.org/archive/html/emacs-devel/2023-12/msg00019.html). + +2023-12-01 Xiyue Deng (tiny change) + + Fix example code in Emacs Lisp Introduction manual + + * doc/lispintro/emacs-lisp-intro.texi (Optional Arguments): Fix + indentation in an example. (Bug#67559) + +2023-12-01 Eli Zaretskii + + Fix example in Emacs Lisp Intro manual + + * doc/lispintro/emacs-lisp-intro.texi (beginning-of-buffer opt + arg): Fix indentation in example. Reported by Xiyue Deng + . (Bug#67560) + +2023-12-01 Jeremy Bryant + + Elisp manual: Mention 'write-region' for saving the buffer + + * doc/emacs/files.texi (Save Commands): Mention + 'write-region'. (Bug#67313) + +2023-11-30 Michael Albinus + + Document, that PROCESS of signal-process can be a string + + * doc/lispref/processes.texi (Signals to Processes) [signal-process]: + * src/process.c (Fsignal_process): Document, that PROCESS can be a + string. + +2023-11-29 nverno + + Fix typescript-ts-mode indentation for switch statements + + * lisp/progmodes/typescript-ts-mode.el (typescript-ts-mode): Add + indentation rule for switch case and default keywords. (Bug#67488) + +2023-11-29 Aymeric Agon-Rambosson (tiny change) + + Repair `tab-first-completion` (bug#67158) + + + * lisp/indent.el (indent-for-tab-command): Use `syntax-class` to fix + longstanding thinko introduced back in 2020 in commit 64c851166442. + Rework the check for `syn` because TAB always completed when + `tab-first-completion` had value `word-or-paren` or `word-or-paren-or-punct`. + + (cherry picked from commit c20226a1ef5fbdfd3e71e2ef8654ee19994c0f2f) + +2023-11-29 Eli Zaretskii + + Fix behavior of 'split-root-window-*' with 'C-u' + + * lisp/window.el (split-root-window-below) + (split-root-window-right): Fix the 'interactive' form to work with + raw 'C-u' as well. (Bug#67459) + (split-window-below, split-window-right, split-root-window-below) + (split-root-window-right): Doc fix. + +2023-11-29 Xiyue Deng (tiny change) + + Add more text to clarify the behavior of 'with-current-buffer' + + * doc/lispintro/emacs-lisp-intro.texi (copy-to-buffer): Expand + description of 'with-current-buffer'. (Bug#67521) + +2023-11-27 Eli Zaretskii + + Fix example in Emacs user manual + + * doc/emacs/custom.texi (Init Rebinding): Fix syntax of example. + Reported by silarakta . (Bug#67474) + +2023-11-27 Michael Albinus + + Mention Titankey in Tramp, which has passed the tests + + * doc/misc/tramp.texi (Frequently Asked Questions): + * lisp/net/tramp.el (tramp-security-key-confirm-regexp): + Mention also Titankey. + +2023-11-26 Yuan Fu + + Fix c-ts-mode indentation after if/else (bug#67417) + + * lisp/progmodes/c-ts-mode.el: + (c-ts-mode--prev-line-match): New function. + (c-ts-mode--indent-styles): Add a rule for the empty line after + if/else/for/etc. + +2023-11-26 Yuan Fu + + Fix indentation for else clause in c-ts-mode (bug#67417) + + * lisp/progmodes/c-ts-mode.el: + (c-ts-mode--indent-styles): Add indentation for children of + else_clause. + * test/lisp/progmodes/c-ts-mode-resources/indent.erts: + (Name): Add test for else-break. Also make the test such that it + needs to indent correctly from scratch (rather than maintaining the + already correct indentation.) + +2023-11-26 Joseph Turner + + Ensure that directory is expanded in package-vc-checkout + + * lisp/emacs-lisp/package-vc.el (package-vc-checkout): Expand + DIRECTORY. (Bug#66115) + +2023-11-25 Ulrich Müller + + * etc/PROBLEMS: Add entry about pinentry with gpgsm. (Bug#67012) + +2023-11-24 nverno + + typescript-ts-mode: Add missing 'operator' to treesit-font-lock-features + + * lisp/progmodes/typescript-ts-mode.el (typescript-ts-mode): + Add operator to treesit-font-lock-feature-list (bug#67433). + +2023-11-24 Michael Albinus + + Extend D-Bus doc and test + + * doc/misc/dbus.texi (Register Objects): Adapt doc of + dbus-unregister-service. + + * test/lisp/net/dbus-tests.el (dbus--test-register-service): + Extend test. + +2023-11-24 Michael Albinus + + Do not unregister a D-Bus service which is a unique name + + * lisp/net/dbus.el (dbus-unregister-service): Check, whether + SERVICE is a known name. (Bug#67386) + +2023-11-24 Eli Zaretskii + + Fix byte-compilation warnings about 'sqlite-rollback' + + * lisp/sqlite.el (sqlite-transaction, sqlite-commit) + (sqlite-rollback): Declare. + * lisp/emacs-lisp/multisession.el (sqlite-commit) + (sqlite-transaction): Remove declaration. + +2023-11-23 Dmitry Gutov + + Make python-ts-mode's syntax-highlighting more standardized + + This was brought up in a Reddit discussion. + + * lisp/progmodes/python.el (python--treesit-fontify-variable): + Use font-lock-variable-use-face (since it applies to references). + (python-ts-mode): Move 'property' from 3rd to 4th + treesit-font-lock-level. + +2023-11-23 George Kuzler (tiny change) + + Fix "Text is read-only" on backspacing initial Calc input + + Immediately after `calc-mode' opens the minibuffer for input + (because you typed a digit, "e", etc), pressing backspace + should clear the minibuffer and return you to the *Calculator* + buffer. Instead, it leaves the minibuffer as-is and prints the + message "Text is read-only"; this is because the function used, + `erase-buffer', tries to erase the read-only minibuffer prompt. + Using `delete-minibuffer-contents' fixes this, since it doesn't + attempt to delete the prompt. + * lisp/calc/calc.el (calcDigit-backspace): Use + `delete-minibuffer-contents' instead of `erase-buffer'. (Bug#67395) + +2023-11-23 Jeremy Bryant + + Add a doc string to simple.el (bug#67355) + + * lisp/simple.el (kill-buffer--possibly-save): Add doc string. + +2023-11-23 Eli Zaretskii + + Mention "visual line" in user manual + + * doc/emacs/display.texi (Visual Line Mode): + * doc/emacs/basic.texi (Continuation Lines, Moving Point): Mention + "visual line". (Bug#67382) + +2023-11-23 Eli Zaretskii + + Allow listing Emoji from a read-only buffer + + * lisp/international/emoji.el (emoji-list): Don't barf here if the + original buffer is read-inly... + (emoji-list-select): ...barf here instead. (Bug#67400) + (emoji-list): Doc fix. + +2023-11-22 Michael Albinus + + Fix CRLF handling in Tramp (don't merge) + + * lisp/net/tramp-sh.el (tramp-send-command-and-read): Use 'space' + instead of 'blank' in rx expression, in order to handle also CR + and alike. Reported by Dominique Quatravaux + . + +2023-11-21 Dmitry Gutov + + Annotate java-ts-mode-test-movement with expected result + + Do not merge to master. + +2023-11-21 Theodor Thornhill + + Backport: Add more java indentation tests + + * test/lisp/progmodes/java-ts-mode-resources/indent.erts: Use default + indent offset, and tweak the indentation examples. + + (cherry picked from commit dbe7803aa1e8249bd70f67f25f19aedabeb9cc22) + +2023-11-21 Theodor Thornhill + + Backport: Add test for java indentation (bug#61115) + + * test/lisp/progmodes/java-ts-mode-resources/indent.erts: Add new test + case. + + (cherry picked from commit 229d0772e235f51812ed8020a31f9a8de366c7ba) + +2023-11-21 Noah Peart + + typescript-ts-mode: Support indentation for conditionals without braces + + * lisp/progmodes/typescript-ts-mode.el + (typescript-ts-mode--indent-rules): Support indentation for + conditionals without braces (bug#67031). + + * test/lisp/progmodes/typescript-ts-mode-resources/indent.erts + (Statement indentation without braces): New test. + +2023-11-21 Theodor Thornhill + + Backport: Add some basic tests for java-ts-mode and typescript-ts-mode + + * test/lisp/progmodes/java-ts-mode-resources/indent.erts: New file + with tests for indentation. + * test/lisp/progmodes/java-ts-mode-resources/movement.erts: New file + with tests for movement. + * test/lisp/progmodes/java-ts-mode-tests.el: New tests. + * test/lisp/progmodes/typescript-ts-mode-resources/indent.erts: New + file with tests for indentation. + * test/lisp/progmodes/typescript-ts-mode-tests.el: New tests. + + (cherry picked from commit c8dd37b16c574beda900d4ee48ac7b4ab4a2ee56) + +2023-11-21 Eli Zaretskii + + Fix 'with-sqlite-transaction' when BODY fails + + * lisp/sqlite.el (with-sqlite-transaction): Don't commit changes + if BODY errors out. Roll back the transaction if committing + fails. (Bug#67142) + + * etc/NEWS: + * doc/lispref/text.texi (Database): Document the error handling in + 'with-sqlite-transaction'. + +2023-11-19 Richard Stallman + + Fix wording in ELisp Intro manual + + * doc/lispintro/emacs-lisp-intro.texi (Lisp macro): Improve + wording in description of 'unless'. (Bug#67185) + +2023-11-18 Yuan Fu + + Add missing python-ts-mode keyword (bug#67015) + + * lisp/progmodes/python.el (python--treesit-keywords): Add "not in". + +2023-11-18 Dmitry Gutov + + Fix string-pixel-width with global setting of display-line-numbers + + * lisp/emacs-lisp/subr-x.el (string-pixel-width): + Instead of checking for display-line-numbers-mode, set the + display-line-numbers variable to nil (bug#67248). + +2023-11-18 Eli Zaretskii + + Document changes in 'edmacro-parse-keys' + + * lisp/edmacro.el (edmacro-parse-keys): Add a comment for forcing + output to be a vector. + (read-kbd-macro): Adjust the doc string to changes in + 'edmacro-parse-keys'. (Bug#67182) + +2023-11-18 Eli Zaretskii + + Add 2 SQLite extensions to allow-list. + + * src/sqlite.c (Fsqlite_load_extension): Add 2 Free Software + extensions to the allow-list. For the details, see + https://lists.gnu.org/archive/html/emacs-devel/2023-11/msg00234.html. + +2023-11-17 Michael Albinus + + * test/lisp/net/tramp-tests.el (tramp--test-timeout-handler): Be more verbose. + +2023-11-17 Michael Albinus + + Make Tramp aware of completion-regexp-list (don't merge) + + * lisp/net/tramp.el (tramp-skeleton-file-name-all-completions): + New defmacro. + (tramp-completion-handle-file-name-all-completions): + * lisp/net/tramp-adb.el (tramp-adb-handle-file-name-all-completions): + * lisp/net/tramp-crypt.el (tramp-crypt-handle-file-name-all-completions): + * lisp/net/tramp-fuse.el (tramp-fuse-handle-file-name-all-completions): + * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-name-all-completions): + * lisp/net/tramp-sh.el (tramp-sh-handle-file-name-all-completions): + * lisp/net/tramp-smb.el (tramp-smb-handle-file-name-all-completions): + * lisp/net/tramp-sudoedit.el + (tramp-sudoedit-handle-file-name-all-completions): Use it. + +2023-11-17 Jeremy Bryant + + Add 5 docstrings to abbrev.el (bug#67153) + + * lisp/abbrev.el (prepare-abbrev-list-buffer, add-abbrev) + (inverse-add-abbrev, abbrev--describe) + (abbrev--possibly-save): Add doc strings. + +2023-11-15 Morgan Smith + + Fix CBZ file detection in doc-view-mode + + * lisp/doc-view.el (doc-view-set-doc-type): Fix CBZ file + detection. (Bug#67133) + + This fix is almost identical to the previous fix for ODF file + detection in bug#54947 which resulted in commit + b3ff4905388834994ff26d9d033d6bc62b094c1c + +2023-11-15 João Távora + + * lisp/progmodes/eglot.el (eglot-server-programs): Fix previous commit. + + (cherry picked from commit 58d9e735e721ecf0187a5e15eefc7641112ace0b) + +2023-11-14 João Távora + + Eglot: Send standard :language-id for typescript-language-server + + bug#67150 + + * lisp/progmodes/eglot.el (eglot-server-programs): Update + language-id for languages handled by typescript-language-server. + + (cherry picked from commit 1fe949888057b0275da041288709bd5690501974) + +2023-11-14 Zajcev Evgeny + + Typofix in the doc/lispref/modes.texi + +2023-11-14 Eli Zaretskii + + Fix spell-checking email message with citations + + This became broken 7 years ago, when the 'boundp condition was + removed, and with it an important unrelated part of the code. + * lisp/textmodes/ispell.el (ispell-message): Fix cite-regexp. + +2023-11-12 Xiaoyue Chen (tiny change) + + Pass only the local parts of Eshell's $PATH to 'tramp-remote-path' + + * lisp/eshell/esh-proc.el (eshell-gather-process-output): Get the + local part of the $PATH (bug#67126). + + Do not merge to master. + +2023-11-12 Jeremy Bryant + + Add two doc strings to cl-extra.el + + * lisp/emacs-lisp/cl-extra.el (cl--random-time) + (cl-find-class): Add docstrings. (Bug#66949) + +2023-11-11 Eli Zaretskii + + Improve documentation of read syntax and printed representation + + * doc/lispref/objects.texi (Syntax for Strings): Describe in more + detail how to specify special characters in string literals. + (Printed Representation, Character Type, Nonprinting Characters): + Improve information and add cross-references about printed + representation and read syntax. (Bug#67033) + +2023-11-09 Eli Zaretskii + + Improve documentation of signaling errors in batch mode + + * doc/lispref/control.texi (Signaling Errors) + (Processing of Errors): + * doc/lispref/os.texi (Batch Mode): + * doc/lispref/debugging.texi (Invoking the Debugger): + * lisp/emacs-lisp/debug.el (debug): + * src/eval.c (Fsignal): + * lisp/subr.el (error): Document more prominently that signaling + an unhandled error in batch mode kills Emacs. Better + documentation of backtrace in batch mode. + +2023-11-09 Yuan Fu + + Fix treesit-simple-indent-presets docstring (bug#67007) + + * lisp/treesit.el (treesit-simple-indent-presets): Fix docstring. + * doc/lispref/modes.texi (Parser-based Indentation): Fix example. + +2023-11-08 Stephen Berman + + Prevent an infinite loop in todo-mode (bug#66994) + + * lisp/calendar/todo-mode.el (todo-item-start): Moving an item to + a todo file (with `C-u m') that had not yet been read into a + buffer puts point at the beginning of the file, from where it is + impossible to reach todo-item-start by this function, so don't try + in that case. + +2023-11-08 Randy Taylor + + Fix cmake-ts-mode indentation (Bug#66845) + + * lisp/progmodes/cmake-ts-mode.el (cmake-ts-mode--indent-rules): + Support versions v0.3.0 and v0.4.0 of the grammar. + (cmake-ts-mode--font-lock-compatibility-fe9b5e0): Fix docstring. + +2023-11-05 Kyle Meyer + + Update to Org 9.6.11 + +2023-11-04 Mattias Engdegård + + Suggest alternative reason for ERT test duplication error + + * lisp/emacs-lisp/ert.el (ert-set-test): Amend error message; + maybe the redefinition was caused by a file loaded twice. + (Bug#66782) + + Suggested by Xiyue Deng. + + (cherry picked from commit 425d23fbeaede81ab4f50b4073949cc1c8a3fbd0) + +2023-11-04 Eli Zaretskii + + Fix description of 'Package-Requires' library header + + * doc/lispref/tips.texi (Library Headers): Update the description + of the 'Package-Requires' header. (Bug#66677) + +2023-10-30 Stefan Monnier + + * lisp/emacs-lisp/cl-lib.el (cl--defalias): Improve&fix docstring + +2023-10-30 Jeremy Bryant + + Add two docstrings in cl-lib.el + + * lisp/emacs-lisp/cl-lib.el (cl--set-buffer-substring) + (cl--defalias): Add docstrings. (Bug#66828) + +2023-10-27 Michael Albinus + + Fix Tramp (don't merge) + + * lisp/net/tramp.el (tramp-read-id-output): Identifiers can contain "-". + +2023-10-26 Michael Albinus + + * doc/misc/tramp.texi (Traces and Profiles): Fix indentation. (don't merge) + +2023-10-25 Michael Albinus + + * doc/misc/tramp.texi (Traces and Profiles): Fix indentation. (Don't merge) + +2023-10-25 Eli Zaretskii + + Fix guessing commands for zstandard archives in Dired + + * lisp/dired-aux.el (dired-guess-shell-alist-default): Fix + zstdandard commands. (Bug#66532) + +2023-10-25 Matthew Woodcraft (tiny change) + + Fix eglot.texi (JSONRPC objects in Elisp) example + + * doc/misc/eglot.texi (JSONRPC objects in Elisp): Correct the + example. (Bug#66569) + +2023-10-25 Michael Albinus + + * doc/man/emacsclient.1: Fix --tramp option. + +2023-10-24 Stefan Kangas + + Improve `nsm-protocol-check--3des-cipher` docstring + + * lisp/net/nsm.el (nsm-protocol-check--3des-cipher): Update + docstring to reflect current NIST policy. + +2023-10-24 Lassi Kortela + + Recognize backslash in `dns-mode` quoted values + + * lisp/textmodes/dns-mode.el (dns-mode-syntax-table): Recognize + backslash as an escape character. (Bug#66660) + + (cherry picked from commit e6f05e189db73a0f0b29f987381ffef61a409232) + +2023-10-24 Stefan Kangas + + Make `dns-mode` fontify quoted values correctly + + * lisp/textmodes/dns-mode.el (dns-mode-syntax-table): Fontify + quoted values correctly. (Bug#62214) + Suggested by Trent W. Buck . + + (cherry picked from commit c586d984f279aa61de4f5dfc4f6df660188dd0f6) + +2023-10-23 Stefan Kangas + + Change news.gmane.org to news.gmane.io + + * admin/notes/emba: + * doc/misc/gnus.texi (Group Parameters) + (Non-ASCII Group Names, Filling In Threads) + (Selection Groups, Spam Package Configuration Examples) + (Terminology): + * lisp/gnus/gnus-group.el (gnus-useful-groups): + * lisp/gnus/gnus-sum.el (gnus-fetch-old-headers): + * lisp/gnus/spam-report.el (spam-report-gmane-use-article-number) + (spam-report-gmane-internal): + * test/lisp/gnus/gnus-group-tests.el (gnus-short-group-name): + Change news.gmane.org to news.gmane.io. + Ref: https://news.gmane.io/ + +2023-10-23 Mauro Aranda + + Fix minor defcustom issues in Gnus (Bug#66715) + + * lisp/gnus/gnus-art.el (gnus-button-prefer-mid-or-mail): Allow + function and add :tag to const values. + * lisp/gnus/gnus-bookmark.el (gnus-bookmark-bookmark-inline-details): + Fix docstring. + * lisp/gnus/gnus-sum.el (gnus-simplify-subject-fuzzy-regexp): Allow a + single regexp as value. + * lisp/gnus/message.el (message-indent-citation-function): Allow a + single function as value. + (message-mail-alias-type): Allow for a list of options as value. + (message-dont-reply-to-names): Allow a function as value. + * lisp/gnus/spam-report.el (spam-report-url-ping-function): Fix + default value for the function widget. + +2023-10-23 Michael Albinus + + Minor connection-local variables fixes + + * doc/emacs/custom.texi (Connection Variables): Warn about + specifying the same variable twice. + + * lisp/files-x.el (connection-local-get-profiles): Normalize criteria. + +2023-10-23 Stefan Kangas + + Make Dired honor `insert-directory-program´ with globs + + Starting with commit 6f6639d6ed6c6314b2643f6c22498fc2e23d34c7 + (Bug#27631), Dired stopped respecting the value of + 'insert-directory-program' when using directory wildcards/globs. + + * lisp/dired.el (dired-insert-directory): Honor the value of + 'insert-directory-program' when using directory wildcards. + +2023-10-22 Morgan J. Smith + + Fix typo in url-privacy-level :type + + * lisp/url/url-vars.el (url-privacy-level): Fix typo in + :type. (Bug#66613) + +2023-10-22 Juri Linkov + + * lisp/vc/log-view.el (log-view-mode-menu): Quote derived modes (bug#66686). + +2023-10-22 Petteri Hintsanen + + * lisp/tab-bar.el: Fix the close button with auto-width (bug#66678). + + (tab-bar-auto-width): Take into account the length of tab-bar-close-button + more than one character: " x". + Don't merge to master. + +2023-10-22 Mauro Aranda + + Fix State button for customize-icon (Bug#66635) + + * lisp/cus-edit.el (custom-icon-action): New function. + (custom-icon): Use it as the :action. Otherwise, clicking the State + button is a noop. Remove irrelevant stuff from the docstring and + comment out some copy-pasta. + (custom-icon-extended-menu): New variable, the menu to show upon + :action. + (custom-icon-set): Really redraw the widget with the new settings. + Comment out strange call to custom-variable-backup-value. + (custom-icon-save): New function. + + * lisp/emacs-lisp/icons.el (icons--merge-spec): Fix call to plist-get + and avoid infloop. + +2023-10-22 Yuan Fu + + Fix the use of adaptive-fill-regexp in treesit indent preset + + * lisp/treesit.el (treesit-simple-indent-presets): + adaptive-fill-regexp don't have a capture group (the group in the + default value is supposed to be a non-capture group), so don't use the + group. Also, in the second diff hunk, replace looking-at with + looking-at-p so it doesn't override match data that we use later. + +2023-10-21 nverno + + Fix treesit-install-language-grammar (bug#66673) + + * lisp/treesit.el (treesit-install-language-grammar): Take out the + language symbol when storing the recipe. + +2023-10-21 Yuan Fu + + Fix treesit-explore-mode (bug#66431) + + * lisp/treesit.el (treesit-explore-mode): Reset + treesit--explorer-last-node before calling treesit--explorer-refresh, + so that in the rare case described in the bug report, the explorer + buffer don't show the outdated node. + +2023-10-21 Dmitry Gutov + + tsx-ts-mode--font-lock-compatibility-bb1f97b: Re-fix the previous fix + + * lisp/progmodes/typescript-ts-mode.el + (tsx-ts-mode--font-lock-compatibility-bb1f97b): Make sure the + tested query is actually valid in the new grammar (bug#66646). + +2023-10-19 Michael Albinus + + Update Tramp version (don't merge with master) + + * doc/misc/trampver.texi: + * lisp/net/trampver.el: Change version to "2.6.2.29.2". + (customize-package-emacs-version-alist): + Adapt Tramp version integrated in Emacs 29.2. + +2023-10-19 Eli Zaretskii + + Bump Emacs version + + * README: + * configure.ac: + * msdos/sed2v2.inp: + * nt/README.W32: Bump Emacs version to 29.1.90. + 2023-10-16 Po Lu Correctly register focus events concomitant with alpha changes @@ -119361,7 +120907,7 @@ This file records repository revisions from commit f2ae39829812098d8269eafbc0fcb98959ee5bb7 (exclusive) to -commit d9e1605122b4ba70a55f7b168505b7d7f8d2bdd6 (inclusive). +commit 92a7132bd6c76a43860fa01ca3363857d8dfc8f3 (inclusive). See ChangeLog.3 for earlier changes. ;; Local Variables: diff --git a/etc/HISTORY b/etc/HISTORY index f6df3e6fe60..afa14cb2350 100644 --- a/etc/HISTORY +++ b/etc/HISTORY @@ -233,6 +233,8 @@ Was not actually released. GNU Emacs 29.1 (2023-07-30) emacs-29.1 +GNU Emacs 29.2 (2024-01-18) emacs-29.2 + ---------------------------------------------------------------------- This file is part of GNU Emacs. -- cgit v1.2.3 From b4baf0f8216b27a34a632f668cb9b02b1ac35b25 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Jan 2024 04:43:06 -0500 Subject: ; Update ChangeLog.4 with latest changes. --- ChangeLog.4 | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/ChangeLog.4 b/ChangeLog.4 index 3600f764292..74d6887376b 100644 --- a/ChangeLog.4 +++ b/ChangeLog.4 @@ -2,6 +2,13 @@ * Version 29.2 released. + * ChangeLog.4: + * etc/HISTORY: Update for Emacs 29.2. + * README: + * configure.ac: + * nt/README.W32: + * msdos/sed2v2.inp: Bump Emacs version to 29.2. + 2024-01-17 Dmitry Gutov diff-mode: Support committing diff with file deletions -- cgit v1.2.3 From ef01b634d219bcceda17dcd61024c7a12173b88c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Jan 2024 05:17:44 -0500 Subject: ; Regenerate lisp/ldefs-boot.el and etc/AUTHORS for 29.2. --- etc/AUTHORS | 112 +++++++++++++++++++++++++++++++++-------------------- lisp/ldefs-boot.el | 20 ++++++---- 2 files changed, 83 insertions(+), 49 deletions(-) diff --git a/etc/AUTHORS b/etc/AUTHORS index 5fc54f1909f..193a3db6760 100644 --- a/etc/AUTHORS +++ b/etc/AUTHORS @@ -45,7 +45,7 @@ Adam Hupp: changed emacs.py emacs2.py emacs3.py gud.el progmodes/python.el Adam Porter: changed tab-line.el cl-macs.el map.el control.texi - map-tests.el pcase-tests.el tab-bar.el + map-tests.el pcase-tests.el tab-bar.el variables.texi Adam Sjøgren: changed mml2015.el shr.el spam.el xterm.c blink.xpm braindamaged.xpm cry.xpm dead.xpm evil.xpm forced.xpm frown.xpm @@ -537,7 +537,7 @@ Aubrey Jaffer: changed info.el unexelf.c August Feng: changed bookmark.el -Augustin Chéneau: changed treesit.el +Augustin Chéneau: changed c-ts-mode.el treesit.el Augusto Stoffel: co-wrote ansi-osc.el and changed progmodes/python.el isearch.el eglot.el comint.el eldoc.el @@ -555,6 +555,8 @@ Axel Boldt: changed ehelp.el electric.el Axel Svensson: changed characters.el display.texi x-win.el +Aymeric Agon-Rambosson: changed indent.el + Bahodir Mansurov: changed quail/cyrillic.el Bake Timmons: changed gnus.texi mail-source.el @@ -984,7 +986,7 @@ Christoph Dittmann: changed ox-beamer.el Christophe de Dinechin: co-wrote ns-win.el -Christophe Deleuze: changed icalendar.el image-dired.el +Christophe Deleuze: changed ange-ftp.el icalendar.el image-dired.el Christoph Egger: changed configure.ac @@ -1016,7 +1018,8 @@ Christopher Thorne: changed dired.el progmodes/grep.el Christopher Wellons: changed emacs-lisp/cl-lib.el hashcash.el viper-cmd.el viper-ex.el viper-init.el viper.el -Christophe Troestler: changed gnus-icalendar.el epg.el newcomment.el +Christophe Troestler: changed rust-ts-mode.el gnus-icalendar.el epg.el + newcomment.el Christoph Göttschkes: changed make-mode.el @@ -1186,6 +1189,9 @@ Daniel LaLiberte: wrote edebug.el isearch.el and co-wrote hideif.el and changed cust-print.el mlconvert.el eval-region.el +Daniel Laurens Nicolai: changed doc-view.el facemenu.el files.el + misc.texi re-builder.el searching.texi + Daniel Lenski: changed speedbar.el Daniel Lopez: changed progmodes/compile.el @@ -1196,7 +1202,7 @@ Daniel Martín: changed c-ts-mode.el nsterm.m shortdoc.el ns-win.el simple.el diff-mode-tests.el erc.texi files.el files.texi indent.erts msdos-xtra.texi progmodes/python.el search.texi .lldbinit basic.texi c-ts-mode-tests.el cmacexp.el compilation.txt compile-tests.el - compile.texi configure.ac and 46 other files + compile.texi configure.ac and 47 other files Daniel McClanahan: changed lisp-mode.el @@ -1475,6 +1481,9 @@ and changed complete.el Denis Stünkel: changed ibuf-ext.el +Denis Zubarev: changed treesit-tests.el progmodes/python.el + python-tests.el treesit.c + Deniz Dogan: changed rcirc.el simple.el css-mode.el TUTORIAL.sv commands.texi erc-backend.el erc-log.el erc.el image.el iswitchb.el lisp-mode.el process.c progmodes/python.el quickurl.el rcirc.texi @@ -1564,10 +1573,10 @@ Dmitry Gorbik: changed org.el Dmitry Gutov: wrote elisp-mode-tests.el jit-lock-tests.el json-tests.el vc-hg-tests.el xref-tests.el and changed xref.el ruby-mode.el project.el vc-git.el ruby-ts-mode.el - elisp-mode.el etags.el ruby-mode-tests.el js.el vc.el package.el - vc-hg.el symref/grep.el dired-aux.el ruby-ts-mode-tests.el simple.el - progmodes/python.el treesit.el log-edit.el ruby-ts.rb rust-ts-mode.el - and 157 other files + elisp-mode.el js.el etags.el ruby-mode-tests.el vc.el package.el + vc-hg.el symref/grep.el treesit.el dired-aux.el progmodes/python.el + ruby-ts-mode-tests.el simple.el typescript-ts-mode.el log-edit.el + ruby-ts.rb and 158 other files Dmitry Kurochkin: changed isearch.el @@ -1668,7 +1677,7 @@ and co-wrote help-tests.el and changed xdisp.c display.texi w32.c msdos.c simple.el w32fns.c files.el fileio.c keyboard.c emacs.c text.texi configure.ac w32term.c dispnew.c frames.texi w32proc.c files.texi xfaces.c window.c - dispextern.h lisp.h and 1334 other files + dispextern.h lisp.h and 1341 other files Eliza Velasquez: changed server.el @@ -2087,6 +2096,8 @@ George D. Plymale Ii: changed esh-cmd.el George Kettleborough: changed org-clock.el org-timer.el +George Kuzler: changed calc.el + George McNinch: changed nnir.el Georges Brun-Cottan: wrote easy-mmode.el @@ -2172,7 +2183,7 @@ Gregor Schmid: changed intervals.c intervals.h tcl-mode.el textprop.c Gregory Chernov: changed nnslashdot.el -Gregory Heytings: changed xdisp.c editfns.c keyboard.c subr.el buffer.c +Gregory Heytings: changed xdisp.c editfns.c subr.el keyboard.c buffer.c dispextern.h lisp.h buffer.h display.texi efaq.texi files.el isearch.el minibuffer.el Makefile.in bytecode.c composite.c positions.texi bytecomp.el emake help-fns.el lread.c and 78 other files @@ -2556,11 +2567,10 @@ and changed gnus-score.el gnus-logic.el Jan Vroonhof: changed gnus-cite.el gnus-msg.el nntp.el -Jared Finder: changed menu-bar.el term.c commands.texi frame.c isearch.el - mouse.el tmm.el wid-edit.el xt-mouse.el artist.el dispnew.c - ediff-wind.el ediff.el faces.el foldout.el frames.texi keyboard.c - lread.c mouse-drag.el progmodes/compile.el ruler-mode.el - and 7 other files +Jared Finder: changed menu-bar.el term.c commands.texi xt-mouse.el + frame.c isearch.el mouse.el tmm.el wid-edit.el artist.el dired.el + dispnew.c ediff-wind.el ediff.el faces.el foldout.el frames.texi + keyboard.c lread.c mouse-drag.el progmodes/compile.el and 9 other files Jarek Czekalski: changed keyboard.c callproc.c mini.texi minibuf.c misc.texi server.el shell.el w32fns.c xgselect.c @@ -2626,7 +2636,7 @@ and changed idlw-rinfo.el idlw-toolbar.el comint.el idlwave.texi vc.el Jean Abou Samra: changed scheme.el -Jean-Christophe Helary: changed emacs-lisp-intro.texi ns-win.el +Jean-Christophe Helary: changed back.texi emacs-lisp-intro.texi ns-win.el package-tests.el package.el strings.texi subr-x.el ucs-normalize.el Jean Forget: changed cal-french.el @@ -2704,6 +2714,9 @@ Jérémie Courrèges-Anglas: changed kqueue.c org.texi ox-latex.el Jeremy Bertram Maitin-Shepard: changed erc.el erc-backend.el erc-button.el erc-track.el mml.el +Jeremy Bryant: changed abbrev.el cl-extra.el emacs-lisp/cl-lib.el + files.texi functions.texi simple.el + Jérémy Compostella: changed tramp-sh.el mml.el battery.el keyboard.c windmove.el window.el xdisp.c @@ -2767,7 +2780,7 @@ Jim Porter: changed eshell.texi esh-cmd.el esh-var-tests.el esh-util.el eshell-tests-helpers.el em-pred.el esh-arg.el esh-cmd-tests.el tramp.el em-pred-tests.el em-dirs-tests.el server.el em-basic.el em-extpipe-tests.el esh-opt-tests.el esh-opt.el - and 92 other files + and 93 other files Jim Radford: changed gnus-start.el @@ -3129,7 +3142,7 @@ Juri Linkov: wrote compose.el emoji.el files-x.el misearch.el and changed isearch.el simple.el info.el replace.el dired.el dired-aux.el progmodes/grep.el minibuffer.el window.el subr.el vc.el outline.el mouse.el diff-mode.el repeat.el image-mode.el files.el menu-bar.el - search.texi startup.el progmodes/compile.el and 473 other files + search.texi startup.el display.texi and 473 other files Jussi Lahdenniemi: changed w32fns.c ms-w32.h msdos.texi w32.c w32.h w32console.c w32heap.c w32inevt.c w32term.h @@ -3645,6 +3658,8 @@ Lute Kamstra: changed modes.texi emacs-lisp/debug.el generic-x.el Lynn Slater: wrote help-macro.el +Maciej Kalandyk: changed progmodes/python.el + Maciek Pasternacki: changed nnrss.el Madan Ramakrishnan: changed org-agenda.el @@ -3940,6 +3955,8 @@ Matthew Tromp: changed ielm.el Matthew White: changed buffer.c bookmark-tests.el bookmark.el test-list.bmk +Matthew Woodcraft: changed eglot.texi + Matthias Dahl: changed faces.el process.c process.h Matthias Förste: changed files.el @@ -3986,11 +4003,11 @@ Matt Simmons: changed message.el Matt Swift: changed dired.el editfns.c lisp-mode.el mm-decode.el outline.el progmodes/compile.el rx.el simple.el startup.el -Mauro Aranda: changed wid-edit.el cus-edit.el custom.el wid-edit-tests.el - widget.texi perl-mode.el custom-tests.el checkdoc-tests.el checkdoc.el - cperl-mode-tests.el cus-edit-tests.el cus-theme.el customize.texi - files.texi gnus.texi octave.el pong.el align.el auth-source.el - autorevert.el base.el and 56 other files +Mauro Aranda: changed wid-edit.el cus-edit.el widget.texi custom.el + wid-edit-tests.el perl-mode.el custom-tests.el checkdoc-tests.el + checkdoc.el cperl-mode-tests.el cus-edit-tests.el cus-theme.el + customize.texi files.texi gnus.texi octave.el pong.el align.el + auth-source.el autorevert.el base.el and 62 other files Maxime Edouard Robert Froumentin: changed gnus-art.el mml.el @@ -4013,7 +4030,7 @@ and co-wrote tramp-cache.el tramp-sh.el tramp.el and changed tramp.texi tramp-adb.el trampver.el trampver.texi dbusbind.c files.el ange-ftp.el files.texi file-notify-tests.el dbus.texi gitlab-ci.yml autorevert.el tramp-fish.el kqueue.c Dockerfile.emba - os.texi tramp-gw.el test/Makefile.in README shell.el files-tests.el + os.texi tramp-gw.el test/Makefile.in README files-x.el shell.el and 309 other files Michael Ben-Gershon: changed acorn.h configure.ac riscix1-1.h riscix1-2.h @@ -4197,8 +4214,8 @@ Mike Kazantsev: changed erc-dcc.el Mike Kupfer: changed mh-comp.el mh-e.el mh-mime.el mh-utils.el files.el ftcrfont.c mh-compat.el mh-utils-tests.el emacs-mime.texi files.texi - gnus-mh.el gnus.texi mh-acros.el mh-e.texi mh-identity.el mh-scan.el - xftfont.c + gnus-mh.el gnus.texi mh-acros.el mh-e.texi mh-funcs.el mh-identity.el + mh-scan.el xftfont.c Mike Lamb: changed em-unix.el esh-util.el pcmpl-unix.el @@ -4258,10 +4275,10 @@ Mohsin Kaleem: changed eglot.el Mon Key: changed animate.el imap.el syntax.el -Morgan J. Smith: changed gnus-group-tests.el +Morgan J. Smith: changed gnus-group-tests.el url-vars.el -Morgan Smith: changed image-dired.el minibuffer-tests.el minibuffer.el - vc-git.el window.el +Morgan Smith: changed image-dired.el doc-view.el minibuffer-tests.el + minibuffer.el vc-git.el window.el Morten Welinder: wrote [many MS-DOS files] arc-mode.el desktop.el dosfns.c internal.el msdos.h pc-win.el @@ -4341,6 +4358,8 @@ Nevin Kapur: changed nnmail.el gnus-sum.el nnimap.el gnus-group.el Nguyen Thai Ngoc Duy: co-wrote vnvni.el +Niall Dooley: changed eglot.el + Niall Mansfield: changed etags.c Nic Ferrier: changed ert.el tramp.el @@ -4455,7 +4474,8 @@ and changed rsz-mini.el emacs-buffer.gdb comint.el files.el Makefile Noah Lavine: changed tramp.el -Noah Peart: changed treesit.el +Noah Peart: changed typescript-ts-mode.el indent.erts js.el treesit.el + c-ts-mode.el js-tests.el js-ts-indents.erts Noah Swainland: changed calc.el goto-addr.el misc.texi @@ -4720,7 +4740,8 @@ Peter O'Gorman: changed configure.ac frame.h hpux10-20.h termhooks.h Peter Oliver: changed emacsclient.desktop emacsclient-mail.desktop Makefile.in emacs-mail.desktop server.el configure.ac emacs.desktop - emacs.metainfo.xml misc.texi perl-mode.el ruby-mode-tests.el vc-sccs.el + emacs.metainfo.xml emacsclient.1 misc.texi perl-mode.el + ruby-mode-tests.el vc-sccs.el Peter Povinec: changed term.el @@ -4760,7 +4781,7 @@ Petri Kaurinkoski: changed configure.ac iris4d.h irix6-0.h irix6-5.h Petr Salinger: changed configure.ac gnu-kfreebsd.h Petteri Hintsanen: changed sequences.texi Makefile.in emacs/Makefile.in - lispintro/Makefile.in lispref/Makefile.in misc/Makefile.in + lispintro/Makefile.in lispref/Makefile.in misc/Makefile.in tab-bar.el Phil Hagelberg: wrote ert-x-tests.el and changed package.el pcmpl-unix.el subr.el @@ -5495,6 +5516,8 @@ Simon Thum: changed ob-maxima.el Skip Collins: changed w32fns.c w32term.c w32term.h +Skykanin-: changed eglot.el + Sławomir Nowaczyk: changed emacs.py progmodes/python.el TUTORIAL.pl flyspell.el ls-lisp.el w32proc.c @@ -5527,7 +5550,7 @@ and co-wrote help-tests.el keymap-tests.el and changed image-dired.el efaq.texi package.el cperl-mode.el help.el subr.el checkdoc.el bookmark.el simple.el dired.el files.el gnus.texi dired-x.el keymap.c image-mode.el erc.el ediff-util.el speedbar.el - woman.el browse-url.el bytecomp-tests.el and 1678 other files + woman.el browse-url.el bytecomp-tests.el and 1683 other files Stefan Merten: co-wrote rst.el @@ -5581,7 +5604,7 @@ and changed wdired.el todo-mode.texi wdired-tests.el diary-lib.el dired.el dired-tests.el doc-view.el files.el info.el minibuffer.el outline.el todo-test-1.todo allout.el eww.el find-dired.el frames.texi hl-line.el menu-bar.el mouse.el otodo-mode.el simple.el - and 63 other files + and 64 other files Stephen C. Gilardi: changed configure.ac @@ -5791,10 +5814,10 @@ Theodore Jump: changed makefile.nt makefile.def w32-win.el w32faces.c Theodor Thornhill: changed typescript-ts-mode.el java-ts-mode.el c-ts-mode.el eglot.el csharp-mode.el js.el css-mode.el project.el - json-ts-mode.el treesit.el c-ts-common.el eglot-tests.el EGLOT-NEWS - README.md c-ts-mode-tests.el compile-tests.el go-ts-mode.el - indent-bsd.erts indent.erts maintaining.texi mwheel.el - and 5 other files + indent.erts json-ts-mode.el treesit.el c-ts-common.el eglot-tests.el + EGLOT-NEWS README.md c-ts-mode-tests.el compile-tests.el go-ts-mode.el + indent-bsd.erts java-ts-mode-tests.el maintaining.texi + and 8 other files Theresa O'Connor: wrote json.el and changed erc.el erc-viper.el erc-log.el erc-track.el viper.el @@ -6317,10 +6340,15 @@ W. Trevor King: changed xterm.el Xavier Maillard: changed gnus-faq.texi gnus-score.el mh-utils.el spam.el +Xiaoyue Chen: changed esh-proc.el + Xi Lu: changed etags.c htmlfontify.el ruby-mode.el CTAGS.good_crlf CTAGS.good_update Makefile TUTORIAL.cn crlf eww.el shortdoc.el tramp-sh.el +Xiyue Deng: changed emacs-lisp-intro.texi functions.texi strings.texi + symbols.texi + Xu Chunyang: changed eglot.el eww.el dom.el gud.el netrc.el Xue Fuqiao: changed display.texi emacs-lisp-intro.texi files.texi @@ -6383,11 +6411,11 @@ Yoshinari Nomura: changed ox-html.el ox.el Yoshinori Koseki: wrote iimage.el and changed fontset.el message.el nnheader.el nnmail.el -Yuan Fu: changed treesit.el treesit.c c-ts-mode.el parsing.texi +Yuan Fu: changed treesit.el c-ts-mode.el treesit.c parsing.texi progmodes/python.el modes.texi js.el treesit-tests.el indent.erts - typescript-ts-mode.el css-mode.el treesit.h configure.ac + typescript-ts-mode.el treesit.h css-mode.el configure.ac java-ts-mode.el print.c sh-script.el c-ts-common.el gdb-mi.el - rust-ts-mode.el go-ts-mode.el starter-guide and 54 other files + rust-ts-mode.el go-ts-mode.el starter-guide and 55 other files Yuanle Song: changed rng-xsd.el diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 82643a55508..16a9df2c92e 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -6613,6 +6613,13 @@ There is some minimal font-lock support (see vars (setq debugger 'debug) (autoload 'debug "debug" "\ Enter debugger. \\`\\[debugger-continue]' returns from the debugger. + +In interactive sessions, this switches to a backtrace buffer and shows +the Lisp backtrace of function calls there. In batch mode (more accurately, +when `noninteractive' is non-nil), it shows the Lisp backtrace on the +standard error stream (unless `backtrace-on-error-noninteractive' is nil), +and then kills Emacs, causing it to exit with a negative exit code. + Arguments are mainly for use when this is called from the internals of the evaluator. @@ -9201,14 +9208,14 @@ Edit a keyboard macro which has been given a name by `name-last-kbd-macro'. (fn &optional PREFIX)" t) (autoload 'read-kbd-macro "edmacro" "\ Read the region as a keyboard macro definition. -The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\". -See documentation for `edmacro-mode' for details. +The region between START and END is interpreted as spelled-out keystrokes, +e.g., \"M-x abc RET\". See documentation for `edmacro-mode' for details. Leading/trailing \"C-x (\" and \"C-x )\" in the text are allowed and ignored. The resulting macro is installed as the \"current\" keyboard macro. In Lisp, may also be called with a single STRING argument in which case the result is returned rather than being installed as the current macro. -The result will be a string if possible, otherwise an event vector. +The result is a vector of input events. Second argument NEED-VECTOR means to return an event vector always. (fn START &optional END)" t) @@ -9824,7 +9831,7 @@ This command prompts for an emoji name, with completion, and inserts it. It recognizes the Unicode Standard names of emoji, and also consults the `emoji-alternate-names' alist." t) (autoload 'emoji-list "emoji" "\ -List emojis and insert the one that's selected. +List emojis and allow selecting and inserting one of them. Select the emoji by typing \\\\[emoji-list-select] on its picture. The glyph will be inserted into the buffer that was current when the command was invoked." t) @@ -22498,7 +22505,7 @@ Coloring: ;;; Generated autoloads from org/org.el -(push (purecopy '(org 9 6 10)) package--builtin-versions) +(push (purecopy '(org 9 6 15)) package--builtin-versions) (autoload 'org-babel-do-load-languages "org" "\ Load the languages defined in `org-babel-load-languages'. @@ -32871,7 +32878,7 @@ Add archive file name handler to `file-name-handler-alist'." (when (and tramp-ar ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 6 2 -1)) package--builtin-versions) +(push (purecopy '(tramp 2 6 2 29 2)) package--builtin-versions) (register-definition-prefixes "trampver" '("tramp-")) @@ -34116,7 +34123,6 @@ Normalize arguments to delight. ;;; Generated autoloads from use-package/use-package-ensure-system-package.el -(push (purecopy '(use-package 0 2)) package--builtin-versions) (autoload 'use-package-normalize/:ensure-system-package "use-package-ensure-system-package" "\ Turn ARGS into a list of conses of the form (PACKAGE-NAME . INSTALL-COMMAND). -- cgit v1.2.3 From 4e500d9d5ab56e0345557e7ab251c997ebebf4c3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Jan 2024 05:30:52 -0500 Subject: Bump Emacs version to 29.2.50. * README: * configure.ac: * nt/README.W32: * msdos/sed2v2.inp: * etc/NEWS: Bump Emacs version to 29.2.50. --- README | 2 +- configure.ac | 2 +- etc/NEWS | 27 +++++++++++++++++++++++++++ msdos/sed2v2.inp | 2 +- nt/README.W32 | 2 +- 5 files changed, 31 insertions(+), 4 deletions(-) diff --git a/README b/README index 1ec182e7497..a968b29f71c 100644 --- a/README +++ b/README @@ -2,7 +2,7 @@ Copyright (C) 2001-2024 Free Software Foundation, Inc. See the end of the file for license conditions. -This directory tree holds version 29.2 of GNU Emacs, the extensible, +This directory tree holds version 29.2.50 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. The file INSTALL in this directory says how to build and install GNU diff --git a/configure.ac b/configure.ac index 8c98e8153f2..78d5475f75a 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ dnl along with GNU Emacs. If not, see . AC_PREREQ([2.65]) dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el. -AC_INIT([GNU Emacs], [29.2], [bug-gnu-emacs@gnu.org], [], +AC_INIT([GNU Emacs], [29.2.50], [bug-gnu-emacs@gnu.org], [], [https://www.gnu.org/software/emacs/]) dnl Set emacs_config_options to the options of 'configure', quoted for the shell, diff --git a/etc/NEWS b/etc/NEWS index 1a0e1f37366..06086e9bdfb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -15,6 +15,33 @@ in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' with a prefix argument or by typing 'C-u C-h C-n'. + +* Installation Changes in Emacs 29.3 + + +* Startup Changes in Emacs 29.3 + + +* Changes in Emacs 29.3 + + +* Editing Changes in Emacs 29.3 + + +* Changes in Specialized Modes and Packages in Emacs 29.3 + + +* New Modes and Packages in Emacs 29.3 + + +* Incompatible Lisp Changes in Emacs 29.3 + + +* Lisp Changes in Emacs 29.3 + + +* Changes in Emacs 29.3 on Non-Free Operating Systems + * Installation Changes in Emacs 29.2 diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index 9790cf55f3d..8ca5bbf74d9 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -67,7 +67,7 @@ /^#undef PACKAGE_NAME/s/^.*$/#define PACKAGE_NAME ""/ /^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/ /^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/ -/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "29.2"/ +/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "29.2.50"/ /^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/ /^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/ /^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/ diff --git a/nt/README.W32 b/nt/README.W32 index 00ec926ef7f..a450c2e84f0 100644 --- a/nt/README.W32 +++ b/nt/README.W32 @@ -1,7 +1,7 @@ Copyright (C) 2001-2024 Free Software Foundation, Inc. See the end of the file for license conditions. - Emacs version 29.2 for MS-Windows + Emacs version 29.2.50 for MS-Windows This README file describes how to set up and run a precompiled distribution of the latest version of GNU Emacs for MS-Windows. You -- cgit v1.2.3 From 2c887f497c723c2397888e2f406faa4de3a8208a Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Thu, 18 Jan 2024 07:24:39 -0800 Subject: Avoid font-lock reset in `gnus-message-citation-mode' * lisp/gnus/gnus-cite.el (gnus-message-citation-mode): Use `font-lock-add-keywords' and `font-lock-remove-keywords' instead of modifying font-lock defaults. Make no font-lock changes until `font-lock-mode' is active. Thanks to Morgan Willcock --- lisp/gnus/gnus-cite.el | 36 +++++++++++------------------------- 1 file changed, 11 insertions(+), 25 deletions(-) diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index 04abdfc0d1b..3fde9baa0fe 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -1122,31 +1122,17 @@ Returns nil if there is no such line before LIMIT, t otherwise." When enabled, it automatically turns on `font-lock-mode'." :lighter "" (when (derived-mode-p 'message-mode) - ;; FIXME: Use font-lock-add-keywords! - (let ((defaults (car font-lock-defaults)) - default) ;; keywords - (while defaults - (setq default (if (consp defaults) - (pop defaults) - (prog1 - defaults - (setq defaults nil)))) - (if gnus-message-citation-mode - ;; `gnus-message-citation-keywords' should be the last - ;; elements of the keywords because the others are unlikely - ;; to have the OVERRIDE flags -- XEmacs applies a keyword - ;; having no OVERRIDE flag to matched text even if it has - ;; already other faces, while Emacs doesn't. - (set (make-local-variable default) - (append (default-value default) - gnus-message-citation-keywords)) - (kill-local-variable default)))) - ;; Force `font-lock-set-defaults' to update `font-lock-keywords'. - (setq font-lock-set-defaults nil) - (font-lock-set-defaults) - (if font-lock-mode - (font-lock-flush) - (gnus-message-citation-mode (font-lock-mode 1))))) + (if (not font-lock-mode) + (gnus-message-citation-mode (font-lock-mode 1)) + (if gnus-message-citation-mode + ;; `gnus-message-citation-keywords' should be the last + ;; elements of the keywords because the others are unlikely + ;; to have the OVERRIDE flags -- XEmacs applies a keyword + ;; having no OVERRIDE flag to matched text even if it has + ;; already other faces, while Emacs doesn't. + (font-lock-add-keywords nil gnus-message-citation-keywords t) + (font-lock-remove-keywords nil gnus-message-citation-keywords)) + (font-lock-flush)))) (defun turn-on-gnus-message-citation-mode () "Turn on `gnus-message-citation-mode'." -- cgit v1.2.3 From ef01250ef9c22aa1ac2ecff3136aabf79b2a677b Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 18 Jan 2024 18:45:16 +0100 Subject: Only use a hash index size of 1 for tables with size 0 (bug#68244) This invariant was intended but insufficiently enforced which could lead to an assertion failure. * src/fns.c (hash_index_size): Assume size>0, and return a value >1. (make_hash_table): Only use hash_index_size for size>0. --- src/fns.c | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/src/fns.c b/src/fns.c index 5bedf49ef36..15bbd270311 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4525,9 +4525,14 @@ hash_index_size (ptrdiff_t size) ptrdiff_t upper_bound = min (MOST_POSITIVE_FIXNUM, min (TYPE_MAXIMUM (hash_idx_t), PTRDIFF_MAX / sizeof (ptrdiff_t))); - ptrdiff_t index_size = size + (size >> 2); /* 1.25x larger */ + /* Single-element index vectors are used iff size=0. */ + eassert (size > 0); + ptrdiff_t lower_bound = 2; + ptrdiff_t index_size = size + max (size >> 2, 1); /* 1.25x larger */ if (index_size < upper_bound) - index_size = next_almost_prime (index_size); + index_size = (index_size < lower_bound + ? lower_bound + : next_almost_prime (index_size)); if (index_size > upper_bound) error ("Hash table too large"); return index_size; @@ -4565,15 +4570,13 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size, h->weakness = weak; h->count = 0; h->table_size = size; - int index_size = hash_index_size (size); - h->index_size = index_size; if (size == 0) { h->key_and_value = NULL; h->hash = NULL; h->next = NULL; - eassert (index_size == 1); + h->index_size = 1; h->index = (hash_idx_t *)empty_hash_index_vector; h->next_free = -1; } @@ -4591,6 +4594,8 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size, h->next[i] = i + 1; h->next[size - 1] = -1; + int index_size = hash_index_size (size); + h->index_size = index_size; h->index = hash_table_alloc_bytes (index_size * sizeof *h->index); for (ptrdiff_t i = 0; i < index_size; i++) h->index[i] = -1; -- cgit v1.2.3 From e7a6ce847fd06c4f132bbac2f2fdc8474753ad3c Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 18 Jan 2024 18:48:12 +0100 Subject: Don't use Qunbound as hash table key when printing (bug#68244) This flaw could cause an assertion failure. * src/print.c (PRINT_CIRCLE_CANDIDATE_P): Don't consider Qunbound a print-circle candidate; it should never be seen by Lisp anyway. --- src/print.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/print.c b/src/print.c index 0899dcdeb03..61999c096aa 100644 --- a/src/print.c +++ b/src/print.c @@ -1311,7 +1311,8 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) || RECORDP (obj))) \ || (! NILP (Vprint_gensym) \ && SYMBOLP (obj) \ - && !SYMBOL_INTERNED_P (obj))) + && !SYMBOL_INTERNED_P (obj) \ + && !hash_unused_entry_key_p (obj))) /* The print preprocess stack, used to traverse data structures. */ -- cgit v1.2.3 From b07a86abb6d5bb3d5cd178bb77592ad7208882f5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 18 Jan 2024 14:00:15 -0500 Subject: * test/lisp/emacs-lisp/comp-cstr-tests.el: Use macros in a simpler way (comp-cstr-test-ts): Move out of `cl-eval-when`. (comp-cstr-typespec-test): Delete. (comp-cstr-synthesize-tests): Make it take the tests as an argument. (comp-cstr-typespec-tests-alist): Delete var, pass its value to the macro instead. --- test/lisp/emacs-lisp/comp-cstr-tests.el | 414 ++++++++++++++++---------------- 1 file changed, 204 insertions(+), 210 deletions(-) diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el b/test/lisp/emacs-lisp/comp-cstr-tests.el index fb1770f1f4a..edc70b12d4b 100644 --- a/test/lisp/emacs-lisp/comp-cstr-tests.el +++ b/test/lisp/emacs-lisp/comp-cstr-tests.el @@ -29,218 +29,212 @@ (require 'cl-lib) (require 'comp-cstr) -(cl-eval-when (compile eval load) - - (defun comp-cstr-test-ts (type-spec) - "Create a constraint from TYPE-SPEC and convert it back to type specifier." - (let ((comp-ctxt (make-comp-cstr-ctxt))) - (comp-cstr-to-type-spec (comp-type-spec-to-cstr type-spec)))) - - (defun comp-cstr-typespec-test (number type-spec expected-type-spec) - `(ert-deftest ,(intern (concat "comp-cstr-test-" (int-to-string number))) () - (should (equal (comp-cstr-test-ts ',type-spec) - ',expected-type-spec)))) - - (defconst comp-cstr-typespec-tests-alist - '(;; 1 - (symbol . symbol) - ;; 2 - ((or string array) . array) - ;; 3 - ((or symbol number) . (or number symbol)) - ;; 4 - ((or cons atom) . t) ;; SBCL return T - ;; 5 - ((or integer number) . number) - ;; 6 - ((or (or integer symbol) number) . (or number symbol)) - ;; 7 - ((or (or integer symbol) (or number list)) . (or list number symbol)) - ;; 8 - ((or (or integer number) nil) . number) - ;; 9 - ((member foo) . (member foo)) - ;; 10 - ((member foo bar) . (member bar foo)) - ;; 11 - ((or (member foo) (member bar)) . (member bar foo)) - ;; 12 - ((or (member foo) symbol) . symbol) ;; SBCL return (OR SYMBOL (MEMBER FOO)) - ;; 13 - ((or (member foo) number) . (or (member foo) number)) - ;; 14 - ((or (integer 1 3) number) . number) - ;; 15 - (integer . integer) - ;; 16 - ((integer 1 2) . (integer 1 2)) - ;; 17 - ((or (integer -1 0) (integer 3 4)) . (or (integer -1 0) (integer 3 4))) - ;; 18 - ((or (integer -1 2) (integer 3 4)) . (integer -1 4)) - ;; 19 - ((or (integer -1 3) (integer 3 4)) . (integer -1 4)) - ;; 20 - ((or (integer -1 4) (integer 3 4)) . (integer -1 4)) - ;; 21 - ((or (integer -1 5) (integer 3 4)) . (integer -1 5)) - ;; 22 - ((or (integer -1 *) (integer 3 4)) . (integer -1 *)) - ;; 23 - ((or (integer -1 2) (integer * 4)) . (integer * 4)) - ;; 24 - ((and string array) . string) - ;; 25 - ((and cons atom) . nil) - ;; 26 - ((and (member foo) (member foo bar baz)) . (member foo)) - ;; 27 - ((and (member foo) (member bar)) . nil) - ;; 28 - ((and (member foo) symbol) . (member foo)) - ;; 29 - ((and (member foo) string) . nil) - ;; 30 - ((and (member foo) (integer 1 2)) . nil) - ;; 31 - ((and (member 1 2) (member 3 2)) . (integer 2 2)) - ;; 32 - ((and number (integer 1 2)) . (integer 1 2)) - ;; 33 - ((and integer (integer 1 2)) . (integer 1 2)) - ;; 34 - ((and (integer -1 0) (integer 3 5)) . nil) - ;; 35 - ((and (integer -1 2) (integer 3 5)) . nil) - ;; 36 - ((and (integer -1 3) (integer 3 5)) . (integer 3 3)) - ;; 37 - ((and (integer -1 4) (integer 3 5)) . (integer 3 4)) - ;; 38 - ((and (integer -1 5) nil) . nil) - ;; 39 - ((not symbol) . (not symbol)) - ;; 40 - ((or (member foo) (not (member foo bar))) . (not (member bar))) - ;; 41 - ((or (member foo bar) (not (member foo))) . t) - ;; 42 - ((or symbol (not sequence)) . (not sequence)) - ;; 43 - ((or symbol (not symbol)) . t) - ;; 44 - ((or symbol (not sequence)) . (not sequence)) - ;; 45 Conservative. - ((or vector (not sequence)) . t) - ;; 46 - ((or (integer 1 10) (not (integer * 5))) . (not (integer * 0))) - ;; 47 - ((or symbol (integer 1 10) (not (integer * 5))) . (not (integer * 0))) - ;; 48 - ((or (not symbol) (integer 1 10) (not (integer * 5))) . (not (or symbol (integer * 0)))) - ;; 49 - ((or symbol (not (member foo))) . (not (member foo))) - ;; 50 - ((or (not symbol) (not (member foo))) . (not symbol)) - ;; 51 Conservative. - ((or (not (member foo)) string) . (not (member foo))) - ;; 52 Conservative. - ((or (member foo) (not string)) . (not string)) - ;; 53 - ((or (not (integer 1 2)) integer) . t) - ;; 54 - ((or (not (integer 1 2)) (not integer)) . (not integer)) - ;; 55 - ((or (integer 1 2) (not integer)) . (not (or (integer * 0) (integer 3 *)))) - ;; 56 - ((or number (not (integer 1 2))) . t) - ;; 57 - ((or atom (not (integer 1 2))) . t) - ;; 58 - ((or atom (not (member foo))) . t) - ;; 59 - ((and symbol (not cons)) . symbol) - ;; 60 - ((and symbol (not symbol)) . nil) - ;; 61 - ((and atom (not symbol)) . atom) - ;; 62 - ((and atom (not string)) . (or array sequence atom)) - ;; 63 Conservative - ((and symbol (not (member foo))) . symbol) - ;; 64 Conservative - ((and symbol (not (member 3))) . symbol) - ;; 65 - ((and (not (member foo)) (integer 1 10)) . (integer 1 10)) - ;; 66 - ((and (member foo) (not (integer 1 10))) . (member foo)) - ;; 67 - ((and t (not (member foo))) . (not (member foo))) - ;; 68 - ((and integer (not (integer 3 4))) . (or (integer * 2) (integer 5 *))) - ;; 69 - ((and (integer 0 20) (not (integer 5 10))) . (or (integer 0 4) (integer 11 20))) - ;; 70 - ((and (not (member a)) (not (member b))) . (not (member a b))) - ;; 71 - ((and (not boolean) (not (member b))) . (not (or (member b) boolean))) - ;; 72 - ((and t (integer 1 1)) . (integer 1 1)) - ;; 73 - ((not (integer -1 5)) . (not (integer -1 5))) - ;; 74 - ((and boolean (or number marker)) . nil) - ;; 75 - ((and atom (or number marker)) . number-or-marker) - ;; 76 - ((and symbol (or number marker)) . nil) - ;; 77 - ((and (or symbol string) (or number marker)) . nil) - ;; 78 - ((and t t) . t) - ;; 79 - ((and (or marker number) (integer 0 0)) . (integer 0 0)) - ;; 80 - ((and t (not t)) . nil) - ;; 81 - ((or (integer 1 1) (not (integer 1 1))) . t) - ;; 82 - ((not t) . nil) - ;; 83 - ((not nil) . t) - ;; 84 - ((or (not string) t) . t) - ;; 85 - ((or (not vector) sequence) . sequence) - ;; 86 - ((or (not symbol) null) . t) - ;; 87 - ((and (or null integer) (not (or null integer))) . nil) - ;; 88 - ((and (or (member a b c)) (not (or (member a b)))) . (member c)) - ;; 89 - ((or cons symbol) . (or list symbol)) ;; FIXME: Why `list'? - ;; 90 - ((or string char-table bool-vector vector) . array) - ;; 91 - ((or string char-table bool-vector vector number) . (or array number)) - ;; 92 - ((or string char-table bool-vector vector cons symbol number) . - (or number sequence symbol)) - ;; 93? - ;; FIXME: I get `cons' rather than `list'? - ;;((or null cons) . list) - ) - "Alist type specifier -> expected type specifier.")) - -(defmacro comp-cstr-synthesize-tests () - "Generate all tests from `comp-cstr-typespec-tests-alist'." +(defun comp-cstr-test-ts (type-spec) + "Create a constraint from TYPE-SPEC and convert it back to type specifier." + (let ((comp-ctxt (make-comp-cstr-ctxt))) + (comp-cstr-to-type-spec (comp-type-spec-to-cstr type-spec)))) + +(defmacro comp-cstr-synthesize-tests (typespec-tests-alist) + "Generate all tests from TYPESPEC-TESTS-ALIST. +The arg is an alist of: type specifier -> expected type specifier." `(progn ,@(cl-loop for i from 1 - for (ts . exp-ts) in comp-cstr-typespec-tests-alist - append (list (comp-cstr-typespec-test i ts exp-ts))))) - -(comp-cstr-synthesize-tests) + for (type-spec . expected-type-spec) in typespec-tests-alist + collect + `(ert-deftest ,(intern (format "comp-cstr-test-%d" i)) () + (should (equal (comp-cstr-test-ts ',type-spec) + ',expected-type-spec)))))) + +(comp-cstr-synthesize-tests + (;; 1 + (symbol . symbol) + ;; 2 + ((or string array) . array) + ;; 3 + ((or symbol number) . (or number symbol)) + ;; 4 + ((or cons atom) . t) ;; Like SBCL + ;; 5 + ((or integer number) . number) + ;; 6 + ((or (or integer symbol) number) . (or number symbol)) + ;; 7 + ((or (or integer symbol) (or number list)) . (or list number symbol)) + ;; 8 + ((or (or integer number) nil) . number) + ;; 9 + ((member foo) . (member foo)) + ;; 10 + ((member foo bar) . (member bar foo)) + ;; 11 + ((or (member foo) (member bar)) . (member bar foo)) + ;; 12 + ((or (member foo) symbol) . symbol) ;; SBCL return (OR SYMBOL (MEMBER FOO)) + ;; 13 + ((or (member foo) number) . (or (member foo) number)) + ;; 14 + ((or (integer 1 3) number) . number) + ;; 15 + (integer . integer) + ;; 16 + ((integer 1 2) . (integer 1 2)) + ;; 17 + ((or (integer -1 0) (integer 3 4)) . (or (integer -1 0) (integer 3 4))) + ;; 18 + ((or (integer -1 2) (integer 3 4)) . (integer -1 4)) + ;; 19 + ((or (integer -1 3) (integer 3 4)) . (integer -1 4)) + ;; 20 + ((or (integer -1 4) (integer 3 4)) . (integer -1 4)) + ;; 21 + ((or (integer -1 5) (integer 3 4)) . (integer -1 5)) + ;; 22 + ((or (integer -1 *) (integer 3 4)) . (integer -1 *)) + ;; 23 + ((or (integer -1 2) (integer * 4)) . (integer * 4)) + ;; 24 + ((and string array) . string) + ;; 25 + ((and cons atom) . nil) + ;; 26 + ((and (member foo) (member foo bar baz)) . (member foo)) + ;; 27 + ((and (member foo) (member bar)) . nil) + ;; 28 + ((and (member foo) symbol) . (member foo)) + ;; 29 + ((and (member foo) string) . nil) + ;; 30 + ((and (member foo) (integer 1 2)) . nil) + ;; 31 + ((and (member 1 2) (member 3 2)) . (integer 2 2)) + ;; 32 + ((and number (integer 1 2)) . (integer 1 2)) + ;; 33 + ((and integer (integer 1 2)) . (integer 1 2)) + ;; 34 + ((and (integer -1 0) (integer 3 5)) . nil) + ;; 35 + ((and (integer -1 2) (integer 3 5)) . nil) + ;; 36 + ((and (integer -1 3) (integer 3 5)) . (integer 3 3)) + ;; 37 + ((and (integer -1 4) (integer 3 5)) . (integer 3 4)) + ;; 38 + ((and (integer -1 5) nil) . nil) + ;; 39 + ((not symbol) . (not symbol)) + ;; 40 + ((or (member foo) (not (member foo bar))) . (not (member bar))) + ;; 41 + ((or (member foo bar) (not (member foo))) . t) + ;; 42 + ((or symbol (not sequence)) . (not sequence)) + ;; 43 + ((or symbol (not symbol)) . t) + ;; 44 + ((or symbol (not sequence)) . (not sequence)) + ;; 45 Conservative. + ((or vector (not sequence)) . t) + ;; 46 + ((or (integer 1 10) (not (integer * 5))) . (not (integer * 0))) + ;; 47 + ((or symbol (integer 1 10) (not (integer * 5))) . (not (integer * 0))) + ;; 48 + ((or (not symbol) (integer 1 10) (not (integer * 5))) . (not (or symbol (integer * 0)))) + ;; 49 + ((or symbol (not (member foo))) . (not (member foo))) + ;; 50 + ((or (not symbol) (not (member foo))) . (not symbol)) + ;; 51 Conservative. + ((or (not (member foo)) string) . (not (member foo))) + ;; 52 Conservative. + ((or (member foo) (not string)) . (not string)) + ;; 53 + ((or (not (integer 1 2)) integer) . t) + ;; 54 + ((or (not (integer 1 2)) (not integer)) . (not integer)) + ;; 55 + ((or (integer 1 2) (not integer)) . (not (or (integer * 0) (integer 3 *)))) + ;; 56 + ((or number (not (integer 1 2))) . t) + ;; 57 + ((or atom (not (integer 1 2))) . t) + ;; 58 + ((or atom (not (member foo))) . t) + ;; 59 + ((and symbol (not cons)) . symbol) + ;; 60 + ((and symbol (not symbol)) . nil) + ;; 61 + ((and atom (not symbol)) . atom) + ;; 62 + ((and atom (not string)) . (or array sequence atom)) + ;; 63 Conservative + ((and symbol (not (member foo))) . symbol) + ;; 64 Conservative + ((and symbol (not (member 3))) . symbol) + ;; 65 + ((and (not (member foo)) (integer 1 10)) . (integer 1 10)) + ;; 66 + ((and (member foo) (not (integer 1 10))) . (member foo)) + ;; 67 + ((and t (not (member foo))) . (not (member foo))) + ;; 68 + ((and integer (not (integer 3 4))) . (or (integer * 2) (integer 5 *))) + ;; 69 + ((and (integer 0 20) (not (integer 5 10))) . (or (integer 0 4) (integer 11 20))) + ;; 70 + ((and (not (member a)) (not (member b))) . (not (member a b))) + ;; 71 + ((and (not boolean) (not (member b))) . (not (or (member b) boolean))) + ;; 72 + ((and t (integer 1 1)) . (integer 1 1)) + ;; 73 + ((not (integer -1 5)) . (not (integer -1 5))) + ;; 74 + ((and boolean (or number marker)) . nil) + ;; 75 + ((and atom (or number marker)) . number-or-marker) + ;; 76 + ((and symbol (or number marker)) . nil) + ;; 77 + ((and (or symbol string) (or number marker)) . nil) + ;; 78 + ((and t t) . t) + ;; 79 + ((and (or marker number) (integer 0 0)) . (integer 0 0)) + ;; 80 + ((and t (not t)) . nil) + ;; 81 + ((or (integer 1 1) (not (integer 1 1))) . t) + ;; 82 + ((not t) . nil) + ;; 83 + ((not nil) . t) + ;; 84 + ((or (not string) t) . t) + ;; 85 + ((or (not vector) sequence) . sequence) + ;; 86 + ((or (not symbol) null) . t) + ;; 87 + ((and (or null integer) (not (or null integer))) . nil) + ;; 88 + ((and (or (member a b c)) (not (or (member a b)))) . (member c)) + ;; 89 + ((or cons symbol) . (or list symbol)) ;; FIXME: Why `list'? + ;; 90 + ((or string char-table bool-vector vector) . array) + ;; 91 + ((or string char-table bool-vector vector number) . (or array number)) + ;; 92 + ((or string char-table bool-vector vector cons symbol number) . + (or number sequence symbol)) + ;; 93? + ;; FIXME: I get `cons' rather than `list'? + ;;((or null cons) . list) + )) ;;; comp-cstr-tests.el ends here -- cgit v1.2.3 From a33f3947ea1ba429570e2ecb4c3167341dcae1a2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 18 Jan 2024 14:05:16 -0500 Subject: * lisp/progmodes/elisp-mode.el (elisp-completion-at-point): Fix bug#68514 Redo the commit 0db2126d7176 to try and avoid selecting more than a mere symbol. --- lisp/progmodes/elisp-mode.el | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 00910fb67c7..da0cb96e1cf 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -657,12 +657,13 @@ functions are annotated with \"\" via the (save-excursion (backward-sexp 1) (skip-chars-forward "`',‘#") - (point)) + (min (point) pos)) (scan-error pos))) (end - (unless (or (eq beg (point-max)) - (member (char-syntax (char-after beg)) - '(?\" ?\())) + (cond + ((and (< beg (point-max)) + (memq (char-syntax (char-after beg)) + '(?w ?\\ ?_))) (condition-case nil (save-excursion (goto-char beg) @@ -670,7 +671,11 @@ functions are annotated with \"\" via the (skip-chars-backward "'’") (when (>= (point) pos) (point))) - (scan-error pos)))) + (scan-error pos))) + ((or (>= beg (point-max)) + (memq (char-syntax (char-after beg)) + '(?\) ?\s))) + beg))) ;; t if in function position. (funpos (eq (char-before beg) ?\()) (quoted (elisp--form-quoted-p beg)) -- cgit v1.2.3 From 81a2212bd52f68045b47d8be9345736655de6607 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 18 Jan 2024 18:28:54 -0500 Subject: * lisp/international/quail.el (quail-input-method): Fix bug#68338 --- lisp/international/quail.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 56f049aedf5..48d2ccb8828 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -1324,9 +1324,11 @@ If STR has `advice' text property, append the following special event: ;; binding in `universal-argument-map' just return ;; (list KEY), otherwise act as if there was no ;; overriding map. - (or (not (eq (cadr overriding-terminal-local-map) - universal-argument-map)) - (lookup-key overriding-terminal-local-map (vector key)))) + ;; We used to do that only for `universal-argument-map', + ;; but according to bug#68338 this should also apply to + ;; other transient maps. Let's hope it's OK to apply it + ;; to all `overriding-terminal-local-map's. + (lookup-key overriding-terminal-local-map (vector key))) overriding-local-map) (list key) (quail-setup-overlays (quail-conversion-keymap)) -- cgit v1.2.3 From 25734dd40c1833841dc6c4ddd4a210927e73b286 Mon Sep 17 00:00:00 2001 From: Arash Esbati Date: Fri, 19 Jan 2024 00:38:25 +0100 Subject: ; Delete pre-release remainder in NEWS.27 --- etc/NEWS.27 | 1 - 1 file changed, 1 deletion(-) diff --git a/etc/NEWS.27 b/etc/NEWS.27 index 2617e1a48f4..080568433c2 100644 --- a/etc/NEWS.27 +++ b/etc/NEWS.27 @@ -28,7 +28,6 @@ If set to a non-nil value which isn't a function, resize the mini frame using the new function 'fit-mini-frame-to-buffer' which won't skip leading or trailing empty lines of the buffer. -+++ ** Update IRC-related references to point to Libera.Chat. In June 2021, the Free Software Foundation and the GNU Project moved their official IRC channels from the Freenode network to Libera.Chat -- cgit v1.2.3 From 13c7933a9d4b26e74e7f5e19d70bb89003239c34 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 15 Jan 2024 05:53:24 -0800 Subject: Add test for erc-extract-command-from-line * lisp/erc/erc.el (erc-extract-command-from-line): Redo doc string. * test/lisp/erc/erc-tests.el (erc--parse-isupport-value): Add case for commonly seen escaped character ?=. (erc-extract-command-from-line): New test. ; * test/lisp/erc/resources/erc-d/resources/basic.eld: Update. ; Don't send unnegotiated multi-prefixed userhost names. ; * test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld: Update. ; * test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld: Update. ; * test/lisp/erc/resources/erc-d/resources/dynamic.eld: Update. ; * test/lisp/erc/resources/erc-d/resources/eof.eld: Update. ; * test/lisp/erc/resources/erc-d/resources/fuzzy.eld: Update. ; * test/lisp/erc/resources/erc-d/resources/incremental.eld: Update. ; * test/lisp/erc/resources/erc-d/resources/linger.eld: Update. ; * test/lisp/erc/resources/erc-d/resources/no-block.eld: Update. ; * test/lisp/erc/resources/erc-d/resources/no-match.eld: Update. ; * test/lisp/erc/resources/erc-d/resources/unexpected.eld: Update. --- lisp/erc/erc.el | 15 +++++-- test/lisp/erc/erc-tests.el | 48 ++++++++++++++++++++++ test/lisp/erc/resources/erc-d/resources/basic.eld | 5 +-- .../resources/erc-d/resources/dynamic-barnet.eld | 2 +- .../resources/erc-d/resources/dynamic-foonet.eld | 2 +- .../lisp/erc/resources/erc-d/resources/dynamic.eld | 5 +-- test/lisp/erc/resources/erc-d/resources/eof.eld | 5 +-- test/lisp/erc/resources/erc-d/resources/fuzzy.eld | 4 +- .../erc/resources/erc-d/resources/incremental.eld | 5 +-- test/lisp/erc/resources/erc-d/resources/linger.eld | 5 +-- .../erc/resources/erc-d/resources/no-block.eld | 7 ++-- .../erc/resources/erc-d/resources/no-match.eld | 5 +-- .../erc/resources/erc-d/resources/unexpected.eld | 5 +-- 13 files changed, 81 insertions(+), 32 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 478683a77f5..6332a8f6763 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7973,9 +7973,18 @@ as outgoing chat messages and echoed slash commands." (when (fboundp cmd) cmd))) (defun erc-extract-command-from-line (line) - "Extract command and args from the input LINE. -If no command was given, return nil. If command matches, return a -list of the form: (command args) where both elements are strings." + "Extract a \"slash command\" and its args from a prompt-input LINE. +If LINE doesn't start with a slash command, return nil. If it +does, meaning the pattern `erc-command-regexp' matches, return a +list of the form (COMMAND ARGS), where COMMAND is either a symbol +for a known handler function or `erc-cmd-default' if unknown. +When COMMAND has the symbol property `do-not-parse-args', return +a string in place of ARGS: that is, either LINE itself, when LINE +consists of only whitespace, or LINE stripped of any trailing +whitespace, including a final newline. When COMMAND lacks the +symbol property `do-not-parse-args', return a possibly empty list +of non-whitespace tokens. Do not perform any shell-style parsing +of quoted or escaped substrings." (when (string-match erc-command-regexp line) (let* ((cmd (erc-command-symbol (match-string 1 line))) ;; note: return is nil, we apply this simply for side effects diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b3912cab33d..e3e20b7ba8f 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -969,6 +969,7 @@ (should (equal (erc--parse-isupport-value "\\x20\\x20\\x20") '(" "))) (should (equal (erc--parse-isupport-value "\\x5Co/") '("\\o/"))) (should (equal (erc--parse-isupport-value "\\x7F,\\x19") '("\\x7F" "\\x19"))) + (should (equal (erc--parse-isupport-value "a\\x3Db") '("a=b"))) (should (equal (erc--parse-isupport-value "a\\x2Cb,c") '("a,b" "c")))) (ert-deftest erc--get-isupport-entry () @@ -1663,6 +1664,53 @@ (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b"))))) (should-not erc-ask-about-multiline-input))) +(ert-deftest erc-extract-command-from-line () + ;; FIXME when next modifying `erc-command-regexp's default value, + ;; move the single quote in the first group's character alternative + ;; to the front, i.e., [A-Za-z'] -> ['A-Za-z], so we can assert + ;; equivalence with this more readable `rx' form. + (rx bol + "/" + (group (+ (in "'A-Za-z"))) + (group (| (: (+ (syntax whitespace)) (* nonl)) + (* (syntax whitespace)))) + eol) + (erc-mode) ; for `erc-mode-syntax-table' + + ;; Non-command. + (should-not (erc-extract-command-from-line "FAKE\n")) + ;; Unknown command. + (should (equal (erc-extract-command-from-line "/FAKE\n") + '(erc-cmd-default "/FAKE\n"))) + + (ert-info ("With `do-not-parse-args'") + (should (equal (erc-extract-command-from-line "/MSG\n") + '(erc-cmd-MSG "\n"))) + (should (equal (erc-extract-command-from-line "/MSG \n") + '(erc-cmd-MSG " \n"))) + (should (equal (erc-extract-command-from-line "/MSG \n\n") + '(erc-cmd-MSG " \n\n"))) + (should (equal (erc-extract-command-from-line "/MSG foo\n") + '(erc-cmd-MSG " foo"))) + (should (equal (erc-extract-command-from-line "/MSG foo\n\n") + '(erc-cmd-MSG " foo"))) + (should (equal (erc-extract-command-from-line "/MSG foo\n \n") + '(erc-cmd-MSG " foo"))) + (should (equal (erc-extract-command-from-line "/MSG foo\n") + '(erc-cmd-MSG " foo")))) + + (ert-info ("Without `do-not-parse-args'") + (should (equal (erc-extract-command-from-line "/HELP\n") + '(erc-cmd-HELP nil))) + (should (equal (erc-extract-command-from-line "/HELP \n") + '(erc-cmd-HELP nil))) + (should (equal (erc-extract-command-from-line "/HELP foo\n") + '(erc-cmd-HELP ("foo")))) + (should (equal (erc-extract-command-from-line "/HELP foo\n") + '(erc-cmd-HELP ("foo")))) + (should (equal (erc-extract-command-from-line "/HELP foo bar\n") + '(erc-cmd-HELP ("foo" "bar")))))) + ;; The point of this test is to ensure output is handled identically ;; regardless of whether a command handler is summoned. diff --git a/test/lisp/erc/resources/erc-d/resources/basic.eld b/test/lisp/erc/resources/erc-d/resources/basic.eld index a020eec3fff..80e46d9a279 100644 --- a/test/lisp/erc/resources/erc-d/resources/basic.eld +++ b/test/lisp/erc/resources/erc-d/resources/basic.eld @@ -8,8 +8,7 @@ (0 ":irc.example.org 002 tester :Your host is irc.example.org") (0 ":irc.example.org 003 tester :This server was created just now") (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv") - (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)") ;; Just to mix thing's up (force handler to schedule timer) (0.1 ":irc.example.org 252 tester 0 :IRC Operators online") @@ -24,7 +23,7 @@ (0 ":irc.example.org 221 tester +Zi") (0 ":irc.example.org 306 tester :You have been marked as being away") (0 ":tester!~tester@localhost JOIN #chan") - (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.example.org 353 alice = #chan :+alice @bob") (0 ":irc.example.org 366 alice #chan :End of NAMES list")) ;; Some comment (to prevent regression) diff --git a/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld b/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld index e8feb2e6fd8..47be0722115 100644 --- a/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld +++ b/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld @@ -22,7 +22,7 @@ (0. ":irc.barnet.org 221 tester +Zi") (0. ":irc.barnet.org 306 tester :You have been marked as being away") (0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan") - (0 ":irc.barnet.org 353 joe = #chan :+joe!~joe@example.com @%+mike!~mike@example.org") + (0 ":irc.barnet.org 353 joe = #chan :+joe @mike") (0 ":irc.barnet.org 366 joe #chan :End of NAMES list")) ((mode 3 "MODE #chan") diff --git a/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld b/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld index 2db750e49da..5d5f8ed18a8 100644 --- a/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld +++ b/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld @@ -21,7 +21,7 @@ (0. ":irc.foonet.org 221 tester +Zi") (0. ":irc.foonet.org 306 tester :You have been marked as being away") (0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan") - (0 ":irc.foonet.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.foonet.org 353 alice = #chan :+alice @bob") (0 ":irc.foonet.org 366 alice #chan :End of NAMES list")) ((mode 3 "MODE #chan") diff --git a/test/lisp/erc/resources/erc-d/resources/dynamic.eld b/test/lisp/erc/resources/erc-d/resources/dynamic.eld index 459b6e52bfe..64d8c091ad7 100644 --- a/test/lisp/erc/resources/erc-d/resources/dynamic.eld +++ b/test/lisp/erc/resources/erc-d/resources/dynamic.eld @@ -7,8 +7,7 @@ (0.0 ":" dom " 002 " nick " :Your host is " dom) (0.0 ":" dom " 003 " nick " :This server was created just now") (0.0 ":" dom " 004 " nick " " dom " BERios CEIRabehiklmnoqstv Iabehkloqv") - (0.0 ":" dom " 005 " nick " MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0.0 ":" dom " 005 " nick " MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0.0 ":" dom " 251 " nick " :There are 3 users and 0 invisible on 1 server(s)") (0.0 ":" dom " 252 " nick " 0 :IRC Operators online") (0.0 ":" dom " 253 " nick " 0 :unregistered connections") @@ -23,7 +22,7 @@ (0.0 ":" dom " 306 " nick " :You have been marked as being away") (0.0 ":" nick "!~" nick "@localhost JOIN #chan") - (0.0 ":" dom " 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0.0 ":" dom " 353 alice = #chan :+alice @bob") (0.0 ":" dom " 366 alice #chan :End of NAMES list")) ((mode 2.2 "MODE #chan") diff --git a/test/lisp/erc/resources/erc-d/resources/eof.eld b/test/lisp/erc/resources/erc-d/resources/eof.eld index 5da84b2e74f..db39b3d4af1 100644 --- a/test/lisp/erc/resources/erc-d/resources/eof.eld +++ b/test/lisp/erc/resources/erc-d/resources/eof.eld @@ -8,8 +8,7 @@ (0 ":irc.example.org 002 tester :Your host is irc.example.org") (0 ":irc.example.org 003 tester :This server was created just now") (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv") - (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)") ;; Just to mix thing's up (force handler to schedule timer) (0.1 ":irc.example.org 252 tester 0 :IRC Operators online") @@ -24,7 +23,7 @@ (0 ":irc.example.org 221 tester +Zi") (0 ":irc.example.org 306 tester :You have been marked as being away") (0 ":tester!~tester@localhost JOIN #chan") - (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.example.org 353 alice = #chan :+alice @bob") (0 ":irc.example.org 366 alice #chan :End of NAMES list")) ((mode-chan 1.2 "MODE #chan") diff --git a/test/lisp/erc/resources/erc-d/resources/fuzzy.eld b/test/lisp/erc/resources/erc-d/resources/fuzzy.eld index 0504b6a6682..cf64004da0d 100644 --- a/test/lisp/erc/resources/erc-d/resources/fuzzy.eld +++ b/test/lisp/erc/resources/erc-d/resources/fuzzy.eld @@ -23,12 +23,12 @@ ((~join-foo 3.2 "JOIN #foo") (0 "@time=" now " :tester!~tester@localhost JOIN #foo") - (0 "@time=" now " :irc.example.org 353 alice = #foo :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 "@time=" now " :irc.example.org 353 alice = #foo :+alice @bob") (0 "@time=" now " :irc.example.org 366 alice #foo :End of NAMES list")) ((~join-bar 1.2 "JOIN #bar") (0 "@time=" now " :tester!~tester@localhost JOIN #bar") - (0 "@time=" now " :irc.example.org 353 alice = #bar :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 "@time=" now " :irc.example.org 353 alice = #bar :+alice @bob") (0 "@time=" now " :irc.example.org 366 alice #bar :End of NAMES list")) ((~mode-foo 3.2 "MODE #foo") diff --git a/test/lisp/erc/resources/erc-d/resources/incremental.eld b/test/lisp/erc/resources/erc-d/resources/incremental.eld index a1b48495ec3..7d192a53066 100644 --- a/test/lisp/erc/resources/erc-d/resources/incremental.eld +++ b/test/lisp/erc/resources/erc-d/resources/incremental.eld @@ -7,8 +7,7 @@ (0.0 ":irc.foo.net 002 tester :Your host is irc.foo.net") (0.0 ":irc.foo.net 003 tester :This server was created just now") (0.0 ":irc.foo.net 004 tester irc.foo.net BERios CEIRabehiklmnoqstv Iabehkloqv") - (0.0 ":irc.foo.net 005 tester MODES NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0.0 ":irc.foo.net 005 tester MODES NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0.0 ":irc.foo.net 251 tester :There are 3 users and 0 invisible on 1 server(s)") (0.0 ":irc.foo.net 252 tester 0 :IRC Operators online") (0.0 ":irc.foo.net 253 tester 0 :unregistered connections") @@ -24,7 +23,7 @@ ((join 3 "JOIN #foo") (0 ":tester!~tester@localhost JOIN #foo") - (0 ":irc.foo.net 353 alice = #foo :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.foo.net 353 alice = #foo :+alice @bob") (0 ":irc.foo.net 366 alice #foo :End of NAMES list")) ((mode 3 "MODE #foo") diff --git a/test/lisp/erc/resources/erc-d/resources/linger.eld b/test/lisp/erc/resources/erc-d/resources/linger.eld index e456370a800..d68da730581 100644 --- a/test/lisp/erc/resources/erc-d/resources/linger.eld +++ b/test/lisp/erc/resources/erc-d/resources/linger.eld @@ -8,8 +8,7 @@ (0 ":irc.example.org 002 tester :Your host is irc.example.org") (0 ":irc.example.org 003 tester :This server was created just now") (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv") - (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)") ;; Just to mix thing's up (force handler to schedule timer) (0.1 ":irc.example.org 252 tester 0 :IRC Operators online") @@ -24,7 +23,7 @@ (0 ":irc.example.org 221 tester +Zi") (0 ":irc.example.org 306 tester :You have been marked as being away") (0 ":tester!~tester@localhost JOIN #chan") - (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.example.org 353 alice = #chan :+alice @bob") (0 ":irc.example.org 366 alice #chan :End of NAMES list")) ((mode-chan 2 "MODE #chan") diff --git a/test/lisp/erc/resources/erc-d/resources/no-block.eld b/test/lisp/erc/resources/erc-d/resources/no-block.eld index 2811923d8ac..af2f4a83ff6 100644 --- a/test/lisp/erc/resources/erc-d/resources/no-block.eld +++ b/test/lisp/erc/resources/erc-d/resources/no-block.eld @@ -7,8 +7,7 @@ (0.0 ":irc.org 002 tester :Your host is irc.org") (0.0 ":irc.org 003 tester :This server was created just now") (0.0 ":irc.org 004 tester irc.org BERios CEIRabehiklmnoqstv Iabehkloqv") - (0.0 ":irc.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0.0 ":irc.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0.0 ":irc.org 251 tester :There are 3 users and 0 invisible on 1 server(s)") (0.0 ":irc.org 252 tester 0 :IRC Operators online") (0.0 ":irc.org 253 tester 0 :unregistered connections") @@ -24,13 +23,13 @@ ((join-foo 1.2 "JOIN #foo") (0 ":tester!~tester@localhost JOIN #foo") - (0 ":irc.example.org 353 alice = #foo :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.example.org 353 alice = #foo :+alice @bob") (0 ":irc.example.org 366 alice #foo :End of NAMES list")) ;; This would time out if the mode-foo's outgoing blocked (remove minus signs to see) ((~join-bar 1.5 "JOIN #bar") (0 ":tester!~tester@localhost JOIN #bar") - (0 ":irc.example.org 353 alice = #bar :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.example.org 353 alice = #bar :+alice @bob") (0 ":irc.example.org 366 alice #bar :End of NAMES list")) ((mode-foo 1.2 "MODE #foo") diff --git a/test/lisp/erc/resources/erc-d/resources/no-match.eld b/test/lisp/erc/resources/erc-d/resources/no-match.eld index d147be1e084..d12854de551 100644 --- a/test/lisp/erc/resources/erc-d/resources/no-match.eld +++ b/test/lisp/erc/resources/erc-d/resources/no-match.eld @@ -8,8 +8,7 @@ (0 ":irc.example.org 002 tester :Your host is irc.example.org") (0 ":irc.example.org 003 tester :This server was created just now") (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv") - (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)") (0 ":irc.example.org 252 tester 0 :IRC Operators online") (0 ":irc.example.org 253 tester 0 :unregistered connections") @@ -25,7 +24,7 @@ ((join 1.2 "JOIN #chan") (0 ":tester!~tester@localhost JOIN #chan") - (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.example.org 353 alice = #chan :+alice @bob") (0 ":irc.example.org 366 alice #chan :End of NAMES list")) ((mode-chan 0.2 "MODE #chan") diff --git a/test/lisp/erc/resources/erc-d/resources/unexpected.eld b/test/lisp/erc/resources/erc-d/resources/unexpected.eld index ac0a8fecfa6..c03b1dbcfdb 100644 --- a/test/lisp/erc/resources/erc-d/resources/unexpected.eld +++ b/test/lisp/erc/resources/erc-d/resources/unexpected.eld @@ -7,8 +7,7 @@ (0.0 ":irc.example.org 002 tester :Your host is irc.example.org") (0.0 ":irc.example.org 003 tester :This server was created just now") (0.0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv") - (0.0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0.0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0.0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)") (0.0 ":irc.example.org 252 tester 0 :IRC Operators online") (0.0 ":irc.example.org 253 tester 0 :unregistered connections") @@ -23,6 +22,6 @@ (0.0 ":irc.example.org 306 tester :You have been marked as being away") (0.0 ":tester!~tester@localhost JOIN #chan") - (0.0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0.0 ":irc.example.org 353 alice = #chan :+alice @bob") (0.0 ":irc.example.org 366 alice #chan :End of NAMES list") (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey")) -- cgit v1.2.3 From dd2caf1a7634ea6fd8aebbdc45ea4caf22d786cd Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 14 Jan 2024 13:02:27 -0800 Subject: Redo doc strings for ERC's entry point commands * lisp/erc/erc.el: Bump Compat version in Package-Requires header to 29.1.4.4. (erc-select-read-args): Revise doc string, and update name of internal `--interactive-env--' entry-point parameter. (erc, erc-tls): Don't use `&interactive-env' as a variable name, in case it confuses persons or programs. Overhaul doc string in response to user complaints. For `erc' specifically, include literal `:keyword' symbols to help non-Emacs users understand the required syntax, which isn't obvious without an example, like `erc-tls' has, and with only "&key" and upcased metasynctatic variables to go by. (erc--current-buffer-joined-p): Remove assertion. * test/lisp/erc/erc-scenarios-keep-place-indicator.el (erc-scenarios-keep-place-indicator--follow): Try waiting for intermittently failing condition. * test/lisp/erc/erc-tests.el (erc-select-read-args): Update name of internal keyword variable. --- lisp/erc/erc.el | 117 +++++++++------------ .../lisp/erc/erc-scenarios-keep-place-indicator.el | 4 +- test/lisp/erc/erc-tests.el | 6 +- 3 files changed, 57 insertions(+), 70 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 6332a8f6763..767a693a52e 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -13,7 +13,7 @@ ;; Michael Olson (mwolson@gnu.org) ;; Kelvin White (kwhite@gnu.org) ;; Version: 5.6-git -;; Package-Requires: ((emacs "27.1") (compat "29.1.4.3")) +;; Package-Requires: ((emacs "27.1") (compat "29.1.4.4")) ;; Keywords: IRC, chat, client, Internet ;; URL: https://www.gnu.org/software/emacs/erc.html @@ -2637,8 +2637,11 @@ typically the same as that reported by `erc-current-nick'." ;;;###autoload (defun erc-select-read-args () - "Prompt the user for values of nick, server, port, and password. -With prefix arg, also prompt for user and full name." + "Prompt for connection parameters and return them in a plist. +By default, collect `:server', `:port', `:nickname', and +`:password'. With a non-nil prefix argument, also prompt for +`:user' and `:full-name'. Also return various environmental +properties needed by entry-point commands, like `erc-tls'." (let* ((input (let ((d (erc-compute-server))) (if erc--prompt-for-server-function (funcall erc--prompt-for-server-function) @@ -2692,7 +2695,7 @@ With prefix arg, also prompt for user and full name." (setq passwd nil)) `( :server ,server :port ,port :nick ,nick ,@(and user `(:user ,user)) ,@(and passwd `(:password ,passwd)) ,@(and full `(:full-name ,full)) - ,@(and env `(&interactive-env ,env))))) + ,@(and env `(--interactive-env-- ,env))))) (defmacro erc--with-entrypoint-environment (env &rest body) "Run BODY with bindings from ENV alist." @@ -2721,30 +2724,40 @@ With prefix arg, also prompt for user and full name." (full-name (erc-compute-full-name)) id ;; Used by interactive form - ((&interactive-env --interactive-env--))) - "ERC is a powerful, modular, and extensible IRC client. -This function is the main entry point for ERC. - -It allows selecting connection parameters, and then starts ERC. - -Non-interactively, it takes the keyword arguments - (server (erc-compute-server)) - (port (erc-compute-port)) - (nick (erc-compute-nick)) - (user (erc-compute-user)) - password - (full-name (erc-compute-full-name)) - id - -That is, if called with + ((--interactive-env-- --interactive-env--))) + "Connect to an Internet Relay Chat SERVER on a non-TLS PORT. +Use NICK and USER, when non-nil, to inform the IRC commands of +the same name, possibly factoring in a non-nil FULL-NAME as well. +When PASSWORD is non-nil, also send an opening server password +via the \"PASS\" command. Interactively, prompt for SERVER, +PORT, NICK, and PASSWORD, along with USER and FULL-NAME when +given a prefix argument. Non-interactively, expect the rarely +needed ID parameter, when non-nil, to be a symbol or a string for +naming the server buffer and identifying the connection +unequivocally. (See Info node `(erc) Connecting' for details +about all mentioned parameters.) + +Together with `erc-tls', this command serves as the main entry +point for ERC, the powerful, modular, and extensible IRC client. +Non-interactively, both commands accept the following keyword +arguments, with their defaults supplied by the indicated +\"compute\" functions: + + :server `erc-compute-server' + :port `erc-compute-port' + :nick `erc-compute-nick' + :user `erc-compute-user' + :password N/A + :full-name `erc-compute-full-name' + :id' N/A + +For example, when called in the following manner (erc :server \"irc.libera.chat\" :full-name \"J. Random Hacker\") -then the server and full-name will be set to those values, -whereas `erc-compute-port' and `erc-compute-nick' will be invoked -for the values of the other parameters. - -See `erc-tls' for the meaning of ID. +ERC assigns SERVER and FULL-NAME the associated keyword values +and defers to `erc-compute-port', `erc-compute-user', and +`erc-compute-nick' for those respective parameters. \(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME ID)" (interactive (let ((erc--display-context `((erc-interactive-display . erc) @@ -2770,51 +2783,26 @@ See `erc-tls' for the meaning of ID. client-certificate id ;; Used by interactive form - ((&interactive-env --interactive-env--))) - "ERC is a powerful, modular, and extensible IRC client. -This function is the main entry point for ERC over TLS. - -It allows selecting connection parameters, and then starts ERC -over TLS. - -Non-interactively, it takes the keyword arguments - (server (erc-compute-server)) - (port (erc-compute-port)) - (nick (erc-compute-nick)) - (user (erc-compute-user)) - password - (full-name (erc-compute-full-name)) - client-certificate - id - -That is, if called with - - (erc-tls :server \"irc.libera.chat\" :full-name \"J. Random Hacker\") - -then the server and full-name will be set to those values, -whereas `erc-compute-port' and `erc-compute-nick' will be invoked -for the values of their respective parameters. - -CLIENT-CERTIFICATE, if non-nil, should either be a list where the -first element is the certificate key file name, and the second -element is the certificate file name itself, or t, which means -that `auth-source' will be queried for the key and the -certificate. Authenticating using a TLS client certificate is -also referred to as \"CertFP\" (Certificate Fingerprint) -authentication by various IRC networks. - -Example usage: + ((--interactive-env-- --interactive-env--))) + "Connect to an IRC server over a TLS-encrypted connection. +Interactively, prompt for SERVER, PORT, NICK, and PASSWORD, along +with USER and FULL-NAME when given a prefix argument. +Non-interactively, also accept a CLIENT-CERTIFICATE, which should +be a list containing the file name of the certificate's key +followed by that of the certificate itself. Alternatively, +accept a value of t instead of a list, to tell ERC to query +`auth-source' for the certificate's details. + +Example client certificate (CertFP) usage: (erc-tls :server \"irc.libera.chat\" :port 6697 :client-certificate \\='(\"/home/bandali/my-cert.key\" \"/home/bandali/my-cert.crt\")) -When present, ID should be a symbol or a string to use for naming -the server buffer and identifying the connection unequivocally. -See Info node `(erc) Network Identifier' for details. Like -CLIENT-CERTIFICATE, this parameter cannot be specified -interactively. +See the alternative entry-point command `erc' as well as Info +node `(erc) Connecting' for a fuller description of the various +parameters, like ID. \(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME CLIENT-CERTIFICATE ID)" (interactive @@ -8055,7 +8043,6 @@ See also `erc-downcase'." (defun erc--current-buffer-joined-p () "Return non-nil if the current buffer is a channel and is joined." - (cl-assert erc--target) (and (erc--target-channel-p erc--target) (erc--target-channel-joined-p erc--target) t)) diff --git a/test/lisp/erc/erc-scenarios-keep-place-indicator.el b/test/lisp/erc/erc-scenarios-keep-place-indicator.el index b8ff59f4e02..572045cf0bc 100644 --- a/test/lisp/erc/erc-scenarios-keep-place-indicator.el +++ b/test/lisp/erc/erc-scenarios-keep-place-indicator.el @@ -85,8 +85,8 @@ (goto-char (window-point)) (should (looking-back (rx " tester, welcome!"))) (should (= (pos-bol) (window-start))) - (should (= (overlay-start erc--keep-place-indicator-overlay) - (pos-bol)))) + (erc-d-t-wait-for 20 + (= (overlay-start erc--keep-place-indicator-overlay) (pos-bol)))) ;; Lower window is still centered at start. (other-window 1) (switch-to-buffer "#chan") diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index e3e20b7ba8f..49c72836a22 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -2707,7 +2707,7 @@ (list :server "irc.libera.chat" :port 6697 :nick (user-login-name) - '&interactive-env + '--interactive-env-- '((erc-server-connect-function . erc-open-tls-stream) (erc-join-buffer . window)))))) @@ -2717,7 +2717,7 @@ (list :server "irc.gnu.org" :port 6697 :nick (user-login-name) - '&interactive-env + '--interactive-env-- '((erc-server-connect-function . erc-open-tls-stream) (erc-join-buffer . window)))))) @@ -2728,7 +2728,7 @@ (list :server "irc.gnu.org" :port 6697 :nick (user-login-name) - '&interactive-env + '--interactive-env-- '((erc-server-connect-function . erc-open-tls-stream) (erc--display-context -- cgit v1.2.3 From 409bb8eb24320f5c9924596841cc81e389617e29 Mon Sep 17 00:00:00 2001 From: Manuel Giraud Date: Fri, 19 Jan 2024 10:55:32 +0100 Subject: ; * doc/misc/gnus.texi (Scoring): Typo (bug#68581). --- doc/misc/gnus.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index efbcb5b1294..a862b7afad0 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -19802,7 +19802,7 @@ locally stored articles. @chapter Scoring @cindex scoring -Other people use @dfn{kill files} (@pxref{Kill Files}, but we here at +Other people use @dfn{kill files} (@pxref{Kill Files}), but we here at Gnus Towers like scoring better than killing, so we'd rather switch than fight. Scoring and score files processing are more powerful and faster than processing of kill files. Scoring also does something -- cgit v1.2.3 From bd5bfc29137b6e452e1900a1fc3cf09e77959133 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 19 Jan 2024 20:51:24 +0800 Subject: Fix another cause of superfluous inotify signals on Android * src/android.c (android_select): If the event queue isn't empty upon the initial check, clear all fdsets. --- src/android.c | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/src/android.c b/src/android.c index 757f256c188..fb7703d84ab 100644 --- a/src/android.c +++ b/src/android.c @@ -744,6 +744,19 @@ android_select (int nfds, fd_set *readfds, fd_set *writefds, if (event_queue.num_events) { + /* Zero READFDS, WRITEFDS and EXCEPTFDS, lest the caller + mistakenly interpret this return value as indicating that an + inotify file descriptor is readable, and try to poll an + unready one. */ + + if (readfds) + FD_ZERO (readfds); + + if (writefds) + FD_ZERO (writefds); + + if (exceptfds) + FD_ZERO (exceptfds); pthread_mutex_unlock (&event_queue.mutex); return 1; } -- cgit v1.2.3 From 6df731431ada23e7ca6b0d76bc91766ab3b8b534 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 19 Jan 2024 18:21:37 +0100 Subject: * doc/misc/gnus.texi (Summary Mail Commands): Fix command name. --- doc/misc/gnus.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index a862b7afad0..232bb9ded3b 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -5832,7 +5832,7 @@ message to the mailing list, and include the original message @kindex S v @r{(Summary)} @findex gnus-summary-very-wide-reply Mail a very wide reply to the author of the current article -(@code{gnus-summary-wide-reply}). A @dfn{very wide reply} is a reply +(@code{gnus-summary-very-wide-reply}). A @dfn{very wide reply} is a reply that goes out to all people listed in the @code{To}, @code{From} (or @code{Reply-To}) and @code{Cc} headers in all the process/prefixed articles. This command uses the process/prefix convention. -- cgit v1.2.3 From 1293aac0df4e2837a141818f225539ec847b6684 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 19 Jan 2024 15:02:50 -0500 Subject: trace.el: Make it usable in batch mode as well While at it, this fixes a bug where a traced function was not able to set `deactivate-mark`. * lisp/emacs-lisp/trace.el (trace--insert): New function, extracted from `trace-make-advice`. Output to stdout in batch mode. (trace--entry-message): Rename from `trace-entry-message`. Change calling convention. Do the insertion directly from here. (trace--exit-message): Rename from `trace-exit-message`. Change calling convention. Do the insertion directly from here. (trace-make-advice, trace-values): Simplify accordingly. --- lisp/emacs-lisp/trace.el | 118 +++++++++++++++++++++++------------------------ 1 file changed, 57 insertions(+), 61 deletions(-) diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el index 2c8b913ec33..29775e77716 100644 --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el @@ -156,45 +156,44 @@ (defun trace-values (&rest values) "Helper function to get internal values. You can call this function to add internal values in the trace buffer." - (unless inhibit-trace - (with-current-buffer (get-buffer-create trace-buffer) - (goto-char (point-max)) - (insert - (trace-entry-message - 'trace-values trace-level values ""))))) + (trace--entry-message + 'trace-values trace-level values (lambda () ""))) -(defun trace-entry-message (function level args context) +(defun trace--entry-message (function level args context) "Generate a string that describes that FUNCTION has been entered. -LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION, -and CONTEXT is a string describing the dynamic context (e.g. values of -some global variables)." - (let ((print-circle t) - (print-escape-newlines t)) - (format "%s%s%d -> %s%s\n" - (mapconcat #'char-to-string (make-string (max 0 (1- level)) ?|) " ") - (if (> level 1) " " "") - level - ;; FIXME: Make it so we can click the function name to jump to its - ;; definition and/or untrace it. - (cl-prin1-to-string (cons function args)) - context))) - -(defun trace-exit-message (function level value context) +LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION." + (unless inhibit-trace + (trace--insert + (let ((ctx (funcall context)) + (print-circle t) + (print-escape-newlines t)) + (format "%s%s%d -> %s%s\n" + (mapconcat #'char-to-string + (make-string (max 0 (1- level)) ?|) " ") + (if (> level 1) " " "") + level + ;; FIXME: Make it so we can click the function name to + ;; jump to its definition and/or untrace it. + (cl-prin1-to-string (cons function args)) + ctx))))) + +(defun trace--exit-message (function level value context) "Generate a string that describes that FUNCTION has exited. -LEVEL is the trace level, VALUE value returned by FUNCTION, -and CONTEXT is a string describing the dynamic context (e.g. values of -some global variables)." - (let ((print-circle t) - (print-escape-newlines t)) - (format "%s%s%d <- %s: %s%s\n" - (mapconcat 'char-to-string (make-string (1- level) ?|) " ") - (if (> level 1) " " "") - level - function - ;; Do this so we'll see strings: - (cl-prin1-to-string value) - context))) - +LEVEL is the trace level, VALUE value returned by FUNCTION." + (unless inhibit-trace + (trace--insert + (let ((ctx (funcall context)) + (print-circle t) + (print-escape-newlines t)) + (format "%s%s%d <- %s: %s%s\n" + (mapconcat 'char-to-string (make-string (1- level) ?|) " ") + (if (> level 1) " " "") + level + function + ;; Do this so we'll see strings: + (cl-prin1-to-string value) + ctx))))) + (defvar trace--timer nil) (defun trace--display-buffer (buf) @@ -208,43 +207,40 @@ some global variables)." (setq trace--timer nil) (display-buffer buf nil 0)))))) +(defun trace--insert (msg) + (if noninteractive + (message "%s" (if (eq ?\n (aref msg (1- (length msg)))) + (substring msg 0 -1) msg)) + (with-current-buffer trace-buffer + (setq-local window-point-insertion-type t) + (goto-char (point-max)) + (let ((deactivate-mark nil)) ;Protect deactivate-mark. + (insert msg))))) (defun trace-make-advice (function buffer background context) "Build the piece of advice to be added to trace FUNCTION. FUNCTION is the name of the traced function. BUFFER is the buffer where the trace should be printed. BACKGROUND if nil means to display BUFFER. -CONTEXT if non-nil should be a function that returns extra info that should -be printed along with the arguments in the trace." +CONTEXT should be a function that returns extra text that should +be printed after the arguments in the trace." (lambda (body &rest args) (let ((trace-level (1+ trace-level)) - (trace-buffer (get-buffer-create buffer)) - (deactivate-mark nil) ;Protect deactivate-mark. - (ctx (funcall context))) + (trace-buffer (get-buffer-create buffer))) + ;; Insert a separator from previous trace output: (unless inhibit-trace - (with-current-buffer trace-buffer - (setq-local window-point-insertion-type t) - (unless background (trace--display-buffer trace-buffer)) - (goto-char (point-max)) - ;; Insert a separator from previous trace output: - (if (= trace-level 1) (insert trace-separator)) - (insert - (trace-entry-message - function trace-level args ctx)))) + (unless background (trace--display-buffer trace-buffer)) + (if (= trace-level 1) (trace--insert trace-separator))) + (trace--entry-message + function trace-level args context) (let ((result)) (unwind-protect (setq result (list (apply body args))) - (unless inhibit-trace - (let ((ctx (funcall context))) - (with-current-buffer trace-buffer - (unless background (trace--display-buffer trace-buffer)) - (goto-char (point-max)) - (insert - (trace-exit-message - function - trace-level - (if result (car result) '\!non-local\ exit\!) - ctx)))))) + (trace--exit-message + function + trace-level + (if result (car result) '\!non-local\ exit\!) + context)) (car result))))) (defun trace-function-internal (function buffer background context) -- cgit v1.2.3 From a34b76cd663e39d9f5d30c4b0e49ba246fac0d63 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 19 Jan 2024 15:04:50 -0500 Subject: trace.el: Mention the last change in NEWS --- etc/NEWS | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 735a05f6579..967d8a94113 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -412,6 +412,10 @@ respectively, in addition to the existing translations 'C-x 8 / e' and * Changes in Specialized Modes and Packages in Emacs 30.1 +--- +** Trace +In batch mode, tracing now sends the trace to stdout. + +++ ** New command 'lldb'. Run the LLDB debugger, analogous to the 'gud-gdb' command. -- cgit v1.2.3 From b3e4fbe867f96a28c5dc9db19fcad2af5b4a4b7e Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 20 Jan 2024 09:30:04 +0800 Subject: Round projs computed executing IP/ISECT instructions and improve IUP * src/sfnt.c (sfnt_multiply_divide_rounded): New function. (sfnt_multiply_divide_signed): Always round values, as fonts which rely on IP to move points in concert with prior motion and subsequently round such points with MDAP are sensitive to minor deviations in the behavior of the former instruction. (load_unscaled): New macro. (IUP_SINGLE_PAIR, sfnt_interpret_iup_1): Compute ratio w/ unscaled points if possible. --- src/sfnt.c | 106 +++++++++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 75 insertions(+), 31 deletions(-) diff --git a/src/sfnt.c b/src/sfnt.c index ca4c60e8e3a..88826e1b2c1 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -3767,7 +3767,23 @@ sfnt_multiply_divide_2 (struct sfnt_large_integer *ab, return q; } -#endif +/* Add the specified unsigned 32-bit N to the large integer + INTEGER. */ + +static void +sfnt_large_integer_add (struct sfnt_large_integer *integer, + uint32_t n) +{ + struct sfnt_large_integer number; + + number.low = integer->low + n; + number.high = integer->high + (number.low + < integer->low); + + *integer = number; +} + +#endif /* !INT64_MAX */ /* Calculate (A * B) / C with no rounding and return the result, using a 64 bit integer if necessary. */ @@ -3780,32 +3796,37 @@ sfnt_multiply_divide (unsigned int a, unsigned int b, unsigned int c) sfnt_multiply_divide_1 (a, b, &temp); return sfnt_multiply_divide_2 (&temp, c); -#else +#else /* INT64_MAX */ uint64_t temp; temp = (uint64_t) a * (uint64_t) b; return temp / c; -#endif +#endif /* !INT64_MAX */ } -#ifndef INT64_MAX +/* Calculate (A * B) / C with rounding and return the result, using a + 64 bit integer if necessary. */ -/* Add the specified unsigned 32-bit N to the large integer - INTEGER. */ - -static void -sfnt_large_integer_add (struct sfnt_large_integer *integer, - uint32_t n) +static unsigned int +sfnt_multiply_divide_rounded (unsigned int a, unsigned int b, + unsigned int c) { - struct sfnt_large_integer number; +#ifndef INT64_MAX + struct sfnt_large_integer temp; - number.low = integer->low + n; - number.high = integer->high + (number.low - < integer->low); + sfnt_multiply_divide_1 (a, b, &temp); + sfnt_large_integer_add (&temp, c / 2); + return sfnt_multiply_divide_2 (&temp, c); +#else /* INT64_MAX */ + uint64_t temp; - *integer = number; + temp = (uint64_t) a * (uint64_t) b + c / 2; + return temp / c; +#endif /* !INT64_MAX */ } +#ifndef INT64_MAX + /* Calculate (A * B) / C, rounding the result with a threshold of N. Use a 64 bit temporary. */ @@ -3820,9 +3841,9 @@ sfnt_multiply_divide_round (unsigned int a, unsigned int b, return sfnt_multiply_divide_2 (&temp, c); } -#endif /* INT64_MAX */ +#endif /* !INT64_MAX */ -/* The same as sfnt_multiply_divide, but handle signed values +/* The same as sfnt_multiply_divide_rounded, but handle signed values instead. */ MAYBE_UNUSED static int @@ -3841,8 +3862,8 @@ sfnt_multiply_divide_signed (int a, int b, int c) if (c < 0) sign = -sign; - return (sfnt_multiply_divide (abs (a), abs (b), abs (c)) - * sign); + return (sfnt_multiply_divide_rounded (abs (a), abs (b), + abs (c)) * sign); } /* Multiply the two 16.16 fixed point numbers X and Y. Return the @@ -3858,7 +3879,7 @@ sfnt_mul_fixed (sfnt_fixed x, sfnt_fixed y) /* This can be done quickly with int64_t. */ return product / (int64_t) 65536; -#else +#else /* !INT64_MAX */ int sign; sign = 1; @@ -3871,7 +3892,7 @@ sfnt_mul_fixed (sfnt_fixed x, sfnt_fixed y) return sfnt_multiply_divide (abs (x), abs (y), 65536) * sign; -#endif +#endif /* INT64_MAX */ } /* Multiply the two 16.16 fixed point numbers X and Y, with rounding @@ -3888,7 +3909,7 @@ sfnt_mul_fixed_round (sfnt_fixed x, sfnt_fixed y) /* This can be done quickly with int64_t. */ return (product + round) / (int64_t) 65536; -#else +#else /* !INT64_MAX */ int sign; sign = 1; @@ -3901,7 +3922,7 @@ sfnt_mul_fixed_round (sfnt_fixed x, sfnt_fixed y) return sfnt_multiply_divide_round (abs (x), abs (y), 32768, 65536) * sign; -#endif +#endif /* INT64_MAX */ } /* Set the pen size to the specified point and return. POINT will be @@ -6542,7 +6563,7 @@ sfnt_mul_f26dot6_fixed (sfnt_f26dot6 x, sfnt_fixed y) sign = -sign; sfnt_multiply_divide_1 (abs (x), abs (y), &temp); - sfnt_large_integer_add (&temp, 32676); + sfnt_large_integer_add (&temp, 32768); return sfnt_multiply_divide_2 (&temp, 65536) * sign; #endif } @@ -11137,6 +11158,11 @@ sfnt_interpret_shp (struct sfnt_interpreter *interpreter, ? interpreter->glyph_zone->x_points[p] \ : interpreter->glyph_zone->y_points[p]) +#define load_unscaled(p) \ + (opcode == 0x31 \ + ? interpreter->glyph_zone->simple->x_coordinates[p] \ + : interpreter->glyph_zone->simple->y_coordinates[p]) + #define IUP_SINGLE_PAIR() \ /* Now make touch_start the first point before, i.e. the first \ touched point in this pair. */ \ @@ -11186,23 +11212,40 @@ sfnt_interpret_shp (struct sfnt_interpreter *interpreter, if (position >= original_min_pos \ && position <= original_max_pos) \ { \ + /* Compute the ratio between the two touched point positions \ + and the original position of the point being touched with \ + positions from the unscaled outline, if at all \ + possible. */ \ + \ + if (interpreter->glyph_zone->simple) \ + { \ + org_max_pos = load_unscaled (point_max); \ + org_min_pos = load_unscaled (point_min); \ + position = load_unscaled (i); \ + } \ + else \ + { \ + org_max_pos = original_max_pos; \ + org_min_pos = original_min_pos; \ + } \ + \ /* Handle the degenerate case where original_min_pos and \ original_max_pos have not changed by placing the point in \ the middle. */ \ - if (original_min_pos == original_max_pos) \ + if (org_min_pos == org_max_pos) \ ratio = 077777; \ else \ /* ... preserve the ratio of i between min_pos and \ max_pos... */ \ ratio = sfnt_div_fixed ((sfnt_sub (position, \ - original_min_pos) \ + org_min_pos) \ * 1024), \ - (sfnt_sub (original_max_pos, \ - original_min_pos) \ + (sfnt_sub (org_max_pos, \ + org_min_pos) \ * 1024)); \ \ delta = sfnt_sub (max_pos, min_pos); \ - delta = sfnt_mul_fixed (ratio, delta); \ + delta = sfnt_mul_fixed_round (ratio, delta); \ store_point (i, sfnt_add (min_pos, delta)); \ } \ else \ @@ -11237,8 +11280,8 @@ sfnt_interpret_iup_1 (struct sfnt_interpreter *interpreter, size_t first_point; size_t point_min, point_max, i; sfnt_f26dot6 position, min_pos, max_pos, delta, ratio; - sfnt_f26dot6 original_max_pos; - sfnt_f26dot6 original_min_pos; + sfnt_f26dot6 original_max_pos, org_max_pos; + sfnt_f26dot6 original_min_pos, org_min_pos; /* Find the first touched point. If none is found, simply return. */ @@ -11324,6 +11367,7 @@ sfnt_interpret_iup_1 (struct sfnt_interpreter *interpreter, #undef load_point #undef store_point #undef load_original +#undef load_unscaled /* Interpret an IUP (``interpolate untouched points'') instruction. INTERPRETER is the interpreter, and OPCODE is the instruction -- cgit v1.2.3 From 3a541b25df5b46439d0cec33e9d276b210e6ca41 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 20 Jan 2024 09:18:27 +0200 Subject: Update Polish translation of tutorial * etc/tutorials/TUTORIAL.pl: Update text about scroll bar. New text by Christopher Yeleighton . (Bug#68599) Copyright-paperwork-exempt: yes --- etc/tutorials/TUTORIAL.pl | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/etc/tutorials/TUTORIAL.pl b/etc/tutorials/TUTORIAL.pl index 6f2565f6855..462fdcd835e 100644 --- a/etc/tutorials/TUTORIAL.pl +++ b/etc/tutorials/TUTORIAL.pl @@ -218,17 +218,11 @@ Na przykład C-u 4 C-v przewija ekran o 4 linie. To powinno było przewinąć ekran do góry o 8 linii. Jeśli chciałbyś przewinąć ekran w dół, to powinieneś podać argument przed poleceniem M-v. -Jeśli pracujesz w systemie z okienkowym trybem graficznym, jak X11 -lub MS-Windows, to prawdopodobnie po lewej stronie okna Emacsa znajduje -się prostokątny obszar nazywany po angielsku "scrollbar", a po polsku -suwakiem. Za jego pomocą możesz przewijać tekst, używając do tego myszy. +W środowisku graficznym, takim jak X lub Microsoft Windows, po jednej +stronie okna Emacs znajdzie się długi prostokątny obszar, nazywany +prowadnicą przewijacza.  Można przewijać treść, stukając myszą w prowadnicę. ->> Spróbuj nacisnąć środkowy klawisz myszy u góry podświetlonego - obszaru na suwaku. To powinno przewinąć tekst do miejsca - określonego przez wysokość, na której nacisnąłeś klawisz myszy. - ->> Przesuń mysz do miejsca oddalonego od górnego końca suwaka o mniej - więcej trzy linie i naciśnij lewy klawisz myszy kilka razy. +Można również używać kółeczka myszy do przewijania, jeśli jest dostępne. * GDY EMACS JEST ZABLOKOWANY -- cgit v1.2.3 From 3a5ee060571b29474f83ebaee11df6920ea68c6a Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Fri, 5 Jan 2024 16:40:44 +0100 Subject: ; Use HTML entities for reserved characters in 'dom-print' * lisp/dom.el (dom-print): Encode HTML reserved characters in strings. * test/lisp/dom-tests.el (dom-tests-print): New test. (Bug#68508) --- lisp/dom.el | 2 +- test/lisp/dom-tests.el | 10 ++++++++++ 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/lisp/dom.el b/lisp/dom.el index f7043ba8252..b329379fdc3 100644 --- a/lisp/dom.el +++ b/lisp/dom.el @@ -288,7 +288,7 @@ If XML, generate XML instead of HTML." (insert ">") (dolist (child children) (if (stringp child) - (insert child) + (insert (url-insert-entities-in-string child)) (setq non-text t) (when pretty (insert "\n" (make-string (+ column 2) ?\s))) diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el index 8cbfb9ad9df..a4e913541bf 100644 --- a/test/lisp/dom-tests.el +++ b/test/lisp/dom-tests.el @@ -209,6 +209,16 @@ child results in an error." (dom-pp node t) (should (equal (buffer-string) "(\"foo\" nil)"))))) +(ert-deftest dom-tests-print () + "Test that `dom-print' correctly encodes HTML reserved characters." + (with-temp-buffer + (dom-print '(samp ((class . "samp")) "
")) + (should (equal + (buffer-string) + (concat "" + "<div class="default"> </div>" + ""))))) + (ert-deftest dom-test-search () (let ((dom '(a nil (b nil (c nil))))) (should (equal (dom-search dom (lambda (d) (eq (dom-tag d) 'a))) -- cgit v1.2.3 From 115908469d30f8c40689673312f72b44c1631c6b Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 20 Jan 2024 10:45:27 +0100 Subject: Sync with Tramp 2.6.3-pre (don't merge with master) * doc/misc/tramp.texi (Obtaining @value{tramp}): Mention the ELPA Tramp manual. (Remote processes): Adapt index. * doc/misc/trampver.texi: * lisp/net/trampver.el (tramp-version): Set to "2.6.3-pre". * lisp/net/tramp.el (tramp-local-host-regexp): Extend. Adapt :version. (tramp-signal-process): PROCESS can also be a string. (tramp-skeleton-directory-files): * lisp/net/tramp-cache.el (with-tramp-saved-file-property) (with-tramp-saved-file-properties) (with-tramp-saved-connection-property) (with-tramp-saved-connection-properties): Use `setf' but `setq' in macro. * lisp/net/tramp-compat.el (tramp-compat-funcall): Declare debug. * lisp/net/tramp-crypt.el (tramp-crypt-file-name-p): Exclude lock files. (tramp-crypt-file-name-handler-alist): Use `identity' for `abbreviate-file-name'. (tramp-crypt-add-directory, tramp-crypt-remove-directory): Adapt docstrings. (tramp-crypt-cleanup-connection): New defun. Add it to `tramp-cleanup-connection-hook' * lisp/net/tramp.el (tramp-skeleton-file-name-all-completions): Handle "." and "..". * lisp/net/tramp-adb.el (tramp-adb-handle-file-name-all-completions): * lisp/net/tramp-fuse.el (tramp-fuse-handle-file-name-all-completions): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-name-all-completions): Remove special handling of "." an "..". * lisp/net/tramp-sh.el (tramp-pipe-stty-settings): New defcustom. (tramp-sh-handle-make-process): Use it. (Bug#62093) * test/lisp/net/tramp-tests.el (tramp-test18-file-attributes): Adapt test. (tramp-test31-signal-process): Extend. --- doc/misc/tramp.texi | 16 ++++--- doc/misc/trampver.texi | 2 +- lisp/net/tramp-adb.el | 12 ++--- lisp/net/tramp-cache.el | 8 ++-- lisp/net/tramp-compat.el | 1 + lisp/net/tramp-crypt.el | 24 ++++++++-- lisp/net/tramp-fuse.el | 13 +----- lisp/net/tramp-gvfs.el | 2 +- lisp/net/tramp-sh.el | 30 +++++++++--- lisp/net/tramp.el | 33 +++++++++++--- lisp/net/trampver.el | 6 +-- test/lisp/net/tramp-tests.el | 106 ++++++++++++++++++++++++------------------- 12 files changed, 156 insertions(+), 97 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 53a848ad652..3be88d1767a 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -318,7 +318,7 @@ behind the scenes when you open a file with @value{tramp}. @cindex GNU ELPA @vindex tramp-version -@value{tramp} is included as part of Emacs (since @w{Emacs 22.1}). +@value{tramp} is included as part of Emacs. @value{tramp} is also freely packaged for download on the Internet at @uref{https://ftp.gnu.org/gnu/tramp/}. The version number of @@ -340,10 +340,12 @@ versions packaged with Emacs can be retrieved by @end lisp @value{tramp} is also available as @uref{https://elpa.gnu.org, GNU -ELPA} package. Besides the standalone releases, further minor versions -of @value{tramp} will appear on GNU ELPA, until the next @value{tramp} -release appears. These minor versions have a four-number string, like -``2.4.5.1''. +ELPA} package. Besides the standalone releases, further minor +versions of @value{tramp} will appear on GNU ELPA, until the next +@value{tramp} release appears. These minor versions have a +four-number string, like ``2.4.5.1''. The manual of the latest +@value{tramp} ELPA package is located at +@uref{https://elpa.gnu.org/packages/doc/tramp.html}. @value{tramp} development versions are available on Git servers. Development versions contain new and incomplete features. The @@ -4108,7 +4110,7 @@ To open @command{powershell} as a remote shell, use this: @subsection Remote process connection type @vindex process-connection-type -@cindex tramp-process-connection-type +@vindex tramp-process-connection-type Asynchronous processes behave differently based on whether they use a pseudo tty or not. This is controlled by the variable @@ -4245,7 +4247,7 @@ called @code{tramp-connection-local-*-ps-profile} and @end group @end lisp -@cindex proced +@cindex @code{proced} @vindex proced-show-remote-processes If you want to see a listing of remote system processes when calling @code{proced}, set user option @code{proced-show-remote-processes} to diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 794c54c112e..956d055fdaf 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -7,7 +7,7 @@ @c In the Tramp GIT, the version number and the bug report address @c are auto-frobbed from configure.ac. -@set trampver 2.6.2.29.2 +@set trampver 2.6.3-pre @set trampurl https://www.gnu.org/software/tramp/ @set tramp-bug-report-address tramp-devel@@gnu.org @set emacsver 26.1 diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 144212a3aec..f2c50983a32 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -464,14 +464,10 @@ Emacs dired can't find files." (file-name-as-directory f) f)) (with-current-buffer (tramp-get-buffer v) - (append - ;; On some file systems like "sdcard", "." and ".." are - ;; not included. - '("." "..") - (mapcar - (lambda (l) - (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string (buffer-string) "\n" 'omit)))))))))) + (mapcar + (lambda (l) + (and (not (string-match-p (rx bol (* blank) eol) l)) l)) + (split-string (buffer-string) "\n" 'omit))))))))) (defun tramp-adb-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index b17469ba908..fe6aeca6eb0 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -338,7 +338,7 @@ Preserve timestamps." (declare (indent 3) (debug t)) `(progn ;; Unify localname. Remove hop from `tramp-file-name' structure. - (setq ,key (tramp-file-name-unify ,key ,file)) + (setf ,key (tramp-file-name-unify ,key ,file)) (let* ((hash (tramp-get-hash-table ,key)) (cached (and (hash-table-p hash) (gethash ,property hash)))) (unwind-protect (progn ,@body) @@ -356,7 +356,7 @@ Preserve timestamps." (declare (indent 3) (debug t)) `(progn ;; Unify localname. Remove hop from `tramp-file-name' structure. - (setq ,key (tramp-file-name-unify ,key ,file)) + (setf ,key (tramp-file-name-unify ,key ,file)) (let* ((hash (tramp-get-hash-table ,key)) (values (and (hash-table-p hash) @@ -472,7 +472,7 @@ used to cache connection properties of the local machine." "Save PROPERTY, run BODY, reset PROPERTY." (declare (indent 2) (debug t)) `(progn - (setq ,key (tramp-file-name-unify ,key)) + (setf ,key (tramp-file-name-unify ,key)) (let* ((hash (tramp-get-hash-table ,key)) (cached (and (hash-table-p hash) (gethash ,property hash tramp-cache-undefined)))) @@ -489,7 +489,7 @@ used to cache connection properties of the local machine." PROPERTIES is a list of file properties (strings)." (declare (indent 2) (debug t)) `(progn - (setq ,key (tramp-file-name-unify ,key)) + (setf ,key (tramp-file-name-unify ,key)) (let* ((hash (tramp-get-hash-table ,key)) (values (mapcar diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 66d312ad2f0..43de5509081 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -63,6 +63,7 @@ ;; avoid them in cases we know what we do. (defmacro tramp-compat-funcall (function &rest arguments) "Call FUNCTION with ARGUMENTS if it exists. Do not raise compiler warnings." + (declare (indent 1) (debug t)) `(when (functionp ,function) (with-no-warnings (funcall ,function ,@arguments)))) diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index a27ca875646..143327c123a 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -148,6 +148,8 @@ If NAME doesn't belong to an encrypted remote directory, return nil." (and tramp-crypt-enabled (stringp name) (not (tramp-compat-file-name-quoted-p name)) (not (string-suffix-p tramp-crypt-encfs-config name)) + ;; No lock file name. + (not (string-prefix-p ".#" (file-name-nondirectory name))) (dolist (dir tramp-crypt-directories) (and (string-prefix-p dir (file-name-as-directory (expand-file-name name))) @@ -157,7 +159,7 @@ If NAME doesn't belong to an encrypted remote directory, return nil." ;; New handlers should be added here. ;;;###tramp-autoload (defconst tramp-crypt-file-name-handler-alist - '(;; `abbreviate-file-name' performed by default handler. + '((abbreviate-file-name . identity) (access-file . tramp-crypt-handle-access-file) (add-name-to-file . tramp-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. @@ -487,7 +489,7 @@ See `tramp-crypt-do-encrypt-or-decrypt-file'." ;;;###tramp-autoload (defun tramp-crypt-add-directory (name) - "Mark remote directory NAME for encryption. + "Mark expanded remote directory NAME for encryption. Files in that directory and all subdirectories will be encrypted before copying to, and decrypted after copying from that directory. File names will be also encrypted." @@ -511,7 +513,7 @@ directory. File names will be also encrypted." #'tramp-crypt-command-completion-p) (defun tramp-crypt-remove-directory (name) - "Unmark remote directory NAME for encryption. + "Unmark expanded remote directory NAME for encryption. Existing files in that directory and its subdirectories will be kept in their encrypted form." ;; (declare (completion tramp-crypt-command-completion-p)) @@ -859,6 +861,22 @@ WILDCARD is not supported." (tramp-compat-funcall 'unlock-file (tramp-crypt-encrypt-file-name filename)))) +(defun tramp-crypt-cleanup-connection (vec) + "Cleanup crypt ressources determined by VEC." + (let ((tramp-cleanup-connection-hook + (remove + #'tramp-crypt-cleanup-connection tramp-cleanup-connection-hook))) + (dolist (dir tramp-crypt-directories) + (when (tramp-file-name-equal-p vec (tramp-dissect-file-name dir)) + (tramp-cleanup-connection (tramp-crypt-dissect-file-name dir)))))) + +;; Add cleanup hooks. +(add-hook 'tramp-cleanup-connection-hook #'tramp-crypt-cleanup-connection) +(add-hook 'tramp-crypt-unload-hook + (lambda () + (remove-hook 'tramp-cleanup-connection-hook + #'tramp-crypt-cleanup-connection))) + (with-eval-after-load 'bookmark (add-hook 'bookmark-inhibit-context-functions #'tramp-crypt-file-name-p) diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index 885000406ea..47870c05911 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -108,17 +108,8 @@ (tramp-fuse-remove-hidden-files (all-completions filename - (append - (file-name-all-completions - filename (tramp-fuse-local-file-name directory)) - ;; Some storage systems do not return "." and "..". - (let (result) - (dolist (item '(".." ".") result) - (when (string-prefix-p filename item) - (catch 'match - (dolist (elt completion-regexp-list) - (unless (string-match-p elt item) (throw 'match nil))) - (setq result (cons (concat item "/") result))))))))))) + (file-name-all-completions + filename (tramp-fuse-local-file-name directory)))))) ;; This function isn't used. (defun tramp-fuse-handle-insert-directory diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index ecb0f922f54..2ccba85c238 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1440,7 +1440,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." filename (with-parsed-tramp-file-name (expand-file-name directory) nil (with-tramp-file-property v localname "file-name-all-completions" - (let ((result '("./" "../"))) + (let (result) ;; Get a list of directories and files. (dolist (item (tramp-gvfs-get-directory-attributes directory) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 40e706c4a11..38925652376 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2876,7 +2876,16 @@ the result will be a local, non-Tramp, file name." (tramp-run-real-handler #'expand-file-name (list localname)))))))))) -;;; Remote commands: +;;; Remote processes: + +(defcustom tramp-pipe-stty-settings "-icanon min 1 time 0" + "How to prevent blocking read in pipeline processes. +This is used in `make-process' with `connection-type' `pipe'." + :group 'tramp + :version "29.3" + :type '(choice (const :tag "Use size limit" "-icanon min 1 time 0") + (const :tag "Use timeout" "-icanon min 0 time 1") + string)) ;; We use BUFFER also as connection buffer during setup. Because of ;; this, its original contents must be saved, and restored once @@ -3087,12 +3096,21 @@ implementation will be used." ;; otherwise strings larger than 4096 ;; bytes, sent by the process, could ;; block, see termios(3) and Bug#61341. + ;; In order to prevent blocking read + ;; from pipe processes, "stty -icanon" + ;; is used. By default, it expects at + ;; least one character to read. When a + ;; process does not read from stdin, + ;; like magit, it should set a timeout + ;; instead. See`tramp-pipe-stty-settings'. + ;; (Bug#62093) ;; FIXME: Shall we rather use "stty raw"? - (if (tramp-check-remote-uname v "Darwin") - (tramp-send-command - v "stty -icanon min 1 time 0") - (tramp-send-command - v "stty -icrnl -icanon min 1 time 0"))) + (tramp-send-command + v (format + "stty %s %s" + (if (tramp-check-remote-uname v "Darwin") + "" "-icrnl") + tramp-pipe-stty-settings))) ;; `tramp-maybe-open-connection' and ;; `tramp-send-command-and-read' could ;; have trashed the connection buffer. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 15a12000120..56b00bdeb42 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -569,11 +569,15 @@ host runs a restricted shell, it shall be added to this list, too." (tramp-compat-rx bos (| (literal tramp-system-name) - (| "localhost" "localhost4" "localhost6" "127.0.0.1" "::1")) + (| "localhost" "127.0.0.1" "::1" + ;; Fedora. + "localhost4" "localhost6" + ;; Ubuntu. + "ip6-localhost" "ip6-loopback")) eos) "Host names which are regarded as local host. If the local host runs a chrooted environment, set this to nil." - :version "29.1" + :version "29.3" :type '(choice (const :tag "Chrooted environment" nil) (regexp :tag "Host regexp"))) @@ -3071,19 +3075,27 @@ not in completion mode." (tramp-run-real-handler #'file-exists-p (list filename)))) (defmacro tramp-skeleton-file-name-all-completions - (_filename _directory &rest body) + (filename directory &rest body) "Skeleton for `tramp-*-handle-filename-all-completions'. BODY is the backend specific code." (declare (indent 2) (debug t)) `(tramp-compat-ignore-error file-missing (delete-dups (delq nil (let* ((case-fold-search read-file-name-completion-ignore-case) - (regexp (mapconcat #'identity completion-regexp-list "\\|")) - (result ,@body)) + (result (progn ,@body))) + ;; Some storage systems do not return "." and "..". + (when (tramp-tramp-file-p ,directory) + (dolist (elt '(".." ".")) + (when (string-prefix-p ,filename elt) + (setq result (cons (concat elt "/") result))))) (if (consp completion-regexp-list) ;; Discriminate over `completion-regexp-list'. (mapcar - (lambda (x) (and (stringp x) (string-match-p regexp x) x)) + (lambda (x) + (when (stringp x) + (catch 'match + (dolist (elt completion-regexp-list x) + (unless (string-match-p elt x) (throw 'match nil)))))) result) result)))))) @@ -3617,7 +3629,7 @@ BODY is the backend specific code." (with-parsed-tramp-file-name (expand-file-name ,directory) nil (tramp-barf-if-file-missing v ,directory (when (file-directory-p ,directory) - (setq ,directory + (setf ,directory (file-name-as-directory (expand-file-name ,directory))) (let ((temp (with-tramp-file-property v localname "directory-files" ,@body)) @@ -6895,7 +6907,14 @@ If PROCESS is a process object which contains the property `remote-pid', or PROCESS is a number and REMOTE is a remote file name, PROCESS is interpreted as process on the respective remote host, which will be the process to signal. +If PROCESS is a string, it is interpreted as process object with +the respective process name, or as a number. SIGCODE may be an integer, or a symbol whose name is a signal name." + (when (stringp process) + (setq process (or (get-process process) + (and (string-match-p (rx bol (+ digit) eol) process) + (string-to-number process)) + (signal 'wrong-type-argument (list #'processp process))))) (let (pid vec) (cond ((processp process) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 7817c520974..1647960ef0e 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.6.2.29.2 +;; Version: 2.6.3-pre ;; Package-Requires: ((emacs "26.1")) ;; Package-Type: multi ;; URL: https://www.gnu.org/software/tramp/ @@ -40,7 +40,7 @@ ;; ./configure" to change them. ;;;###tramp-autoload -(defconst tramp-version "2.6.2.29.2" +(defconst tramp-version "2.6.3-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -78,7 +78,7 @@ ;; Check for Emacs version. (let ((x (if (not (string-version-lessp emacs-version "26.1")) "ok" - (format "Tramp 2.6.2.29.2 is not fit for %s" + (format "Tramp 2.6.3-pre is not fit for %s" (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 5f2a41909b7..465afa87bb0 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3757,7 +3757,7 @@ This tests also `access-file', `file-readable-p', (should (eq (file-attribute-type attr) t))) ;; Cleanup. - (ignore-errors (delete-directory tmp-name1)) + (ignore-errors (delete-directory tmp-name1 'recursive)) (ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-file tmp-name2)))))) @@ -5675,55 +5675,69 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (delete-exited-processes t) kill-buffer-query-functions command proc) - (dolist (sigcode '(2 INT)) - (unwind-protect - (with-temp-buffer - (setq command "trap 'echo boom; exit 1' 2; sleep 100" - proc (start-file-process-shell-command - (format "test1%s" sigcode) (current-buffer) command)) - (should (processp proc)) - (should (process-live-p proc)) - (should (equal (process-status proc) 'run)) - (should (numberp (process-get proc 'remote-pid))) - (should (equal (process-get proc 'remote-command) - (with-connection-local-variables - `(,shell-file-name ,shell-command-switch ,command)))) - (should (zerop (signal-process proc sigcode))) - ;; Let the process accept the signal. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (accept-process-output proc 0 nil t))) - (should-not (process-live-p proc))) + ;; If PROCESS is a string, it must be a process name or a process + ;; number. Check error handling. + (should-error + (signal-process (md5 (current-time-string)) 0) + :type 'wrong-type-argument) + + ;; The PROCESS argument of `signal-process' can be a string. Test + ;; this as well. + (dolist + (func '(identity + (lambda (x) (format "%s" (if (processp x) (process-name x) x))))) + (dolist (sigcode '(2 INT)) + (unwind-protect + (with-temp-buffer + (setq command "trap 'echo boom; exit 1' 2; sleep 100" + proc (start-file-process-shell-command + (format "test1-%s" sigcode) (current-buffer) command)) + (should (processp proc)) + (should (process-live-p proc)) + (should (equal (process-status proc) 'run)) + (should (numberp (process-get proc 'remote-pid))) + (should + (equal (process-get proc 'remote-command) + (with-connection-local-variables + `(,shell-file-name ,shell-command-switch ,command)))) + (should (zerop (signal-process (funcall func proc) sigcode))) + ;; Let the process accept the signal. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (accept-process-output proc 0 nil t))) + (should-not (process-live-p proc))) - ;; Cleanup. - (ignore-errors (kill-process proc)) - (ignore-errors (delete-process proc))) + ;; Cleanup. + (ignore-errors (kill-process proc)) + (ignore-errors (delete-process proc))) - (unwind-protect - (with-temp-buffer - (setq command "trap 'echo boom; exit 1' 2; sleep 100" - proc (start-file-process-shell-command - (format "test2%s" sigcode) (current-buffer) command)) - (should (processp proc)) - (should (process-live-p proc)) - (should (equal (process-status proc) 'run)) - (should (numberp (process-get proc 'remote-pid))) - (should (equal (process-get proc 'remote-command) - (with-connection-local-variables - `(,shell-file-name ,shell-command-switch ,command)))) - ;; `signal-process' has argument REMOTE since Emacs 29. - (with-no-warnings + (unwind-protect + (with-temp-buffer + (setq command "trap 'echo boom; exit 1' 2; sleep 100" + proc (start-file-process-shell-command + (format "test2-%s" sigcode) (current-buffer) command)) + (should (processp proc)) + (should (process-live-p proc)) + (should (equal (process-status proc) 'run)) + (should (numberp (process-get proc 'remote-pid))) (should - (zerop - (signal-process - (process-get proc 'remote-pid) sigcode default-directory)))) - ;; Let the process accept the signal. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (accept-process-output proc 0 nil t))) - (should-not (process-live-p proc))) + (equal (process-get proc 'remote-command) + (with-connection-local-variables + `(,shell-file-name ,shell-command-switch ,command)))) + ;; `signal-process' has argument REMOTE since Emacs 29. + (with-no-warnings + (should + (zerop + (signal-process + (funcall func (process-get proc 'remote-pid)) + sigcode default-directory)))) + ;; Let the process accept the signal. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (accept-process-output proc 0 nil t))) + (should-not (process-live-p proc))) - ;; Cleanup. - (ignore-errors (kill-process proc)) - (ignore-errors (delete-process proc)))))) + ;; Cleanup. + (ignore-errors (kill-process proc)) + (ignore-errors (delete-process proc))))))) (ert-deftest tramp-test31-list-system-processes () "Check `list-system-processes'." -- cgit v1.2.3 From 8bb5525b62163d7c3617a8b61da94f1a12a8d8e8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 20 Jan 2024 06:37:09 -0500 Subject: ; Fix merge snafus * lisp/jsonrpc.el: * lisp/progmodes/eglot.el: Fix merge snafus. --- lisp/jsonrpc.el | 3 +++ lisp/progmodes/eglot.el | 43 ------------------------------------------- 2 files changed, 3 insertions(+), 43 deletions(-) diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 0ecde0a5425..1f8e1b1a876 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -689,6 +689,9 @@ With optional CLEANUP, kill any associated buffers." (when-let (p (slot-value connection '-autoport-inferior)) (delete-process p)) (funcall (jsonrpc--on-shutdown connection) connection))))) +(defvar jsonrpc--in-process-filter nil + "Non-nil if inside `jsonrpc--process-filter'.") + (cl-defun jsonrpc--process-filter (proc string) "Called when new data STRING has arrived for PROC." (when jsonrpc--in-process-filter diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 5d3f7159161..c5cfdd3cedd 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1803,49 +1803,6 @@ If optional MARKER, return a marker instead" vec) "Like `url-path-allowed-chars' but more restrictive.") -(defun eglot--path-to-uri (path) - "URIfy PATH." - (let ((truepath (file-truename path))) - (if (and (url-type (url-generic-parse-url path)) - ;; It might be MS Windows path which includes a drive - ;; letter that looks like a URL scheme (bug#59338) - (not (and (eq system-type 'windows-nt) - (file-name-absolute-p truepath)))) - ;; Path is already a URI, so forward it to the LSP server - ;; untouched. The server should be able to handle it, since - ;; it provided this URI to clients in the first place. - path - (concat "file://" - ;; Add a leading "/" for local MS Windows-style paths. - (if (and (eq system-type 'windows-nt) - (not (file-remote-p truepath))) - "/") - (url-hexify-string - ;; Again watch out for trampy paths. - (directory-file-name (file-local-name truepath)) - eglot--uri-path-allowed-chars))))) - -(declare-function w32-long-file-name "w32proc.c" (fn)) -(defun eglot--uri-to-path (uri) - "Convert URI to file path, helped by `eglot--current-server'." - (when (keywordp uri) (setq uri (substring (symbol-name uri) 1))) - (let* ((server (eglot-current-server)) - (remote-prefix (and server (eglot--trampish-p server))) - (url (url-generic-parse-url uri))) - ;; Only parse file:// URIs, leave other URI untouched as - ;; `file-name-handler-alist' should know how to handle them - ;; (bug#58790). - (if (string= "file" (url-type url)) - (let* ((retval (url-unhex-string (url-filename url))) - ;; Remove the leading "/" for local MS Windows-style paths. - (normalized (if (and (not remote-prefix) - (eq system-type 'windows-nt) - (cl-plusp (length retval))) - (w32-long-file-name (substring retval 1)) - retval))) - (concat remote-prefix normalized)) - uri))) - (defun eglot--snippet-expansion-fn () "Compute a function to expand snippets. Doubles as an indicator of snippet support." -- cgit v1.2.3 From ce836aafaa581e5b713eb289071dbeed73166c99 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 20 Jan 2024 06:40:54 -0500 Subject: ; Merge NEWS.29. --- etc/NEWS.29 | 45 +++++++++++++++++++++++++++------------------ 1 file changed, 27 insertions(+), 18 deletions(-) diff --git a/etc/NEWS.29 b/etc/NEWS.29 index 069661866ce..06086e9bdfb 100644 --- a/etc/NEWS.29 +++ b/etc/NEWS.29 @@ -15,11 +15,32 @@ in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' with a prefix argument or by typing 'C-u C-h C-n'. -Temporary note: -+++ indicates that all relevant manuals in doc/ have been updated. ---- means no change in the manuals is needed. -When you add a new item, use the appropriate mark if you are sure it -applies, and please also update docstrings as needed. + +* Installation Changes in Emacs 29.3 + + +* Startup Changes in Emacs 29.3 + + +* Changes in Emacs 29.3 + + +* Editing Changes in Emacs 29.3 + + +* Changes in Specialized Modes and Packages in Emacs 29.3 + + +* New Modes and Packages in Emacs 29.3 + + +* Incompatible Lisp Changes in Emacs 29.3 + + +* Lisp Changes in Emacs 29.3 + + +* Changes in Emacs 29.3 on Non-Free Operating Systems * Installation Changes in Emacs 29.2 @@ -43,36 +64,24 @@ more details. * Changes in Emacs 29.2 - -* Editing Changes in Emacs 29.2 +This is a bug-fix release with no new features. * Changes in Specialized Modes and Packages in Emacs 29.2 ** Tramp -+++ *** New user option 'tramp-show-ad-hoc-proxies'. When non-nil, ad-hoc definitions are kept in remote file names instead of showing the shortcuts. - -* New Modes and Packages in Emacs 29.2 - * Incompatible Lisp Changes in Emacs 29.2 -+++ ** 'with-sqlite-transaction' rolls back changes if its BODY fails. If the BODY of the macro signals an error, or committing the results of the transaction fails, the changes will now be rolled back. - -* Lisp Changes in Emacs 29.2 - - -* Changes in Emacs 29.2 on Non-Free Operating Systems - * Installation Changes in Emacs 29.1 -- cgit v1.2.3 From 412cc0212d7bf2f2d0f49fdb8a4ff69480b8afed Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 20 Jan 2024 05:43:27 -0600 Subject: Eldoc: play nice with mode-line-format-right-align (bug#68547) * lisp/emacs-lisp/eldoc.el (eldoc-minibuffer-message): Avoid nesting 'mode-line-format', since that breaks 'mode-line-format-right-align'. --- lisp/emacs-lisp/eldoc.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 06970d40e8a..912a7357ca7 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -312,9 +312,11 @@ Otherwise, it displays the message like `message' would." (not (and (listp mode-line-format) (assq 'eldoc-mode-line-string mode-line-format)))) (setq mode-line-format - (list "" '(eldoc-mode-line-string - (" " eldoc-mode-line-string " ")) - mode-line-format))) + (funcall + (if (listp mode-line-format) #'append #'list) + (list "" '(eldoc-mode-line-string + (" " eldoc-mode-line-string " "))) + mode-line-format))) (setq eldoc-mode-line-string (when (stringp format-string) (apply #'format-message format-string args))) -- cgit v1.2.3 From d276996c4f60395464ca8d5d7de487022b4937fa Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 20 Jan 2024 11:26:09 -0800 Subject: Avoid Gnulib ‘access’ module MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * admin/merge-gnulib (AVOIDED_MODULES): Add ‘access’, since I don’t think Emacs cares about the Mac OS X 10.5 bug where faccessat ignores a trailing slash on a symlink to a directory. This will matter the next time we run admin/merge-gnulib. --- admin/merge-gnulib | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 6378a5f9a22..edaa1e08b57 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -52,7 +52,7 @@ GNULIB_MODULES=' ' AVOIDED_MODULES=' - btowc chmod close crypto/af_alg dup fchdir fstat + access btowc chmod close crypto/af_alg dup fchdir fstat iswblank iswctype iswdigit iswxdigit langinfo lock mbrtowc mbsinit memchr mkdir msvc-inval msvc-nothrow nl_langinfo openat-die opendir pthread-h raise -- cgit v1.2.3 From 3add626f1405739aa430adcc0b4c27e587a7c561 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 20 Jan 2024 11:45:04 -0800 Subject: Update from Gnulib by running admin/merge-gnulib --- build-aux/config.guess | 15 +++- build-aux/config.sub | 174 ++++++++++++++++++++++++++++++++------------- build-aux/install-sh | 8 +-- build-aux/update-copyright | 159 +++++++++++++++++++++-------------------- doc/misc/texinfo.tex | 56 ++++++--------- lib/acl-internal.h | 3 - lib/alloca.in.h | 4 +- lib/attribute.h | 2 + lib/binary-io.h | 3 +- lib/boot-time-aux.h | 16 +++-- lib/boot-time.c | 9 ++- lib/c-ctype.h | 3 +- lib/c-strcasecmp.c | 3 +- lib/c-strncasecmp.c | 3 +- lib/careadlinkat.c | 4 +- lib/cloexec.c | 3 +- lib/close-stream.c | 3 +- lib/diffseq.h | 4 +- lib/dirent.in.h | 6 -- lib/dirfd.c | 65 ----------------- lib/dup2.c | 3 +- lib/faccessat.c | 6 +- lib/fdopendir.c | 36 ---------- lib/filemode.h | 4 +- lib/fpending.c | 4 +- lib/fpending.h | 4 +- lib/fsusage.c | 4 +- lib/getgroups.c | 3 +- lib/getloadavg.c | 4 +- lib/getopt-cdefs.in.h | 6 +- lib/getopt.c | 33 +++++---- lib/getopt1.c | 2 +- lib/gettext.h | 4 +- lib/gettime.c | 3 +- lib/gettimeofday.c | 3 +- lib/gnulib.mk.in | 9 +++ lib/group-member.c | 4 +- lib/intprops-internal.h | 5 ++ lib/malloc.c | 3 +- lib/md5-stream.c | 4 +- lib/md5.c | 4 +- lib/md5.h | 26 +++++-- lib/memmem.c | 4 +- lib/memrchr.c | 4 +- lib/nanosleep.c | 3 +- lib/open.c | 6 +- lib/rawmemchr.c | 26 +++++-- lib/regex.c | 4 -- lib/save-cwd.h | 4 +- lib/set-permissions.c | 1 + lib/sha1.c | 3 +- lib/sha1.h | 16 ++++- lib/sha256.h | 16 ++++- lib/sha512.h | 16 ++++- lib/sig2str.c | 3 +- lib/stat-time.h | 13 ++-- lib/stddef.in.h | 28 +++++++- lib/stdint.in.h | 2 + lib/stdio.in.h | 51 ++++++++++++- lib/stdlib.in.h | 145 +++++++++++++++++++++++++++++++++---- lib/string.in.h | 125 ++++++++++++++++++++++++++------ lib/strtoimax.c | 4 +- lib/strtol.c | 4 +- lib/strtoll.c | 4 +- lib/sys_stat.in.h | 30 +++++++- lib/tempname.c | 4 +- lib/time_r.c | 3 +- lib/unistd.c | 2 +- lib/unistd.in.h | 31 ++++---- lib/unlocked-io.h | 2 +- lib/utimens.c | 4 +- lib/verify.h | 10 +-- lib/xalloc-oversized.h | 11 ++- m4/00gnulib.m4 | 10 +-- m4/absolute-header.m4 | 4 +- m4/acl.m4 | 6 +- m4/alloca.m4 | 4 +- m4/assert_h.m4 | 6 +- m4/canonicalize.m4 | 26 +++---- m4/clock_time.m4 | 4 +- m4/codeset.m4 | 4 +- m4/d-type.m4 | 3 +- m4/dirent_h.m4 | 9 ++- m4/dirfd.m4 | 13 ++-- m4/dup2.m4 | 7 +- m4/filemode.m4 | 3 +- m4/fstatat.m4 | 4 +- m4/fsusage.m4 | 3 +- m4/getgroups.m4 | 9 ++- m4/getline.m4 | 4 +- m4/getloadavg.m4 | 14 ++-- m4/getopt.m4 | 6 +- m4/getrandom.m4 | 6 +- m4/gettime.m4 | 3 +- m4/gettimeofday.m4 | 7 +- m4/gnulib-common.m4 | 58 ++++++++++----- m4/gnulib-comp.m4 | 6 +- m4/group-member.m4 | 3 +- m4/include_next.m4 | 10 +-- m4/largefile.m4 | 4 +- m4/lstat.m4 | 6 +- m4/malloc.m4 | 9 +-- m4/manywarnings.m4 | 10 +-- m4/mempcpy.m4 | 4 +- m4/memrchr.m4 | 4 +- m4/mktime.m4 | 14 ++-- m4/nanosleep.m4 | 15 ++-- m4/nstrftime.m4 | 3 +- m4/open.m4 | 4 +- m4/pathmax.m4 | 4 +- m4/pthread_sigmask.m4 | 14 ++-- m4/readutmp.m4 | 6 +- m4/realloc.m4 | 7 +- m4/regex.m4 | 10 +-- m4/sig2str.m4 | 3 +- m4/ssize_t.m4 | 3 +- m4/stat-time.m4 | 4 +- m4/stdalign.m4 | 12 ++-- m4/stdint.m4 | 10 +-- m4/stdlib_h.m4 | 4 +- m4/string_h.m4 | 3 +- m4/strnlen.m4 | 4 +- m4/strtoimax.m4 | 17 +++-- m4/strtoll.m4 | 7 +- m4/time_h.m4 | 3 +- m4/timespec.m4 | 3 +- m4/unistd_h.m4 | 3 +- m4/utimes.m4 | 12 ++-- m4/warnings.m4 | 6 +- 129 files changed, 1061 insertions(+), 675 deletions(-) diff --git a/build-aux/config.guess b/build-aux/config.guess index 405d53d9785..f6d217a49f8 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -4,7 +4,7 @@ # shellcheck disable=SC2006,SC2268 # see below for rationale -timestamp='2023-07-20' +timestamp='2024-01-01' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -60,7 +60,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright 1992-2023 Free Software Foundation, Inc. +Copyright 1992-2024 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -155,6 +155,9 @@ Linux|GNU|GNU/*) set_cc_for_build cat <<-EOF > "$dummy.c" + #if defined(__ANDROID__) + LIBC=android + #else #include #if defined(__UCLIBC__) LIBC=uclibc @@ -162,6 +165,8 @@ Linux|GNU|GNU/*) LIBC=dietlibc #elif defined(__GLIBC__) LIBC=gnu + #elif defined(__LLVM_LIBC__) + LIBC=llvm #else #include /* First heuristic to detect musl libc. */ @@ -169,6 +174,7 @@ Linux|GNU|GNU/*) LIBC=musl #endif #endif + #endif EOF cc_set_libc=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g'` eval "$cc_set_libc" @@ -904,7 +910,7 @@ EOF fi ;; *:FreeBSD:*:*) - UNAME_PROCESSOR=`/usr/bin/uname -p` + UNAME_PROCESSOR=`uname -p` case $UNAME_PROCESSOR in amd64) UNAME_PROCESSOR=x86_64 ;; @@ -1589,6 +1595,9 @@ EOF *:Unleashed:*:*) GUESS=$UNAME_MACHINE-unknown-unleashed$UNAME_RELEASE ;; + *:Ironclad:*:*) + GUESS=$UNAME_MACHINE-unknown-ironclad + ;; esac # Do we have a guess based on uname results? diff --git a/build-aux/config.sub b/build-aux/config.sub index 183b3cc627b..2c6a07ab3c3 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -4,7 +4,7 @@ # shellcheck disable=SC2006,SC2268 # see below for rationale -timestamp='2023-07-31' +timestamp='2024-01-01' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -76,7 +76,7 @@ Report bugs and patches to ." version="\ GNU config.sub ($timestamp) -Copyright 1992-2023 Free Software Foundation, Inc. +Copyright 1992-2024 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -1181,7 +1181,7 @@ case $cpu-$vendor in case $cpu in 1750a | 580 \ | a29k \ - | aarch64 | aarch64_be \ + | aarch64 | aarch64_be | aarch64c | arm64ec \ | abacus \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] \ @@ -1200,6 +1200,7 @@ case $cpu-$vendor in | d10v | d30v | dlx | dsp16xx \ | e2k | elxsi | epiphany \ | f30[01] | f700 | fido | fr30 | frv | ft32 | fx80 \ + | javascript \ | h8300 | h8500 \ | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ | hexagon \ @@ -1221,6 +1222,7 @@ case $cpu-$vendor in | moxie \ | mt \ | msp430 \ + | nanomips* \ | nds32 | nds32le | nds32be \ | nfp \ | nios | nios2 | nios2eb | nios2el \ @@ -1252,6 +1254,7 @@ case $cpu-$vendor in | ubicom32 \ | v70 | v850 | v850e | v850e1 | v850es | v850e2 | v850e2v3 \ | vax \ + | vc4 \ | visium \ | w65 \ | wasm32 | wasm64 \ @@ -1284,11 +1287,12 @@ esac # Decode manufacturer-specific aliases for certain operating systems. -if test x$basic_os != x +if test x"$basic_os" != x then # First recognize some ad-hoc cases, or perhaps split kernel-os, or else just # set os. +obj= case $basic_os in gnu/linux*) kernel=linux @@ -1488,10 +1492,16 @@ case $os in os=eabi ;; *) - os=elf + os= + obj=elf ;; esac ;; + aout* | coff* | elf* | pe*) + # These are machine code file formats, not OSes + obj=$os + os= + ;; *) # No normalization, but not necessarily accepted, that comes below. ;; @@ -1510,12 +1520,15 @@ else # system, and we'll never get to this point. kernel= +obj= case $cpu-$vendor in score-*) - os=elf + os= + obj=elf ;; spu-*) - os=elf + os= + obj=elf ;; *-acorn) os=riscix1.2 @@ -1525,28 +1538,35 @@ case $cpu-$vendor in os=gnu ;; arm*-semi) - os=aout + os= + obj=aout ;; c4x-* | tic4x-*) - os=coff + os= + obj=coff ;; c8051-*) - os=elf + os= + obj=elf ;; clipper-intergraph) os=clix ;; hexagon-*) - os=elf + os= + obj=elf ;; tic54x-*) - os=coff + os= + obj=coff ;; tic55x-*) - os=coff + os= + obj=coff ;; tic6x-*) - os=coff + os= + obj=coff ;; # This must come before the *-dec entry. pdp10-*) @@ -1568,19 +1588,24 @@ case $cpu-$vendor in os=sunos3 ;; m68*-cisco) - os=aout + os= + obj=aout ;; mep-*) - os=elf + os= + obj=elf ;; mips*-cisco) - os=elf + os= + obj=elf ;; - mips*-*) - os=elf + mips*-*|nanomips*-*) + os= + obj=elf ;; or32-*) - os=coff + os= + obj=coff ;; *-tti) # must be before sparc entry or we get the wrong os. os=sysv3 @@ -1589,7 +1614,8 @@ case $cpu-$vendor in os=sunos4.1.1 ;; pru-*) - os=elf + os= + obj=elf ;; *-be) os=beos @@ -1670,10 +1696,12 @@ case $cpu-$vendor in os=uxpv ;; *-rom68k) - os=coff + os= + obj=coff ;; *-*bug) - os=coff + os= + obj=coff ;; *-apple) os=macos @@ -1691,10 +1719,11 @@ esac fi -# Now, validate our (potentially fixed-up) OS. +# Now, validate our (potentially fixed-up) individual pieces (OS, OBJ). + case $os in # Sometimes we do "kernel-libc", so those need to count as OSes. - musl* | newlib* | relibc* | uclibc*) + llvm* | musl* | newlib* | relibc* | uclibc*) ;; # Likewise for "kernel-abi" eabi* | gnueabi*) @@ -1702,6 +1731,9 @@ case $os in # VxWorks passes extra cpu info in the 4th filed. simlinux | simwindows | spe) ;; + # See `case $cpu-$os` validation below + ghcjs) + ;; # Now accept the basic system types. # The portable systems comes first. # Each alternative MUST end in a * to match a version number. @@ -1719,11 +1751,11 @@ case $os in | mirbsd* | netbsd* | dicos* | openedition* | ose* \ | bitrig* | openbsd* | secbsd* | solidbsd* | libertybsd* | os108* \ | ekkobsd* | freebsd* | riscix* | lynxos* | os400* \ - | bosx* | nextstep* | cxux* | aout* | elf* | oabi* \ - | ptx* | coff* | ecoff* | winnt* | domain* | vsta* \ + | bosx* | nextstep* | cxux* | oabi* \ + | ptx* | ecoff* | winnt* | domain* | vsta* \ | udi* | lites* | ieee* | go32* | aux* | hcos* \ | chorusrdb* | cegcc* | glidix* | serenity* \ - | cygwin* | msys* | pe* | moss* | proelf* | rtems* \ + | cygwin* | msys* | moss* | proelf* | rtems* \ | midipix* | mingw32* | mingw64* | mint* \ | uxpv* | beos* | mpeix* | udk* | moxiebox* \ | interix* | uwin* | mks* | rhapsody* | darwin* \ @@ -1736,71 +1768,115 @@ case $os in | onefs* | tirtos* | phoenix* | fuchsia* | redox* | bme* \ | midnightbsd* | amdhsa* | unleashed* | emscripten* | wasi* \ | nsk* | powerunix* | genode* | zvmoe* | qnx* | emx* | zephyr* \ - | fiwix* | mlibc* | cos* | mbr* ) + | fiwix* | mlibc* | cos* | mbr* | ironclad* ) ;; # This one is extra strict with allowed versions sco3.2v2 | sco3.2v[4-9]* | sco5v6*) # Don't forget version if it is 3.2v4 or newer. ;; + # This refers to builds using the UEFI calling convention + # (which depends on the architecture) and PE file format. + # Note that this is both a different calling convention and + # different file format than that of GNU-EFI + # (x86_64-w64-mingw32). + uefi) + ;; none) ;; kernel* | msvc* ) # Restricted further below ;; + '') + if test x"$obj" = x + then + echo "Invalid configuration '$1': Blank OS only allowed with explicit machine code file format" 1>&2 + fi + ;; *) echo "Invalid configuration '$1': OS '$os' not recognized" 1>&2 exit 1 ;; esac +case $obj in + aout* | coff* | elf* | pe*) + ;; + '') + # empty is fine + ;; + *) + echo "Invalid configuration '$1': Machine code format '$obj' not recognized" 1>&2 + exit 1 + ;; +esac + +# Here we handle the constraint that a (synthetic) cpu and os are +# valid only in combination with each other and nowhere else. +case $cpu-$os in + # The "javascript-unknown-ghcjs" triple is used by GHC; we + # accept it here in order to tolerate that, but reject any + # variations. + javascript-ghcjs) + ;; + javascript-* | *-ghcjs) + echo "Invalid configuration '$1': cpu '$cpu' is not valid with os '$os$obj'" 1>&2 + exit 1 + ;; +esac + # As a final step for OS-related things, validate the OS-kernel combination # (given a valid OS), if there is a kernel. -case $kernel-$os in - linux-gnu* | linux-dietlibc* | linux-android* | linux-newlib* \ - | linux-musl* | linux-relibc* | linux-uclibc* | linux-mlibc* ) +case $kernel-$os-$obj in + linux-gnu*- | linux-android*- | linux-dietlibc*- | linux-llvm*- \ + | linux-mlibc*- | linux-musl*- | linux-newlib*- \ + | linux-relibc*- | linux-uclibc*- ) ;; - uclinux-uclibc* ) + uclinux-uclibc*- ) ;; - managarm-mlibc* | managarm-kernel* ) + managarm-mlibc*- | managarm-kernel*- ) ;; - windows*-gnu* | windows*-msvc*) + windows*-msvc*-) ;; - -dietlibc* | -newlib* | -musl* | -relibc* | -uclibc* | -mlibc* ) + -dietlibc*- | -llvm*- | -mlibc*- | -musl*- | -newlib*- | -relibc*- \ + | -uclibc*- ) # These are just libc implementations, not actual OSes, and thus # require a kernel. echo "Invalid configuration '$1': libc '$os' needs explicit kernel." 1>&2 exit 1 ;; - -kernel* ) + -kernel*- ) echo "Invalid configuration '$1': '$os' needs explicit kernel." 1>&2 exit 1 ;; - *-kernel* ) + *-kernel*- ) echo "Invalid configuration '$1': '$kernel' does not support '$os'." 1>&2 exit 1 ;; - *-msvc* ) + *-msvc*- ) echo "Invalid configuration '$1': '$os' needs 'windows'." 1>&2 exit 1 ;; - kfreebsd*-gnu* | kopensolaris*-gnu*) + kfreebsd*-gnu*- | kopensolaris*-gnu*-) ;; - vxworks-simlinux | vxworks-simwindows | vxworks-spe) + vxworks-simlinux- | vxworks-simwindows- | vxworks-spe-) ;; - nto-qnx*) + nto-qnx*-) ;; - os2-emx) + os2-emx-) ;; - *-eabi* | *-gnueabi*) + *-eabi*- | *-gnueabi*-) ;; - none-coff* | none-elf*) + none--*) # None (no kernel, i.e. freestanding / bare metal), - # can be paired with an output format "OS" + # can be paired with an machine code file format ;; - -*) + -*-) # Blank kernel with real OS is always fine. ;; - *-*) + --*) + # Blank kernel and OS with real machine code file format is always fine. + ;; + *-*-*) echo "Invalid configuration '$1': Kernel '$kernel' not known to work with OS '$os'." 1>&2 exit 1 ;; @@ -1884,7 +1960,7 @@ case $vendor in ;; esac -echo "$cpu-$vendor-${kernel:+$kernel-}$os" +echo "$cpu-$vendor${kernel:+-$kernel}${os:+-$os}${obj:+-$obj}" exit # Local variables: diff --git a/build-aux/install-sh b/build-aux/install-sh index ec298b53740..7c56c9c0151 100755 --- a/build-aux/install-sh +++ b/build-aux/install-sh @@ -1,7 +1,7 @@ #!/bin/sh # install - install a program, script, or datafile -scriptversion=2020-11-14.01; # UTC +scriptversion=2023-11-23.18; # UTC # This originates from X11R5 (mit/util/scripts/install.sh), which was # later released in X11R6 (xc/config/util/install.sh) with the @@ -124,9 +124,9 @@ it's up to you to specify -f if you want it. If -S is not specified, no backups are attempted. -Email bug reports to bug-automake@gnu.org. -Automake home page: https://www.gnu.org/software/automake/ -" +Report bugs to . +GNU Automake home page: . +General help using GNU software: ." while test $# -ne 0; do case $1 in diff --git a/build-aux/update-copyright b/build-aux/update-copyright index 6d56e48fdb1..ea3e46fe60f 100755 --- a/build-aux/update-copyright +++ b/build-aux/update-copyright @@ -138,7 +138,7 @@ eval 'exec perl -wSx -0777 -pi "$0" "$@"' if 0; -my $VERSION = '2023-06-18.01:14'; # UTC +my $VERSION = '2024-01-15.18:30'; # UTC # The definition above must lie within the first 8 lines in order # for the Emacs time-stamp write hook (at end) to update it. # If you change this file with Emacs, please let the write hook @@ -146,6 +146,7 @@ my $VERSION = '2023-06-18.01:14'; # UTC use strict; use warnings; +use re 'eval'; my $copyright_re = 'Copyright'; my $circle_c_re = '(?:\([cC]\)|@copyright\{}|\\\\\(co|©|©)'; @@ -169,14 +170,13 @@ if (!$this_year || $this_year !~ m/^\d{4}$/) # Unless the file consistently uses "\r\n" as the EOL, use "\n" instead. my $eol = /(?:^|[^\r])\n/ ? "\n" : "\r\n"; -my $leading; -my $prefix; -my $ws_re; my $stmt_re; -while (/(^|\n)(.{0,$prefix_max})$copyright_re/g) +my $found; +while (/(^|\n)(.{0,$prefix_max})$copyright_re/cg) { - $leading = "$1$2"; - $prefix = $2; + my $pos=pos(); + my $leading = "$1$2"; + my $prefix = $2; if ($prefix =~ /^(\s*\/)\*(\s*)$/) { $prefix =~ s,/, ,; @@ -187,7 +187,7 @@ while (/(^|\n)(.{0,$prefix_max})$copyright_re/g) $prefix = $prefix_ws; } } - $ws_re = '[ \t\r\f]'; # \s without \n + my $ws_re = '[ \t\r\f]'; # \s without \n $ws_re = "(?:$ws_re*(?:$ws_re|\\n" . quotemeta($prefix) . ")$ws_re*)"; my $holder_re = $holder; @@ -198,96 +198,97 @@ while (/(^|\n)(.{0,$prefix_max})$copyright_re/g) . "((?:\\d\\d)?\\d\\d)$ws_re$holder_re"; if (/\G$stmt_remainder_re/) { + $found = 1; $stmt_re = quotemeta($leading) . "($copyright_re$stmt_remainder_re)"; - last; - } - } -if (defined $stmt_re) - { - /$stmt_re/ or die; # Should never die. - my $stmt = $1; - my $final_year_orig = $2; - # Handle two-digit year numbers like "98" and "99". - my $final_year = $final_year_orig; - $final_year <= 99 - and $final_year += 1900; + /$stmt_re/ or die; # Should never die. + my $stmt = $1; + my $final_year_orig = $2; - if ($final_year != $this_year) - { - # Update the year. - $stmt =~ s/(^|[^\d])$final_year_orig\b/$1$final_year, $this_year/; - } - if ($final_year != $this_year || $ENV{'UPDATE_COPYRIGHT_FORCE'}) - { - # Normalize all whitespace including newline-prefix sequences. - $stmt =~ s/$ws_re/ /g; + # Handle two-digit year numbers like "98" and "99". + my $final_year = $final_year_orig; + $final_year <= 99 + and $final_year += 1900; - # Put spaces after commas. - $stmt =~ s/, ?/, /g; - - # Convert 2-digit to 4-digit years. - $stmt =~ s/(\b\d\d\b)/19$1/g; - - # Make the use of intervals consistent. - if (!$ENV{UPDATE_COPYRIGHT_USE_INTERVALS}) + if ($final_year != $this_year) { - $stmt =~ s/(\d{4})$ndash_re(\d{4})/join(', ', $1..$2)/eg; + # Update the year. + $stmt =~ s/(^|[^\d])$final_year_orig\b/$1$final_year, $this_year/; } - else + if ($final_year != $this_year || $ENV{'UPDATE_COPYRIGHT_FORCE'}) { - my $ndash = ($ARGV =~ /\.tex(i(nfo)?)?$/ ? "--" - : $ARGV =~ /\.(\d[a-z]*|man)$/ ? "\\(en" - : "-"); + # Normalize all whitespace including newline-prefix sequences. + $stmt =~ s/$ws_re/ /g; - $stmt =~ - s/ - (\d{4}) - (?: - (,\ |$ndash_re) - ((??{ - if ($2 ne ', ') { '\d{4}'; } - elsif (!$3) { $1 + 1; } - else { $3 + 1; } - })) - )+ - /$1$ndash$3/gx; + # Put spaces after commas. + $stmt =~ s/, ?/, /g; - # When it's 2, emit a single range encompassing all year numbers. - $ENV{UPDATE_COPYRIGHT_USE_INTERVALS} == 2 - and $stmt =~ s/(^|[^\d])(\d{4})\b.*(?:[^\d])(\d{4})\b/$1$2$ndash$3/; - } + # Convert 2-digit to 4-digit years. + $stmt =~ s/(\b\d\d\b)/19$1/g; - # Format within margin. - my $stmt_wrapped; - my $text_margin = $margin - length($prefix); - if ($prefix =~ /^(\t+)/) - { - $text_margin -= length($1) * ($tab_width - 1); - } - while (length $stmt) - { - if (($stmt =~ s/^(.{1,$text_margin})(?: |$)//) - || ($stmt =~ s/^([\S]+)(?: |$)//)) + # Make the use of intervals consistent. + if (!$ENV{UPDATE_COPYRIGHT_USE_INTERVALS}) { - my $line = $1; - $stmt_wrapped .= $stmt_wrapped ? "$eol$prefix" : $leading; - $stmt_wrapped .= $line; + $stmt =~ s/(\d{4})$ndash_re(\d{4})/join(', ', $1..$2)/eg; } else { - # Should be unreachable, but we don't want an infinite - # loop if it can be reached. - die; + my $ndash = ($ARGV =~ /\.tex(i(nfo)?)?$/ ? "--" + : $ARGV =~ /\.(\d[a-z]*|man)$/ ? "\\(en" + : "-"); + + $stmt =~ + s/ + (\d{4}) + (?: + (,\ |$ndash_re) + ((??{ + if ($2 ne ', ') { '\d{4}'; } + elsif (!$3) { $1 + 1; } + else { $3 + 1; } + })) + )+ + /$1$ndash$3/gx; + + # When it's 2, emit a single range encompassing all year numbers. + $ENV{UPDATE_COPYRIGHT_USE_INTERVALS} == 2 + and $stmt =~ s/(^|[^\d])(\d{4})\b.*(?:[^\d])(\d{4})\b/$1$2$ndash$3/; } - } - # Replace the old copyright statement. - s/$stmt_re/$stmt_wrapped/g; + # Format within margin. + my $stmt_wrapped; + my $text_margin = $margin - length($prefix); + if ($prefix =~ /^(\t+)/) + { + $text_margin -= length($1) * ($tab_width - 1); + } + while (length $stmt) + { + if (($stmt =~ s/^(.{1,$text_margin})(?: |$)//) + || ($stmt =~ s/^([\S]+)(?: |$)//)) + { + my $line = $1; + $stmt_wrapped .= $stmt_wrapped ? "$eol$prefix" : $leading; + $stmt_wrapped .= $line; + } + else + { + # Should be unreachable, but we don't want an infinite + # loop if it can be reached. + die; + } + } + + # Replace the old copyright statement. + my $p = pos(); + s/$stmt_re/$stmt_wrapped/g; + pos() = $p; + } } } -else + +if (!$found) { print STDERR "$ARGV: warning: copyright statement not found\n"; } diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index 7fd371c1d9d..e8c382f5967 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,9 +3,9 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2024-01-02.10} +\def\texinfoversion{2023-09-19.19} % -% Copyright 1985--1986, 1988, 1990--2024 Free Software Foundation, Inc. +% Copyright 1985, 1986, 1988, 1990-2023 Free Software Foundation, Inc. % % This texinfo.tex file is free software: you can redistribute it and/or % modify it under the terms of the GNU General Public License as @@ -5652,42 +5652,13 @@ might help (with 'rm \jobname.?? \jobname.??s')% \parfillskip=0pt plus -1fill % \advance\rightskip by \entryrightmargin - % Determine how far we can stretch into the margin. - % This allows, e.g., "Appendix H GNU Free Documentation License" to - % fit on one line in @letterpaper format. - \ifdim\entryrightmargin>2.1em - \dimen@i=2.1em - \else - \dimen@i=0em - \fi - \advance \parfillskip by 0pt minus 1\dimen@i % \dimen@ii = \hsize \advance\dimen@ii by -1\leftskip \advance\dimen@ii by -1\entryrightmargin - \advance\dimen@ii by 1\dimen@i \ifdim\wd\boxA > \dimen@ii % If the entry doesn't fit in one line \ifdim\dimen@ > 0.8\dimen@ii % due to long index text - % Undo changes above - \advance \parfillskip by 0pt minus -1\dimen@i - \advance\dimen@ii by -1\dimen@i - % - % Try to split the text roughly evenly. \dimen@ will be the length of - % the first line. - \dimen@ = 0.7\dimen@ - \dimen@ii = \hsize - \ifnum\dimen@>\dimen@ii - % If the entry is too long (for example, if it needs more than - % two lines), use the same line length for all lines. - \dimen@ = \dimen@ii - \else - \advance \dimen@ by 1\rightskip - \fi \advance\leftskip by 0pt plus 1fill % ragged right - \parshape = 2 0pt \dimen@ 0em \dimen@ii - % Ideally we'd add a finite glue at the end of the first line only, - % instead of using \parshape with explicit line lengths, but TeX - % doesn't seem to provide a way to do such a thing. % % Indent all lines but the first one. \advance\leftskip by \entrycontskip @@ -5714,12 +5685,11 @@ might help (with 'rm \jobname.?? \jobname.??s')% \newskip\thinshrinkable \skip\thinshrinkable=.15em minus .15em -% Like plain.tex's \dotfill, except uses up at least 1 em. +% Like plain.tex's \dotfill, except uses up at least 0.5 em. % The filll stretch here overpowers both the fil and fill stretch to push % the page number to the right. \def\indexdotfill{\cleaders - \hbox{$\mathsurround=0pt \mkern1.5mu.\mkern1.5mu$}\hskip 1em plus 1filll} - + \hbox{$\mathsurround=0pt \mkern1.5mu.\mkern1.5mu$}\hskip 0.5em plus 1filll} \def\primary #1{\line{#1\hfil}} @@ -7709,9 +7679,13 @@ might help (with 'rm \jobname.?? \jobname.??s')% \def\deflineheader#1 #2 #3\endheader{% \printdefname{#1}{}{#2}\magicamp\defunargs{#3\unskip}% } + \def\deftypeline{% \doingtypefntrue - \parseargusing\activeparens{\printdefunline\deflineheader}% + \parseargusing\activeparens{\printdefunline\deftypelineheader}% +} +\def\deftypelineheader#1 #2 #3 #4\endheader{% + \printdefname{#1}{#2}{#3}\magicamp\defunargs{#4\unskip}% } % \makedefun{deffoo} (\deffooheader parameters) { (\deffooheader expansion) } @@ -8846,6 +8820,11 @@ might help (with 'rm \jobname.?? \jobname.??s')% \fi } +% @nodedescription, @nodedescriptionblock - do nothing for TeX +\parseargdef\nodedescription{} +\def\nodedescriptionblock{\doignore{nodedescriptionblock}} + + % @anchor{NAME} -- define xref target at arbitrary point. % \newcount\savesfregister @@ -11859,9 +11838,13 @@ directory should work if nowhere else does.} \def\c{\loadconf\c}% % Definition for the first newline read in the file \def ^^M{\loadconf}% - % In case the first line has a whole-line command on it + % In case the first line has a whole-line or environment command on it \let\originalparsearg\parsearg% \def\parsearg{\loadconf\originalparsearg}% + % + % \startenvironment is in the expansion of commands defined with \envdef + \let\originalstartenvironment\startenvironment% + \def\startenvironment{\loadconf\startenvironment}% }} @@ -11889,6 +11872,7 @@ directory should work if nowhere else does.} \enableemergencynewline \let\c=\comment \let\parsearg\originalparsearg + \let\startenvironment\originalstartenvironment % % Also turn back on active characters that might appear in the input % file name, in case not using a pre-dumped format. diff --git a/lib/acl-internal.h b/lib/acl-internal.h index 4de891d3f22..ef1f84dc243 100644 --- a/lib/acl-internal.h +++ b/lib/acl-internal.h @@ -52,9 +52,6 @@ extern int aclsort (int, int, struct acl *); #include #include -#ifndef MIN -# define MIN(a,b) ((a) < (b) ? (a) : (b)) -#endif #ifndef SIZE_MAX # define SIZE_MAX ((size_t) -1) diff --git a/lib/alloca.in.h b/lib/alloca.in.h index 49c86125b69..6aa47df8ec3 100644 --- a/lib/alloca.in.h +++ b/lib/alloca.in.h @@ -1,7 +1,7 @@ /* Memory allocation on the stack. - Copyright (C) 1995, 1999, 2001-2004, 2006-2024 Free Software - Foundation, Inc. + Copyright (C) 1995, 1999, 2001-2004, 2006-2024 Free Software Foundation, + Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/attribute.h b/lib/attribute.h index 9504c625e59..710341ba417 100644 --- a/lib/attribute.h +++ b/lib/attribute.h @@ -182,6 +182,8 @@ /* The function does not throw exceptions. */ /* Applies to: functions. */ +/* After a function's parameter list, this attribute must come first, before + other attributes. */ #define ATTRIBUTE_NOTHROW _GL_ATTRIBUTE_NOTHROW /* Do not inline the function. */ diff --git a/lib/binary-io.h b/lib/binary-io.h index 33e3de1d1de..0cc5c11748c 100644 --- a/lib/binary-io.h +++ b/lib/binary-io.h @@ -1,6 +1,5 @@ /* Binary mode I/O. - Copyright (C) 2001, 2003, 2005, 2008-2024 Free Software Foundation, - Inc. + Copyright (C) 2001, 2003, 2005, 2008-2024 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/boot-time-aux.h b/lib/boot-time-aux.h index a7babf6dc64..8b966fe691f 100644 --- a/lib/boot-time-aux.h +++ b/lib/boot-time-aux.h @@ -86,15 +86,21 @@ get_linux_uptime (struct timespec *p_uptime) static int get_linux_boot_time_fallback (struct timespec *p_boot_time) { - /* On Alpine Linux, UTMP_FILE is not filled. It is always empty. - So, get the time stamp of a file that gets touched only during the - boot process. */ + /* On Devuan with the 'runit' init system and on Artix with the 's6' init + system, UTMP_FILE contains USER_PROCESS and other entries, but no + BOOT_TIME entry. + On Alpine Linux, UTMP_FILE is not filled. It is always empty. + So, in both cases, get the time stamp of a file that gets touched only + during the boot process. */ const char * const boot_touched_files[] = { "/var/lib/systemd/random-seed", /* seen on distros with systemd */ - "/var/run/utmp", /* seen on distros with OpenRC */ - "/var/lib/random-seed" /* seen on older distros */ + "/var/lib/urandom/random-seed", /* seen on Devuan with runit */ + "/var/lib/random-seed", /* seen on Artix with s6 */ + /* This must come last, since on several distros /var/run/utmp is + modified when a user logs in, i.e. long after boot. */ + "/var/run/utmp" /* seen on Alpine Linux with OpenRC */ }; for (idx_t i = 0; i < SIZEOF (boot_touched_files); i++) { diff --git a/lib/boot-time.c b/lib/boot-time.c index f560914962b..c1171e8024d 100644 --- a/lib/boot-time.c +++ b/lib/boot-time.c @@ -203,7 +203,14 @@ get_boot_time_uncached (struct timespec *p_boot_time) } # endif -# else /* old FreeBSD, OpenBSD, native Windows */ +# else /* Adélie Linux, old FreeBSD, OpenBSD, native Windows */ + +# if defined __linux__ && !defined __ANDROID__ + /* Workaround for Adélie Linux: */ + get_linux_boot_time_fallback (&found_boot_time); + if (found_boot_time.tv_sec == 0) + get_linux_boot_time_final_fallback (&found_boot_time); +# endif # if defined __OpenBSD__ /* Workaround for OpenBSD: */ diff --git a/lib/c-ctype.h b/lib/c-ctype.h index 016fe7c3b11..b582de4a7fd 100644 --- a/lib/c-ctype.h +++ b/lib/c-ctype.h @@ -5,8 +5,7 @@ functions' behaviour depends on the current locale set via setlocale. - Copyright (C) 2000-2003, 2006, 2008-2024 Free Software Foundation, - Inc. + Copyright (C) 2000-2003, 2006, 2008-2024 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/c-strcasecmp.c b/lib/c-strcasecmp.c index a4bad4f2e2f..1fa575a8562 100644 --- a/lib/c-strcasecmp.c +++ b/lib/c-strcasecmp.c @@ -1,6 +1,5 @@ /* c-strcasecmp.c -- case insensitive string comparator in C locale - Copyright (C) 1998-1999, 2005-2006, 2009-2024 Free Software - Foundation, Inc. + Copyright (C) 1998-1999, 2005-2006, 2009-2024 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/c-strncasecmp.c b/lib/c-strncasecmp.c index 693601586be..4c8b0b6b841 100644 --- a/lib/c-strncasecmp.c +++ b/lib/c-strncasecmp.c @@ -1,6 +1,5 @@ /* c-strncasecmp.c -- case insensitive string comparator in C locale - Copyright (C) 1998-1999, 2005-2006, 2009-2024 Free Software - Foundation, Inc. + Copyright (C) 1998-1999, 2005-2006, 2009-2024 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/careadlinkat.c b/lib/careadlinkat.c index 9d77aa7067a..f308b6963ae 100644 --- a/lib/careadlinkat.c +++ b/lib/careadlinkat.c @@ -1,7 +1,7 @@ /* Read symbolic links into a buffer without size limitation, relative to fd. - Copyright (C) 2001, 2003-2004, 2007, 2009-2024 Free Software - Foundation, Inc. + Copyright (C) 2001, 2003-2004, 2007, 2009-2024 Free Software Foundation, + Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/cloexec.c b/lib/cloexec.c index b4279752880..cdb0d740eb7 100644 --- a/lib/cloexec.c +++ b/lib/cloexec.c @@ -1,7 +1,6 @@ /* cloexec.c - set or clear the close-on-exec descriptor flag - Copyright (C) 1991, 2004-2006, 2009-2024 Free Software Foundation, - Inc. + Copyright (C) 1991, 2004-2006, 2009-2024 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/close-stream.c b/lib/close-stream.c index ae53f93aabe..81094c6863c 100644 --- a/lib/close-stream.c +++ b/lib/close-stream.c @@ -1,7 +1,6 @@ /* Close a stream, with nicer error checking than fclose's. - Copyright (C) 1998-2002, 2004, 2006-2024 Free Software Foundation, - Inc. + Copyright (C) 1998-2002, 2004, 2006-2024 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/diffseq.h b/lib/diffseq.h index 7f8fa0bc6d3..0c5bc9cbc6d 100644 --- a/lib/diffseq.h +++ b/lib/diffseq.h @@ -1,7 +1,7 @@ /* Analyze differences between two vectors. - Copyright (C) 1988-1989, 1992-1995, 2001-2004, 2006-2024 Free - Software Foundation, Inc. + Copyright (C) 1988-1989, 1992-1995, 2001-2004, 2006-2024 Free Software + Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/dirent.in.h b/lib/dirent.in.h index 425550ab3ab..f05b880077f 100644 --- a/lib/dirent.in.h +++ b/lib/dirent.in.h @@ -237,12 +237,6 @@ _GL_WARN_ON_USE (rewinddir, "rewinddir is not portable - " _GL_FUNCDECL_RPL (dirfd, int, (DIR *) _GL_ARG_NONNULL ((1))); _GL_CXXALIAS_RPL (dirfd, int, (DIR *)); -# ifdef __KLIBC__ -/* Gnulib internal hooks needed to maintain the dirfd metadata. */ -_GL_EXTERN_C int _gl_register_dirp_fd (int fd, DIR *dirp) - _GL_ARG_NONNULL ((2)); -_GL_EXTERN_C void _gl_unregister_dirp_fd (int fd); -# endif # else # if defined __cplusplus && defined GNULIB_NAMESPACE && defined dirfd /* dirfd is defined as a macro and not as a function. diff --git a/lib/dirfd.c b/lib/dirfd.c index 70600f2a75a..afcf382e301 100644 --- a/lib/dirfd.c +++ b/lib/dirfd.c @@ -26,59 +26,6 @@ # include "dirent-private.h" #endif -#ifdef __KLIBC__ -# include -# include - -static struct dirp_fd_list -{ - DIR *dirp; - int fd; - struct dirp_fd_list *next; -} *dirp_fd_start = NULL; - -/* Register fd associated with dirp to dirp_fd_list. */ -int -_gl_register_dirp_fd (int fd, DIR *dirp) -{ - struct dirp_fd_list *new_dirp_fd = malloc (sizeof *new_dirp_fd); - if (!new_dirp_fd) - return -1; - - new_dirp_fd->dirp = dirp; - new_dirp_fd->fd = fd; - new_dirp_fd->next = dirp_fd_start; - - dirp_fd_start = new_dirp_fd; - - return 0; -} - -/* Unregister fd from dirp_fd_list with closing it */ -void -_gl_unregister_dirp_fd (int fd) -{ - struct dirp_fd_list *dirp_fd; - struct dirp_fd_list *dirp_fd_prev; - - for (dirp_fd_prev = NULL, dirp_fd = dirp_fd_start; dirp_fd; - dirp_fd_prev = dirp_fd, dirp_fd = dirp_fd->next) - { - if (dirp_fd->fd == fd) - { - if (dirp_fd_prev) - dirp_fd_prev->next = dirp_fd->next; - else /* dirp_fd == dirp_fd_start */ - dirp_fd_start = dirp_fd_start->next; - - close (fd); - free (dirp_fd); - break; - } - } -} -#endif - int dirfd (DIR *dir_p) { @@ -90,19 +37,7 @@ dirfd (DIR *dir_p) #else int fd = DIR_TO_FD (dir_p); if (fd == -1) -# ifndef __KLIBC__ errno = ENOTSUP; -# else - { - struct dirp_fd_list *dirp_fd; - - for (dirp_fd = dirp_fd_start; dirp_fd; dirp_fd = dirp_fd->next) - if (dirp_fd->dirp == dir_p) - return dirp_fd->fd; - - errno = EINVAL; - } -# endif return fd; #endif diff --git a/lib/dup2.c b/lib/dup2.c index 7e1960e48d3..916e113dd89 100644 --- a/lib/dup2.c +++ b/lib/dup2.c @@ -1,7 +1,6 @@ /* Duplicate an open file descriptor to a specified file descriptor. - Copyright (C) 1999, 2004-2007, 2009-2024 Free Software Foundation, - Inc. + Copyright (C) 1999, 2004-2007, 2009-2024 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/faccessat.c b/lib/faccessat.c index f82eca2dbe3..8178ca8632e 100644 --- a/lib/faccessat.c +++ b/lib/faccessat.c @@ -40,10 +40,14 @@ orig_faccessat (int fd, char const *name, int mode, int flag) } #endif +#ifdef __osf__ /* Write "unistd.h" here, not , otherwise OSF/1 5.1 DTK cc eliminates this include because of the preliminary #include above. */ -#include "unistd.h" +# include "unistd.h" +#else +# include +#endif #ifndef HAVE_ACCESS /* Mingw lacks access, but it also lacks real vs. effective ids, so diff --git a/lib/fdopendir.c b/lib/fdopendir.c index e49abec4f62..bdbb2ea912f 100644 --- a/lib/fdopendir.c +++ b/lib/fdopendir.c @@ -44,42 +44,6 @@ fdopendir (int fd) return dirp; } -# elif defined __KLIBC__ - -# include - -DIR * -fdopendir (int fd) -{ - char path[_MAX_PATH]; - DIR *dirp; - - /* Get a path from fd */ - if (__libc_Back_ioFHToPath (fd, path, sizeof (path))) - return NULL; - - dirp = opendir (path); - if (!dirp) - return NULL; - - /* Unregister fd registered by opendir() */ - _gl_unregister_dirp_fd (dirfd (dirp)); - - /* Register our fd */ - if (_gl_register_dirp_fd (fd, dirp)) - { - int saved_errno = errno; - - closedir (dirp); - - errno = saved_errno; - - dirp = NULL; - } - - return dirp; -} - # else /* We are not in control of the file descriptor of a DIR, and therefore have to play tricks with file descriptors before and after a call to opendir(). */ diff --git a/lib/filemode.h b/lib/filemode.h index bb601c11d3f..2dee82f0be1 100644 --- a/lib/filemode.h +++ b/lib/filemode.h @@ -1,7 +1,7 @@ /* Make a string describing file modes. - Copyright (C) 1998-1999, 2003, 2006, 2009-2024 Free Software - Foundation, Inc. + Copyright (C) 1998-1999, 2003, 2006, 2009-2024 Free Software Foundation, + Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/fpending.c b/lib/fpending.c index 8d90bdee51b..51468955844 100644 --- a/lib/fpending.c +++ b/lib/fpending.c @@ -1,6 +1,6 @@ /* fpending.c -- return the number of pending output bytes on a stream - Copyright (C) 2000, 2004, 2006-2007, 2009-2024 Free Software - Foundation, Inc. + Copyright (C) 2000, 2004, 2006-2007, 2009-2024 Free Software Foundation, + Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/fpending.h b/lib/fpending.h index 15122915254..28db3b403d9 100644 --- a/lib/fpending.h +++ b/lib/fpending.h @@ -1,7 +1,7 @@ /* Declare __fpending. - Copyright (C) 2000, 2003, 2005-2006, 2009-2024 Free Software - Foundation, Inc. + Copyright (C) 2000, 2003, 2005-2006, 2009-2024 Free Software Foundation, + Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/fsusage.c b/lib/fsusage.c index d99a02f01f3..97d0eef7aa8 100644 --- a/lib/fsusage.c +++ b/lib/fsusage.c @@ -1,7 +1,7 @@ /* fsusage.c -- return space usage of mounted file systems - Copyright (C) 1991-1992, 1996, 1998-1999, 2002-2006, 2009-2024 Free - Software Foundation, Inc. + Copyright (C) 1991-1992, 1996, 1998-1999, 2002-2006, 2009-2024 Free Software + Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/getgroups.c b/lib/getgroups.c index 346954adaad..9f4908e9977 100644 --- a/lib/getgroups.c +++ b/lib/getgroups.c @@ -1,7 +1,6 @@ /* provide consistent interface to getgroups for systems that don't allow N==0 - Copyright (C) 1996, 1999, 2003, 2006-2024 Free Software Foundation, - Inc. + Copyright (C) 1996, 1999, 2003, 2006-2024 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/getloadavg.c b/lib/getloadavg.c index 7f0a236c870..c940e4c7ee0 100644 --- a/lib/getloadavg.c +++ b/lib/getloadavg.c @@ -1,7 +1,7 @@ /* Get the system load averages. - Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2024 Free - Software Foundation, Inc. + Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2024 Free Software + Foundation, Inc. NOTE: The canonical source of this file is maintained with gnulib. Bugs can be reported to bug-gnulib@gnu.org. diff --git a/lib/getopt-cdefs.in.h b/lib/getopt-cdefs.in.h index 7a791392de5..a1d304d49e8 100644 --- a/lib/getopt-cdefs.in.h +++ b/lib/getopt-cdefs.in.h @@ -57,7 +57,11 @@ #ifndef __THROW # if defined __cplusplus && (__GNUC_PREREQ (2,8) || __clang_major__ >= 4) -# define __THROW throw () +# if __cplusplus >= 201103L +# define __THROW noexcept (true) +# else +# define __THROW throw () +# endif # else # define __THROW # endif diff --git a/lib/getopt.c b/lib/getopt.c index e2951f74601..f66f119ec50 100644 --- a/lib/getopt.c +++ b/lib/getopt.c @@ -21,7 +21,7 @@ # include #endif -#include "getopt.h" +#include #include #include @@ -223,8 +223,9 @@ process_long_option (int argc, char **argv, const char *optstring, { /* Didn't find an exact match, so look for abbreviations. */ unsigned char *ambig_set = NULL; - int ambig_malloced = 0; - int ambig_fallback = 0; + /* Use simpler fallback diagnostic if ambig_set == &ambig_fallback. */ + unsigned char ambig_fallback; + void *ambig_malloced = NULL; int indfound = -1; for (p = longopts, option_index = 0; p->name; p++, option_index++) @@ -242,39 +243,42 @@ process_long_option (int argc, char **argv, const char *optstring, || pfound->val != p->val) { /* Second or later nonexact match found. */ - if (!ambig_fallback) + if (ambig_set != &ambig_fallback) { if (!print_errors) /* Don't waste effort tracking the ambig set if we're not going to print it anyway. */ - ambig_fallback = 1; + ambig_set = &ambig_fallback; else if (!ambig_set) { if (__libc_use_alloca (n_options)) ambig_set = alloca (n_options); - else if ((ambig_set = malloc (n_options)) == NULL) - /* Fall back to simpler error message. */ - ambig_fallback = 1; else - ambig_malloced = 1; + { + ambig_malloced = malloc (n_options); + /* Fall back to simpler diagnostic if + memory allocation fails. */ + ambig_set = (ambig_malloced ? ambig_malloced + : &ambig_fallback); + } - if (ambig_set) + if (ambig_set != &ambig_fallback) { memset (ambig_set, 0, n_options); ambig_set[indfound] = 1; } } - if (ambig_set) + if (ambig_set && ambig_set != &ambig_fallback) ambig_set[option_index] = 1; } } } - if (ambig_set || ambig_fallback) + if (ambig_set) { if (print_errors) { - if (ambig_fallback) + if (ambig_set == &ambig_fallback) fprintf (stderr, _("%s: option '%s%s' is ambiguous\n"), argv[0], prefix, d->__nextchar); else @@ -296,8 +300,7 @@ process_long_option (int argc, char **argv, const char *optstring, funlockfile (stderr); } } - if (ambig_malloced) - free (ambig_set); + free (ambig_malloced); d->__nextchar += strlen (d->__nextchar); d->optind++; d->optopt = 0; diff --git a/lib/getopt1.c b/lib/getopt1.c index 0c8e29b5b91..c42d29f8b57 100644 --- a/lib/getopt1.c +++ b/lib/getopt1.c @@ -21,7 +21,7 @@ # include #endif -#include "getopt.h" +#include #include "getopt_int.h" int diff --git a/lib/gettext.h b/lib/gettext.h index 970032306e5..39d5ae4daa5 100644 --- a/lib/gettext.h +++ b/lib/gettext.h @@ -1,6 +1,6 @@ /* Convenience header for conditional use of GNU . - Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2024 Free - Software Foundation, Inc. + Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2024 Free Software + Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/gettime.c b/lib/gettime.c index 1f6d960713b..38d36859415 100644 --- a/lib/gettime.c +++ b/lib/gettime.c @@ -1,7 +1,6 @@ /* gettime -- get the system clock - Copyright (C) 2002, 2004-2007, 2009-2024 Free Software Foundation, - Inc. + Copyright (C) 2002, 2004-2007, 2009-2024 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/gettimeofday.c b/lib/gettimeofday.c index ddef1425a4d..8dd26f73c03 100644 --- a/lib/gettimeofday.c +++ b/lib/gettimeofday.c @@ -1,7 +1,6 @@ /* Provide gettimeofday for systems that don't have it or for which it's broken. - Copyright (C) 2001-2003, 2005-2007, 2009-2024 Free Software - Foundation, Inc. + Copyright (C) 2001-2003, 2005-2007, 2009-2024 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index add29f83883..fcf2b186038 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -34,6 +34,7 @@ # --no-libtool \ # --macro-prefix=gl \ # --no-vc-files \ +# --avoid=access \ # --avoid=btowc \ # --avoid=chmod \ # --avoid=close \ @@ -563,6 +564,7 @@ GL_GNULIB_PUTS = @GL_GNULIB_PUTS@ GL_GNULIB_PWRITE = @GL_GNULIB_PWRITE@ GL_GNULIB_QSORT_R = @GL_GNULIB_QSORT_R@ GL_GNULIB_RAISE = @GL_GNULIB_RAISE@ +GL_GNULIB_RAND = @GL_GNULIB_RAND@ GL_GNULIB_RANDOM = @GL_GNULIB_RANDOM@ GL_GNULIB_RANDOM_R = @GL_GNULIB_RANDOM_R@ GL_GNULIB_RAWMEMCHR = @GL_GNULIB_RAWMEMCHR@ @@ -1123,6 +1125,7 @@ REPLACE_EXECVE = @REPLACE_EXECVE@ REPLACE_EXECVP = @REPLACE_EXECVP@ REPLACE_EXECVPE = @REPLACE_EXECVPE@ REPLACE_FACCESSAT = @REPLACE_FACCESSAT@ +REPLACE_FCHDIR = @REPLACE_FCHDIR@ REPLACE_FCHMODAT = @REPLACE_FCHMODAT@ REPLACE_FCHOWNAT = @REPLACE_FCHOWNAT@ REPLACE_FCLOSE = @REPLACE_FCLOSE@ @@ -1212,6 +1215,7 @@ REPLACE_PUTENV = @REPLACE_PUTENV@ REPLACE_PWRITE = @REPLACE_PWRITE@ REPLACE_QSORT_R = @REPLACE_QSORT_R@ REPLACE_RAISE = @REPLACE_RAISE@ +REPLACE_RAND = @REPLACE_RAND@ REPLACE_RANDOM = @REPLACE_RANDOM@ REPLACE_RANDOM_R = @REPLACE_RANDOM_R@ REPLACE_READ = @REPLACE_READ@ @@ -1261,6 +1265,7 @@ REPLACE_STRTOUL = @REPLACE_STRTOUL@ REPLACE_STRTOULL = @REPLACE_STRTOULL@ REPLACE_STRTOUMAX = @REPLACE_STRTOUMAX@ REPLACE_STRUCT_TIMEVAL = @REPLACE_STRUCT_TIMEVAL@ +REPLACE_STRVERSCMP = @REPLACE_STRVERSCMP@ REPLACE_SYMLINK = @REPLACE_SYMLINK@ REPLACE_SYMLINKAT = @REPLACE_SYMLINKAT@ REPLACE_TIME = @REPLACE_TIME@ @@ -3326,6 +3331,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ -e 's/@''GNULIB_PTSNAME_R''@/$(GL_GNULIB_PTSNAME_R)/g' \ -e 's/@''GNULIB_PUTENV''@/$(GL_GNULIB_PUTENV)/g' \ -e 's/@''GNULIB_QSORT_R''@/$(GL_GNULIB_QSORT_R)/g' \ + -e 's/@''GNULIB_RAND''@/$(GL_GNULIB_RAND)/g' \ -e 's/@''GNULIB_RANDOM''@/$(GL_GNULIB_RANDOM)/g' \ -e 's/@''GNULIB_RANDOM_R''@/$(GL_GNULIB_RANDOM_R)/g' \ -e 's/@''GNULIB_REALLOC_GNU''@/$(GL_GNULIB_REALLOC_GNU)/g' \ @@ -3423,6 +3429,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ -e 's|@''REPLACE_PTSNAME_R''@|$(REPLACE_PTSNAME_R)|g' \ -e 's|@''REPLACE_PUTENV''@|$(REPLACE_PUTENV)|g' \ -e 's|@''REPLACE_QSORT_R''@|$(REPLACE_QSORT_R)|g' \ + -e 's|@''REPLACE_RAND''@|$(REPLACE_RAND)|g' \ -e 's|@''REPLACE_RANDOM''@|$(REPLACE_RANDOM)|g' \ -e 's|@''REPLACE_RANDOM_R''@|$(REPLACE_RANDOM_R)|g' \ -e 's|@''REPLACE_REALLOC_FOR_REALLOC_GNU''@|$(REPLACE_REALLOC_FOR_REALLOC_GNU)|g' \ @@ -3568,6 +3575,7 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''REPLACE_STRERROR_R''@|$(REPLACE_STRERROR_R)|g' \ -e 's|@''REPLACE_STRERRORNAME_NP''@|$(REPLACE_STRERRORNAME_NP)|g' \ -e 's|@''REPLACE_STRSIGNAL''@|$(REPLACE_STRSIGNAL)|g' \ + -e 's|@''REPLACE_STRVERSCMP''@|$(REPLACE_STRVERSCMP)|g' \ -e 's|@''UNDEFINE_STRTOK_R''@|$(UNDEFINE_STRTOK_R)|g' \ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ @@ -4141,6 +4149,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''REPLACE_EXECVP''@|$(REPLACE_EXECVP)|g' \ -e 's|@''REPLACE_EXECVPE''@|$(REPLACE_EXECVPE)|g' \ -e 's|@''REPLACE_FACCESSAT''@|$(REPLACE_FACCESSAT)|g' \ + -e 's|@''REPLACE_FCHDIR''@|$(REPLACE_FCHDIR)|g' \ -e 's|@''REPLACE_FCHOWNAT''@|$(REPLACE_FCHOWNAT)|g' \ -e 's|@''REPLACE_FDATASYNC''@|$(REPLACE_FDATASYNC)|g' \ -e 's|@''REPLACE_FTRUNCATE''@|$(REPLACE_FTRUNCATE)|g' \ diff --git a/lib/group-member.c b/lib/group-member.c index 300d58bdbaa..43b49831003 100644 --- a/lib/group-member.c +++ b/lib/group-member.c @@ -1,7 +1,7 @@ /* group-member.c -- determine whether group id is in calling user's group list - Copyright (C) 1994, 1997-1998, 2003, 2005-2006, 2009-2024 Free - Software Foundation, Inc. + Copyright (C) 1994, 1997-1998, 2003, 2005-2006, 2009-2024 Free Software + Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/intprops-internal.h b/lib/intprops-internal.h index dcbf537786a..c8a87d2bb27 100644 --- a/lib/intprops-internal.h +++ b/lib/intprops-internal.h @@ -20,6 +20,11 @@ #include +/* Pacify GCC 13.2 in some calls to _GL_EXPR_SIGNED. */ +#if defined __GNUC__ && 4 < __GNUC__ + (3 <= __GNUC_MINOR__) +# pragma GCC diagnostic ignored "-Wtype-limits" +#endif + /* Return a value with the common real type of E and V and the value of V. Do not evaluate E. */ #define _GL_INT_CONVERT(e, v) ((1 ? 0 : (e)) + (v)) diff --git a/lib/malloc.c b/lib/malloc.c index 7b954ae1129..2a7867a1d1f 100644 --- a/lib/malloc.c +++ b/lib/malloc.c @@ -1,7 +1,6 @@ /* malloc() function that is glibc compatible. - Copyright (C) 1997-1998, 2006-2007, 2009-2024 Free Software - Foundation, Inc. + Copyright (C) 1997-1998, 2006-2007, 2009-2024 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/md5-stream.c b/lib/md5-stream.c index ca82b067e42..c82f18145e0 100644 --- a/lib/md5-stream.c +++ b/lib/md5-stream.c @@ -1,7 +1,7 @@ /* Functions to compute MD5 message digest of files or memory blocks. according to the definition of MD5 in RFC 1321 from April 1992. - Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2024 Free - Software Foundation, Inc. + Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2024 Free Software + Foundation, Inc. This file is part of the GNU C Library. This file is free software: you can redistribute it and/or modify diff --git a/lib/md5.c b/lib/md5.c index 1818216a4b9..8e02f15d14d 100644 --- a/lib/md5.c +++ b/lib/md5.c @@ -1,7 +1,7 @@ /* Functions to compute MD5 message digest of files or memory blocks. according to the definition of MD5 in RFC 1321 from April 1992. - Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2024 Free - Software Foundation, Inc. + Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2024 Free Software + Foundation, Inc. This file is part of the GNU C Library. This file is free software: you can redistribute it and/or modify diff --git a/lib/md5.h b/lib/md5.h index 99f56ef0eec..2f470703f5c 100644 --- a/lib/md5.h +++ b/lib/md5.h @@ -1,7 +1,7 @@ /* Declaration of functions and data types used for MD5 sum computing library functions. - Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2024 Free - Software Foundation, Inc. + Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2024 Free Software + Foundation, Inc. This file is part of the GNU C Library. This file is free software: you can redistribute it and/or modify @@ -32,7 +32,21 @@ # ifndef OPENSSL_API_COMPAT # define OPENSSL_API_COMPAT 0x10101000L /* FIXME: Use OpenSSL 1.1+ API. */ # endif -# include +/* If would give a compile-time error, don't use OpenSSL. */ +# include +# if OPENSSL_VERSION_MAJOR >= 3 +# include +# if (OPENSSL_CONFIGURED_API \ + < (OPENSSL_API_COMPAT < 0x900000L ? OPENSSL_API_COMPAT : \ + ((OPENSSL_API_COMPAT >> 28) & 0xF) * 10000 \ + + ((OPENSSL_API_COMPAT >> 20) & 0xFF) * 100 \ + + ((OPENSSL_API_COMPAT >> 12) & 0xFF))) +# undef HAVE_OPENSSL_MD5 +# endif +# endif +# if HAVE_OPENSSL_MD5 +# include +# endif # endif #define MD5_DIGEST_SIZE 16 @@ -49,7 +63,11 @@ #ifndef __THROW # if defined __cplusplus && (__GNUC_PREREQ (2,8) || __clang_major__ >= 4) -# define __THROW throw () +# if __cplusplus >= 201103L +# define __THROW noexcept (true) +# else +# define __THROW throw () +# endif # else # define __THROW # endif diff --git a/lib/memmem.c b/lib/memmem.c index 6fbc36e6654..e9b8c5392b6 100644 --- a/lib/memmem.c +++ b/lib/memmem.c @@ -1,5 +1,5 @@ -/* Copyright (C) 1991-1994, 1996-1998, 2000, 2004, 2007-2024 Free - Software Foundation, Inc. +/* Copyright (C) 1991-1994, 1996-1998, 2000, 2004, 2007-2024 Free Software + Foundation, Inc. This file is part of the GNU C Library. This file is free software: you can redistribute it and/or modify diff --git a/lib/memrchr.c b/lib/memrchr.c index 025869b6022..3df1f479c78 100644 --- a/lib/memrchr.c +++ b/lib/memrchr.c @@ -1,7 +1,7 @@ /* memrchr -- find the last occurrence of a byte in a memory block - Copyright (C) 1991, 1993, 1996-1997, 1999-2000, 2003-2024 Free - Software Foundation, Inc. + Copyright (C) 1991, 1993, 1996-1997, 1999-2000, 2003-2024 Free Software + Foundation, Inc. Based on strlen implementation by Torbjorn Granlund (tege@sics.se), with help from Dan Sahlin (dan@sics.se) and diff --git a/lib/nanosleep.c b/lib/nanosleep.c index c998515ebaa..c6a76ec0eb4 100644 --- a/lib/nanosleep.c +++ b/lib/nanosleep.c @@ -1,7 +1,6 @@ /* Provide a replacement for the POSIX nanosleep function. - Copyright (C) 1999-2000, 2002, 2004-2024 Free Software Foundation, - Inc. + Copyright (C) 1999-2000, 2002, 2004-2024 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/open.c b/lib/open.c index adcac458a78..e690c9ea779 100644 --- a/lib/open.c +++ b/lib/open.c @@ -38,9 +38,13 @@ orig_open (const char *filename, int flags, mode_t mode) } /* Specification. */ +#ifdef __osf__ /* Write "fcntl.h" here, not , otherwise OSF/1 5.1 DTK cc eliminates this include because of the preliminary #include above. */ -#include "fcntl.h" +# include "fcntl.h" +#else +# include +#endif #include "cloexec.h" diff --git a/lib/rawmemchr.c b/lib/rawmemchr.c index 37639287f01..013e7f8cced 100644 --- a/lib/rawmemchr.c +++ b/lib/rawmemchr.c @@ -19,7 +19,7 @@ /* Specification. */ #include -/* A function definition is only needed if HAVE_RAWMEMCHR is not defined. */ +/* A function definition is needed only if HAVE_RAWMEMCHR is not defined. */ #if !HAVE_RAWMEMCHR # include @@ -30,19 +30,30 @@ void * rawmemchr (const void *s, int c_in) { - /* Change this typedef to experiment with performance. */ +# ifdef __CHERI_PURE_CAPABILITY__ + /* Most architectures let you read an aligned word, + even if the unsigned char array at S ends in the middle of the word. + However CHERI does not, so call memchr + with the underlying object's remaining length. + This cannot return NULL if S points to a C_IN-terminated array. + Use builtins rather than including which is less stable. */ + return memchr (s, c_in, (__builtin_cheri_length_get (s) + - __builtin_cheri_offset_get (s))); +# else + + /* You can change this typedef to experiment with performance. */ typedef uintptr_t longword; - /* If you change the "uintptr_t", you should change UINTPTR_WIDTH to match. - This verifies that the type does not have padding bits. */ - static_assert (UINTPTR_WIDTH == UCHAR_WIDTH * sizeof (longword)); + /* Verify that the longword type lacks padding bits. */ + static_assert (UINTPTR_WIDTH == UCHAR_WIDTH * sizeof (uintptr_t)); const unsigned char *char_ptr; unsigned char c = c_in; /* Handle the first few bytes by reading one byte at a time. - Do this until CHAR_PTR is aligned on a longword boundary. */ + Do this until CHAR_PTR is aligned on a natural longword boundary, + as using alignof (longword) might be slower. */ for (char_ptr = (const unsigned char *) s; - (uintptr_t) char_ptr % alignof (longword) != 0; + (uintptr_t) char_ptr % sizeof (longword) != 0; ++char_ptr) if (*char_ptr == c) return (void *) char_ptr; @@ -118,6 +129,7 @@ rawmemchr (const void *s, int c_in) while (*char_ptr != c) char_ptr++; return (void *) char_ptr; +# endif } #endif diff --git a/lib/regex.c b/lib/regex.c index 08031cecc04..4b1a6ed68e3 100644 --- a/lib/regex.c +++ b/lib/regex.c @@ -26,10 +26,6 @@ # pragma GCC diagnostic ignored "-Wsuggest-attribute=pure" # pragma GCC diagnostic ignored "-Wvla" # endif -# if __GNUC_PREREQ (4, 3) -# pragma GCC diagnostic ignored "-Wold-style-definition" -# pragma GCC diagnostic ignored "-Wtype-limits" -# endif #endif /* Make sure no one compiles this code with a C++ compiler. */ diff --git a/lib/save-cwd.h b/lib/save-cwd.h index 79900ee0b08..692e4b97be2 100644 --- a/lib/save-cwd.h +++ b/lib/save-cwd.h @@ -1,7 +1,7 @@ /* Save and restore current working directory. - Copyright (C) 1995, 1997-1998, 2003, 2009-2024 Free Software - Foundation, Inc. + Copyright (C) 1995, 1997-1998, 2003, 2009-2024 Free Software Foundation, + Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/set-permissions.c b/lib/set-permissions.c index a3d4cc839e5..83a355faa5c 100644 --- a/lib/set-permissions.c +++ b/lib/set-permissions.c @@ -22,6 +22,7 @@ #include "acl.h" #include "acl-internal.h" +#include "minmax.h" #if USE_ACL # if ! defined HAVE_ACL_FROM_MODE && defined HAVE_ACL_FROM_TEXT /* FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */ diff --git a/lib/sha1.c b/lib/sha1.c index 454d68e266d..24fcd0b0139 100644 --- a/lib/sha1.c +++ b/lib/sha1.c @@ -1,8 +1,7 @@ /* sha1.c - Functions to compute SHA1 message digest of files or memory blocks according to the NIST specification FIPS-180-1. - Copyright (C) 2000-2001, 2003-2006, 2008-2024 Free Software - Foundation, Inc. + Copyright (C) 2000-2001, 2003-2006, 2008-2024 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/sha1.h b/lib/sha1.h index 15bfa043e3b..940163eb528 100644 --- a/lib/sha1.h +++ b/lib/sha1.h @@ -31,7 +31,21 @@ # ifndef OPENSSL_API_COMPAT # define OPENSSL_API_COMPAT 0x10101000L /* FIXME: Use OpenSSL 1.1+ API. */ # endif -# include +/* If would give a compile-time error, don't use OpenSSL. */ +# include +# if OPENSSL_VERSION_MAJOR >= 3 +# include +# if (OPENSSL_CONFIGURED_API \ + < (OPENSSL_API_COMPAT < 0x900000L ? OPENSSL_API_COMPAT : \ + ((OPENSSL_API_COMPAT >> 28) & 0xF) * 10000 \ + + ((OPENSSL_API_COMPAT >> 20) & 0xFF) * 100 \ + + ((OPENSSL_API_COMPAT >> 12) & 0xFF))) +# undef HAVE_OPENSSL_SHA1 +# endif +# endif +# if HAVE_OPENSSL_SHA1 +# include +# endif # endif # ifdef __cplusplus diff --git a/lib/sha256.h b/lib/sha256.h index daf5edd2dd9..a9d7abb8a2c 100644 --- a/lib/sha256.h +++ b/lib/sha256.h @@ -30,7 +30,21 @@ # ifndef OPENSSL_API_COMPAT # define OPENSSL_API_COMPAT 0x10101000L /* FIXME: Use OpenSSL 1.1+ API. */ # endif -# include +/* If would give a compile-time error, don't use OpenSSL. */ +# include +# if OPENSSL_VERSION_MAJOR >= 3 +# include +# if (OPENSSL_CONFIGURED_API \ + < (OPENSSL_API_COMPAT < 0x900000L ? OPENSSL_API_COMPAT : \ + ((OPENSSL_API_COMPAT >> 28) & 0xF) * 10000 \ + + ((OPENSSL_API_COMPAT >> 20) & 0xFF) * 100 \ + + ((OPENSSL_API_COMPAT >> 12) & 0xFF))) +# undef HAVE_OPENSSL_SHA256 +# endif +# endif +# if HAVE_OPENSSL_SHA256 +# include +# endif # endif # ifdef __cplusplus diff --git a/lib/sha512.h b/lib/sha512.h index 35fa3b52849..f6bac85488e 100644 --- a/lib/sha512.h +++ b/lib/sha512.h @@ -30,7 +30,21 @@ # ifndef OPENSSL_API_COMPAT # define OPENSSL_API_COMPAT 0x10101000L /* FIXME: Use OpenSSL 1.1+ API. */ # endif -# include +/* If would give a compile-time error, don't use OpenSSL. */ +# include +# if OPENSSL_VERSION_MAJOR >= 3 +# include +# if (OPENSSL_CONFIGURED_API \ + < (OPENSSL_API_COMPAT < 0x900000L ? OPENSSL_API_COMPAT : \ + ((OPENSSL_API_COMPAT >> 28) & 0xF) * 10000 \ + + ((OPENSSL_API_COMPAT >> 20) & 0xFF) * 100 \ + + ((OPENSSL_API_COMPAT >> 12) & 0xFF))) +# undef HAVE_OPENSSL_SHA512 +# endif +# endif +# if HAVE_OPENSSL_SHA512 +# include +# endif # endif # ifdef __cplusplus diff --git a/lib/sig2str.c b/lib/sig2str.c index ac20be041a4..c6b91e38498 100644 --- a/lib/sig2str.c +++ b/lib/sig2str.c @@ -1,7 +1,6 @@ /* sig2str.c -- convert between signal names and numbers - Copyright (C) 2002, 2004, 2006, 2009-2024 Free Software Foundation, - Inc. + Copyright (C) 2002, 2004, 2006, 2009-2024 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/stat-time.h b/lib/stat-time.h index c43d578e144..3cd8478f310 100644 --- a/lib/stat-time.h +++ b/lib/stat-time.h @@ -52,11 +52,13 @@ extern "C" { #if _GL_WINDOWS_STAT_TIMESPEC || defined HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC # if _GL_WINDOWS_STAT_TIMESPEC || defined TYPEOF_STRUCT_STAT_ST_ATIM_IS_STRUCT_TIMESPEC # define STAT_TIMESPEC(st, st_xtim) ((st)->st_xtim) +# define STAT_TIMESPEC_OFFSETOF(st_xtim) offsetof (struct stat, st_xtim) # else # define STAT_TIMESPEC_NS(st, st_xtim) ((st)->st_xtim.tv_nsec) # endif #elif defined HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC # define STAT_TIMESPEC(st, st_xtim) ((st)->st_xtim##espec) +# define STAT_TIMESPEC_OFFSETOF(st_xtim) offsetof (struct stat, st_xtim##espec) #elif defined HAVE_STRUCT_STAT_ST_ATIMENSEC # define STAT_TIMESPEC_NS(st, st_xtim) ((st)->st_xtim##ensec) #elif defined HAVE_STRUCT_STAT_ST_ATIM_ST__TIM_TV_NSEC @@ -194,20 +196,21 @@ get_stat_birthtime (_GL_UNUSED struct stat const *st) } /* If a stat-like function returned RESULT, normalize the timestamps - in *ST, in case this platform suffers from the Solaris 11 bug where + in *ST, if this platform suffers from a macOS and Solaris bug where tv_nsec might be negative. Return the adjusted RESULT, setting errno to EOVERFLOW if normalization overflowed. This function is intended to be private to this .h file. */ _GL_STAT_TIME_INLINE int stat_time_normalize (int result, _GL_UNUSED struct stat *st) { -#if defined __sun && defined STAT_TIMESPEC +#if (((defined __APPLE__ && defined __MACH__) || defined __sun) \ + && defined STAT_TIMESPEC_OFFSETOF) if (result == 0) { long int timespec_hz = 1000000000; - short int const ts_off[] = { offsetof (struct stat, st_atim), - offsetof (struct stat, st_mtim), - offsetof (struct stat, st_ctim) }; + short int const ts_off[] = { STAT_TIMESPEC_OFFSETOF (st_atim), + STAT_TIMESPEC_OFFSETOF (st_mtim), + STAT_TIMESPEC_OFFSETOF (st_ctim) }; int i; for (i = 0; i < sizeof ts_off / sizeof *ts_off; i++) { diff --git a/lib/stddef.in.h b/lib/stddef.in.h index 0f1d73ea49d..fa8998d9b72 100644 --- a/lib/stddef.in.h +++ b/lib/stddef.in.h @@ -58,7 +58,7 @@ /* On AIX 7.2, with xlc in 64-bit mode, defines max_align_t to a type with alignment 4, but 'long' has alignment 8. */ -# if defined _AIX && defined __LP64__ +# if defined _AIX && defined __LP64__ && !@HAVE_MAX_ALIGN_T@ # if !GNULIB_defined_max_align_t # ifdef _MAX_ALIGN_T /* /usr/include/stddef.h has already defined max_align_t. Override it. */ @@ -101,11 +101,33 @@ typedef long max_align_t; # ifndef _@GUARD_PREFIX@_STDDEF_H # define _@GUARD_PREFIX@_STDDEF_H -/* This file uses _Noreturn. */ +/* This file uses _Noreturn, _GL_ATTRIBUTE_NOTHROW. */ #if !_GL_CONFIG_H_INCLUDED #error "Please include config.h first." #endif +/* _GL_ATTRIBUTE_NOTHROW declares that the function does not throw exceptions. + */ +#ifndef _GL_ATTRIBUTE_NOTHROW +# if defined __cplusplus +# if (__GNUC__ + (__GNUC_MINOR__ >= 8) > 2) || __clang_major >= 4 +# if __cplusplus >= 201103L +# define _GL_ATTRIBUTE_NOTHROW noexcept (true) +# else +# define _GL_ATTRIBUTE_NOTHROW throw () +# endif +# else +# define _GL_ATTRIBUTE_NOTHROW +# endif +# else +# if (__GNUC__ + (__GNUC_MINOR__ >= 3) > 3) || defined __clang__ +# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__)) +# else +# define _GL_ATTRIBUTE_NOTHROW +# endif +# endif +#endif + /* Some platforms lack wchar_t. */ #if !@HAVE_WCHAR_T@ # define wchar_t int @@ -178,7 +200,7 @@ extern _Noreturn void abort (void) # if defined __cplusplus && (__GLIBC__ >= 2) -throw () +_GL_ATTRIBUTE_NOTHROW # endif ; # define unreachable() abort () diff --git a/lib/stdint.in.h b/lib/stdint.in.h index 446f29ecb57..fea7483b9cc 100644 --- a/lib/stdint.in.h +++ b/lib/stdint.in.h @@ -306,6 +306,8 @@ typedef gl_uint_fast32_t gl_uint_fast16_t; uintptr_t to avoid conflicting declarations of system functions like _findclose in . */ # if !((defined __KLIBC__ && defined _INTPTR_T_DECLARED) \ + || (defined __INTPTR_WIDTH__ \ + && __INTPTR_WIDTH__ != (defined _WIN64 ? LLONG_WIDTH : LONG_WIDTH)) \ || defined __MINGW32__) # undef intptr_t # undef uintptr_t diff --git a/lib/stdio.in.h b/lib/stdio.in.h index 7fcb4c7b008..4947307e578 100644 --- a/lib/stdio.in.h +++ b/lib/stdio.in.h @@ -38,8 +38,14 @@ /* Suppress macOS deprecation warnings for sprintf and vsprintf. */ #if (defined __APPLE__ && defined __MACH__) && !defined _POSIX_C_SOURCE -# define _POSIX_C_SOURCE 200809L -# define _GL_DEFINED__POSIX_C_SOURCE +# ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ +# include +# endif +# if (defined MAC_OS_X_VERSION_MIN_REQUIRED \ + && 130000 <= MAC_OS_X_VERSION_MIN_REQUIRED) +# define _POSIX_C_SOURCE 200809L +# define _GL_DEFINED__POSIX_C_SOURCE +# endif #endif #define _GL_ALREADY_INCLUDING_STDIO_H @@ -58,7 +64,8 @@ #define _@GUARD_PREFIX@_STDIO_H /* This file uses _GL_ATTRIBUTE_DEALLOC, _GL_ATTRIBUTE_FORMAT, - _GL_ATTRIBUTE_MALLOC, GNULIB_POSIXCHECK, HAVE_RAW_DECL_*. */ + _GL_ATTRIBUTE_MALLOC, _GL_ATTRIBUTE_NOTHROW, GNULIB_POSIXCHECK, + HAVE_RAW_DECL_*. */ #if !_GL_CONFIG_H_INCLUDED #error "Please include config.h first." #endif @@ -143,6 +150,28 @@ # endif #endif +/* _GL_ATTRIBUTE_NOTHROW declares that the function does not throw exceptions. + */ +#ifndef _GL_ATTRIBUTE_NOTHROW +# if defined __cplusplus +# if (__GNUC__ + (__GNUC_MINOR__ >= 8) > 2) || __clang_major >= 4 +# if __cplusplus >= 201103L +# define _GL_ATTRIBUTE_NOTHROW noexcept (true) +# else +# define _GL_ATTRIBUTE_NOTHROW throw () +# endif +# else +# define _GL_ATTRIBUTE_NOTHROW +# endif +# else +# if (__GNUC__ + (__GNUC_MINOR__ >= 3) > 3) || defined __clang__ +# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__)) +# else +# define _GL_ATTRIBUTE_NOTHROW +# endif +# endif +#endif + /* An __attribute__ __format__ specifier for a function that takes a format string and arguments, where the format string directives are the ones standardized by ISO C99 and POSIX. @@ -344,10 +373,18 @@ _GL_CXXALIAS_MDA (fdopen, FILE *, (int fd, const char *mode)); # else # if __GNUC__ >= 11 /* For -Wmismatched-dealloc: Associate fdopen with fclose or rpl_fclose. */ +# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2 _GL_FUNCDECL_SYS (fdopen, FILE *, (int fd, const char *mode) + _GL_ATTRIBUTE_NOTHROW _GL_ARG_NONNULL ((2)) _GL_ATTRIBUTE_DEALLOC (fclose, 1) _GL_ATTRIBUTE_MALLOC); +# else +_GL_FUNCDECL_SYS (fdopen, FILE *, + (int fd, const char *mode) + _GL_ARG_NONNULL ((2)) _GL_ATTRIBUTE_DEALLOC (fclose, 1) + _GL_ATTRIBUTE_MALLOC); +# endif # endif _GL_CXXALIAS_SYS (fdopen, FILE *, (int fd, const char *mode)); # endif @@ -355,10 +392,18 @@ _GL_CXXALIASWARN (fdopen); #else # if @GNULIB_FCLOSE@ && __GNUC__ >= 11 && !defined fdopen /* For -Wmismatched-dealloc: Associate fdopen with fclose or rpl_fclose. */ +# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2 _GL_FUNCDECL_SYS (fdopen, FILE *, (int fd, const char *mode) + _GL_ATTRIBUTE_NOTHROW _GL_ARG_NONNULL ((2)) _GL_ATTRIBUTE_DEALLOC (fclose, 1) _GL_ATTRIBUTE_MALLOC); +# else +_GL_FUNCDECL_SYS (fdopen, FILE *, + (int fd, const char *mode) + _GL_ARG_NONNULL ((2)) _GL_ATTRIBUTE_DEALLOC (fclose, 1) + _GL_ATTRIBUTE_MALLOC); +# endif # endif # if defined GNULIB_POSIXCHECK # undef fdopen diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index ffa86eef0dc..b901d175aeb 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -1,7 +1,6 @@ /* A GNU-like . - Copyright (C) 1995, 2001-2004, 2006-2024 Free Software Foundation, - Inc. + Copyright (C) 1995, 2001-2004, 2006-2024 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as @@ -39,7 +38,8 @@ #define _@GUARD_PREFIX@_STDLIB_H /* This file uses _Noreturn, _GL_ATTRIBUTE_DEALLOC, _GL_ATTRIBUTE_MALLOC, - _GL_ATTRIBUTE_PURE, GNULIB_POSIXCHECK, HAVE_RAW_DECL_*. */ + _GL_ATTRIBUTE_NOTHROW, _GL_ATTRIBUTE_PURE, GNULIB_POSIXCHECK, + HAVE_RAW_DECL_*. */ #if !_GL_CONFIG_H_INCLUDED #error "Please include config.h first." #endif @@ -133,6 +133,28 @@ struct random_data # endif #endif +/* _GL_ATTRIBUTE_NOTHROW declares that the function does not throw exceptions. + */ +#ifndef _GL_ATTRIBUTE_NOTHROW +# if defined __cplusplus +# if (__GNUC__ + (__GNUC_MINOR__ >= 8) > 2) || __clang_major >= 4 +# if __cplusplus >= 201103L +# define _GL_ATTRIBUTE_NOTHROW noexcept (true) +# else +# define _GL_ATTRIBUTE_NOTHROW throw () +# endif +# else +# define _GL_ATTRIBUTE_NOTHROW +# endif +# else +# if (__GNUC__ + (__GNUC_MINOR__ >= 3) > 3) || defined __clang__ +# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__)) +# else +# define _GL_ATTRIBUTE_NOTHROW +# endif +# endif +#endif + /* The __attribute__ feature is available in gcc versions 2.5 and later. The attribute __pure__ was added in gcc 2.96. */ #ifndef _GL_ATTRIBUTE_PURE @@ -201,7 +223,7 @@ _GL_WARN_ON_USE (_Exit, "_Exit is unportable - " # define free rpl_free # endif # if defined __cplusplus && (__GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2) -_GL_FUNCDECL_RPL (free, void, (void *ptr) throw ()); +_GL_FUNCDECL_RPL (free, void, (void *ptr) _GL_ATTRIBUTE_NOTHROW); # else _GL_FUNCDECL_RPL (free, void, (void *ptr)); # endif @@ -235,9 +257,16 @@ _GL_CXXALIAS_RPL (aligned_alloc, void *, (size_t alignment, size_t size)); # if @HAVE_ALIGNED_ALLOC@ # if __GNUC__ >= 11 /* For -Wmismatched-dealloc: Associate aligned_alloc with free or rpl_free. */ +# if __GLIBC__ + (__GLIBC_MINOR__ >= 16) > 2 +_GL_FUNCDECL_SYS (aligned_alloc, void *, + (size_t alignment, size_t size) + _GL_ATTRIBUTE_NOTHROW + _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# else _GL_FUNCDECL_SYS (aligned_alloc, void *, (size_t alignment, size_t size) _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# endif # endif _GL_CXXALIAS_SYS (aligned_alloc, void *, (size_t alignment, size_t size)); # endif @@ -248,9 +277,16 @@ _GL_CXXALIASWARN (aligned_alloc); #else # if @GNULIB_FREE_POSIX@ && __GNUC__ >= 11 && !defined aligned_alloc /* For -Wmismatched-dealloc: Associate aligned_alloc with free or rpl_free. */ +# if __GLIBC__ + (__GLIBC_MINOR__ >= 16) > 2 +_GL_FUNCDECL_SYS (aligned_alloc, void *, + (size_t alignment, size_t size) + _GL_ATTRIBUTE_NOTHROW + _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# else _GL_FUNCDECL_SYS (aligned_alloc, void *, (size_t alignment, size_t size) _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# endif # endif # if defined GNULIB_POSIXCHECK # undef aligned_alloc @@ -293,9 +329,16 @@ _GL_CXXALIAS_RPL (calloc, void *, (size_t nmemb, size_t size)); # else # if __GNUC__ >= 11 /* For -Wmismatched-dealloc: Associate calloc with free or rpl_free. */ +# if __GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2 +_GL_FUNCDECL_SYS (calloc, void *, + (size_t nmemb, size_t size) + _GL_ATTRIBUTE_NOTHROW + _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# else _GL_FUNCDECL_SYS (calloc, void *, (size_t nmemb, size_t size) _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# endif # endif _GL_CXXALIAS_SYS (calloc, void *, (size_t nmemb, size_t size)); # endif @@ -305,9 +348,16 @@ _GL_CXXALIASWARN (calloc); #else # if @GNULIB_FREE_POSIX@ && __GNUC__ >= 11 && !defined calloc /* For -Wmismatched-dealloc: Associate calloc with free or rpl_free. */ +# if __GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2 _GL_FUNCDECL_SYS (calloc, void *, (size_t nmemb, size_t size) + _GL_ATTRIBUTE_NOTHROW _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# else +_GL_FUNCDECL_SYS (calloc, void *, + (size_t nmemb, size_t size) + _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# endif # endif # if defined GNULIB_POSIXCHECK # undef calloc @@ -329,10 +379,18 @@ _GL_FUNCDECL_RPL (canonicalize_file_name, char *, _GL_CXXALIAS_RPL (canonicalize_file_name, char *, (const char *name)); # else # if !@HAVE_CANONICALIZE_FILE_NAME@ || __GNUC__ >= 11 +# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2 +_GL_FUNCDECL_SYS (canonicalize_file_name, char *, + (const char *name) + _GL_ATTRIBUTE_NOTHROW + _GL_ARG_NONNULL ((1)) + _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# else _GL_FUNCDECL_SYS (canonicalize_file_name, char *, (const char *name) _GL_ARG_NONNULL ((1)) _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# endif # endif _GL_CXXALIAS_SYS (canonicalize_file_name, char *, (const char *name)); # endif @@ -345,10 +403,18 @@ _GL_CXXALIASWARN (canonicalize_file_name); # if @GNULIB_FREE_POSIX@ && __GNUC__ >= 11 && !defined canonicalize_file_name /* For -Wmismatched-dealloc: Associate canonicalize_file_name with free or rpl_free. */ +# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2 _GL_FUNCDECL_SYS (canonicalize_file_name, char *, (const char *name) + _GL_ATTRIBUTE_NOTHROW _GL_ARG_NONNULL ((1)) _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# else +_GL_FUNCDECL_SYS (canonicalize_file_name, char *, + (const char *name) + _GL_ARG_NONNULL ((1)) + _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# endif # endif # if defined GNULIB_POSIXCHECK # undef canonicalize_file_name @@ -570,9 +636,16 @@ _GL_CXXALIAS_RPL (malloc, void *, (size_t size)); # else # if __GNUC__ >= 11 /* For -Wmismatched-dealloc: Associate malloc with free or rpl_free. */ +# if __GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2 _GL_FUNCDECL_SYS (malloc, void *, (size_t size) + _GL_ATTRIBUTE_NOTHROW _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# else +_GL_FUNCDECL_SYS (malloc, void *, + (size_t size) + _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# endif # endif _GL_CXXALIAS_SYS (malloc, void *, (size_t size)); # endif @@ -582,9 +655,16 @@ _GL_CXXALIASWARN (malloc); #else # if @GNULIB_FREE_POSIX@ && __GNUC__ >= 11 && !defined malloc /* For -Wmismatched-dealloc: Associate malloc with free or rpl_free. */ +# if __GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2 +_GL_FUNCDECL_SYS (malloc, void *, + (size_t size) + _GL_ATTRIBUTE_NOTHROW + _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# else _GL_FUNCDECL_SYS (malloc, void *, (size_t size) _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# endif # endif # if defined GNULIB_POSIXCHECK && !_GL_USE_STDLIB_ALLOC # undef malloc @@ -967,6 +1047,10 @@ _GL_CXXALIAS_RPL (putenv, int, (char *string)); # define putenv _putenv # endif _GL_CXXALIAS_MDA (putenv, int, (char *string)); +# elif defined __KLIBC__ +/* Need to cast, because on OS/2 kLIBC, the first parameter is + const char *string. */ +_GL_CXXALIAS_SYS_CAST (putenv, int, (char *string)); # else _GL_CXXALIAS_SYS (putenv, int, (char *string)); # endif @@ -983,6 +1067,10 @@ _GL_CXXALIASWARN (putenv); /* Need to cast, because on mingw, the parameter is either 'const char *string' or 'char *string'. */ _GL_CXXALIAS_MDA_CAST (putenv, int, (char *string)); +# elif defined __KLIBC__ +/* Need to cast, because on OS/2 kLIBC, the first parameter is + const char *string. */ +_GL_CXXALIAS_SYS_CAST (putenv, int, (char *string)); # else _GL_CXXALIAS_SYS (putenv, int, (char *string)); # endif @@ -1024,7 +1112,9 @@ _GL_CXXALIAS_SYS (qsort_r, void, (void *base, size_t nmemb, size_t size, _gl_qsort_r_compar_fn compare, void *arg)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (qsort_r); +# endif #elif defined GNULIB_POSIXCHECK # undef qsort_r # if HAVE_RAW_DECL_QSORT_R @@ -1034,11 +1124,26 @@ _GL_WARN_ON_USE (qsort_r, "qsort_r is not portable - " #endif -#if @GNULIB_RANDOM_R@ -# if !@HAVE_RANDOM_R@ -# ifndef RAND_MAX -# define RAND_MAX 2147483647 +#if @GNULIB_RAND@ || (@GNULIB_RANDOM_R@ && !@HAVE_RANDOM_R@) +# ifndef RAND_MAX +# define RAND_MAX 2147483647 +# endif +#endif + + +#if @GNULIB_RAND@ +# if @REPLACE_RAND@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef rand +# define rand rpl_rand # endif +_GL_FUNCDECL_RPL (rand, int, (void)); +_GL_CXXALIAS_RPL (rand, int, (void)); +# else +_GL_CXXALIAS_SYS (rand, int, (void)); +# endif +# if __GLIBC__ >= 2 +_GL_CXXALIASWARN (rand); # endif #endif @@ -1293,8 +1398,16 @@ _GL_CXXALIAS_RPL (realloc, void *, (void *ptr, size_t size)); # else # if __GNUC__ >= 11 /* For -Wmismatched-dealloc: Associate realloc with free or rpl_free. */ -_GL_FUNCDECL_SYS (realloc, void *, (void *ptr, size_t size) - _GL_ATTRIBUTE_DEALLOC_FREE); +# if __GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2 +_GL_FUNCDECL_SYS (realloc, void *, + (void *ptr, size_t size) + _GL_ATTRIBUTE_NOTHROW + _GL_ATTRIBUTE_DEALLOC_FREE); +# else +_GL_FUNCDECL_SYS (realloc, void *, + (void *ptr, size_t size) + _GL_ATTRIBUTE_DEALLOC_FREE); +# endif # endif _GL_CXXALIAS_SYS (realloc, void *, (void *ptr, size_t size)); # endif @@ -1304,8 +1417,16 @@ _GL_CXXALIASWARN (realloc); #else # if @GNULIB_FREE_POSIX@ && __GNUC__ >= 11 && !defined realloc /* For -Wmismatched-dealloc: Associate realloc with free or rpl_free. */ -_GL_FUNCDECL_SYS (realloc, void *, (void *ptr, size_t size) - _GL_ATTRIBUTE_DEALLOC_FREE); +# if __GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2 +_GL_FUNCDECL_SYS (realloc, void *, + (void *ptr, size_t size) + _GL_ATTRIBUTE_NOTHROW + _GL_ATTRIBUTE_DEALLOC_FREE); +# else +_GL_FUNCDECL_SYS (realloc, void *, + (void *ptr, size_t size) + _GL_ATTRIBUTE_DEALLOC_FREE); +# endif # endif # if defined GNULIB_POSIXCHECK && !_GL_USE_STDLIB_ALLOC # undef realloc diff --git a/lib/string.in.h b/lib/string.in.h index 70239c33bea..01ea3e3913b 100644 --- a/lib/string.in.h +++ b/lib/string.in.h @@ -45,7 +45,8 @@ #define _@GUARD_PREFIX@_STRING_H /* This file uses _GL_ATTRIBUTE_DEALLOC, _GL_ATTRIBUTE_MALLOC, - _GL_ATTRIBUTE_PURE, GNULIB_POSIXCHECK, HAVE_RAW_DECL_*. */ + _GL_ATTRIBUTE_NOTHROW, _GL_ATTRIBUTE_PURE, GNULIB_POSIXCHECK, + HAVE_RAW_DECL_*. */ #if !_GL_CONFIG_H_INCLUDED #error "Please include config.h first." #endif @@ -110,6 +111,28 @@ # endif #endif +/* _GL_ATTRIBUTE_NOTHROW declares that the function does not throw exceptions. + */ +#ifndef _GL_ATTRIBUTE_NOTHROW +# if defined __cplusplus +# if (__GNUC__ + (__GNUC_MINOR__ >= 8) > 2) || __clang_major >= 4 +# if __cplusplus >= 201103L +# define _GL_ATTRIBUTE_NOTHROW noexcept (true) +# else +# define _GL_ATTRIBUTE_NOTHROW throw () +# endif +# else +# define _GL_ATTRIBUTE_NOTHROW +# endif +# else +# if (__GNUC__ + (__GNUC_MINOR__ >= 3) > 3) || defined __clang__ +# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__)) +# else +# define _GL_ATTRIBUTE_NOTHROW +# endif +# endif +#endif + /* The __attribute__ feature is available in gcc versions 2.5 and later. The attribute __pure__ was added in gcc 2.96. */ #ifndef _GL_ATTRIBUTE_PURE @@ -133,7 +156,7 @@ && !(defined __cplusplus && defined GNULIB_NAMESPACE)) /* We can't do '#define free rpl_free' here. */ # if defined __cplusplus && (__GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2) -_GL_EXTERN_C void rpl_free (void *) throw (); +_GL_EXTERN_C void rpl_free (void *) _GL_ATTRIBUTE_NOTHROW; # else _GL_EXTERN_C void rpl_free (void *); # endif @@ -148,7 +171,7 @@ _GL_EXTERN_C void __cdecl free (void *); # else # if defined __cplusplus && (__GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2) -_GL_EXTERN_C void free (void *) throw (); +_GL_EXTERN_C void free (void *) _GL_ATTRIBUTE_NOTHROW; # else _GL_EXTERN_C void free (void *); # endif @@ -163,7 +186,7 @@ _GL_EXTERN_C void __cdecl free (void *); # else # if defined __cplusplus && (__GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2) -_GL_EXTERN_C void free (void *) throw (); +_GL_EXTERN_C void free (void *) _GL_ATTRIBUTE_NOTHROW; # else _GL_EXTERN_C void free (void *); # endif @@ -266,9 +289,12 @@ _GL_CXXALIAS_SYS_CAST2 (memchr, # if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 10) && !defined __UCLIBC__) \ && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \ || defined __clang__) -_GL_CXXALIASWARN1 (memchr, void *, (void *__s, int __c, size_t __n) throw ()); +_GL_CXXALIASWARN1 (memchr, void *, + (void *__s, int __c, size_t __n) + _GL_ATTRIBUTE_NOTHROW); _GL_CXXALIASWARN1 (memchr, void const *, - (void const *__s, int __c, size_t __n) throw ()); + (void const *__s, int __c, size_t __n) + _GL_ATTRIBUTE_NOTHROW); # elif __GLIBC__ >= 2 _GL_CXXALIASWARN (memchr); # endif @@ -368,8 +394,12 @@ _GL_CXXALIAS_SYS_CAST2 (memrchr, # if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 10) && !defined __UCLIBC__) \ && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \ || defined __clang__) -_GL_CXXALIASWARN1 (memrchr, void *, (void *, int, size_t) throw ()); -_GL_CXXALIASWARN1 (memrchr, void const *, (void const *, int, size_t) throw ()); +_GL_CXXALIASWARN1 (memrchr, void *, + (void *, int, size_t) + _GL_ATTRIBUTE_NOTHROW); +_GL_CXXALIASWARN1 (memrchr, void const *, + (void const *, int, size_t) + _GL_ATTRIBUTE_NOTHROW); # elif __GLIBC__ >= 2 _GL_CXXALIASWARN (memrchr); # endif @@ -416,9 +446,12 @@ _GL_CXXALIAS_SYS_CAST2 (rawmemchr, # if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 10) && !defined __UCLIBC__) \ && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \ || defined __clang__) -_GL_CXXALIASWARN1 (rawmemchr, void *, (void *__s, int __c_in) throw ()); +_GL_CXXALIASWARN1 (rawmemchr, void *, + (void *__s, int __c_in) + _GL_ATTRIBUTE_NOTHROW); _GL_CXXALIASWARN1 (rawmemchr, void const *, - (void const *__s, int __c_in) throw ()); + (void const *__s, int __c_in) + _GL_ATTRIBUTE_NOTHROW); # else _GL_CXXALIASWARN (rawmemchr); # endif @@ -538,9 +571,12 @@ _GL_CXXALIAS_SYS_CAST2 (strchrnul, # if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 10) && !defined __UCLIBC__) \ && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \ || defined __clang__) -_GL_CXXALIASWARN1 (strchrnul, char *, (char *__s, int __c_in) throw ()); +_GL_CXXALIASWARN1 (strchrnul, char *, + (char *__s, int __c_in) + _GL_ATTRIBUTE_NOTHROW); _GL_CXXALIASWARN1 (strchrnul, char const *, - (char const *__s, int __c_in) throw ()); + (char const *__s, int __c_in) + _GL_ATTRIBUTE_NOTHROW); # elif __GLIBC__ >= 2 _GL_CXXALIASWARN (strchrnul); # endif @@ -576,10 +612,18 @@ _GL_CXXALIAS_MDA (strdup, char *, (char const *__s)); # undef strdup # endif # if (!@HAVE_DECL_STRDUP@ || __GNUC__ >= 11) && !defined strdup +# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2 _GL_FUNCDECL_SYS (strdup, char *, (char const *__s) + _GL_ATTRIBUTE_NOTHROW _GL_ARG_NONNULL ((1)) _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# else +_GL_FUNCDECL_SYS (strdup, char *, + (char const *__s) + _GL_ARG_NONNULL ((1)) + _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# endif # endif _GL_CXXALIAS_SYS (strdup, char *, (char const *__s)); # endif @@ -587,10 +631,18 @@ _GL_CXXALIASWARN (strdup); #else # if __GNUC__ >= 11 && !defined strdup /* For -Wmismatched-dealloc: Associate strdup with free or rpl_free. */ +# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2 +_GL_FUNCDECL_SYS (strdup, char *, + (char const *__s) + _GL_ATTRIBUTE_NOTHROW + _GL_ARG_NONNULL ((1)) + _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# else _GL_FUNCDECL_SYS (strdup, char *, (char const *__s) _GL_ARG_NONNULL ((1)) _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# endif # endif # if defined GNULIB_POSIXCHECK # undef strdup @@ -659,10 +711,18 @@ _GL_FUNCDECL_RPL (strndup, char *, _GL_CXXALIAS_RPL (strndup, char *, (char const *__s, size_t __n)); # else # if !@HAVE_DECL_STRNDUP@ || (__GNUC__ >= 11 && !defined strndup) +# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2 +_GL_FUNCDECL_SYS (strndup, char *, + (char const *__s, size_t __n) + _GL_ATTRIBUTE_NOTHROW + _GL_ARG_NONNULL ((1)) + _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# else _GL_FUNCDECL_SYS (strndup, char *, (char const *__s, size_t __n) _GL_ARG_NONNULL ((1)) _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# endif # endif _GL_CXXALIAS_SYS (strndup, char *, (char const *__s, size_t __n)); # endif @@ -670,10 +730,18 @@ _GL_CXXALIASWARN (strndup); #else # if __GNUC__ >= 11 && !defined strndup /* For -Wmismatched-dealloc: Associate strndup with free or rpl_free. */ +# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2 _GL_FUNCDECL_SYS (strndup, char *, (char const *__s, size_t __n) + _GL_ATTRIBUTE_NOTHROW _GL_ARG_NONNULL ((1)) _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# else +_GL_FUNCDECL_SYS (strndup, char *, + (char const *__s, size_t __n) + _GL_ARG_NONNULL ((1)) + _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# endif # endif # if defined GNULIB_POSIXCHECK # undef strndup @@ -742,9 +810,12 @@ _GL_CXXALIAS_SYS_CAST2 (strpbrk, # if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 10) && !defined __UCLIBC__) \ && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \ || defined __clang__) -_GL_CXXALIASWARN1 (strpbrk, char *, (char *__s, char const *__accept) throw ()); +_GL_CXXALIASWARN1 (strpbrk, char *, + (char *__s, char const *__accept) + _GL_ATTRIBUTE_NOTHROW); _GL_CXXALIASWARN1 (strpbrk, char const *, - (char const *__s, char const *__accept) throw ()); + (char const *__s, char const *__accept) + _GL_ATTRIBUTE_NOTHROW); # elif __GLIBC__ >= 2 _GL_CXXALIASWARN (strpbrk); # endif @@ -852,9 +923,11 @@ _GL_CXXALIAS_SYS_CAST2 (strstr, && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \ || defined __clang__) _GL_CXXALIASWARN1 (strstr, char *, - (char *haystack, const char *needle) throw ()); + (char *haystack, const char *needle) + _GL_ATTRIBUTE_NOTHROW); _GL_CXXALIASWARN1 (strstr, const char *, - (const char *haystack, const char *needle) throw ()); + (const char *haystack, const char *needle) + _GL_ATTRIBUTE_NOTHROW); # elif __GLIBC__ >= 2 _GL_CXXALIASWARN (strstr); # endif @@ -903,9 +976,11 @@ _GL_CXXALIAS_SYS_CAST2 (strcasestr, && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \ || defined __clang__) _GL_CXXALIASWARN1 (strcasestr, char *, - (char *haystack, const char *needle) throw ()); + (char *haystack, const char *needle) + _GL_ATTRIBUTE_NOTHROW); _GL_CXXALIASWARN1 (strcasestr, const char *, - (const char *haystack, const char *needle) throw ()); + (const char *haystack, const char *needle) + _GL_ATTRIBUTE_NOTHROW); # elif __GLIBC__ >= 2 _GL_CXXALIASWARN (strcasestr); # endif @@ -1344,12 +1419,22 @@ _GL_WARN_ON_USE (strsignal, "strsignal is unportable - " #endif #if @GNULIB_STRVERSCMP@ -# if !@HAVE_STRVERSCMP@ +# if @REPLACE_STRVERSCMP@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# define strverscmp rpl_strverscmp +# endif +_GL_FUNCDECL_RPL (strverscmp, int, (const char *, const char *) + _GL_ATTRIBUTE_PURE + _GL_ARG_NONNULL ((1, 2))); +_GL_CXXALIAS_RPL (strverscmp, int, (const char *, const char *)); +# else +# if !@HAVE_STRVERSCMP@ _GL_FUNCDECL_SYS (strverscmp, int, (const char *, const char *) _GL_ATTRIBUTE_PURE _GL_ARG_NONNULL ((1, 2))); -# endif +# endif _GL_CXXALIAS_SYS (strverscmp, int, (const char *, const char *)); +# endif _GL_CXXALIASWARN (strverscmp); #elif defined GNULIB_POSIXCHECK # undef strverscmp diff --git a/lib/strtoimax.c b/lib/strtoimax.c index be6cd1fb7dd..1bc62621ec5 100644 --- a/lib/strtoimax.c +++ b/lib/strtoimax.c @@ -1,7 +1,7 @@ /* Convert string representation of a number into an intmax_t value. - Copyright (C) 1999, 2001-2004, 2006, 2009-2024 Free Software - Foundation, Inc. + Copyright (C) 1999, 2001-2004, 2006, 2009-2024 Free Software Foundation, + Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/strtol.c b/lib/strtol.c index b0e7c358800..914cf5b57ab 100644 --- a/lib/strtol.c +++ b/lib/strtol.c @@ -1,7 +1,7 @@ /* Convert string representation of a number into an integer value. - Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2024 Free - Software Foundation, Inc. + Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2024 Free Software + Foundation, Inc. NOTE: The canonical source of this file is maintained with the GNU C Library. Bugs can be reported to bug-glibc@gnu.org. diff --git a/lib/strtoll.c b/lib/strtoll.c index 840a03b11e8..d3f5e47fc12 100644 --- a/lib/strtoll.c +++ b/lib/strtoll.c @@ -1,6 +1,6 @@ /* Function to parse a 'long long int' from text. - Copyright (C) 1995-1997, 1999, 2001, 2009-2024 Free Software - Foundation, Inc. + Copyright (C) 1995-1997, 1999, 2001, 2009-2024 Free Software Foundation, + Inc. This file is part of the GNU C Library. This file is free software: you can redistribute it and/or modify diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h index 7593fee54a8..bf08f33536d 100644 --- a/lib/sys_stat.in.h +++ b/lib/sys_stat.in.h @@ -55,17 +55,41 @@ #ifndef _@GUARD_PREFIX@_SYS_STAT_H #define _@GUARD_PREFIX@_SYS_STAT_H -/* This file uses GNULIB_POSIXCHECK, HAVE_RAW_DECL_*. */ +/* This file uses _GL_ATTRIBUTE_NOTHROW, GNULIB_POSIXCHECK, HAVE_RAW_DECL_*. */ #if !_GL_CONFIG_H_INCLUDED #error "Please include config.h first." #endif + +/* _GL_ATTRIBUTE_NOTHROW declares that the function does not throw exceptions. + */ +#ifndef _GL_ATTRIBUTE_NOTHROW +# if defined __cplusplus +# if (__GNUC__ + (__GNUC_MINOR__ >= 8) > 2) || __clang_major >= 4 +# if __cplusplus >= 201103L +# define _GL_ATTRIBUTE_NOTHROW noexcept (true) +# else +# define _GL_ATTRIBUTE_NOTHROW throw () +# endif +# else +# define _GL_ATTRIBUTE_NOTHROW +# endif +# else +# if (__GNUC__ + (__GNUC_MINOR__ >= 3) > 3) || defined __clang__ +# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__)) +# else +# define _GL_ATTRIBUTE_NOTHROW +# endif +# endif +#endif + /* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */ /* The definition of _GL_ARG_NONNULL is copied here. */ /* The definition of _GL_WARN_ON_USE is copied here. */ + /* Before doing "#define mknod rpl_mknod" below, we need to include all headers that may declare mknod(). OS/2 kLIBC declares mknod() in , not in . */ @@ -575,7 +599,11 @@ _GL_WARN_ON_USE (futimens, "futimens is not portable - " #if @GNULIB_GETUMASK@ # if !@HAVE_GETUMASK@ +# if __GLIBC__ + (__GLIBC_MINOR__ >= 2) > 2 +_GL_FUNCDECL_SYS (getumask, mode_t, (void) _GL_ATTRIBUTE_NOTHROW); +# else _GL_FUNCDECL_SYS (getumask, mode_t, (void)); +# endif # endif _GL_CXXALIAS_SYS (getumask, mode_t, (void)); # if @HAVE_GETUMASK@ diff --git a/lib/tempname.c b/lib/tempname.c index fec5f7b29d6..446ddeaef19 100644 --- a/lib/tempname.c +++ b/lib/tempname.c @@ -193,7 +193,7 @@ try_tempname_len (char *tmpl, int suffixlen, void *args, char *XXXXXX; unsigned int count; int fd = -1; - int save_errno = errno; + int saved_errno = errno; /* A lower bound on the number of temporary files to attempt to generate. The maximum total number of temporary file names that @@ -258,7 +258,7 @@ try_tempname_len (char *tmpl, int suffixlen, void *args, fd = tryfunc (tmpl, args); if (fd >= 0) { - __set_errno (save_errno); + __set_errno (saved_errno); return fd; } else if (errno != EEXIST) diff --git a/lib/time_r.c b/lib/time_r.c index 4201e73f743..3ef0b36802c 100644 --- a/lib/time_r.c +++ b/lib/time_r.c @@ -1,7 +1,6 @@ /* Reentrant time functions like localtime_r. - Copyright (C) 2003, 2006-2007, 2010-2024 Free Software Foundation, - Inc. + Copyright (C) 2003, 2006-2007, 2010-2024 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/unistd.c b/lib/unistd.c index 50b75ff44b7..f3b3f7bd2fe 100644 --- a/lib/unistd.c +++ b/lib/unistd.c @@ -18,5 +18,5 @@ #include #define _GL_UNISTD_INLINE _GL_EXTERN_INLINE -#include "unistd.h" +#include typedef int dummy; diff --git a/lib/unistd.in.h b/lib/unistd.in.h index 661cec2770f..b412966367d 100644 --- a/lib/unistd.in.h +++ b/lib/unistd.in.h @@ -971,23 +971,28 @@ _GL_WARN_ON_USE (faccessat, "faccessat is not portable - " Return 0 if successful, otherwise -1 and errno set. See the POSIX:2008 specification . */ -# if ! @HAVE_FCHDIR@ +# if @REPLACE_FCHDIR@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef fchdir +# define fchdir rpl_fchdir +# endif +_GL_FUNCDECL_RPL (fchdir, int, (int /*fd*/)); +_GL_CXXALIAS_RPL (fchdir, int, (int /*fd*/)); +# else +# if !@HAVE_FCHDIR@ || !@HAVE_DECL_FCHDIR@ _GL_FUNCDECL_SYS (fchdir, int, (int /*fd*/)); - +# endif +_GL_CXXALIAS_SYS (fchdir, int, (int /*fd*/)); +# endif +_GL_CXXALIASWARN (fchdir); +# if @REPLACE_FCHDIR@ || !@HAVE_FCHDIR@ /* Gnulib internal hooks needed to maintain the fchdir metadata. */ _GL_EXTERN_C int _gl_register_fd (int fd, const char *filename) _GL_ARG_NONNULL ((2)); _GL_EXTERN_C void _gl_unregister_fd (int fd); _GL_EXTERN_C int _gl_register_dup (int oldfd, int newfd); _GL_EXTERN_C const char *_gl_directory_name (int fd); - -# else -# if !@HAVE_DECL_FCHDIR@ -_GL_FUNCDECL_SYS (fchdir, int, (int /*fd*/)); -# endif # endif -_GL_CXXALIAS_SYS (fchdir, int, (int /*fd*/)); -_GL_CXXALIASWARN (fchdir); #elif defined GNULIB_POSIXCHECK # undef fchdir # if HAVE_RAW_DECL_FCHDIR @@ -1113,10 +1118,10 @@ _GL_WARN_ON_USE (ftruncate, "ftruncate is unportable - " or SIZE was too small. See the POSIX:2008 specification . - Additionally, the gnulib module 'getcwd' guarantees the following GNU - extension: If BUF is NULL, an array is allocated with 'malloc'; the array - is SIZE bytes long, unless SIZE == 0, in which case it is as big as - necessary. */ + Additionally, the gnulib module 'getcwd' or 'getcwd-lgpl' guarantees the + following GNU extension: If BUF is NULL, an array is allocated with + 'malloc'; the array is SIZE bytes long, unless SIZE == 0, in which case + it is as big as necessary. */ # if @REPLACE_GETCWD@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) # define getcwd rpl_getcwd diff --git a/lib/unlocked-io.h b/lib/unlocked-io.h index b27c3fdcd6f..0cd9bbf3c98 100644 --- a/lib/unlocked-io.h +++ b/lib/unlocked-io.h @@ -101,7 +101,7 @@ # define fwrite_unlocked(w,x,y,z) fwrite (w,x,y,z) # endif -# if HAVE_DECL_GETC_UNLOCKED || defined get_unlocked +# if HAVE_DECL_GETC_UNLOCKED || defined getc_unlocked # undef getc # define getc(x) getc_unlocked (x) # else diff --git a/lib/utimens.c b/lib/utimens.c index dca9a01252a..4bfb9c91a7b 100644 --- a/lib/utimens.c +++ b/lib/utimens.c @@ -231,8 +231,8 @@ fdutimens (int fd, char const *file, struct timespec const timespec[2]) The same bug occurs in Solaris 11.1 (Apr 2013). - FIXME: Simplify this for Linux in 2016 and for Solaris in - 2024, when file system bugs are no longer common. */ + FIXME: Simplify this in 2024, when these file system bugs are + no longer common on Gnulib target platforms. */ if (adjustment_needed == 2) { if (fd < 0 ? stat (file, &st) : fstat (fd, &st)) diff --git a/lib/verify.h b/lib/verify.h index a80f22c694a..08268c2498f 100644 --- a/lib/verify.h +++ b/lib/verify.h @@ -188,9 +188,9 @@ template _gl_verify_type<(R) ? 1 : -1> #elif defined _GL_HAVE__STATIC_ASSERT # define _GL_VERIFY_TYPE(R, DIAGNOSTIC) \ - struct { \ - _Static_assert (R, DIAGNOSTIC); \ - int _gl_dummy; \ + struct { \ + _Static_assert (R, DIAGNOSTIC); \ + int _gl_dummy; \ } #else # define _GL_VERIFY_TYPE(R, DIAGNOSTIC) \ @@ -212,8 +212,8 @@ template #elif defined _GL_HAVE__STATIC_ASSERT # define _GL_VERIFY(R, DIAGNOSTIC, ...) _Static_assert (R, DIAGNOSTIC) #else -# define _GL_VERIFY(R, DIAGNOSTIC, ...) \ - extern int (*_GL_GENSYM (_gl_verify_function) (void)) \ +# define _GL_VERIFY(R, DIAGNOSTIC, ...) \ + extern int (*_GL_GENSYM (_gl_verify_function) (void)) \ [_GL_VERIFY_TRUE (R, DIAGNOSTIC)] # if 4 < __GNUC__ + (6 <= __GNUC_MINOR__) # pragma GCC diagnostic ignored "-Wnested-externs" diff --git a/lib/xalloc-oversized.h b/lib/xalloc-oversized.h index 2be82cd275d..0b7bb2cee85 100644 --- a/lib/xalloc-oversized.h +++ b/lib/xalloc-oversized.h @@ -1,7 +1,6 @@ /* xalloc-oversized.h -- memory allocation size checking - Copyright (C) 1990-2000, 2003-2004, 2006-2024 Free Software - Foundation, Inc. + Copyright (C) 1990-2000, 2003-2004, 2006-2024 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as @@ -49,13 +48,13 @@ #if 7 <= __GNUC__ && !defined __clang__ && PTRDIFF_MAX < SIZE_MAX # define xalloc_oversized(n, s) \ __builtin_mul_overflow_p (n, s, (ptrdiff_t) 1) -#elif (5 <= __GNUC__ && !defined __ICC && !__STRICT_ANSI__ \ - && PTRDIFF_MAX < SIZE_MAX) +#elif 5 <= __GNUC__ && !defined __ICC && PTRDIFF_MAX < SIZE_MAX # define xalloc_oversized(n, s) \ (__builtin_constant_p (n) && __builtin_constant_p (s) \ ? __xalloc_oversized (n, s) \ - : ({ ptrdiff_t __xalloc_count; \ - __builtin_mul_overflow (n, s, &__xalloc_count); })) + : __extension__ \ + ({ ptrdiff_t __xalloc_count; \ + __builtin_mul_overflow (n, s, &__xalloc_count); })) /* Other compilers use integer division; this may be slower but is more portable. */ diff --git a/m4/00gnulib.m4 b/m4/00gnulib.m4 index 3448c40bbd6..99c99d1b0fb 100644 --- a/m4/00gnulib.m4 +++ b/m4/00gnulib.m4 @@ -1,4 +1,4 @@ -# 00gnulib.m4 serial 8 +# 00gnulib.m4 serial 9 dnl Copyright (C) 2009-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -49,14 +49,14 @@ dnl AC_REQUIRE([gl_COMPILER_CLANG]) [if test $gl_cv_compiler_clang = yes; then dnl Test whether the compiler supports the option dnl '-Werror=implicit-function-declaration'. - save_ac_compile="$ac_compile" + saved_ac_compile="$ac_compile" ac_compile="$ac_compile -Werror=implicit-function-declaration" dnl Use _AC_COMPILE_IFELSE instead of AC_COMPILE_IFELSE, to avoid a dnl warning "AC_COMPILE_IFELSE was called before AC_USE_SYSTEM_EXTENSIONS". _AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]],[[]])], [gl_cv_compiler_check_decl_option='-Werror=implicit-function-declaration'], [gl_cv_compiler_check_decl_option=none]) - ac_compile="$save_ac_compile" + ac_compile="$saved_ac_compile" else gl_cv_compiler_check_decl_option=none fi @@ -71,11 +71,11 @@ dnl Redefine _AC_CHECK_DECL_BODY so that it references ac_compile_for_check_decl dnl instead of ac_compile. If, for whatever reason, the override of AC_PROG_CC dnl in zzgnulib.m4 is inactive, use the original ac_compile. m4_define([_AC_CHECK_DECL_BODY], -[ ac_save_ac_compile="$ac_compile" +[ ac_saved_ac_compile="$ac_compile" if test -n "$ac_compile_for_check_decl"; then ac_compile="$ac_compile_for_check_decl" fi] -m4_defn([_AC_CHECK_DECL_BODY])[ ac_compile="$ac_save_ac_compile" +m4_defn([_AC_CHECK_DECL_BODY])[ ac_compile="$ac_saved_ac_compile" ]) # gl_00GNULIB diff --git a/m4/absolute-header.m4 b/m4/absolute-header.m4 index aa7d0dac6da..0e9f9ba763a 100644 --- a/m4/absolute-header.m4 +++ b/m4/absolute-header.m4 @@ -1,4 +1,4 @@ -# absolute-header.m4 serial 17 +# absolute-header.m4 serial 18 dnl Copyright (C) 2006-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -66,7 +66,7 @@ AC_DEFUN([gl_ABSOLUTE_HEADER_ONE], esac changequote(,) case "$host_os" in - mingw*) + mingw* | windows*) dnl For the sake of native Windows compilers (excluding gcc), dnl treat backslash as a directory separator, like /. dnl Actually, these compilers use a double-backslash as diff --git a/m4/acl.m4 b/m4/acl.m4 index 199bf67cbc5..2050d108b0c 100644 --- a/m4/acl.m4 +++ b/m4/acl.m4 @@ -1,5 +1,5 @@ # acl.m4 - check for access control list (ACL) primitives -# serial 29 +# serial 30 # Copyright (C) 2002, 2004-2024 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation @@ -27,7 +27,7 @@ AC_DEFUN_ONCE([gl_FUNC_ACL], dnl On all platforms, the ACL related API is declared in . AC_CHECK_HEADERS([sys/acl.h]) if test $ac_cv_header_sys_acl_h = yes; then - ac_save_LIBS=$LIBS + gl_saved_LIBS=$LIBS dnl Test for POSIX-draft-like API (GNU/Linux, FreeBSD, Mac OS X, dnl IRIX, Tru64, Cygwin >= 2.5). @@ -129,7 +129,7 @@ int type = ACL_TYPE_EXTENDED;]])], fi fi - LIBS=$ac_save_LIBS + LIBS=$gl_saved_LIBS fi if test "$enable_acl$use_acl" = yes0; then diff --git a/m4/alloca.m4 b/m4/alloca.m4 index 911a003a04f..90960215382 100644 --- a/m4/alloca.m4 +++ b/m4/alloca.m4 @@ -1,6 +1,6 @@ # alloca.m4 serial 21 -dnl Copyright (C) 2002-2004, 2006-2007, 2009-2024 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2004, 2006-2007, 2009-2024 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/assert_h.m4 b/m4/assert_h.m4 index a73e45f0641..d3d4c42519f 100644 --- a/m4/assert_h.m4 +++ b/m4/assert_h.m4 @@ -9,10 +9,10 @@ dnl From Paul Eggert. AC_DEFUN([gl_ASSERT_H], [ AC_CACHE_CHECK([for static_assert], [gl_cv_static_assert], - [gl_save_CFLAGS=$CFLAGS + [gl_saved_CFLAGS=$CFLAGS for gl_working in "yes, a keyword" "yes, an macro"; do AS_CASE([$gl_working], - [*assert.h*], [CFLAGS="$gl_save_CFLAGS -DINCLUDE_ASSERT_H"]) + [*assert.h*], [CFLAGS="$gl_saved_CFLAGS -DINCLUDE_ASSERT_H"]) AC_COMPILE_IFELSE( [AC_LANG_PROGRAM( @@ -32,7 +32,7 @@ AC_DEFUN([gl_ASSERT_H], ]])], [gl_cv_static_assert=$gl_working], [gl_cv_static_assert=no]) - CFLAGS=$gl_save_CFLAGS + CFLAGS=$gl_saved_CFLAGS test "$gl_cv_static_assert" != no && break done]) diff --git a/m4/canonicalize.m4 b/m4/canonicalize.m4 index a5831bb4b62..05dc6dd264d 100644 --- a/m4/canonicalize.m4 +++ b/m4/canonicalize.m4 @@ -1,4 +1,4 @@ -# canonicalize.m4 serial 38 +# canonicalize.m4 serial 39 dnl Copyright (C) 2003-2007, 2009-2024 Free Software Foundation, Inc. @@ -66,8 +66,8 @@ AC_DEFUN([gl_CANONICALIZE_LGPL_SEPARATE], dnl available through the linker option '-loldnames'. AC_REQUIRE([AC_CANONICAL_HOST]) case "$host_os" in - mingw*) ;; - *) AC_CHECK_FUNCS([getcwd]) ;; + mingw* | windows*) ;; + *) AC_CHECK_FUNCS([getcwd]) ;; esac AC_REQUIRE([gl_DOUBLE_SLASH_ROOT]) @@ -158,16 +158,16 @@ AC_DEFUN([gl_FUNC_REALPATH_WORKS], esac ], [case "$host_os" in - # Guess yes on glibc systems. - *-gnu* | gnu*) gl_cv_func_realpath_works="guessing yes" ;; - # Guess 'nearly' on musl systems. - *-musl*) gl_cv_func_realpath_works="guessing nearly" ;; - # Guess no on Cygwin. - cygwin*) gl_cv_func_realpath_works="guessing no" ;; - # Guess no on native Windows. - mingw*) gl_cv_func_realpath_works="guessing no" ;; - # If we don't know, obey --enable-cross-guesses. - *) gl_cv_func_realpath_works="$gl_cross_guess_normal" ;; + # Guess yes on glibc systems. + *-gnu* | gnu*) gl_cv_func_realpath_works="guessing yes" ;; + # Guess 'nearly' on musl systems. + *-musl*) gl_cv_func_realpath_works="guessing nearly" ;; + # Guess no on Cygwin. + cygwin*) gl_cv_func_realpath_works="guessing no" ;; + # Guess no on native Windows. + mingw* | windows*) gl_cv_func_realpath_works="guessing no" ;; + # If we don't know, obey --enable-cross-guesses. + *) gl_cv_func_realpath_works="$gl_cross_guess_normal" ;; esac ]) rm -rf conftest.a conftest.l conftest.d diff --git a/m4/clock_time.m4 b/m4/clock_time.m4 index 369e1412ec6..c016575c8ea 100644 --- a/m4/clock_time.m4 +++ b/m4/clock_time.m4 @@ -1,4 +1,4 @@ -# clock_time.m4 serial 13 +# clock_time.m4 serial 14 dnl Copyright (C) 2002-2006, 2009-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -32,7 +32,7 @@ AC_DEFUN([gl_CLOCK_TIME], CLOCK_TIME_LIB= AC_SUBST([CLOCK_TIME_LIB]) case "$host_os" in - mingw*) + mingw* | windows*) ac_cv_func_clock_getres=no ac_cv_func_clock_gettime=no ac_cv_func_clock_settime=no diff --git a/m4/codeset.m4 b/m4/codeset.m4 index 0b01779abc9..94dccce7775 100644 --- a/m4/codeset.m4 +++ b/m4/codeset.m4 @@ -1,6 +1,6 @@ # codeset.m4 serial 5 (gettext-0.18.2) -dnl Copyright (C) 2000-2002, 2006, 2008-2014, 2016, 2019-2024 Free -dnl Software Foundation, Inc. +dnl Copyright (C) 2000-2002, 2006, 2008-2014, 2016, 2019-2024 Free Software +dnl Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/d-type.m4 b/m4/d-type.m4 index 13bab57a3a5..b06bca5a7dc 100644 --- a/m4/d-type.m4 +++ b/m4/d-type.m4 @@ -5,8 +5,7 @@ dnl dnl Check whether struct dirent has a member named d_type. dnl -# Copyright (C) 1997, 1999-2004, 2006, 2009-2024 Free Software -# Foundation, Inc. +# Copyright (C) 1997, 1999-2004, 2006, 2009-2024 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/dirent_h.m4 b/m4/dirent_h.m4 index 1e55f025d28..3e3d967f499 100644 --- a/m4/dirent_h.m4 +++ b/m4/dirent_h.m4 @@ -1,4 +1,4 @@ -# dirent_h.m4 serial 20 +# dirent_h.m4 serial 22 dnl Copyright (C) 2008-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -32,14 +32,13 @@ AC_DEFUN_ONCE([gl_DIRENT_H], dnl Determine whether needs to override the DIR type. AC_DEFUN_ONCE([gl_DIRENT_DIR], [ - dnl Set DIR_HAS_FD_MEMBER if dirfd() works, i.e. not always returns -1, - dnl or has the __KLIBC__ workaround as in lib/dirfd.c. + dnl Set DIR_HAS_FD_MEMBER if dirfd() works, i.e. not always returns -1. dnl We could use the findings from gl_FUNC_DIRFD and gl_PREREQ_DIRFD, but dnl it's simpler since we know the affected platforms. AC_REQUIRE([AC_CANONICAL_HOST]) case "$host_os" in - mingw*) DIR_HAS_FD_MEMBER=0 ;; - *) DIR_HAS_FD_MEMBER=1 ;; + mingw* | windows* | os2*) DIR_HAS_FD_MEMBER=0 ;; + *) DIR_HAS_FD_MEMBER=1 ;; esac AC_SUBST([DIR_HAS_FD_MEMBER]) ]) diff --git a/m4/dirfd.m4 b/m4/dirfd.m4 index 6578dc0232b..e58582e6145 100644 --- a/m4/dirfd.m4 +++ b/m4/dirfd.m4 @@ -1,4 +1,4 @@ -# serial 28 -*- Autoconf -*- +# serial 30 -*- Autoconf -*- dnl Find out how to get the file descriptor associated with an open DIR*. @@ -40,15 +40,12 @@ AC_DEFUN([gl_FUNC_DIRFD], HAVE_DIRFD=0 else HAVE_DIRFD=1 - dnl Replace dirfd() on native Windows, to support fdopendir(). + dnl Replace dirfd() on native Windows and OS/2 kLIBC, + dnl to support fdopendir(). AC_REQUIRE([gl_DIRENT_DIR]) if test $DIR_HAS_FD_MEMBER = 0; then REPLACE_DIRFD=1 fi - dnl OS/2 kLIBC dirfd() does not work. - case "$host_os" in - os2*) REPLACE_DIRFD=1 ;; - esac fi ]) @@ -58,7 +55,7 @@ AC_DEFUN([gl_PREREQ_DIRFD], AC_CACHE_CHECK([how to get the file descriptor associated with an open DIR*], [gl_cv_sys_dir_fd_member_name], [ - dirfd_save_CFLAGS=$CFLAGS + gl_saved_CFLAGS=$CFLAGS for ac_expr in d_fd dd_fd; do CFLAGS="$CFLAGS -DDIR_FD_MEMBER_NAME=$ac_expr" @@ -68,7 +65,7 @@ AC_DEFUN([gl_PREREQ_DIRFD], [[DIR *dir_p = opendir("."); (void) dir_p->DIR_FD_MEMBER_NAME;]])], [dir_fd_found=yes] ) - CFLAGS=$dirfd_save_CFLAGS + CFLAGS=$gl_saved_CFLAGS test "$dir_fd_found" = yes && break done test "$dir_fd_found" = yes || ac_expr=no_such_member diff --git a/m4/dup2.m4 b/m4/dup2.m4 index 1833ff0ec17..f6759b647a6 100644 --- a/m4/dup2.m4 +++ b/m4/dup2.m4 @@ -1,6 +1,5 @@ -#serial 27 -dnl Copyright (C) 2002, 2005, 2007, 2009-2024 Free Software Foundation, -dnl Inc. +#serial 28 +dnl Copyright (C) 2002, 2005, 2007, 2009-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. @@ -68,7 +67,7 @@ AC_DEFUN([gl_FUNC_DUP2], ], [gl_cv_func_dup2_works=yes], [gl_cv_func_dup2_works=no], [case "$host_os" in - mingw*) # on this platform, dup2 always returns 0 for success + mingw* | windows*) # on this platform, dup2 always returns 0 for success gl_cv_func_dup2_works="guessing no" ;; cygwin*) # on cygwin 1.5.x, dup2(1,1) returns 0 gl_cv_func_dup2_works="guessing no" ;; diff --git a/m4/filemode.m4 b/m4/filemode.m4 index 3dd40f44b8b..b72317281b3 100644 --- a/m4/filemode.m4 +++ b/m4/filemode.m4 @@ -1,6 +1,5 @@ # filemode.m4 serial 9 -dnl Copyright (C) 2002, 2005-2006, 2009-2024 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2005-2006, 2009-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/fstatat.m4 b/m4/fstatat.m4 index 1b5e5f19276..c22569b7961 100644 --- a/m4/fstatat.m4 +++ b/m4/fstatat.m4 @@ -1,4 +1,4 @@ -# fstatat.m4 serial 4 +# fstatat.m4 serial 5 dnl Copyright (C) 2004-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -50,7 +50,7 @@ AC_DEFUN([gl_FUNC_FSTATAT], esac case $host_os in - solaris*) + darwin* | solaris*) REPLACE_FSTATAT=1 ;; esac diff --git a/m4/fsusage.m4 b/m4/fsusage.m4 index 9a81dabe34c..31d424c857d 100644 --- a/m4/fsusage.m4 +++ b/m4/fsusage.m4 @@ -1,8 +1,7 @@ # serial 35 # Obtaining file system usage information. -# Copyright (C) 1997-1998, 2000-2001, 2003-2024 Free Software -# Foundation, Inc. +# Copyright (C) 1997-1998, 2000-2001, 2003-2024 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/getgroups.m4 b/m4/getgroups.m4 index 5062278b335..f6e0cbd3fce 100644 --- a/m4/getgroups.m4 +++ b/m4/getgroups.m4 @@ -1,10 +1,9 @@ -# serial 24 +# serial 25 dnl From Jim Meyering. dnl A wrapper around AC_FUNC_GETGROUPS. -# Copyright (C) 1996-1997, 1999-2004, 2008-2024 Free Software -# Foundation, Inc. +# Copyright (C) 1996-1997, 1999-2004, 2008-2024 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, @@ -21,7 +20,7 @@ AC_DEFUN([AC_FUNC_GETGROUPS], # If we don't yet have getgroups, see if it's in -lbsd. # This is reported to be necessary on an ITOS 3000WS running SEIUX 3.1. - ac_save_LIBS=$LIBS + gl_saved_LIBS=$LIBS if test $ac_cv_func_getgroups = no; then AC_CHECK_LIB(bsd, getgroups, [GETGROUPS_LIB=-lbsd]) fi @@ -57,7 +56,7 @@ AC_DEFUN([AC_FUNC_GETGROUPS], [Define to 1 if your system has a working `getgroups' function.]) ;; esac - LIBS=$ac_save_LIBS + LIBS=$gl_saved_LIBS ])# AC_FUNC_GETGROUPS AC_DEFUN([gl_FUNC_GETGROUPS], diff --git a/m4/getline.m4 b/m4/getline.m4 index d0e285dbc9f..1a7e89034bc 100644 --- a/m4/getline.m4 +++ b/m4/getline.m4 @@ -1,7 +1,7 @@ # getline.m4 serial 33 -dnl Copyright (C) 1998-2003, 2005-2007, 2009-2024 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 1998-2003, 2005-2007, 2009-2024 Free Software Foundation, +dnl Inc. dnl dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, diff --git a/m4/getloadavg.m4 b/m4/getloadavg.m4 index d25a594b215..9d0236f77fe 100644 --- a/m4/getloadavg.m4 +++ b/m4/getloadavg.m4 @@ -1,13 +1,13 @@ # Check for getloadavg. -# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2024 Free -# Software Foundation, Inc. +# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2024 Free Software +# Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. -#serial 12 +#serial 13 # Autoconf defines AC_FUNC_GETLOADAVG, but that is obsolescent. # New applications should use gl_GETLOADAVG instead. @@ -20,7 +20,7 @@ AC_DEFUN([gl_GETLOADAVG], # Persuade glibc to declare getloadavg(). AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) -gl_save_LIBS=$LIBS +gl_saved_LIBS=$LIBS # getloadavg is present in libc on glibc >= 2.2, Mac OS X, FreeBSD >= 2.0, # NetBSD >= 0.9, OpenBSD >= 2.0, Solaris >= 7. @@ -81,12 +81,12 @@ if test $ac_cv_func_getloadavg != yes; then fi fi -if test "x$gl_save_LIBS" = x; then +if test "x$gl_saved_LIBS" = x; then GETLOADAVG_LIBS=$LIBS else - GETLOADAVG_LIBS=`echo "$LIBS" | sed "s!$gl_save_LIBS!!"` + GETLOADAVG_LIBS=`echo "$LIBS" | sed "s!$gl_saved_LIBS!!"` fi -LIBS=$gl_save_LIBS +LIBS=$gl_saved_LIBS AC_SUBST([GETLOADAVG_LIBS])dnl diff --git a/m4/getopt.m4 b/m4/getopt.m4 index cc0356390ba..be812d8459b 100644 --- a/m4/getopt.m4 +++ b/m4/getopt.m4 @@ -1,4 +1,4 @@ -# getopt.m4 serial 48 +# getopt.m4 serial 49 dnl Copyright (C) 2002-2006, 2008-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -197,8 +197,8 @@ main () fi else case "$host_os" in - darwin* | aix* | mingw*) gl_cv_func_getopt_posix="guessing no";; - *) gl_cv_func_getopt_posix="guessing yes";; + darwin* | aix* | mingw* | windows*) gl_cv_func_getopt_posix="guessing no";; + *) gl_cv_func_getopt_posix="guessing yes";; esac fi ]) diff --git a/m4/getrandom.m4 b/m4/getrandom.m4 index 6ddaed2d569..55be445c31a 100644 --- a/m4/getrandom.m4 +++ b/m4/getrandom.m4 @@ -1,4 +1,4 @@ -# getrandom.m4 serial 11 +# getrandom.m4 serial 13 dnl Copyright 2020-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -9,6 +9,8 @@ dnl Written by Paul Eggert. AC_DEFUN([gl_FUNC_GETRANDOM], [ AC_REQUIRE([gl_SYS_RANDOM_H_DEFAULTS]) + AC_REQUIRE([AC_CANONICAL_HOST]) + gl_CHECK_FUNCS_ANDROID([getrandom], [[/* Additional includes are needed before on uClibc and Mac OS X. */ @@ -45,7 +47,7 @@ AC_DEFUN([gl_FUNC_GETRANDOM], fi case "$host_os" in - mingw*) + mingw* | windows*) AC_CHECK_HEADERS([bcrypt.h], [], [], [[#include ]]) diff --git a/m4/gettime.m4 b/m4/gettime.m4 index 61fdbb35d46..e450e6b9d05 100644 --- a/m4/gettime.m4 +++ b/m4/gettime.m4 @@ -1,6 +1,5 @@ # gettime.m4 serial 14 -dnl Copyright (C) 2002, 2004-2006, 2009-2024 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2004-2006, 2009-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/gettimeofday.m4 b/m4/gettimeofday.m4 index 6c2f8583603..35269914ced 100644 --- a/m4/gettimeofday.m4 +++ b/m4/gettimeofday.m4 @@ -1,7 +1,6 @@ -# serial 29 +# serial 30 -# Copyright (C) 2001-2003, 2005, 2007, 2009-2024 Free Software -# Foundation, Inc. +# Copyright (C) 2001-2003, 2005, 2007, 2009-2024 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. @@ -58,7 +57,7 @@ int gettimeofday (struct timeval *restrict, struct timezone *restrict); dnl On mingw, the original gettimeofday has only a precision of 15.6 dnl milliseconds. So override it. case "$host_os" in - mingw*) REPLACE_GETTIMEOFDAY=1 ;; + mingw* | windows*) REPLACE_GETTIMEOFDAY=1 ;; esac fi AC_DEFINE_UNQUOTED([GETTIMEOFDAY_TIMEZONE], [$gl_gettimeofday_timezone], diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index db0c8853d73..03d10fa51ea 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -1,4 +1,4 @@ -# gnulib-common.m4 serial 87 +# gnulib-common.m4 serial 90 dnl Copyright (C) 2007-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -114,10 +114,14 @@ AC_DEFUN([gl_COMMON_BODY], [ # define _GL_ATTR_warn_unused_result _GL_GNUC_PREREQ (3, 4) #endif -/* Disable GCC -Wpedantic if using __has_c_attribute and this is not C23+. */ -#if (defined __has_c_attribute && _GL_GNUC_PREREQ (4, 6) \ - && (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) <= 201710) -# pragma GCC diagnostic ignored "-Wpedantic" +/* Use __has_c_attribute if available. However, do not use with + pre-C23 GCC, which can issue false positives if -Wpedantic. */ +#if (defined __has_c_attribute \ + && ! (_GL_GNUC_PREREQ (4, 6) \ + && (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) <= 201710)) +# define _GL_HAVE___HAS_C_ATTRIBUTE 1 +#else +# define _GL_HAVE___HAS_C_ATTRIBUTE 0 #endif /* Define if, in a function declaration, the attributes in bracket syntax @@ -242,7 +246,7 @@ AC_DEFUN([gl_COMMON_BODY], [ in C++ also: namespace, class, template specialization. */ #ifndef _GL_ATTRIBUTE_DEPRECATED # ifndef _GL_BRACKET_BEFORE_ATTRIBUTE -# ifdef __has_c_attribute +# if _GL_HAVE___HAS_C_ATTRIBUTE # if __has_c_attribute (__deprecated__) # define _GL_ATTRIBUTE_DEPRECATED [[__deprecated__]] # endif @@ -291,7 +295,7 @@ AC_DEFUN([gl_COMMON_BODY], [ /* Applies to: Empty statement (;), inside a 'switch' statement. */ /* Always expands to something. */ #ifndef _GL_ATTRIBUTE_FALLTHROUGH -# ifdef __has_c_attribute +# if _GL_HAVE___HAS_C_ATTRIBUTE # if __has_c_attribute (__fallthrough__) # define _GL_ATTRIBUTE_FALLTHROUGH [[__fallthrough__]] # endif @@ -380,7 +384,7 @@ AC_DEFUN([gl_COMMON_BODY], [ # if !defined __apple_build_version__ && __clang_major__ >= 10 # define _GL_ATTRIBUTE_MAYBE_UNUSED [[__maybe_unused__]] # endif -# elif defined __has_c_attribute +# elif _GL_HAVE___HAS_C_ATTRIBUTE # if __has_c_attribute (__maybe_unused__) # define _GL_ATTRIBUTE_MAYBE_UNUSED [[__maybe_unused__]] # endif @@ -411,7 +415,7 @@ AC_DEFUN([gl_COMMON_BODY], [ # if __clang_major__ >= 1000 # define _GL_ATTRIBUTE_NODISCARD [[__nodiscard__]] # endif -# elif defined __has_c_attribute +# elif _GL_HAVE___HAS_C_ATTRIBUTE # if __has_c_attribute (__nodiscard__) # define _GL_ATTRIBUTE_NODISCARD [[__nodiscard__]] # endif @@ -466,11 +470,25 @@ AC_DEFUN([gl_COMMON_BODY], [ /* _GL_ATTRIBUTE_NOTHROW declares that the function does not throw exceptions. */ /* Applies to: functions. */ +/* After a function's parameter list, this attribute must come first, before + other attributes. */ #ifndef _GL_ATTRIBUTE_NOTHROW -# if _GL_HAS_ATTRIBUTE (nothrow) && !defined __cplusplus -# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__)) +# if defined __cplusplus +# if _GL_GNUC_PREREQ (2, 8) || __clang_major >= 4 +# if __cplusplus >= 201103L +# define _GL_ATTRIBUTE_NOTHROW noexcept (true) +# else +# define _GL_ATTRIBUTE_NOTHROW throw () +# endif +# else +# define _GL_ATTRIBUTE_NOTHROW +# endif # else -# define _GL_ATTRIBUTE_NOTHROW +# if _GL_HAS_ATTRIBUTE (nothrow) +# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__)) +# else +# define _GL_ATTRIBUTE_NOTHROW +# endif # endif #endif @@ -1056,6 +1074,7 @@ AC_DEFUN([gl_CC_GNULIB_WARNINGS], dnl -Wno-pedantic >= 4.8 >= 3.9 dnl -Wno-sign-compare >= 3 >= 3.9 dnl -Wno-sign-conversion >= 4.3 >= 3.9 + dnl -Wno-tautological-out-of-range-compare - >= 3.9 dnl -Wno-type-limits >= 4.3 >= 3.9 dnl -Wno-undef >= 3 >= 3.9 dnl -Wno-unsuffixed-float-constants >= 4.5 @@ -1081,6 +1100,9 @@ AC_DEFUN([gl_CC_GNULIB_WARNINGS], #if __GNUC__ + (__GNUC_MINOR__ >= 8) > 4 || (__clang_major__ + (__clang_minor__ >= 9) > 3) -Wno-pedantic #endif + #if 3 < __clang_major__ + (9 <= __clang_minor__) + -Wno-tautological-constant-out-of-range-compare + #endif #if __GNUC__ + (__GNUC_MINOR__ >= 3) > 4 || (__clang_major__ + (__clang_minor__ >= 9) > 3) -Wno-sign-conversion -Wno-type-limits @@ -1144,12 +1166,12 @@ AC_DEFUN([gl_PREPARE_CHECK_FUNCS_MACOS], if test $gl_cv_compiler_clang = yes; then dnl Test whether the compiler supports the option dnl '-Werror=unguarded-availability-new'. - save_ac_compile="$ac_compile" + saved_ac_compile="$ac_compile" ac_compile="$ac_compile -Werror=unguarded-availability-new" AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]],[[]])], [gl_cv_compiler_check_future_option='-Werror=unguarded-availability-new'], [gl_cv_compiler_check_future_option=none]) - ac_compile="$save_ac_compile" + ac_compile="$saved_ac_compile" else gl_cv_compiler_check_future_option=none fi @@ -1197,14 +1219,14 @@ AC_DEFUN([gl_CHECK_FUNCS_CASE_FOR_MACOS], darwin*) if test "x$gl_cv_compiler_check_future_option" != "xnone"; then dnl Use a compile test, not a link test. - save_ac_compile="$ac_compile" + saved_ac_compile="$ac_compile" ac_compile="$ac_compile $gl_cv_compiler_check_future_option" - save_ac_compile_for_check_decl="$ac_compile_for_check_decl" + saved_ac_compile_for_check_decl="$ac_compile_for_check_decl" ac_compile_for_check_decl="$ac_compile_for_check_decl $gl_cv_compiler_check_future_option" unset [ac_cv_have_decl_][$1] AC_CHECK_DECL([$1], , , [$2]) - ac_compile="$save_ac_compile" - ac_compile_for_check_decl="$save_ac_compile_for_check_decl" + ac_compile="$saved_ac_compile" + ac_compile_for_check_decl="$saved_ac_compile_for_check_decl" [ac_cv_func_][$1]="$[ac_cv_have_decl_][$1]" if test $[ac_cv_func_][$1] = yes; then [gl_cv_onwards_func_][$1]=yes diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index f3ac7cc2409..2e5b328e3d8 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -677,7 +677,7 @@ AC_DEFUN([gl_INIT], if $gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b; then :; else AC_REQUIRE([AC_CANONICAL_HOST]) gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=true - if case $host_os in mingw*) false;; *) :;; esac; then + if case $host_os in mingw* | windows*) false;; *) :;; esac; then func_gl_gnulib_m4code_open fi fi @@ -1005,13 +1005,13 @@ AC_DEFUN([gl_INIT], if test $REPLACE_GETLINE = 1; then func_gl_gnulib_m4code_getdelim fi - if case $host_os in mingw*) false;; *) test $HAVE_GETLOADAVG = 0 || test $REPLACE_GETLOADAVG = 1;; esac; then + if case $host_os in mingw* | windows*) false;; *) test $HAVE_GETLOADAVG = 0 || test $REPLACE_GETLOADAVG = 1;; esac; then func_gl_gnulib_m4code_open fi if test $REPLACE_GETOPT = 1; then func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36 fi - if case $host_os in mingw*) false;; *) test $HAVE_GETRANDOM = 0 || test $REPLACE_GETRANDOM = 1;; esac; then + if case $host_os in mingw* | windows*) false;; *) test $HAVE_GETRANDOM = 0 || test $REPLACE_GETRANDOM = 1;; esac; then func_gl_gnulib_m4code_open fi if test $HAVE_READLINKAT = 0 || test $REPLACE_READLINKAT = 1; then diff --git a/m4/group-member.m4 b/m4/group-member.m4 index e058ace62b9..60b3d526db2 100644 --- a/m4/group-member.m4 +++ b/m4/group-member.m4 @@ -1,7 +1,6 @@ # serial 14 -# Copyright (C) 1999-2001, 2003-2007, 2009-2024 Free Software -# Foundation, Inc. +# Copyright (C) 1999-2001, 2003-2007, 2009-2024 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/include_next.m4 b/m4/include_next.m4 index 8a1c52c8564..70cb746f435 100644 --- a/m4/include_next.m4 +++ b/m4/include_next.m4 @@ -1,4 +1,4 @@ -# include_next.m4 serial 26 +# include_next.m4 serial 27 dnl Copyright (C) 2006-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -74,17 +74,17 @@ EOF #endif #define DEFINED_IN_CONFTESTD2 EOF - gl_save_CPPFLAGS="$CPPFLAGS" - CPPFLAGS="$gl_save_CPPFLAGS -Iconftestd1b -Iconftestd2" + gl_saved_CPPFLAGS="$CPPFLAGS" + CPPFLAGS="$gl_saved_CPPFLAGS -Iconftestd1b -Iconftestd2" dnl We intentionally avoid using AC_LANG_SOURCE here. AC_COMPILE_IFELSE([AC_LANG_DEFINES_PROVIDED[#include ]], [gl_cv_have_include_next=yes], - [CPPFLAGS="$gl_save_CPPFLAGS -Iconftestd1a -Iconftestd2" + [CPPFLAGS="$gl_saved_CPPFLAGS -Iconftestd1a -Iconftestd2" AC_COMPILE_IFELSE([AC_LANG_DEFINES_PROVIDED[#include ]], [gl_cv_have_include_next=buggy], [gl_cv_have_include_next=no]) ]) - CPPFLAGS="$gl_save_CPPFLAGS" + CPPFLAGS="$gl_saved_CPPFLAGS" rm -rf conftestd1a conftestd1b conftestd2 ]) PRAGMA_SYSTEM_HEADER= diff --git a/m4/largefile.m4 b/m4/largefile.m4 index 2ac98cc8c93..cbe9bc1f63d 100644 --- a/m4/largefile.m4 +++ b/m4/largefile.m4 @@ -247,7 +247,7 @@ AC_DEFUN([_AC_SYS_LARGEFILE_PROBE], AC_REQUIRE([AC_CANONICAL_HOST]) if test $ac_opt_found != yes; then AS_CASE([$host_os], - [mingw*], + [mingw* | windows*], [ac_cv_sys_largefile_opts="supported through gnulib" ac_opt_found=yes] ) @@ -305,7 +305,7 @@ AC_DEFUN([gl_LARGEFILE], [ AC_REQUIRE([AC_CANONICAL_HOST]) case "$host_os" in - mingw*) + mingw* | windows*) dnl Native Windows. dnl mingw64 defines off_t to a 64-bit type already, if dnl _FILE_OFFSET_BITS=64, which is ensured by AC_SYS_LARGEFILE. diff --git a/m4/lstat.m4 b/m4/lstat.m4 index d69b3b2182e..48cc8653fe6 100644 --- a/m4/lstat.m4 +++ b/m4/lstat.m4 @@ -1,4 +1,4 @@ -# serial 34 +# serial 36 # Copyright (C) 1997-2001, 2003-2024 Free Software Foundation, Inc. # @@ -18,7 +18,7 @@ AC_DEFUN([gl_FUNC_LSTAT], if test $ac_cv_func_lstat = yes; then AC_REQUIRE([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK]) case $host_os,$gl_cv_func_lstat_dereferences_slashed_symlink in - solaris* | *no) + darwin* | solaris* | *no) REPLACE_LSTAT=1 ;; esac @@ -62,7 +62,7 @@ AC_DEFUN([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK], *-gnu* | gnu*) # Guess yes on glibc systems. gl_cv_func_lstat_dereferences_slashed_symlink="guessing yes" ;; - mingw*) + mingw* | windows*) # Guess no on native Windows. gl_cv_func_lstat_dereferences_slashed_symlink="guessing no" ;; *) diff --git a/m4/malloc.m4 b/m4/malloc.m4 index 770b1ba0ccd..635d6726b11 100644 --- a/m4/malloc.m4 +++ b/m4/malloc.m4 @@ -1,4 +1,4 @@ -# malloc.m4 serial 29 +# malloc.m4 serial 31 dnl Copyright (C) 2007, 2009-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -16,7 +16,8 @@ AC_DEFUN([_AC_FUNC_MALLOC_IF], [[#include ]], [[void *p = malloc (0); - int result = !p; + void * volatile vp = p; + int result = !vp; free (p); return result;]]) ], @@ -26,7 +27,7 @@ AC_DEFUN([_AC_FUNC_MALLOC_IF], # Guess yes on platforms where we know the result. *-gnu* | freebsd* | netbsd* | openbsd* | bitrig* \ | gnu* | *-musl* | midipix* | midnightbsd* \ - | hpux* | solaris* | cygwin* | mingw* | msys* ) + | hpux* | solaris* | cygwin* | mingw* | windows* | msys* ) ac_cv_func_malloc_0_nonnull="guessing yes" ;; # If we don't know, obey --enable-cross-guesses. *) ac_cv_func_malloc_0_nonnull="$gl_cross_guess_normal" ;; @@ -128,7 +129,7 @@ AC_DEFUN([gl_CHECK_MALLOC_POSIX], dnl except on those platforms where we have seen 'test-malloc-gnu', dnl 'test-realloc-gnu', 'test-calloc-gnu' fail. case "$host_os" in - mingw*) + mingw* | windows*) gl_cv_func_malloc_posix=no ;; irix* | solaris*) dnl On IRIX 6.5, the three functions return NULL with errno unset diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4 index 4d44f3aa34d..3c6795ceb28 100644 --- a/m4/manywarnings.m4 +++ b/m4/manywarnings.m4 @@ -1,4 +1,4 @@ -# manywarnings.m4 serial 24 +# manywarnings.m4 serial 25 dnl Copyright (C) 2008-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -52,7 +52,7 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC(C)], AC_CACHE_CHECK([whether -Wno-missing-field-initializers is needed], [gl_cv_cc_nomfi_needed], [gl_cv_cc_nomfi_needed=no - gl_save_CFLAGS="$CFLAGS" + gl_saved_CFLAGS="$CFLAGS" CFLAGS="$CFLAGS -Wextra -Werror" AC_COMPILE_IFELSE( [AC_LANG_PROGRAM( @@ -71,7 +71,7 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC(C)], [CFLAGS="$CFLAGS -Wno-missing-field-initializers" AC_COMPILE_IFELSE([], [gl_cv_cc_nomfi_needed=yes])]) - CFLAGS="$gl_save_CFLAGS" + CFLAGS="$gl_saved_CFLAGS" ]) dnl Next, check if -Werror -Wuninitialized is useful with the @@ -79,13 +79,13 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC(C)], dnl has no effect if -O is not also used AC_CACHE_CHECK([whether -Wuninitialized is supported], [gl_cv_cc_uninitialized_supported], - [gl_save_CFLAGS="$CFLAGS" + [gl_saved_CFLAGS="$CFLAGS" CFLAGS="$CFLAGS -Werror -Wuninitialized" AC_COMPILE_IFELSE( [AC_LANG_PROGRAM([[]], [[]])], [gl_cv_cc_uninitialized_supported=yes], [gl_cv_cc_uninitialized_supported=no]) - CFLAGS="$gl_save_CFLAGS" + CFLAGS="$gl_saved_CFLAGS" ]) ]) diff --git a/m4/mempcpy.m4 b/m4/mempcpy.m4 index 375b3b4cda9..94ce05d1a6a 100644 --- a/m4/mempcpy.m4 +++ b/m4/mempcpy.m4 @@ -1,6 +1,6 @@ # mempcpy.m4 serial 14 -dnl Copyright (C) 2003-2004, 2006-2007, 2009-2024 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2003-2004, 2006-2007, 2009-2024 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/memrchr.m4 b/m4/memrchr.m4 index 21604f0ef94..b4ccdfa3c8d 100644 --- a/m4/memrchr.m4 +++ b/m4/memrchr.m4 @@ -1,6 +1,6 @@ # memrchr.m4 serial 11 -dnl Copyright (C) 2002-2003, 2005-2007, 2009-2024 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2003, 2005-2007, 2009-2024 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/mktime.m4 b/m4/mktime.m4 index a4aeb9f76ba..0565e5e61fe 100644 --- a/m4/mktime.m4 +++ b/m4/mktime.m4 @@ -1,6 +1,6 @@ -# serial 38 -dnl Copyright (C) 2002-2003, 2005-2007, 2009-2024 Free Software -dnl Foundation, Inc. +# serial 39 +dnl Copyright (C) 2002-2003, 2005-2007, 2009-2024 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. @@ -264,9 +264,9 @@ main () [gl_cv_func_working_mktime=yes], [gl_cv_func_working_mktime=no], [case "$host_os" in - # Guess no on native Windows. - mingw*) gl_cv_func_working_mktime="guessing no" ;; - *) gl_cv_func_working_mktime="$gl_cross_guess_normal" ;; + # Guess no on native Windows. + mingw* | windows*) gl_cv_func_working_mktime="guessing no" ;; + *) gl_cv_func_working_mktime="$gl_cross_guess_normal" ;; esac ]) fi @@ -287,7 +287,7 @@ AC_DEFUN([gl_FUNC_MKTIME], with the algorithmic workarounds.]) fi case "$host_os" in - mingw*) + mingw* | windows*) REPLACE_MKTIME=1 AC_DEFINE([NEED_MKTIME_WINDOWS], [1], [Define if the compilation of mktime.c should define 'mktime' diff --git a/m4/nanosleep.m4 b/m4/nanosleep.m4 index ad3f68cb75b..c51f590402f 100644 --- a/m4/nanosleep.m4 +++ b/m4/nanosleep.m4 @@ -1,4 +1,4 @@ -# serial 44 +# serial 46 dnl From Jim Meyering. dnl Check for the nanosleep function. @@ -21,7 +21,7 @@ AC_DEFUN([gl_FUNC_NANOSLEEP], AC_CHECK_DECLS_ONCE([alarm]) - nanosleep_save_libs=$LIBS + gl_saved_LIBS=$LIBS # Solaris 2.5.1 needs -lposix4 to get the nanosleep function. # Solaris 7 prefers the library name -lrt to the obsolescent name -lposix4. @@ -116,11 +116,14 @@ AC_DEFUN([gl_FUNC_NANOSLEEP], *) gl_cv_func_nanosleep=no ;; esac], [case "$host_os" in - linux*) # Guess it halfway works when the kernel is Linux. + # Guess it halfway works when the kernel is Linux. + linux*) gl_cv_func_nanosleep='guessing no (mishandles large arguments)' ;; - mingw*) # Guess no on native Windows. + # Guess no on native Windows. + mingw* | windows*) gl_cv_func_nanosleep='guessing no' ;; - *) # If we don't know, obey --enable-cross-guesses. + # If we don't know, obey --enable-cross-guesses. + *) gl_cv_func_nanosleep="$gl_cross_guess_normal" ;; esac ]) @@ -140,7 +143,7 @@ AC_DEFUN([gl_FUNC_NANOSLEEP], else HAVE_NANOSLEEP=0 fi - LIBS=$nanosleep_save_libs + LIBS=$gl_saved_LIBS # For backward compatibility. LIB_NANOSLEEP="$NANOSLEEP_LIB" diff --git a/m4/nstrftime.m4 b/m4/nstrftime.m4 index 01725b2a331..67250dc9455 100644 --- a/m4/nstrftime.m4 +++ b/m4/nstrftime.m4 @@ -1,7 +1,6 @@ # serial 37 -# Copyright (C) 1996-1997, 1999-2007, 2009-2024 Free Software -# Foundation, Inc. +# Copyright (C) 1996-1997, 1999-2007, 2009-2024 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/open.m4 b/m4/open.m4 index edbd8b93c83..91e5c31b59a 100644 --- a/m4/open.m4 +++ b/m4/open.m4 @@ -1,4 +1,4 @@ -# open.m4 serial 15 +# open.m4 serial 16 dnl Copyright (C) 2007-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -9,7 +9,7 @@ AC_DEFUN([gl_FUNC_OPEN], AC_REQUIRE([AC_CANONICAL_HOST]) AC_REQUIRE([gl_PREPROC_O_CLOEXEC]) case "$host_os" in - mingw* | pw*) + mingw* | windows* | pw*) REPLACE_OPEN=1 ;; *) diff --git a/m4/pathmax.m4 b/m4/pathmax.m4 index b7ce9ff1468..a0fc296c9b2 100644 --- a/m4/pathmax.m4 +++ b/m4/pathmax.m4 @@ -1,6 +1,6 @@ # pathmax.m4 serial 11 -dnl Copyright (C) 2002-2003, 2005-2006, 2009-2024 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2003, 2005-2006, 2009-2024 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/pthread_sigmask.m4 b/m4/pthread_sigmask.m4 index 81be9611db2..cb2ee900313 100644 --- a/m4/pthread_sigmask.m4 +++ b/m4/pthread_sigmask.m4 @@ -1,4 +1,4 @@ -# pthread_sigmask.m4 serial 22 +# pthread_sigmask.m4 serial 23 dnl Copyright (C) 2011-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -47,7 +47,7 @@ AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK], if test -n "$LIBMULTITHREAD"; then AC_CACHE_CHECK([for pthread_sigmask in $LIBMULTITHREAD], [gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD], - [gl_save_LIBS="$LIBS" + [gl_saved_LIBS="$LIBS" LIBS="$LIBS $LIBMULTITHREAD" AC_LINK_IFELSE( [AC_LANG_PROGRAM( @@ -58,7 +58,7 @@ AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK], ], [gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD=yes], [gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD=no]) - LIBS="$gl_save_LIBS" + LIBS="$gl_saved_LIBS" ]) if test $gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD = yes; then dnl pthread_sigmask is available with -pthread or -lpthread. @@ -164,7 +164,7 @@ AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK], AC_CACHE_CHECK([whether pthread_sigmask returns error numbers], [gl_cv_func_pthread_sigmask_return_works], [ - gl_save_LIBS="$LIBS" + gl_saved_LIBS="$LIBS" LIBS="$LIBS $PTHREAD_SIGMASK_LIB" AC_RUN_IFELSE( [AC_LANG_SOURCE([[ @@ -188,7 +188,7 @@ int main () gl_cv_func_pthread_sigmask_return_works="guessing yes";; esac ]) - LIBS="$gl_save_LIBS" + LIBS="$gl_saved_LIBS" ]) case "$gl_cv_func_pthread_sigmask_return_works" in *no) @@ -214,7 +214,7 @@ int main () [dnl Link against $LIBMULTITHREAD, not only $PTHREAD_SIGMASK_LIB. dnl Otherwise we get a false positive on those platforms where dnl $gl_cv_func_pthread_sigmask_in_libc_works is "no". - gl_save_LIBS=$LIBS + gl_saved_LIBS=$LIBS LIBS="$LIBS $LIBMULTITHREAD"]) AC_RUN_IFELSE( [AC_LANG_SOURCE([[ @@ -258,7 +258,7 @@ int main () [:], [gl_cv_func_pthread_sigmask_unblock_works=no], [:]) - m4_ifdef([gl_][THREADLIB], [LIBS=$gl_save_LIBS]) + m4_ifdef([gl_][THREADLIB], [LIBS=$gl_saved_LIBS]) ]) case "$gl_cv_func_pthread_sigmask_unblock_works" in *no) diff --git a/m4/readutmp.m4 b/m4/readutmp.m4 index d458a8b554a..ec40019735f 100644 --- a/m4/readutmp.m4 +++ b/m4/readutmp.m4 @@ -1,4 +1,4 @@ -# readutmp.m4 serial 30 +# readutmp.m4 serial 31 dnl Copyright (C) 2002-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -18,7 +18,7 @@ AC_DEFUN([gl_READUTMP], if test $ac_cv_header_systemd_sd_login_h = yes; then AC_CACHE_CHECK([for libsystemd version >= 254], [gl_cv_lib_readutmp_systemd], - [gl_save_LIBS="$LIBS" + [gl_saved_LIBS="$LIBS" LIBS="$LIBS -lsystemd" AC_LINK_IFELSE( [AC_LANG_PROGRAM([[ @@ -31,7 +31,7 @@ AC_DEFUN([gl_READUTMP], ], [gl_cv_lib_readutmp_systemd=yes], [gl_cv_lib_readutmp_systemd=no]) - LIBS="$gl_save_LIBS" + LIBS="$gl_saved_LIBS" ]) if test $gl_cv_lib_readutmp_systemd = yes; then AC_DEFINE([READUTMP_USE_SYSTEMD], [1], diff --git a/m4/realloc.m4 b/m4/realloc.m4 index 7c769644a6e..a59af2807c9 100644 --- a/m4/realloc.m4 +++ b/m4/realloc.m4 @@ -1,4 +1,4 @@ -# realloc.m4 serial 27 +# realloc.m4 serial 29 dnl Copyright (C) 2007, 2009-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -16,7 +16,8 @@ AC_DEFUN([_AC_FUNC_REALLOC_IF], [[#include ]], [[void *p = realloc (0, 0); - int result = !p; + void * volatile vp = p; + int result = !vp; free (p); return result;]]) ], @@ -26,7 +27,7 @@ AC_DEFUN([_AC_FUNC_REALLOC_IF], # Guess yes on platforms where we know the result. *-gnu* | freebsd* | netbsd* | openbsd* | bitrig* \ | gnu* | *-musl* | midipix* | midnightbsd* \ - | hpux* | solaris* | cygwin* | mingw* | msys* ) + | hpux* | solaris* | cygwin* | mingw* | windows* | msys* ) ac_cv_func_realloc_0_nonnull="guessing yes" ;; # If we don't know, obey --enable-cross-guesses. *) ac_cv_func_realloc_0_nonnull="$gl_cross_guess_normal" ;; diff --git a/m4/regex.m4 b/m4/regex.m4 index 7a43e1c9a26..3dfeabea057 100644 --- a/m4/regex.m4 +++ b/m4/regex.m4 @@ -1,4 +1,4 @@ -# serial 74 +# serial 75 # Copyright (C) 1996-2001, 2003-2024 Free Software Foundation, Inc. # @@ -327,10 +327,10 @@ AC_DEFUN([gl_REGEX], [gl_cv_func_re_compile_pattern_working=yes], [gl_cv_func_re_compile_pattern_working=no], [case "$host_os" in - # Guess no on native Windows. - mingw*) gl_cv_func_re_compile_pattern_working="guessing no" ;; - # Otherwise obey --enable-cross-guesses. - *) gl_cv_func_re_compile_pattern_working="$gl_cross_guess_normal" ;; + # Guess no on native Windows. + mingw* | windows*) gl_cv_func_re_compile_pattern_working="guessing no" ;; + # Otherwise obey --enable-cross-guesses. + *) gl_cv_func_re_compile_pattern_working="$gl_cross_guess_normal" ;; esac ]) ]) diff --git a/m4/sig2str.m4 b/m4/sig2str.m4 index 2cb77c58a46..ab3786b8954 100644 --- a/m4/sig2str.m4 +++ b/m4/sig2str.m4 @@ -1,6 +1,5 @@ # serial 7 -dnl Copyright (C) 2002, 2005-2006, 2009-2024 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2005-2006, 2009-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/ssize_t.m4 b/m4/ssize_t.m4 index 65c96fcf56b..25b28d77e4e 100644 --- a/m4/ssize_t.m4 +++ b/m4/ssize_t.m4 @@ -1,6 +1,5 @@ # ssize_t.m4 serial 6 -dnl Copyright (C) 2001-2003, 2006, 2010-2024 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2001-2003, 2006, 2010-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/stat-time.m4 b/m4/stat-time.m4 index 7535a4c7e5c..8bec2f5f815 100644 --- a/m4/stat-time.m4 +++ b/m4/stat-time.m4 @@ -1,7 +1,7 @@ # Checks for stat-related time functions. -# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2024 Free -# Software Foundation, Inc. +# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2024 Free Software +# Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/stdalign.m4 b/m4/stdalign.m4 index 2683fae7daf..e3c1e609236 100644 --- a/m4/stdalign.m4 +++ b/m4/stdalign.m4 @@ -13,10 +13,10 @@ AC_DEFUN([gl_ALIGNASOF], [ AC_CACHE_CHECK([for alignas and alignof], [gl_cv_header_working_stdalign_h], - [gl_save_CFLAGS=$CFLAGS + [gl_saved_CFLAGS=$CFLAGS for gl_working in "yes, keywords" "yes, macros"; do AS_CASE([$gl_working], - [*stdalign.h*], [CFLAGS="$gl_save_CFLAGS -DINCLUDE_STDALIGN_H"]) + [*stdalign.h*], [CFLAGS="$gl_saved_CFLAGS -DINCLUDE_STDALIGN_H"]) AC_COMPILE_IFELSE( [AC_LANG_PROGRAM( [[#include @@ -56,7 +56,7 @@ AC_DEFUN([gl_ALIGNASOF], [gl_cv_header_working_stdalign_h=$gl_working], [gl_cv_header_working_stdalign_h=no]) - CFLAGS=$gl_save_CFLAGS + CFLAGS=$gl_saved_CFLAGS test "$gl_cv_header_working_stdalign_h" != no && break done]) @@ -112,7 +112,11 @@ AC_DEFUN([gl_ALIGNASOF], # define _Alignof(type) alignof (type) # else template struct __alignof_helper { char __a; __t __b; }; -# define _Alignof(type) offsetof (__alignof_helper, __b) +# if (defined __GNUC__ && 4 <= __GNUC__) || defined __clang__ +# define _Alignof(type) __builtin_offsetof (__alignof_helper, __b) +# else +# define _Alignof(type) offsetof (__alignof_helper, __b) +# endif # define _GL_STDALIGN_NEEDS_STDDEF 1 # endif # else diff --git a/m4/stdint.m4 b/m4/stdint.m4 index 8c0d430c042..4aa250827cc 100644 --- a/m4/stdint.m4 +++ b/m4/stdint.m4 @@ -1,4 +1,4 @@ -# stdint.m4 serial 62 +# stdint.m4 serial 63 dnl Copyright (C) 2001-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -286,10 +286,10 @@ static const char *macro_values[] = [gl_cv_header_working_stdint_h=yes], [], [case "$host_os" in - # Guess yes on native Windows. - mingw*) gl_cv_header_working_stdint_h="guessing yes" ;; - # In general, assume it works. - *) gl_cv_header_working_stdint_h="guessing yes" ;; + # Guess yes on native Windows. + mingw* | windows*) gl_cv_header_working_stdint_h="guessing yes" ;; + # In general, assume it works. + *) gl_cv_header_working_stdint_h="guessing yes" ;; esac ]) ]) diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4 index bd6ef381c69..92e67a74bb5 100644 --- a/m4/stdlib_h.m4 +++ b/m4/stdlib_h.m4 @@ -1,4 +1,4 @@ -# stdlib_h.m4 serial 75 +# stdlib_h.m4 serial 76 dnl Copyright (C) 2007-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -134,6 +134,7 @@ AC_DEFUN([gl_STDLIB_H_REQUIRE_DEFAULTS], gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_PTSNAME_R]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_PUTENV]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_QSORT_R]) + gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_RAND]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_RANDOM]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_RANDOM_R]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_REALLOCARRAY]) @@ -237,6 +238,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS], REPLACE_PTSNAME_R=0; AC_SUBST([REPLACE_PTSNAME_R]) REPLACE_PUTENV=0; AC_SUBST([REPLACE_PUTENV]) REPLACE_QSORT_R=0; AC_SUBST([REPLACE_QSORT_R]) + REPLACE_RAND=0; AC_SUBST([REPLACE_RAND]) REPLACE_RANDOM=0; AC_SUBST([REPLACE_RANDOM]) REPLACE_RANDOM_R=0; AC_SUBST([REPLACE_RANDOM_R]) REPLACE_REALLOC_FOR_REALLOC_GNU=0; AC_SUBST([REPLACE_REALLOC_FOR_REALLOC_GNU]) diff --git a/m4/string_h.m4 b/m4/string_h.m4 index 3cbcbc74873..8b12101447f 100644 --- a/m4/string_h.m4 +++ b/m4/string_h.m4 @@ -5,7 +5,7 @@ # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. -# serial 37 +# serial 38 # Written by Paul Eggert. @@ -146,5 +146,6 @@ AC_DEFUN([gl_STRING_H_DEFAULTS], REPLACE_STRERROR_R=0; AC_SUBST([REPLACE_STRERROR_R]) REPLACE_STRERRORNAME_NP=0; AC_SUBST([REPLACE_STRERRORNAME_NP]) REPLACE_STRSIGNAL=0; AC_SUBST([REPLACE_STRSIGNAL]) + REPLACE_STRVERSCMP=0; AC_SUBST([REPLACE_STRVERSCMP]) UNDEFINE_STRTOK_R=0; AC_SUBST([UNDEFINE_STRTOK_R]) ]) diff --git a/m4/strnlen.m4 b/m4/strnlen.m4 index 16b351a3d41..3eac8e629d7 100644 --- a/m4/strnlen.m4 +++ b/m4/strnlen.m4 @@ -1,6 +1,6 @@ # strnlen.m4 serial 14 -dnl Copyright (C) 2002-2003, 2005-2007, 2009-2024 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2003, 2005-2007, 2009-2024 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/strtoimax.m4 b/m4/strtoimax.m4 index 0708d7e1ce8..b58fa48ff6e 100644 --- a/m4/strtoimax.m4 +++ b/m4/strtoimax.m4 @@ -1,6 +1,5 @@ -# strtoimax.m4 serial 16 -dnl Copyright (C) 2002-2004, 2006, 2009-2024 Free Software Foundation, -dnl Inc. +# strtoimax.m4 serial 17 +dnl Copyright (C) 2002-2004, 2006, 2009-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. @@ -62,12 +61,12 @@ int main () [gl_cv_func_strtoimax=yes], [gl_cv_func_strtoimax=no], [case "$host_os" in - # Guess no on AIX 5. - aix5*) gl_cv_func_strtoimax="guessing no" ;; - # Guess yes on native Windows. - mingw*) gl_cv_func_strtoimax="guessing yes" ;; - # Guess yes otherwise. - *) gl_cv_func_strtoimax="guessing yes" ;; + # Guess no on AIX 5. + aix5*) gl_cv_func_strtoimax="guessing no" ;; + # Guess yes on native Windows. + mingw* | windows*) gl_cv_func_strtoimax="guessing yes" ;; + # Guess yes otherwise. + *) gl_cv_func_strtoimax="guessing yes" ;; esac ]) ]) diff --git a/m4/strtoll.m4 b/m4/strtoll.m4 index 5ba266f7687..130b9094d88 100644 --- a/m4/strtoll.m4 +++ b/m4/strtoll.m4 @@ -1,6 +1,5 @@ -# strtoll.m4 serial 11 -dnl Copyright (C) 2002, 2004, 2006, 2008-2024 Free Software Foundation, -dnl Inc. +# strtoll.m4 serial 12 +dnl Copyright (C) 2002, 2004, 2006, 2008-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. @@ -45,7 +44,7 @@ AC_DEFUN([gl_FUNC_STRTOLL], [gl_cv_func_strtoll_works=no], [case "$host_os" in # Guess no on native Windows. - mingw*) gl_cv_func_strtoll_works="guessing no" ;; + mingw* | windows*) gl_cv_func_strtoll_works="guessing no" ;; # Guess no on glibc systems. *-gnu* | gnu*) gl_cv_func_strtoll_works="guessing no" ;; # Guess no on musl systems. diff --git a/m4/time_h.m4 b/m4/time_h.m4 index 07f82cdfaeb..367f69efae6 100644 --- a/m4/time_h.m4 +++ b/m4/time_h.m4 @@ -1,7 +1,6 @@ # Configure a more-standard replacement for . -# Copyright (C) 2000-2001, 2003-2007, 2009-2024 Free Software -# Foundation, Inc. +# Copyright (C) 2000-2001, 2003-2007, 2009-2024 Free Software Foundation, Inc. # serial 24 diff --git a/m4/timespec.m4 b/m4/timespec.m4 index 0a1c90e550c..59a0db9966e 100644 --- a/m4/timespec.m4 +++ b/m4/timespec.m4 @@ -1,7 +1,6 @@ #serial 15 -# Copyright (C) 2000-2001, 2003-2007, 2009-2024 Free Software -# Foundation, Inc. +# Copyright (C) 2000-2001, 2003-2007, 2009-2024 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/unistd_h.m4 b/m4/unistd_h.m4 index 3a1cacaef55..e078bd617a7 100644 --- a/m4/unistd_h.m4 +++ b/m4/unistd_h.m4 @@ -1,4 +1,4 @@ -# unistd_h.m4 serial 94 +# unistd_h.m4 serial 95 dnl Copyright (C) 2006-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -234,6 +234,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS], REPLACE_EXECVP=0; AC_SUBST([REPLACE_EXECVP]) REPLACE_EXECVPE=0; AC_SUBST([REPLACE_EXECVPE]) REPLACE_FACCESSAT=0; AC_SUBST([REPLACE_FACCESSAT]) + REPLACE_FCHDIR=0; AC_SUBST([REPLACE_FCHDIR]) REPLACE_FCHOWNAT=0; AC_SUBST([REPLACE_FCHOWNAT]) REPLACE_FDATASYNC=0; AC_SUBST([REPLACE_FDATASYNC]) REPLACE_FTRUNCATE=0; AC_SUBST([REPLACE_FTRUNCATE]) diff --git a/m4/utimes.m4 b/m4/utimes.m4 index 040b1af8050..05b23cbb736 100644 --- a/m4/utimes.m4 +++ b/m4/utimes.m4 @@ -1,5 +1,5 @@ # Detect some bugs in glibc's implementation of utimes. -# serial 8 +# serial 9 dnl Copyright (C) 2003-2005, 2009-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation @@ -144,11 +144,11 @@ main () [gl_cv_func_working_utimes=yes], [gl_cv_func_working_utimes=no], [case "$host_os" in - # Guess yes on musl systems. - *-musl*) gl_cv_func_working_utimes="guessing yes" ;; - # Guess no on native Windows. - mingw*) gl_cv_func_working_utimes="guessing no" ;; - *) gl_cv_func_working_utimes="$gl_cross_guess_normal" ;; + # Guess yes on musl systems. + *-musl*) gl_cv_func_working_utimes="guessing yes" ;; + # Guess no on native Windows. + mingw* | windows*) gl_cv_func_working_utimes="guessing no" ;; + *) gl_cv_func_working_utimes="$gl_cross_guess_normal" ;; esac ]) ]) diff --git a/m4/warnings.m4 b/m4/warnings.m4 index 6c97ef194e4..d487636aa36 100644 --- a/m4/warnings.m4 +++ b/m4/warnings.m4 @@ -1,4 +1,4 @@ -# warnings.m4 serial 19 +# warnings.m4 serial 20 dnl Copyright (C) 2008-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -26,13 +26,13 @@ case $gl_positive in esac m4_pushdef([gl_Positive], [$gl_positive])])dnl AC_CACHE_CHECK([whether _AC_LANG compiler handles $1], [gl_Warn], [ - gl_save_compiler_FLAGS="$gl_Flags" + gl_saved_compiler_FLAGS="$gl_Flags" AS_VAR_APPEND(m4_defn([gl_Flags]), [" $gl_unknown_warnings_are_errors ]m4_defn([gl_Positive])["]) AC_LINK_IFELSE([m4_default([$4], [AC_LANG_PROGRAM([[]])])], [AS_VAR_SET([gl_Warn], [yes])], [AS_VAR_SET([gl_Warn], [no])]) - gl_Flags="$gl_save_compiler_FLAGS" + gl_Flags="$gl_saved_compiler_FLAGS" ]) AS_VAR_IF(gl_Warn, [yes], [$2], [$3]) m4_popdef([gl_Positive])dnl -- cgit v1.2.3 From 1805f4bfd62354f4331c8f0464a2adb7787ecc1f Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 10 Dec 2023 14:48:33 +0100 Subject: Add script admin/run-codespell and supporting files * admin/codespell/README: * admin/codespell/codespell.dictionary: * admin/codespell/codespell.exclude: * admin/codespell/codespell.ignore: * admin/codespell/codespell.rc: * admin/run-codespell: New files. --- admin/codespell/README | 27 + admin/codespell/codespell.dictionary | 17 + admin/codespell/codespell.exclude | 1550 ++++++++++++++++++++++++++++++++++ admin/codespell/codespell.ignore | 41 + admin/codespell/codespell.rc | 4 + admin/run-codespell | 68 ++ 6 files changed, 1707 insertions(+) create mode 100644 admin/codespell/README create mode 100644 admin/codespell/codespell.dictionary create mode 100644 admin/codespell/codespell.exclude create mode 100644 admin/codespell/codespell.ignore create mode 100644 admin/codespell/codespell.rc create mode 100755 admin/run-codespell diff --git a/admin/codespell/README b/admin/codespell/README new file mode 100644 index 00000000000..fcc5e3b41d0 --- /dev/null +++ b/admin/codespell/README @@ -0,0 +1,27 @@ +This directory contains supporting files for running codespell. +See the ./admin/run-codespell script. + +codespell.dictionary + + This file contains additional, Emacs-specific corrections. When + fixing typos in Emacs, consider adding them to this file. + +codespell.exclude + + This file contains lines that are correct and should be ignored by + codespell. Add any false positives to this file. + + The lines must match lines in the Emacs source tree exactly, + including any whitespace. + +codespell.ignore + + This file contains any words that are correct in the context of + Emacs, or that we otherwise choose to ignore. Use your best + judgment when adding words to this file. Common typos that are + only correct in highly specific contexts should probably be in + codespell.exclude instead. + +codespell.rc + + This file contains the Emacs specific codespell configuration. diff --git a/admin/codespell/codespell.dictionary b/admin/codespell/codespell.dictionary new file mode 100644 index 00000000000..b082a48fe99 --- /dev/null +++ b/admin/codespell/codespell.dictionary @@ -0,0 +1,17 @@ +alis->alist, alias, alas, axis, alms, +boostrap-clean->bootstrap-clean +brunches->branches +defalis->defalias +defalises->defaliases +ecmacs->emacs +ehsell->eshell +emcs->emacs +finis->finish +firs->first +file-writeable-p->file-writable-p +hep->help +least-favourite->least-favorite +lien->line +liens->lines +mecas->emacs +sehell->eshell, shell, diff --git a/admin/codespell/codespell.exclude b/admin/codespell/codespell.exclude new file mode 100644 index 00000000000..89b8a951f93 --- /dev/null +++ b/admin/codespell/codespell.exclude @@ -0,0 +1,1550 @@ +Bonus: Return a cons cell: (COMPILED . UPTODATE). +Bonus: Return a cons cell: (COMPILED . UPTODATE)." +(defun semantic-grammar-create-package (&optional force uptodate) +If the Lisp code seems up to date, do nothing (if UPTODATE + (if uptodate (setq output nil))) +;; Updated by the RIPE Network Coordination Center. +;; Thanks to jond@miter.org (Jonathan Doughty) for help with code for + \"VHDL Modeling Guidelines\". +# PCRE LICENSE +# General Purpose Licence (GPL), or Lesser General Purpose Licence (LGPL), +# then the terms of that licence shall supersede any condition above with + Li, Luo et al. "The CRI-CAM02UCS colour rendering index." COLOR research + Luo et al. "Uniform colour spaces based on CIECAM02 colour appearance + "[o]utput/save MIME part; save [a]ll parts; \n" +;; Jari Aalto +;; Alon Albert +;; Jari Aalto . + ("IRCnet: EU, AT, Linz" IRCnet "linz.irc.at" ((6666 6668))) + ["Januar" "Februar" "März" "April" "Mai" "Juni" "Juli" "August" +Both types of item should be moved en bloc to the new category, + return dum// -7- + struct Dum { + mutable a::b::Foo::Dum dumdum; + "Mot de Passe :" ; localized (Bug#29729) + (leapyear, ydhms_diff, guess_time_tm, __mktime_internal): Use it. + * config.bat: Build-in the first step towards X11 support with + * configure.ac (emacs_config_features): Don’t worry about GIR. + * configure.ac (WEBKIT, GIR, CAIRO): Use EMACS_CHECK_MODULES, not PKG_. + * configure.ac (emacs_config_features): Add XWIDGETS, WEBKIT, GIR. +1995-04-20 Kevin Rodgers +(seq-mapn #'concat '("moskito" "bite") ["bee" "sting"]) +Steven E. Harris (seh at panix.com), +Kevin Rodgers (kevin.rodgers at ihs.com), +plot,x,alog(x+5*sin(x) + 2), +be shown. On positions 3,4, and 7, the @samp{alog} function will be +As is my wont, I started hacking on it almost immediately. I first +The latter criterion is the "je ne sais quoi" of the artistic aspect of +order but are now listed consecutively en bloc. + "mot de passe" "Mot de passe") + Reported by Mor Zahavi . (Bug#51271) + * etc/refcards/fr-refcard.tex (section{Formater}): Remove mention + Reported by Ture Pålsson. + 9261a219ec * doc/emacs/windows.texi (Window Convenience): Describe mor... + 650a664ccd Let imenu to work on the menu bar when its list is a singl... + "\\(?:Currentl?y\\|Now\\) drawing from '\\(AC\\|Battery\\) Power'" + ;; Move done items en bloc to top of done items section. + * erc-complete.el: * added docfixes (thanks ore) + (interactive "DDelete directory from file cache: ") + some Agian scripts. */ + Rename from "Gnus Maintainance Guide". + * gnus-coding.texi (Gnus Maintainance Guide): Update to mention Emacs + * gnus-coding.texi (Gnus Maintainance Guide): Fix title typo. + * gnus-coding.texi (Gnus Maintainance Guide): Update conventions for +2005-10-23 Lars Hansen +1998-07-17 Gordon Matzigkeit +1998-04-26 James Troup +2003-06-11 Daniel Néri +2001-07-26 10:00:00 Steven E. Harris +2001-01-15 Jack Twilley + + matching LAMDA as a word. Noted by Stefan Monnier. + completion variant for every "LAMDA" name (bug#30513). + "foto" + ("foto" . 0.375) + Add configury for GMP library + Include w32inevt.h, basetyps.h and unknwn.h. + * make-docfile.c (write_c_args): Correctly handle prefixes of "defalt". + * hexl.c [DOSNT]: Include fcntl.h. + * make-docfile.c (write_c_args): Print an argument named "defalt" +2003-03-07 Kevin Rodgers (tiny change) +2003-03-06 Kevin Rodgers (tiny change) + "Speedwave", "Simili", "Synopsys Design Compiler", "Cadence NC", + with-parsed-tramp-file-name macro which is wont to produce such stuff. +2004-12-29 Sanghyuk Suh +2007-02-28 Lars Hansen +2006-11-24 Lars Hansen +2006-10-29 Lars Hansen +2006-09-12 Lars Hansen +2006-06-23 Lars Hansen +2006-05-14 Lars Hansen +2006-05-13 Lars Hansen +2006-02-09 Lars Hansen +2006-02-06 Lars Hansen +2005-11-22 Lars Hansen +2005-11-08 Lars Hansen +2005-11-03 Lars Hansen +2005-11-02 Lars Hansen +2005-10-08 Lars Hansen +2005-08-10 Lars Hansen +2005-07-12 Lars Hansen +2011-02-22 Seppo Sade (tiny change) +2012-09-21 Joel Bion (tiny change) + * rmail.el: Major changes from Bob Weiner + * rmailsum.el: Big rewrite from weiner@pts.mot.com. +1995-05-19 Kevin Rodgers (tiny change) +1994-08-29 Tom Tromey (tromey@creche.colorado.edu) +1994-07-11 Kevin Rodgers (tiny change) +1994-06-17 Kevin Rodgers (kevinr@ihs.com) (tiny change) +1995-12-13 Kevin Rodgers +1995-11-10 Kevin Rodgers +1995-06-30 Kevin Rodgers +1998-07-07 Kevin Rodgers (tiny change) +1998-06-03 Kevin Rodgers (tiny change) +1997-12-22 Kevin Rodgers (tiny change) +1997-11-02 Kevin Rodgers +1997-10-21 Brad Howes +1997-06-22 Howard Melman +1997-03-24 Kevin Rodgers +1996-11-04 Kevin Rodgers +1996-10-20 Kevin Rodgers +1996-09-12 Kevin Rodgers +1999-11-16 Reto Zimmermann +1999-06-12 Reto Zimmermann +1999-05-15 Reto Zimmermann +1998-08-26 Kevin Rodgers (tiny change) + directories. From Kevin Rodgers . + "du Radis" "de la Ruche" "du Gainier" + Iinclude string.h, stdlib.h unconditionally. +2006-04-23 Lars Hansen +2006-04-20 Lars Hansen +2005-11-10 Lars Hansen + explicitly sets the defalt value. + Unexpect wait_object in case of x errors (memory leak). + (receive_incremental_selection): Don't unexpect wait_object when done + append "CCL: Quitted" when the CCL program is quitted. + the loop. When quitted, show a proper error message. + (read_minibuf_noninteractive): If defalt is cons, set val to its car. + (read_minibuf): If defalt is cons, set histstring to its car. + (Fcompleting_read): If defalt is cons, set val to its car. + but it still has blocs in it, don't return it to the system, + any, in the DEFALT argument into the root of the Emacs build or + * fileio.c (Fexpand_file_name): Default DEFALT at beginning, +1992-03-03 Wilson H. Tien (wtien@urbana.mcd.mot.com) + * fileio.c (Fexpand_file_name): Pass DEFALT through + * ralloc.c (relocate_some_blocs): Handle BLOC == NIL_BLOC. + malloc heap, zero it out even if we don't have any blocs in the + (r_alloc_sbrk): Provide hysteresis in relocating the blocs. + (get_bloc): Return zero if we can't allocate the new bloc. + * ralloc.c (r_re_alloc): Instead of allocating a new bloc at the + original bloc, just expand the original block. This saves a copy + If string quotes don't match up, don't take value from OFROM; + Globally replaced INTERRUPTABLE with INTERRUPTIBLE. + * fileio.c (Fread_file_name): If defalt is nil and user tries to use +1995-03-23 Kevin Rodgers (tiny change) + * fileio.c (Fexpand_file_name): Look for a handler for defalt. +1994-09-21 Tom Tromey + (r_alloc_sbrk): Refuse to move blocs, if frozen. +1994-08-26 Kevin Rodgers + (Fcall_process_region) [DOSNT]: Canonicalize slashes in filename. + * minibuf.c (read_minibuf): Do use DEFALT in place of empty input + * minibuf.c (read_minibuf): Return DEFALT here, if minibuffer is empty. + (read_minibuf): Now static. New arg DEFALT. Callers changed. + CHAR_TABLE_ORDINARY_SLOTS for top, defalt, parent, and purpose. + is moved before `contents' so that XCHAT_TABLE (val)->defalt can + for an ASCII font, not defalt slot. + /* And if the configury during frame creation has been + Bob Desinger +/* Calculate the checksum of a SOM header record. */ + to preserve. Then we map these VAs to the section entries in the +#include + /* weiner@footloose.sps.mot.com reports that this causes + (VARN+1 SLOTN+1)) +dum@dots{} Nice tune, that@dots{} la la la@dots{} What, you're back? +C'est la vie. + ("gnus-warning" "duplicat\\(e\\|ion\\) of message" "duplicate") +James Troup, +@cindex @code{multline}, AMS-LaTeX environment +@code{align}, @code{gather}, @code{multline}, @code{flalign}, + \openin 1 #1.pdf \ifeof 1 + \openin 1 #1.PDF \ifeof 1 + \openin 1 #1.png \ifeof 1 + \openin 1 #1.jpg \ifeof 1 + \openin 1 #1.jpeg \ifeof 1 + \openin 1 #1.JPG \ifeof 1 + \def\adn#1{\addtokens{\toksC}{#1}\global\countA=1\let\next=\maketoks} + \openin 1 \jobname.\indexname s + % If the index file exists but is empty, then \openin leaves \ifeof +\setbox\balancedcolumns=\vbox{shouldnt see this}% + \openin 1 \tocreadfilename\space + \openin 1 \jobname.aux +\openin 1 = epsf.tex + \openin 1 txi-#1.tex + \openin 1 txi-#1.tex + @openin 1 texinfo.cnf + '("En" "To" "Tre")) +=project.clj=, =build.boot= or =deps.edn=, falling back on + ("(.H)J" (1 :otf=beng=half+)) +- (".H" :otf=beng=blwf,half,vatu+) ++ (".+H" :otf=beng=blwf,half,vatu+) + \quad \B{p}art: a)uthor (from), s)ubject, x)refs (cross-post), d)ate, l)ines, + message-i)d, t)references (parent), f)ollowup, b)ody, h)ead (all headers);\\* +\key{show subtree in indirect buffer, ded.\ frame}{C-c C-x b} +@tindex alog +mode setting. With the Inverse flag [@code{alog}], this command is +@r{ a b@: I B @: @: 2 @:alog@:(a,b) b^a} +@r{ a b@: I f I @: @: 2 @:alog@:(a,b) b^a} + Change comment about the iif hook to reflect the actual reason. + "I + E (ln), L (exp), B (alog: B^X); f E (lnp1), f L (expm1)" + (let (numer denom) + (setq numer (car (math-read-expr-list))) + (if (and (Math-num-integerp numer) + (list 'frac numer denom) + (list '/ numer denom)))) + (calc-binary-op "alog" 'calcFunc-alog arg) + (let ((dum (math-lud-pivot-check sum))) + (if (or (math-zerop big) (Math-lessp big dum)) + (setq big dum + (calc-pop-push-record-list 0 "larg" + (interactive "NNumber of columns = ") + (calc-binary-op "cros" 'calcFunc-cross arg))) + (calc-binary-op "unio" 'calcFunc-vunion arg '(vec) 'calcFunc-rdup))) + (calc-tabular-command 'calcFunc-table "Index" "tabl" + (ptd (file-truename pd))) + (string-match (concat "^" (regexp-quote ptd)) ftn))) + (let ((aci (autoconf-parameters-for-macro "AC_INIT")) + ((> (length aci) 1) + (setq name (nth 0 aci) + ver (nth 1 aci) + bugrep (nth 2 aci))) + (princ "\nKnown members of ") + (peom (save-excursion (c-end-of-macro) (point)))) + (when (> (point) peom) + (let ((larg (car args)) + (if (stringp larg) + (setq larg (semantic-tag-new-variable + larg nil nil))) + (srecode-semantic-tag (semantic-tag-name larg) + :prime larg) + (princ "\n--------------------------------------------\n\nNumber of tables: ") +;; avk@rtsg.mot.com (Andrew V. Klein) for a dired tip. + (args docstring interactive orig &optional befores arounds afters) +and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG + (dolist (advice befores) + (let* ((nam (buffer-substring (match-beginning 2) (match-end 2))) + (setq nmlst (cons nam nmlst) + "If we are in an rmail summary buffer, then chart out the froms." + (let* ((nam (buffer-substring (match-beginning 1) (match-end 1))) + (m (member nam nmlst))) + (message "Scanned username %s" nam) + (setq nmlst (cons nam nmlst) + ((memq word '(concat concating)) + (crypted (cl-loop with str = (make-string (* 2 (length orig-name)) 0) + for c-sym = (concat prefix crypted "_" human-readable "_" + (concat prefix crypted "_" human-readable "_0")))) + (let* ((acces (plist-get soptions :accessor)) + (when acces + (push `(cl-defmethod (setf ,acces) (value (this ,name)) + (push `(cl-defmethod ,acces ((this ,name)) + (push `(cl-defmethod ,acces ((this (subclass ,name))) +;; => "(\\(c\\(atch\\|ond\\(ition-case\\)?\\)\\|if\\|let\\*?\\|prog[12n]\\|save-\\(current-buffer\\|excursion\\|match-data\\|restriction\\|window-excursion\\)\\|throw\\|un\\(less\\|wind-protect\\)\\|wh\\(en\\|ile\\)\\)\\>" +G-C-g: Keyboard Quit |Ex Ext Cmd|Fill Regio| REPLACE | UND W | +;; lisp example from Jari Aalto +;; perl example from Jari Aalto +;; '(("\\<\\(uno\\|due\\|tre\\)\\>" . 'font-lock-keyword-face) + "define\\|e\\(?:l\\(?:if\\|se\\)\\|ndif\\|rror\\)\\|file\\|i\\(?:f\\(?:n?def\\)?\\|mport\\|nclude\\)\\|line\\|pragma\\|undef\\|warning" +2003-06-11 Daniel Néri + (lambda (valu symb) + (let ((anumber (string-to-number + (< anumber bnumber))))) + (curren . 164) + ;; Now we must merge the Dows with the Doms. To do that, we + (dows dow-list) + ;; second add all possible dows + (while (setq day (pop dows)) +;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit). + didnt nnmaildir--file nnmaildir-article-file-name + (setq didnt (cons (nnmaildir--art-num article) didnt))) + (setq didnt (cons (nnmaildir--art-num article) didnt)) + didnt))) + (insert "\nKnown Certificates:\n")))) +;; We could use `symbol-file' but this is a wee bit more efficient. + (beng . bengali) + (maka . makasar) + ,(font-spec :registry "iso10646-1" :otf '(beng nil (rphf)))) + (khmer ,(font-spec :registry "iso10646-1" :otf '(khmr nil (pres)))) + ("wee" . "Latin-2") ; MS Windows Lower Sorbian + ;; Unicode uses the spelling "lamda" in character + (string-match "\\" new-name)) + "WINDOWS-1258 (Viet Nam)" + "mot de passe" ; fr +Je/sli czytasz ten tekst, to albo przegl/adasz plik /xr/od/lowy +W drugim przypadku mo/zesz usun/a/c tekst z ekranu, stosuj/ac + przekodowuj/a zaznaczony fragment wzgl/ednie ca/ly buffor. + Poni/zsze przyk/lady powinny wyja/sni/c, jakich parametr/ow + Funkcje biblioteki odwo/luj/a si/e do pi/eciu zmiennych, kt/ore + ("capetown" "Cape Town, South Africa") + (progn (error msg "preced") 0))) + 2005-08-10. + (dolist (slot '(answers authorities additionals)) + queries answers authorities additionals) + (setq additionals (dns-read-bytes 2)) + (additionals ,additionals)) + [nil ; 1 ACI Item N + ("¤" . "(#)") +;; Author: Alon Albert + "Mark region appropriately. The next char REGION is d(efun),s(-exp),b(uffer), +l(ines)." + (t (message "Mark: d(efun),s(-exp),b(uf),p(arag),P(age),f(unct),w(ord),e(os),l(ines)") + "Verify spelling for the objects specified by char UNIT : [b(uffer), + (t (message "Spell check: b(uffer), r(egion), s(tring), w(ord)") +sWith: " ) +(defun org-babel-perl--var-to-perl (var &optional varn) + (if varn + (concat "my $" (symbol-name varn) "=" (when lvar "\n") + (if org-agenda-entry-text-mode " ETxt" "") + ("curren" "\\textcurrency{}" nil "¤" "curr." "¤" "¤") + (interactive "nNumber of clones to produce: ") +N is the number of WHATs to shift. +multlinewidth The width of the multline environment. + (list :tag "multlinewidth (width to use for the multline environment)" + "align" "gather" "multline" "flalign" "alignat" + ("ca" :default "Autor") + ("cs" :default "Autor") + ("de" :default "Autor") + ("es" :default "Autor") + ("et" :default "Autor") + ("pl" :default "Autor") + ("pt_BR" :default "Autor") + ("ro" :default "Autor") + ("sl" :default "Seznam tabel") + ("nl" :default "Zie tabel %s" + :html "Zie tabel %s" :latex "Zie tabel~%s") + ("et" :default "Tabel") + ("nl" :default "Tabel") + ("ro" :default "Tabel") + ("ro" :default "Tabele") + ("da" :default "Tabel %d") + ("et" :default "Tabel %d") + ("nl" :default "Tabel %d:" :html "Tabel %d:") + ("ro" :default "Tabel %d") + ("pl" :html "Spis treści") + (thier their (their)) + (whats up) (whats new) (what\'s up) (what\'s new) + refer refered referred refers + (c++-mode . "#\\(assert\\|cpu\\|define\\|endif\\|el\\(if\\|se\\)\\|i\\(dent\\|f\\(def\\|ndef\\)?\\|mport\\|nclude\\(_next\\)?\\)\\|line\\|machine\\|pragma\\|system\\|un\\(assert\\|def\\)\\|warning\\)\\>")) + "^\\(?:Error\\|Warnin\\(g\\)\\) \\(?:[FEW][0-9]+ \\)?\ +: \\(?:see declaration\\|\\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:\\)" + "^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)" + "^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:" + \\(?:warnin\\(g\\)\\|informationa\\(l\\)\\)?" 1 2 3 (4 . 5)) + "^ *\\([0-9]+\\)\\.[ \t]+.*\n +\\(<-*>\n\\*\\*\\* \\(?:Error\\|Warnin\\(g\\)\\)\\)" + "^\\(?:Error\\|Warnin\\(g\\)\\):.*\n.* line \\([0-9]+\\) char\ + ": \\(?:ERROR\\|WARNIN\\(G\\)\\|REMAR\\(K\\)\\) \\(?:[[:alnum:] ]+, \\)?\ + (" --?o\\(?:utfile\\|utput\\)?[= ]\\(\\S +\\)" . 1) + "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$" ;FRMAT + (insert "\n[U]nknown conditionals: ") + (struc info file tags-file &optional view where) +STRUC is an `ebrowse-bs' structure (or a structure including that) +FILE is not taken out of STRUC here because the filename in STRUC + (ebrowse-bs-name struc))) + (setf ebrowse-temp-position-to-view struc + (ebrowse-find-pattern struc info)))) + "cexp" "log" "alog" "dlog" "clog" "log10" + '("ASCII" "addto" "also" "and" "angle" "atleast" "batchmode" + "bre~ak" "bti~tle" "c~hange" "cl~ear" "col~umn" "conn~ect" + "repf~ooter" "reph~eader" "r~un" "sav~e" "sho~w" "shutdown" + "copyc~ommit" "copytypecheck" "def~ine" "describe" +That is, all code between \"// synopsys translate_off\" and +\"// synopsys translate_on\" is highlighted using a different background color +option to intermix between input/output/inouts. + :help "Help on AUTOINOUT - adding inouts from cells"] + (eval-when-compile (verilog-regexp-words '("Outputs" "Inouts" "Inputs" "Interfaces" "Interfaced")))) + '("surefire" "0in" "auto" "leda" "rtl_synthesis" "synopsys" + (structres nil) + (setq structres (verilog-in-struct-nested-p)) + (cond ((not structres) nil) + ;;((and structres (equal (char-after) ?\})) (throw 'nesting 'struct-close)) + ((> structres 0) (throw 'nesting 'nested-struct)) + ((= structres 0) (throw 'nesting 'block)) + (list 'block structres)) +// Created : + (search-forward "") (replace-match "" t t) +Return an array of [outputs inouts inputs wire reg assign const gparam intf]." + (when (looking-at "[^\n]*\\(auto\\|synopsys\\)\\s +enum\\s +\\([a-zA-Z0-9_]+\\)") +Return an array of [ outputs inouts inputs ] signals for modules that are + (while (re-search-forward "\\s *(?\\s *// Inouts" end-inst-point t) + (if (looking-at "[^\n]*\\(auto\\|synopsys\\)\\s +enum\\s +\\([a-zA-Z0-9_]+\\)") + "// Inouts" + Inouts are not supported, as assignments must be unidirectional. + (verilog-auto-inst-port-list "// Inouts\n" + This ONLY detects inouts of AUTOINSTants (see `verilog-read-sub-decls'). + // Beginning of automatic inouts + // Inouts +from only extracting inouts starting with i: + (verilog-insert-indent "// Beginning of automatic inouts (from unused autoinst inouts)\n") + // Beginning of automatic in/out/inouts + (verilog-insert-indent "// Beginning of automatic in/out/inouts (from specific module)\n") + // Beginning of automatic in/out/inouts (from modport) + (verilog-insert-indent "// Beginning of automatic in/out/inouts (from modport)\n") +finds all inputs and inouts in the module, and if that input is not otherwise +First, parameters are built into an enumeration using the synopsys enum + \"synopsys enum\" may be used in place of \"auto enum\". + default: state_ascii_r = \"%Erro\"; + `verilog-auto-inout' for AUTOINOUT making hierarchy inouts + `verilog-auto-unused' for AUTOUNUSED unused inputs/inouts + ;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared + ("GHDL" "ghdl" "-i --workdir=\\1 --ieee=synopsys -fexplicit " "make" "-f \\1" + ;; ERROR: test.vhd(14): Unknown identifier: positiv + ;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd + ;; Synopsys, VHDL Analyzer (sim): vhdlan -nc test.vhd + ("Synopsys" "vhdlan" "-nc -work \\1" "make" "-f \\1" + nil "mkdir \\1" "./" "work/" "Makefile" "synopsys" + ;; Synopsys, VHDL Analyzer (syn): vhdlan -nc -spc test.vhd + ("Synopsys Design Compiler" "vhdlan" "-nc -spc -work \\1" "make" "-f \\1" + ("Synopsys" "-vhdl87 \\2" "-f \\1 top_level" ((".*/datapath/.*" . "-optimize \\3") (".*_tb\\.vhd" . nil)))) +(defcustom vhdl-directive-keywords '("psl" "pragma" "synopsys") + (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)) + (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))) +;; Author: Alex Rezinsky +;; Thanks to Gord Wait for +;; Thanks to Paul Furnanz for XEmacs compatibility +;; Thanks to Kevin Rodgers for handling control characters +;; * Check `ps-paper-type': Sudhakar Frederick +;; Thanks to Kevin Rodgers for adding support for color and +;; Thanks to Avishai Yacobi, avishaiy@mcil.comm.mot.com, for writing the +;; Ralf Brown's Interrupt List. file INTERRUP.F, D-2138, Table 01400 + ("portugues" ; Portuguese mode + ("portugues" "pt_PT") +;; of the document. If WRAPP is true then wrap the search to the +(defun reftex-isearch-switch-to-next-file (crt-buf &optional wrapp) + (if wrapp +f / c Toggle follow mode / Toggle display of [c]ontext. + F t c Toggle: [F]ile borders, [t]able of contents, [c]ontext +\\`l' \\`i' \\`c' \\`F' Toggle display of [l]abels, [i]ndex, [c]ontext, [F]ile borders. + ;; OK, get the makro name + ("multline" ?e nil nil t) + "nbsp" "iexcl" "cent" "pound" "curren" "yen" "brvbar" "sect" +;; |ment\| +;; horizontale disigatan fenestron, si- horizontally split window similar to +;; ^jus anta^ue faris C-x C-f. file if you just did C-x C-f. +;; per C-x u kaj plue modifu la du continue to edit the two buffers. +;; Programistoj eble ^satus la eblecon Programmers might like the ability +;; iliajn finojn dum redaktado. won't see their end during editing. + "news:" "nfs://" "nntp://" "opaquelocktoken:" "pop://" "pres:" +;; Bob Weiner , + control whether we try to do keep-alives for our connections. + keep-alives to time out on cached documents with no known + ;; seconds for the keep-alives to time out on some servers. + msglen = ccl->quit_silently ? 0 : sprintf (msg, "\nCCL: Quitted."); + Quitted" to the generated text when + CCL program is quitted. */ + followings. */ + /* Followings are target of code detection. */ + /* Followings are NOT target of code detection. */ + /* The followings are extra attributes for each type. */ + Aadd, + case Aadd : accum += next; break; + case Aadd : mpz_add (mpz[0], *accum, *next); break; + case Aadd : overflow = INT_ADD_WRAPV (accum, next, &a); break; + return nargs == 1 ? a : arith_driver (Aadd, nargs, args, a); + /* The followings are used only for a font-entity and a font-object. */ + /* The followings are used only for a font-object. */ + /* We have already tried this element and the followings +/* According to RBIL (INTERRUP.A, V-1000), 160 is the maximum possible + hole between the first bloc and the end of malloc storage. */ + /* First bloc in this heap. */ + /* Last bloc in this heap. */ + struct heap *heap; /* Heap this bloc is in. */ +/* Find the bloc referenced by the address in PTR. Returns a pointer + callers that always expect a bloc to be returned should abort +/* Allocate a bloc of SIZE bytes and append it to the chain of blocs. + Returns a pointer to the new bloc, or zero if we couldn't allocate + /* Put this bloc on the doubly-linked list of blocs. */ +/* Calculate new locations of blocs in the list beginning with BLOC, +in the quitted window. + trough color and main window's background color. + means the truck and arrow colors, and "trough" means the + bg[ACTIVE] = "blue"@ @ @ @ # @r{Trough color.} +also for the trough of a scroll bar, i.e., @code{bg[ACTIVE] = "red"} +sets the scroll bar trough to red. Buttons that have been armed + (while (search-forward "nam" nil t) + (search-forward "som") + (search-forward "Nam") + (0 ":rando!~u@bivkhq8yav938.irc PRIVMSG tester :[09:17:51] u thur?") + (0.01 ":alice/foonet PRIVMSG #chan/foonet :bob: Sir, his wife some two months since fled from his house: her pretence is a pilgrimage to Saint Jaques le Grand; which holy undertaking with most austere sanctimony she accomplished; and, there residing, the tenderness of her nature became as a prey to her grief; in fine, made a groan of her last breath, and now she sings in heaven.") + "sav" + (if valu + (cons symb valu))) + (sample-text . "Er is een aantal manieren waarop je dit kan doen") +Tai Daeng (also known as Red Tai or Tai Rouge), + ;; Ith character and the followings matches precomposable + sprintf (css, "scrollbar trough { background-color: #%06x; }", + OFROM[I] is position of the earliest comment-starter seen + sprintf (css, "scrollbar trough { background-color: #%02x%02x%02x; }", + /* Note: "background" is the thumb color, and "trough" is the color behind + (uptodate t)) + (while (and files uptodate) + (setq uptodate nil))))) + uptodate))) + ptrdiff_t acount = 0; /* The # of consecutive times A won. */ + acount = 0; + ++acount; + if (acount >= min_gallop) + acount = k; + } while (acount >= GALLOP_WIN_MIN || bcount >= GALLOP_WIN_MIN); + ptrdiff_t acount = 0; /* The # of consecutive times A won. */ + ++acount; + if (acount >= min_gallop) + acount = 0; + acount = k; + } while (acount >= GALLOP_WIN_MIN || bcount >= GALLOP_WIN_MIN); + 154cd116be (origin/emacs-27) * admin/release-process: Adapt bug numbe... + a38da0d cc-mode.texi: Work around makeinfo alignment bug. Fix proble... + fd35804971 (origin/emacs-26) * doc/lispref/strings.texi (Case Convers... + be in line with the raison d'être of compiling printer which is speed. +mace +at that position, the result is @samp{fro!b}, with point between the +doesnt +minimize(xfit(gaus(a,b,c,d,x), x, [a,b,c], data)_5, d, guess) +where @code{gaus} represents the Gaussian model with background, +* Score Decays:: It can be useful to let scores wither away. +providers if they were to do this---their @emph{raison d'être} is to +While this design may be internally consistent with the raison d'être of +Finally, just to whet your appetite for what can be done with the +Wedler, Alan Williams, Roland Winkler, Hans-Christoph Wirth, Eli + "Some Place\nIn some City\nSome country.") +@c andrewm@@optimation.co.nz +Emacs Macht Alle Computer Schoen +GLib-GObject-WARNING **: /build/buildd/glib2.0-2.14.5/gobject/gsignal.c:1741: instance `0x8206790' has no handler with id `1234' at t-compilation-perl-gtk.pl line 3. + \quad \B{A}ction: I)ncrease, L)ower;\\* + (calc-unary-op "flor" 'calcFunc-ffloor arg) + (calc-unary-op "flor" 'calcFunc-floor arg))))) + ["de la Vertu" "du Génie" "du Travail" "de la Raison" "des Récompenses" + "de la Cuve" "de la Pomme de terre" "de l'Immortelle" + "de la Raison" "des Récompenses" "de la Révolution"] + (string-match "config\\(ure\\.\\(in\\|ac\\)\\|\\.status\\)?$" f) + ("\\.\\(dll\\|drv\\|386\\|vxd\\|fon\\|fnt\\|fot\\|ttf\\|grp\\)$" . t) + (insert (format "\nIn %s:\n" form))) + (format "\nIn macro %s:" (cadr form))) + (format "\nIn variable %s:" (cadr form))) + (insert "\nIn " package) + "\nIn order to use version `%s' of gnus, you will need to set\n" +znak/ow diakrytycznych. Funkcje te mo/zna pogrupowa/c nast/epuj/aco. + oraz ich warto/sci domy/slne s/a nast/epuj/ace: + (insert "\nIn " (emacs-version)) + "[n]ew messages; [']ticked messages; [s]earch;\n" + (?/ "Limit to [c]c, ran[g]e, fro[m], [s]ubject, [t]o; [w]iden") + (dictionary-send-command "show strat") +r(egion), s(tring), w(ord) ]." + "ncl" "nfd" "ngu" "nin" "nma" "nmu" "nod" "nop" "npp" "nsf" + (theyre they\'re (they are)) + (insert "\n[K]nown conditionals: ") + "[T]rue Face" "[F]alse Face" "[W]rite")) + "[ \t]*in\\(?:put\\|clude\\)[ \t]*{\\(.*%s\\)}"))) + (let ((siz (cond ((numberp size) + (and (< siz 0) + siz)) + "\tHow to report bugs and contribute improvements to Emacs\n" + "\tHow to obtain the latest version of Emacs\n" + (insert "\tHow to report bugs and contribute improvements to Emacs\n\n") + (insert "\tHow to get the latest version of GNU Emacs\n") + ("/mod\\(?:ules\\|probe\\)\\.conf" . "alias\\|in\\(?:clude\\|stall\\)\\|options\\|remove") + ("/dictionary\\.lst\\'" . "DICT\\|HYPH\\|THES") + ;; use-mark sizeA dateA sizeB dateB filename +;; nin, nil are placeholders. See ediff-make-new-meta-list-element in +;; Andrew McRae + * xmenu.c (apply_systemfont_to_menu): *childs was incorrectly used. +DEFUN ("catch", Fcatch, Scatch, 1, UNEVALLED, 0, + defsubr (&Scatch); +DEFUN ("elt", Felt, Selt, 2, 2, 0, + defsubr (&Selt); + (should (equal (string-truncate-left "longstring" 8) "...tring"))) + (0.06 ":joe!~u@6d9pasqcqwb2s.irc PRIVMSG #chan :mike: Lady, I will commend you to mine own heart.") + (perl "GLib-GObject-WARNING **: /build/buildd/glib2.0-2.14.5/gobject/gsignal.c:1741: instance `0x8206790' has no handler with id `1234' at t-compilation-perl-gtk.pl line 3." + (rxp "Error: Mismatched end tag: expected , got \nin unnamed entity at line 71 char 8 of file:///home/reto/test/group.xml" + (rxp "Warning: Start tag for undeclared element geroup\nin unnamed entity at line 4 char 8 of file:///home/reto/test/group.xml" + (string= (python-util-strip-string "\n str \nin \tg \n\r") "str \nin \tg")) + (insert "hel") + (format "\nIn function %s:" (cadr form))) + (t "\nIn top level expression:")))) + All suggested by Ned Ludd. +;; 2002-07-27 Added DELETESCRIPT. Suggested by Ned Ludd. +;; Ned Ludd. +To: Ned Freed +@strong{Te Deum} + If the termcap entry does not define the "ti" or "te" string, + and the "te" string is used to set it back on exit. + (te (solar-time-equation date ut))) + (setq ut (- ut te)) + (let ((te (semantic-tag-end aftertag))) + (when (not te) + (goto-char te) + ("te" . "Telugu") + ("\\.te?xt\\'" . text-mode) + ("\\.te?xi\\'" . texinfo-mode) + '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed 's/\r$//'") + ("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain") + (not (string-match "\\.te?xi\\'" name)) ;; not .texi + (?\ተ "te") + (?\ቴ "tE") + (?\ጠ "Te") + (?\ጤ "TE") + (?\∃ "TE") + (?\て "te") + (?\テ "Te") + ("te" "Telugu" utf-8) ; Telugu + "సంకేతపదము" ; te + * org-clock.el (org-clocktable-steps): Allow ts and te to be day + issue face m te ts dt ov) + te nil ts nil) + te (match-string 3) + te (float-time (org-time-string-to-time te)) + dt (- te ts)))) + (setq tlend (or te tlend) tlstart (or ts tlstart)) + ts te s h m remove) + (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) + (org-time-string-to-time te) + te (org-duration-from-minutes (+ (* 60 h) m))) + (te (float-time + (dt (- (if tend (min te tend) te) + (te (plist-get params :tend)) + te (nth 1 cc))) + (unless (or block (and ts te)) + (te (plist-get params :tend)) + te (nth 1 cc))) + (when (integerp te) (setq te (calendar-gregorian-from-absolute te))) + (when (and te (listp te)) + (setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te)))) + (if te (setq te (org-matcher-time te))) + (org-clock-sum ts te + ts te h m s neg) + te (match-string 3)) + (apply #'encode-time (org-parse-time-string te))) +;; Emulate more complete preprocessor support for tbl (.TS/.TE) +This applies to text between .TE and .TS directives. + ;; ((looking-at "[te]") (setq c nil)) ; reject t(roff) and e(ven page) + (set-marker to (woman-find-next-control-line "TE")) + tty->TS_end_termcap_modes = tgetstr ("te", address); + const char *TS_end_termcap_modes; /* "te" */ + (0 ":joe!~u@286u8jcpis84e.irc PRIVMSG #chan :[09:19:19] mike: Chi non te vede, non te pretia.") + (0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :joe: Chi non te vede, non te pretia.") + "un moyen, et te trompant ainsi sur la route =C3=A0 suivre les voil=C3=A0 bi=\n" + "ent=C3=B4t qui te d=C3=A9gradent, car si leur musique est vulgaire ils te f=\n" + "abriquent pour te la vendre une =C3=A2me vulgaire.")) + "un moyen, et te trompant ainsi sur la route à suivre les voilà bi" + "entôt qui te dégradent, car si leur musique est vulgaire ils te f" + "abriquent pour te la vendre une âme vulgaire.")) + (".TS" . ".TE") + (define-key vhdl-template-map "te" #'vhdl-template-terminal) + ("te" "telugu") + (format "%s.TE\n" +:NR:te=\\E[47l:ti=\\E[47h\ + ;; don't define :te=\\E[2J\\E[?47l\\E8:ti=\\E7\\E[?47h\ + nil nil nil nil "FA" "C." "dP" "TE" "~TE" "/0" +(defalias 'woman2-TE #'woman2-fi) +;;; Preliminary table support (.TS/.TE) + ;; ".TE -- End of table code for the tbl processor." + 8804ac857b * src/buffer.c (syms_of_buffer) : Doc fix. (Bu... + da00a6f317 Fix Xaw widget text disappearing when built with cairo (bu... +2020-11-10 Andrew G Cohen +2020-09-23 Andrew G Cohen +2020-09-11 Andrew G Cohen +2020-09-10 Andrew G Cohen +2020-09-09 Andrew G Cohen +2020-09-07 Andrew G Cohen +2020-09-05 Andrew G Cohen +2020-08-29 Andrew G Cohen +2020-08-27 Andrew G Cohen + 121be3e118 ; * etc/NEWS: Remove temporary note on documentation. (Bu... + 224e8d1464 Make call_process call signal_after_change. This fixes bu... + 891f7de8ed * test/lisp/simple-tests.el: Full path to Emacs binary (bu... + 8b7c776 * lisp/simple.el (kill-do-not-save-duplicates): Doc fix. (Bu... + beb4eac * doc/lispref/display.texi (Showing Images): Fix a typo. (Bu... + 60b5c10 Provide more details in doc-string of 'delete-windows-on' (Bu... + 57bcdc7 Don't call XGetGeometry for frames without outer X window (Bu... + f64c277 (origin/emacs-26) Let bookmark-jump override window-point (Bu... + 4bd43b0 Increase max-lisp-eval-depth adjustment while in debugger (bu... + 55c9bb9f3c Fix comint-get-old-input-default for output field case (Bu... + e244fed Clarify that nil doesn't match itself as a cl-case clause (Bu... + e21f018 * doc/lispref/functions.texi (Inline Functions): Fix typo (Bu... + c59ecb005e New customization variable for python-mode indentation (Bu... + a36a090 * lisp/progmodes/verilog-mode.el (verilog-mode): Fix typo (Bu... + 98ca7d5 Improve edit-kbd-macro prompting in case of remapped keys (Bu... + 804b37ca63 Save and restore text-pixel height and width of frames (Bu... + 9715317dfd * lisp/dired.el (dired-find-alternate-file): Doc fix. (Bu... + 234b1e3864 Flymake backends must check proc obsoleteness in source bu... + dc8812829b Remove resizable attribute on macOS undecorated frames (bu... + 43fac3beae Make "unsafe directory" error message more informative (Bu... +2017-04-25 Andrew G Cohen +2017-04-23 Andrew G Cohen + dbb3410 python.el: Fix detection of native completion in Python 3 (bu... + 4b2d77d * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Fix (bu... + d59bcbc Handle mouse leaving initial window in `mouse-set-region' (Bu... + 586b213 * lisp/url/url.el (url-retrieve-synchronously): Doc fix. (Bu... + f3653ec * configure.ac (HAVE_MODULES): Treat gnu like gnu-linux. (Bu... +2010-12-15 Andrew Cohen +2010-12-14 Andrew Cohen +2010-12-13 Andrew Cohen +;; Author: Joe Wells + (define-key calc-mode-map "bu" 'calc-unpack-bits) + (ruby-mode "*.r[bu]" "*.rake" "*.gemspec" "*.erb" "*.haml" +2002-03-31 Andrew Cohen (tiny change) +2013-05-04 Andrew Cohen +2013-04-25 Andrew Cohen +2013-04-24 Andrew Cohen +2013-04-14 Andrew Cohen +2013-04-10 Andrew Cohen +2013-04-04 Andrew Cohen +2013-04-01 Andrew Cohen +2013-03-31 Andrew Cohen +2013-03-30 Andrew Cohen +2013-03-29 Andrew Cohen +2013-03-27 Andrew Cohen +2013-03-26 Andrew Cohen +2012-07-22 Andrew Cohen +2011-09-12 Andrew Cohen +2011-09-05 Andrew Cohen +2011-09-01 Andrew Cohen +2011-08-11 Andrew Cohen +2011-08-05 Andrew Cohen +2011-08-04 Andrew Cohen +2011-08-03 Andrew Cohen +2011-08-02 Andrew Cohen +2011-07-24 Andrew Cohen +2011-07-23 Andrew Cohen +2011-07-20 Andrew Cohen +2011-07-14 Andrew Cohen +2011-07-02 Andrew Cohen +2011-07-01 Andrew Cohen +2011-06-30 Andrew Cohen +2011-06-21 Andrew Cohen +2011-02-22 Andrew Cohen +2010-12-17 Andrew Cohen +2010-12-16 Andrew Cohen +2010-12-10 Andrew Cohen +2010-12-08 Andrew Cohen +2010-12-07 Andrew Cohen +2010-12-06 Andrew Cohen +2010-12-05 Andrew Cohen +2010-12-04 Andrew Cohen +2010-12-03 Andrew Cohen +2010-12-02 Andrew Cohen +2010-12-01 Andrew Cohen +2010-11-29 Andrew Cohen +2010-11-28 Andrew Cohen +2010-11-27 Andrew Cohen +2010-11-23 Andrew Cohen +2010-11-21 Andrew Cohen +2010-11-17 Andrew Cohen +2010-11-11 Andrew Cohen +2010-11-06 Andrew Cohen +2010-11-04 Andrew Cohen +2010-11-03 Andrew Cohen +2010-11-01 Andrew Cohen +2010-10-31 Andrew Cohen +2010-10-30 Andrew Cohen +2010-10-22 Andrew Cohen +2010-10-18 Andrew Cohen +2010-10-16 Andrew Cohen +2010-10-15 Andrew Cohen +2010-10-14 Andrew Cohen +2010-10-10 Andrew Cohen +2010-09-25 Andrew Cohen (tiny change) +2010-09-23 Andrew Cohen +2004-02-26 Andrew Cohen + . + syntax table here. Reported by Andrew Cohen . + ;; Fix by Mike Dugan . +;; Author: Andrew Cohen + (?\ቡ "bu") + (?\ぶ "bu") + (?\ブ "Bu") +;; Author: Joe Wells +;; Tue Mar 23 21:23:18 1993 Joe Wells (jbw at csd.bu.edu) +;; Mon Mar 22 21:20:56 1993 Joe Wells (jbw at bigbird.bu.edu) +;; Mon Mar 22 20:16:57 1993 Joe Wells (jbw at bigbird.bu.edu) +;; Mon Mar 22 00:46:12 1993 Joe Wells (jbw at bigbird.bu.edu) +;; Sun Mar 21 21:41:06 1993 Joe Wells (jbw at bigbird.bu.edu) +;; Sun Mar 21 14:39:38 1993 Joe Wells (jbw at bigbird.bu.edu) +;; Mon Feb 1 22:23:31 1993 Joe Wells (jbw at bigbird.bu.edu) +;; Mon Apr 6 23:59:09 1992 Joe Wells (jbw at bigbird.bu.edu) +;; Sun Apr 5 19:39:08 1992 Joe Wells (jbw at bigbird.bu.edu) +;; Sun Feb 2 14:45:24 1992 Joe Wells (jbw at bigbird.bu.edu) + " --------Unsent Message below:" ; from sendmail at BU +;; Mostly rewritten by Andrew Cohen from 2010 + ((string= "*" bullet) "\\(bu") + (gud-def gud-finish "bu\\t" "\C-f" "Finish executing current function.") + ("bu" "*" "\267" . t) ; bullet + '("+l" "#s" "#bu"))) + da6234e2df Make sure pixel sizes are zero when setting window size fo... + d38fd9229c0 Narrow scope of modification hook renabling in org-src fo... +is the last word in the buffer that starts with @samp{fo}. A numeric +after the first @samp{FO}; the @samp{F} in that @samp{FO} might not be +expression @samp{fo}, which matches only the string @samp{fo}. To do +expression. Thus, @samp{fo*} has a repeating @samp{o}, not a repeating +@samp{fo}. It matches @samp{f}, @samp{fo}, @samp{foo}, and so on. +$ ls -li fo* +(file-name-all-completions "fo" "") + nil t "fo") +Complete a foo: fo@point{} +and @samp{o} to get the regular expression @samp{fo}, which matches only +the string @samp{fo}. Still trivial. To do something more powerful, you +fo +@samp{fo#.el} matches @file{f.el}, @file{fo.el}, @file{foo.el}, etc. +@samp{fo#.el} matches @file{fo.el}, @file{foo.el}, @file{fooo.el}, + + + \futurelet\next\fo@t +M-f Fo Alias (keep?) +% | fo | + fo ;; List of final overloaded functions + (if (get s 'constant-flag) fo ov)) + (when fo + (mapc #'mode-local-print-binding fo)) + :eval (string-match-p "^[fo]+" "foobar")) + :eval (and (string-match "^\\([fo]+\\)b" "foobar") + ("fo" . "Faroese") + (?\ፎ "fo") + ("fo" . "Latin-1") ; Faroese + ("fo" "Faroe Islands") + M-f -> Fo Alias (keep?) + ;; quotes (for example), we end up completing "fo" to "foobar and throwing + ;; completing "fo" to "foO" when completing against "FOO" (bug#4219). + + + + (format " fo:min-width=\"%0.2fcm\"" (or width .2)))) + (concat (format " fo:min-height=\"%0.2fcm\"" (or height .2)) + + ;; Are we coalescing two tokens together, e.g. "fo o" + ;; user from completing "fo" to "foo/" when she +;; | | | fo | | fo | | | +page-height == bm + print-height + tm - fo - fh + ("fo+bar" nil "2nd") + ("fo*bar" nil "3rd"))) + (should (equal (ert--abbreviate-string "foo" 2 nil) "fo")) + (should (equal (string-limit "foo" 2) "fo")) + (should (equal (string-limit "foó" 10 nil 'utf-8) "fo\303\263")) + (should (equal (string-limit "foó" 3 nil 'utf-8) "fo")) + (should (equal (string-limit "foó" 4 nil 'utf-8) "fo\303\263")) + (should (equal (string-limit "foóa" 4 nil 'utf-8) "fo\303\263")) + (should (equal (string-limit "foóá" 4 nil 'utf-8) "fo\303\263")) + (should (equal (string-limit "foóa" 4 nil 'iso-8859-1) "fo\363a")) + (should (equal (string-limit "foóá" 4 nil 'iso-8859-1) "fo\363\341")) + (should (equal (string-limit "foó" 10 t 'utf-8) "fo\303\263")) + (should (equal (string-limit "foó" 4 t 'utf-8) "fo\303\263")) + (should (equal (string-limit "foóa" 4 t 'iso-8859-1) "fo\363a")) + (should (equal (string-limit "foóá" 4 t 'iso-8859-1) "fo\363\341")) + " fo")) + (("foo" 2 nil nil "...") . "fo") ;; XEmacs failure? + (non-directories '("/abso-folder/fo" "rela-folder/fo" + "/testdir/Mail/rela-folder/fo" + (format "+%s/fo" mh-test-rel-folder) nil 'lambda))))) + (format "+%s/fo" mh-test-abs-folder) nil 'lambda))))) + (should (equal (file-name-completion "fo" tmp-name) "foo.")) + (sort (file-name-all-completions "fo" tmp-name) #'string-lessp) + (should (equal (file-name-completion "fo" tmp-name) "foo")) + (equal (file-name-all-completions "fo" tmp-name) '("foo"))) + (should (equal (file-name-completion "fo" tmp-name) "foo")) + (should (equal (string-replace "fo" "bar" "lafofofozot") + (should (= (replace-regexp-in-region "fo+" "new" (point-min) (point-max)) + (should (= (replace-regexp-in-region "fo+" "new" (point-min) 14) + (should-error (replace-regexp-in-region "fo+" "new" (point-min) 30))) + (should (= (replace-regexp-in-region "Fo+" "new" (point-min)) + (should-not (yank-media--utf-16-p "fo")) + (should (equal (fns-tests--with-region base64-encode-region "fo") "Zm8=")) + (should (equal (base64-encode-string "fo") "Zm8=")) + (should (equal (fns-tests--with-region base64url-encode-region "fo") "Zm8=")) + (should (equal (fns-tests--with-region base64url-encode-region "fo" t) "Zm8")) + (should (equal (fns-tests--with-region base64url-encode-region (fns-tests--string-repeat "fo" 50) t) + (should (equal (base64url-encode-string "fo") "Zm8=")) + (should (equal (base64url-encode-string "fo" t) "Zm8")) + (should (equal (base64url-encode-string (fns-tests--string-repeat "fo" 50) t) (concat (fns-tests--string-repeat "Zm9mb2Zv" 16) "Zm9mbw"))) + (should (equal (base64-decode-string "Zm8=") "fo")) + (should (equal (base64-decode-string "Zm8" t) "fo")) + (should (equal (base64-decode-string "Zm8=" t) "fo")) + (fns-tests--string-repeat "fo" 50))) +@samp{o} (oblique), @samp{ri} (reverse italic), or @samp{ot} (other). +@deffn Method project-update-version :AFTER ot +The @code{:version} of the project @var{OT} has been updated. +@deffn Method project-remove-file :AFTER ot fnnd +Remove the current buffer from project target @var{OT}. +@deffn Method project-delete-target :AFTER ot +Delete the current target @var{OT} from its parent project. +@deffn Method project-edit-file-target :AFTER ot +Edit the target @var{OT} associated with this file. +@deffn Method project-add-file :AFTER ot file +Add the current buffer into project target @var{OT}. +- (font (nil phetsarath\ ot unicode-bmp))) + "Remove the current buffer from project target OT. +(cl-defmethod project-update-version ((ot ede-project)) + "The :version of the project OT has been updated. + (error "project-update-version not supported by %s" (eieio-object-name ot))) + ;; no so ea we ne se nw sw up do in ot + ;; no so ea we ne se nw sw up do in ot + (define-key vhdl-template-map "ot" #'vhdl-template-others) + { 200, { "italic" ,"i", "ot" }}, +(cl-defmethod oclosure-interactive-form ((ot oclosure-test)) + (let ((snd (oclosure-test--snd ot))) + (math-simplify-divisor): Only bind math-simplify-divisor-[nd]over + @result{} Nd + "s section[eg- emacs / p4-blame]:\nD source-dir: \nD output-dir: ") +(define-key ctl-x-map "nd" 'narrow-to-defun) + (aref ["th" "st" "nd" "rd"] (% n 10)))) + (let* ((nd date) + (setq nd (list (car date) (1+ (cadr date)) + (setq nd (list (car date) (1- (cadr date)) + (setq nd (calendar-gregorian-from-absolute ; date standardization + (calendar-absolute-from-gregorian nd))) + (list nd ut))) + (interactive "*P\nd") + (interactive "^p\nd") + (interactive "^p\nd\nd") + (if (string= "" nd) + (concat "\\`" (regexp-quote nd))) + (nd (file-name-nondirectory auto-save-list-file-prefix))) + ((= digit 2) "nd") + \"s section[eg- emacs / p4-blame]:\\nD source-dir: \\nD output-dir: \") + (interactive "D source directory: \nD output directory: ") +(defun mailcap-parse-mailcap-extras (st nd) + (narrow-to-region st nd) + ("New York" . "ny") ("North Carolina" . "nc") ("North Dakota" . "nd") + '(Lu Ll Lt Lm Lo Mn Mc Me Nd Nl No Pc Pd +(xsdre-def-derived-category 'N '(union Nd Nl No)) + "cm=^p=%+ %+ :cr=^p^a:le=^p^b:nd=^p^f:" +p(aragraph), P(age), f(unction in C/Pascal etc.), w(ord), e(nd of sentence), +;; - an ordinal suffix (st, nd, rd, th) for the year + - an ordinal suffix (st, nd, rd, th) for the year + '(", *\\(e\\(nd\\|rr\\)\\)\\> *\\(= *\\([0-9]+\\)\\)?" + "\\<\\(&&\\|and\\|b\\(egin\\|reak\\)\\|c\\(ase\\|o\\(mpile_opt\\|ntinue\\)\\)\\|do\\|e\\(lse\\|nd\\(case\\|else\\|for\\|if\\|rep\\|switch\\|while\\)?\\|q\\)\\|for\\(ward_function\\)?\\|g\\(oto\\|[et]\\)\\|i\\(f\\|nherits\\)\\|l[et]\\|mod\\|n\\(e\\|ot\\)\\|o\\(n_\\(error\\|ioerror\\)\\|[fr]\\)\\|re\\(peat\\|turn\\)\\|switch\\|then\\|until\\|while\\|xor\\|||\\)\\>") + "and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\)\\|for\\|i[fn]\\|" + (interactive "P\nd") + (interactive "*p\nd") + Right (tty) = tgetstr ("nd", address); + "c\nd\n"))) + (insert "a\nb\nc\nd\ne\nf") + (insert "a\nb\nc\nd\ne") + (interactive "i\nd\nP") + * lisp/term.el (term-termcap-format): Fix a typo in the "ue=" +Urban Engberg (ue at cci.dk), + * quail/latin-post.el ("german-postfix"): Do not translate ue to + (define-key calc-mode-map "ue" 'calc-explain-units) + le ue pe) + (bindat--make :ue ,(bindat--toplevel 'unpack type) + Trivial patch from Urban Engberg . + ("ü" "ue") + ("Ü" "Ue") +;; AE -> Ä OE -> Ö UE -> Ü +;; ae -> ä oe -> ö ue -> ü ss -> ß +;; AEE -> AE OEE -> OE UEE -> UE +;; aee -> ae oee -> oe uee -> ue sss -> ss" +;; ("UE" ?Ü) +;; ("ue" ?ü) +;; ("UEE" "UE") +;; ("uee" "ue") + ("Uuml" "\\\"{U}" nil "Ü" "Ue" "Ü" "Ü") + ("uuml" "\\\"{u}" nil "ü" "ue" "ü" "ü") +:so=\\E[7m:se=\\E[m:us=\\E[4m:ue=\\E[m:md=\\E[1m:mr=\\E[7m:me=\\E[m\ + (("\"U" "\\\"U") . "Ue") ; "U,\"U -> Ue + (("\"u" "\\\"u") . "ue") ; "u,\"u -> ue +/^#undef INTERNAL_TERMINAL *$/s,^.*$,#define INTERNAL_TERMINAL "pc|bios|IBM PC with color display::co#80:li#25:Co#16:pa#256:km:ms:cm=:cl=:ce=::se=:so=:us=
    :ue=
:md=:mh=:mb=:mr=:me=::AB=:AF=:op=:", + * s/msdos.h (INTERNAL_TERMINAL): Add capabilities se, so, us, ue, + tty->TS_exit_underline_mode = tgetstr ("ue", address); +:bl=^G:do=^J:le=^H:ta=^I:se=\\E[27m:ue=\\E[24m\ + const char *TS_enter_underline_mode; /* "ue" -- end underlining. */ + ((equal (aref (car lines) 0) "fpr") + (let* ((fpr (epg-sub-key-fingerprint subkey)) + (candidates (epg-list-keys context fpr 'secret)) + (error "Found %d secret keys with same fingerprint %s" candno fpr)) + (fpr (epg-sub-key-fingerprint primary))) + (string-match-p (concat fingerprint "$") fpr) + (dolist (fpr signer-fprs nil) + fpr + (substring fpr -16 nil))) + (let ((fpr (if (eq protocol 'OpenPGP) + (should (string-match-p (concat "-r " fpr) match)))) + time. The reverse is true in Ireland, where standard time "IST" +(e.g., especially with l(ist) and k(ill)). +;; + ;; . + ("ist" "İstanbul, Turkey") + consistency (e.g., esp. with l(ist) and k(ill). + (?F "[l]ist; [v]isit folder;\n" + "[s]equences, [l]ist,\n" + "exec~ute" "exit" "get" "help" "ho~st" "[$]" "i~nput" "l~ist" + (calendar-standard-time-zone-name "IST") + "1972-07-01 05:29:59.999 +0530 (IST)")) + (let ((thi (if (math-lessp hi '(float -2 0)) + (math-float lo) (math-float thi) 'inf) + lo thi))) +Joakim Hove wrote @file{html2text.el}, a html to plain text converter. +Hove, Denis Howe, Lars Ingebrigtsen, Andrew Innes, Seiichiro Inoue, + * html2text.el: New file from Joakim Hove . +;; Author: Joakim Hove +Damon Anton Permezel wrote @file{hanoi.el}, an animated demonstration of +Jeff Peck, Damon Anton Permezel, Tom Perrine, William M. Perry, Per +;; Author: Damon Anton Permezel +; Author (a) 1985, Damon Anton Permezel +;; JAVE I preferred ecmascript-mode. +;;JAVE break needs labels +;JAVE this just instantiates a default empty ebrowse struct? +JAVE: stub for needs-refresh, because, how do we know if BROWSE files +;JAVE what it actually seems to do is split the original tree in "tables" associated with files + ;(semantic-fetch-tags) ;JAVE could this go here? +JAVE this thing would need to be recursive to handle java and csharp" +; (re-search-forward (concat "/\\*" indicator "\\*/")); JAVE this isn't generic enough for different languages + clen cidx) + (setq clen (length lao-consonant)) + str (if (= clen 1) + * bidi.c (bidi_level_of_next_char): clen should be EMACS_NT, not int. + if (ident_length == 6 && memcmp (ident_start, "defalt", 6) == 0) + if (! NILP (XCHAR_TABLE (table)->defalt)) + Fcopy_sequence (XCHAR_TABLE (table)->defalt)); +make_sub_char_table (int depth, int min_char, Lisp_Object defalt) + XSUB_CHAR_TABLE (table)->contents[i] = defalt; + set_char_table_defalt (copy, XCHAR_TABLE (table)->defalt); + val = tbl->defalt; + Lisp_Object defalt, bool is_uniprop, bool is_subtable) + defalt, is_uniprop); + val = defalt; + Lisp_Object defalt, bool is_uniprop) + defalt, is_uniprop, true); + defalt, is_uniprop, true); + tbl->defalt, is_uniprop, false); + tbl->defalt, is_uniprop, false); + val = XCHAR_TABLE (char_table)->defalt; + this = XCHAR_TABLE (top)->defalt; + ? (dp)->defalt \ +decode_env_path (const char *evarname, const char *defalt, bool empty) + path = ns_relocate (defalt); + path = defalt; + (name, defalt) + if (NILP (defalt)) + CHECK_STRING (defalt); + if (CHAR_TABLE_P (vector) && ! NILP (XCHAR_TABLE (vector)->defalt)) + (*elt_describer) (XCHAR_TABLE (vector)->defalt, args); + The size counts the defalt, parent, purpose, ascii, + Lisp_Object defalt; + val = tbl->defalt; + counts the ordinary slots and the top, defalt, parent, and purpose +verify (offsetof (struct Lisp_Char_Table, defalt) == header_size); + XCHAR_TABLE (table)->defalt = val; + string, and DEFALT is a string, read from DEFALT instead of VAL. */ +string_to_object (Lisp_Object val, Lisp_Object defalt) + if (STRINGP (defalt)) + else if (CONSP (defalt) && STRINGP (XCAR (defalt))) + Lisp_Object defalt) + val = string_to_object (val, CONSP (defalt) ? XCAR (defalt) : defalt); + DEFALT specifies the default value for the sake of history commands. + Lisp_Object histvar, Lisp_Object histpos, Lisp_Object defalt, + specbind (Qminibuffer_default, defalt); + val = read_minibuf_noninteractive (prompt, expflag, defalt); + else if (STRINGP (defalt)) + else if (CONSP (defalt) && STRINGP (XCAR (defalt))) + val = string_to_object (val, defalt); + Lisp_Object defalt = Fassq (prop, Vtext_property_default_nonsticky); + if (ignore_previous_character || (CONSP (defalt) && !NILP (XCDR (defalt)))) + val = dp->defalt; + Lisp_Object name, defalt; + defalt = current_buffer->directory; + newdir = SDATA (defalt); + val = defalt; + val = XCAR (defalt); + histstring = defalt; + histstring = XCAR (defalt); + EIEIO: Promote the CLOS behavior over the EIEIO-specific behavior + Change the implementation of `:initform` to better match the CLOS semantics, + (CLOS compatibility, Wish List): Adjust to new featureset. +@cindex CLOS +(@acronym{CLOS}), this support is based on @dfn{generic functions}. +The Emacs generic functions closely follow @acronym{CLOS}, including +use of similar names, so if you have experience with @acronym{CLOS}, + * eieio.texi (Accessing Slots, CLOS compatibility): Adjust wording + (Method Invocation, CLOS compatibility): + * eieio.texi (Class Values, CLOS compatibility): + EIEIO and CLOS from 'Building Classes' to here. + (Class Values, CLOS compatibility): Mention that + * eieio.texi (top): Make clear that EIEIO is not a full CLOS +to Emacs Lisp programmers. CLOS and Common Lisp streams are fine +a subset of CLOS functionality. @xref{Top, , Introduction, eieio, EIEIO}.) +The Common Lisp Object System (CLOS) is not implemented, +CLOS functionality. +bugs in @ede{}. A knowledge of Emacs Lisp, and some @eieio{}(CLOS) is +@ede{} uses @eieio{}, the CLOS package for Emacs, to define two object +concepts of the Common Lisp Object System (CLOS). It provides a +* CLOS compatibility:: What are the differences? +Lisp Object System (CLOS) and also differs from it in several aspects, +on the other hand you are already familiar with CLOS, you should be +aware that @eieio{} does not implement the full CLOS specification and +@pxref{CLOS compatibility}). +and methods using inheritance similar to CLOS. +Method definitions similar to CLOS. +Public and private classifications for slots (extensions to CLOS) +Customization support in a class (extension to CLOS) +Due to restrictions in the Emacs Lisp language, CLOS cannot be +setf. Here are some important CLOS features that @eieio{} presently +This CLOS method tag is non-functional. +will use the list as a value. This is incompatible with CLOS (which would +This option is in the CLOS spec, but is not fully compliant in @eieio{}. +This option is specific to Emacs, and is not in the CLOS spec. +what CLOS does when a monotonic class structure is defined. +Unsupported CLOS option. Enables the use of a different base class other +Unsupported CLOS option. Specifies a list of initargs to be used when +@xref{CLOS compatibility}, for more details on CLOS tags versus +The following accessors are defined by CLOS to reference or modify +This is not a CLOS function. It is therefore +of CLOS. +objects. In CLOS, this would be named @code{STANDARD-CLASS}, and that +This function takes arguments in a different order than in CLOS. +In @var{clos}, the argument list is (@var{class} @var{object} @var{slot-name}), but +@node CLOS compatibility +@chapter CLOS compatibility +CLOS. +CLOS supports the @code{describe} command, but @eieio{} provides +@eieio{} is an incomplete implementation of CLOS@. Finding ways to +improve the compatibility would help make CLOS style programs run +@c LocalWords: cb cdr charquote checkcache cindex CLOS +System (CLOS). It is used by the other CEDET packages. +CLOS class and slot documentation. + "Convert a list of CLOS class slot PARTLIST to `variable' tags." +C++ and CLOS can define methods that are not in the body of a class +Some languages such as C++ and CLOS permit the declaration of member +the class. C++ and CLOS both permit methods of a class to be defined +;; Standard CLOS name. +This may prevent classes from CLOS applications from being used with EIEIO +since EIEIO does not support all CLOS tags.") + ;; not by CLOS and is mildly inconsistent with the :initform thingy, so + ;; (but not CLOS) but is a bad idea (for one: it's slower). + "Abstractly modify a CLOS object." + "Instance of a CLOS class." +;; CLOS, the Common Lisp Object System. In addition, EIEIO also adds +The following are extensions on CLOS: +Options in CLOS not supported in EIEIO: + ;; test, so we can let typep have the CLOS documented behavior +;;; Handy CLOS macros +;; CLOS name, maybe? +The CLOS function `class-direct-superclasses' is aliased to this function." +The CLOS function `class-direct-subclasses' is aliased to this function." +;; Official CLOS functions. +;;; CLOS queries into classes and slots +;; FIXME: CLOS uses "&rest INITARGS" instead. +In CLOS, the argument list is (CLASS OBJECT SLOT-NAME), but +;;; Unimplemented functions from CLOS + ;; CLOS and EIEIO + ;; this works for SOS, STklos, SCOOPS, Meroon and Tiny CLOS. + ;; EIEIO's :initform is not 100% compatible with CLOS in +;; Also test behavior of `call-next-method'. From clos.org: + ;; CLOS form of make-instance + (interactive "p\nd\nd") + (interactive "p\nd") + (let (st nd pt) + (setq nd (match-beginning 0) + pt nd) + (setq nd (match-beginning 0) + (setq nd (match-beginning 0)))) + (setq nd (match-beginning 0))) + (or st nd)))) + (narrow-to-region (or st (point-min)) (or nd (point-max))) + (when nd + (goto-char nd) + (fortran-blink-match "e\\(nd[ \t]*if\\|lse\\([ \t]*if\\)?\\)\\b" + ;; FIXME: `foo a!nd bar' should transpose into `bar and foo'. + (make-directory nd t) + (speedbar-goto-this-file nd) + (let ((nd (file-name-nondirectory file))) + (concat "] \\(" (regexp-quote nd) +:nd=\\E[C:up=\\E[A:ce=\\E[K:ho=\\E[H:pt\ +(defun url-http-content-length-after-change-function (_st nd _length) + (funcall byte-count-to-string-function (- nd url-http-end-of-headers)) + (url-percentage (- nd url-http-end-of-headers) + (funcall byte-count-to-string-function (- nd url-http-end-of-headers)) + (url-percentage (- nd url-http-end-of-headers) + (if (> (- nd url-http-end-of-headers) url-http-content-length) +(defun url-http-chunked-encoding-after-change-function (st nd length) + url-http-chunked-counter st nd length) + (if (> nd (+ url-http-chunked-start url-http-chunked-length)) + nd)) +(defun url-http-wait-for-headers-change-function (_st nd _length) + (setq nd (- nd (url-http-clean-headers))))) + (when (> nd url-http-end-of-headers) + (marker-position url-http-end-of-headers) nd + (- nd url-http-end-of-headers)))) + ((> nd url-http-end-of-headers) + nd + (- nd url-http-end-of-headers))) + Lu, Ll, Lt, Lm, Lo, Mn, Mc, Me, Nd, Nl, No, Pc, Pd, Ps, Pe, Pi, Pf, Po, + const char *cm_right; /* right (nd) */ + (should (equal (ert-test-result-messages result) "a\nb\nc\nd\n"))))) + (insert "a\nb\nc\nd\n") + (insert "a\nb\nc\nd\n") + (insert "a\nb\nc\nd\n") + (insert "a\nb\nc\nd\n") + (insert "a\nb\nc\nd\n") + (should (string= (buffer-string) "Abc\nd efg\n(h ijk).")))) + (nd (read-directory-name "Create directory: " +DESCRIPTION:In this meeting\\, we will cover topics from product and enginee +@item @samp{.crate} --- +@cindex @file{crate} file archive suffix +@cindex file archive suffix @file{crate} +;; * ".crate" - Cargo (Rust) packages + "crate" ;; Cargo (Rust) packages. Not in libarchive testsuite. + ;; RFC5546 refers to uninvited attendees as "party crashers". +That includes both spelling (e.g., "behavior", not "behaviour") and + * doc/lispref/control.texi (Signalling Errors) + * doc/lispref/control.texi (Signalling Errors) +Re "behavior" vs "behaviour", etc. ++ [[https://protesilaos.com/codelog/2020-07-08-modus-themes-nuanced-colours/][Modus themes: major review of "nuanced" colours]] (2020-07-08) ++ [[https://protesilaos.com/codelog/2020-09-14-modus-themes-review-blues/][Modus themes: review of blue colours]] (2020-09-14) ++ [[https://protesilaos.com/codelog/2021-01-11-modus-themes-review-select-faint-colours/][Modus themes: review of select "faint" colours]] (2021-01-11) ++ [[https://protesilaos.com/codelog/2022-01-02-review-modus-themes-org-habit-colours/][Modus themes: review of the org-habit graph colours]] (2022-01-02) ++ [[https://protesilaos.com/codelog/2022-04-20-modus-themes-case-study-avy/][Modus themes: case study on Avy faces and colour combinations]] (2022-04-20) ++ [[https://protesilaos.com/codelog/2022-04-21-modus-themes-colour-theory/][Emacs: colour theory and techniques used in the Modus themes]] (2022-04-21) + * :- initialise + * :- finalise + "initialise", "finalise", "mutable", "module", "interface", "implementation", +;;; ( A cancelled ) Ignore this cache entry; + (.DEFAULT): Use $(FLAVOUR) instead of $@ for clarity. +1998-04-26 Justin Sheehy +1997-10-25 David S. Goldberg +;; Updated by the RIPE Network Coordination Centre. +;; Thanks to jond@mitre.org (Jonathan Doughty) for help with code for + (when (and ok tod (not (string-match "\\`DONE\\|CANCELLED" evt))) +"all" "analyse" "analyze" "and" "array" "asc" "as" "asymmetric" + \"VHDL Modelling Guidelines\". + {WSAECANCELLED , "Operation cancelled"}, /* not sure */ + {WSA_E_CANCELLED , "Operation already cancelled"}, /* really not sure */ + 2013-09-26 dup2, dup3: work around another cygwin crasher + cc3ad9a ; * CONTRIBUTE: Clarify rules for committing to release branc... +Paul Raines (raines at slack.stanford.edu), + \qquad date: b)efore, a)t, n)this,\\* +place an (I)nstall flag on the available version and a (D)elete flag + Improved verbiage of prompt. Aliases are now inserted "[b]efore" + or "[a]fter" the existing alias instead of "[i]nsert" or + "[b]efore or [a]fter: ") + (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? ")) + (mark_image): Move from allo.c. +Forward propagate immediate involed in assignments." ; FIXME: Typo. Involved or invoked? + (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) + (org-time-string-to-time te) + (te (org-time-string-to-seconds se)) + (dt (- (if tend (min te tend) te) + te (match-string 3)) + (setq s (- (org-time-string-to-seconds te) + ("te" :babel-ini-only "telugu" :polyglossia "telugu" :lang-name "Telugu") +2016-09-10 Toke Høiland-Jørgensen (tiny change) + Reported by Toke Høiland-Jørgensen . +2012-07-17 Toke Høiland-Jørgensen (tiny change) +2012-06-17 Toke Høiland-Jørgensen (tiny change) +(doctor-put-meaning toke 'toke) + "\\|" ; per toke.c + const struct sockaddr *to, int tolen); +2014-11-26 Toke Høiland-Jørgensen (tiny change) + ptrdiff_t tolen = strlen (key_symbols[i].to); + eassert (tolen <= fromlen); + memcpy (match, key_symbols[i].to, tolen); + memmove (match + tolen, match + fromlen, + len -= fromlen - tolen; + p = match + tolen; + const struct sockaddr * to, int tolen); + const struct sockaddr * to, int tolen) + int rc = pfn_sendto (SOCK_HANDLE (s), buf, len, flags, to, tolen); +Put dialogue in buffer." + "Function called by ], the ket. View registers and call ]]." +;; Matches a char which is a constituent of a variable or number, or a ket +(defun verilog-expand-vector-internal (bra ket) + "Given start brace BRA, and end brace KET, expand one line into many lines." + (regexp-quote ket) + (int-to-string (car vec)) ket sig-tail "\n")) + "Given start brace BRA, and end brace KET, expand one line into many lines." + m | mo | mot | moti | motif ) val=motif ;; + i | in | ino | inot | inoti | inotif | inotify ) val=inotify ;; +2001-04-23 Kahlil Hodgson + (funcall expect 20 "ingenuous"))))) + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #chan :mike: Mehercle! if their sons be ingenuous, they shall want no instruction; if their daughters be capable, I will put it to them. But, vir sapit qui pauca loquitur. A soul feminine saluteth us.")) + (search-forward "return te") + "fn test() -> i32 { let test=3; return te; }")))) + ts te h m s neg) + te (match-string 3)) + (setq s (- (org-time-string-to-seconds te) + Rename from whitespace-skipping-for-quotes-not-ouside. + (whitespace-skipping-for-quotes-not-ouside) +Thread-Modell: posix +Thread-Modell: posix +(ert-deftest indent-sexp-cant-go () +(ert-deftest thunk-let-bound-vars-cant-be-set-test () + (mml-secure-cust-fpr-lookup context 'encrypt "sub@example.org"))) + (let ((p-e-fprs (mml-secure-cust-fpr-lookup + (p-s-fprs (mml-secure-cust-fpr-lookup + (let ((p-e-fprs (mml-secure-cust-fpr-lookup + (p-s-fprs (mml-secure-cust-fpr-lookup + (let ((s-e-fprs (mml-secure-cust-fpr-lookup + (s-s-fprs (mml-secure-cust-fpr-lookup +(ert-deftest doesnt-time-out () +(ert-deftest json-el-cant-serialize-this () + (should (equal (try-completion "B-hel" subvtable) + (should (equal (all-completions "B-hel" subvtable) '("-hello"))) + (should (equal (completion-boundaries "B-hel" subvtable +(ert-deftest ruby-regexp-doesnt-start-in-string () + Rename from wisent-inaccessable-symbols, fixing a misspelling. + ("calc-math" calcFunc-alog calcFunc-arccos + ( ?B 2 calcFunc-alog ) + (change-log-function-face, change-log-acknowledgement-face): + (bs-appearance) : Renamed from bs-appearence. + typo `fortran-strip-sqeuence-nos'. + * progmodes/fortran.el (fortran-strip-sqeuence-nos): Doc fix. + (fortran-strip-sqeuence-nos): Make arg optional. Fix regexp and +1999-06-01 Jae-youn Chung +doc/emacs/docstyle.texi:14: fied ==> field +(define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "25.1") +(define-obsolete-function-alias 'hfy-colour-vals #'hfy-color-vals "27.1") +(define-obsolete-function-alias 'hfy-colour #'hfy-color "27.1") +(define-obsolete-variable-alias 'eglot-ignored-server-capabilities + setenv ("TZ", "IST-02IDT-03,M4.1.6/00:00,M9.5.6/01:00", 0); + "kana-TA", "kana-CHI", "kana-TSU", "kana-TE", + (internal--after-with-selected-window): Fix typo seleted->selected. + * subr.el (internal--before-with-seleted-window) + (internal--after-with-seleted-window): New functions. + * follow.el (follow-inactive-menu): Rename from follow-deactive-menu. + * emacs-lisp/cconv.el (cconv-analyse-form): Warn use of ((λ ...) ...). + (feedmail-sendmail-f-doesnt-sell-me-out) + (feedmail-sendmail-f-doesnt-sell-me-out) + Respect feedmail-sendmail-f-doesnt-sell-me-out. + * terminal.el (te-get-char, te-tic-sentinel): +from server-external-socket-initialised, since it should be + * lisp/server.el: (server-external-socket-initialised): New + Rename from help-fns--analyse-function. + c-ambiguous-overloadable-or-identifier-prefices. Caller changed. + * lisp/progmodes/cc-langs.el (c-ambiguous-overloadable-or-identifier-prefices) + Rename from nndiary-last-occurence. + Rename from nndiary-next-occurence. All uses changed. + lisp/textmodes/flyspell.el (flyspell-ajust-cursor-point): Rename to + * test/file-organization.org: Rename from test/file-organisation.org. + character class (namely ‘fo’ leaving ‘o’ in the string), but since the + change-log-acknowledgement-face): + 9daf1cf * etc/NEWS: Improve wording of vc-git-log-output-coding-syste... + a05fb21 * lisp/emacs-lisp/package.el (package-install-selected-packag... + 5cc6919 Fix a caching bug, which led to inordinately slow c-beginnin... + (mml-secure-cust-usage-lookup, mml-secure-cust-fpr-lookup) + * test/file-organisation.org: New file. + ("test/file-organisation.org" . "file-organization.org") + `message-insert-formated-citation-line'. + info.addons = (\"hald-addon-acpi\") + deactive->inactive, inactivate->deactivate spelling fixes (Bug#10150) + (org-detach-overlay): Rename from `org-detatch-overlay'. + (change-log-acknowledgement): Remove "-face" suffix from face names. + (appt-visible): Rename from appt-visable. + (pascal-seperator-keywords): Renamed to pascal-separator-keywords. + mouse-union-first-prefered. + * sc.el (sc-consistent-cite-p): Renamed from sc-consistant-cite-p. + bibtex-name-alignement. + "d-elete, u-ndelete, x-punge, f-ind, o-ther window, R-ename, C-opy, h-elp")) + (erc-coding-sytem-for-target): Removed. + (erc-coding-sytem-for-target): New. +Paul Raines (raines at slac.stanford.edu), + "union" "unsafe" "use" "where" "while" (crate) (self) (super) + term-ansi-face-alredy-done. + (ebnf-syntactic): Change group name and tag from "ebnf-syntatic". + "ebnf-syntatic". + Rename from ucs-input-inactivate. + Rename from hangul-input-method-inactivate. + * terminal.el (te-create-terminfo): Use make-temp-file + (org-detatch-overlay, org-move-overlay, org-overlay-put): + 'gnus-score-find-favourite-words + 'nndiary-last-occurence + 'nndiary-next-occurence +(define-obsolete-function-alias 'org-truely-invisible-p +(define-obsolete-variable-alias 'eglot-ignored-server-capabilites + ("`fo" . "format" ) +(define-obsolete-function-alias 'rtree-normalise-range + `org-attch-delete'. Add a security query before deleting the + `org-toggel-region-headings'. + "3 Oktober 2000 16:30 multiline + "September" "Oktober" "November" "Dezember"]) + "de la Cognée" "de l'Ellébore" "du Brocoli" + 1fe596d89f (origin/emacs-27) Fix another compilation problem in a bui... + "du Buis" "du Lichen" "de l'If" + if (c == BIG) { /* caint get thar from here */ + Christoph Groth and Liu Xin . + "passord" ; nb + (should (equal (rfc6068-unhexify-string "caf%C3%A9") "café"))) + (equal (rfc6068-parse-mailto-url "mailto:user@example.org?subject=caf%C3%A9&body=caf%C3%A9") +;; Paul Lew suggested implementing fixed width + (TUNG@WAIF.MIT.EDU <8704130324.AA10879@prep.ai.mit.edu>) + (ruby-ts-mode "*.r[bu]" "*.rake" "*.gemspec" "*.erb" "*.haml" +(doctor-put-meaning cunt 'sexnoun) +(doctor-put-meaning cunts 'sexnoun) +(doctor-put-meaning skool 'school) + Add ".crate" to Tramp archive file suffixes. + * lisp/net/tramp-archive.el (tramp-archive-suffixes): Add ".crate". +2021-11-10 Benj (tiny change) + allow party crashers to respond to ical events + calling those respondents "party crashers". +2019-12-17 Antoine Kalmbach (tiny change) +2014-02-18 Matus Goljer +2014-02-13 Matus Goljer +2004-05-20 Magnus Henoch +2004-11-14 Magnus Henoch +2006-10-16 Magnus Henoch +2006-11-01 Magnus Henoch +2006-11-08 Magnus Henoch +2006-11-15 Magnus Henoch +2006-11-26 Magnus Henoch +2006-12-08 Magnus Henoch +2007-01-14 Magnus Henoch +2007-10-28 Magnus Henoch +2007-12-03 Magnus Henoch +2008-02-04 Magnus Henoch +2008-03-09 Magnus Henoch +2008-09-30 Magnus Henoch + (secnd (cdr (cadr dlist)))) + (car secnd))) ; fetch_date + secnd (cdr secnd)) + (car secnd))) ; Keep_flag + secnd (cdr secnd)) + (car secnd))) ; NOV_entry_position +@c LocalWords: DesBrisay Dcc devel dir dired docstring filll forw +Older versions of the themes provided options ~grayscale~ (or ~greyscale~) + > The requestor should delete [...] the property specified in the + We are not the requestor, so we should not be deleting this property + needs to remain available as the requestor will generally want to read + [t]ime [s]cheduled [d]eadline [c]reated cloc[k]ing + (message "Sparse tree: [r]egexp [t]odo [T]odo-kwd [m]atch [p]roperty +;; -grey Render in greyscale as 8bits/pixel. + -grey Render in greyscale as 8bits/pixel. + (if (looking-at "p\\(ublic\\|rotected\\|rivate\\)") + "\\=p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\>[^_]" nil t) + "\\(p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\|more\\)\\>" + * sysdep.c (WRITABLE): Renamed from WRITEABLE. +DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0, + defsubr (&Scond); + /* XXX: who is wrong, the requestor or the implementation? */ + /* "Data" to send a requestor for a failed MULTIPLE subtarget. */ + /* This formula is from a paper titled `Colour metric' by Thiadmer Riemersma. + (0.1 ":mike!~u@286u8jcpis84e.irc PRIVMSG #chan :joe: Good gentleman, go your gait, and let poor volk pass. An chud ha' bin zwaggered out of my life, 'twould not ha' bin zo long as 'tis by a vortnight. Nay, come not near th' old man; keep out, che vor ye, or ise try whether your costard or my ballow be the harder. Chill be plain with you.") + db "create table if not exists test10 (col1 text, col2 blob, col3 numbre)") + (const :format "[%v] %t\n" :tag "Alias for `gray-background'" greyscale) +2008-09-11 Magnus Henoch + . +2006-10-07 Magnus Henoch +2006-09-07 Magnus Henoch + Reported by Magnus Henoch . +2005-09-24 Magnus Henoch +2005-09-17 Magnus Henoch +2005-09-10 Magnus Henoch +2005-08-09 Magnus Henoch +2008-10-16 Magnus Henoch +2008-10-01 Magnus Henoch +2008-07-02 Magnus Henoch +2008-04-23 Magnus Henoch +2008-03-28 Magnus Henoch + * bibtex.el (bibtex-entry): Add OPTkey/annote. If OPTcrossref set +;; :booktitle :month :annote :abstract + (:annote . "An annotation. It is not used by the standard bibliography styles, but may be used by others that produce an annotated bibliography.") + :annote (or (cdr (assoc "annote" entry)) "[no annotation]") + '(("annote" "Personal annotation (ignored)")) + (r2b-put-field "annote" r2bv-annote) +2006-10-29 Magnus Henoch +2006-10-28 Magnus Henoch +2006-10-27 Magnus Henoch +2006-10-12 Magnus Henoch +2006-10-11 Magnus Henoch +2006-10-09 Magnus Henoch +2008-10-16 Magnus Henoch +2007-12-31 Magnus Henoch +2007-12-05 Magnus Henoch + (ENUMABLE): Remove; no longer needed. + * lisp.h (ENUMABLE) [!_AIX]: Don't define to 0 merely because we're + * lisp.h (ENUMABLE, DEFINE_GDB_SYMBOL_ENUM): New macros. + * lisp.h (ENUMABLE, DEFINE_GDB_SYMBOL_ENUM): Delete macros. + * lisp.h (ENUMABLE, DEFINE_GDB_SYMBOL_ENUM): New macros. +2023-06-29 Andrew G Cohen +2023-05-07 Andrew G Cohen + C-x b fo + avoid failures due to MS-Windows "numeric tails" (mis)feature and +2022-04-07 Andrew G Cohen +2022-04-03 Andrew G Cohen +2022-03-22 Andrew G Cohen +2022-03-20 Andrew G Cohen +2022-03-17 Andrew G Cohen +2022-03-17 Andrew G Cohen +2022-03-04 Andrew G Cohen +2022-02-18 Andrew G Cohen +2022-02-18 Andrew G Cohen +2022-02-11 Andrew G Cohen +2022-02-08 Andrew G Cohen +2022-02-03 Andrew G Cohen +2021-12-21 Andrew G Cohen +2021-12-18 Andrew G Cohen + 6d5886e780 * test/lisp/repeat-tests.el (repeat-tests-call-b): Test fo... + 0771d8939a * etc/PROBLEMS: Mention problems with regexp matcher. (Bu... + 59df93e2dd * lisp/help.el (help--analyze-key): Add new arg BUFFER (bu... + 3832b983cf In Fdelete_other_windows_internal fix new total window siz... + 3a9d5f04fb Mention ffap-file-name-with-spaces in the ffap doc strin + Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) + # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. +@item Unform +J. Otto Tennant, +extern struct servent *hes_getservbyname (/* char *, char * */); + struct servent *servent; + servent = hes_getservbyname (service, "tcp"); + if (servent) + servent = getservbyname (service, "tcp"); + if (servent) + struct servent *srv = getservbyname (service, protocol); +2003-04-10 Sebastian Tennant (tiny change) + Reported by Sebastian Tennant . + causing truncation of AUTOWIRE signals. Reported by Bruce Tennant. + Tennant. +1997-10-21 Jens Lautenbacher + unform Use unformatted display: add(a, mul(b,c)). + (memq calc-language '(nil flat unform)) + (memq calc-language '(nil flat unform))) + '(flat big unform)))) +;; Sebastian Tennant + (message "Mark as unread: (n)one / (a)ll / all (d)ownloaded articles? (n) ") + (wheight (window-height)) + (rest (- wheight pheight))) + (vai #xA500) + (vai\ . vai) + ts te h m s neg) + te (match-string 3)) + (setq s (- (org-time-string-to-seconds te) +(defun dun-listify-string (strin) + (while (setq end-pos (string-match "[ ,:;]" (substring strin pos))) + (substring strin pos end-pos)))))) +(defun dun-listify-string2 (strin) + (while (setq end-pos (string-search " " (substring strin pos))) + (substring strin pos end-pos)))))) +"any" "append" "as" "asc" "ascic" "async" "at_begin" "at_end" "audit" + "attribute" "(d)eclaration or (s)pecification?" t) ?s) + "quantity" "(f)ree, (b)ranch, or (s)ource quantity?" t))) + "Spacify table frame. + ("\\oint" . ?∮) +struct servent * sys_getservbyname (const char * name, const char * proto); + Supplement, Latin Extended-A/B, Vai, Supplemental Punctuation, Tai + Remove the "mis;tak-+;;" line from the code; apparently this + it->dpvec_char_len if dpend reached. + 3:000MSTRIN[0]STRIN[1]STRIN[2] + [2:000MSTRIN[0]STRIN[1]STRIN[2]] + Lisp_Object *dpvec, *dpend; + struct servent *svc_info +struct servent * (PASCAL *pfn_getservbyname) (const char * name, const char * proto); +struct servent * + struct servent * serv; + struct servent *srv = sys_getservbyname (service, protocol); + /* Reset bits 4 (Phonetic), 12 (Vai), 14 (Nko), 27 (Balinese). */ + DEFSYM (Qvai, "vai"); + it->dpend = v->contents + v->header.size; + it->dpend = default_invis_vector + 3; + it->dpend = v->contents + v->header.size; + it->dpend = it->dpvec + ctl_len; + if (it->dpvec + it->current.dpvec_index >= it->dpend) + if (it->dpend - it->dpvec > 0 /* empty dpvec[] is invalid */ + if (it->current.dpvec_index < it->dpend - it->dpvec - 1) + && it->dpvec + it->current.dpvec_index + 1 >= it->dpend))) + && it->dpvec + it->current.dpvec_index != it->dpend); +VERY VERY LONG STRIN | VERY VERY LONG STRIN + (ert-info ("Joined by bouncer to #foo, pal persent") + (ert-info ("Joined by bouncer to #chan@foonet, pal persent") + (ert-info ("Joined by bouncer to #chan@barnet, pal persent") diff --git a/admin/codespell/codespell.ignore b/admin/codespell/codespell.ignore new file mode 100644 index 00000000000..34de02e969b --- /dev/null +++ b/admin/codespell/codespell.ignore @@ -0,0 +1,41 @@ +acknowledgements +afile +ake +analogue +ans +bloc +blocs +callint +clen +crossreference +crossreferences +debbugs +dedented +dependant +doas +ede +grey +gud +ifset +inout +keypair +keyserver +keyservers +lightening +mapp +master +mimicks +mitre +msdos +ot +parm +parms +reenable +reenabled +requestor +sie +spawnve +statics +stdio +texline +typdef diff --git a/admin/codespell/codespell.rc b/admin/codespell/codespell.rc new file mode 100644 index 00000000000..9ef5f40369c --- /dev/null +++ b/admin/codespell/codespell.rc @@ -0,0 +1,4 @@ +[codespell] +skip=.git/*,*.elc,*.eln,*.gpg,*.gz,*.icns,*.jpg,*.kbx,*.key,*.pbm,*.png,*.rnc,*.so,*.tiff,*.tit,*.xml,*.xpm,*.zip,*random_seed +builtin=clear,rare,en-GB_to_en-US +quiet-level=35 diff --git a/admin/run-codespell b/admin/run-codespell new file mode 100755 index 00000000000..991b72073b2 --- /dev/null +++ b/admin/run-codespell @@ -0,0 +1,68 @@ +#!/bin/bash +### run-codespell - run codespell on Emacs + +## Copyright (C) 2023-2024 Free Software Foundation, Inc. + +## Author: Stefan Kangas + +## This file is part of GNU Emacs. + +## GNU Emacs is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. + +## GNU Emacs is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. + +## You should have received a copy of the GNU General Public License +## along with GNU Emacs. If not, see . + +### Commentary: + +## Run codespell on the Emacs source tree. +## +## codespell 2.2.2 or later is recommended. Earlier versions had a +## bug where the line count was incorrect for files containing "^L" +## characters. + +source "${0%/*}/emacs-shell-lib" + +CODESPELL_DIR="${PD}/codespell" + +CODESPELL_RC="${CODESPELL_DIR}/codespell.rc" +CODESPELL_EXCLUDE="${CODESPELL_DIR}/codespell.exclude" +CODESPELL_IGNORE="${CODESPELL_DIR}/codespell.ignore" +CODESPELL_DICTIONARY="${CODESPELL_DIR}/codespell.dictionary" + +emacs_run_codespell () +{ + git ls-files |\ + grep -v -E -e '^(lib|m4)/.*' |\ + grep -v -E -e '^admin/(charsets|codespell|unidata)/.*' |\ + grep -v -E -e '^doc/misc/texinfo.tex$' |\ + grep -v -E -e '^etc/(AUTHORS|HELLO|publicsuffix.txt)$' |\ + grep -v -E -e '^etc/refcards/(cs|de|fr|pl|pt|sk)-.+.tex$' |\ + grep -v -E -e '^etc/tutorials/TUTORIAL\..+' |\ + grep -v -E -e '^leim/(MISC|SKK)-DIC/.*' |\ + grep -v -E -e '^lisp/language/ethio-util.el' |\ + grep -v -E -e '^lisp/ldefs-boot.el' |\ + grep -v -E -e '^lisp/leim/.*' |\ + grep -v -E -e '^test/lisp/net/puny-resources/IdnaTestV2.txt' |\ + grep -v -E -e '^test/manual/(etags|indent)/.*' |\ + grep -v -E -e '^test/src/regex-resources/.*' |\ + xargs codespell \ + --config "$CODESPELL_RC" \ + --exclude-file "$CODESPELL_EXCLUDE" \ + --ignore-words "$CODESPELL_IGNORE" \ + --disable-colors \ + --write-changes \ + $@ +} + +emacs_run_codespell +emacs_run_codespell --dictionary "$CODESPELL_DICTIONARY" + +exit 0 -- cgit v1.2.3 From eb779ae64677e643d2d78cfc2b016088e8d7ff98 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Jan 2024 18:05:14 -0500 Subject: * lisp/keymap.el (define-keymap): Demote "duplicate def" to a warning * test/src/keymap-tests.el (keymap-test-duplicate-definitions): Adjust accordingly. --- lisp/keymap.el | 12 +++++++++--- test/src/keymap-tests.el | 17 +++++++++++++---- 2 files changed, 22 insertions(+), 7 deletions(-) diff --git a/lisp/keymap.el b/lisp/keymap.el index 065c59da74c..d2544e30ce0 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -577,9 +577,15 @@ should be a MENU form as accepted by `easy-menu-define'. (let ((def (pop definitions))) (if (eq key :menu) (easy-menu-define nil keymap "" def) - (if (member key seen-keys) - (error "Duplicate definition for key: %S %s" key keymap) - (push key seen-keys)) + (when (member key seen-keys) + ;; Since the keys can be computed dynamically, it can + ;; very well happen that we get duplicate definitions + ;; due to some unfortunate configuration rather than + ;; due to an actual bug. While such duplicates are + ;; not desirable, they shouldn't prevent the users + ;; from getting their job done. + (message "Duplicate definition for key: %S %s" key keymap)) + (push key seen-keys) (keymap-set keymap key def))))) keymap))) diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index bc9977f31bf..04b897045db 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -23,6 +23,7 @@ ;;; Code: (require 'ert) +(require 'cl-lib) (defun keymap-tests--make-keymap-test (fun) (should (eq (car (funcall fun)) 'keymap)) @@ -470,10 +471,18 @@ g .. h foo ert-keymap-duplicate "a" #'next-line "a" #'previous-line)) - (should-error - (define-keymap - "a" #'next-line - "a" #'previous-line))) + (let ((msg "")) + ;; FIXME: It would be nicer to use `current-message' rather than override + ;; `message', but `current-message' returns always nil in batch mode :-( + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) (setq msg (apply #'format fmt args))))) + (should + (string-match "duplicate" + (progn + (define-keymap + "a" #'next-line + "a" #'previous-line) + msg)))))) (ert-deftest keymap-unset-test-remove-and-inheritance () "Check various behaviors of keymap-unset. (Bug#62207)" -- cgit v1.2.3 From 82f71e106afd9bede95cfea3025f7c059d7c2bcf Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Jan 2024 18:08:31 -0500 Subject: * lisp/completion-preview.el: Fix use in non-GUI session Fix loading in non-GUI sessions where `mwheel` is not preloaded. Not requiring `mwheel` would be a lot more complex, since it would require delaying the construction of `completion-preview--mouse-map`. * lisp/completion-preview.el (): Require `mwheel`. Remove correspondingly redundant `defvar`s. (completion-preview--mouse-map): Use `key-description` rather than mimicking it with `format`. --- lisp/completion-preview.el | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index baadb4714b1..3bb5ef24e9d 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -52,6 +52,8 @@ ;;; Code: +(require 'mwheel) + (defgroup completion-preview nil "In-buffer completion preview." :group 'completion) @@ -128,19 +130,19 @@ If this option is nil, these commands do not display any message." ;; "M-p" #'completion-preview-prev-candidate ) -(defvar mouse-wheel-up-event) -(defvar mouse-wheel-up-alternate-event) -(defvar mouse-wheel-down-event) -(defvar mouse-wheel-down-alternate-event) (defvar-keymap completion-preview--mouse-map :doc "Keymap for mouse clicks on the completion preview." "" #'completion-preview-insert "C-" #'completion-at-point "" #'completion-at-point - (format "<%s>" mouse-wheel-up-event) #'completion-preview-prev-candidate - (format "<%s>" mouse-wheel-up-alternate-event) #'completion-preview-prev-candidate - (format "<%s>" mouse-wheel-down-event) #'completion-preview-next-candidate - (format "<%s>" mouse-wheel-down-alternate-event) #'completion-preview-next-candidate) + (key-description (vector mouse-wheel-up-event)) + #'completion-preview-prev-candidate + (key-description (vector mouse-wheel-up-alternate-event)) + #'completion-preview-prev-candidate + (key-description (vector mouse-wheel-down-event)) + #'completion-preview-next-candidate + (key-description (vector mouse-wheel-down-alternate-event)) + #'completion-preview-next-candidate) (defvar-local completion-preview--overlay nil) -- cgit v1.2.3 From db8890b3c96289ca95e4ea3ea53f0eda1a948af6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Jan 2024 18:28:12 -0500 Subject: mwheel.el: Unconditionally use the `wheel-up/down/...` events The `mouse-wheel-DIR-event` vars were introduced because under X11 we get different `mouse-N` events depending on the users' mouse and those same events can be used for other things for other rodents, so we can't unconditionally treat those events as mouse-wheel events. But this does not apply to the `wheel-up/down/...` events. So hard code them. * lisp/mwheel.el (mwheel--is-dir-p): Always consider the `wheel-DIR` events. (mouse-wheel--setup-bindings): Always bind the `wheel-DIR` events. * lisp/completion-preview.el (completion-preview--mouse-map): Unconditionally bind the `wheel-DIR` events. * lisp/edmacro.el (edmacro-fix-menu-commands): Hard code the `wheel-DIR` events as mouse events regardless of `mouse-wheel-*-event`s. * lisp/progmodes/flymake.el (flymake--mode-line-counter-map): Do nothing, because it's already been done in commit e5be6c7ae309. * doc/lispref/commands.texi (Misc Events): Document the need to use `wheel-up/down/left/right` unconditionally. --- doc/lispref/commands.texi | 29 +++++++++++++++-------------- etc/NEWS | 7 +++++++ lisp/completion-preview.el | 2 ++ lisp/edmacro.el | 15 ++++++++------- lisp/mwheel.el | 15 ++++++++++----- 5 files changed, 42 insertions(+), 26 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 10f47d736d2..5f840ac21ec 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2562,23 +2562,24 @@ non-@code{nil}. @vindex mouse-wheel-up-event @vindex mouse-wheel-down-event The @code{wheel-up} and @code{wheel-down} events are generated only on -some kinds of systems. On other systems, @code{mouse-4} and -@code{mouse-5} are used instead. For portable code, use the variables -@code{mouse-wheel-up-event}, @code{mouse-wheel-up-alternate-event}, -@code{mouse-wheel-down-event} and -@code{mouse-wheel-down-alternate-event} defined in @file{mwheel.el} to -determine what event types to expect from the mouse wheel. +some kinds of systems. On other systems, other events like @code{mouse-4} and +@code{mouse-5} are used instead. Portable code should handle both +@code{wheel-up} and @code{wheel-down} events as well as the events +specified in the variables @code{mouse-wheel-up-event} and +@code{mouse-wheel-down-event}, defined in @file{mwheel.el}. @vindex mouse-wheel-left-event @vindex mouse-wheel-right-event -Similarly, some mice can generate @code{mouse-wheel-left-event} and -@code{mouse-wheel-right-event} and can be used to scroll if -@code{mouse-wheel-tilt-scroll} is non-@code{nil}. However, some mice -also generate other events at the same time as they're generating -these scroll events which may get in the way. The way to fix this is -generally to unbind these events (for instance, @code{mouse-6} or -@code{mouse-7}, but this is very hardware and operating system -dependent). +The same holds for the horizontal wheel movements which are usually +represented by @code{wheel-left} and @code{wheel-right} events, but +for which portable code should also obey the variables +@code{mouse-wheel-left-event} and @code{mouse-wheel-right-event}, +defined in @file{mwheel.el}. +However, some mice also generate other events at the same time as +they're generating these scroll events which may get in the way. +The way to fix this is generally to unbind these events (for instance, +@code{mouse-6} or @code{mouse-7}, but this is very hardware and +operating system dependent). @cindex @code{pinch} event @item (pinch @var{position} @var{dx} @var{dy} @var{scale} @var{angle}) diff --git a/etc/NEWS b/etc/NEWS index f4d008ee2d6..fefdfb2afb3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -406,6 +406,13 @@ respectively, in addition to the existing translations 'C-x 8 / e' and * Changes in Specialized Modes and Packages in Emacs 30.1 ++++ +** Mwheel +The 'wheel-up/down/left/right' events are now bound unconditionally, +and the 'mouse-wheel-up/down/left/right-event' variables are thus +used only to specify the 'mouse-4/5/6/7' events generated by +legacy setup, such as 'xterm-mouse-mode' or X11 without XInput2. + +++ ** New command 'lldb'. Run the LLDB debugger, analogous to the 'gud-gdb' command. diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 3bb5ef24e9d..48b6a4fd822 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -135,6 +135,8 @@ If this option is nil, these commands do not display any message." "" #'completion-preview-insert "C-" #'completion-at-point "" #'completion-at-point + "" #'completion-preview-prev-candidate + "" #'completion-preview-next-candidate (key-description (vector mouse-wheel-up-event)) #'completion-preview-prev-candidate (key-description (vector mouse-wheel-up-alternate-event)) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 5bd0c1892e5..9ade554f559 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -748,13 +748,14 @@ This function assumes that the events can be stored in a string." ;; info is recorded in macros to make this possible. ((or (mouse-event-p ev) (mouse-movement-p ev) (memq (event-basic-type ev) - (list mouse-wheel-down-event mouse-wheel-up-event - mouse-wheel-right-event - mouse-wheel-left-event - mouse-wheel-down-alternate-event - mouse-wheel-up-alternate-event - mouse-wheel-right-alternate-event - mouse-wheel-left-alternate-event))) + `( ,mouse-wheel-down-event ,mouse-wheel-up-event + ,mouse-wheel-right-event + ,mouse-wheel-left-event + ,mouse-wheel-down-alternate-event + ,mouse-wheel-up-alternate-event + ,mouse-wheel-right-alternate-event + ,mouse-wheel-left-alternate-event + wheel-down wheel-up wheel-left wheel-right))) nil) (noerror nil) (t diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 84679f5c33f..f50376c72b5 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -308,9 +308,11 @@ active window." (defmacro mwheel--is-dir-p (dir button) (declare (debug (sexp form))) (let ((custom-var (intern (format "mouse-wheel-%s-event" dir))) - (custom-var-alt (intern (format "mouse-wheel-%s-alternate-event" dir)))) + (custom-var-alt (intern (format "mouse-wheel-%s-alternate-event" dir))) + (event (intern (format "wheel-%s" dir)))) (macroexp-let2 nil butsym button - `(or (eq ,butsym ,custom-var) + `(or (eq ,butsym ',event) + (eq ,butsym ,custom-var) ;; We presume here `button' is never nil. (eq ,butsym ,custom-var-alt))))) @@ -503,14 +505,16 @@ an event used for scrolling, such as `mouse-wheel-down-event'." ((and (consp binding) (eq (cdr binding) 'text-scale)) (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event mouse-wheel-down-alternate-event - mouse-wheel-up-alternate-event)) + mouse-wheel-up-alternate-event + 'wheel-down 'wheel-up)) (when event (mouse-wheel--add-binding `[,(append (car binding) (list event))] 'mouse-wheel-text-scale)))) ((and (consp binding) (eq (cdr binding) 'global-text-scale)) (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event mouse-wheel-down-alternate-event - mouse-wheel-up-alternate-event)) + mouse-wheel-up-alternate-event + 'wheel-down 'wheel-up)) (when event (mouse-wheel--add-binding `[,(append (car binding) (list event))] 'mouse-wheel-global-text-scale)))) @@ -521,7 +525,8 @@ an event used for scrolling, such as `mouse-wheel-down-event'." mouse-wheel-down-alternate-event mouse-wheel-up-alternate-event mouse-wheel-left-alternate-event - mouse-wheel-right-alternate-event)) + mouse-wheel-right-alternate-event + 'wheel-down 'wheel-up 'wheel-left 'wheel-right)) (when event (dolist (key (mouse-wheel--create-scroll-keys binding event)) (mouse-wheel--add-binding key 'mwheel-scroll)))))))) -- cgit v1.2.3 From 18294854c717a82966090e99130bcb99fc354a5b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Jan 2024 18:52:37 -0500 Subject: mwheel.el: Remove `mouse-wheel-*-alternate-event` vars Now that `wheel-DIR` events are hardcoded, we never need more than one variable (which we actually never needed anyway, we could have let `mouse-wheel-*-event` vars hold lists of events instead), so remove the `mouse-wheel-*-alternate-event` vars by merging their default value into that of the corresponding `mouse-wheel-*-event`. * lisp/mwheel.el (mouse-wheel-down-event, mouse-wheel-up-event) (mouse-wheel-left-event, mouse-wheel-right-event): Don't bother holding `wheel-DIR` events since these are already handled anyway. Hold the event that would have been held in `mouse-wheel-DIR-alternate-event` instead. (mouse-wheel-down-alternate-event, mouse-wheel-up-alternate-event) (mouse-wheel-left-alternate-event, mouse-wheel-right-alternate-event): Delete vars. (mwheel--is-dir-p, mouse-wheel--setup-bindings): * lisp/edmacro.el (edmacro-fix-menu-commands): * lisp/completion-preview.el (completion-preview--mouse-map): Don't use `mouse-wheel-up/down-alternate-event` any more. * lisp/progmodes/flymake.el (flymake--mode-line-counter-map): Do nothing, because it already ignored those vars. --- lisp/completion-preview.el | 4 --- lisp/edmacro.el | 11 +------ lisp/mwheel.el | 76 +++++++++++++--------------------------------- 3 files changed, 22 insertions(+), 69 deletions(-) diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 48b6a4fd822..f552db7aa8e 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -139,11 +139,7 @@ If this option is nil, these commands do not display any message." "" #'completion-preview-next-candidate (key-description (vector mouse-wheel-up-event)) #'completion-preview-prev-candidate - (key-description (vector mouse-wheel-up-alternate-event)) - #'completion-preview-prev-candidate (key-description (vector mouse-wheel-down-event)) - #'completion-preview-next-candidate - (key-description (vector mouse-wheel-down-alternate-event)) #'completion-preview-next-candidate) (defvar-local completion-preview--overlay nil) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 9ade554f559..9d185d79142 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -729,10 +729,6 @@ This function assumes that the events can be stored in a string." (defvar mouse-wheel-up-event) (defvar mouse-wheel-right-event) (defvar mouse-wheel-left-event) - (defvar mouse-wheel-down-alternate-event) - (defvar mouse-wheel-up-alternate-event) - (defvar mouse-wheel-right-alternate-event) - (defvar mouse-wheel-left-alternate-event) ;; Make a list of the elements. (setq macro (append macro nil)) (dolist (ev macro) @@ -749,12 +745,7 @@ This function assumes that the events can be stored in a string." ((or (mouse-event-p ev) (mouse-movement-p ev) (memq (event-basic-type ev) `( ,mouse-wheel-down-event ,mouse-wheel-up-event - ,mouse-wheel-right-event - ,mouse-wheel-left-event - ,mouse-wheel-down-alternate-event - ,mouse-wheel-up-alternate-event - ,mouse-wheel-right-alternate-event - ,mouse-wheel-left-alternate-event + ,mouse-wheel-right-event ,mouse-wheel-left-event wheel-down wheel-up wheel-left wheel-right))) nil) (noerror nil) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index f50376c72b5..438ca5f84d5 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -60,44 +60,28 @@ (if (or (featurep 'w32-win) (featurep 'ns-win) (featurep 'haiku-win) (featurep 'pgtk-win) (featurep 'android-win)) - 'wheel-up + (if (featurep 'xinput2) + nil + (unless (featurep 'x) + 'mouse-4)) 'mouse-4) - "Event used for scrolling down." + "Event used for scrolling down, beside `wheel-down', if any." :group 'mouse :type 'symbol :set 'mouse-wheel-change-button) -(defcustom mouse-wheel-down-alternate-event - (if (featurep 'xinput2) - 'wheel-up - (unless (featurep 'x) - 'mouse-4)) - "Alternative wheel down event to consider." - :group 'mouse - :type 'symbol - :version "29.1" - :set 'mouse-wheel-change-button) - (defcustom mouse-wheel-up-event (if (or (featurep 'w32-win) (featurep 'ns-win) (featurep 'haiku-win) (featurep 'pgtk-win) (featurep 'android-win)) - 'wheel-down + (if (featurep 'xinput2) + nil + (unless (featurep 'x) + 'mouse-5)) 'mouse-5) - "Event used for scrolling up." - :group 'mouse - :type 'symbol - :set 'mouse-wheel-change-button) - -(defcustom mouse-wheel-up-alternate-event - (if (featurep 'xinput2) - 'wheel-down - (unless (featurep 'x) - 'mouse-5)) - "Alternative wheel up event to consider." + "Event used for scrolling up, beside `wheel-up', if any." :group 'mouse :type 'symbol - :version "29.1" :set 'mouse-wheel-change-button) (defcustom mouse-wheel-click-event 'mouse-2 @@ -252,31 +236,23 @@ Also see `mouse-wheel-tilt-scroll'." (if (or (featurep 'w32-win) (featurep 'ns-win) (featurep 'haiku-win) (featurep 'pgtk-win) (featurep 'android-win)) - 'wheel-left + (if (featurep 'xinput2) + nil + (unless (featurep 'x) + 'mouse-6)) 'mouse-6) - "Event used for scrolling left.") - -(defvar mouse-wheel-left-alternate-event - (if (featurep 'xinput2) - 'wheel-left - (unless (featurep 'x) - 'mouse-6)) - "Alternative wheel left event to consider.") + "Event used for scrolling left, beside `wheel-left', if any.") (defvar mouse-wheel-right-event (if (or (featurep 'w32-win) (featurep 'ns-win) (featurep 'haiku-win) (featurep 'pgtk-win) (featurep 'android-win)) - 'wheel-right + (if (featurep 'xinput2) + nil + (unless (featurep 'x) + 'mouse-7)) 'mouse-7) - "Event used for scrolling right.") - -(defvar mouse-wheel-right-alternate-event - (if (featurep 'xinput2) - 'wheel-right - (unless (featurep 'x) - 'mouse-7)) - "Alternative wheel right event to consider.") + "Event used for scrolling right, beside `wheel-right', if any.") (defun mouse-wheel--get-scroll-window (event) "Return window for mouse wheel event EVENT. @@ -308,13 +284,11 @@ active window." (defmacro mwheel--is-dir-p (dir button) (declare (debug (sexp form))) (let ((custom-var (intern (format "mouse-wheel-%s-event" dir))) - (custom-var-alt (intern (format "mouse-wheel-%s-alternate-event" dir))) (event (intern (format "wheel-%s" dir)))) (macroexp-let2 nil butsym button `(or (eq ,butsym ',event) - (eq ,butsym ,custom-var) ;; We presume here `button' is never nil. - (eq ,butsym ,custom-var-alt))))) + (eq ,butsym ,custom-var))))) (defun mwheel-scroll (event &optional arg) "Scroll up or down according to the EVENT. @@ -504,16 +478,12 @@ an event used for scrolling, such as `mouse-wheel-down-event'." ;; Bindings for changing font size. ((and (consp binding) (eq (cdr binding) 'text-scale)) (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event - mouse-wheel-down-alternate-event - mouse-wheel-up-alternate-event 'wheel-down 'wheel-up)) (when event (mouse-wheel--add-binding `[,(append (car binding) (list event))] 'mouse-wheel-text-scale)))) ((and (consp binding) (eq (cdr binding) 'global-text-scale)) (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event - mouse-wheel-down-alternate-event - mouse-wheel-up-alternate-event 'wheel-down 'wheel-up)) (when event (mouse-wheel--add-binding `[,(append (car binding) (list event))] @@ -522,10 +492,6 @@ an event used for scrolling, such as `mouse-wheel-down-event'." (t (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event mouse-wheel-left-event mouse-wheel-right-event - mouse-wheel-down-alternate-event - mouse-wheel-up-alternate-event - mouse-wheel-left-alternate-event - mouse-wheel-right-alternate-event 'wheel-down 'wheel-up 'wheel-left 'wheel-right)) (when event (dolist (key (mouse-wheel--create-scroll-keys binding event)) -- cgit v1.2.3 From 998667f90262432facbf43cdb1f0a96704c84271 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Jan 2024 19:05:24 -0500 Subject: mwheel.el: Code clean to reduce duplication * lisp/mwheel.el (mouse-wheel-obey-old-style-wheel-buttons): New var, extracted from `mouse-wheel-*-event` definitions. (mouse-wheel-down-event, mouse-wheel-up-event) (mouse-wheel-left-event, mouse-wheel-right-event): Use it. --- lisp/mwheel.el | 54 +++++++++++++++++++++--------------------------------- 1 file changed, 21 insertions(+), 33 deletions(-) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 438ca5f84d5..fc1f8e8b6d6 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -56,33 +56,33 @@ (bound-and-true-p mouse-wheel-mode)) (mouse-wheel-mode 1))) -(defcustom mouse-wheel-down-event +(defvar mouse-wheel-obey-old-style-wheel-buttons + ;; FIXME: Yuck! (if (or (featurep 'w32-win) (featurep 'ns-win) (featurep 'haiku-win) (featurep 'pgtk-win) (featurep 'android-win)) (if (featurep 'xinput2) nil (unless (featurep 'x) - 'mouse-4)) - 'mouse-4) + t)) + t) + "If non-nil, treat mouse-4/5/6/7 events as mouse wheel events. +These are the event names used historically in X11 before XInput2. +They are sometimes generated by things like `xterm-mouse-mode' as well.") + +(defcustom mouse-wheel-down-event + (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-4) "Event used for scrolling down, beside `wheel-down', if any." :group 'mouse :type 'symbol - :set 'mouse-wheel-change-button) + :set #'mouse-wheel-change-button) (defcustom mouse-wheel-up-event - (if (or (featurep 'w32-win) (featurep 'ns-win) - (featurep 'haiku-win) (featurep 'pgtk-win) - (featurep 'android-win)) - (if (featurep 'xinput2) - nil - (unless (featurep 'x) - 'mouse-5)) - 'mouse-5) + (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-5) "Event used for scrolling up, beside `wheel-up', if any." :group 'mouse :type 'symbol - :set 'mouse-wheel-change-button) + :set #'mouse-wheel-change-button) (defcustom mouse-wheel-click-event 'mouse-2 "Event that should be temporarily inhibited after mouse scrolling. @@ -92,7 +92,7 @@ scrolling with the mouse wheel. To prevent that, this variable can be set to the event sent when clicking on the mouse wheel button." :group 'mouse :type 'symbol - :set 'mouse-wheel-change-button) + :set #'mouse-wheel-change-button) (defcustom mouse-wheel-inhibit-click-time 0.35 "Time in seconds to inhibit clicking on mouse wheel button after scroll." @@ -149,7 +149,7 @@ information, see `text-scale-adjust' and `global-text-scale-adjust'." (const :tag "Scroll horizontally" :value hscroll) (const :tag "Change buffer face size" :value text-scale) (const :tag "Change global face size" :value global-text-scale))))) - :set 'mouse-wheel-change-button + :set #'mouse-wheel-change-button :version "28.1") (defcustom mouse-wheel-progressive-speed t @@ -233,25 +233,11 @@ Also see `mouse-wheel-tilt-scroll'." "Function that does the job of scrolling right.") (defvar mouse-wheel-left-event - (if (or (featurep 'w32-win) (featurep 'ns-win) - (featurep 'haiku-win) (featurep 'pgtk-win) - (featurep 'android-win)) - (if (featurep 'xinput2) - nil - (unless (featurep 'x) - 'mouse-6)) - 'mouse-6) + (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-6) "Event used for scrolling left, beside `wheel-left', if any.") (defvar mouse-wheel-right-event - (if (or (featurep 'w32-win) (featurep 'ns-win) - (featurep 'haiku-win) (featurep 'pgtk-win) - (featurep 'android-win)) - (if (featurep 'xinput2) - nil - (unless (featurep 'x) - 'mouse-7)) - 'mouse-7) + (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-7) "Event used for scrolling right, beside `wheel-right', if any.") (defun mouse-wheel--get-scroll-window (event) @@ -335,7 +321,8 @@ value of ARG, and the command uses it in subsequent scrolls." mwheel-scroll-right-function) mouse-wheel-scroll-amount-horizontal)) ((mwheel--is-dir-p down button) - (condition-case nil (funcall mwheel-scroll-down-function amt) + (condition-case nil + (funcall mwheel-scroll-down-function amt) ;; Make sure we do indeed scroll to the beginning of ;; the buffer. (beginning-of-buffer @@ -359,7 +346,8 @@ value of ARG, and the command uses it in subsequent scrolls." ((mwheel--is-dir-p up button) (condition-case nil (funcall mwheel-scroll-up-function amt) ;; Make sure we do indeed scroll to the end of the buffer. - (end-of-buffer (while t (funcall mwheel-scroll-up-function))))) + (end-of-buffer + (while t (funcall mwheel-scroll-up-function))))) ((mwheel--is-dir-p left button) ; for tilt scroll (when mouse-wheel-tilt-scroll (funcall (if mouse-wheel-flip-direction -- cgit v1.2.3 From 5701f96335c603b474ccb01a7d8522875ac4905f Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 20 Jan 2024 21:01:11 +0100 Subject: * admin/README: Fix entry on coccinelle subdirectory. --- admin/README | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/admin/README b/admin/README index c7dec63875a..0afacee5f2f 100644 --- a/admin/README +++ b/admin/README @@ -57,15 +57,15 @@ Tests for custom types and load problems. Show files added/removed between two tar files. -Brief description of sub-directories: +* Brief description of sub-directories. charsets scripts for generating charset map files in ../etc/charsets -coccinelle patches to make coccinelle work with - the latest Emacs version. Since they - apply a few minor changes in Emacs internals - in multiple places, they are trivial for - copyright purposes. +coccinelle semantic patches for use with the static code + analyzer coccinelle. Since they apply a few + minor changes in Emacs internals in multiple + places, they are trivial for copyright + purposes. grammars wisent and bovine grammars, used to produce files in lisp/cedet/. notes miscellaneous notes related to administrative -- cgit v1.2.3 From 557ed9c04634aaacaafb9bf3066d33b1644912ac Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 20 Jan 2024 21:03:12 +0100 Subject: * admin/README: Document the run-codespell script. --- admin/README | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/admin/README b/admin/README index 0afacee5f2f..419039b4fba 100644 --- a/admin/README +++ b/admin/README @@ -39,6 +39,11 @@ Build Emacs in various ways. Install emacs quickly ("incrementally"). +** run-codespell + +Run the codespell tool on the Emacs sources. Requires codespell to be +installed first. + ** alloc-colors.c A utility program that allocates a given number of colors on X. Can @@ -66,6 +71,7 @@ coccinelle semantic patches for use with the static code minor changes in Emacs internals in multiple places, they are trivial for copyright purposes. +codespell supporting files for the run-codespell script. grammars wisent and bovine grammars, used to produce files in lisp/cedet/. notes miscellaneous notes related to administrative -- cgit v1.2.3 From 9841ced147f8a198da58a7925c0be55e2ed8dc75 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 20 Jan 2024 21:08:52 +0100 Subject: ; Fix typos --- admin/codespell/codespell.exclude | 1 + lisp/net/tramp-crypt.el | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/admin/codespell/codespell.exclude b/admin/codespell/codespell.exclude index 89b8a951f93..2503f4a9a16 100644 --- a/admin/codespell/codespell.exclude +++ b/admin/codespell/codespell.exclude @@ -1548,3 +1548,4 @@ VERY VERY LONG STRIN | VERY VERY LONG STRIN (ert-info ("Joined by bouncer to #foo, pal persent") (ert-info ("Joined by bouncer to #chan@foonet, pal persent") (ert-info ("Joined by bouncer to #chan@barnet, pal persent") +.UE . diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 143327c123a..9f30cdef069 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -862,7 +862,7 @@ WILDCARD is not supported." 'unlock-file (tramp-crypt-encrypt-file-name filename)))) (defun tramp-crypt-cleanup-connection (vec) - "Cleanup crypt ressources determined by VEC." + "Cleanup crypt resources determined by VEC." (let ((tramp-cleanup-connection-hook (remove #'tramp-crypt-cleanup-connection tramp-cleanup-connection-hook))) -- cgit v1.2.3 From afc9cd1721c586f960af5e324a61418775ac4543 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 20 Jan 2024 16:26:45 -0800 Subject: Fix autogen.sh’s spurious ‘git diff’ output MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Problem reported by Gerd Möllmann (Bug#68464). * .gitignore: Ignore files in exec that are now copied from build-aux. * admin/merge-gnulib (avoided_flags): Instead of clearing autom4te.cache here ... * autogen.sh (do_git): ... clear it here. Use config.guess, config.sub and install-sh from the Emacs repository, as they are more likely to be up to date. This avoids unnecessary differences among different builders, and avoids unnecessary ‘git diff’ output after autogen.sh. Also, copy these files from build-aux to exec since there should be no difference between the two copies. * exec/config.guess, exec/config.sub, exec/install-sh: Remove from repository, as autogen.sh now copies them from build-aux. --- .gitignore | 3 + admin/merge-gnulib | 3 - autogen.sh | 16 + exec/config.guess | 1774 ------------------------------------------------ exec/config.sub | 1907 ---------------------------------------------------- exec/install-sh | 541 --------------- 6 files changed, 19 insertions(+), 4225 deletions(-) delete mode 100755 exec/config.guess delete mode 100755 exec/config.sub delete mode 100755 exec/install-sh diff --git a/.gitignore b/.gitignore index 49f8c57e2d5..29c571a3dcb 100644 --- a/.gitignore +++ b/.gitignore @@ -376,7 +376,10 @@ _gdb_history # Files ignored in exec/. exec/aclocal.m4 +exec/config.guess +exec/config.sub exec/config.status +exec/install-sh exec/loader exec/test exec/exec1 diff --git a/admin/merge-gnulib b/admin/merge-gnulib index edaa1e08b57..5246fb14e1e 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -107,9 +107,6 @@ test -x "$gnulib_srcdir"/gnulib-tool || { # gnulib-tool has problems with a bare checkout (Bug#32452#65). test -f configure || ./autogen.sh || exit -# Old caches can confuse autoconf when some Gnulib-related changes take effect. -rm -fr autom4te.cache || exit - avoided_flags= for module in $AVOIDED_MODULES; do avoided_flags="$avoided_flags --avoid=$module" diff --git a/autogen.sh b/autogen.sh index be41771cae7..f56966ae0d1 100755 --- a/autogen.sh +++ b/autogen.sh @@ -239,6 +239,16 @@ Please report any problems with this script to bug-gnu-emacs@gnu.org .' fi # do_check + # Stale caches can confuse autoconf. + rm -fr autom4te.cache exec/autom4te.cache || exit + + # In build-aux save config.guess, config.sub and install-sh + # in case autoreconf overwrites them, as we rely on the copies + # in Git, which are updated by admin/merge-gnulib. + for file in config.guess config.sub install-sh; do + cp -p build-aux/$file build-aux/$file.tmp || exit + done + # Build aclocal.m4 here so that autoreconf need not use aclocal. # aclocal is part of Automake and might not be installed, and # autoreconf skips aclocal if aclocal.m4 is already supplied. @@ -269,6 +279,12 @@ Please report any problems with this script to bug-gnu-emacs@gnu.org .' # Now, run autoreconf inside the exec directory to generate its # configure script. autoreconf -fi exec || exit + + # Restore config.guess etc. in build-aux, and copy them to exec. + for file in config.guess config.sub install-sh; do + cp build-aux/$file.tmp exec/$file && + mv build-aux/$file.tmp build-aux/$file || exit + done fi diff --git a/exec/config.guess b/exec/config.guess deleted file mode 100755 index 62974adb3dd..00000000000 --- a/exec/config.guess +++ /dev/null @@ -1,1774 +0,0 @@ -#!/usr/bin/sh -# Attempt to guess a canonical system name. -# Copyright 1992-2024 Free Software Foundation, Inc. - -# shellcheck disable=SC2006,SC2268 # see below for rationale - -timestamp='2023-06-23' - -# This file is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, see . -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that -# program. This Exception is an additional permission under section 7 -# of the GNU General Public License, version 3 ("GPLv3"). -# -# Originally written by Per Bothner; maintained since 2000 by Ben Elliston. -# -# You can get the latest version of this script from: -# https://git.savannah.gnu.org/cgit/config.git/plain/config.guess -# -# Please send patches to . - - -# The "shellcheck disable" line above the timestamp inhibits complaints -# about features and limitations of the classic Bourne shell that were -# superseded or lifted in POSIX. However, this script identifies a wide -# variety of pre-POSIX systems that do not have POSIX shells at all, and -# even some reasonably current systems (Solaris 10 as case-in-point) still -# have a pre-POSIX /bin/sh. - - -me=`echo "$0" | sed -e 's,.*/,,'` - -usage="\ -Usage: $0 [OPTION] - -Output the configuration name of the system '$me' is run on. - -Options: - -h, --help print this help, then exit - -t, --time-stamp print date of last modification, then exit - -v, --version print version number, then exit - -Report bugs and patches to ." - -version="\ -GNU config.guess ($timestamp) - -Originally written by Per Bothner. -Copyright 1992-2023 Free Software Foundation, Inc. - -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." - -help=" -Try '$me --help' for more information." - -# Parse command line -while test $# -gt 0 ; do - case $1 in - --time-stamp | --time* | -t ) - echo "$timestamp" ; exit ;; - --version | -v ) - echo "$version" ; exit ;; - --help | --h* | -h ) - echo "$usage"; exit ;; - -- ) # Stop option processing - shift; break ;; - - ) # Use stdin as input. - break ;; - -* ) - echo "$me: invalid option $1$help" >&2 - exit 1 ;; - * ) - break ;; - esac -done - -if test $# != 0; then - echo "$me: too many arguments$help" >&2 - exit 1 -fi - -# Just in case it came from the environment. -GUESS= - -# CC_FOR_BUILD -- compiler used by this script. Note that the use of a -# compiler to aid in system detection is discouraged as it requires -# temporary files to be created and, as you can see below, it is a -# headache to deal with in a portable fashion. - -# Historically, 'CC_FOR_BUILD' used to be named 'HOST_CC'. We still -# use 'HOST_CC' if defined, but it is deprecated. - -# Portable tmp directory creation inspired by the Autoconf team. - -tmp= -# shellcheck disable=SC2172 -trap 'test -z "$tmp" || rm -fr "$tmp"' 0 1 2 13 15 - -set_cc_for_build() { - # prevent multiple calls if $tmp is already set - test "$tmp" && return 0 - : "${TMPDIR=/tmp}" - # shellcheck disable=SC2039,SC3028 - { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || - { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir "$tmp" 2>/dev/null) ; } || - { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir "$tmp" 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } || - { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } - dummy=$tmp/dummy - case ${CC_FOR_BUILD-},${HOST_CC-},${CC-} in - ,,) echo "int x;" > "$dummy.c" - for driver in cc gcc c89 c99 ; do - if ($driver -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then - CC_FOR_BUILD=$driver - break - fi - done - if test x"$CC_FOR_BUILD" = x ; then - CC_FOR_BUILD=no_compiler_found - fi - ;; - ,,*) CC_FOR_BUILD=$CC ;; - ,*,*) CC_FOR_BUILD=$HOST_CC ;; - esac -} - -# This is needed to find uname on a Pyramid OSx when run in the BSD universe. -# (ghazi@noc.rutgers.edu 1994-08-24) -if test -f /.attbin/uname ; then - PATH=$PATH:/.attbin ; export PATH -fi - -UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown -UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown -UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown -UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown - -case $UNAME_SYSTEM in -Linux|GNU|GNU/*) - LIBC=unknown - - set_cc_for_build - cat <<-EOF > "$dummy.c" - #include - #if defined(__UCLIBC__) - LIBC=uclibc - #elif defined(__dietlibc__) - LIBC=dietlibc - #elif defined(__GLIBC__) - LIBC=gnu - #else - #include - /* First heuristic to detect musl libc. */ - #ifdef __DEFINED_va_list - LIBC=musl - #endif - #endif - EOF - cc_set_libc=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g'` - eval "$cc_set_libc" - - # Second heuristic to detect musl libc. - if [ "$LIBC" = unknown ] && - command -v ldd >/dev/null && - ldd --version 2>&1 | grep -q ^musl; then - LIBC=musl - fi - - # If the system lacks a compiler, then just pick glibc. - # We could probably try harder. - if [ "$LIBC" = unknown ]; then - LIBC=gnu - fi - ;; -esac - -# Note: order is significant - the case branches are not exclusive. - -case $UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION in - *:NetBSD:*:*) - # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, - # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently - # switched to ELF, *-*-netbsd* would select the old - # object file format. This provides both forward - # compatibility and a consistent mechanism for selecting the - # object file format. - # - # Note: NetBSD doesn't particularly care about the vendor - # portion of the name. We always set it to "unknown". - UNAME_MACHINE_ARCH=`(uname -p 2>/dev/null || \ - /sbin/sysctl -n hw.machine_arch 2>/dev/null || \ - /usr/sbin/sysctl -n hw.machine_arch 2>/dev/null || \ - echo unknown)` - case $UNAME_MACHINE_ARCH in - aarch64eb) machine=aarch64_be-unknown ;; - armeb) machine=armeb-unknown ;; - arm*) machine=arm-unknown ;; - sh3el) machine=shl-unknown ;; - sh3eb) machine=sh-unknown ;; - sh5el) machine=sh5le-unknown ;; - earmv*) - arch=`echo "$UNAME_MACHINE_ARCH" | sed -e 's,^e\(armv[0-9]\).*$,\1,'` - endian=`echo "$UNAME_MACHINE_ARCH" | sed -ne 's,^.*\(eb\)$,\1,p'` - machine=${arch}${endian}-unknown - ;; - *) machine=$UNAME_MACHINE_ARCH-unknown ;; - esac - # The Operating System including object format, if it has switched - # to ELF recently (or will in the future) and ABI. - case $UNAME_MACHINE_ARCH in - earm*) - os=netbsdelf - ;; - arm*|i386|m68k|ns32k|sh3*|sparc|vax) - set_cc_for_build - if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ELF__ - then - # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). - # Return netbsd for either. FIX? - os=netbsd - else - os=netbsdelf - fi - ;; - *) - os=netbsd - ;; - esac - # Determine ABI tags. - case $UNAME_MACHINE_ARCH in - earm*) - expr='s/^earmv[0-9]/-eabi/;s/eb$//' - abi=`echo "$UNAME_MACHINE_ARCH" | sed -e "$expr"` - ;; - esac - # The OS release - # Debian GNU/NetBSD machines have a different userland, and - # thus, need a distinct triplet. However, they do not need - # kernel version information, so it can be replaced with a - # suitable tag, in the style of linux-gnu. - case $UNAME_VERSION in - Debian*) - release='-gnu' - ;; - *) - release=`echo "$UNAME_RELEASE" | sed -e 's/[-_].*//' | cut -d. -f1,2` - ;; - esac - # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: - # contains redundant information, the shorter form: - # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. - GUESS=$machine-${os}${release}${abi-} - ;; - *:Bitrig:*:*) - UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` - GUESS=$UNAME_MACHINE_ARCH-unknown-bitrig$UNAME_RELEASE - ;; - *:OpenBSD:*:*) - UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` - GUESS=$UNAME_MACHINE_ARCH-unknown-openbsd$UNAME_RELEASE - ;; - *:SecBSD:*:*) - UNAME_MACHINE_ARCH=`arch | sed 's/SecBSD.//'` - GUESS=$UNAME_MACHINE_ARCH-unknown-secbsd$UNAME_RELEASE - ;; - *:LibertyBSD:*:*) - UNAME_MACHINE_ARCH=`arch | sed 's/^.*BSD\.//'` - GUESS=$UNAME_MACHINE_ARCH-unknown-libertybsd$UNAME_RELEASE - ;; - *:MidnightBSD:*:*) - GUESS=$UNAME_MACHINE-unknown-midnightbsd$UNAME_RELEASE - ;; - *:ekkoBSD:*:*) - GUESS=$UNAME_MACHINE-unknown-ekkobsd$UNAME_RELEASE - ;; - *:SolidBSD:*:*) - GUESS=$UNAME_MACHINE-unknown-solidbsd$UNAME_RELEASE - ;; - *:OS108:*:*) - GUESS=$UNAME_MACHINE-unknown-os108_$UNAME_RELEASE - ;; - macppc:MirBSD:*:*) - GUESS=powerpc-unknown-mirbsd$UNAME_RELEASE - ;; - *:MirBSD:*:*) - GUESS=$UNAME_MACHINE-unknown-mirbsd$UNAME_RELEASE - ;; - *:Sortix:*:*) - GUESS=$UNAME_MACHINE-unknown-sortix - ;; - *:Twizzler:*:*) - GUESS=$UNAME_MACHINE-unknown-twizzler - ;; - *:Redox:*:*) - GUESS=$UNAME_MACHINE-unknown-redox - ;; - mips:OSF1:*.*) - GUESS=mips-dec-osf1 - ;; - alpha:OSF1:*:*) - # Reset EXIT trap before exiting to avoid spurious non-zero exit code. - trap '' 0 - case $UNAME_RELEASE in - *4.0) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` - ;; - *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` - ;; - esac - # According to Compaq, /usr/sbin/psrinfo has been available on - # OSF/1 and Tru64 systems produced since 1995. I hope that - # covers most systems running today. This code pipes the CPU - # types through head -n 1, so we only detect the type of CPU 0. - ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` - case $ALPHA_CPU_TYPE in - "EV4 (21064)") - UNAME_MACHINE=alpha ;; - "EV4.5 (21064)") - UNAME_MACHINE=alpha ;; - "LCA4 (21066/21068)") - UNAME_MACHINE=alpha ;; - "EV5 (21164)") - UNAME_MACHINE=alphaev5 ;; - "EV5.6 (21164A)") - UNAME_MACHINE=alphaev56 ;; - "EV5.6 (21164PC)") - UNAME_MACHINE=alphapca56 ;; - "EV5.7 (21164PC)") - UNAME_MACHINE=alphapca57 ;; - "EV6 (21264)") - UNAME_MACHINE=alphaev6 ;; - "EV6.7 (21264A)") - UNAME_MACHINE=alphaev67 ;; - "EV6.8CB (21264C)") - UNAME_MACHINE=alphaev68 ;; - "EV6.8AL (21264B)") - UNAME_MACHINE=alphaev68 ;; - "EV6.8CX (21264D)") - UNAME_MACHINE=alphaev68 ;; - "EV6.9A (21264/EV69A)") - UNAME_MACHINE=alphaev69 ;; - "EV7 (21364)") - UNAME_MACHINE=alphaev7 ;; - "EV7.9 (21364A)") - UNAME_MACHINE=alphaev79 ;; - esac - # A Pn.n version is a patched version. - # A Vn.n version is a released version. - # A Tn.n version is a released field test version. - # A Xn.n version is an unreleased experimental baselevel. - # 1.2 uses "1.2" for uname -r. - OSF_REL=`echo "$UNAME_RELEASE" | sed -e 's/^[PVTX]//' | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz` - GUESS=$UNAME_MACHINE-dec-osf$OSF_REL - ;; - Amiga*:UNIX_System_V:4.0:*) - GUESS=m68k-unknown-sysv4 - ;; - *:[Aa]miga[Oo][Ss]:*:*) - GUESS=$UNAME_MACHINE-unknown-amigaos - ;; - *:[Mm]orph[Oo][Ss]:*:*) - GUESS=$UNAME_MACHINE-unknown-morphos - ;; - *:OS/390:*:*) - GUESS=i370-ibm-openedition - ;; - *:z/VM:*:*) - GUESS=s390-ibm-zvmoe - ;; - *:OS400:*:*) - GUESS=powerpc-ibm-os400 - ;; - arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) - GUESS=arm-acorn-riscix$UNAME_RELEASE - ;; - arm*:riscos:*:*|arm*:RISCOS:*:*) - GUESS=arm-unknown-riscos - ;; - SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) - GUESS=hppa1.1-hitachi-hiuxmpp - ;; - Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) - # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. - case `(/bin/universe) 2>/dev/null` in - att) GUESS=pyramid-pyramid-sysv3 ;; - *) GUESS=pyramid-pyramid-bsd ;; - esac - ;; - NILE*:*:*:dcosx) - GUESS=pyramid-pyramid-svr4 - ;; - DRS?6000:unix:4.0:6*) - GUESS=sparc-icl-nx6 - ;; - DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) - case `/usr/bin/uname -p` in - sparc) GUESS=sparc-icl-nx7 ;; - esac - ;; - s390x:SunOS:*:*) - SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` - GUESS=$UNAME_MACHINE-ibm-solaris2$SUN_REL - ;; - sun4H:SunOS:5.*:*) - SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` - GUESS=sparc-hal-solaris2$SUN_REL - ;; - sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) - SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` - GUESS=sparc-sun-solaris2$SUN_REL - ;; - i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) - GUESS=i386-pc-auroraux$UNAME_RELEASE - ;; - i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) - set_cc_for_build - SUN_ARCH=i386 - # If there is a compiler, see if it is configured for 64-bit objects. - # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. - # This test works for both compilers. - if test "$CC_FOR_BUILD" != no_compiler_found; then - if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ - (CCOPTS="" $CC_FOR_BUILD -m64 -E - 2>/dev/null) | \ - grep IS_64BIT_ARCH >/dev/null - then - SUN_ARCH=x86_64 - fi - fi - SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` - GUESS=$SUN_ARCH-pc-solaris2$SUN_REL - ;; - sun4*:SunOS:6*:*) - # According to config.sub, this is the proper way to canonicalize - # SunOS6. Hard to guess exactly what SunOS6 will be like, but - # it's likely to be more like Solaris than SunOS4. - SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` - GUESS=sparc-sun-solaris3$SUN_REL - ;; - sun4*:SunOS:*:*) - case `/usr/bin/arch -k` in - Series*|S4*) - UNAME_RELEASE=`uname -v` - ;; - esac - # Japanese Language versions have a version number like '4.1.3-JL'. - SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/-/_/'` - GUESS=sparc-sun-sunos$SUN_REL - ;; - sun3*:SunOS:*:*) - GUESS=m68k-sun-sunos$UNAME_RELEASE - ;; - sun*:*:4.2BSD:*) - UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` - test "x$UNAME_RELEASE" = x && UNAME_RELEASE=3 - case `/bin/arch` in - sun3) - GUESS=m68k-sun-sunos$UNAME_RELEASE - ;; - sun4) - GUESS=sparc-sun-sunos$UNAME_RELEASE - ;; - esac - ;; - aushp:SunOS:*:*) - GUESS=sparc-auspex-sunos$UNAME_RELEASE - ;; - # The situation for MiNT is a little confusing. The machine name - # can be virtually everything (everything which is not - # "atarist" or "atariste" at least should have a processor - # > m68000). The system name ranges from "MiNT" over "FreeMiNT" - # to the lowercase version "mint" (or "freemint"). Finally - # the system name "TOS" denotes a system which is actually not - # MiNT. But MiNT is downward compatible to TOS, so this should - # be no problem. - atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - GUESS=m68k-atari-mint$UNAME_RELEASE - ;; - atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) - GUESS=m68k-atari-mint$UNAME_RELEASE - ;; - *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - GUESS=m68k-atari-mint$UNAME_RELEASE - ;; - milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - GUESS=m68k-milan-mint$UNAME_RELEASE - ;; - hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - GUESS=m68k-hades-mint$UNAME_RELEASE - ;; - *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - GUESS=m68k-unknown-mint$UNAME_RELEASE - ;; - m68k:machten:*:*) - GUESS=m68k-apple-machten$UNAME_RELEASE - ;; - powerpc:machten:*:*) - GUESS=powerpc-apple-machten$UNAME_RELEASE - ;; - RISC*:Mach:*:*) - GUESS=mips-dec-mach_bsd4.3 - ;; - RISC*:ULTRIX:*:*) - GUESS=mips-dec-ultrix$UNAME_RELEASE - ;; - VAX*:ULTRIX*:*:*) - GUESS=vax-dec-ultrix$UNAME_RELEASE - ;; - 2020:CLIX:*:* | 2430:CLIX:*:*) - GUESS=clipper-intergraph-clix$UNAME_RELEASE - ;; - mips:*:*:UMIPS | mips:*:*:RISCos) - set_cc_for_build - sed 's/^ //' << EOF > "$dummy.c" -#ifdef __cplusplus -#include /* for printf() prototype */ - int main (int argc, char *argv[]) { -#else - int main (argc, argv) int argc; char *argv[]; { -#endif - #if defined (host_mips) && defined (MIPSEB) - #if defined (SYSTYPE_SYSV) - printf ("mips-mips-riscos%ssysv\\n", argv[1]); exit (0); - #endif - #if defined (SYSTYPE_SVR4) - printf ("mips-mips-riscos%ssvr4\\n", argv[1]); exit (0); - #endif - #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) - printf ("mips-mips-riscos%sbsd\\n", argv[1]); exit (0); - #endif - #endif - exit (-1); - } -EOF - $CC_FOR_BUILD -o "$dummy" "$dummy.c" && - dummyarg=`echo "$UNAME_RELEASE" | sed -n 's/\([0-9]*\).*/\1/p'` && - SYSTEM_NAME=`"$dummy" "$dummyarg"` && - { echo "$SYSTEM_NAME"; exit; } - GUESS=mips-mips-riscos$UNAME_RELEASE - ;; - Motorola:PowerMAX_OS:*:*) - GUESS=powerpc-motorola-powermax - ;; - Motorola:*:4.3:PL8-*) - GUESS=powerpc-harris-powermax - ;; - Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) - GUESS=powerpc-harris-powermax - ;; - Night_Hawk:Power_UNIX:*:*) - GUESS=powerpc-harris-powerunix - ;; - m88k:CX/UX:7*:*) - GUESS=m88k-harris-cxux7 - ;; - m88k:*:4*:R4*) - GUESS=m88k-motorola-sysv4 - ;; - m88k:*:3*:R3*) - GUESS=m88k-motorola-sysv3 - ;; - AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` - if test "$UNAME_PROCESSOR" = mc88100 || test "$UNAME_PROCESSOR" = mc88110 - then - if test "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx || \ - test "$TARGET_BINARY_INTERFACE"x = x - then - GUESS=m88k-dg-dgux$UNAME_RELEASE - else - GUESS=m88k-dg-dguxbcs$UNAME_RELEASE - fi - else - GUESS=i586-dg-dgux$UNAME_RELEASE - fi - ;; - M88*:DolphinOS:*:*) # DolphinOS (SVR3) - GUESS=m88k-dolphin-sysv3 - ;; - M88*:*:R3*:*) - # Delta 88k system running SVR3 - GUESS=m88k-motorola-sysv3 - ;; - XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) - GUESS=m88k-tektronix-sysv3 - ;; - Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) - GUESS=m68k-tektronix-bsd - ;; - *:IRIX*:*:*) - IRIX_REL=`echo "$UNAME_RELEASE" | sed -e 's/-/_/g'` - GUESS=mips-sgi-irix$IRIX_REL - ;; - ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. - GUESS=romp-ibm-aix # uname -m gives an 8 hex-code CPU id - ;; # Note that: echo "'`uname -s`'" gives 'AIX ' - i*86:AIX:*:*) - GUESS=i386-ibm-aix - ;; - ia64:AIX:*:*) - if test -x /usr/bin/oslevel ; then - IBM_REV=`/usr/bin/oslevel` - else - IBM_REV=$UNAME_VERSION.$UNAME_RELEASE - fi - GUESS=$UNAME_MACHINE-ibm-aix$IBM_REV - ;; - *:AIX:2:3) - if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then - set_cc_for_build - sed 's/^ //' << EOF > "$dummy.c" - #include - - main() - { - if (!__power_pc()) - exit(1); - puts("powerpc-ibm-aix3.2.5"); - exit(0); - } -EOF - if $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` - then - GUESS=$SYSTEM_NAME - else - GUESS=rs6000-ibm-aix3.2.5 - fi - elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then - GUESS=rs6000-ibm-aix3.2.4 - else - GUESS=rs6000-ibm-aix3.2 - fi - ;; - *:AIX:*:[4567]) - IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` - if /usr/sbin/lsattr -El "$IBM_CPU_ID" | grep ' POWER' >/dev/null 2>&1; then - IBM_ARCH=rs6000 - else - IBM_ARCH=powerpc - fi - if test -x /usr/bin/lslpp ; then - IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc | \ - awk -F: '{ print $3 }' | sed s/[0-9]*$/0/` - else - IBM_REV=$UNAME_VERSION.$UNAME_RELEASE - fi - GUESS=$IBM_ARCH-ibm-aix$IBM_REV - ;; - *:AIX:*:*) - GUESS=rs6000-ibm-aix - ;; - ibmrt:4.4BSD:*|romp-ibm:4.4BSD:*) - GUESS=romp-ibm-bsd4.4 - ;; - ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and - GUESS=romp-ibm-bsd$UNAME_RELEASE # 4.3 with uname added to - ;; # report: romp-ibm BSD 4.3 - *:BOSX:*:*) - GUESS=rs6000-bull-bosx - ;; - DPX/2?00:B.O.S.:*:*) - GUESS=m68k-bull-sysv3 - ;; - 9000/[34]??:4.3bsd:1.*:*) - GUESS=m68k-hp-bsd - ;; - hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) - GUESS=m68k-hp-bsd4.4 - ;; - 9000/[34678]??:HP-UX:*:*) - HPUX_REV=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*.[0B]*//'` - case $UNAME_MACHINE in - 9000/31?) HP_ARCH=m68000 ;; - 9000/[34]??) HP_ARCH=m68k ;; - 9000/[678][0-9][0-9]) - if test -x /usr/bin/getconf; then - sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case $sc_cpu_version in - 523) HP_ARCH=hppa1.0 ;; # CPU_PA_RISC1_0 - 528) HP_ARCH=hppa1.1 ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case $sc_kernel_bits in - 32) HP_ARCH=hppa2.0n ;; - 64) HP_ARCH=hppa2.0w ;; - '') HP_ARCH=hppa2.0 ;; # HP-UX 10.20 - esac ;; - esac - fi - if test "$HP_ARCH" = ""; then - set_cc_for_build - sed 's/^ //' << EOF > "$dummy.c" - - #define _HPUX_SOURCE - #include - #include - - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); - - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } -EOF - (CCOPTS="" $CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null) && HP_ARCH=`"$dummy"` - test -z "$HP_ARCH" && HP_ARCH=hppa - fi ;; - esac - if test "$HP_ARCH" = hppa2.0w - then - set_cc_for_build - - # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating - # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler - # generating 64-bit code. GNU and HP use different nomenclature: - # - # $ CC_FOR_BUILD=cc ./config.guess - # => hppa2.0w-hp-hpux11.23 - # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess - # => hppa64-hp-hpux11.23 - - if echo __LP64__ | (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | - grep -q __LP64__ - then - HP_ARCH=hppa2.0w - else - HP_ARCH=hppa64 - fi - fi - GUESS=$HP_ARCH-hp-hpux$HPUX_REV - ;; - ia64:HP-UX:*:*) - HPUX_REV=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*.[0B]*//'` - GUESS=ia64-hp-hpux$HPUX_REV - ;; - 3050*:HI-UX:*:*) - set_cc_for_build - sed 's/^ //' << EOF > "$dummy.c" - #include - int - main () - { - long cpu = sysconf (_SC_CPU_VERSION); - /* The order matters, because CPU_IS_HP_MC68K erroneously returns - true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct - results, however. */ - if (CPU_IS_PA_RISC (cpu)) - { - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; - case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; - default: puts ("hppa-hitachi-hiuxwe2"); break; - } - } - else if (CPU_IS_HP_MC68K (cpu)) - puts ("m68k-hitachi-hiuxwe2"); - else puts ("unknown-hitachi-hiuxwe2"); - exit (0); - } -EOF - $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` && - { echo "$SYSTEM_NAME"; exit; } - GUESS=unknown-hitachi-hiuxwe2 - ;; - 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:*) - GUESS=hppa1.1-hp-bsd - ;; - 9000/8??:4.3bsd:*:*) - GUESS=hppa1.0-hp-bsd - ;; - *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) - GUESS=hppa1.0-hp-mpeix - ;; - hp7??:OSF1:*:* | hp8?[79]:OSF1:*:*) - GUESS=hppa1.1-hp-osf - ;; - hp8??:OSF1:*:*) - GUESS=hppa1.0-hp-osf - ;; - i*86:OSF1:*:*) - if test -x /usr/sbin/sysversion ; then - GUESS=$UNAME_MACHINE-unknown-osf1mk - else - GUESS=$UNAME_MACHINE-unknown-osf1 - fi - ;; - parisc*:Lites*:*:*) - GUESS=hppa1.1-hp-lites - ;; - C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) - GUESS=c1-convex-bsd - ;; - C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) - if getsysinfo -f scalar_acc - then echo c32-convex-bsd - else echo c2-convex-bsd - fi - exit ;; - C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) - GUESS=c34-convex-bsd - ;; - C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) - GUESS=c38-convex-bsd - ;; - C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) - GUESS=c4-convex-bsd - ;; - CRAY*Y-MP:*:*:*) - CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` - GUESS=ymp-cray-unicos$CRAY_REL - ;; - CRAY*[A-Z]90:*:*:*) - echo "$UNAME_MACHINE"-cray-unicos"$UNAME_RELEASE" \ - | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ - -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ - -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*TS:*:*:*) - CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` - GUESS=t90-cray-unicos$CRAY_REL - ;; - CRAY*T3E:*:*:*) - CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` - GUESS=alphaev5-cray-unicosmk$CRAY_REL - ;; - CRAY*SV1:*:*:*) - CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` - GUESS=sv1-cray-unicos$CRAY_REL - ;; - *:UNICOS/mp:*:*) - CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` - GUESS=craynv-cray-unicosmp$CRAY_REL - ;; - F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) - FUJITSU_PROC=`uname -m | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz` - FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'` - FUJITSU_REL=`echo "$UNAME_RELEASE" | sed -e 's/ /_/'` - GUESS=${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL} - ;; - 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'` - FUJITSU_REL=`echo "$UNAME_RELEASE" | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/ /_/'` - GUESS=sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL} - ;; - i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) - GUESS=$UNAME_MACHINE-pc-bsdi$UNAME_RELEASE - ;; - sparc*:BSD/OS:*:*) - GUESS=sparc-unknown-bsdi$UNAME_RELEASE - ;; - *:BSD/OS:*:*) - GUESS=$UNAME_MACHINE-unknown-bsdi$UNAME_RELEASE - ;; - arm:FreeBSD:*:*) - UNAME_PROCESSOR=`uname -p` - set_cc_for_build - if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ARM_PCS_VFP - then - FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` - GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL-gnueabi - else - FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` - GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL-gnueabihf - fi - ;; - *:FreeBSD:*:*) - UNAME_PROCESSOR=`/usr/bin/uname -p` - case $UNAME_PROCESSOR in - amd64) - UNAME_PROCESSOR=x86_64 ;; - i386) - UNAME_PROCESSOR=i586 ;; - esac - FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` - GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL - ;; - i*:CYGWIN*:*) - GUESS=$UNAME_MACHINE-pc-cygwin - ;; - *:MINGW64*:*) - GUESS=$UNAME_MACHINE-pc-mingw64 - ;; - *:MINGW*:*) - GUESS=$UNAME_MACHINE-pc-mingw32 - ;; - *:MSYS*:*) - GUESS=$UNAME_MACHINE-pc-msys - ;; - i*:PW*:*) - GUESS=$UNAME_MACHINE-pc-pw32 - ;; - *:SerenityOS:*:*) - GUESS=$UNAME_MACHINE-pc-serenity - ;; - *:Interix*:*) - case $UNAME_MACHINE in - x86) - GUESS=i586-pc-interix$UNAME_RELEASE - ;; - authenticamd | genuineintel | EM64T) - GUESS=x86_64-unknown-interix$UNAME_RELEASE - ;; - IA64) - GUESS=ia64-unknown-interix$UNAME_RELEASE - ;; - esac ;; - i*:UWIN*:*) - GUESS=$UNAME_MACHINE-pc-uwin - ;; - amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) - GUESS=x86_64-pc-cygwin - ;; - prep*:SunOS:5.*:*) - SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` - GUESS=powerpcle-unknown-solaris2$SUN_REL - ;; - *:GNU:*:*) - # the GNU system - GNU_ARCH=`echo "$UNAME_MACHINE" | sed -e 's,[-/].*$,,'` - GNU_REL=`echo "$UNAME_RELEASE" | sed -e 's,/.*$,,'` - GUESS=$GNU_ARCH-unknown-$LIBC$GNU_REL - ;; - *:GNU/*:*:*) - # other systems with GNU libc and userland - GNU_SYS=`echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]"` - GNU_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` - GUESS=$UNAME_MACHINE-unknown-$GNU_SYS$GNU_REL-$LIBC - ;; - x86_64:[Mm]anagarm:*:*|i?86:[Mm]anagarm:*:*) - GUESS="$UNAME_MACHINE-pc-managarm-mlibc" - ;; - *:[Mm]anagarm:*:*) - GUESS="$UNAME_MACHINE-unknown-managarm-mlibc" - ;; - *:Minix:*:*) - GUESS=$UNAME_MACHINE-unknown-minix - ;; - aarch64:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - aarch64_be:Linux:*:*) - UNAME_MACHINE=aarch64_be - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' /proc/cpuinfo 2>/dev/null` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep -q ld.so.1 - if test "$?" = 0 ; then LIBC=gnulibc1 ; fi - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - arc:Linux:*:* | arceb:Linux:*:* | arc32:Linux:*:* | arc64:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - arm*:Linux:*:*) - set_cc_for_build - if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ARM_EABI__ - then - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - else - if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ARM_PCS_VFP - then - GUESS=$UNAME_MACHINE-unknown-linux-${LIBC}eabi - else - GUESS=$UNAME_MACHINE-unknown-linux-${LIBC}eabihf - fi - fi - ;; - avr32*:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - cris:Linux:*:*) - GUESS=$UNAME_MACHINE-axis-linux-$LIBC - ;; - crisv32:Linux:*:*) - GUESS=$UNAME_MACHINE-axis-linux-$LIBC - ;; - e2k:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - frv:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - hexagon:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - i*86:Linux:*:*) - GUESS=$UNAME_MACHINE-pc-linux-$LIBC - ;; - ia64:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - k1om:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - loongarch32:Linux:*:* | loongarch64:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - m32r*:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - m68*:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - mips:Linux:*:* | mips64:Linux:*:*) - set_cc_for_build - IS_GLIBC=0 - test x"${LIBC}" = xgnu && IS_GLIBC=1 - sed 's/^ //' << EOF > "$dummy.c" - #undef CPU - #undef mips - #undef mipsel - #undef mips64 - #undef mips64el - #if ${IS_GLIBC} && defined(_ABI64) - LIBCABI=gnuabi64 - #else - #if ${IS_GLIBC} && defined(_ABIN32) - LIBCABI=gnuabin32 - #else - LIBCABI=${LIBC} - #endif - #endif - - #if ${IS_GLIBC} && defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6 - CPU=mipsisa64r6 - #else - #if ${IS_GLIBC} && !defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6 - CPU=mipsisa32r6 - #else - #if defined(__mips64) - CPU=mips64 - #else - CPU=mips - #endif - #endif - #endif - - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - MIPS_ENDIAN=el - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - MIPS_ENDIAN= - #else - MIPS_ENDIAN= - #endif - #endif -EOF - cc_set_vars=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU\|^MIPS_ENDIAN\|^LIBCABI'` - eval "$cc_set_vars" - test "x$CPU" != x && { echo "$CPU${MIPS_ENDIAN}-unknown-linux-$LIBCABI"; exit; } - ;; - mips64el:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - openrisc*:Linux:*:*) - GUESS=or1k-unknown-linux-$LIBC - ;; - or32:Linux:*:* | or1k*:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - padre:Linux:*:*) - GUESS=sparc-unknown-linux-$LIBC - ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - GUESS=hppa64-unknown-linux-$LIBC - ;; - parisc:Linux:*:* | hppa:Linux:*:*) - # Look for CPU level - case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in - PA7*) GUESS=hppa1.1-unknown-linux-$LIBC ;; - PA8*) GUESS=hppa2.0-unknown-linux-$LIBC ;; - *) GUESS=hppa-unknown-linux-$LIBC ;; - esac - ;; - ppc64:Linux:*:*) - GUESS=powerpc64-unknown-linux-$LIBC - ;; - ppc:Linux:*:*) - GUESS=powerpc-unknown-linux-$LIBC - ;; - ppc64le:Linux:*:*) - GUESS=powerpc64le-unknown-linux-$LIBC - ;; - ppcle:Linux:*:*) - GUESS=powerpcle-unknown-linux-$LIBC - ;; - riscv32:Linux:*:* | riscv32be:Linux:*:* | riscv64:Linux:*:* | riscv64be:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - s390:Linux:*:* | s390x:Linux:*:*) - GUESS=$UNAME_MACHINE-ibm-linux-$LIBC - ;; - sh64*:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - sh*:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - sparc:Linux:*:* | sparc64:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - tile*:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - vax:Linux:*:*) - GUESS=$UNAME_MACHINE-dec-linux-$LIBC - ;; - x86_64:Linux:*:*) - set_cc_for_build - CPU=$UNAME_MACHINE - LIBCABI=$LIBC - if test "$CC_FOR_BUILD" != no_compiler_found; then - ABI=64 - sed 's/^ //' << EOF > "$dummy.c" - #ifdef __i386__ - ABI=x86 - #else - #ifdef __ILP32__ - ABI=x32 - #endif - #endif -EOF - cc_set_abi=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^ABI' | sed 's, ,,g'` - eval "$cc_set_abi" - case $ABI in - x86) CPU=i686 ;; - x32) LIBCABI=${LIBC}x32 ;; - esac - fi - GUESS=$CPU-pc-linux-$LIBCABI - ;; - xtensa*:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC - ;; - i*86:DYNIX/ptx:4*:*) - # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. - # earlier versions are messed up and put the nodename in both - # sysname and nodename. - GUESS=i386-sequent-sysv4 - ;; - i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, - # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. - GUESS=$UNAME_MACHINE-pc-sysv4.2uw$UNAME_VERSION - ;; - i*86:OS/2:*:*) - # If we were able to find 'uname', then EMX Unix compatibility - # is probably installed. - GUESS=$UNAME_MACHINE-pc-os2-emx - ;; - i*86:XTS-300:*:STOP) - GUESS=$UNAME_MACHINE-unknown-stop - ;; - i*86:atheos:*:*) - GUESS=$UNAME_MACHINE-unknown-atheos - ;; - i*86:syllable:*:*) - GUESS=$UNAME_MACHINE-pc-syllable - ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) - GUESS=i386-unknown-lynxos$UNAME_RELEASE - ;; - i*86:*DOS:*:*) - GUESS=$UNAME_MACHINE-pc-msdosdjgpp - ;; - i*86:*:4.*:*) - UNAME_REL=`echo "$UNAME_RELEASE" | sed 's/\/MP$//'` - if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then - GUESS=$UNAME_MACHINE-univel-sysv$UNAME_REL - else - GUESS=$UNAME_MACHINE-pc-sysv$UNAME_REL - fi - ;; - i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. - case `/bin/uname -X | grep "^Machine"` in - *486*) UNAME_MACHINE=i486 ;; - *Pentium) UNAME_MACHINE=i586 ;; - *Pent*|*Celeron) UNAME_MACHINE=i686 ;; - esac - GUESS=$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} - ;; - i*86:*:3.2:*) - if test -f /usr/options/cb.name; then - UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then - UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` - (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 - (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ - && UNAME_MACHINE=i586 - (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ - && UNAME_MACHINE=i686 - (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ - && UNAME_MACHINE=i686 - GUESS=$UNAME_MACHINE-pc-sco$UNAME_REL - else - GUESS=$UNAME_MACHINE-pc-sysv32 - fi - ;; - pc:*:*:*) - # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i586. - # Note: whatever this is, it MUST be the same as what config.sub - # prints for the "djgpp" host, or else GDB configure will decide that - # this is a cross-build. - GUESS=i586-pc-msdosdjgpp - ;; - Intel:Mach:3*:*) - GUESS=i386-pc-mach3 - ;; - paragon:*:*:*) - GUESS=i860-intel-osf1 - ;; - i860:*:4.*:*) # i860-SVR4 - if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then - GUESS=i860-stardent-sysv$UNAME_RELEASE # Stardent Vistra i860-SVR4 - else # Add other i860-SVR4 vendors below as they are discovered. - GUESS=i860-unknown-sysv$UNAME_RELEASE # Unknown i860-SVR4 - fi - ;; - mini*:CTIX:SYS*5:*) - # "miniframe" - GUESS=m68010-convergent-sysv - ;; - mc68k:UNIX:SYSTEM5:3.51m) - GUESS=m68k-convergent-sysv - ;; - M680?0:D-NIX:5.3:*) - GUESS=m68k-diab-dnix - ;; - M68*:*:R3V[5678]*:*) - test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; - 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) - OS_REL='' - test -r /etc/.relid \ - && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4.3"$OS_REL"; exit; } - /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ - && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;; - 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; - NCR*:*:4.2:* | MPRAS*:*:4.2:*) - OS_REL='.3' - test -r /etc/.relid \ - && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4.3"$OS_REL"; exit; } - /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ - && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } - /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ - && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;; - m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) - GUESS=m68k-unknown-lynxos$UNAME_RELEASE - ;; - mc68030:UNIX_System_V:4.*:*) - GUESS=m68k-atari-sysv4 - ;; - TSUNAMI:LynxOS:2.*:*) - GUESS=sparc-unknown-lynxos$UNAME_RELEASE - ;; - rs6000:LynxOS:2.*:*) - GUESS=rs6000-unknown-lynxos$UNAME_RELEASE - ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) - GUESS=powerpc-unknown-lynxos$UNAME_RELEASE - ;; - SM[BE]S:UNIX_SV:*:*) - GUESS=mips-dde-sysv$UNAME_RELEASE - ;; - RM*:ReliantUNIX-*:*:*) - GUESS=mips-sni-sysv4 - ;; - RM*:SINIX-*:*:*) - GUESS=mips-sni-sysv4 - ;; - *:SINIX-*:*:*) - if uname -p 2>/dev/null >/dev/null ; then - UNAME_MACHINE=`(uname -p) 2>/dev/null` - GUESS=$UNAME_MACHINE-sni-sysv4 - else - GUESS=ns32k-sni-sysv - fi - ;; - PENTIUM:*:4.0*:*) # Unisys 'ClearPath HMP IX 4000' SVR4/MP effort - # says - GUESS=i586-unisys-sysv4 - ;; - *:UNIX_System_V:4*:FTX*) - # From Gerald Hewes . - # How about differentiating between stratus architectures? -djm - GUESS=hppa1.1-stratus-sysv4 - ;; - *:*:*:FTX*) - # From seanf@swdc.stratus.com. - GUESS=i860-stratus-sysv4 - ;; - i*86:VOS:*:*) - # From Paul.Green@stratus.com. - GUESS=$UNAME_MACHINE-stratus-vos - ;; - *:VOS:*:*) - # From Paul.Green@stratus.com. - GUESS=hppa1.1-stratus-vos - ;; - mc68*:A/UX:*:*) - GUESS=m68k-apple-aux$UNAME_RELEASE - ;; - news*:NEWS-OS:6*:*) - GUESS=mips-sony-newsos6 - ;; - R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) - if test -d /usr/nec; then - GUESS=mips-nec-sysv$UNAME_RELEASE - else - GUESS=mips-unknown-sysv$UNAME_RELEASE - fi - ;; - BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. - GUESS=powerpc-be-beos - ;; - BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. - GUESS=powerpc-apple-beos - ;; - BePC:BeOS:*:*) # BeOS running on Intel PC compatible. - GUESS=i586-pc-beos - ;; - BePC:Haiku:*:*) # Haiku running on Intel PC compatible. - GUESS=i586-pc-haiku - ;; - ppc:Haiku:*:*) # Haiku running on Apple PowerPC - GUESS=powerpc-apple-haiku - ;; - *:Haiku:*:*) # Haiku modern gcc (not bound by BeOS compat) - GUESS=$UNAME_MACHINE-unknown-haiku - ;; - SX-4:SUPER-UX:*:*) - GUESS=sx4-nec-superux$UNAME_RELEASE - ;; - SX-5:SUPER-UX:*:*) - GUESS=sx5-nec-superux$UNAME_RELEASE - ;; - SX-6:SUPER-UX:*:*) - GUESS=sx6-nec-superux$UNAME_RELEASE - ;; - SX-7:SUPER-UX:*:*) - GUESS=sx7-nec-superux$UNAME_RELEASE - ;; - SX-8:SUPER-UX:*:*) - GUESS=sx8-nec-superux$UNAME_RELEASE - ;; - SX-8R:SUPER-UX:*:*) - GUESS=sx8r-nec-superux$UNAME_RELEASE - ;; - SX-ACE:SUPER-UX:*:*) - GUESS=sxace-nec-superux$UNAME_RELEASE - ;; - Power*:Rhapsody:*:*) - GUESS=powerpc-apple-rhapsody$UNAME_RELEASE - ;; - *:Rhapsody:*:*) - GUESS=$UNAME_MACHINE-apple-rhapsody$UNAME_RELEASE - ;; - arm64:Darwin:*:*) - GUESS=aarch64-apple-darwin$UNAME_RELEASE - ;; - *:Darwin:*:*) - UNAME_PROCESSOR=`uname -p` - case $UNAME_PROCESSOR in - unknown) UNAME_PROCESSOR=powerpc ;; - esac - if command -v xcode-select > /dev/null 2> /dev/null && \ - ! xcode-select --print-path > /dev/null 2> /dev/null ; then - # Avoid executing cc if there is no toolchain installed as - # cc will be a stub that puts up a graphical alert - # prompting the user to install developer tools. - CC_FOR_BUILD=no_compiler_found - else - set_cc_for_build - fi - if test "$CC_FOR_BUILD" != no_compiler_found; then - if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ - (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ - grep IS_64BIT_ARCH >/dev/null - then - case $UNAME_PROCESSOR in - i386) UNAME_PROCESSOR=x86_64 ;; - powerpc) UNAME_PROCESSOR=powerpc64 ;; - esac - fi - # On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc - if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') | \ - (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ - grep IS_PPC >/dev/null - then - UNAME_PROCESSOR=powerpc - fi - elif test "$UNAME_PROCESSOR" = i386 ; then - # uname -m returns i386 or x86_64 - UNAME_PROCESSOR=$UNAME_MACHINE - fi - GUESS=$UNAME_PROCESSOR-apple-darwin$UNAME_RELEASE - ;; - *:procnto*:*:* | *:QNX:[0123456789]*:*) - UNAME_PROCESSOR=`uname -p` - if test "$UNAME_PROCESSOR" = x86; then - UNAME_PROCESSOR=i386 - UNAME_MACHINE=pc - fi - GUESS=$UNAME_PROCESSOR-$UNAME_MACHINE-nto-qnx$UNAME_RELEASE - ;; - *:QNX:*:4*) - GUESS=i386-pc-qnx - ;; - NEO-*:NONSTOP_KERNEL:*:*) - GUESS=neo-tandem-nsk$UNAME_RELEASE - ;; - NSE-*:NONSTOP_KERNEL:*:*) - GUESS=nse-tandem-nsk$UNAME_RELEASE - ;; - NSR-*:NONSTOP_KERNEL:*:*) - GUESS=nsr-tandem-nsk$UNAME_RELEASE - ;; - NSV-*:NONSTOP_KERNEL:*:*) - GUESS=nsv-tandem-nsk$UNAME_RELEASE - ;; - NSX-*:NONSTOP_KERNEL:*:*) - GUESS=nsx-tandem-nsk$UNAME_RELEASE - ;; - *:NonStop-UX:*:*) - GUESS=mips-compaq-nonstopux - ;; - BS2000:POSIX*:*:*) - GUESS=bs2000-siemens-sysv - ;; - DS/*:UNIX_System_V:*:*) - GUESS=$UNAME_MACHINE-$UNAME_SYSTEM-$UNAME_RELEASE - ;; - *:Plan9:*:*) - # "uname -m" is not consistent, so use $cputype instead. 386 - # is converted to i386 for consistency with other x86 - # operating systems. - if test "${cputype-}" = 386; then - UNAME_MACHINE=i386 - elif test "x${cputype-}" != x; then - UNAME_MACHINE=$cputype - fi - GUESS=$UNAME_MACHINE-unknown-plan9 - ;; - *:TOPS-10:*:*) - GUESS=pdp10-unknown-tops10 - ;; - *:TENEX:*:*) - GUESS=pdp10-unknown-tenex - ;; - KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) - GUESS=pdp10-dec-tops20 - ;; - XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) - GUESS=pdp10-xkl-tops20 - ;; - *:TOPS-20:*:*) - GUESS=pdp10-unknown-tops20 - ;; - *:ITS:*:*) - GUESS=pdp10-unknown-its - ;; - SEI:*:*:SEIUX) - GUESS=mips-sei-seiux$UNAME_RELEASE - ;; - *:DragonFly:*:*) - DRAGONFLY_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` - GUESS=$UNAME_MACHINE-unknown-dragonfly$DRAGONFLY_REL - ;; - *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` - case $UNAME_MACHINE in - A*) GUESS=alpha-dec-vms ;; - I*) GUESS=ia64-dec-vms ;; - V*) GUESS=vax-dec-vms ;; - esac ;; - *:XENIX:*:SysV) - GUESS=i386-pc-xenix - ;; - i*86:skyos:*:*) - SKYOS_REL=`echo "$UNAME_RELEASE" | sed -e 's/ .*$//'` - GUESS=$UNAME_MACHINE-pc-skyos$SKYOS_REL - ;; - i*86:rdos:*:*) - GUESS=$UNAME_MACHINE-pc-rdos - ;; - i*86:Fiwix:*:*) - GUESS=$UNAME_MACHINE-pc-fiwix - ;; - *:AROS:*:*) - GUESS=$UNAME_MACHINE-unknown-aros - ;; - x86_64:VMkernel:*:*) - GUESS=$UNAME_MACHINE-unknown-esx - ;; - amd64:Isilon\ OneFS:*:*) - GUESS=x86_64-unknown-onefs - ;; - *:Unleashed:*:*) - GUESS=$UNAME_MACHINE-unknown-unleashed$UNAME_RELEASE - ;; -esac - -# Do we have a guess based on uname results? -if test "x$GUESS" != x; then - echo "$GUESS" - exit -fi - -# No uname command or uname output not recognized. -set_cc_for_build -cat > "$dummy.c" < -#include -#endif -#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__) -#if defined (vax) || defined (__vax) || defined (__vax__) || defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__) -#include -#if defined(_SIZE_T_) || defined(SIGLOST) -#include -#endif -#endif -#endif -main () -{ -#if defined (sony) -#if defined (MIPSEB) - /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, - I don't know.... */ - printf ("mips-sony-bsd\n"); exit (0); -#else -#include - printf ("m68k-sony-newsos%s\n", -#ifdef NEWSOS4 - "4" -#else - "" -#endif - ); exit (0); -#endif -#endif - -#if defined (NeXT) -#if !defined (__ARCHITECTURE__) -#define __ARCHITECTURE__ "m68k" -#endif - int version; - version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; - if (version < 4) - printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); - else - printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); - exit (0); -#endif - -#if defined (MULTIMAX) || defined (n16) -#if defined (UMAXV) - printf ("ns32k-encore-sysv\n"); exit (0); -#else -#if defined (CMU) - printf ("ns32k-encore-mach\n"); exit (0); -#else - printf ("ns32k-encore-bsd\n"); exit (0); -#endif -#endif -#endif - -#if defined (__386BSD__) - printf ("i386-pc-bsd\n"); exit (0); -#endif - -#if defined (sequent) -#if defined (i386) - printf ("i386-sequent-dynix\n"); exit (0); -#endif -#if defined (ns32000) - printf ("ns32k-sequent-dynix\n"); exit (0); -#endif -#endif - -#if defined (_SEQUENT_) - struct utsname un; - - uname(&un); - if (strncmp(un.version, "V2", 2) == 0) { - printf ("i386-sequent-ptx2\n"); exit (0); - } - if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ - printf ("i386-sequent-ptx1\n"); exit (0); - } - printf ("i386-sequent-ptx\n"); exit (0); -#endif - -#if defined (vax) -#if !defined (ultrix) -#include -#if defined (BSD) -#if BSD == 43 - printf ("vax-dec-bsd4.3\n"); exit (0); -#else -#if BSD == 199006 - printf ("vax-dec-bsd4.3reno\n"); exit (0); -#else - printf ("vax-dec-bsd\n"); exit (0); -#endif -#endif -#else - printf ("vax-dec-bsd\n"); exit (0); -#endif -#else -#if defined(_SIZE_T_) || defined(SIGLOST) - struct utsname un; - uname (&un); - printf ("vax-dec-ultrix%s\n", un.release); exit (0); -#else - printf ("vax-dec-ultrix\n"); exit (0); -#endif -#endif -#endif -#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__) -#if defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__) -#if defined(_SIZE_T_) || defined(SIGLOST) - struct utsname *un; - uname (&un); - printf ("mips-dec-ultrix%s\n", un.release); exit (0); -#else - printf ("mips-dec-ultrix\n"); exit (0); -#endif -#endif -#endif - -#if defined (alliant) && defined (i860) - printf ("i860-alliant-bsd\n"); exit (0); -#endif - - exit (1); -} -EOF - -$CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null && SYSTEM_NAME=`"$dummy"` && - { echo "$SYSTEM_NAME"; exit; } - -# Apollos put the system type in the environment. -test -d /usr/apollo && { echo "$ISP-apollo-$SYSTYPE"; exit; } - -echo "$0: unable to guess system type" >&2 - -case $UNAME_MACHINE:$UNAME_SYSTEM in - mips:Linux | mips64:Linux) - # If we got here on MIPS GNU/Linux, output extra information. - cat >&2 <&2 <&2 </dev/null || echo unknown` -uname -r = `(uname -r) 2>/dev/null || echo unknown` -uname -s = `(uname -s) 2>/dev/null || echo unknown` -uname -v = `(uname -v) 2>/dev/null || echo unknown` - -/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` -/bin/uname -X = `(/bin/uname -X) 2>/dev/null` - -hostinfo = `(hostinfo) 2>/dev/null` -/bin/universe = `(/bin/universe) 2>/dev/null` -/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` -/bin/arch = `(/bin/arch) 2>/dev/null` -/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` -/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` - -UNAME_MACHINE = "$UNAME_MACHINE" -UNAME_RELEASE = "$UNAME_RELEASE" -UNAME_SYSTEM = "$UNAME_SYSTEM" -UNAME_VERSION = "$UNAME_VERSION" -EOF -fi - -exit 1 - -# Local variables: -# eval: (add-hook 'before-save-hook 'time-stamp) -# time-stamp-start: "timestamp='" -# time-stamp-format: "%:y-%02m-%02d" -# time-stamp-end: "'" -# End: diff --git a/exec/config.sub b/exec/config.sub deleted file mode 100755 index 7ab92879f13..00000000000 --- a/exec/config.sub +++ /dev/null @@ -1,1907 +0,0 @@ -#!/usr/bin/sh -# Configuration validation subroutine script. -# Copyright 1992-2024 Free Software Foundation, Inc. - -# shellcheck disable=SC2006,SC2268 # see below for rationale - -timestamp='2023-06-23' - -# This file is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, see . -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that -# program. This Exception is an additional permission under section 7 -# of the GNU General Public License, version 3 ("GPLv3"). - - -# Please send patches to . -# -# Configuration subroutine to validate and canonicalize a configuration type. -# Supply the specified configuration type as an argument. -# If it is invalid, we print an error message on stderr and exit with code 1. -# Otherwise, we print the canonical config type on stdout and succeed. - -# You can get the latest version of this script from: -# https://git.savannah.gnu.org/cgit/config.git/plain/config.sub - -# This file is supposed to be the same for all GNU packages -# and recognize all the CPU types, system types and aliases -# that are meaningful with *any* GNU software. -# Each package is responsible for reporting which valid configurations -# it does not support. The user should be able to distinguish -# a failure to support a valid configuration from a meaningless -# configuration. - -# The goal of this file is to map all the various variations of a given -# machine specification into a single specification in the form: -# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM -# or in some cases, the newer four-part form: -# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM -# It is wrong to echo any other type of specification. - -# The "shellcheck disable" line above the timestamp inhibits complaints -# about features and limitations of the classic Bourne shell that were -# superseded or lifted in POSIX. However, this script identifies a wide -# variety of pre-POSIX systems that do not have POSIX shells at all, and -# even some reasonably current systems (Solaris 10 as case-in-point) still -# have a pre-POSIX /bin/sh. - -me=`echo "$0" | sed -e 's,.*/,,'` - -usage="\ -Usage: $0 [OPTION] CPU-MFR-OPSYS or ALIAS - -Canonicalize a configuration name. - -Options: - -h, --help print this help, then exit - -t, --time-stamp print date of last modification, then exit - -v, --version print version number, then exit - -Report bugs and patches to ." - -version="\ -GNU config.sub ($timestamp) - -Copyright 1992-2023 Free Software Foundation, Inc. - -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." - -help=" -Try '$me --help' for more information." - -# Parse command line -while test $# -gt 0 ; do - case $1 in - --time-stamp | --time* | -t ) - echo "$timestamp" ; exit ;; - --version | -v ) - echo "$version" ; exit ;; - --help | --h* | -h ) - echo "$usage"; exit ;; - -- ) # Stop option processing - shift; break ;; - - ) # Use stdin as input. - break ;; - -* ) - echo "$me: invalid option $1$help" >&2 - exit 1 ;; - - *local*) - # First pass through any local machine types. - echo "$1" - exit ;; - - * ) - break ;; - esac -done - -case $# in - 0) echo "$me: missing argument$help" >&2 - exit 1;; - 1) ;; - *) echo "$me: too many arguments$help" >&2 - exit 1;; -esac - -# Split fields of configuration type -# shellcheck disable=SC2162 -saved_IFS=$IFS -IFS="-" read field1 field2 field3 field4 <&2 - exit 1 - ;; - *-*-*-*) - basic_machine=$field1-$field2 - basic_os=$field3-$field4 - ;; - *-*-*) - # Ambiguous whether COMPANY is present, or skipped and KERNEL-OS is two - # parts - maybe_os=$field2-$field3 - case $maybe_os in - nto-qnx* | linux-* | uclinux-uclibc* \ - | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* \ - | netbsd*-eabi* | kopensolaris*-gnu* | cloudabi*-eabi* \ - | storm-chaos* | os2-emx* | rtmk-nova* | managarm-*) - basic_machine=$field1 - basic_os=$maybe_os - ;; - android-linux) - basic_machine=$field1-unknown - basic_os=linux-android - ;; - *) - basic_machine=$field1-$field2 - basic_os=$field3 - ;; - esac - ;; - *-*) - # A lone config we happen to match not fitting any pattern - case $field1-$field2 in - decstation-3100) - basic_machine=mips-dec - basic_os= - ;; - *-*) - # Second component is usually, but not always the OS - case $field2 in - # Prevent following clause from handling this valid os - sun*os*) - basic_machine=$field1 - basic_os=$field2 - ;; - zephyr*) - basic_machine=$field1-unknown - basic_os=$field2 - ;; - # Manufacturers - dec* | mips* | sequent* | encore* | pc533* | sgi* | sony* \ - | att* | 7300* | 3300* | delta* | motorola* | sun[234]* \ - | unicom* | ibm* | next | hp | isi* | apollo | altos* \ - | convergent* | ncr* | news | 32* | 3600* | 3100* \ - | hitachi* | c[123]* | convex* | sun | crds | omron* | dg \ - | ultra | tti* | harris | dolphin | highlevel | gould \ - | cbm | ns | masscomp | apple | axis | knuth | cray \ - | microblaze* | sim | cisco \ - | oki | wec | wrs | winbond) - basic_machine=$field1-$field2 - basic_os= - ;; - *) - basic_machine=$field1 - basic_os=$field2 - ;; - esac - ;; - esac - ;; - *) - # Convert single-component short-hands not valid as part of - # multi-component configurations. - case $field1 in - 386bsd) - basic_machine=i386-pc - basic_os=bsd - ;; - a29khif) - basic_machine=a29k-amd - basic_os=udi - ;; - adobe68k) - basic_machine=m68010-adobe - basic_os=scout - ;; - alliant) - basic_machine=fx80-alliant - basic_os= - ;; - altos | altos3068) - basic_machine=m68k-altos - basic_os= - ;; - am29k) - basic_machine=a29k-none - basic_os=bsd - ;; - amdahl) - basic_machine=580-amdahl - basic_os=sysv - ;; - amiga) - basic_machine=m68k-unknown - basic_os= - ;; - amigaos | amigados) - basic_machine=m68k-unknown - basic_os=amigaos - ;; - amigaunix | amix) - basic_machine=m68k-unknown - basic_os=sysv4 - ;; - apollo68) - basic_machine=m68k-apollo - basic_os=sysv - ;; - apollo68bsd) - basic_machine=m68k-apollo - basic_os=bsd - ;; - aros) - basic_machine=i386-pc - basic_os=aros - ;; - aux) - basic_machine=m68k-apple - basic_os=aux - ;; - balance) - basic_machine=ns32k-sequent - basic_os=dynix - ;; - blackfin) - basic_machine=bfin-unknown - basic_os=linux - ;; - cegcc) - basic_machine=arm-unknown - basic_os=cegcc - ;; - convex-c1) - basic_machine=c1-convex - basic_os=bsd - ;; - convex-c2) - basic_machine=c2-convex - basic_os=bsd - ;; - convex-c32) - basic_machine=c32-convex - basic_os=bsd - ;; - convex-c34) - basic_machine=c34-convex - basic_os=bsd - ;; - convex-c38) - basic_machine=c38-convex - basic_os=bsd - ;; - cray) - basic_machine=j90-cray - basic_os=unicos - ;; - crds | unos) - basic_machine=m68k-crds - basic_os= - ;; - da30) - basic_machine=m68k-da30 - basic_os= - ;; - decstation | pmax | pmin | dec3100 | decstatn) - basic_machine=mips-dec - basic_os= - ;; - delta88) - basic_machine=m88k-motorola - basic_os=sysv3 - ;; - dicos) - basic_machine=i686-pc - basic_os=dicos - ;; - djgpp) - basic_machine=i586-pc - basic_os=msdosdjgpp - ;; - ebmon29k) - basic_machine=a29k-amd - basic_os=ebmon - ;; - es1800 | OSE68k | ose68k | ose | OSE) - basic_machine=m68k-ericsson - basic_os=ose - ;; - gmicro) - basic_machine=tron-gmicro - basic_os=sysv - ;; - go32) - basic_machine=i386-pc - basic_os=go32 - ;; - h8300hms) - basic_machine=h8300-hitachi - basic_os=hms - ;; - h8300xray) - basic_machine=h8300-hitachi - basic_os=xray - ;; - h8500hms) - basic_machine=h8500-hitachi - basic_os=hms - ;; - harris) - basic_machine=m88k-harris - basic_os=sysv3 - ;; - hp300 | hp300hpux) - basic_machine=m68k-hp - basic_os=hpux - ;; - hp300bsd) - basic_machine=m68k-hp - basic_os=bsd - ;; - hppaosf) - basic_machine=hppa1.1-hp - basic_os=osf - ;; - hppro) - basic_machine=hppa1.1-hp - basic_os=proelf - ;; - i386mach) - basic_machine=i386-mach - basic_os=mach - ;; - isi68 | isi) - basic_machine=m68k-isi - basic_os=sysv - ;; - m68knommu) - basic_machine=m68k-unknown - basic_os=linux - ;; - magnum | m3230) - basic_machine=mips-mips - basic_os=sysv - ;; - merlin) - basic_machine=ns32k-utek - basic_os=sysv - ;; - mingw64) - basic_machine=x86_64-pc - basic_os=mingw64 - ;; - mingw32) - basic_machine=i686-pc - basic_os=mingw32 - ;; - mingw32ce) - basic_machine=arm-unknown - basic_os=mingw32ce - ;; - monitor) - basic_machine=m68k-rom68k - basic_os=coff - ;; - morphos) - basic_machine=powerpc-unknown - basic_os=morphos - ;; - moxiebox) - basic_machine=moxie-unknown - basic_os=moxiebox - ;; - msdos) - basic_machine=i386-pc - basic_os=msdos - ;; - msys) - basic_machine=i686-pc - basic_os=msys - ;; - mvs) - basic_machine=i370-ibm - basic_os=mvs - ;; - nacl) - basic_machine=le32-unknown - basic_os=nacl - ;; - ncr3000) - basic_machine=i486-ncr - basic_os=sysv4 - ;; - netbsd386) - basic_machine=i386-pc - basic_os=netbsd - ;; - netwinder) - basic_machine=armv4l-rebel - basic_os=linux - ;; - news | news700 | news800 | news900) - basic_machine=m68k-sony - basic_os=newsos - ;; - news1000) - basic_machine=m68030-sony - basic_os=newsos - ;; - necv70) - basic_machine=v70-nec - basic_os=sysv - ;; - nh3000) - basic_machine=m68k-harris - basic_os=cxux - ;; - nh[45]000) - basic_machine=m88k-harris - basic_os=cxux - ;; - nindy960) - basic_machine=i960-intel - basic_os=nindy - ;; - mon960) - basic_machine=i960-intel - basic_os=mon960 - ;; - nonstopux) - basic_machine=mips-compaq - basic_os=nonstopux - ;; - os400) - basic_machine=powerpc-ibm - basic_os=os400 - ;; - OSE68000 | ose68000) - basic_machine=m68000-ericsson - basic_os=ose - ;; - os68k) - basic_machine=m68k-none - basic_os=os68k - ;; - paragon) - basic_machine=i860-intel - basic_os=osf - ;; - parisc) - basic_machine=hppa-unknown - basic_os=linux - ;; - psp) - basic_machine=mipsallegrexel-sony - basic_os=psp - ;; - pw32) - basic_machine=i586-unknown - basic_os=pw32 - ;; - rdos | rdos64) - basic_machine=x86_64-pc - basic_os=rdos - ;; - rdos32) - basic_machine=i386-pc - basic_os=rdos - ;; - rom68k) - basic_machine=m68k-rom68k - basic_os=coff - ;; - sa29200) - basic_machine=a29k-amd - basic_os=udi - ;; - sei) - basic_machine=mips-sei - basic_os=seiux - ;; - sequent) - basic_machine=i386-sequent - basic_os= - ;; - sps7) - basic_machine=m68k-bull - basic_os=sysv2 - ;; - st2000) - basic_machine=m68k-tandem - basic_os= - ;; - stratus) - basic_machine=i860-stratus - basic_os=sysv4 - ;; - sun2) - basic_machine=m68000-sun - basic_os= - ;; - sun2os3) - basic_machine=m68000-sun - basic_os=sunos3 - ;; - sun2os4) - basic_machine=m68000-sun - basic_os=sunos4 - ;; - sun3) - basic_machine=m68k-sun - basic_os= - ;; - sun3os3) - basic_machine=m68k-sun - basic_os=sunos3 - ;; - sun3os4) - basic_machine=m68k-sun - basic_os=sunos4 - ;; - sun4) - basic_machine=sparc-sun - basic_os= - ;; - sun4os3) - basic_machine=sparc-sun - basic_os=sunos3 - ;; - sun4os4) - basic_machine=sparc-sun - basic_os=sunos4 - ;; - sun4sol2) - basic_machine=sparc-sun - basic_os=solaris2 - ;; - sun386 | sun386i | roadrunner) - basic_machine=i386-sun - basic_os= - ;; - sv1) - basic_machine=sv1-cray - basic_os=unicos - ;; - symmetry) - basic_machine=i386-sequent - basic_os=dynix - ;; - t3e) - basic_machine=alphaev5-cray - basic_os=unicos - ;; - t90) - basic_machine=t90-cray - basic_os=unicos - ;; - toad1) - basic_machine=pdp10-xkl - basic_os=tops20 - ;; - tpf) - basic_machine=s390x-ibm - basic_os=tpf - ;; - udi29k) - basic_machine=a29k-amd - basic_os=udi - ;; - ultra3) - basic_machine=a29k-nyu - basic_os=sym1 - ;; - v810 | necv810) - basic_machine=v810-nec - basic_os=none - ;; - vaxv) - basic_machine=vax-dec - basic_os=sysv - ;; - vms) - basic_machine=vax-dec - basic_os=vms - ;; - vsta) - basic_machine=i386-pc - basic_os=vsta - ;; - vxworks960) - basic_machine=i960-wrs - basic_os=vxworks - ;; - vxworks68) - basic_machine=m68k-wrs - basic_os=vxworks - ;; - vxworks29k) - basic_machine=a29k-wrs - basic_os=vxworks - ;; - xbox) - basic_machine=i686-pc - basic_os=mingw32 - ;; - ymp) - basic_machine=ymp-cray - basic_os=unicos - ;; - *) - basic_machine=$1 - basic_os= - ;; - esac - ;; -esac - -# Decode 1-component or ad-hoc basic machines -case $basic_machine in - # Here we handle the default manufacturer of certain CPU types. It is in - # some cases the only manufacturer, in others, it is the most popular. - w89k) - cpu=hppa1.1 - vendor=winbond - ;; - op50n) - cpu=hppa1.1 - vendor=oki - ;; - op60c) - cpu=hppa1.1 - vendor=oki - ;; - ibm*) - cpu=i370 - vendor=ibm - ;; - orion105) - cpu=clipper - vendor=highlevel - ;; - mac | mpw | mac-mpw) - cpu=m68k - vendor=apple - ;; - pmac | pmac-mpw) - cpu=powerpc - vendor=apple - ;; - - # Recognize the various machine names and aliases which stand - # for a CPU type and a company and sometimes even an OS. - 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) - cpu=m68000 - vendor=att - ;; - 3b*) - cpu=we32k - vendor=att - ;; - bluegene*) - cpu=powerpc - vendor=ibm - basic_os=cnk - ;; - decsystem10* | dec10*) - cpu=pdp10 - vendor=dec - basic_os=tops10 - ;; - decsystem20* | dec20*) - cpu=pdp10 - vendor=dec - basic_os=tops20 - ;; - delta | 3300 | motorola-3300 | motorola-delta \ - | 3300-motorola | delta-motorola) - cpu=m68k - vendor=motorola - ;; - dpx2*) - cpu=m68k - vendor=bull - basic_os=sysv3 - ;; - encore | umax | mmax) - cpu=ns32k - vendor=encore - ;; - elxsi) - cpu=elxsi - vendor=elxsi - basic_os=${basic_os:-bsd} - ;; - fx2800) - cpu=i860 - vendor=alliant - ;; - genix) - cpu=ns32k - vendor=ns - ;; - h3050r* | hiux*) - cpu=hppa1.1 - vendor=hitachi - basic_os=hiuxwe2 - ;; - hp3k9[0-9][0-9] | hp9[0-9][0-9]) - cpu=hppa1.0 - vendor=hp - ;; - hp9k2[0-9][0-9] | hp9k31[0-9]) - cpu=m68000 - vendor=hp - ;; - hp9k3[2-9][0-9]) - cpu=m68k - vendor=hp - ;; - hp9k6[0-9][0-9] | hp6[0-9][0-9]) - cpu=hppa1.0 - vendor=hp - ;; - hp9k7[0-79][0-9] | hp7[0-79][0-9]) - cpu=hppa1.1 - vendor=hp - ;; - hp9k78[0-9] | hp78[0-9]) - # FIXME: really hppa2.0-hp - cpu=hppa1.1 - vendor=hp - ;; - hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) - # FIXME: really hppa2.0-hp - cpu=hppa1.1 - vendor=hp - ;; - hp9k8[0-9][13679] | hp8[0-9][13679]) - cpu=hppa1.1 - vendor=hp - ;; - hp9k8[0-9][0-9] | hp8[0-9][0-9]) - cpu=hppa1.0 - vendor=hp - ;; - i*86v32) - cpu=`echo "$1" | sed -e 's/86.*/86/'` - vendor=pc - basic_os=sysv32 - ;; - i*86v4*) - cpu=`echo "$1" | sed -e 's/86.*/86/'` - vendor=pc - basic_os=sysv4 - ;; - i*86v) - cpu=`echo "$1" | sed -e 's/86.*/86/'` - vendor=pc - basic_os=sysv - ;; - i*86sol2) - cpu=`echo "$1" | sed -e 's/86.*/86/'` - vendor=pc - basic_os=solaris2 - ;; - j90 | j90-cray) - cpu=j90 - vendor=cray - basic_os=${basic_os:-unicos} - ;; - iris | iris4d) - cpu=mips - vendor=sgi - case $basic_os in - irix*) - ;; - *) - basic_os=irix4 - ;; - esac - ;; - miniframe) - cpu=m68000 - vendor=convergent - ;; - *mint | mint[0-9]* | *MiNT | *MiNT[0-9]*) - cpu=m68k - vendor=atari - basic_os=mint - ;; - news-3600 | risc-news) - cpu=mips - vendor=sony - basic_os=newsos - ;; - next | m*-next) - cpu=m68k - vendor=next - case $basic_os in - openstep*) - ;; - nextstep*) - ;; - ns2*) - basic_os=nextstep2 - ;; - *) - basic_os=nextstep3 - ;; - esac - ;; - np1) - cpu=np1 - vendor=gould - ;; - op50n-* | op60c-*) - cpu=hppa1.1 - vendor=oki - basic_os=proelf - ;; - pa-hitachi) - cpu=hppa1.1 - vendor=hitachi - basic_os=hiuxwe2 - ;; - pbd) - cpu=sparc - vendor=tti - ;; - pbb) - cpu=m68k - vendor=tti - ;; - pc532) - cpu=ns32k - vendor=pc532 - ;; - pn) - cpu=pn - vendor=gould - ;; - power) - cpu=power - vendor=ibm - ;; - ps2) - cpu=i386 - vendor=ibm - ;; - rm[46]00) - cpu=mips - vendor=siemens - ;; - rtpc | rtpc-*) - cpu=romp - vendor=ibm - ;; - sde) - cpu=mipsisa32 - vendor=sde - basic_os=${basic_os:-elf} - ;; - simso-wrs) - cpu=sparclite - vendor=wrs - basic_os=vxworks - ;; - tower | tower-32) - cpu=m68k - vendor=ncr - ;; - vpp*|vx|vx-*) - cpu=f301 - vendor=fujitsu - ;; - w65) - cpu=w65 - vendor=wdc - ;; - w89k-*) - cpu=hppa1.1 - vendor=winbond - basic_os=proelf - ;; - none) - cpu=none - vendor=none - ;; - leon|leon[3-9]) - cpu=sparc - vendor=$basic_machine - ;; - leon-*|leon[3-9]-*) - cpu=sparc - vendor=`echo "$basic_machine" | sed 's/-.*//'` - ;; - - *-*) - # shellcheck disable=SC2162 - saved_IFS=$IFS - IFS="-" read cpu vendor <&2 - exit 1 - ;; - esac - ;; -esac - -# Here we canonicalize certain aliases for manufacturers. -case $vendor in - digital*) - vendor=dec - ;; - commodore*) - vendor=cbm - ;; - *) - ;; -esac - -# Decode manufacturer-specific aliases for certain operating systems. - -if test x$basic_os != x -then - -# First recognize some ad-hoc cases, or perhaps split kernel-os, or else just -# set os. -case $basic_os in - gnu/linux*) - kernel=linux - os=`echo "$basic_os" | sed -e 's|gnu/linux|gnu|'` - ;; - os2-emx) - kernel=os2 - os=`echo "$basic_os" | sed -e 's|os2-emx|emx|'` - ;; - nto-qnx*) - kernel=nto - os=`echo "$basic_os" | sed -e 's|nto-qnx|qnx|'` - ;; - *-*) - # shellcheck disable=SC2162 - saved_IFS=$IFS - IFS="-" read kernel os <&2 - exit 1 - ;; -esac - -# As a final step for OS-related things, validate the OS-kernel combination -# (given a valid OS), if there is a kernel. -case $kernel-$os in - linux-gnu* | linux-dietlibc* | linux-android* | linux-newlib* \ - | linux-musl* | linux-relibc* | linux-uclibc* | linux-mlibc* ) - ;; - uclinux-uclibc* ) - ;; - managarm-mlibc* | managarm-kernel* ) - ;; - -dietlibc* | -newlib* | -musl* | -relibc* | -uclibc* | -mlibc* ) - # These are just libc implementations, not actual OSes, and thus - # require a kernel. - echo "Invalid configuration '$1': libc '$os' needs explicit kernel." 1>&2 - exit 1 - ;; - -kernel* ) - echo "Invalid configuration '$1': '$os' needs explicit kernel." 1>&2 - exit 1 - ;; - *-kernel* ) - echo "Invalid configuration '$1': '$kernel' does not support '$os'." 1>&2 - exit 1 - ;; - kfreebsd*-gnu* | kopensolaris*-gnu*) - ;; - vxworks-simlinux | vxworks-simwindows | vxworks-spe) - ;; - nto-qnx*) - ;; - os2-emx) - ;; - *-eabi* | *-gnueabi*) - ;; - -*) - # Blank kernel with real OS is always fine. - ;; - *-*) - echo "Invalid configuration '$1': Kernel '$kernel' not known to work with OS '$os'." 1>&2 - exit 1 - ;; -esac - -# Here we handle the case where we know the os, and the CPU type, but not the -# manufacturer. We pick the logical manufacturer. -case $vendor in - unknown) - case $cpu-$os in - *-riscix*) - vendor=acorn - ;; - *-sunos*) - vendor=sun - ;; - *-cnk* | *-aix*) - vendor=ibm - ;; - *-beos*) - vendor=be - ;; - *-hpux*) - vendor=hp - ;; - *-mpeix*) - vendor=hp - ;; - *-hiux*) - vendor=hitachi - ;; - *-unos*) - vendor=crds - ;; - *-dgux*) - vendor=dg - ;; - *-luna*) - vendor=omron - ;; - *-genix*) - vendor=ns - ;; - *-clix*) - vendor=intergraph - ;; - *-mvs* | *-opened*) - vendor=ibm - ;; - *-os400*) - vendor=ibm - ;; - s390-* | s390x-*) - vendor=ibm - ;; - *-ptx*) - vendor=sequent - ;; - *-tpf*) - vendor=ibm - ;; - *-vxsim* | *-vxworks* | *-windiss*) - vendor=wrs - ;; - *-aux*) - vendor=apple - ;; - *-hms*) - vendor=hitachi - ;; - *-mpw* | *-macos*) - vendor=apple - ;; - *-*mint | *-mint[0-9]* | *-*MiNT | *-MiNT[0-9]*) - vendor=atari - ;; - *-vos*) - vendor=stratus - ;; - esac - ;; -esac - -echo "$cpu-$vendor-${kernel:+$kernel-}$os" -exit - -# Local variables: -# eval: (add-hook 'before-save-hook 'time-stamp) -# time-stamp-start: "timestamp='" -# time-stamp-format: "%:y-%02m-%02d" -# time-stamp-end: "'" -# End: diff --git a/exec/install-sh b/exec/install-sh deleted file mode 100755 index e046efdf0a3..00000000000 --- a/exec/install-sh +++ /dev/null @@ -1,541 +0,0 @@ -#!/usr/bin/sh -# install - install a program, script, or datafile - -scriptversion=2020-11-14.01; # UTC - -# This originates from X11R5 (mit/util/scripts/install.sh), which was -# later released in X11R6 (xc/config/util/install.sh) with the -# following copyright and license. -# -# Copyright (C) 1994 X Consortium -# -# Permission is hereby granted, free of charge, to any person obtaining a copy -# of this software and associated documentation files (the "Software"), to -# deal in the Software without restriction, including without limitation the -# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or -# sell copies of the Software, and to permit persons to whom the Software is -# furnished to do so, subject to the following conditions: -# -# The above copyright notice and this permission notice shall be included in -# all copies or substantial portions of the Software. -# -# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN -# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC- -# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -# -# Except as contained in this notice, the name of the X Consortium shall not -# be used in advertising or otherwise to promote the sale, use or other deal- -# ings in this Software without prior written authorization from the X Consor- -# tium. -# -# -# FSF changes to this file are in the public domain. -# -# Calling this script install-sh is preferred over install.sh, to prevent -# 'make' implicit rules from creating a file called install from it -# when there is no Makefile. -# -# This script is compatible with the BSD install script, but was written -# from scratch. - -tab=' ' -nl=' -' -IFS=" $tab$nl" - -# Set DOITPROG to "echo" to test this script. - -doit=${DOITPROG-} -doit_exec=${doit:-exec} - -# Put in absolute file names if you don't have them in your path; -# or use environment vars. - -chgrpprog=${CHGRPPROG-chgrp} -chmodprog=${CHMODPROG-chmod} -chownprog=${CHOWNPROG-chown} -cmpprog=${CMPPROG-cmp} -cpprog=${CPPROG-cp} -mkdirprog=${MKDIRPROG-mkdir} -mvprog=${MVPROG-mv} -rmprog=${RMPROG-rm} -stripprog=${STRIPPROG-strip} - -posix_mkdir= - -# Desired mode of installed file. -mode=0755 - -# Create dirs (including intermediate dirs) using mode 755. -# This is like GNU 'install' as of coreutils 8.32 (2020). -mkdir_umask=22 - -backupsuffix= -chgrpcmd= -chmodcmd=$chmodprog -chowncmd= -mvcmd=$mvprog -rmcmd="$rmprog -f" -stripcmd= - -src= -dst= -dir_arg= -dst_arg= - -copy_on_change=false -is_target_a_directory=possibly - -usage="\ -Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE - or: $0 [OPTION]... SRCFILES... DIRECTORY - or: $0 [OPTION]... -t DIRECTORY SRCFILES... - or: $0 [OPTION]... -d DIRECTORIES... - -In the 1st form, copy SRCFILE to DSTFILE. -In the 2nd and 3rd, copy all SRCFILES to DIRECTORY. -In the 4th, create DIRECTORIES. - -Options: - --help display this help and exit. - --version display version info and exit. - - -c (ignored) - -C install only if different (preserve data modification time) - -d create directories instead of installing files. - -g GROUP $chgrpprog installed files to GROUP. - -m MODE $chmodprog installed files to MODE. - -o USER $chownprog installed files to USER. - -p pass -p to $cpprog. - -s $stripprog installed files. - -S SUFFIX attempt to back up existing files, with suffix SUFFIX. - -t DIRECTORY install into DIRECTORY. - -T report an error if DSTFILE is a directory. - -Environment variables override the default commands: - CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG - RMPROG STRIPPROG - -By default, rm is invoked with -f; when overridden with RMPROG, -it's up to you to specify -f if you want it. - -If -S is not specified, no backups are attempted. - -Email bug reports to bug-automake@gnu.org. -Automake home page: https://www.gnu.org/software/automake/ -" - -while test $# -ne 0; do - case $1 in - -c) ;; - - -C) copy_on_change=true;; - - -d) dir_arg=true;; - - -g) chgrpcmd="$chgrpprog $2" - shift;; - - --help) echo "$usage"; exit $?;; - - -m) mode=$2 - case $mode in - *' '* | *"$tab"* | *"$nl"* | *'*'* | *'?'* | *'['*) - echo "$0: invalid mode: $mode" >&2 - exit 1;; - esac - shift;; - - -o) chowncmd="$chownprog $2" - shift;; - - -p) cpprog="$cpprog -p";; - - -s) stripcmd=$stripprog;; - - -S) backupsuffix="$2" - shift;; - - -t) - is_target_a_directory=always - dst_arg=$2 - # Protect names problematic for 'test' and other utilities. - case $dst_arg in - -* | [=\(\)!]) dst_arg=./$dst_arg;; - esac - shift;; - - -T) is_target_a_directory=never;; - - --version) echo "$0 $scriptversion"; exit $?;; - - --) shift - break;; - - -*) echo "$0: invalid option: $1" >&2 - exit 1;; - - *) break;; - esac - shift -done - -# We allow the use of options -d and -T together, by making -d -# take the precedence; this is for compatibility with GNU install. - -if test -n "$dir_arg"; then - if test -n "$dst_arg"; then - echo "$0: target directory not allowed when installing a directory." >&2 - exit 1 - fi -fi - -if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then - # When -d is used, all remaining arguments are directories to create. - # When -t is used, the destination is already specified. - # Otherwise, the last argument is the destination. Remove it from $@. - for arg - do - if test -n "$dst_arg"; then - # $@ is not empty: it contains at least $arg. - set fnord "$@" "$dst_arg" - shift # fnord - fi - shift # arg - dst_arg=$arg - # Protect names problematic for 'test' and other utilities. - case $dst_arg in - -* | [=\(\)!]) dst_arg=./$dst_arg;; - esac - done -fi - -if test $# -eq 0; then - if test -z "$dir_arg"; then - echo "$0: no input file specified." >&2 - exit 1 - fi - # It's OK to call 'install-sh -d' without argument. - # This can happen when creating conditional directories. - exit 0 -fi - -if test -z "$dir_arg"; then - if test $# -gt 1 || test "$is_target_a_directory" = always; then - if test ! -d "$dst_arg"; then - echo "$0: $dst_arg: Is not a directory." >&2 - exit 1 - fi - fi -fi - -if test -z "$dir_arg"; then - do_exit='(exit $ret); exit $ret' - trap "ret=129; $do_exit" 1 - trap "ret=130; $do_exit" 2 - trap "ret=141; $do_exit" 13 - trap "ret=143; $do_exit" 15 - - # Set umask so as not to create temps with too-generous modes. - # However, 'strip' requires both read and write access to temps. - case $mode in - # Optimize common cases. - *644) cp_umask=133;; - *755) cp_umask=22;; - - *[0-7]) - if test -z "$stripcmd"; then - u_plus_rw= - else - u_plus_rw='% 200' - fi - cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;; - *) - if test -z "$stripcmd"; then - u_plus_rw= - else - u_plus_rw=,u+rw - fi - cp_umask=$mode$u_plus_rw;; - esac -fi - -for src -do - # Protect names problematic for 'test' and other utilities. - case $src in - -* | [=\(\)!]) src=./$src;; - esac - - if test -n "$dir_arg"; then - dst=$src - dstdir=$dst - test -d "$dstdir" - dstdir_status=$? - # Don't chown directories that already exist. - if test $dstdir_status = 0; then - chowncmd="" - fi - else - - # Waiting for this to be detected by the "$cpprog $src $dsttmp" command - # might cause directories to be created, which would be especially bad - # if $src (and thus $dsttmp) contains '*'. - if test ! -f "$src" && test ! -d "$src"; then - echo "$0: $src does not exist." >&2 - exit 1 - fi - - if test -z "$dst_arg"; then - echo "$0: no destination specified." >&2 - exit 1 - fi - dst=$dst_arg - - # If destination is a directory, append the input filename. - if test -d "$dst"; then - if test "$is_target_a_directory" = never; then - echo "$0: $dst_arg: Is a directory" >&2 - exit 1 - fi - dstdir=$dst - dstbase=`basename "$src"` - case $dst in - */) dst=$dst$dstbase;; - *) dst=$dst/$dstbase;; - esac - dstdir_status=0 - else - dstdir=`dirname "$dst"` - test -d "$dstdir" - dstdir_status=$? - fi - fi - - case $dstdir in - */) dstdirslash=$dstdir;; - *) dstdirslash=$dstdir/;; - esac - - obsolete_mkdir_used=false - - if test $dstdir_status != 0; then - case $posix_mkdir in - '') - # With -d, create the new directory with the user-specified mode. - # Otherwise, rely on $mkdir_umask. - if test -n "$dir_arg"; then - mkdir_mode=-m$mode - else - mkdir_mode= - fi - - posix_mkdir=false - # The $RANDOM variable is not portable (e.g., dash). Use it - # here however when possible just to lower collision chance. - tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$ - - trap ' - ret=$? - rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir" 2>/dev/null - exit $ret - ' 0 - - # Because "mkdir -p" follows existing symlinks and we likely work - # directly in world-writeable /tmp, make sure that the '$tmpdir' - # directory is successfully created first before we actually test - # 'mkdir -p'. - if (umask $mkdir_umask && - $mkdirprog $mkdir_mode "$tmpdir" && - exec $mkdirprog $mkdir_mode -p -- "$tmpdir/a/b") >/dev/null 2>&1 - then - if test -z "$dir_arg" || { - # Check for POSIX incompatibilities with -m. - # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or - # other-writable bit of parent directory when it shouldn't. - # FreeBSD 6.1 mkdir -m -p sets mode of existing directory. - test_tmpdir="$tmpdir/a" - ls_ld_tmpdir=`ls -ld "$test_tmpdir"` - case $ls_ld_tmpdir in - d????-?r-*) different_mode=700;; - d????-?--*) different_mode=755;; - *) false;; - esac && - $mkdirprog -m$different_mode -p -- "$test_tmpdir" && { - ls_ld_tmpdir_1=`ls -ld "$test_tmpdir"` - test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1" - } - } - then posix_mkdir=: - fi - rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir" - else - # Remove any dirs left behind by ancient mkdir implementations. - rmdir ./$mkdir_mode ./-p ./-- "$tmpdir" 2>/dev/null - fi - trap '' 0;; - esac - - if - $posix_mkdir && ( - umask $mkdir_umask && - $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir" - ) - then : - else - - # mkdir does not conform to POSIX, - # or it failed possibly due to a race condition. Create the - # directory the slow way, step by step, checking for races as we go. - - case $dstdir in - /*) prefix='/';; - [-=\(\)!]*) prefix='./';; - *) prefix='';; - esac - - oIFS=$IFS - IFS=/ - set -f - set fnord $dstdir - shift - set +f - IFS=$oIFS - - prefixes= - - for d - do - test X"$d" = X && continue - - prefix=$prefix$d - if test -d "$prefix"; then - prefixes= - else - if $posix_mkdir; then - (umask $mkdir_umask && - $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break - # Don't fail if two instances are running concurrently. - test -d "$prefix" || exit 1 - else - case $prefix in - *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;; - *) qprefix=$prefix;; - esac - prefixes="$prefixes '$qprefix'" - fi - fi - prefix=$prefix/ - done - - if test -n "$prefixes"; then - # Don't fail if two instances are running concurrently. - (umask $mkdir_umask && - eval "\$doit_exec \$mkdirprog $prefixes") || - test -d "$dstdir" || exit 1 - obsolete_mkdir_used=true - fi - fi - fi - - if test -n "$dir_arg"; then - { test -z "$chowncmd" || $doit $chowncmd "$dst"; } && - { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } && - { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false || - test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1 - else - - # Make a couple of temp file names in the proper directory. - dsttmp=${dstdirslash}_inst.$$_ - rmtmp=${dstdirslash}_rm.$$_ - - # Trap to clean up those temp files at exit. - trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0 - - # Copy the file name to the temp name. - (umask $cp_umask && - { test -z "$stripcmd" || { - # Create $dsttmp read-write so that cp doesn't create it read-only, - # which would cause strip to fail. - if test -z "$doit"; then - : >"$dsttmp" # No need to fork-exec 'touch'. - else - $doit touch "$dsttmp" - fi - } - } && - $doit_exec $cpprog "$src" "$dsttmp") && - - # and set any options; do chmod last to preserve setuid bits. - # - # If any of these fail, we abort the whole thing. If we want to - # ignore errors from any of these, just make sure not to ignore - # errors from the above "$doit $cpprog $src $dsttmp" command. - # - { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } && - { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } && - { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } && - { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } && - - # If -C, don't bother to copy if it wouldn't change the file. - if $copy_on_change && - old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` && - new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` && - set -f && - set X $old && old=:$2:$4:$5:$6 && - set X $new && new=:$2:$4:$5:$6 && - set +f && - test "$old" = "$new" && - $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1 - then - rm -f "$dsttmp" - else - # If $backupsuffix is set, and the file being installed - # already exists, attempt a backup. Don't worry if it fails, - # e.g., if mv doesn't support -f. - if test -n "$backupsuffix" && test -f "$dst"; then - $doit $mvcmd -f "$dst" "$dst$backupsuffix" 2>/dev/null - fi - - # Rename the file to the real destination. - $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null || - - # The rename failed, perhaps because mv can't rename something else - # to itself, or perhaps because mv is so ancient that it does not - # support -f. - { - # Now remove or move aside any old file at destination location. - # We try this two ways since rm can't unlink itself on some - # systems and the destination file might be busy for other - # reasons. In this case, the final cleanup might fail but the new - # file should still install successfully. - { - test ! -f "$dst" || - $doit $rmcmd "$dst" 2>/dev/null || - { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null && - { $doit $rmcmd "$rmtmp" 2>/dev/null; :; } - } || - { echo "$0: cannot unlink or rename $dst" >&2 - (exit 1); exit 1 - } - } && - - # Now rename the file to the real destination. - $doit $mvcmd "$dsttmp" "$dst" - } - fi || exit 1 - - trap '' 0 - fi -done - -# Local variables: -# eval: (add-hook 'before-save-hook 'time-stamp) -# time-stamp-start: "scriptversion=" -# time-stamp-format: "%:y-%02m-%02d.%02H" -# time-stamp-time-zone: "UTC0" -# time-stamp-end: "; # UTC" -# End: -- cgit v1.2.3 From 973c1b8a1838b78d1388437c2aa7f4eb4dceb7d9 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 20 Jan 2024 16:52:31 -0800 Subject: Pacify gcc -Wsuggest-attribute=malloc * src/lisp.h (hash_table_alloc_bytes): Declare with ATTRIBUTE_MALLOC_SIZE ((1)). --- src/lisp.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lisp.h b/src/lisp.h index 64492361e64..d9448f476e7 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4475,7 +4475,7 @@ extern void syms_of_alloc (void); extern struct buffer *allocate_buffer (void) ATTRIBUTE_RETURNS_NONNULL; extern int valid_lisp_object_p (Lisp_Object); -void *hash_table_alloc_bytes (ptrdiff_t nbytes); +void *hash_table_alloc_bytes (ptrdiff_t nbytes) ATTRIBUTE_MALLOC_SIZE ((1)); void hash_table_free_bytes (void *p, ptrdiff_t nbytes); /* Defined in gmalloc.c. */ -- cgit v1.2.3 From 0a47a5a4bef0a33c012302346685ecab861cc306 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 20 Jan 2024 16:52:31 -0800 Subject: Omit some parens * src/lisp.h (XBARE_SYMBOL, XSYMBOL): Omit parentheses that are no longer needed now that we have symbols with positions and these symbols are never macros. --- src/lisp.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index d9448f476e7..e25d990e1e9 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1145,7 +1145,7 @@ XSYMBOL_WITH_POS (Lisp_Object a) } INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED -(XBARE_SYMBOL) (Lisp_Object a) +XBARE_SYMBOL (Lisp_Object a) { eassert (BARE_SYMBOL_P (a)); intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol, struct Lisp_Symbol); @@ -1154,7 +1154,7 @@ INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED } INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED -(XSYMBOL) (Lisp_Object a) +XSYMBOL (Lisp_Object a) { eassert (SYMBOLP ((a))); if (!symbols_with_pos_enabled || BARE_SYMBOL_P (a)) -- cgit v1.2.3 From b6ed79b71ccb3df8df05531d473ff9510cf9a39f Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 20 Jan 2024 16:52:31 -0800 Subject: Be more systematic about parens in C source code Be more systematic about putting space before paren in calls, and in avoiding unnecessary parentheses in macros. This was partly inspired by my wading through gcc -E output while debugging something else, and seeing too many parens. This patch does not change the generated .o files on my platform. --- admin/notes/java | 2 +- lib-src/etags.c | 6 +-- lib-src/seccomp-filter.c | 4 +- src/alloc.c | 50 +++++++++++----------- src/android.c | 2 +- src/android.h | 2 +- src/androidterm.h | 4 +- src/buffer.h | 2 +- src/ccl.c | 10 ++--- src/ccl.h | 2 +- src/charset.c | 2 +- src/charset.h | 68 +++++++++++++++--------------- src/coding.c | 14 +++--- src/coding.h | 23 +++++----- src/comp.c | 2 +- src/composite.h | 48 ++++++++++----------- src/conf_post.h | 6 +-- src/dispextern.h | 58 ++++++++++++------------- src/dispnew.c | 6 +-- src/disptab.h | 8 ++-- src/editfns.c | 2 +- src/emacsgtkfixed.h | 4 +- src/font.h | 26 ++++++------ src/fontset.c | 12 +++--- src/frame.h | 10 ++--- src/gtkutil.c | 4 +- src/image.c | 4 +- src/keyboard.c | 4 +- src/keyboard.h | 26 ++++++------ src/lisp.h | 68 +++++++++++++++--------------- src/lread.c | 2 +- src/macfont.h | 4 +- src/msdos.c | 2 +- src/nsfont.m | 2 +- src/nsterm.h | 6 +-- src/pdumper.h | 2 +- src/pgtkterm.h | 2 +- src/regex-emacs.c | 16 +++---- src/sfnt.c | 2 +- src/term.c | 11 ++--- src/w32font.c | 4 +- src/window.h | 22 +++++----- src/xdisp.c | 10 ++--- src/xfaces.c | 44 +++++++++---------- src/xterm.h | 6 +-- test/src/emacs-module-resources/mod-test.c | 4 +- 46 files changed, 309 insertions(+), 309 deletions(-) diff --git a/admin/notes/java b/admin/notes/java index 891096cd406..e10f09f780f 100644 --- a/admin/notes/java +++ b/admin/notes/java @@ -445,7 +445,7 @@ loaded by the special invocation: where ``static'' defines a section of code which will be run upon the object (containing class) being loaded. This is like: - __attribute__((constructor)) + __attribute__ ((constructor)) on systems where shared object constructors are supported. diff --git a/lib-src/etags.c b/lib-src/etags.c index 506366141e6..032cfa8010b 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -3825,7 +3825,7 @@ C_entries (int c_ext, /* extension of C */ { case fstartlist: /* This prevents tagging fb in - void (__attribute__((noreturn)) *fb) (void); + void (__attribute__ ((noreturn)) *fb) (void); Fixing this is not easy and not very important. */ fvdef = finlist; continue; @@ -4380,14 +4380,14 @@ Yacc_entries (FILE *inf) #define LOOKING_AT(cp, kw) /* kw is the keyword, a literal string */ \ ((assert ("" kw), true) /* syntax error if not a literal string */ \ - && strneq ((cp), kw, sizeof (kw)-1) /* cp points at kw */ \ + && strneq (cp, kw, sizeof (kw) - 1) /* cp points at kw */ \ && notinname ((cp)[sizeof (kw)-1]) /* end of kw */ \ && ((cp) = skip_spaces ((cp) + sizeof (kw) - 1), true)) /* skip spaces */ /* Similar to LOOKING_AT but does not use notinname, does not skip */ #define LOOKING_AT_NOCASE(cp, kw) /* the keyword is a literal string */ \ ((assert ("" kw), true) /* syntax error if not a literal string */ \ - && strncaseeq ((cp), kw, sizeof (kw)-1) /* cp points at kw */ \ + && strncaseeq (cp, kw, sizeof (kw) - 1) /* cp points at kw */ \ && ((cp) += sizeof (kw) - 1, true)) /* skip spaces */ /* diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c index 8846e6aedae..0aeb6e8d88a 100644 --- a/lib-src/seccomp-filter.c +++ b/lib-src/seccomp-filter.c @@ -114,7 +114,7 @@ set_attribute (enum scmp_filter_attr attr, uint32_t value) { \ const struct scmp_arg_cmp arg_array[] = {__VA_ARGS__}; \ enum { arg_cnt = sizeof arg_array / sizeof *arg_array }; \ - int status = seccomp_rule_add_array (ctx, (action), (syscall), \ + int status = seccomp_rule_add_array (ctx, action, syscall, \ arg_cnt, arg_array); \ if (status < 0) \ fail (-status, "seccomp_rule_add_array (%s, %s, %d, {%s})", \ @@ -143,7 +143,7 @@ export_filter (const char *file, } #define EXPORT_FILTER(file, function) \ - export_filter ((file), (function), #function) + export_filter (file, function, #function) int main (int argc, char **argv) diff --git a/src/alloc.c b/src/alloc.c index 16aaa32e15f..b78445f65df 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1466,9 +1466,9 @@ static INTERVAL interval_free_list; __asan_unpoison_memory_region ((b)->intervals, \ sizeof ((b)->intervals)) # define ASAN_POISON_INTERVAL(i) \ - __asan_poison_memory_region ((i), sizeof (*(i))) + __asan_poison_memory_region (i, sizeof *(i)) # define ASAN_UNPOISON_INTERVAL(i) \ - __asan_unpoison_memory_region ((i), sizeof (*(i))) + __asan_unpoison_memory_region (i, sizeof *(i)) #else # define ASAN_POISON_INTERVAL_BLOCK(b) ((void) 0) # define ASAN_UNPOISON_INTERVAL_BLOCK(b) ((void) 0) @@ -1752,25 +1752,25 @@ init_strings (void) */ # define ASAN_PREPARE_DEAD_SDATA(s, size) \ do { \ - __asan_poison_memory_region ((s), sdata_size ((size))); \ - __asan_unpoison_memory_region (&(((s))->string), \ + __asan_poison_memory_region (s, sdata_size (size)); \ + __asan_unpoison_memory_region (&(s)->string, \ sizeof (struct Lisp_String *)); \ - __asan_unpoison_memory_region (&SDATA_NBYTES ((s)), \ - sizeof (SDATA_NBYTES ((s)))); \ + __asan_unpoison_memory_region (&SDATA_NBYTES (s), \ + sizeof SDATA_NBYTES (s)); \ } while (false) /* Prepare s for storing string data for NBYTES bytes. */ # define ASAN_PREPARE_LIVE_SDATA(s, nbytes) \ - __asan_unpoison_memory_region ((s), sdata_size ((nbytes))) + __asan_unpoison_memory_region (s, sdata_size (nbytes)) # define ASAN_POISON_SBLOCK_DATA(b, size) \ - __asan_poison_memory_region ((b)->data, (size)) + __asan_poison_memory_region ((b)->data, size) # define ASAN_POISON_STRING_BLOCK(b) \ __asan_poison_memory_region ((b)->strings, STRING_BLOCK_SIZE) # define ASAN_UNPOISON_STRING_BLOCK(b) \ __asan_unpoison_memory_region ((b)->strings, STRING_BLOCK_SIZE) # define ASAN_POISON_STRING(s) \ - __asan_poison_memory_region ((s), sizeof (*(s))) + __asan_poison_memory_region (s, sizeof *(s)) # define ASAN_UNPOISON_STRING(s) \ - __asan_unpoison_memory_region ((s), sizeof (*(s))) + __asan_unpoison_memory_region (s, sizeof *(s)) #else # define ASAN_PREPARE_DEAD_SDATA(s, size) ((void) 0) # define ASAN_PREPARE_LIVE_SDATA(s, nbytes) ((void) 0) @@ -2691,13 +2691,13 @@ struct float_block }; #define XFLOAT_MARKED_P(fptr) \ - GETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX ((fptr))) + GETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX (fptr)) #define XFLOAT_MARK(fptr) \ - SETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX ((fptr))) + SETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX (fptr)) #define XFLOAT_UNMARK(fptr) \ - UNSETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX ((fptr))) + UNSETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX (fptr)) #if GC_ASAN_POISON_OBJECTS # define ASAN_POISON_FLOAT_BLOCK(fblk) \ @@ -2707,9 +2707,9 @@ struct float_block __asan_unpoison_memory_region ((fblk)->floats, \ sizeof ((fblk)->floats)) # define ASAN_POISON_FLOAT(p) \ - __asan_poison_memory_region ((p), sizeof (struct Lisp_Float)) + __asan_poison_memory_region (p, sizeof (struct Lisp_Float)) # define ASAN_UNPOISON_FLOAT(p) \ - __asan_unpoison_memory_region ((p), sizeof (struct Lisp_Float)) + __asan_unpoison_memory_region (p, sizeof (struct Lisp_Float)) #else # define ASAN_POISON_FLOAT_BLOCK(fblk) ((void) 0) # define ASAN_UNPOISON_FLOAT_BLOCK(fblk) ((void) 0) @@ -2803,13 +2803,13 @@ struct cons_block }; #define XCONS_MARKED_P(fptr) \ - GETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr))) + GETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX (fptr)) #define XMARK_CONS(fptr) \ - SETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr))) + SETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX (fptr)) #define XUNMARK_CONS(fptr) \ - UNSETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr))) + UNSETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX (fptr)) /* Minimum number of bytes of consing since GC before next GC, when memory is full. */ @@ -2832,9 +2832,9 @@ static struct Lisp_Cons *cons_free_list; # define ASAN_POISON_CONS_BLOCK(b) \ __asan_poison_memory_region ((b)->conses, sizeof ((b)->conses)) # define ASAN_POISON_CONS(p) \ - __asan_poison_memory_region ((p), sizeof (struct Lisp_Cons)) + __asan_poison_memory_region (p, sizeof (struct Lisp_Cons)) # define ASAN_UNPOISON_CONS(p) \ - __asan_unpoison_memory_region ((p), sizeof (struct Lisp_Cons)) + __asan_unpoison_memory_region (p, sizeof (struct Lisp_Cons)) #else # define ASAN_POISON_CONS_BLOCK(b) ((void) 0) # define ASAN_POISON_CONS(p) ((void) 0) @@ -3152,11 +3152,11 @@ Lisp_Object zero_vector; #if GC_ASAN_POISON_OBJECTS # define ASAN_POISON_VECTOR_CONTENTS(v, bytes) \ - __asan_poison_memory_region ((v)->contents, (bytes)) + __asan_poison_memory_region ((v)->contents, bytes) # define ASAN_UNPOISON_VECTOR_CONTENTS(v, bytes) \ - __asan_unpoison_memory_region ((v)->contents, (bytes)) + __asan_unpoison_memory_region ((v)->contents, bytes) # define ASAN_UNPOISON_VECTOR_BLOCK(b) \ - __asan_unpoison_memory_region ((b)->data, sizeof ((b)->data)) + __asan_unpoison_memory_region ((b)->data, sizeof (b)->data) #else # define ASAN_POISON_VECTOR_CONTENTS(v, bytes) ((void) 0) # define ASAN_UNPOISON_VECTOR_CONTENTS(v, bytes) ((void) 0) @@ -3886,9 +3886,9 @@ struct symbol_block # define ASAN_UNPOISON_SYMBOL_BLOCK(s) \ __asan_unpoison_memory_region ((s)->symbols, sizeof ((s)->symbols)) # define ASAN_POISON_SYMBOL(sym) \ - __asan_poison_memory_region ((sym), sizeof (*(sym))) + __asan_poison_memory_region (sym, sizeof *(sym)) # define ASAN_UNPOISON_SYMBOL(sym) \ - __asan_unpoison_memory_region ((sym), sizeof (*(sym))) + __asan_unpoison_memory_region (sym, sizeof *(sym)) #else # define ASAN_POISON_SYMBOL_BLOCK(s) ((void) 0) diff --git a/src/android.c b/src/android.c index fb7703d84ab..509f30a759b 100644 --- a/src/android.c +++ b/src/android.c @@ -6008,7 +6008,7 @@ android_build_jstring (const char *text) is created. */ #if __GNUC__ >= 3 -#define likely(cond) __builtin_expect ((cond), 1) +#define likely(cond) __builtin_expect (cond, 1) #else /* __GNUC__ < 3 */ #define likely(cond) (cond) #endif /* __GNUC__ >= 3 */ diff --git a/src/android.h b/src/android.h index 1059933d339..2f5f32037c5 100644 --- a/src/android.h +++ b/src/android.h @@ -309,7 +309,7 @@ extern struct timespec emacs_installation_time; #define ANDROID_DELETE_LOCAL_REF(ref) \ ((*android_java_env)->DeleteLocalRef (android_java_env, \ - (ref))) + ref)) #define NATIVE_NAME(name) Java_org_gnu_emacs_EmacsNative_##name diff --git a/src/androidterm.h b/src/androidterm.h index 7568055a20b..41c93067e82 100644 --- a/src/androidterm.h +++ b/src/androidterm.h @@ -298,8 +298,8 @@ enum code after any drawing command, but code can be run whenever someone asks for the handle necessary to draw. */ #define FRAME_ANDROID_DRAWABLE(f) \ - (((f))->output_data.android->need_buffer_flip = true, \ - FRAME_ANDROID_WINDOW ((f))) + ((f)->output_data.android->need_buffer_flip = true, \ + FRAME_ANDROID_WINDOW (f)) /* Return whether or not the frame F has been completely drawn. Used while handling async input. */ diff --git a/src/buffer.h b/src/buffer.h index 80edfdcbc22..9e0982f5da7 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -216,7 +216,7 @@ extern ptrdiff_t advance_to_char_boundary (ptrdiff_t byte_pos); /* Return the byte at byte position N. Do not check that the position is in range. */ -#define FETCH_BYTE(n) *(BYTE_POS_ADDR ((n))) +#define FETCH_BYTE(n) (*BYTE_POS_ADDR (n)) /* Define the actual buffer data structures. */ diff --git a/src/ccl.c b/src/ccl.c index 7df50ba7022..a3a03a5b7b1 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -51,7 +51,7 @@ static Lisp_Object Vccl_program_table; /* Return a hash table of id number ID. */ #define GET_HASH_TABLE(id) \ - (XHASH_TABLE (XCDR (AREF (Vtranslation_hash_table_vector, (id))))) + XHASH_TABLE (XCDR (AREF (Vtranslation_hash_table_vector, id))) /* CCL (Code Conversion Language) is a simple language which has operations on one input buffer, one output buffer, and 7 registers. @@ -627,7 +627,7 @@ do \ { \ struct ccl_program called_ccl; \ if (stack_idx >= 256 \ - || ! setup_ccl_program (&called_ccl, (symbol))) \ + || ! setup_ccl_program (&called_ccl, symbol)) \ { \ if (stack_idx > 0) \ { \ @@ -818,7 +818,7 @@ while (0) #define CCL_DECODE_CHAR(id, code) \ ((id) == 0 ? (code) \ - : (charset = CHARSET_FROM_ID ((id)), DECODE_CHAR (charset, (code)))) + : (charset = CHARSET_FROM_ID (id), DECODE_CHAR (charset, code))) /* Encode character C by some of charsets in CHARSET_LIST. Set ID to the id of the used charset, ENCODED to the result of encoding. @@ -828,9 +828,9 @@ while (0) do { \ unsigned ncode; \ \ - charset = char_charset ((c), (charset_list), &ncode); \ + charset = char_charset (c, charset_list, &ncode); \ if (! charset && ! NILP (charset_list)) \ - charset = char_charset ((c), Qnil, &ncode); \ + charset = char_charset (c, Qnil, &ncode); \ if (charset) \ { \ (id) = CHARSET_ID (charset); \ diff --git a/src/ccl.h b/src/ccl.h index 8eb9d7eb2e8..b8bdcad4c32 100644 --- a/src/ccl.h +++ b/src/ccl.h @@ -82,7 +82,7 @@ extern void ccl_driver (struct ccl_program *, int *, int *, int, int, #define CHECK_CCL_PROGRAM(x) \ do { \ if (NILP (Fccl_program_p (x))) \ - wrong_type_argument (Qcclp, (x)); \ + wrong_type_argument (Qcclp, x); \ } while (false); #endif /* EMACS_CCL_H */ diff --git a/src/charset.c b/src/charset.c index 6a74f294ad8..f562af90cb2 100644 --- a/src/charset.c +++ b/src/charset.c @@ -1790,7 +1790,7 @@ encode_char (struct charset *charset, int c) return CHARSET_INVALID_CODE (charset); } - if (! CHARSET_FAST_MAP_REF ((c), charset->fast_map) + if (! CHARSET_FAST_MAP_REF (c, charset->fast_map) || c < CHARSET_MIN_CHAR (charset) || c > CHARSET_MAX_CHAR (charset)) return CHARSET_INVALID_CODE (charset); diff --git a/src/charset.h b/src/charset.h index 91454d3d73e..ba83cd5ccb2 100644 --- a/src/charset.h +++ b/src/charset.h @@ -267,18 +267,18 @@ extern int emacs_mule_charset[256]; /* Return the attribute vector of charset whose symbol is SYMBOL. */ #define CHARSET_SYMBOL_ATTRIBUTES(symbol) \ - Fgethash ((symbol), Vcharset_hash_table, Qnil) - -#define CHARSET_ATTR_ID(attrs) AREF ((attrs), charset_id) -#define CHARSET_ATTR_NAME(attrs) AREF ((attrs), charset_name) -#define CHARSET_ATTR_PLIST(attrs) AREF ((attrs), charset_plist) -#define CHARSET_ATTR_MAP(attrs) AREF ((attrs), charset_map) -#define CHARSET_ATTR_DECODER(attrs) AREF ((attrs), charset_decoder) -#define CHARSET_ATTR_ENCODER(attrs) AREF ((attrs), charset_encoder) -#define CHARSET_ATTR_SUBSET(attrs) AREF ((attrs), charset_subset) -#define CHARSET_ATTR_SUPERSET(attrs) AREF ((attrs), charset_superset) -#define CHARSET_ATTR_UNIFY_MAP(attrs) AREF ((attrs), charset_unify_map) -#define CHARSET_ATTR_DEUNIFIER(attrs) AREF ((attrs), charset_deunifier) + Fgethash (symbol, Vcharset_hash_table, Qnil) + +#define CHARSET_ATTR_ID(attrs) AREF (attrs, charset_id) +#define CHARSET_ATTR_NAME(attrs) AREF (attrs, charset_name) +#define CHARSET_ATTR_PLIST(attrs) AREF (attrs, charset_plist) +#define CHARSET_ATTR_MAP(attrs) AREF (attrs, charset_map) +#define CHARSET_ATTR_DECODER(attrs) AREF (attrs, charset_decoder) +#define CHARSET_ATTR_ENCODER(attrs) AREF (attrs, charset_encoder) +#define CHARSET_ATTR_SUBSET(attrs) AREF (attrs, charset_subset) +#define CHARSET_ATTR_SUPERSET(attrs) AREF (attrs, charset_superset) +#define CHARSET_ATTR_UNIFY_MAP(attrs) AREF (attrs, charset_unify_map) +#define CHARSET_ATTR_DEUNIFIER(attrs) AREF (attrs, charset_deunifier) #define CHARSET_SYMBOL_ID(symbol) \ CHARSET_ATTR_ID (CHARSET_SYMBOL_ATTRIBUTES (symbol)) @@ -290,7 +290,7 @@ extern int emacs_mule_charset[256]; /* Return the attribute vector of CHARSET. */ #define CHARSET_ATTRIBUTES(charset) \ - (HASH_VALUE (XHASH_TABLE (Vcharset_hash_table), (charset)->hash_index)) + HASH_VALUE (XHASH_TABLE (Vcharset_hash_table), (charset)->hash_index) #define CHARSET_ID(charset) ((charset)->id) #define CHARSET_HASH_INDEX(charset) ((charset)->hash_index) @@ -314,21 +314,21 @@ extern int emacs_mule_charset[256]; #define CHARSET_UNIFIED_P(charset) ((charset)->unified_p) #define CHARSET_NAME(charset) \ - (CHARSET_ATTR_NAME (CHARSET_ATTRIBUTES (charset))) + CHARSET_ATTR_NAME (CHARSET_ATTRIBUTES (charset)) #define CHARSET_MAP(charset) \ - (CHARSET_ATTR_MAP (CHARSET_ATTRIBUTES (charset))) + CHARSET_ATTR_MAP (CHARSET_ATTRIBUTES (charset)) #define CHARSET_DECODER(charset) \ - (CHARSET_ATTR_DECODER (CHARSET_ATTRIBUTES (charset))) + CHARSET_ATTR_DECODER (CHARSET_ATTRIBUTES (charset)) #define CHARSET_ENCODER(charset) \ - (CHARSET_ATTR_ENCODER (CHARSET_ATTRIBUTES (charset))) + CHARSET_ATTR_ENCODER (CHARSET_ATTRIBUTES (charset)) #define CHARSET_SUBSET(charset) \ - (CHARSET_ATTR_SUBSET (CHARSET_ATTRIBUTES (charset))) + CHARSET_ATTR_SUBSET (CHARSET_ATTRIBUTES (charset)) #define CHARSET_SUPERSET(charset) \ - (CHARSET_ATTR_SUPERSET (CHARSET_ATTRIBUTES (charset))) + CHARSET_ATTR_SUPERSET (CHARSET_ATTRIBUTES (charset)) #define CHARSET_UNIFY_MAP(charset) \ - (CHARSET_ATTR_UNIFY_MAP (CHARSET_ATTRIBUTES (charset))) + CHARSET_ATTR_UNIFY_MAP (CHARSET_ATTRIBUTES (charset)) #define CHARSET_DEUNIFIER(charset) \ - (CHARSET_ATTR_DEUNIFIER (CHARSET_ATTRIBUTES (charset))) + CHARSET_ATTR_DEUNIFIER (CHARSET_ATTRIBUTES (charset)) INLINE void set_charset_attr (struct charset *charset, enum charset_attr_index idx, @@ -345,7 +345,7 @@ set_charset_attr (struct charset *charset, enum charset_attr_index idx, #define CHECK_CHARSET(x) \ do { \ if (! SYMBOLP (x) || CHARSET_SYMBOL_HASH_INDEX (x) < 0) \ - wrong_type_argument (Qcharsetp, (x)); \ + wrong_type_argument (Qcharsetp, x); \ } while (false) @@ -356,7 +356,7 @@ set_charset_attr (struct charset *charset, enum charset_attr_index idx, ptrdiff_t idx; \ \ if (! SYMBOLP (x) || (idx = CHARSET_SYMBOL_HASH_INDEX (x)) < 0) \ - wrong_type_argument (Qcharsetp, (x)); \ + wrong_type_argument (Qcharsetp, x); \ id = XFIXNUM (AREF (HASH_VALUE (XHASH_TABLE (Vcharset_hash_table), idx), \ charset_id)); \ } while (false) @@ -367,7 +367,7 @@ set_charset_attr (struct charset *charset, enum charset_attr_index idx, #define CHECK_CHARSET_GET_ATTR(x, attr) \ do { \ if (!SYMBOLP (x) || NILP (attr = CHARSET_SYMBOL_ATTRIBUTES (x))) \ - wrong_type_argument (Qcharsetp, (x)); \ + wrong_type_argument (Qcharsetp, x); \ } while (false) @@ -383,7 +383,7 @@ set_charset_attr (struct charset *charset, enum charset_attr_index idx, contains the character C. */ #define CHAR_CHARSET(c) \ ((c) < 0x80 ? CHARSET_FROM_ID (charset_ascii) \ - : char_charset ((c), Qnil, NULL)) + : char_charset (c, Qnil, NULL)) #if false /* Char-table of charset-sets. Each element is a bool vector indexed @@ -410,18 +410,18 @@ extern Lisp_Object Vchar_charset_set; : ((code) < (charset)->min_code || (code) > (charset)->max_code) \ ? -1 \ : (charset)->unified_p \ - ? decode_char ((charset), (code)) \ + ? decode_char (charset, code) \ : (charset)->method == CHARSET_METHOD_OFFSET \ ? ((charset)->code_linear_p \ ? (int) ((code) - (charset)->min_code) + (charset)->code_offset \ - : decode_char ((charset), (code))) \ + : decode_char (charset, code)) \ : (charset)->method == CHARSET_METHOD_MAP \ ? (((charset)->code_linear_p \ && VECTORP (CHARSET_DECODER (charset))) \ ? XFIXNUM (AREF (CHARSET_DECODER (charset), \ (code) - (charset)->min_code)) \ - : decode_char ((charset), (code))) \ - : decode_char ((charset), (code))) + : decode_char (charset, code)) \ + : decode_char (charset, code)) extern Lisp_Object charset_work; @@ -462,7 +462,7 @@ extern bool charset_map_loaded; /* Set CHARSET to the charset highest priority of C, CODE to the code-point of C in CHARSET. */ #define SPLIT_CHAR(c, charset, code) \ - ((charset) = char_charset ((c), Qnil, &(code))) + ((charset) = char_charset (c, Qnil, &(code))) #define ISO_MAX_DIMENSION 3 @@ -501,15 +501,15 @@ extern int iso_charset_table[ISO_MAX_DIMENSION][ISO_MAX_CHARS][ISO_MAX_FINAL]; || ((CHARSET_UNIFIED_P (charset) \ || (charset)->method == CHARSET_METHOD_SUBSET \ || (charset)->method == CHARSET_METHOD_SUPERSET) \ - ? encode_char ((charset), (c)) != (charset)->invalid_code \ - : (CHARSET_FAST_MAP_REF ((c), (charset)->fast_map) \ + ? encode_char (charset, c) != (charset)->invalid_code \ + : (CHARSET_FAST_MAP_REF (c, (charset)->fast_map) \ && ((charset)->method == CHARSET_METHOD_OFFSET \ ? (c) >= (charset)->min_char && (c) <= (charset)->max_char \ : ((charset)->method == CHARSET_METHOD_MAP \ && (charset)->compact_codes_p \ && CHAR_TABLE_P (CHARSET_ENCODER (charset))) \ - ? ! NILP (CHAR_TABLE_REF (CHARSET_ENCODER (charset), (c))) \ - : encode_char ((charset), (c)) != (charset)->invalid_code)))) + ? ! NILP (CHAR_TABLE_REF (CHARSET_ENCODER (charset), c)) \ + : encode_char (charset, c) != (charset)->invalid_code)))) /* Special macros for emacs-mule encoding. */ diff --git a/src/coding.c b/src/coding.c index a5bec8b6305..5f3ceab718b 100644 --- a/src/coding.c +++ b/src/coding.c @@ -314,9 +314,9 @@ static Lisp_Object Vbig5_coding_system; /* ISO2022 section */ #define CODING_ISO_INITIAL(coding, reg) \ - (XFIXNUM (AREF (AREF (CODING_ID_ATTRS ((coding)->id), \ - coding_attr_iso_initial), \ - reg))) + XFIXNUM (AREF (AREF (CODING_ID_ATTRS ((coding)->id), \ + coding_attr_iso_initial), \ + reg)) #define CODING_ISO_REQUEST(coding, charset_id) \ @@ -466,7 +466,7 @@ enum iso_code_class_type #define CODING_CCL_ENCODER(coding) \ AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_encoder) #define CODING_CCL_VALIDS(coding) \ - (SDATA (AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_valids))) + SDATA (AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_valids)) /* Index for each coding category in `coding_categories' */ @@ -4198,12 +4198,12 @@ decode_coding_iso_2022 (struct coding_system *coding) #define ENCODE_ISO_CHARACTER(charset, c) \ do { \ unsigned code; \ - CODING_ENCODE_CHAR (coding, dst, dst_end, (charset), (c), code); \ + CODING_ENCODE_CHAR (coding, dst, dst_end, charset, c, code); \ \ if (CHARSET_DIMENSION (charset) == 1) \ - ENCODE_ISO_CHARACTER_DIMENSION1 ((charset), code); \ + ENCODE_ISO_CHARACTER_DIMENSION1 (charset, code); \ else \ - ENCODE_ISO_CHARACTER_DIMENSION2 ((charset), code >> 8, code & 0xFF); \ + ENCODE_ISO_CHARACTER_DIMENSION2 (charset, code >> 8, code & 0xFF); \ } while (0) diff --git a/src/coding.h b/src/coding.h index 9beb4350bbf..8905e36838d 100644 --- a/src/coding.h +++ b/src/coding.h @@ -166,28 +166,28 @@ enum coding_attr_index /* Return the name of a coding system specified by ID. */ #define CODING_ID_NAME(id) \ - (HASH_KEY (XHASH_TABLE (Vcoding_system_hash_table), id)) + HASH_KEY (XHASH_TABLE (Vcoding_system_hash_table), id) /* Return the attribute vector of a coding system specified by ID. */ #define CODING_ID_ATTRS(id) \ - (AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 0)) + AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 0) /* Return the list of aliases of a coding system specified by ID. */ #define CODING_ID_ALIASES(id) \ - (AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 1)) + AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 1) /* Return the eol-type of a coding system specified by ID. */ #define CODING_ID_EOL_TYPE(id) \ - (AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 2)) + AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 2) /* Return the spec vector of CODING_SYSTEM_SYMBOL. */ #define CODING_SYSTEM_SPEC(coding_system_symbol) \ - (Fgethash (coding_system_symbol, Vcoding_system_hash_table, Qnil)) + Fgethash (coding_system_symbol, Vcoding_system_hash_table, Qnil) /* Return the ID of CODING_SYSTEM_SYMBOL. */ @@ -209,7 +209,7 @@ enum coding_attr_index do { \ if (CODING_SYSTEM_ID (x) < 0 \ && NILP (Fcheck_coding_system (x))) \ - wrong_type_argument (Qcoding_system_p, (x)); \ + wrong_type_argument (Qcoding_system_p, x); \ } while (false) @@ -225,7 +225,7 @@ enum coding_attr_index spec = CODING_SYSTEM_SPEC (x); \ } \ if (NILP (spec)) \ - wrong_type_argument (Qcoding_system_p, (x)); \ + wrong_type_argument (Qcoding_system_p, x); \ } while (false) @@ -242,7 +242,7 @@ enum coding_attr_index id = CODING_SYSTEM_ID (x); \ } \ if (id < 0) \ - wrong_type_argument (Qcoding_system_p, (x)); \ + wrong_type_argument (Qcoding_system_p, x); \ } while (false) @@ -745,10 +745,9 @@ extern Lisp_Object from_unicode_buffer (const wchar_t *wstr); #define decode_coding_c_string(coding, src, bytes, dst_object) \ do { \ - (coding)->source = (src); \ - (coding)->src_chars = (coding)->src_bytes = (bytes); \ - decode_coding_object ((coding), Qnil, 0, 0, (bytes), (bytes), \ - (dst_object)); \ + (coding)->source = src; \ + (coding)->src_chars = (coding)->src_bytes = bytes; \ + decode_coding_object (coding, Qnil, 0, 0, bytes, bytes, dst_object); \ } while (false) diff --git a/src/comp.c b/src/comp.c index 2872c28a2b1..3f9e738d9a7 100644 --- a/src/comp.c +++ b/src/comp.c @@ -522,7 +522,7 @@ load_gccjit_if_necessary (bool mandatory) #define DECL_BLOCK(name, func) \ gcc_jit_block *(name) = \ - gcc_jit_function_new_block ((func), STR (name)) + gcc_jit_function_new_block (func, STR (name)) #ifndef WINDOWSNT # ifdef HAVE__SETJMP diff --git a/src/composite.h b/src/composite.h index 4fe49b764e4..37f494d69e0 100644 --- a/src/composite.h +++ b/src/composite.h @@ -260,8 +260,8 @@ composition_valid_p (ptrdiff_t start, ptrdiff_t end, Lisp_Object prop) #define LGSTRING_CHAR(lgs, i) AREF (LGSTRING_HEADER (lgs), (i) + 1) #define LGSTRING_CHAR_LEN(lgs) (ASIZE (LGSTRING_HEADER (lgs)) - 1) -#define LGSTRING_SET_FONT(lgs, val) ASET (LGSTRING_HEADER (lgs), 0, (val)) -#define LGSTRING_SET_CHAR(lgs, i, c) ASET (LGSTRING_HEADER (lgs), (i) + 1, (c)) +#define LGSTRING_SET_FONT(lgs, val) ASET (LGSTRING_HEADER (lgs), 0, val) +#define LGSTRING_SET_CHAR(lgs, i, c) ASET (LGSTRING_HEADER (lgs), (i) + 1, c) #define LGSTRING_ID(lgs) AREF (lgs, 1) #define LGSTRING_SET_ID(lgs, id) ASET (lgs, 1, id) @@ -270,9 +270,9 @@ composition_valid_p (ptrdiff_t start, ptrdiff_t end, Lisp_Object prop) LGSTRING can hold. This is NOT the actual number of valid LGLYPHs; to find the latter, walk the glyphs returned by LGSTRING_GLYPH until the first one that is nil. */ -#define LGSTRING_GLYPH_LEN(lgs) (ASIZE ((lgs)) - 2) -#define LGSTRING_GLYPH(lgs, idx) AREF ((lgs), (idx) + 2) -#define LGSTRING_SET_GLYPH(lgs, idx, val) ASET ((lgs), (idx) + 2, (val)) +#define LGSTRING_GLYPH_LEN(lgs) (ASIZE (lgs) - 2) +#define LGSTRING_GLYPH(lgs, idx) AREF (lgs, (idx) + 2) +#define LGSTRING_SET_GLYPH(lgs, idx, val) ASET (lgs, (idx) + 2, val) INLINE Lisp_Object * lgstring_glyph_addr (Lisp_Object lgs, ptrdiff_t idx) { @@ -298,33 +298,33 @@ enum lglyph_indices contributed to the glyph (since there isn't a 1:1 correspondence between composed characters and the font glyphs). */ #define LGLYPH_NEW() make_nil_vector (LGLYPH_SIZE) -#define LGLYPH_FROM(g) XFIXNUM (AREF ((g), LGLYPH_IX_FROM)) -#define LGLYPH_TO(g) XFIXNUM (AREF ((g), LGLYPH_IX_TO)) -#define LGLYPH_CHAR(g) XFIXNUM (AREF ((g), LGLYPH_IX_CHAR)) +#define LGLYPH_FROM(g) XFIXNUM (AREF (g, LGLYPH_IX_FROM)) +#define LGLYPH_TO(g) XFIXNUM (AREF (g, LGLYPH_IX_TO)) +#define LGLYPH_CHAR(g) XFIXNUM (AREF (g, LGLYPH_IX_CHAR)) #define LGLYPH_CODE(g) \ - (NILP (AREF ((g), LGLYPH_IX_CODE)) \ + (NILP (AREF (g, LGLYPH_IX_CODE)) \ ? FONT_INVALID_CODE \ : cons_to_unsigned (AREF (g, LGLYPH_IX_CODE), TYPE_MAXIMUM (unsigned))) -#define LGLYPH_WIDTH(g) XFIXNUM (AREF ((g), LGLYPH_IX_WIDTH)) -#define LGLYPH_LBEARING(g) XFIXNUM (AREF ((g), LGLYPH_IX_LBEARING)) -#define LGLYPH_RBEARING(g) XFIXNUM (AREF ((g), LGLYPH_IX_RBEARING)) -#define LGLYPH_ASCENT(g) XFIXNUM (AREF ((g), LGLYPH_IX_ASCENT)) -#define LGLYPH_DESCENT(g) XFIXNUM (AREF ((g), LGLYPH_IX_DESCENT)) -#define LGLYPH_ADJUSTMENT(g) AREF ((g), LGLYPH_IX_ADJUSTMENT) -#define LGLYPH_SET_FROM(g, val) ASET ((g), LGLYPH_IX_FROM, make_fixnum (val)) -#define LGLYPH_SET_TO(g, val) ASET ((g), LGLYPH_IX_TO, make_fixnum (val)) -#define LGLYPH_SET_CHAR(g, val) ASET ((g), LGLYPH_IX_CHAR, make_fixnum (val)) +#define LGLYPH_WIDTH(g) XFIXNUM (AREF (g, LGLYPH_IX_WIDTH)) +#define LGLYPH_LBEARING(g) XFIXNUM (AREF (g, LGLYPH_IX_LBEARING)) +#define LGLYPH_RBEARING(g) XFIXNUM (AREF (g, LGLYPH_IX_RBEARING)) +#define LGLYPH_ASCENT(g) XFIXNUM (AREF (g, LGLYPH_IX_ASCENT)) +#define LGLYPH_DESCENT(g) XFIXNUM (AREF (g, LGLYPH_IX_DESCENT)) +#define LGLYPH_ADJUSTMENT(g) AREF (g, LGLYPH_IX_ADJUSTMENT) +#define LGLYPH_SET_FROM(g, val) ASET (g, LGLYPH_IX_FROM, make_fixnum (val)) +#define LGLYPH_SET_TO(g, val) ASET (g, LGLYPH_IX_TO, make_fixnum (val)) +#define LGLYPH_SET_CHAR(g, val) ASET (g, LGLYPH_IX_CHAR, make_fixnum (val)) /* Callers must assure that VAL is not negative! */ #define LGLYPH_SET_CODE(g, val) \ ASET (g, LGLYPH_IX_CODE, \ val == FONT_INVALID_CODE ? Qnil : INT_TO_INTEGER (val)) -#define LGLYPH_SET_WIDTH(g, val) ASET ((g), LGLYPH_IX_WIDTH, make_fixnum (val)) -#define LGLYPH_SET_LBEARING(g, val) ASET ((g), LGLYPH_IX_LBEARING, make_fixnum (val)) -#define LGLYPH_SET_RBEARING(g, val) ASET ((g), LGLYPH_IX_RBEARING, make_fixnum (val)) -#define LGLYPH_SET_ASCENT(g, val) ASET ((g), LGLYPH_IX_ASCENT, make_fixnum (val)) -#define LGLYPH_SET_DESCENT(g, val) ASET ((g), LGLYPH_IX_DESCENT, make_fixnum (val)) -#define LGLYPH_SET_ADJUSTMENT(g, val) ASET ((g), LGLYPH_IX_ADJUSTMENT, (val)) +#define LGLYPH_SET_WIDTH(g, val) ASET (g, LGLYPH_IX_WIDTH, make_fixnum (val)) +#define LGLYPH_SET_LBEARING(g, val) ASET (g, LGLYPH_IX_LBEARING, make_fixnum (val)) +#define LGLYPH_SET_RBEARING(g, val) ASET (g, LGLYPH_IX_RBEARING, make_fixnum (val)) +#define LGLYPH_SET_ASCENT(g, val) ASET (g, LGLYPH_IX_ASCENT, make_fixnum (val)) +#define LGLYPH_SET_DESCENT(g, val) ASET (g, LGLYPH_IX_DESCENT, make_fixnum (val)) +#define LGLYPH_SET_ADJUSTMENT(g, val) ASET (g, LGLYPH_IX_ADJUSTMENT, val) #define LGLYPH_XOFF(g) (VECTORP (LGLYPH_ADJUSTMENT (g)) \ ? XFIXNUM (AREF (LGLYPH_ADJUSTMENT (g), 0)) : 0) diff --git a/src/conf_post.h b/src/conf_post.h index 7701bcf40b2..83a0dd1b09b 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -178,8 +178,8 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */ /* Things that lib/reg* wants. */ -#define mbrtowc(pwc, s, n, ps) mbtowc ((pwc), (s), (n)) -#define wcrtomb(s, wc, ps) wctomb ((s), (wc)) +#define mbrtowc(pwc, s, n, ps) mbtowc (pwc, s, n) +#define wcrtomb(s, wc, ps) wctomb (s, wc) #define btowc(b) ((wchar_t) (b)) #define towupper(chr) toupper (chr) #define towlower(chr) tolower (chr) @@ -317,7 +317,7 @@ extern int emacs_setenv_TZ (char const *); type _GL_ATTRIBUTE_MAY_ALIAS *name = (type *) (addr) #if 3 <= __GNUC__ -# define ATTRIBUTE_SECTION(name) __attribute__((section (name))) +# define ATTRIBUTE_SECTION(name) __attribute__ ((section (name))) #else # define ATTRIBUTE_SECTION(name) #endif diff --git a/src/dispextern.h b/src/dispextern.h index 6cab3ff243e..84b9dadc184 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -315,7 +315,7 @@ struct text_pos /* Set marker MARKER from text position POS. */ #define SET_MARKER_FROM_TEXT_POS(MARKER, POS) \ - set_marker_both ((MARKER), Qnil, CHARPOS ((POS)), BYTEPOS ((POS))) + set_marker_both (MARKER, Qnil, CHARPOS (POS), BYTEPOS (POS)) /* Value is non-zero if character and byte positions of POS1 and POS2 are equal. */ @@ -399,7 +399,7 @@ GLYPH_CODE_FACE (Lisp_Object gc) SET_GLYPH (glyph, XFIXNUM (XCAR (gc)), XFIXNUM (XCDR (gc))); \ else \ SET_GLYPH (glyph, (XFIXNUM (gc) & ((1 << CHARACTERBITS)-1)), \ - (XFIXNUM (gc) >> CHARACTERBITS)); \ + XFIXNUM (gc) >> CHARACTERBITS); \ } \ while (false) @@ -676,9 +676,9 @@ struct glyph defined in lisp.h. */ #define SET_CHAR_GLYPH_FROM_GLYPH(GLYPH, FROM) \ - SET_CHAR_GLYPH ((GLYPH), \ - GLYPH_CHAR ((FROM)), \ - GLYPH_FACE ((FROM)), \ + SET_CHAR_GLYPH (GLYPH, \ + GLYPH_CHAR (FROM), \ + GLYPH_FACE (FROM), \ false) /* Construct a glyph code from a character glyph GLYPH. If the @@ -689,9 +689,9 @@ struct glyph do \ { \ if ((GLYPH).u.ch < 256) \ - SET_GLYPH ((G), (GLYPH).u.ch, ((GLYPH).face_id)); \ + SET_GLYPH (G, (GLYPH).u.ch, (GLYPH).face_id); \ else \ - SET_GLYPH ((G), -1, 0); \ + SET_GLYPH (G, -1, 0); \ } \ while (false) @@ -837,7 +837,7 @@ struct glyph_matrix #ifdef GLYPH_DEBUG void check_matrix_pointer_lossage (struct glyph_matrix *); -#define CHECK_MATRIX(MATRIX) check_matrix_pointer_lossage ((MATRIX)) +#define CHECK_MATRIX(MATRIX) check_matrix_pointer_lossage (MATRIX) #else #define CHECK_MATRIX(MATRIX) ((void) 0) #endif @@ -1130,7 +1130,7 @@ struct glyph_row #ifdef GLYPH_DEBUG struct glyph_row *matrix_row (struct glyph_matrix *, int); -#define MATRIX_ROW(MATRIX, ROW) matrix_row ((MATRIX), (ROW)) +#define MATRIX_ROW(MATRIX, ROW) matrix_row (MATRIX, ROW) #else #define MATRIX_ROW(MATRIX, ROW) ((MATRIX)->rows + (ROW)) #endif @@ -1166,12 +1166,12 @@ struct glyph_row *matrix_row (struct glyph_matrix *, int); MATRIX. */ #define MATRIX_ROW_GLYPH_START(MATRIX, ROW) \ - (MATRIX_ROW ((MATRIX), (ROW))->glyphs[TEXT_AREA]) + (MATRIX_ROW (MATRIX, ROW)->glyphs[TEXT_AREA]) /* Return the number of used glyphs in the text area of a row. */ #define MATRIX_ROW_USED(MATRIX, ROW) \ - (MATRIX_ROW ((MATRIX), (ROW))->used[TEXT_AREA]) + (MATRIX_ROW (MATRIX, ROW)->used[TEXT_AREA]) /* Return the character/ byte position at which the display of ROW starts. BIDI Note: this is the smallest character/byte position @@ -1201,7 +1201,7 @@ struct glyph_row *matrix_row (struct glyph_matrix *, int); #define MATRIX_BOTTOM_TEXT_ROW(MATRIX, W) \ ((MATRIX)->rows \ + (MATRIX)->nrows \ - - (window_wants_mode_line ((W)) ? 1 : 0)) + - (window_wants_mode_line (W) ? 1 : 0)) /* Non-zero if the face of the last glyph in ROW's text area has to be drawn to the end of the text area. */ @@ -1211,7 +1211,7 @@ struct glyph_row *matrix_row (struct glyph_matrix *, int); /* Set and query the enabled_p flag of glyph row ROW in MATRIX. */ #define SET_MATRIX_ROW_ENABLED_P(MATRIX, ROW, VALUE) \ - (MATRIX_ROW (MATRIX, ROW)->enabled_p = (VALUE)) + (MATRIX_ROW (MATRIX, ROW)->enabled_p = VALUE) #define MATRIX_ROW_ENABLED_P(MATRIX, ROW) \ (MATRIX_ROW (MATRIX, ROW)->enabled_p) @@ -1232,28 +1232,28 @@ struct glyph_row *matrix_row (struct glyph_matrix *, int); #define MR_PARTIALLY_VISIBLE_AT_BOTTOM(W, ROW) \ (((ROW)->y + (ROW)->height - (ROW)->extra_line_spacing) \ - > WINDOW_BOX_HEIGHT_NO_MODE_LINE ((W))) + > WINDOW_BOX_HEIGHT_NO_MODE_LINE (W)) /* Non-zero if ROW is not completely visible in window W. */ #define MATRIX_ROW_PARTIALLY_VISIBLE_P(W, ROW) \ - (MR_PARTIALLY_VISIBLE ((ROW)) \ - && (MR_PARTIALLY_VISIBLE_AT_TOP ((W), (ROW)) \ - || MR_PARTIALLY_VISIBLE_AT_BOTTOM ((W), (ROW)))) + (MR_PARTIALLY_VISIBLE (ROW) \ + && (MR_PARTIALLY_VISIBLE_AT_TOP (W, ROW) \ + || MR_PARTIALLY_VISIBLE_AT_BOTTOM (W, ROW))) /* Non-zero if ROW is partially visible at the top of window W. */ #define MATRIX_ROW_PARTIALLY_VISIBLE_AT_TOP_P(W, ROW) \ - (MR_PARTIALLY_VISIBLE ((ROW)) \ - && MR_PARTIALLY_VISIBLE_AT_TOP ((W), (ROW))) + (MR_PARTIALLY_VISIBLE (ROW) \ + && MR_PARTIALLY_VISIBLE_AT_TOP (W, ROW)) /* Non-zero if ROW is partially visible at the bottom of window W. */ #define MATRIX_ROW_PARTIALLY_VISIBLE_AT_BOTTOM_P(W, ROW) \ - (MR_PARTIALLY_VISIBLE ((ROW)) \ - && MR_PARTIALLY_VISIBLE_AT_BOTTOM ((W), (ROW))) + (MR_PARTIALLY_VISIBLE (ROW) \ + && MR_PARTIALLY_VISIBLE_AT_BOTTOM (W, ROW)) /* Return the bottom Y + 1 of ROW. */ @@ -1263,7 +1263,7 @@ struct glyph_row *matrix_row (struct glyph_matrix *, int); iterator structure pointed to by IT?. */ #define MATRIX_ROW_LAST_VISIBLE_P(ROW, IT) \ - (MATRIX_ROW_BOTTOM_Y ((ROW)) >= (IT)->last_visible_y) + (MATRIX_ROW_BOTTOM_Y (ROW) >= (IT)->last_visible_y) /* Non-zero if ROW displays a continuation line. */ @@ -1537,9 +1537,9 @@ struct glyph_string /* Return the desired face id for the mode line of window W. */ #define CURRENT_MODE_LINE_ACTIVE_FACE_ID(W) \ - (CURRENT_MODE_LINE_ACTIVE_FACE_ID_3((W), \ + CURRENT_MODE_LINE_ACTIVE_FACE_ID_3(W, \ XWINDOW (selected_window), \ - (W))) + W) /* Return the current height of the mode line of window W. If not known from W->mode_line_height, look at W's current glyph matrix, or return @@ -1625,8 +1625,8 @@ struct glyph_string #define VCENTER_BASELINE_OFFSET(FONT, F) \ (FONT_DESCENT (FONT) \ - + (FRAME_LINE_HEIGHT ((F)) - FONT_HEIGHT ((FONT)) \ - + (FRAME_LINE_HEIGHT ((F)) > FONT_HEIGHT ((FONT)))) / 2 \ + + (FRAME_LINE_HEIGHT (F) - FONT_HEIGHT (FONT) \ + + (FRAME_LINE_HEIGHT (F) > FONT_HEIGHT (FONT))) / 2 \ - (FONT_DESCENT (FRAME_FONT (F)) - FRAME_BASELINE_OFFSET (F))) /* A heuristic test for fonts that claim they need a preposterously @@ -2858,12 +2858,12 @@ struct it if ((IT)->glyph_row != NULL && (IT)->bidi_p) \ (IT)->glyph_row->reversed_p = (IT)->bidi_it.paragraph_dir == R2L; \ if (FRAME_RIF ((IT)->f) != NULL) \ - FRAME_RIF ((IT)->f)->produce_glyphs ((IT)); \ + FRAME_RIF ((IT)->f)->produce_glyphs (IT); \ else \ - produce_glyphs ((IT)); \ + produce_glyphs (IT); \ if ((IT)->glyph_row != NULL) \ inhibit_free_realized_faces =true; \ - reset_box_start_end_flags ((IT)); \ + reset_box_start_end_flags (IT); \ } while (false) /* Bit-flags indicating what operation move_it_to should perform. */ diff --git a/src/dispnew.c b/src/dispnew.c index d0f259eef6c..c204a9dbf1b 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -134,8 +134,8 @@ static struct frame *frame_matrix_frame; static int window_to_frame_vpos (struct window *, int); static int window_to_frame_hpos (struct window *, int); -#define WINDOW_TO_FRAME_VPOS(W, VPOS) window_to_frame_vpos ((W), (VPOS)) -#define WINDOW_TO_FRAME_HPOS(W, HPOS) window_to_frame_hpos ((W), (HPOS)) +#define WINDOW_TO_FRAME_VPOS(W, VPOS) window_to_frame_vpos (W, VPOS) +#define WINDOW_TO_FRAME_HPOS(W, HPOS) window_to_frame_hpos (W, HPOS) /* One element of the ring buffer containing redisplay history information. */ @@ -5240,7 +5240,7 @@ count_match (struct glyph *str1, struct glyph *end1, struct glyph *str2, struct /* Char insertion/deletion cost vector, from term.c */ #ifndef HAVE_ANDROID -#define char_ins_del_cost(f) (&char_ins_del_vector[FRAME_TOTAL_COLS ((f))]) +#define char_ins_del_cost(f) (&char_ins_del_vector[FRAME_TOTAL_COLS (f)]) #endif diff --git a/src/disptab.h b/src/disptab.h index d63d19ae754..2080181610a 100644 --- a/src/disptab.h +++ b/src/disptab.h @@ -39,13 +39,13 @@ along with GNU Emacs. If not, see . */ extern Lisp_Object disp_char_vector (struct Lisp_Char_Table *, int); #define DISP_CHAR_VECTOR(dp, c) \ - (ASCII_CHAR_P(c) \ + (ASCII_CHAR_P (c) \ ? (NILP ((dp)->ascii) \ ? (dp)->defalt \ : (SUB_CHAR_TABLE_P ((dp)->ascii) \ ? XSUB_CHAR_TABLE ((dp)->ascii)->contents[c] \ : (dp)->ascii)) \ - : disp_char_vector ((dp), (c))) + : disp_char_vector (dp, c)) /* Defined in window.c. */ extern struct Lisp_Char_Table *window_display_table (struct window *); @@ -78,8 +78,8 @@ extern struct Lisp_Char_Table *buffer_display_table (void); LENGTH), and set G to the final glyph. */ #define GLYPH_FOLLOW_ALIASES(base, length, g) \ do { \ - while (GLYPH_ALIAS_P ((base), (length), (g))) \ - SET_GLYPH_CHAR ((g), XFIXNUM ((base)[GLYPH_CHAR (g)])); \ + while (GLYPH_ALIAS_P (base, length, g)) \ + SET_GLYPH_CHAR (g, XFIXNUM ((base)[GLYPH_CHAR (g)])); \ if (!GLYPH_CHAR_VALID_P (g)) \ SET_GLYPH_CHAR (g, ' '); \ } while (false) diff --git a/src/editfns.c b/src/editfns.c index 7b84f71f4a8..0cecd81c07f 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -1908,7 +1908,7 @@ determines whether case is significant or ignored. */) #define USE_HEURISTIC #define XVECREF_YVECREF_EQUAL(ctx, xoff, yoff) \ - buffer_chars_equal ((ctx), (xoff), (yoff)) + buffer_chars_equal (ctx, xoff, yoff) #define OFFSET ptrdiff_t diff --git a/src/emacsgtkfixed.h b/src/emacsgtkfixed.h index 9fa9ef79278..2db78fd00b5 100644 --- a/src/emacsgtkfixed.h +++ b/src/emacsgtkfixed.h @@ -28,8 +28,8 @@ struct frame; G_BEGIN_DECLS #ifdef HAVE_PGTK -#define EMACS_TYPE_FIXED (emacs_fixed_get_type ()) -#define EMACS_IS_FIXED(obj) (G_TYPE_CHECK_INSTANCE_TYPE ((obj), EMACS_TYPE_FIXED)) +#define EMACS_TYPE_FIXED emacs_fixed_get_type () +#define EMACS_IS_FIXED(obj) G_TYPE_CHECK_INSTANCE_TYPE (obj, EMACS_TYPE_FIXED) #endif struct frame; diff --git a/src/font.h b/src/font.h index ad92f9f4739..8ee1940be0a 100644 --- a/src/font.h +++ b/src/font.h @@ -191,16 +191,16 @@ enum font_property_index /* Return the numeric weight value of FONT. */ #define FONT_WEIGHT_NUMERIC(font) \ - (FIXNUMP (AREF ((font), FONT_WEIGHT_INDEX)) \ - ? (XFIXNUM (AREF ((font), FONT_WEIGHT_INDEX)) >> 8) : -1) + (FIXNUMP (AREF (font, FONT_WEIGHT_INDEX)) \ + ? (XFIXNUM (AREF (font, FONT_WEIGHT_INDEX)) >> 8) : -1) /* Return the numeric slant value of FONT. */ #define FONT_SLANT_NUMERIC(font) \ - (FIXNUMP (AREF ((font), FONT_SLANT_INDEX)) \ - ? (XFIXNUM (AREF ((font), FONT_SLANT_INDEX)) >> 8) : -1) + (FIXNUMP (AREF (font, FONT_SLANT_INDEX)) \ + ? (XFIXNUM (AREF (font, FONT_SLANT_INDEX)) >> 8) : -1) /* Return the numeric width value of FONT. */ #define FONT_WIDTH_NUMERIC(font) \ - (FIXNUMP (AREF ((font), FONT_WIDTH_INDEX)) \ - ? (XFIXNUM (AREF ((font), FONT_WIDTH_INDEX)) >> 8) : -1) + (FIXNUMP (AREF (font, FONT_WIDTH_INDEX)) \ + ? (XFIXNUM (AREF (font, FONT_WIDTH_INDEX)) >> 8) : -1) /* Return the symbolic weight value of FONT. */ #define FONT_WEIGHT_SYMBOLIC(font) \ font_style_symbolic (font, FONT_WEIGHT_INDEX, false) @@ -222,19 +222,19 @@ enum font_property_index /* Return the numeric weight value corresponding to the symbol NAME. */ #define FONT_WEIGHT_NAME_NUMERIC(name) \ - (font_style_to_value (FONT_WEIGHT_INDEX, (name), false) >> 8) + (font_style_to_value (FONT_WEIGHT_INDEX, name, false) >> 8) /* Return the numeric slant value corresponding to the symbol NAME. */ #define FONT_SLANT_NAME_NUMERIC(name) \ - (font_style_to_value (FONT_SLANT_INDEX, (name), false) >> 8) + (font_style_to_value (FONT_SLANT_INDEX, name, false) >> 8) /* Return the numeric width value corresponding to the symbol NAME. */ #define FONT_WIDTH_NAME_NUMERIC(name) \ - (font_style_to_value (FONT_WIDTH_INDEX, (name), false) >> 8) + (font_style_to_value (FONT_WIDTH_INDEX, name, false) >> 8) /* Set the font property PROP of FONT to VAL. PROP is one of style-related font property index (FONT_WEIGHT/SLANT/WIDTH_INDEX). VAL (integer or symbol) is the numeric or symbolic style value. */ #define FONT_SET_STYLE(font, prop, val) \ - ASET ((font), prop, make_fixnum (font_style_to_value (prop, val, true))) + ASET (font, prop, make_fixnum (font_style_to_value (prop, val, true))) #ifndef MSDOS #define FONT_WIDTH(f) ((f)->max_width) @@ -549,7 +549,7 @@ GC_XFONT_OBJECT (Lisp_Object p) return XUNTAG (p, Lisp_Vectorlike, struct font); } -#define XSETFONT(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FONT)) +#define XSETFONT(a, b) XSETPSEUDOVECTOR (a, b, PVEC_FONT) INLINE struct font * CHECK_FONT_GET_OBJECT (Lisp_Object x) @@ -1004,13 +1004,13 @@ extern void font_deferred_log (const char *, Lisp_Object, Lisp_Object); #define FONT_ADD_LOG(ACTION, ARG, RESULT) \ do { \ if (! EQ (Vfont_log, Qt)) \ - font_add_log ((ACTION), (ARG), (RESULT)); \ + font_add_log (ACTION, ARG, RESULT); \ } while (false) #define FONT_DEFERRED_LOG(ACTION, ARG, RESULT) \ do { \ if (! EQ (Vfont_log, Qt)) \ - font_deferred_log ((ACTION), (ARG), (RESULT)); \ + font_deferred_log (ACTION, ARG, RESULT); \ } while (false) /* FIXME: This is for use in functions that can be called while diff --git a/src/fontset.c b/src/fontset.c index 005d0a98d2a..d27fa22015e 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -266,19 +266,19 @@ font_def_new (Lisp_Object font_spec, Lisp_Object encoding, #define RFONT_DEF_FACE(rfont_def) AREF (rfont_def, 0) #define RFONT_DEF_SET_FACE(rfont_def, face_id) \ - ASET ((rfont_def), 0, make_fixnum (face_id)) + ASET (rfont_def, 0, make_fixnum (face_id)) #define RFONT_DEF_FONT_DEF(rfont_def) AREF (rfont_def, 1) #define RFONT_DEF_SPEC(rfont_def) FONT_DEF_SPEC (AREF (rfont_def, 1)) #define RFONT_DEF_OBJECT(rfont_def) AREF (rfont_def, 2) #define RFONT_DEF_SET_OBJECT(rfont_def, object) \ - ASET ((rfont_def), 2, (object)) + ASET (rfont_def, 2, object) /* Score of RFONT_DEF is an integer value; the lowest 8 bits represent the order of listing by font backends, the higher bits represents the order given by charset priority list. The smaller value is preferable. */ #define RFONT_DEF_SCORE(rfont_def) XFIXNUM (AREF (rfont_def, 3)) #define RFONT_DEF_SET_SCORE(rfont_def, score) \ - ASET ((rfont_def), 3, make_fixnum (score)) + ASET (rfont_def, 3, make_fixnum (score)) #define RFONT_DEF_NEW(rfont_def, font_def) \ do { \ (rfont_def) = make_nil_vector (4); \ @@ -295,7 +295,7 @@ font_def_new (Lisp_Object font_spec, Lisp_Object encoding, #define FONTSET_REF(fontset, c) \ (EQ (fontset, Vdefault_fontset) \ ? CHAR_TABLE_REF (fontset, c) \ - : fontset_ref ((fontset), (c))) + : fontset_ref (fontset, c)) static Lisp_Object fontset_ref (Lisp_Object fontset, int c) @@ -315,7 +315,7 @@ fontset_ref (Lisp_Object fontset, int c) specifying a range. */ #define FONTSET_SET(fontset, range, elt) \ - Fset_char_table_range ((fontset), (range), (elt)) + Fset_char_table_range (fontset, range, elt) /* Modify the elements of FONTSET for characters in RANGE by replacing @@ -329,7 +329,7 @@ fontset_ref (Lisp_Object fontset, int c) ? (NILP (range) \ ? set_fontset_fallback (fontset, make_vector (1, elt)) \ : (void) Fset_char_table_range (fontset, range, make_vector (1, elt))) \ - : fontset_add ((fontset), (range), (elt), (add))) + : fontset_add (fontset, range, elt, add)) static void fontset_add (Lisp_Object fontset, Lisp_Object range, Lisp_Object elt, Lisp_Object add) diff --git a/src/frame.h b/src/frame.h index d574fe93a57..e03362361a7 100644 --- a/src/frame.h +++ b/src/frame.h @@ -909,7 +909,7 @@ default_pixels_per_inch_y (void) #define XFRAME(p) \ (eassert (FRAMEP (p)), XUNTAG (p, Lisp_Vectorlike, struct frame)) -#define XSETFRAME(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FRAME)) +#define XSETFRAME(a, b) XSETPSEUDOVECTOR (a, b, PVEC_FRAME) /* Given a window, return its frame as a Lisp_Object. */ #define WINDOW_FRAME(w) ((w)->frame) @@ -992,7 +992,7 @@ default_pixels_per_inch_y (void) FRAME_DISPLAY_INFO (f)->font_resolution) #else /* !HAVE_ANDROID */ -#define FRAME_RES(f) (FRAME_RES_Y (f)) +#define FRAME_RES(f) FRAME_RES_Y (f) #endif /* HAVE_ANDROID */ #else /* !HAVE_WINDOW_SYSTEM */ @@ -1130,12 +1130,12 @@ default_pixels_per_inch_y (void) /* Height of F's bottom margin in frame lines. */ #define FRAME_BOTTOM_MARGIN(f) \ - (FRAME_TOOL_BAR_BOTTOM_LINES (f)) + FRAME_TOOL_BAR_BOTTOM_LINES (f) /* Pixel height of frame F's bottom margin. */ #define FRAME_BOTTOM_MARGIN_HEIGHT(f) \ - (FRAME_TOOL_BAR_BOTTOM_HEIGHT (f)) + FRAME_TOOL_BAR_BOTTOM_HEIGHT (f) /* Size of both vertical margins combined. */ @@ -1159,7 +1159,7 @@ default_pixels_per_inch_y (void) visible by the X server. */ #ifndef HAVE_X_WINDOWS -#define FRAME_REDISPLAY_P(f) (FRAME_VISIBLE_P (f)) +#define FRAME_REDISPLAY_P(f) FRAME_VISIBLE_P (f) #else #define FRAME_REDISPLAY_P(f) (FRAME_VISIBLE_P (f) \ || (FRAME_X_P (f) \ diff --git a/src/gtkutil.c b/src/gtkutil.c index 6cfb4034ed9..c067f7b53ac 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -117,10 +117,10 @@ static void xg_widget_style_updated (GtkWidget *, gpointer); #define gtk_box_new(ori, spacing) \ ((ori) == GTK_ORIENTATION_HORIZONTAL \ - ? gtk_hbox_new (FALSE, (spacing)) : gtk_vbox_new (FALSE, (spacing))) + ? gtk_hbox_new (FALSE, spacing) : gtk_vbox_new (FALSE, spacing)) #define gtk_scrollbar_new(ori, spacing) \ ((ori) == GTK_ORIENTATION_HORIZONTAL \ - ? gtk_hscrollbar_new ((spacing)) : gtk_vscrollbar_new ((spacing))) + ? gtk_hscrollbar_new (spacing) : gtk_vscrollbar_new (spacing)) #endif /* HAVE_GTK3 */ #define XG_BIN_CHILD(x) gtk_bin_get_child (GTK_BIN (x)) diff --git a/src/image.c b/src/image.c index 66838adbb2a..41d72964631 100644 --- a/src/image.c +++ b/src/image.c @@ -4875,7 +4875,7 @@ xbm_read_bitmap_data (struct frame *f, char *contents, char *end, while (0) #define expect_ident(IDENT) \ - if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \ + if (LA1 == XBM_TK_IDENT && strcmp (buffer, IDENT) == 0) \ match (); \ else \ goto failure @@ -6154,7 +6154,7 @@ xpm_load_image (struct frame *f, #define expect_ident(IDENT) \ if (LA1 == XPM_TK_IDENT \ - && strlen ((IDENT)) == len && memcmp ((IDENT), beg, len) == 0) \ + && strlen (IDENT) == len && memcmp (IDENT, beg, len) == 0) \ match (); \ else \ goto failure diff --git a/src/keyboard.c b/src/keyboard.c index e1d738dd6ef..1f7253a7da1 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -9082,7 +9082,7 @@ process_tab_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void * } /* Access slot with index IDX of vector tab_bar_item_properties. */ -#define PROP(IDX) AREF (tab_bar_item_properties, (IDX)) +#define PROP(IDX) AREF (tab_bar_item_properties, IDX) static void set_prop_tab_bar (ptrdiff_t idx, Lisp_Object val) { @@ -9466,7 +9466,7 @@ process_tool_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void } /* Access slot with index IDX of vector tool_bar_item_properties. */ -#define PROP(IDX) AREF (tool_bar_item_properties, (IDX)) +#define PROP(IDX) AREF (tool_bar_item_properties, IDX) static void set_prop (ptrdiff_t idx, Lisp_Object val) { diff --git a/src/keyboard.h b/src/keyboard.h index 05245f366f5..68e68bc2ae3 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -396,7 +396,7 @@ extern void unuse_menu_items (void); /* Macros for dealing with lispy events. */ /* True if EVENT has data fields describing it (i.e. a mouse click). */ -#define EVENT_HAS_PARAMETERS(event) (CONSP (event)) +#define EVENT_HAS_PARAMETERS(event) CONSP (event) /* Extract the head from an event. This works on composite and simple events. */ @@ -414,32 +414,32 @@ extern void unuse_menu_items (void); : CAR_SAFE (CDR_SAFE (event))) /* This does not handle touchscreen events. */ -#define EVENT_END(event) (CAR_SAFE (CDR_SAFE (CDR_SAFE (event)))) +#define EVENT_END(event) CAR_SAFE (CDR_SAFE (CDR_SAFE (event))) /* Extract the click count from a multi-click event. */ -#define EVENT_CLICK_COUNT(event) (Fnth (make_fixnum (2), (event))) +#define EVENT_CLICK_COUNT(event) Fnth (make_fixnum (2), event) /* Extract the fields of a position. */ -#define POSN_WINDOW(posn) (CAR_SAFE (posn)) -#define POSN_POSN(posn) (CAR_SAFE (CDR_SAFE (posn))) -#define POSN_SET_POSN(posn,x) (XSETCAR (XCDR (posn), (x))) -#define POSN_WINDOW_POSN(posn) (CAR_SAFE (CDR_SAFE (CDR_SAFE (posn)))) -#define POSN_TIMESTAMP(posn) (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (posn))))) -#define POSN_SCROLLBAR_PART(posn) (Fnth (make_fixnum (4), (posn))) +#define POSN_WINDOW(posn) CAR_SAFE (posn) +#define POSN_POSN(posn) CAR_SAFE (CDR_SAFE (posn)) +#define POSN_SET_POSN(posn,x) XSETCAR (XCDR (posn), x) +#define POSN_WINDOW_POSN(posn) CAR_SAFE (CDR_SAFE (CDR_SAFE (posn))) +#define POSN_TIMESTAMP(posn) CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (posn)))) +#define POSN_SCROLLBAR_PART(posn) Fnth (make_fixnum (4), posn) /* A cons (STRING . STRING-CHARPOS), or nil in mouse-click events. It's a cons if the click is over a string in the mode line. */ -#define POSN_STRING(posn) (Fnth (make_fixnum (4), (posn))) +#define POSN_STRING(posn) Fnth (make_fixnum (4), posn) /* If POSN_STRING is nil, event refers to buffer location. */ -#define POSN_INBUFFER_P(posn) (NILP (POSN_STRING (posn))) -#define POSN_BUFFER_POSN(posn) (Fnth (make_fixnum (5), (posn))) +#define POSN_INBUFFER_P(posn) NILP (POSN_STRING (posn)) +#define POSN_BUFFER_POSN(posn) Fnth (make_fixnum (5), posn) /* Getting the kind of an event head. */ #define EVENT_HEAD_KIND(event_head) \ - (Fget ((event_head), Qevent_kind)) + Fget (event_head, Qevent_kind) /* Address (if not 0) of struct timespec to zero out if a SIGIO interrupt happens. */ diff --git a/src/lisp.h b/src/lisp.h index e25d990e1e9..20b28e93c8d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -369,11 +369,11 @@ typedef EMACS_INT Lisp_Word; # define lisp_h_Qnil {0} #endif -#define lisp_h_PSEUDOVECTORP(a,code) \ - (lisp_h_VECTORLIKEP((a)) && \ - ((XUNTAG ((a), Lisp_Vectorlike, union vectorlike_header)->size \ - & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \ - == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS)))) +#define lisp_h_PSEUDOVECTORP(a,code) \ + (lisp_h_VECTORLIKEP (a) \ + && ((XUNTAG (a, Lisp_Vectorlike, union vectorlike_header)->size \ + & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \ + == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS)))) #define lisp_h_CHECK_FIXNUM(x) CHECK_TYPE (FIXNUMP (x), Qfixnump, x) #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) @@ -391,17 +391,17 @@ typedef EMACS_INT Lisp_Word; * What about keeping the part after `symbols_with_pos_enabled` in * a separate function? */ #define lisp_h_EQ(x, y) \ - ((XLI ((x)) == XLI ((y))) \ + (XLI (x) == XLI (y) \ || (symbols_with_pos_enabled \ - && (SYMBOL_WITH_POS_P ((x)) \ - ? (BARE_SYMBOL_P ((y)) \ - ? XLI (XSYMBOL_WITH_POS((x))->sym) == XLI (y) \ - : SYMBOL_WITH_POS_P((y)) \ - && (XLI (XSYMBOL_WITH_POS((x))->sym) \ - == XLI (XSYMBOL_WITH_POS((y))->sym))) \ - : (SYMBOL_WITH_POS_P ((y)) \ - && BARE_SYMBOL_P ((x)) \ - && (XLI (x) == XLI ((XSYMBOL_WITH_POS ((y)))->sym)))))) + && (SYMBOL_WITH_POS_P (x) \ + ? (BARE_SYMBOL_P (y) \ + ? XLI (XSYMBOL_WITH_POS (x)->sym) == XLI (y) \ + : (SYMBOL_WITH_POS_P (y) \ + && (XLI (XSYMBOL_WITH_POS (x)->sym) \ + == XLI (XSYMBOL_WITH_POS (y)->sym)))) \ + : (SYMBOL_WITH_POS_P (y) \ + && BARE_SYMBOL_P (x) \ + && (XLI (x) == XLI (XSYMBOL_WITH_POS (y)->sym)))))) #define lisp_h_FIXNUMP(x) \ (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \ @@ -417,10 +417,10 @@ typedef EMACS_INT Lisp_Word; #define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write) #define lisp_h_SYMBOL_VAL(sym) \ (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value) -#define lisp_h_SYMBOL_WITH_POS_P(x) PSEUDOVECTORP ((x), PVEC_SYMBOL_WITH_POS) -#define lisp_h_BARE_SYMBOL_P(x) TAGGEDP ((x), Lisp_Symbol) -#define lisp_h_SYMBOLP(x) ((BARE_SYMBOL_P ((x)) || \ - (symbols_with_pos_enabled && (SYMBOL_WITH_POS_P ((x)))))) +#define lisp_h_SYMBOL_WITH_POS_P(x) PSEUDOVECTORP (x, PVEC_SYMBOL_WITH_POS) +#define lisp_h_BARE_SYMBOL_P(x) TAGGEDP (x, Lisp_Symbol) +#define lisp_h_SYMBOLP(x) \ + (BARE_SYMBOL_P (x) || (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x))) #define lisp_h_TAGGEDP(a, tag) \ (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \ - (unsigned) (tag)) \ @@ -1156,7 +1156,7 @@ XBARE_SYMBOL (Lisp_Object a) INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED XSYMBOL (Lisp_Object a) { - eassert (SYMBOLP ((a))); + eassert (SYMBOLP (a)); if (!symbols_with_pos_enabled || BARE_SYMBOL_P (a)) return XBARE_SYMBOL (a); return XBARE_SYMBOL (XSYMBOL_WITH_POS (a)->sym); @@ -1407,19 +1407,19 @@ dead_object (void) == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS)))) #define XSETWINDOW_CONFIGURATION(a, b) \ - (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW_CONFIGURATION)) -#define XSETPROCESS(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_PROCESS)) -#define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW)) -#define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL)) -#define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR)) -#define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER)) -#define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE)) -#define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) -#define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE)) -#define XSETTHREAD(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_THREAD)) -#define XSETMUTEX(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_MUTEX)) -#define XSETCONDVAR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CONDVAR)) -#define XSETNATIVE_COMP_UNIT(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_NATIVE_COMP_UNIT)) + XSETPSEUDOVECTOR (a, b, PVEC_WINDOW_CONFIGURATION) +#define XSETPROCESS(a, b) XSETPSEUDOVECTOR (a, b, PVEC_PROCESS) +#define XSETWINDOW(a, b) XSETPSEUDOVECTOR (a, b, PVEC_WINDOW) +#define XSETTERMINAL(a, b) XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL) +#define XSETSUBR(a, b) XSETPSEUDOVECTOR (a, b, PVEC_SUBR) +#define XSETBUFFER(a, b) XSETPSEUDOVECTOR (a, b, PVEC_BUFFER) +#define XSETCHAR_TABLE(a, b) XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE) +#define XSETBOOL_VECTOR(a, b) XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR) +#define XSETSUB_CHAR_TABLE(a, b) XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE) +#define XSETTHREAD(a, b) XSETPSEUDOVECTOR (a, b, PVEC_THREAD) +#define XSETMUTEX(a, b) XSETPSEUDOVECTOR (a, b, PVEC_MUTEX) +#define XSETCONDVAR(a, b) XSETPSEUDOVECTOR (a, b, PVEC_CONDVAR) +#define XSETNATIVE_COMP_UNIT(a, b) XSETPSEUDOVECTOR (a, b, PVEC_NATIVE_COMP_UNIT) /* Efficiently convert a pointer to a Lisp object and back. The pointer is represented as a fixnum, so the garbage collector @@ -2542,7 +2542,7 @@ XHASH_TABLE (Lisp_Object a) } #define XSET_HASH_TABLE(VAR, PTR) \ - (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE)) + XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE) /* Value is the key part of entry IDX in hash table H. */ INLINE Lisp_Object diff --git a/src/lread.c b/src/lread.c index 2c6a444ec56..929f86ef283 100644 --- a/src/lread.c +++ b/src/lread.c @@ -124,7 +124,7 @@ static struct android_fd_or_asset invalid_file_stream = #define file_stream struct android_fd_or_asset #define file_offset off_t -#define file_tell(n) (android_asset_lseek ((n), 0, SEEK_CUR)) +#define file_tell(n) android_asset_lseek (n, 0, SEEK_CUR) #define file_seek android_asset_lseek #define file_stream_valid_p(p) ((p).asset || (p).fd >= 0) #define file_stream_close android_close_asset diff --git a/src/macfont.h b/src/macfont.h index 77426f6f198..45cb1eaa7e4 100644 --- a/src/macfont.h +++ b/src/macfont.h @@ -75,7 +75,7 @@ enum { #define kCTVersionNumber10_9 0x00060000 #endif #define MAC_FONT_CHARACTER_SET_STRING_ATTRIBUTE \ - (CFSTR ("MAC_FONT_CHARACTER_SET_STRING_ATTRIBUTE")) + CFSTR ("MAC_FONT_CHARACTER_SET_STRING_ATTRIBUTE") typedef const struct _EmacsScreenFont *ScreenFontRef; /* opaque */ @@ -85,4 +85,4 @@ extern void macfont_update_antialias_threshold (void); /* This is an undocumented function. */ extern void CGContextSetFontSmoothingStyle(CGContextRef, int) - __attribute__((weak_import)); + __attribute__ ((weak_import)); diff --git a/src/msdos.c b/src/msdos.c index 1f82d4029d7..7e78c35027e 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -2865,7 +2865,7 @@ IT_menu_calc_size (XMenu *menu, int *width, int *height) do \ { \ (GLYPH).type = CHAR_GLYPH; \ - SET_CHAR_GLYPH ((GLYPH), CODE, FACE_ID, PADDING_P); \ + SET_CHAR_GLYPH (GLYPH, CODE, FACE_ID, PADDING_P); \ (GLYPH).charpos = -1; \ } \ while (0) diff --git a/src/nsfont.m b/src/nsfont.m index 2679a42e1e1..4e1d85a5c4a 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -601,7 +601,7 @@ static NSString { Lisp_Object script = assq_no_quit (XCAR (otf), Votf_script_alist); return CONSP (script) - ? [NSString stringWithLispString: SYMBOL_NAME (XCDR ((script)))] + ? [NSString stringWithLispString: SYMBOL_NAME (XCDR (script))] : @""; } diff --git a/src/nsterm.h b/src/nsterm.h index faa839dc1af..ae940ec5b4f 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -278,9 +278,9 @@ char const * nstrace_fullscreen_type_name (int); #define NSTRACE_WHEN(cond, ...) \ - __attribute__((cleanup(nstrace_restore_global_trace_state))) \ + __attribute__ ((cleanup (nstrace_restore_global_trace_state))) \ int nstrace_saved_enabled_global = nstrace_enabled_global; \ - __attribute__((cleanup(nstrace_leave))) \ + __attribute__ ((cleanup (nstrace_leave))) \ int nstrace_enabled = nstrace_enabled_global && (cond); \ if (nstrace_enabled) { ++nstrace_depth; } \ else { nstrace_enabled_global = 0; } \ @@ -1290,7 +1290,7 @@ extern char gnustep_base_version[]; /* version tracking */ /* Little utility macros */ #define IN_BOUND(min, x, max) (((x) < (min)) \ ? (min) : (((x)>(max)) ? (max) : (x))) -#define SCREENMAXBOUND(x) (IN_BOUND (-SCREENMAX, x, SCREENMAX)) +#define SCREENMAXBOUND(x) IN_BOUND (-SCREENMAX, x, SCREENMAX) #ifdef NS_IMPL_COCOA diff --git a/src/pdumper.h b/src/pdumper.h index 726805efdac..0d5e4c2d45f 100644 --- a/src/pdumper.h +++ b/src/pdumper.h @@ -128,7 +128,7 @@ pdumper_do_now_and_after_late_load (pdumper_hook hook) if (dumped_with_pdumper_p ()) \ (variable) = (value); \ else \ - eassert (EQ ((variable), (value))); \ + eassert (EQ (variable, value)); \ } while (0) /* Actually load a dump. */ diff --git a/src/pgtkterm.h b/src/pgtkterm.h index e8c54dff4d9..8072d963691 100644 --- a/src/pgtkterm.h +++ b/src/pgtkterm.h @@ -462,7 +462,7 @@ enum #define FRAME_X_WINDOW(f) FRAME_GTK_OUTER_WIDGET (f) #define FRAME_NATIVE_WINDOW(f) GTK_WINDOW (FRAME_X_WINDOW (f)) #define FRAME_GDK_WINDOW(f) \ - (gtk_widget_get_window (FRAME_GTK_WIDGET (f))) + gtk_widget_get_window (FRAME_GTK_WIDGET (f)) #define FRAME_X_DISPLAY(f) (FRAME_DISPLAY_INFO (f)->gdpy) diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 6aa6f4f9b34..dfc6c1fd691 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -99,7 +99,7 @@ #define IS_REAL_ASCII(c) ((c) < 0200) /* 1 if C is a unibyte character. */ -#define ISUNIBYTE(c) (SINGLE_BYTE_CHAR_P ((c))) +#define ISUNIBYTE(c) SINGLE_BYTE_CHAR_P (c) /* The Emacs definitions should not be directly affected by locales. */ @@ -1345,7 +1345,7 @@ struct range_table_work_area /* Set a range (RANGE_START, RANGE_END) to WORK_AREA. */ #define SET_RANGE_TABLE_WORK_AREA(work_area, range_start, range_end) \ do { \ - EXTEND_RANGE_TABLE ((work_area), 2); \ + EXTEND_RANGE_TABLE (work_area, 2); \ (work_area).table[(work_area).used++] = (range_start); \ (work_area).table[(work_area).used++] = (range_end); \ } while (false) @@ -1380,7 +1380,7 @@ struct range_table_work_area /* Set the bit for character C in a list. */ -#define SET_LIST_BIT(c) (b[((c)) / BYTEWIDTH] |= 1 << ((c) % BYTEWIDTH)) +#define SET_LIST_BIT(c) (b[(c) / BYTEWIDTH] |= 1 << ((c) % BYTEWIDTH)) /* Store characters in the range FROM to TO in the bitmap at B (for @@ -1403,7 +1403,7 @@ struct range_table_work_area C1 = TRANSLATE (C0); \ if (! ASCII_CHAR_P (C1)) \ { \ - SET_RANGE_TABLE_WORK_AREA ((work_area), C1, C1); \ + SET_RANGE_TABLE_WORK_AREA (work_area, C1, C1); \ if ((C1 = RE_CHAR_TO_UNIBYTE (C1)) < 0) \ C1 = C0; \ } \ @@ -1446,7 +1446,7 @@ struct range_table_work_area } \ } \ if (I < USED) \ - SET_RANGE_TABLE_WORK_AREA ((work_area), C2, C2); \ + SET_RANGE_TABLE_WORK_AREA (work_area, C2, C2); \ } \ } \ } while (false) @@ -1458,7 +1458,7 @@ struct range_table_work_area do { \ int C0, C1, C2, I, USED = RANGE_TABLE_WORK_USED (work_area); \ \ - SET_RANGE_TABLE_WORK_AREA ((work_area), (FROM), (TO)); \ + SET_RANGE_TABLE_WORK_AREA (work_area, FROM, TO); \ for (C0 = (FROM); C0 <= (TO); C0++) \ { \ C1 = TRANSLATE (C0); \ @@ -1482,7 +1482,7 @@ struct range_table_work_area } \ } \ if (I < USED) \ - SET_RANGE_TABLE_WORK_AREA ((work_area), C1, C1); \ + SET_RANGE_TABLE_WORK_AREA (work_area, C1, C1); \ } \ } while (false) @@ -3755,7 +3755,7 @@ execute_charset (re_char **pp, int c, int corig, bool unibyte, int count; rtp = CHARSET_RANGE_TABLE (p); EXTRACT_NUMBER_AND_INCR (count, rtp); - *pp = CHARSET_RANGE_TABLE_END ((rtp), (count)); + *pp = CHARSET_RANGE_TABLE_END (rtp, count); } else *pp += 2 + CHARSET_BITMAP_SIZE (p); diff --git a/src/sfnt.c b/src/sfnt.c index 88826e1b2c1..a70994fbe67 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -6860,7 +6860,7 @@ sfnt_interpret_trap (struct sfnt_interpreter *interpreter, (interpreter->SP - interpreter->stack) #define TRAP(why) \ - sfnt_interpret_trap (interpreter, (why)) + sfnt_interpret_trap (interpreter, why) #define MOVE(a, b, n) \ memmove (a, b, (n) * sizeof (uint32_t)) diff --git a/src/term.c b/src/term.c index d3c858c6bf2..447876d288a 100644 --- a/src/term.c +++ b/src/term.c @@ -86,12 +86,12 @@ static AVOID vfatal (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0); #ifndef HAVE_ANDROID #define OUTPUT(tty, a) \ - emacs_tputs ((tty), a, \ + emacs_tputs (tty, a, \ FRAME_TOTAL_LINES (XFRAME (selected_frame)) - curY (tty), \ cmputc) -#define OUTPUT1(tty, a) emacs_tputs ((tty), a, 1, cmputc) -#define OUTPUTL(tty, a, lines) emacs_tputs ((tty), a, lines, cmputc) +#define OUTPUT1(tty, a) emacs_tputs (tty, a, 1, cmputc) +#define OUTPUTL(tty, a, lines) emacs_tputs (tty, a, lines, cmputc) #define OUTPUT_IF(tty, a) \ do { \ @@ -99,7 +99,8 @@ static AVOID vfatal (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0); OUTPUT (tty, a); \ } while (0) -#define OUTPUT1_IF(tty, a) do { if (a) emacs_tputs ((tty), a, 1, cmputc); } while (0) +#define OUTPUT1_IF(tty, a) \ + do { if (a) emacs_tputs (tty, a, 1, cmputc); } while (0) #endif @@ -1117,7 +1118,7 @@ per_line_cost (const char *str) int *char_ins_del_vector; -#define char_ins_del_cost(f) (&char_ins_del_vector[FRAME_COLS ((f))]) +#define char_ins_del_cost(f) (&char_ins_del_vector[FRAME_COLS (f)]) static void calculate_ins_del_char_costs (struct frame *f) diff --git a/src/w32font.c b/src/w32font.c index c4718053a34..56061c0d9ce 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -2265,14 +2265,14 @@ font_supported_scripts (FONTSIGNATURE * sig) /* Match a single subrange. SYM is set if bit N is set in subranges. */ #define SUBRANGE(n,sym) \ if (subranges[(n) / 32] & (1U << ((n) % 32))) \ - supported = Fcons ((sym), supported) + supported = Fcons (sym, supported) /* Match multiple subranges. SYM is set if any MASK bit is set in subranges[0 - 3]. */ #define MASK_ANY(mask0,mask1,mask2,mask3,sym) \ if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \ || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \ - supported = Fcons ((sym), supported) + supported = Fcons (sym, supported) /* 0: ASCII (a.k.a. "Basic Latin"), 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B, diff --git a/src/window.h b/src/window.h index 31fcbbd5541..19283725931 100644 --- a/src/window.h +++ b/src/window.h @@ -595,11 +595,11 @@ wset_next_buffers (struct window *w, Lisp_Object val) /* Non-nil if window W is leaf window (has a buffer). */ #define WINDOW_LEAF_P(W) \ - (BUFFERP ((W)->contents)) + BUFFERP ((W)->contents) /* Non-nil if window W is internal (is a parent window). */ #define WINDOW_INTERNAL_P(W) \ - (WINDOWP ((W)->contents)) + WINDOWP ((W)->contents) /* True if window W is a horizontal combination of windows. */ #define WINDOW_HORIZONTAL_COMBINATION_P(W) \ @@ -610,7 +610,7 @@ wset_next_buffers (struct window *w, Lisp_Object val) (WINDOW_INTERNAL_P (W) && !(W)->horizontal) /* Window W's XFRAME. */ -#define WINDOW_XFRAME(W) (XFRAME (WINDOW_FRAME ((W)))) +#define WINDOW_XFRAME(W) XFRAME (WINDOW_FRAME (W)) /* Whether window W is a pseudo window. */ #define WINDOW_PSEUDO_P(W) ((W)->pseudo_window_p) @@ -630,11 +630,11 @@ wset_next_buffers (struct window *w, Lisp_Object val) /* Return the canonical column width of the frame of window W. */ #define WINDOW_FRAME_COLUMN_WIDTH(W) \ - (FRAME_COLUMN_WIDTH (WINDOW_XFRAME ((W)))) + FRAME_COLUMN_WIDTH (WINDOW_XFRAME (W)) /* Return the canonical line height of the frame of window W. */ #define WINDOW_FRAME_LINE_HEIGHT(W) \ - (FRAME_LINE_HEIGHT (WINDOW_XFRAME ((W)))) + FRAME_LINE_HEIGHT (WINDOW_XFRAME (W)) /* Return the pixel width of window W. This includes dividers, scroll bars, fringes and margins, if any. */ @@ -666,7 +666,7 @@ wset_next_buffers (struct window *w, Lisp_Object val) #define MIN_SAFE_WINDOW_HEIGHT (1) #define MIN_SAFE_WINDOW_PIXEL_HEIGHT(W) \ - (WINDOW_FRAME_LINE_HEIGHT (W)) + WINDOW_FRAME_LINE_HEIGHT (W) /* True if window W has no other windows to its left on its frame. */ #define WINDOW_LEFTMOST_P(W) \ @@ -1011,7 +1011,7 @@ wset_next_buffers (struct window *w, Lisp_Object val) /* Height in pixels of the mode line. May be zero if W doesn't have a mode line. */ #define WINDOW_MODE_LINE_HEIGHT(W) \ - (window_wants_mode_line ((W)) \ + (window_wants_mode_line (W) \ ? CURRENT_MODE_LINE_HEIGHT (W) \ : 0) @@ -1049,7 +1049,7 @@ wset_next_buffers (struct window *w, Lisp_Object val) /* Pixel height of window W without mode and header/tab line and bottom divider. */ #define WINDOW_BOX_TEXT_HEIGHT(W) \ - (WINDOW_PIXEL_HEIGHT ((W)) \ + (WINDOW_PIXEL_HEIGHT (W) \ - WINDOW_BOTTOM_DIVIDER_WIDTH (W) \ - WINDOW_SCROLL_BAR_AREA_HEIGHT (W) \ - WINDOW_MODE_LINE_HEIGHT (W) \ @@ -1065,7 +1065,7 @@ wset_next_buffers (struct window *w, Lisp_Object val) /* Convert window W relative pixel X to frame pixel coordinates. */ #define WINDOW_TO_FRAME_PIXEL_X(W, X) \ - ((X) + WINDOW_BOX_LEFT_EDGE_X ((W))) + ((X) + WINDOW_BOX_LEFT_EDGE_X (W)) /* Convert window W relative pixel Y to frame pixel coordinates. */ #define WINDOW_TO_FRAME_PIXEL_Y(W, Y) \ @@ -1073,7 +1073,7 @@ wset_next_buffers (struct window *w, Lisp_Object val) /* Convert frame relative pixel X to window relative pixel X. */ #define FRAME_TO_WINDOW_PIXEL_X(W, X) \ - ((X) - WINDOW_BOX_LEFT_EDGE_X ((W))) + ((X) - WINDOW_BOX_LEFT_EDGE_X (W)) /* Convert frame relative pixel Y to window relative pixel Y. */ #define FRAME_TO_WINDOW_PIXEL_Y(W, Y) \ @@ -1082,7 +1082,7 @@ wset_next_buffers (struct window *w, Lisp_Object val) /* Convert a text area relative x-position in window W to frame X pixel coordinates. */ #define WINDOW_TEXT_TO_FRAME_PIXEL_X(W, X) \ - (window_box_left ((W), TEXT_AREA) + (X)) + window_box_left (W, TEXT_AREA) + (X) /* This is the window in which the terminal's cursor should be left when nothing is being done with it. This must always be a leaf window, and its diff --git a/src/xdisp.c b/src/xdisp.c index 14cf030ca4e..e69336d5abe 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3084,9 +3084,9 @@ funcall_with_backtraces (ptrdiff_t nargs, Lisp_Object *args) } #define SAFE_CALLMANY(inhibit_quit, f, array) \ - dsafe__call ((inhibit_quit), f, ARRAYELTS (array), array) + dsafe__call (inhibit_quit, f, ARRAYELTS (array), array) #define dsafe_calln(inhibit_quit, ...) \ - SAFE_CALLMANY ((inhibit_quit), \ + SAFE_CALLMANY (inhibit_quit, \ backtrace_on_redisplay_error \ ? funcall_with_backtraces : Ffuncall, \ ((Lisp_Object []) {__VA_ARGS__})) @@ -6775,7 +6775,7 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos) \ entries[n].string = (STRING); \ entries[n].overlay = (OVERLAY); \ - priority = Foverlay_get ((OVERLAY), Qpriority); \ + priority = Foverlay_get (OVERLAY, Qpriority); \ entries[n].priority = FIXNUMP (priority) ? XFIXNUM (priority) : 0; \ entries[n].after_string_p = (AFTER_P); \ ++n; \ @@ -29523,9 +29523,9 @@ dump_glyph_string (struct glyph_string *s) # define ALLOCATE_HDC(hdc, f) \ Lisp_Object prev_quit = Vinhibit_quit; \ Vinhibit_quit = Qt; \ - HDC hdc = get_frame_dc ((f)) + HDC hdc = get_frame_dc (f) # define RELEASE_HDC(hdc, f) \ - release_frame_dc ((f), (hdc)); \ + release_frame_dc (f, hdc); \ Vinhibit_quit = prev_quit #else # define ALLOCATE_HDC(hdc, f) diff --git a/src/xfaces.c b/src/xfaces.c index 2ca2c30636c..b9a78328661 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -293,15 +293,15 @@ along with GNU Emacs. If not, see . */ /* True if face attribute ATTR is unspecified. */ -#define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified) +#define UNSPECIFIEDP(ATTR) EQ (ATTR, Qunspecified) /* True if face attribute ATTR is `ignore-defface'. */ -#define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), QCignore_defface) +#define IGNORE_DEFFACE_P(ATTR) EQ (ATTR, QCignore_defface) /* True if face attribute ATTR is `reset'. */ -#define RESET_P(ATTR) EQ ((ATTR), Qreset) +#define RESET_P(ATTR) EQ (ATTR, Qreset) /* Size of hash table of realized faces in face caches (should be a prime number). */ @@ -1756,26 +1756,26 @@ the WIDTH times as wide as FACE on FRAME. */) /* Access face attributes of face LFACE, a Lisp vector. */ -#define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX) -#define LFACE_FOUNDRY(LFACE) AREF ((LFACE), LFACE_FOUNDRY_INDEX) -#define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX) -#define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX) -#define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX) -#define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX) -#define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX) -#define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX) -#define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX) -#define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX) -#define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX) -#define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX) -#define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX) -#define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX) -#define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX) -#define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX) -#define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX) -#define LFACE_EXTEND(LFACE) AREF ((LFACE), LFACE_EXTEND_INDEX) +#define LFACE_FAMILY(LFACE) AREF (LFACE, LFACE_FAMILY_INDEX) +#define LFACE_FOUNDRY(LFACE) AREF (LFACE, LFACE_FOUNDRY_INDEX) +#define LFACE_HEIGHT(LFACE) AREF (LFACE, LFACE_HEIGHT_INDEX) +#define LFACE_WEIGHT(LFACE) AREF (LFACE, LFACE_WEIGHT_INDEX) +#define LFACE_SLANT(LFACE) AREF (LFACE, LFACE_SLANT_INDEX) +#define LFACE_UNDERLINE(LFACE) AREF (LFACE, LFACE_UNDERLINE_INDEX) +#define LFACE_INVERSE(LFACE) AREF (LFACE, LFACE_INVERSE_INDEX) +#define LFACE_FOREGROUND(LFACE) AREF (LFACE, LFACE_FOREGROUND_INDEX) +#define LFACE_BACKGROUND(LFACE) AREF (LFACE, LFACE_BACKGROUND_INDEX) +#define LFACE_STIPPLE(LFACE) AREF (LFACE, LFACE_STIPPLE_INDEX) +#define LFACE_SWIDTH(LFACE) AREF (LFACE, LFACE_SWIDTH_INDEX) +#define LFACE_OVERLINE(LFACE) AREF (LFACE, LFACE_OVERLINE_INDEX) +#define LFACE_STRIKE_THROUGH(LFACE) AREF (LFACE, LFACE_STRIKE_THROUGH_INDEX) +#define LFACE_BOX(LFACE) AREF (LFACE, LFACE_BOX_INDEX) +#define LFACE_FONT(LFACE) AREF (LFACE, LFACE_FONT_INDEX) +#define LFACE_INHERIT(LFACE) AREF (LFACE, LFACE_INHERIT_INDEX) +#define LFACE_FONTSET(LFACE) AREF (LFACE, LFACE_FONTSET_INDEX) +#define LFACE_EXTEND(LFACE) AREF (LFACE, LFACE_EXTEND_INDEX) #define LFACE_DISTANT_FOREGROUND(LFACE) \ - AREF ((LFACE), LFACE_DISTANT_FOREGROUND_INDEX) + AREF (LFACE, LFACE_DISTANT_FOREGROUND_INDEX) /* True if LFACE is a Lisp face. A Lisp face is a vector of size LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */ diff --git a/src/xterm.h b/src/xterm.h index 3c128148270..2c00b1e7bec 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -84,7 +84,7 @@ typedef GtkWidget *xt_or_gtk_widget; #undef XSync /* gdk_window_process_all_updates is deprecated in GDK 3.22. */ #if GTK_CHECK_VERSION (3, 22, 0) -#define XSync(d, b) do { XSync ((d), (b)); } while (false) +#define XSync(d, b) do { XSync (d, b); } while (false) #else #define XSync(d, b) do { gdk_window_process_all_updates (); \ XSync (d, b); } while (false) @@ -1402,7 +1402,7 @@ extern void x_mark_frame_dirty (struct frame *f); code after any drawing command, but we can run code whenever someone asks for the handle necessary to draw. */ #define FRAME_X_DRAWABLE(f) \ - (x_mark_frame_dirty ((f)), FRAME_X_RAW_DRAWABLE ((f))) + (x_mark_frame_dirty (f), FRAME_X_RAW_DRAWABLE (f)) #ifdef HAVE_XDBE #define FRAME_X_DOUBLE_BUFFERED_P(f) \ @@ -1447,7 +1447,7 @@ extern void x_mark_frame_dirty (struct frame *f); FRAME_X_WINDOW (f)) #else /* !USE_GTK */ -#define FRAME_OUTER_WINDOW(f) (FRAME_X_WINDOW (f)) +#define FRAME_OUTER_WINDOW(f) FRAME_X_WINDOW (f) #endif /* !USE_GTK */ #endif diff --git a/test/src/emacs-module-resources/mod-test.c b/test/src/emacs-module-resources/mod-test.c index 06049364b1e..3aafae1b896 100644 --- a/test/src/emacs-module-resources/mod-test.c +++ b/test/src/emacs-module-resources/mod-test.c @@ -33,9 +33,9 @@ along with GNU Emacs. If not, see . */ #ifdef WINDOWSNT /* Cannot include because of the local header by the same name, sigh. */ -uintptr_t _beginthread (void (__cdecl *)(void *), unsigned, void *); +uintptr_t _beginthread (void (__cdecl *) (void *), unsigned, void *); # if !defined __x86_64__ -# define ALIGN_STACK __attribute__((force_align_arg_pointer)) +# define ALIGN_STACK __attribute__ ((force_align_arg_pointer)) # endif # include /* for Sleep */ #else /* !WINDOWSNT */ -- cgit v1.2.3 From cf26f573162130fed73c6e5603cb58e158903add Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 20 Jan 2024 16:52:31 -0800 Subject: Simplify and tune XSYMBOL MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/lisp.h (XSYMBOL): Simplify and tune. There is no need to examine symbols_with_pos_enabled here, since the arg must be a symbol so if it's not a bare symbol then it must be a symbol_with_pos; and checking whether a symbol is bare is cheap. With Ubuntu 23.10 on a Xeon W-1350, this shrank Emacs’s executable text size by 0.1% and sped up a default build of all *.elc files by 0.4%. Remove unnecessary eassert, since XBARE_SYMBOL and XSYMBOL_WITH_POS have easserts that suffice. --- src/lisp.h | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index 20b28e93c8d..c3309c81a16 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1156,10 +1156,7 @@ XBARE_SYMBOL (Lisp_Object a) INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED XSYMBOL (Lisp_Object a) { - eassert (SYMBOLP (a)); - if (!symbols_with_pos_enabled || BARE_SYMBOL_P (a)) - return XBARE_SYMBOL (a); - return XBARE_SYMBOL (XSYMBOL_WITH_POS (a)->sym); + return XBARE_SYMBOL (BARE_SYMBOL_P (a) ? a : XSYMBOL_WITH_POS (a)->sym); } INLINE Lisp_Object -- cgit v1.2.3 From bdcd662a21f4c4265f704b69deb9cf277a663ea7 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 20 Jan 2024 16:52:31 -0800 Subject: Speed up make_lisp_symbol when debugging * src/lisp.h (make_lisp_symbol): In eassert use XBARE_SYMBOL rather than XSYMBOL. This is safe because the symbol must be bare. The change speeds up make_lisp_symbol when debugging. --- src/lisp.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lisp.h b/src/lisp.h index c3309c81a16..f0beafba42c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1166,7 +1166,7 @@ make_lisp_symbol (struct Lisp_Symbol *sym) cast to char * rather than to intptr_t. */ char *symoffset = (char *) ((char *) sym - (char *) lispsym); Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset); - eassert (XSYMBOL (a) == sym); + eassert (XBARE_SYMBOL (a) == sym); return a; } -- cgit v1.2.3 From 416fad04c26d712a0897c7a03566425133c6c7d1 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 20 Jan 2024 16:52:31 -0800 Subject: Omit -DHAVE_CONFIG_H * configure.ac (CFLAGS): Do not add -DHAVE_CONFIG_H. It is no longer needed now that the Android printf hack has been removed. --- configure.ac | 3 --- 1 file changed, 3 deletions(-) diff --git a/configure.ac b/configure.ac index 90b3cde0d18..55f742ba8ef 100644 --- a/configure.ac +++ b/configure.ac @@ -7097,9 +7097,6 @@ AC_DEFINE_UNQUOTED([COPYRIGHT], ["$copyright"], [Short copyright string for this version of Emacs.]) AC_SUBST([copyright]) -# This is needed for gnulib's printf modules. -CFLAGS="$CFLAGS -DHAVE_CONFIG_H" - ### Specify what sort of things we'll be editing into Makefile and config.h. ### Use configuration here uncanonicalized to avoid exceeding size limits. AC_SUBST([version]) -- cgit v1.2.3 From 76efd4037eeba53ad5716477c55bdf7ae6ccf6d9 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Jan 2024 09:15:55 +0800 Subject: ; * exec/Makefile.in (extraclean): Remove standard files. --- exec/Makefile.in | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/exec/Makefile.in b/exec/Makefile.in index 068f59efc75..9febc585f4f 100644 --- a/exec/Makefile.in +++ b/exec/Makefile.in @@ -1,4 +1,4 @@ -### @configure_input@ +s### @configure_input@ # Copyright (C) 2023-2024 Free Software Foundation, Inc. @@ -131,9 +131,12 @@ maintainer-clean: distclean ### the coding standards seem to come from. It's like distclean, but ### it deletes backup and autosave files too. +# config.* and install-sh are copied from build-aux in the root of +# this repository by autogen.sh. extraclean: maintainer-clean -rm -f config-tmp-* $(srcdir)/aclocal.m4 $(srcdir)/configure \ - $(srcdir)/src/config.in + $(srcdir)/src/config.in $(srcdir)/config.guess \ + $(srcdir)/config.sub $(srcdir)/install-sh -[ "$(srcdir)" = "." ] || \ find $(srcdir) '(' -name '*~' -o -name '#*' ')' $(FIND_DELETE) -find . '(' -name '*~' -o -name '#*' ')' $(FIND_DELETE) -- cgit v1.2.3 From 10ffe161da67a550534c818cab27001b1e75c79f Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Jan 2024 09:53:55 +0800 Subject: Suppress detection of utmpx.h on Android * configure.ac (ac_cv_header_utmpx_h): Predefine to no when Android is older than 34. --- configure.ac | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/configure.ac b/configure.ac index 55f742ba8ef..dffe7696ac5 100644 --- a/configure.ac +++ b/configure.ac @@ -160,6 +160,12 @@ variable when you ran configure.]) ;; esac AC_MSG_RESULT([$host_alias]) + + # Suppress the detection of utmpx.h on Android versions older than + # 34, for the header will be present yet define no functions, + # which Gnulib is not prepared to handle. + AS_IF([test "$ANDROID_SDK" -lt "34"], + [ac_cv_header_utmpx_h=no]) fi AC_CANONICAL_HOST -- cgit v1.2.3 From 8da6c8c7c1e25d2d1d511b50c0ff94097e512470 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Jan 2024 09:58:17 +0800 Subject: ; * exec/Makefile.in: Correct typo. --- exec/Makefile.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/exec/Makefile.in b/exec/Makefile.in index 9febc585f4f..36f0c0c74a9 100644 --- a/exec/Makefile.in +++ b/exec/Makefile.in @@ -1,4 +1,4 @@ -s### @configure_input@ +### @configure_input@ # Copyright (C) 2023-2024 Free Software Foundation, Inc. -- cgit v1.2.3 From e654f9ce1e6f146346160044a6469e34f25dfeea Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Jan 2024 10:04:02 +0800 Subject: * make-dist (possibly_non_vc_files): Append exec standard files. --- make-dist | 2 ++ 1 file changed, 2 insertions(+) diff --git a/make-dist b/make-dist index 91639652350..c8b0fcf4f24 100755 --- a/make-dist +++ b/make-dist @@ -358,6 +358,8 @@ possibly_non_vc_files=" admin/charsets/jisx2131-filter src/config.in exec/configure exec/config.h.in + exec/config.sub exec/config.guess + exec/install-sh leim/small-ja-dic-option "$( find admin doc etc lisp \ -- cgit v1.2.3 From d88f9717ae6279a7577023f8630bd777d1b153b0 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Jan 2024 10:33:30 +0800 Subject: ; * msdos/sedleim.inp: Adapt to Emacs 30. --- msdos/sedleim.inp | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/msdos/sedleim.inp b/msdos/sedleim.inp index f644e9ce965..d43fbef4672 100644 --- a/msdos/sedleim.inp +++ b/msdos/sedleim.inp @@ -41,3 +41,7 @@ RUN_EMACS = ${EMACS} -batch --no-site-file --no-site-lisp /^MKDIR_P *=/s,@MKDIR_P@,gmkdir -p, /^\${leimdir}\/quail \${leimdir}\/ja-dic: *$/s|\${leimdir}/|$(rel_leimdir)\\| + +# Should an option to enable this be provided by config.bat? +/^SMALL_JA_DIC *=/s/@SMALL_JA_DIC@// +/^small-ja-dic-option: /s|../config.status|| -- cgit v1.2.3 From ca8d451561c5f722f7c3bfc63595961334b7b5f9 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 20 Jan 2024 23:00:54 -0500 Subject: (define-derived-mode): Fix bug#68600 * lisp/emacs-lisp/derived.el (define-derived-mode): Use a reference to the mode symbol instead of the mode's "pretty" name in the hook variable's docstring. --- lisp/emacs-lisp/derived.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 5c224362708..726f96a25f7 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -211,10 +211,10 @@ See Info node `(elisp)Derived Modes' for more details. (defvar ,hook nil) (unless (get ',hook 'variable-documentation) (put ',hook 'variable-documentation - ,(format "Hook run after entering %s mode. + ,(format "Hook run after entering `%S'. No problems result if this variable is not bound. `add-hook' automatically binds it. (This is true for all hook variables.)" - name))) + child))) (unless (boundp ',map) (put ',map 'definition-name ',child)) (with-no-warnings (defvar ,map (make-sparse-keymap))) -- cgit v1.2.3 From eca7368039d841993ba649bc144017598592fa56 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 20 Jan 2024 23:12:36 -0500 Subject: * lisp/mwheel.el (mouse-wheel-obey-old-style-wheel-buttons): Simplify --- lisp/mwheel.el | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index fc1f8e8b6d6..d3cdab87e84 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -56,16 +56,7 @@ (bound-and-true-p mouse-wheel-mode)) (mouse-wheel-mode 1))) -(defvar mouse-wheel-obey-old-style-wheel-buttons - ;; FIXME: Yuck! - (if (or (featurep 'w32-win) (featurep 'ns-win) - (featurep 'haiku-win) (featurep 'pgtk-win) - (featurep 'android-win)) - (if (featurep 'xinput2) - nil - (unless (featurep 'x) - t)) - t) +(defvar mouse-wheel-obey-old-style-wheel-buttons t "If non-nil, treat mouse-4/5/6/7 events as mouse wheel events. These are the event names used historically in X11 before XInput2. They are sometimes generated by things like `xterm-mouse-mode' as well.") -- cgit v1.2.3 From 957b4f826a440d3d6fae8e338667530713ddf0ba Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Jan 2024 12:47:24 +0800 Subject: Don't invert wheel event directions * lisp/mwheel.el (mwheel--is-dir-p): In Emacs, up means down and down means up... --- lisp/mwheel.el | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index d3cdab87e84..1e08328c875 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -261,7 +261,15 @@ active window." (defmacro mwheel--is-dir-p (dir button) (declare (debug (sexp form))) (let ((custom-var (intern (format "mouse-wheel-%s-event" dir))) - (event (intern (format "wheel-%s" dir)))) + ;; N.B. that the direction `down' in a wheel event refers to + ;; the movement of the section of the buffer the window is + ;; displaying, that is to say, the direction `scroll-up' moves + ;; it in. + (event (intern (format "wheel-%s" (cond ((eq dir 'up) + 'down) + ((eq dir 'down) + 'up) + (t dir)))))) (macroexp-let2 nil butsym button `(or (eq ,butsym ',event) ;; We presume here `button' is never nil. -- cgit v1.2.3 From cc8d4b0c9110c1384f5a9c214cf4069b3e99ae9b Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Jan 2024 12:49:41 +0800 Subject: ; * etc/NEWS: Improve mwheel entry. --- etc/NEWS | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 8129412e872..a1874313502 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -419,9 +419,10 @@ In batch mode, tracing now sends the trace to stdout. +++ ** Mwheel The 'wheel-up/down/left/right' events are now bound unconditionally, -and the 'mouse-wheel-up/down/left/right-event' variables are thus -used only to specify the 'mouse-4/5/6/7' events generated by -legacy setup, such as 'xterm-mouse-mode' or X11 without XInput2. +and the 'mouse-wheel-up/down/left/right-event' variables are thus used +only to specify the 'mouse-4/5/6/7' events generated by older +configurations such as X11 when the X server does not support at least +version 2.1 of the X Input Extension, and 'xterm-mouse-mode'. +++ ** New command 'lldb'. -- cgit v1.2.3 From 0a07603ae8db41f69e83b1bfec6e28a92f737852 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sun, 21 Jan 2024 07:08:11 +0200 Subject: project-recompile: New command * lisp/progmodes/project.el (project-recompile): New command (bug#68570). --- lisp/progmodes/project.el | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index a6f14a0865c..ab4504fa027 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1363,6 +1363,7 @@ If you exit the `query-replace', you can later continue the (defvar compilation-read-command) (declare-function compilation-read-command "compile") +(declare-function recompile "compile") (defun project-prefixed-buffer-name (mode) (concat "*" @@ -1396,6 +1397,18 @@ If non-nil, it overrides `compilation-buffer-name-function' for compilation-buffer-name-function))) (call-interactively #'compile))) +(defun project-recompile (&optional edit-command) + "Run `recompile' with appropriate buffer." + (declare (interactive-only recompile)) + (interactive "P") + (let ((compilation-buffer-name-function + (or project-compilation-buffer-name-function + ;; Should we error instead? When there's no + ;; project-specific naming, there is no point in using + ;; this command. + compilation-buffer-name-function))) + (recompile edit-command))) + (defcustom project-ignore-buffer-conditions nil "List of conditions to filter the buffers to be switched to. If any of these conditions are satisfied for a buffer in the -- cgit v1.2.3 From c450eec07ff19953c8e1e75e99909d140db0e5d0 Mon Sep 17 00:00:00 2001 From: Matthew Smith Date: Sat, 20 Jan 2024 09:45:31 +0000 Subject: typescript-ts-mode: Skip test if tsx grammar missing typescript-ts-mode-test-indentation depends on both the tree-sitter typescript grammar, and the tree-sitter tsx grammar. If only the typescript is installed, the tests will run and then fail unexpectedly after tsx fails to load. * test/lisp/progmodes/typescript-ts-mode-tests.el (typescript-ts-mode-test-indentation): Skip test if tsx grammar is missing. Copyright-paperwork-exempt: yes --- test/lisp/progmodes/typescript-ts-mode-tests.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/lisp/progmodes/typescript-ts-mode-tests.el b/test/lisp/progmodes/typescript-ts-mode-tests.el index 27b7df714e6..effd9551fb0 100644 --- a/test/lisp/progmodes/typescript-ts-mode-tests.el +++ b/test/lisp/progmodes/typescript-ts-mode-tests.el @@ -24,7 +24,8 @@ (require 'treesit) (ert-deftest typescript-ts-mode-test-indentation () - (skip-unless (treesit-ready-p 'typescript)) + (skip-unless (and (treesit-ready-p 'typescript) + (treesit-ready-p 'tsx))) (ert-test-erts-file (ert-resource-file "indent.erts"))) (provide 'typescript-ts-mode-tests) -- cgit v1.2.3 From fec87a4b36a67688932e7bb7e1720bd2c4363a61 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 19 Jan 2024 15:17:52 +0100 Subject: Add C macro for hash table iteration This removes some boilerplate code and further reduces dependencies on hash table implementation internals. * src/lisp.h (DOHASH): New. * src/comp.c (compile_function, Fcomp__compile_ctxt_to_file): * src/composite.c (composition_gstring_cache_clear_font): * src/emacs-module.c (module_global_reference_p): * src/fns.c (Fmaphash): * src/json.c (lisp_to_json_nonscalar_1): * src/minibuf.c (Ftest_completion): * src/print.c (print): Use it instead of a hand-written loop. --- src/comp.c | 40 ++++++++++++++++------------------------ src/composite.c | 12 ++++-------- src/emacs-module.c | 9 +++------ src/fns.c | 9 +-------- src/json.c | 47 ++++++++++++++++++++++------------------------- src/lisp.h | 8 ++++++++ src/minibuf.c | 4 ++-- src/print.c | 12 +++--------- 8 files changed, 59 insertions(+), 82 deletions(-) diff --git a/src/comp.c b/src/comp.c index 3f9e738d9a7..25c4cb2f22c 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4330,11 +4330,10 @@ compile_function (Lisp_Object func) declare_block (Qentry); Lisp_Object blocks = CALL1I (comp-func-blocks, func); struct Lisp_Hash_Table *ht = XHASH_TABLE (blocks); - for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (ht); i++) + DOHASH (ht, i) { Lisp_Object block_name = HASH_KEY (ht, i); - if (!EQ (block_name, Qentry) - && !hash_unused_entry_key_p (block_name)) + if (!EQ (block_name, Qentry)) declare_block (block_name); } @@ -4344,24 +4343,21 @@ compile_function (Lisp_Object func) gcc_jit_lvalue_as_rvalue (comp.func_relocs)); - for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (ht); i++) + DOHASH (ht, i) { Lisp_Object block_name = HASH_KEY (ht, i); - if (!hash_unused_entry_key_p (block_name)) + Lisp_Object block = HASH_VALUE (ht, i); + Lisp_Object insns = CALL1I (comp-block-insns, block); + if (NILP (block) || NILP (insns)) + xsignal1 (Qnative_ice, + build_string ("basic block is missing or empty")); + + comp.block = retrive_block (block_name); + while (CONSP (insns)) { - Lisp_Object block = HASH_VALUE (ht, i); - Lisp_Object insns = CALL1I (comp-block-insns, block); - if (NILP (block) || NILP (insns)) - xsignal1 (Qnative_ice, - build_string ("basic block is missing or empty")); - - comp.block = retrive_block (block_name); - while (CONSP (insns)) - { - Lisp_Object insn = XCAR (insns); - emit_limple_insn (insn); - insns = XCDR (insns); - } + Lisp_Object insn = XCAR (insns); + emit_limple_insn (insn); + insns = XCDR (insns); } } const char *err = gcc_jit_context_get_first_error (comp.ctxt); @@ -4965,14 +4961,10 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, struct Lisp_Hash_Table *func_h = XHASH_TABLE (CALL1I (comp-ctxt-funcs-h, Vcomp_ctxt)); - for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (func_h); i++) - if (!hash_unused_entry_key_p (HASH_KEY (func_h, i))) - declare_function (HASH_VALUE (func_h, i)); + DOHASH (func_h, i) declare_function (HASH_VALUE (func_h, i)); /* Compile all functions. Can't be done before because the relocation structs has to be already defined. */ - for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (func_h); i++) - if (!hash_unused_entry_key_p (HASH_KEY (func_h, i))) - compile_function (HASH_VALUE (func_h, i)); + DOHASH (func_h, i) compile_function (HASH_VALUE (func_h, i)); /* Work around bug#46495 (GCC PR99126). */ #if defined (WIDE_EMACS_INT) \ diff --git a/src/composite.c b/src/composite.c index 78c884dd72d..d9233fe0cc0 100644 --- a/src/composite.c +++ b/src/composite.c @@ -687,17 +687,13 @@ composition_gstring_cache_clear_font (Lisp_Object font_object) { struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table); - for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) + DOHASH (h, i) { Lisp_Object k = HASH_KEY (h, i); + Lisp_Object gstring = HASH_VALUE (h, i); - if (!hash_unused_entry_key_p (k)) - { - Lisp_Object gstring = HASH_VALUE (h, i); - - if (EQ (LGSTRING_FONT (gstring), font_object)) - hash_remove_from_table (h, k); - } + if (EQ (LGSTRING_FONT (gstring), font_object)) + hash_remove_from_table (h, k); } } diff --git a/src/emacs-module.c b/src/emacs-module.c index 00ae33dfa2c..77dd2b9152c 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -410,12 +410,9 @@ module_global_reference_p (emacs_value v, ptrdiff_t *n) struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); /* Note that we can't use `hash_lookup' because V might be a local reference that's identical to some global reference. */ - for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) - { - if (!hash_unused_entry_key_p (HASH_KEY (h, i)) - && &XMODULE_GLOBAL_REFERENCE (HASH_VALUE (h, i))->value == v) - return true; - } + DOHASH (h, i) + if (&XMODULE_GLOBAL_REFERENCE (HASH_VALUE (h, i))->value == v) + return true; /* Only used for debugging, so we don't care about overflow, just make sure the operation is defined. */ ckd_add (n, *n, h->count); diff --git a/src/fns.c b/src/fns.c index 15bbd270311..4531b237824 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5655,14 +5655,7 @@ FUNCTION is called with two arguments, KEY and VALUE. (Lisp_Object function, Lisp_Object table) { struct Lisp_Hash_Table *h = check_hash_table (table); - - for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) - { - Lisp_Object k = HASH_KEY (h, i); - if (!hash_unused_entry_key_p (k)) - call2 (function, k, HASH_VALUE (h, i)); - } - + DOHASH (h, i) call2 (function, HASH_KEY (h, i), HASH_VALUE (h, i)); return Qnil; } diff --git a/src/json.c b/src/json.c index 266905f1c34..5434780ba13 100644 --- a/src/json.c +++ b/src/json.c @@ -361,33 +361,30 @@ lisp_to_json_nonscalar_1 (Lisp_Object lisp, json = json_check (json_object ()); count = SPECPDL_INDEX (); record_unwind_protect_ptr (json_release_object, json); - for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) + DOHASH (h, i) { Lisp_Object key = HASH_KEY (h, i); - if (!hash_unused_entry_key_p (key)) - { - CHECK_STRING (key); - Lisp_Object ekey = json_encode (key); - /* We can't specify the length, so the string must be - null-terminated. */ - check_string_without_embedded_nulls (ekey); - const char *key_str = SSDATA (ekey); - /* Reject duplicate keys. These are possible if the hash - table test is not `equal'. */ - if (json_object_get (json, key_str) != NULL) - wrong_type_argument (Qjson_value_p, lisp); - int status - = json_object_set_new (json, key_str, - lisp_to_json (HASH_VALUE (h, i), conf)); - if (status == -1) - { - /* A failure can be caused either by an invalid key or - by low memory. */ - json_check_utf8 (ekey); - json_out_of_memory (); - } - } - } + CHECK_STRING (key); + Lisp_Object ekey = json_encode (key); + /* We can't specify the length, so the string must be + null-terminated. */ + check_string_without_embedded_nulls (ekey); + const char *key_str = SSDATA (ekey); + /* Reject duplicate keys. These are possible if the hash + table test is not `equal'. */ + if (json_object_get (json, key_str) != NULL) + wrong_type_argument (Qjson_value_p, lisp); + int status + = json_object_set_new (json, key_str, + lisp_to_json (HASH_VALUE (h, i), conf)); + if (status == -1) + { + /* A failure can be caused either by an invalid key or + by low memory. */ + json_check_utf8 (ekey); + json_out_of_memory (); + } + } } else if (NILP (lisp)) return json_check (json_object ()); diff --git a/src/lisp.h b/src/lisp.h index f0beafba42c..edea7cc23bb 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2579,6 +2579,14 @@ hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) return h->test->hashfn (key, h); } +/* Hash table iteration construct (roughly an inlined maphash): + Iterate IDXVAR as index over valid entries of TABLE. + The body may remove the current entry or alter its value slot, but not + mutate TABLE in any other way. */ +#define DOHASH(TABLE, IDXVAR) \ + for (ptrdiff_t IDXVAR = 0; IDXVAR < (TABLE)->table_size; IDXVAR++) \ + if (!hash_unused_entry_key_p (HASH_KEY (TABLE, IDXVAR))) + void hash_table_thaw (Lisp_Object hash_table); /* Default size for hash tables if not specified. */ diff --git a/src/minibuf.c b/src/minibuf.c index 8198dc0f360..857b62d94f0 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -2114,10 +2114,10 @@ the values STRING, PREDICATE and `lambda'. */) goto found_matching_key; } else - for (i = 0; i < HASH_TABLE_SIZE (h); ++i) + DOHASH (h, j) { + i = j; tem = HASH_KEY (h, i); - if (hash_unused_entry_key_p (tem)) continue; Lisp_Object strkey = (SYMBOLP (tem) ? Fsymbol_name (tem) : tem); if (!STRINGP (strkey)) continue; if (BASE_EQ (Fcompare_strings (string, Qnil, Qnil, diff --git a/src/print.c b/src/print.c index 61999c096aa..c61fb3cd574 100644 --- a/src/print.c +++ b/src/print.c @@ -1285,15 +1285,9 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) { /* Remove unnecessary objects, which appear only once in OBJ; that is, whose status is Qt. */ struct Lisp_Hash_Table *h = XHASH_TABLE (Vprint_number_table); - ptrdiff_t i; - - for (i = 0; i < HASH_TABLE_SIZE (h); ++i) - { - Lisp_Object key = HASH_KEY (h, i); - if (!hash_unused_entry_key_p (key) - && EQ (HASH_VALUE (h, i), Qt)) - Fremhash (key, Vprint_number_table); - } + DOHASH (h, i) + if (EQ (HASH_VALUE (h, i), Qt)) + Fremhash (HASH_KEY (h, i), Vprint_number_table); } } -- cgit v1.2.3 From 7a87ca09a73d61b46bfcaca317095ce7545bd3f3 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 19 Jan 2024 15:52:13 +0100 Subject: Clarify permitted mutation in `maphash` documentation * doc/lispref/hash.texi (Hash Access): * src/fns.c (Fmaphash): Make it clear what the function passed as argument can do. Until now these rules were unwritten, and are still unenforced. --- doc/lispref/hash.texi | 4 ++++ src/fns.c | 2 ++ 2 files changed, 6 insertions(+) diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi index 3d3fe3e3be2..4270de664f1 100644 --- a/doc/lispref/hash.texi +++ b/doc/lispref/hash.texi @@ -206,6 +206,10 @@ This function calls @var{function} once for each of the associations in @var{table}. The function @var{function} should accept two arguments---a @var{key} listed in @var{table}, and its associated @var{value}. @code{maphash} returns @code{nil}. + +@var{function} is allowed to call @code{puthash} to set a new value +for @var{key} and @code{remhash} to remove @var{key}, but should not +add, remove or modify other associations in @var{table}. @end defun @node Defining Hash diff --git a/src/fns.c b/src/fns.c index 4531b237824..f862c1470c4 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5651,6 +5651,8 @@ DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0, DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0, doc: /* Call FUNCTION for all entries in hash table TABLE. FUNCTION is called with two arguments, KEY and VALUE. +It should not alter TABLE in any way other than using `puthash' to +set a new value for KEY, or `remhash' to remove KEY. `maphash' always returns nil. */) (Lisp_Object function, Lisp_Object table) { -- cgit v1.2.3 From 50201e03b9c4133296dbd10e6c7ebd5dc2a62d50 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 19 Jan 2024 16:45:51 +0100 Subject: Make better use of fixnum range in sxhash etc Recent hash table changes reduced the range of sxhash, sxhash-eq etc to [0,2**32) on platforms with 62-bit fixnums. This change makes them use the full fixnum range again. Hash table hashing is unaffected. * src/fns.c (sxhash_eq, sxhash_eql): New. (hash_hash_to_fixnum): Replace with... (reduce_emacs_uint_to_fixnum): ...this. (hashfn_eq, hashfn_eql, Fsxhash_eq, Fsxhash_eql, Fsxhash_equal) (Fsxhash_equal_including_properties): Use the new functions. --- src/fns.c | 45 +++++++++++++++++++++++++-------------------- 1 file changed, 25 insertions(+), 20 deletions(-) diff --git a/src/fns.c b/src/fns.c index f862c1470c4..f34e069ddbe 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4462,14 +4462,26 @@ reduce_emacs_uint_to_hash_hash (EMACS_UINT x) : x ^ (x >> (8 * (sizeof x - sizeof (hash_hash_t))))); } +static EMACS_INT +sxhash_eq (Lisp_Object key) +{ + if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (key)) + key = SYMBOL_WITH_POS_SYM (key); + return XHASH (key) ^ XTYPE (key); +} + +static EMACS_INT +sxhash_eql (Lisp_Object key) +{ + return FLOATP (key) || BIGNUMP (key) ? sxhash (key) : sxhash_eq (key); +} + /* Ignore H and return a hash code for KEY which uses 'eq' to compare keys. */ static hash_hash_t hashfn_eq (Lisp_Object key, struct Lisp_Hash_Table *h) { - if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (key)) - key = SYMBOL_WITH_POS_SYM (key); - return reduce_emacs_uint_to_hash_hash (XHASH (key) ^ XTYPE (key)); + return reduce_emacs_uint_to_hash_hash (sxhash_eq (key)); } /* Ignore H and return a hash code for KEY which uses 'equal' to @@ -4484,8 +4496,7 @@ hashfn_equal (Lisp_Object key, struct Lisp_Hash_Table *h) static hash_hash_t hashfn_eql (Lisp_Object key, struct Lisp_Hash_Table *h) { - return (FLOATP (key) || BIGNUMP (key) - ? hashfn_equal (key, h) : hashfn_eq (key, h)); + return reduce_emacs_uint_to_hash_hash (sxhash_eql (key)); } /* Given H, return a hash code for KEY which uses a user-defined @@ -5283,13 +5294,11 @@ collect_interval (INTERVAL interval, void *arg) Lisp Interface ***********************************************************************/ -/* Reduce X to a Lisp fixnum. */ +/* Reduce the hash value X to a Lisp fixnum. */ static inline Lisp_Object -hash_hash_to_fixnum (hash_hash_t x) +reduce_emacs_uint_to_fixnum (EMACS_UINT x) { - return make_ufixnum (FIXNUM_BITS < 8 * sizeof x - ? (x ^ x >> (8 * sizeof x - FIXNUM_BITS)) & INTMASK - : x); + return make_ufixnum (SXHASH_REDUCE (x)); } DEFUN ("sxhash-eq", Fsxhash_eq, Ssxhash_eq, 1, 1, 0, @@ -5299,7 +5308,7 @@ If (eq A B), then (= (sxhash-eq A) (sxhash-eq B)). Hash codes are not guaranteed to be preserved across Emacs sessions. */) (Lisp_Object obj) { - return hash_hash_to_fixnum (hashfn_eq (obj, NULL)); + return reduce_emacs_uint_to_fixnum (sxhash_eq (obj)); } DEFUN ("sxhash-eql", Fsxhash_eql, Ssxhash_eql, 1, 1, 0, @@ -5310,7 +5319,7 @@ isn't necessarily true. Hash codes are not guaranteed to be preserved across Emacs sessions. */) (Lisp_Object obj) { - return hash_hash_to_fixnum (hashfn_eql (obj, NULL)); + return reduce_emacs_uint_to_fixnum (sxhash_eql (obj)); } DEFUN ("sxhash-equal", Fsxhash_equal, Ssxhash_equal, 1, 1, 0, @@ -5321,7 +5330,7 @@ opposite isn't necessarily true. Hash codes are not guaranteed to be preserved across Emacs sessions. */) (Lisp_Object obj) { - return hash_hash_to_fixnum (hashfn_equal (obj, NULL)); + return reduce_emacs_uint_to_fixnum (sxhash (obj)); } DEFUN ("sxhash-equal-including-properties", Fsxhash_equal_including_properties, @@ -5334,14 +5343,10 @@ If (sxhash-equal-including-properties A B), then Hash codes are not guaranteed to be preserved across Emacs sessions. */) (Lisp_Object obj) { + EMACS_UINT hash = sxhash (obj); if (STRINGP (obj)) - { - EMACS_UINT hash = 0; - traverse_intervals (string_intervals (obj), 0, hash_interval, &hash); - return make_ufixnum (SXHASH_REDUCE (sxhash_combine (sxhash (obj), hash))); - } - - return hash_hash_to_fixnum (hashfn_equal (obj, NULL)); + traverse_intervals (string_intervals (obj), 0, hash_interval, &hash); + return reduce_emacs_uint_to_fixnum (hash); } -- cgit v1.2.3 From 1d754c79603f1b6e4574c7e64c1bf5fb8c6c190d Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 19 Jan 2024 18:31:06 +0100 Subject: Change HASH_UNUSED_ENTRY_KEY from Qunbound to NULL float This removes hacks from code that had to be careful not to use Qunbound as a hash table key, at the cost of a minor hack in the GC marker. * src/lisp.h (INVALID_LISP_VALUE, HASH_UNUSED_ENTRY_KEY): Define as a null-pointer float. * src/alloc.c (process_mark_stack): Add hack to ignore that value. * src/pdumper.c (dump_object_needs_dumping_p) (pdumper_init_symbol_unbound, pdumper_load): * src/print.c (PRINT_CIRCLE_CANDIDATE_P): Remove hacks for Qunbound. --- src/alloc.c | 24 ++++++++++++++++-------- src/lisp.h | 7 ++++++- src/pdumper.c | 19 +------------------ src/print.c | 8 ++++++-- 4 files changed, 29 insertions(+), 29 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index b78445f65df..2a1690d2cff 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -7293,6 +7293,9 @@ process_mark_stack (ptrdiff_t base_sp) struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *)ptr; set_vector_marked (ptr); if (h->weakness == Weak_None) + /* The values pushed here may include + HASH_UNUSED_ENTRY_KEY, which this function must + cope with. */ mark_stack_push_values (h->key_and_value, 2 * h->table_size); else @@ -7437,14 +7440,19 @@ process_mark_stack (ptrdiff_t base_sp) } case Lisp_Float: - CHECK_ALLOCATED_AND_LIVE (live_float_p, MEM_TYPE_FLOAT); - /* Do not mark floats stored in a dump image: these floats are - "cold" and do not have mark bits. */ - if (pdumper_object_p (XFLOAT (obj))) - eassert (pdumper_cold_object_p (XFLOAT (obj))); - else if (!XFLOAT_MARKED_P (XFLOAT (obj))) - XFLOAT_MARK (XFLOAT (obj)); - break; + { + struct Lisp_Float *f = XFLOAT (obj); + if (!f) + break; /* for HASH_UNUSED_ENTRY_KEY */ + CHECK_ALLOCATED_AND_LIVE (live_float_p, MEM_TYPE_FLOAT); + /* Do not mark floats stored in a dump image: these floats are + "cold" and do not have mark bits. */ + if (pdumper_object_p (f)) + eassert (pdumper_cold_object_p (f)); + else if (!XFLOAT_MARKED_P (f)) + XFLOAT_MARK (f); + break; + } case_Lisp_Int: break; diff --git a/src/lisp.h b/src/lisp.h index edea7cc23bb..ae78947805e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2515,8 +2515,13 @@ struct Lisp_Hash_Table struct Lisp_Hash_Table *next_weak; } GCALIGNED_STRUCT; +/* A specific Lisp_Object that is not a valid Lisp value. + We need to be careful not to leak this value into machinery + where it may be treated as one; we'd get a segfault if lucky. */ +#define INVALID_LISP_VALUE make_lisp_ptr (NULL, Lisp_Float) + /* Key value that marks an unused hash table entry. */ -#define HASH_UNUSED_ENTRY_KEY Qunbound +#define HASH_UNUSED_ENTRY_KEY INVALID_LISP_VALUE /* KEY is a key of an unused hash table entry. */ INLINE bool diff --git a/src/pdumper.c b/src/pdumper.c index 4602931b63a..8d030585c83 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -1337,9 +1337,7 @@ dump_object_needs_dumping_p (Lisp_Object object) included in the dump despite all references to them being bitwise-invariant. */ return (!dump_object_self_representing_p (object) - || (dump_object_emacs_ptr (object) - /* Don't dump Qunbound -- it's not a legal hash table key. */ - && !BASE_EQ (object, Qunbound))); + || dump_object_emacs_ptr (object)); } static void @@ -2553,19 +2551,6 @@ dump_symbol (struct dump_context *ctx, return offset; } -/* Give Qunbound its name. - All other symbols are dumped and loaded but not Qunbound because it - cannot be used as a key in a hash table. - FIXME: A better solution would be to use a value other than Qunbound - as a marker for unused entries in hash tables. */ -static void -pdumper_init_symbol_unbound (void) -{ - eassert (NILP (SYMBOL_NAME (Qunbound))); - const char *name = "unbound"; - init_symbol (Qunbound, make_pure_c_string (name, strlen (name))); -} - static dump_off dump_vectorlike_generic (struct dump_context *ctx, const union vectorlike_header *header) @@ -5767,8 +5752,6 @@ pdumper_load (const char *dump_filename, char *argv0) for (int i = 0; i < nr_dump_hooks; ++i) dump_hooks[i] (); - pdumper_init_symbol_unbound (); - #ifdef HAVE_NATIVE_COMP pdumper_set_emacs_execdir (argv0); #else diff --git a/src/print.c b/src/print.c index c61fb3cd574..c99d8d5fe3a 100644 --- a/src/print.c +++ b/src/print.c @@ -1305,8 +1305,7 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) || RECORDP (obj))) \ || (! NILP (Vprint_gensym) \ && SYMBOLP (obj) \ - && !SYMBOL_INTERNED_P (obj) \ - && !hash_unused_entry_key_p (obj))) + && !SYMBOL_INTERNED_P (obj))) /* The print preprocess stack, used to traverse data structures. */ @@ -1392,6 +1391,9 @@ static void print_preprocess (Lisp_Object obj) { eassert (!NILP (Vprint_circle)); + /* The ppstack may contain HASH_UNUSED_ENTRY_KEY which is an invalid + Lisp value. Make sure that our filter stops us from traversing it. */ + eassert (!PRINT_CIRCLE_CANDIDATE_P (HASH_UNUSED_ENTRY_KEY)); ptrdiff_t base_sp = ppstack.sp; for (;;) @@ -1450,6 +1452,8 @@ print_preprocess (Lisp_Object obj) if (HASH_TABLE_P (obj)) { struct Lisp_Hash_Table *h = XHASH_TABLE (obj); + /* The values pushed here may include + HASH_UNUSED_ENTRY_KEY; see top of this function. */ pp_stack_push_values (h->key_and_value, 2 * h->table_size); } -- cgit v1.2.3 From 5c12e988abb24b8240814d3dd3f40face7d48287 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 21 Jan 2024 14:09:21 +0100 Subject: doc: Delete extraneous quotes around keys * lisp/allout.el (allout-outlinify-sticky): * lisp/auth-source.el (auth-sources): * lisp/buff-menu.el (Buffer-menu-delete) (Buffer-menu-delete-backwards, Buffer-menu-save) (Buffer-menu-execute, Buffer-menu-select): * lisp/calendar/todo-mode.el (todo-show) (todo-show-categories-table, todo-top-priorities-overrides): * lisp/desktop.el (desktop-save-mode): * lisp/dired-aux.el (dired-do-kill-lines, dired-do-copy): * lisp/edmacro.el (edit-kbd-macro): * lisp/emulation/viper-cmd.el (viper-ask-level): * lisp/emulation/viper-init.el (viper-expert-level): * lisp/filesets.el (filesets-add-buffer): * lisp/follow.el (follow-mode): * lisp/gnus/gnus-group.el (gnus-group-mode): * lisp/gnus/gnus-sum.el (gnus-summary-mode): * lisp/ibuffer.el (ibuffer-mode): * lisp/international/ogonek.el (ogonek-informacja) (ogonek-information): * lisp/isearch.el (search-default-mode): * lisp/macros.el (apply-macro-to-region-lines): * lisp/mail/supercite.el (sc-mail-field-query) (sc-insert-reference, sc-insert-citation): * lisp/play/decipher.el (decipher-make-checkpoint): (decipher-restore-checkpoint): * lisp/progmodes/idlw-shell.el (idlwave-shell-mode): * lisp/progmodes/idlwave.el (idlwave-store-inquired-class): * lisp/progmodes/prolog.el (prolog-mode, prolog-inferior-mode): * lisp/progmodes/sh-script.el (sh-set-shell): * lisp/progmodes/vhdl-mode.el (vhdl-compiler-alist) (vhdl-modify-date-prefix-string) (vhdl-modify-date-on-saving, vhdl-mode): * lisp/server.el (server-start): * lisp/subr.el (locate-library): * lisp/tempo.el (tempo-marks, tempo-use-tag-list): * lisp/time.el (world-clock): * lisp/vc/vc-hooks.el (vc-mode): * lisp/whitespace.el (whitespace-report-region): * lisp/windmove.el (windmove-delete-in-direction): Doc fix: Delete extraneous quotes around keys. --- lisp/allout.el | 2 +- lisp/auth-source.el | 4 +- lisp/buff-menu.el | 18 ++-- lisp/calendar/todo-mode.el | 26 ++--- lisp/desktop.el | 4 +- lisp/dired-aux.el | 4 +- lisp/edmacro.el | 6 +- lisp/emulation/viper-cmd.el | 2 +- lisp/emulation/viper-init.el | 10 +- lisp/filesets.el | 2 +- lisp/follow.el | 4 +- lisp/gnus/gnus-group.el | 6 +- lisp/gnus/gnus-sum.el | 10 +- lisp/ibuffer.el | 238 +++++++++++++++++++++---------------------- lisp/international/ogonek.el | 4 +- lisp/isearch.el | 6 +- lisp/macros.el | 4 +- lisp/mail/supercite.el | 6 +- lisp/play/decipher.el | 6 +- lisp/progmodes/idlw-shell.el | 2 +- lisp/progmodes/idlwave.el | 2 +- lisp/progmodes/prolog.el | 4 +- lisp/progmodes/sh-script.el | 2 +- lisp/progmodes/vhdl-mode.el | 18 ++-- lisp/server.el | 4 +- lisp/subr.el | 2 +- lisp/tempo.el | 4 +- lisp/time.el | 2 +- lisp/vc/vc-hooks.el | 2 +- lisp/whitespace.el | 4 +- lisp/windmove.el | 2 +- 31 files changed, 206 insertions(+), 204 deletions(-) diff --git a/lisp/allout.el b/lisp/allout.el index 95b73c54934..a7121efb14a 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -6195,7 +6195,7 @@ for details on preparing Emacs for automatic allout activation." (allout-open-topic 2) (insert (substitute-command-keys (concat "Dummy outline topic header -- see" - " `allout-mode' docstring: `\\[describe-mode]'."))) + " `allout-mode' docstring: \\[describe-mode]"))) (allout-adjust-file-variable "allout-layout" (or allout-layout '(-1 : 0)))))) ;;;_ > allout-file-vars-section-data () diff --git a/lisp/auth-source.el b/lisp/auth-source.el index e62a9eaa7b1..1f233f9f60f 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -233,8 +233,8 @@ EPA/EPG set up, the file will be encrypted and decrypted automatically. See Info node `(epa)Encrypting/decrypting gpg files' for details. -It's best to customize this with `\\[customize-variable]' because the choices -can get pretty complex." +It's best to customize this with \\[customize-variable] because +the choices can get pretty complex." :version "26.1" ; neither new nor changed default :type `(repeat :tag "Authentication Sources" (choice diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 82afea3d053..5796544c534 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -416,7 +416,7 @@ When called interactively prompt for MARK; RET remove all marks." (defun Buffer-menu-delete (&optional arg) "Mark the buffer on this Buffer Menu buffer line for deletion. -A subsequent \\`\\[Buffer-menu-execute]' command +A subsequent \\\\[Buffer-menu-execute] command \ will delete it. If prefix argument ARG is non-nil, it specifies the number of @@ -437,16 +437,16 @@ buffers to delete; a negative ARG means to delete backwards." (defun Buffer-menu-delete-backwards (&optional arg) "Mark the buffer on this Buffer Menu line for deletion, and move up. -A subsequent \\`\\[Buffer-menu-execute]' -command will delete the marked buffer. Prefix ARG means move -that many lines." +A subsequent \\\\[Buffer-menu-execute] command \ +will delete the marked buffer. Prefix ARG + means move that many lines." (interactive "p" Buffer-menu-mode) (Buffer-menu-delete (- (or arg 1)))) (defun Buffer-menu-save () "Mark the buffer on this Buffer Menu line for saving. -A subsequent \\`\\[Buffer-menu-execute]' command -will save it." +A subsequent \\\\[Buffer-menu-execute] \ +command will save it." (interactive nil Buffer-menu-mode) (when (Buffer-menu-buffer) (tabulated-list-set-col 2 "S" t) @@ -463,8 +463,8 @@ it as modified." (defun Buffer-menu-execute () "Save and/or delete marked buffers in the Buffer Menu. -Buffers marked with \\`\\[Buffer-menu-save]' are saved. -Buffers marked with \\`\\[Buffer-menu-delete]' are deleted." +Buffers marked with \\\\[Buffer-menu-save] are saved. +Buffers marked with \\\\[Buffer-menu-delete] are deleted." (interactive nil Buffer-menu-mode) (save-excursion (Buffer-menu-beginning) @@ -492,7 +492,7 @@ Buffers marked with \\`\\[Buffer-menu-delete]' are deleted (defun Buffer-menu-select () "Select this line's buffer; also, display buffers marked with `>'. -You can mark buffers with the \\`\\[Buffer-menu-mark]' command. +You can mark buffers with the \\\\[Buffer-menu-mark] command. This command deletes and replaces all the previously existing windows in the selected frame, and will remove any marks." diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index d0b4c05cd68..f2ee94ec8f7 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -677,7 +677,7 @@ current (i.e., last displayed) category. In Todo mode just the category's unfinished todo items are shown by default. The done items are hidden, but typing -`\\[todo-toggle-view-done-items]' displays them below the todo +\\[todo-toggle-view-done-items] displays them below the todo items. With non-nil user option `todo-show-with-done' both todo and done items are always shown on visiting a category." (interactive "P\np") @@ -3570,12 +3570,12 @@ categories display according to priority." In the initial display the lines of the table are numbered, indicating the current order of the categories when sequentially -navigating through the todo file with `\\[todo-forward-category]' -and `\\[todo-backward-category]'. You can reorder the lines, and -hence the category sequence, by typing `\\[todo-raise-category]' -or `\\[todo-lower-category]' to raise or lower the category at -point, or by typing `\\[todo-set-category-number]' and entering a -number at the prompt or by typing `\\[todo-set-category-number]' +navigating through the todo file with \\[todo-forward-category] +and \\[todo-backward-category]. You can reorder the lines, and +hence the category sequence, by typing \\[todo-raise-category] +or \\[todo-lower-category] to raise or lower the category at +point, or by typing \\[todo-set-category-number] and entering a +number at the prompt or by typing \\[todo-set-category-number] with a numeric prefix. If you save the todo file after reordering the categories, the new order persists in subsequent Emacs sessions. @@ -3584,8 +3584,8 @@ The labels above the category names and item counts are buttons, and clicking these changes the display: sorted by category name or by the respective item counts (alternately descending or ascending). In these displays the categories are not numbered -and `\\[todo-set-category-number]', `\\[todo-raise-category]' and -`\\[todo-lower-category]' are disabled. (Programmatically, the +and \\[todo-set-category-number], \\[todo-raise-category] and +\\[todo-lower-category] are disabled. (Programmatically, the sorting is triggered by passing a non-nil SORTKEY argument.) In addition, the lines with the category names and item counts @@ -4065,8 +4065,8 @@ face." (defcustom todo-top-priorities-overrides nil "List of rules specifying number of top priority items to show. These rules override `todo-top-priorities' on invocations of -`\\[todo-filter-top-priorities]' and -`\\[todo-filter-top-priorities-multifile]'. Each rule is a list +\\[todo-filter-top-priorities] and +\\[todo-filter-top-priorities-multifile]. Each rule is a list of the form (FILE NUM ALIST), where FILE is a member of `todo-files', NUM is a number specifying the default number of top priority items for each category in that file, and ALIST, @@ -4075,8 +4075,8 @@ number specifying the default number of top priority items in that category, which overrides NUM. This variable should be set interactively by -`\\[todo-set-top-priorities-in-file]' or -`\\[todo-set-top-priorities-in-category]'." +\\[todo-set-top-priorities-in-file] or +\\[todo-set-top-priorities-in-category]." :type 'sexp :group 'todo-filtered) diff --git a/lisp/desktop.el b/lisp/desktop.el index ff113c85e12..e3994ceb83c 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -168,8 +168,8 @@ one session to another. In particular, Emacs will save the desktop when it exits (this may prompt you; see the option `desktop-save'). The next time Emacs starts, if this mode is active it will restore the desktop. -To manually save the desktop at any time, use the command `\\[desktop-save]'. -To load it, use `\\[desktop-read]'. +To manually save the desktop at any time, use the command \\[desktop-save]. +To load it, use \\[desktop-read]. Once a desktop file exists, Emacs will auto-save it according to the option `desktop-auto-save-timeout'. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index f091101ea27..a2ce3083cfe 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1467,7 +1467,7 @@ With a prefix argument, kill that many lines starting with the current line. (defun dired-do-kill-lines (&optional arg fmt init-count) "Remove all marked lines, or the next ARG lines. The files or directories on those lines are _not_ deleted. Only the -Dired listing is affected. To restore the removals, use `\\[revert-buffer]'. +Dired listing is affected. To restore the removals, use \\[revert-buffer]. With a numeric prefix arg, remove that many lines going forward, starting with the current line. (A negative prefix arg removes lines @@ -2871,7 +2871,7 @@ similar to the \"-d\" option for the \"cp\" shell command. But if `dired-copy-dereference' is non-nil, the symbolic links are dereferenced and then copied, similar to the \"-L\" option for the \"cp\" shell command. If ARG is a cons with -element 4 (`\\[universal-argument]'), the inverted value of +element 4 (\\[universal-argument]), the inverted value of `dired-copy-dereference' will be used. Also see `dired-do-revert-buffer'." diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 9d185d79142..abfc380d154 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -124,9 +124,9 @@ from `kmacro-edit-lossage'." (defun edit-kbd-macro (keys &optional prefix finish-hook store-hook) "Edit a keyboard macro. At the prompt, type any key sequence which is bound to a keyboard macro. -Or, type `\\[kmacro-end-and-call-macro]' or \\`RET' to edit the last -keyboard macro, `\\[view-lossage]' to edit the last 300 -keystrokes as a keyboard macro, or `\\[execute-extended-command]' +Or, type \\[kmacro-end-and-call-macro] or \\`RET' to edit the last +keyboard macro, \\[view-lossage] to edit the last 300 +keystrokes as a keyboard macro, or \\[execute-extended-command] to edit a macro by its command name. With a prefix argument, format the macro in a more concise way." (interactive diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 9c42f38dc45..192eb99a570 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -4637,7 +4637,7 @@ sensitive for VI-style look-and-feel." (insert (substitute-command-keys " Please specify your level of familiarity with the venomous VI PERil \(and the VI Plan for Emacs Rescue). -You can change it at any time by typing `\\[viper-set-expert-level]' +You can change it at any time by typing \\[viper-set-expert-level] 1 -- BEGINNER: Almost all Emacs features are suppressed. Feels almost like straight Vi. File name completion and diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index 30750951887..9f724551239 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -257,11 +257,11 @@ that deletes a file.") (defvar viper-expert-level (if (boundp 'viper-expert-level) viper-expert-level 0) "User's expert level. -The minor mode viper-vi-diehard-minor-mode is in effect when -viper-expert-level is 1 or 2 or when viper-want-emacs-keys-in-vi is t. -The minor mode viper-insert-diehard-minor-mode is in effect when -viper-expert-level is 1 or 2 or if viper-want-emacs-keys-in-insert is t. -Use `\\[viper-set-expert-level]' to change this.") +The minor mode `viper-vi-diehard-minor-mode' is in effect when +`viper-expert-level' is 1 or 2 or when `viper-want-emacs-keys-in-vi' is t. +The minor mode `viper-insert-diehard-minor-mode' is in effect when +`viper-expert-level' is 1 or 2 or if `viper-want-emacs-keys-in-insert' is t. +Use \\[viper-set-expert-level] to change this.") ;; Max expert level supported by Viper. This is NOT a user option. ;; It is here to make it hard for the user from resetting it. diff --git a/lisp/filesets.el b/lisp/filesets.el index 7332687d46d..11576a46936 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -1767,7 +1767,7 @@ If no fileset name is provided, prompt for NAME." (add-to-list 'filesets-data (list name '(:files))) (message (substitute-command-keys - "Fileset %s created. Call `\\[filesets-save-config]' to save.") + "Fileset %s created. Call \\[filesets-save-config] to save.") name) (car filesets-data)))))) (if entry diff --git a/lisp/follow.el b/lisp/follow.el index 316c85b1629..ce40317ca59 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -413,8 +413,8 @@ being able to use 144 or 216 lines instead of the normal 72... (your mileage may vary). To split one large window into two side-by-side windows, the commands -`\\[split-window-right]' or \ -`\\[follow-delete-other-windows-and-split]' can be used. +\\[split-window-right] or \ +\\[follow-delete-other-windows-and-split] can be used. Only windows displayed in the same frame follow each other. diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 9664d603019..d562d052d82 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -1064,11 +1064,11 @@ When FORCE, rebuild the tool bar." All normal editing commands are switched off. \\ The group buffer lists (some of) the groups available. For instance, -`\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]' +\\[gnus-group-list-groups] will list all subscribed groups with unread articles, while \\[gnus-group-list-zombies] lists all zombie groups. -Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe -to a group not displayed, type `\\[gnus-group-toggle-subscription]'. +Groups that are displayed can be entered with \\[gnus-group-read-group]. To subscribe +to a group not displayed, type \\[gnus-group-toggle-subscription]. For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index fd67e46a401..dc66e1375ab 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -3062,17 +3062,17 @@ the summary mode hooks are run.") "Major mode for reading articles. \\ Each line in this buffer represents one article. To read an -article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards -and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]', +article, you can, for instance, type \\[gnus-summary-next-page]. To move forwards +and backwards while displaying articles, type \\[gnus-summary-next-unread-article] and \\[gnus-summary-prev-unread-article], respectively. You can also post articles and send mail from this buffer. To -follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author -of an article, type `\\[gnus-summary-reply]'. +follow up an article, type \\[gnus-summary-followup]. To mail a reply to the author +of an article, type \\[gnus-summary-reply]. There are approximately one gazillion commands you can execute in this buffer; read the Info manual for more -information (`\\[gnus-info-find-node]'). +information (\\[gnus-info-find-node]). The following commands are available: diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 602f06338e2..c65213f5bde 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -2376,135 +2376,135 @@ particular subset of them, and sorting by various criteria. Operations on marked buffers: \\ - `\\[ibuffer-do-save]' - Save the marked buffers. - `\\[ibuffer-do-view]' - View the marked buffers in the selected frame. - `\\[ibuffer-do-view-other-frame]' - View the marked buffers in another frame. - `\\[ibuffer-do-revert]' - Revert the marked buffers. - `\\[ibuffer-do-toggle-read-only]' - Toggle read-only state of marked buffers. - `\\[ibuffer-do-toggle-lock]' - Toggle lock state of marked buffers. - `\\[ibuffer-do-delete]' - Kill the marked buffers. - `\\[ibuffer-do-isearch]' - Do incremental search in the marked buffers. - `\\[ibuffer-do-isearch-regexp]' - Isearch for regexp in the marked buffers. - `\\[ibuffer-do-replace-regexp]' - Replace by regexp in each of the marked - buffers. - `\\[ibuffer-do-query-replace]' - Query replace in each of the marked buffers. - `\\[ibuffer-do-query-replace-regexp]' - As above, with a regular expression. - `\\[ibuffer-do-print]' - Print the marked buffers. - `\\[ibuffer-do-occur]' - List lines in all marked buffers which match - a given regexp (like the function `occur'). - `\\[ibuffer-do-shell-command-pipe]' - Pipe the contents of the marked - buffers to a shell command. - `\\[ibuffer-do-shell-command-pipe-replace]' - Replace the contents of the marked - buffers with the output of a shell command. - `\\[ibuffer-do-shell-command-file]' - Run a shell command with the - buffer's file as an argument. - `\\[ibuffer-do-eval]' - Evaluate a form in each of the marked buffers. This - is a very flexible command. For example, if you want to make all - of the marked buffers read-only, try using (read-only-mode 1) as - the input form. - `\\[ibuffer-do-view-and-eval]' - As above, but view each buffer while the form - is evaluated. - `\\[ibuffer-do-kill-lines]' - Remove the marked lines from the *Ibuffer* buffer, - but don't kill the associated buffer. - `\\[ibuffer-do-kill-on-deletion-marks]' - Kill all buffers marked for deletion. + \\[ibuffer-do-save] - Save the marked buffers. + \\[ibuffer-do-view] - View the marked buffers in the selected frame. + \\[ibuffer-do-view-other-frame] - View the marked buffers in another frame. + \\[ibuffer-do-revert] - Revert the marked buffers. + \\[ibuffer-do-toggle-read-only] - Toggle read-only state of marked buffers. + \\[ibuffer-do-toggle-lock] - Toggle lock state of marked buffers. + \\[ibuffer-do-delete] - Kill the marked buffers. + \\[ibuffer-do-isearch] - Do incremental search in the marked buffers. + \\[ibuffer-do-isearch-regexp] - Isearch for regexp in the marked buffers. + \\[ibuffer-do-replace-regexp] - Replace by regexp in each of the marked + buffers. + \\[ibuffer-do-query-replace] - Query replace in each of the marked buffers. + \\[ibuffer-do-query-replace-regexp] - As above, with a regular expression. + \\[ibuffer-do-print] - Print the marked buffers. + \\[ibuffer-do-occur] - List lines in all marked buffers which match + a given regexp (like the function `occur'). + \\[ibuffer-do-shell-command-pipe] - Pipe the contents of the marked + buffers to a shell command. + \\[ibuffer-do-shell-command-pipe-replace] - Replace the contents of the marked + buffers with the output of a shell command. + \\[ibuffer-do-shell-command-file] - Run a shell command with the + buffer's file as an argument. + \\[ibuffer-do-eval] - Evaluate a form in each of the marked buffers. This + is a very flexible command. For example, if you want to make all + of the marked buffers read-only, try using (read-only-mode 1) as + the input form. + \\[ibuffer-do-view-and-eval] - As above, but view each buffer while the form + is evaluated. + \\[ibuffer-do-kill-lines] - Remove the marked lines from the *Ibuffer* buffer, + but don't kill the associated buffer. + \\[ibuffer-do-kill-on-deletion-marks] - Kill all buffers marked for deletion. Marking commands: - `\\[ibuffer-mark-forward]' - Mark the buffer at point. - `\\[ibuffer-toggle-marks]' - Unmark all currently marked buffers, and mark - all unmarked buffers. - `\\[ibuffer-change-marks]' - Change the mark used on marked buffers. - `\\[ibuffer-unmark-forward]' - Unmark the buffer at point. - `\\[ibuffer-unmark-backward]' - Unmark the previous buffer. - `\\[ibuffer-unmark-all]' - Unmark buffers marked with MARK. - `\\[ibuffer-unmark-all-marks]' - Unmark all marked buffers. - `\\[ibuffer-mark-by-mode]' - Mark buffers by major mode. - `\\[ibuffer-mark-unsaved-buffers]' - Mark all \"unsaved\" buffers. - This means that the buffer is modified, and has an associated file. - `\\[ibuffer-mark-modified-buffers]' - Mark all modified buffers, - regardless of whether they have an associated file. - `\\[ibuffer-mark-special-buffers]' - Mark all buffers whose name begins and - ends with `*'. - `\\[ibuffer-mark-dissociated-buffers]' - Mark all buffers which have - an associated file, but that file doesn't currently exist. - `\\[ibuffer-mark-read-only-buffers]' - Mark all read-only buffers. - `\\[ibuffer-mark-dired-buffers]' - Mark buffers in `dired-mode'. - `\\[ibuffer-mark-help-buffers]' - Mark buffers in `help-mode', `apropos-mode', etc. - `\\[ibuffer-mark-old-buffers]' - Mark buffers older than `ibuffer-old-time'. - `\\[ibuffer-mark-for-delete]' - Mark the buffer at point for deletion. - `\\[ibuffer-mark-by-name-regexp]' - Mark buffers by their name, using a regexp. - `\\[ibuffer-mark-by-mode-regexp]' - Mark buffers by their major mode, using a regexp. - `\\[ibuffer-mark-by-file-name-regexp]' - Mark buffers by their filename, using a regexp. - `\\[ibuffer-mark-by-content-regexp]' - Mark buffers by their content, using a regexp. - `\\[ibuffer-mark-by-locked]' - Mark all locked buffers. + \\[ibuffer-mark-forward] - Mark the buffer at point. + \\[ibuffer-toggle-marks] - Unmark all currently marked buffers, and mark + all unmarked buffers. + \\[ibuffer-change-marks] - Change the mark used on marked buffers. + \\[ibuffer-unmark-forward] - Unmark the buffer at point. + \\[ibuffer-unmark-backward] - Unmark the previous buffer. + \\[ibuffer-unmark-all] - Unmark buffers marked with MARK. + \\[ibuffer-unmark-all-marks] - Unmark all marked buffers. + \\[ibuffer-mark-by-mode] - Mark buffers by major mode. + \\[ibuffer-mark-unsaved-buffers] - Mark all \"unsaved\" buffers. + This means that the buffer is modified, and has an associated file. + \\[ibuffer-mark-modified-buffers] - Mark all modified buffers, + regardless of whether they have an associated file. + \\[ibuffer-mark-special-buffers] - Mark all buffers whose name begins and + ends with `*'. + \\[ibuffer-mark-dissociated-buffers] - Mark all buffers which have + an associated file, but that file doesn't currently exist. + \\[ibuffer-mark-read-only-buffers] - Mark all read-only buffers. + \\[ibuffer-mark-dired-buffers] - Mark buffers in `dired-mode'. + \\[ibuffer-mark-help-buffers] - Mark buffers in `help-mode', `apropos-mode', etc. + \\[ibuffer-mark-old-buffers] - Mark buffers older than `ibuffer-old-time'. + \\[ibuffer-mark-for-delete] - Mark the buffer at point for deletion. + \\[ibuffer-mark-by-name-regexp] - Mark buffers by their name, using a regexp. + \\[ibuffer-mark-by-mode-regexp] - Mark buffers by their major mode, using a regexp. + \\[ibuffer-mark-by-file-name-regexp] - Mark buffers by their filename, using a regexp. + \\[ibuffer-mark-by-content-regexp] - Mark buffers by their content, using a regexp. + \\[ibuffer-mark-by-locked] - Mark all locked buffers. Filtering commands: - `\\[ibuffer-filter-chosen-by-completion]' - Select and apply filter chosen by completion. - `\\[ibuffer-filter-by-mode]' - Add a filter by any major mode. - `\\[ibuffer-filter-by-used-mode]' - Add a filter by a major mode now in use. - `\\[ibuffer-filter-by-derived-mode]' - Add a filter by derived mode. - `\\[ibuffer-filter-by-name]' - Add a filter by buffer name. - `\\[ibuffer-filter-by-content]' - Add a filter by buffer content. - `\\[ibuffer-filter-by-basename]' - Add a filter by basename. - `\\[ibuffer-filter-by-directory]' - Add a filter by directory name. - `\\[ibuffer-filter-by-filename]' - Add a filter by filename. - `\\[ibuffer-filter-by-file-extension]' - Add a filter by file extension. - `\\[ibuffer-filter-by-modified]' - Add a filter by modified buffers. - `\\[ibuffer-filter-by-predicate]' - Add a filter by an arbitrary Lisp predicate. - `\\[ibuffer-filter-by-size-gt]' - Add a filter by buffer size. - `\\[ibuffer-filter-by-size-lt]' - Add a filter by buffer size. - `\\[ibuffer-filter-by-starred-name]' - Add a filter by special buffers. - `\\[ibuffer-filter-by-visiting-file]' - Add a filter by buffers visiting files. - `\\[ibuffer-save-filters]' - Save the current filters with a name. - `\\[ibuffer-switch-to-saved-filters]' - Switch to previously saved filters. - `\\[ibuffer-add-saved-filters]' - Add saved filters to current filters. - `\\[ibuffer-and-filter]' - Replace the top two filters with their logical AND. - `\\[ibuffer-or-filter]' - Replace the top two filters with their logical OR. - `\\[ibuffer-pop-filter]' - Remove the top filter. - `\\[ibuffer-negate-filter]' - Invert the logical sense of the top filter. - `\\[ibuffer-decompose-filter]' - Break down the topmost filter. - `\\[ibuffer-filter-disable]' - Remove all filtering currently in effect. + \\[ibuffer-filter-chosen-by-completion] - Select and apply filter chosen by completion. + \\[ibuffer-filter-by-mode] - Add a filter by any major mode. + \\[ibuffer-filter-by-used-mode] - Add a filter by a major mode now in use. + \\[ibuffer-filter-by-derived-mode] - Add a filter by derived mode. + \\[ibuffer-filter-by-name] - Add a filter by buffer name. + \\[ibuffer-filter-by-content] - Add a filter by buffer content. + \\[ibuffer-filter-by-basename] - Add a filter by basename. + \\[ibuffer-filter-by-directory] - Add a filter by directory name. + \\[ibuffer-filter-by-filename] - Add a filter by filename. + \\[ibuffer-filter-by-file-extension] - Add a filter by file extension. + \\[ibuffer-filter-by-modified] - Add a filter by modified buffers. + \\[ibuffer-filter-by-predicate] - Add a filter by an arbitrary Lisp predicate. + \\[ibuffer-filter-by-size-gt] - Add a filter by buffer size. + \\[ibuffer-filter-by-size-lt] - Add a filter by buffer size. + \\[ibuffer-filter-by-starred-name] - Add a filter by special buffers. + \\[ibuffer-filter-by-visiting-file] - Add a filter by buffers visiting files. + \\[ibuffer-save-filters] - Save the current filters with a name. + \\[ibuffer-switch-to-saved-filters] - Switch to previously saved filters. + \\[ibuffer-add-saved-filters] - Add saved filters to current filters. + \\[ibuffer-and-filter] - Replace the top two filters with their logical AND. + \\[ibuffer-or-filter] - Replace the top two filters with their logical OR. + \\[ibuffer-pop-filter] - Remove the top filter. + \\[ibuffer-negate-filter] - Invert the logical sense of the top filter. + \\[ibuffer-decompose-filter] - Break down the topmost filter. + \\[ibuffer-filter-disable] - Remove all filtering currently in effect. Filter group commands: - `\\[ibuffer-filters-to-filter-group]' - Create filter group from filters. - `\\[ibuffer-pop-filter-group]' - Remove top filter group. - `\\[ibuffer-forward-filter-group]' - Move to the next filter group. - `\\[ibuffer-backward-filter-group]' - Move to the previous filter group. - `\\[ibuffer-clear-filter-groups]' - Remove all active filter groups. - `\\[ibuffer-save-filter-groups]' - Save the current groups with a name. - `\\[ibuffer-switch-to-saved-filter-groups]' - Restore previously saved groups. - `\\[ibuffer-delete-saved-filter-groups]' - Delete previously saved groups. + \\[ibuffer-filters-to-filter-group] - Create filter group from filters. + \\[ibuffer-pop-filter-group] - Remove top filter group. + \\[ibuffer-forward-filter-group] - Move to the next filter group. + \\[ibuffer-backward-filter-group] - Move to the previous filter group. + \\[ibuffer-clear-filter-groups] - Remove all active filter groups. + \\[ibuffer-save-filter-groups] - Save the current groups with a name. + \\[ibuffer-switch-to-saved-filter-groups] - Restore previously saved groups. + \\[ibuffer-delete-saved-filter-groups] - Delete previously saved groups. Sorting commands: - `\\[ibuffer-toggle-sorting-mode]' - Rotate between the various sorting modes. - `\\[ibuffer-invert-sorting]' - Reverse the current sorting order. - `\\[ibuffer-do-sort-by-alphabetic]' - Sort the buffers lexicographically. - `\\[ibuffer-do-sort-by-filename/process]' - Sort the buffers by the file name. - `\\[ibuffer-do-sort-by-recency]' - Sort the buffers by last viewing time. - `\\[ibuffer-do-sort-by-size]' - Sort the buffers by size. - `\\[ibuffer-do-sort-by-major-mode]' - Sort the buffers by major mode. + \\[ibuffer-toggle-sorting-mode] - Rotate between the various sorting modes. + \\[ibuffer-invert-sorting] - Reverse the current sorting order. + \\[ibuffer-do-sort-by-alphabetic] - Sort the buffers lexicographically. + \\[ibuffer-do-sort-by-filename/process] - Sort the buffers by the file name. + \\[ibuffer-do-sort-by-recency] - Sort the buffers by last viewing time. + \\[ibuffer-do-sort-by-size] - Sort the buffers by size. + \\[ibuffer-do-sort-by-major-mode] - Sort the buffers by major mode. Other commands: - `\\[ibuffer-update]' - Regenerate the list of all buffers. - Prefix arg means to toggle whether buffers that match - `ibuffer-maybe-show-predicates' should be displayed. - `\\[ibuffer-auto-mode]' - Toggle automatic updates. - - `\\[ibuffer-switch-format]' - Change the current display format. - `\\[forward-line]' - Move point to the next line. - `\\[previous-line]' - Move point to the previous line. - `\\[describe-mode]' - This help. - `\\[ibuffer-diff-with-file]' - View the differences between this buffer - and its associated file. - `\\[ibuffer-visit-buffer]' - View the buffer on this line. - `\\[ibuffer-visit-buffer-other-window]' - As above, but in another window. - `\\[ibuffer-visit-buffer-other-window-noselect]' - As both above, but don't select - the new window. - `\\[ibuffer-bury-buffer]' - Bury (not kill!) the buffer on this line. + \\[ibuffer-update] - Regenerate the list of all buffers. + Prefix arg means to toggle whether buffers that match + `ibuffer-maybe-show-predicates' should be displayed. + \\[ibuffer-auto-mode] - Toggle automatic updates. + + \\[ibuffer-switch-format] - Change the current display format. + \\[forward-line] - Move point to the next line. + \\[previous-line] - Move point to the previous line. + \\[describe-mode] - This help. + \\[ibuffer-diff-with-file] - View the differences between this buffer + and its associated file. + \\[ibuffer-visit-buffer] - View the buffer on this line. + \\[ibuffer-visit-buffer-other-window] - As above, but in another window. + \\[ibuffer-visit-buffer-other-window-noselect] - As both above, but don't select + the new window. + \\[ibuffer-bury-buffer] - Bury (not kill!) the buffer on this line. ** Information on Filtering: @@ -2525,7 +2525,7 @@ with \"gnus\". You can accomplish this via: \\[ibuffer-filter-by-name] ^gnus RET Additionally, you can OR the top two filters together with -`\\[ibuffer-or-filters]'. To see all buffers in either +\\[ibuffer-or-filters]. To see all buffers in either `emacs-lisp-mode' or `lisp-interaction-mode', type: \\[ibuffer-filter-by-mode] emacs-lisp-mode RET @@ -2535,9 +2535,9 @@ Additionally, you can OR the top two filters together with Filters can also be saved and restored using mnemonic names: see the functions `ibuffer-save-filters' and `ibuffer-switch-to-saved-filters'. -To remove the top filter on the stack, use `\\[ibuffer-pop-filter]', and +To remove the top filter on the stack, use \\[ibuffer-pop-filter], and to disable all filtering currently in effect, use -`\\[ibuffer-filter-disable]'. +\\[ibuffer-filter-disable]. ** Filter Groups: @@ -2545,7 +2545,7 @@ Once one has mastered filters, the next logical step up is \"filter groups\". A filter group is basically a named group of buffers which match a filter, which are displayed together in an Ibuffer buffer. To create a filter group, simply use the regular functions to create a -filter, and then type `\\[ibuffer-filters-to-filter-group]'. +filter, and then type \\[ibuffer-filters-to-filter-group]. A quick example will make things clearer. Suppose that one wants to group all of one's Emacs Lisp buffers together. To do this, type: @@ -2563,7 +2563,7 @@ multiple filter groups; instead, the first filter group is used. The filter groups are displayed in this order of precedence. You may rearrange filter groups by using the usual pair -`\\[ibuffer-kill-line]' and `\\[ibuffer-yank]'. Yanked groups +\\[ibuffer-kill-line] and \\[ibuffer-yank]. Yanked groups will be inserted before the group at point." ;; Include state info next to the mode name. (setq-local mode-line-process diff --git a/lisp/international/ogonek.el b/lisp/international/ogonek.el index 13feaee405a..4fddd2701d5 100644 --- a/lisp/international/ogonek.el +++ b/lisp/international/ogonek.el @@ -75,7 +75,7 @@ The codes are given in the following order: Je/sli czytasz ten tekst, to albo przegl/adasz plik /xr/od/lowy biblioteki `ogonek.el', albo wywo/la/le/s polecenie `ogonek-jak'. W drugim przypadku mo/zesz usun/a/c tekst z ekranu, stosuj/ac -polecenie `\\[kill-buffer]'. +polecenie \\[kill-buffer]. Niniejsza biblioteka dostarcza funkcji do zmiany kodowania polskich znak/ow diakrytycznych. Funkcje te mo/zna pogrupowa/c nast/epuj/aco. @@ -174,7 +174,7 @@ znak/ow diakrytycznych. Funkcje te mo/zna pogrupowa/c nast/epuj/aco. If you read this text then you are either looking at the library's source text or you have called the `ogonek-how' command. In the -latter case you may remove this text using `\\[kill-buffer]'. +latter case you may remove this text using \\[kill-buffer]. The library provides functions for changing the encoding of Polish diacritic characters, the ones with an `ogonek' below or above them. diff --git a/lisp/isearch.el b/lisp/isearch.el index 4cac79a3f4a..a139a6fb84e 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -282,13 +282,13 @@ Value is nil, t, or a function. If nil, default to literal searches (note that `case-fold-search' and `isearch-lax-whitespace' may still be applied).\\ -If t, default to regexp searches (as if typing `\\[isearch-toggle-regexp]' during +If t, default to regexp searches (as if typing \\[isearch-toggle-regexp] during isearch). If a function, use that function as an `isearch-regexp-function'. Example functions (and the keys to toggle them during isearch) -are `word-search-regexp' \(`\\[isearch-toggle-word]'), `isearch-symbol-regexp' -\(`\\[isearch-toggle-symbol]'), and `char-fold-to-regexp' \(`\\[isearch-toggle-char-fold]')." +are `word-search-regexp' \(\\[isearch-toggle-word]), `isearch-symbol-regexp' +\(\\[isearch-toggle-symbol]), and `char-fold-to-regexp' \(\\[isearch-toggle-char-fold])." ;; :type is set below by `isearch-define-mode-toggle'. :type '(choice (const :tag "Literal search" nil) (const :tag "Regexp search" t) diff --git a/lisp/macros.el b/lisp/macros.el index 0a04bad762a..7108a027ca6 100644 --- a/lisp/macros.el +++ b/lisp/macros.el @@ -197,7 +197,7 @@ For example, in Usenet articles, sections of text quoted from another author are indented, or have each line start with `>'. To quote a section of text, define a keyboard macro which inserts `>', put point and mark at opposite ends of the quoted section, and use -`\\[apply-macro-to-region-lines]' to mark the entire section. +\\[apply-macro-to-region-lines] to mark the entire section. Suppose you wanted to build a keyword table in C where each entry looked like this: @@ -219,7 +219,7 @@ and write a macro to massage a word into a table entry: \\C-x ) and then select the region of un-tablified names and use -`\\[apply-macro-to-region-lines]' to build the table from the names." +\\[apply-macro-to-region-lines] to build the table from the names." (interactive "r") (or macro (progn diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el index c3fa738150e..9104feb6219 100644 --- a/lisp/mail/supercite.el +++ b/lisp/mail/supercite.el @@ -817,7 +817,7 @@ If there was no mail header with FIELD as its key, return the value of (defun sc-mail-field-query (arg) "View the value of a mail field. -With `\\[universal-argument]', prompts for action on mail field. +With \\[universal-argument], prompts for action on mail field. Action can be one of: View, Modify, Add, or Delete." (interactive "P") (let* ((alist '(("view" . ?v) ("modify" . ?m) ("add" . ?a) ("delete" . ?d))) @@ -1710,7 +1710,7 @@ Numeric ARG indicates which header style from `sc-rewrite-header-list' to use when rewriting the header. No supplied ARG indicates use of `sc-preferred-header-style'. -With just `\\[universal-argument]', electric reference insert mode is +With just \\[universal-argument], electric reference insert mode is entered, regardless of the value of `sc-electric-references-p'. See `sc-electric-mode' for more information." (interactive "P") @@ -1930,7 +1930,7 @@ With numeric ARG, inserts that many new lines." (defun sc-insert-citation (arg) "Insert citation string at beginning of current line if not already cited. -With `\\[universal-argument]' insert citation even if line is already +With \\[universal-argument] insert citation even if line is already cited." (interactive "P") (save-excursion diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el index bfc28ec9f89..56f166c10f1 100644 --- a/lisp/play/decipher.el +++ b/lisp/play/decipher.el @@ -481,7 +481,7 @@ The most useful commands are: "Checkpoint the current cipher alphabet. This records the current alphabet so you can return to it later. You may have any number of checkpoints. -Type `\\[decipher-restore-checkpoint]' to restore a checkpoint." +Type \\[decipher-restore-checkpoint] to restore a checkpoint." (interactive "sCheckpoint description: " decipher-mode) (or (stringp desc) (setq desc "")) @@ -508,7 +508,7 @@ Type `\\[decipher-restore-checkpoint]' to restore a checkpoint." If point is not on a checkpoint line, moves to the first checkpoint line. If point is on a checkpoint, restores that checkpoint. -Type `\\[decipher-make-checkpoint]' to make a checkpoint." +Type \\[decipher-make-checkpoint] to make a checkpoint." (interactive nil decipher-mode) (beginning-of-line) (if (looking-at "%!\\([A-Z ]+\\)!") @@ -524,7 +524,7 @@ Type `\\[decipher-make-checkpoint]' to make a checkpoint." ;; Move to the first checkpoint: (goto-char (point-min)) (if (re-search-forward "^%![A-Z ]+!" nil t) - (message "Select the checkpoint to restore and type `%s'" + (message "Select the checkpoint to restore and type %s" (substitute-command-keys "\\[decipher-restore-checkpoint]")) (error "No checkpoints in this buffer")))) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index b5470b5490d..0f11103cf02 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -829,7 +829,7 @@ IDL has currently stepped.") 3. Routine Info ------------ - `\\[idlwave-routine-info]' displays information about an IDL routine near point, + \\[idlwave-routine-info] displays information about an IDL routine near point, just like in `idlwave-mode'. The module used is the one at point or the one whose argument list is being edited. To update IDLWAVE's knowledge about compiled or edited modules, use diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 4b96461d773..30442fa0d34 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -657,7 +657,7 @@ When you specify a class, this information can be stored as a text property on the `->' arrow in the source code, so that during the same editing session, IDLWAVE will not have to ask again. When this variable is non-nil, IDLWAVE will store and reuse the class information. -The class stored can be checked and removed with `\\[idlwave-routine-info]' +The class stored can be checked and removed with \\[idlwave-routine-info] on the arrow. The default of this variable is nil, since the result of commands then diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index a65943a48eb..97f08a79ccd 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -1148,7 +1148,7 @@ line and comments can also be enclosed in /* ... */. If an optional argument SYSTEM is non-nil, set up mode for the given system. To find out what version of Prolog mode you are running, enter -`\\[prolog-mode-version]'. +\\[prolog-mode-version]. Commands: \\{prolog-mode-map}" @@ -1268,7 +1268,7 @@ imitating normal Unix input editing. \\[comint-quit-subjob] sends quit signal, likewise. To find out what version of Prolog mode you are running, enter -`\\[prolog-mode-version]'." +\\[prolog-mode-version]." (require 'compile) (setq comint-input-filter 'prolog-input-filter) (setq mode-line-process '(": %s")) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 2a650fe0ea6..43fb8a723bd 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -2304,7 +2304,7 @@ Point should be before the newline." When used interactively, insert the proper starting #!-line, and make the visited file executable via `executable-set-magic', perhaps querying depending on the value of `executable-query'. -(If given a prefix (i.e., `\\[universal-argument]') don't insert any starting #! +(If given a prefix (i.e., \\[universal-argument]) don't insert any starting #! line.) When this function is called noninteractively, INSERT-FLAG (the third diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 060880d7cf2..afdf52629c4 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -457,7 +457,7 @@ If no file name at all is printed out, set both \"File Message\" entries to 0 \(a default file name message will be printed out instead, does not work in XEmacs). -A compiler is selected for syntax analysis (`\\[vhdl-compile]') by +A compiler is selected for syntax analysis (\\[vhdl-compile]) by assigning its name to option `vhdl-compiler'. Please send any missing or erroneous compiler properties to the maintainer for @@ -1106,14 +1106,14 @@ For more information on format strings, see the documentation for the (defcustom vhdl-modify-date-prefix-string "-- Last update: " "Prefix string of modification date in VHDL file header. If actualization of the modification date is called (menu, -`\\[vhdl-template-modify]'), this string is searched and the rest +\\[vhdl-template-modify]), this string is searched and the rest of the line replaced by the current date." :type 'string :group 'vhdl-header) (defcustom vhdl-modify-date-on-saving t "Non-nil means update the modification date when the buffer is saved. -Calls function `\\[vhdl-template-modify]'). +Calls function \\[vhdl-template-modify]). NOTE: Activate the new setting in a VHDL buffer by using the menu entry \"Activate Options\"." @@ -4469,7 +4469,7 @@ Usage: according to option `vhdl-argument-list-indent'. If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of - tabs. `\\[tabify]' and `\\[untabify]' allow the conversion of spaces to + tabs. \\[tabify] and \\[untabify] allow the conversion of spaces to tabs and vice versa. Syntax-based indentation can be very slow in large files. Option @@ -4780,7 +4780,7 @@ Usage: `vhdl-highlight-translate-off' is non-nil. For documentation and customization of the used colors see - customization group `vhdl-highlight-faces' (`\\[customize-group]'). For + customization group `vhdl-highlight-faces' (\\[customize-group]). For highlighting of matching parenthesis, see customization group `paren-showing'. Automatic buffer highlighting is turned on/off by option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs). @@ -4840,14 +4840,14 @@ Usage: sessions using the \"Save Options\" menu entry. Options and their detailed descriptions can also be accessed by using - the \"Customize\" menu entry or the command `\\[customize-option]' - (`\\[customize-group]' for groups). Some customizations only take effect + the \"Customize\" menu entry or the command \\[customize-option] + (\\[customize-group] for groups). Some customizations only take effect after some action (read the NOTE in the option documentation). Customization can also be done globally (i.e. site-wide, read the INSTALL file). Not all options are described in this documentation, so go and see - what other useful user options there are (`\\[vhdl-customize]' or menu)! + what other useful user options there are (\\[vhdl-customize] or menu)! FILE EXTENSIONS: @@ -4876,7 +4876,7 @@ Usage: Maintenance: ------------ -To submit a bug report, enter `\\[vhdl-submit-bug-report]' within VHDL Mode. +To submit a bug report, enter \\[vhdl-submit-bug-report] within VHDL Mode. Add a description of the problem and include a reproducible test case. Questions and enhancement requests can be sent to . diff --git a/lisp/server.el b/lisp/server.el index f75e9cb4fe5..66e6d729f8a 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -729,7 +729,9 @@ the `server-process' variable." (concat "Unable to start the Emacs server.\n" (cadr err) (substitute-command-keys - "\nTo start the server in this Emacs process, stop the existing server or call `\\[server-force-delete]' to forcibly disconnect it.")) + (concat "\nTo start the server in this Emacs process, stop " + "the existing server or call \\[server-force-delete] " + "to forcibly disconnect it."))) :warning) (setq leave-dead t))) ;; Now any previous server is properly stopped. diff --git a/lisp/subr.el b/lisp/subr.el index df28989b399..33de100870e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3102,7 +3102,7 @@ instead." LIBRARY should be a relative file name of the library, a string. It can omit the suffix (a.k.a. file-name extension) if NOSUFFIX is nil (which is the default, see below). -This command searches the directories in `load-path' like `\\[load-library]' +This command searches the directories in `load-path' like \\[load-library] to find the file that `\\[load-library] RET LIBRARY RET' would load. Optional second arg NOSUFFIX non-nil means don't add suffixes `load-suffixes' to the specified name LIBRARY. diff --git a/lisp/tempo.el b/lisp/tempo.el index 513e778e4ef..b7ad680c2a9 100644 --- a/lisp/tempo.el +++ b/lisp/tempo.el @@ -164,7 +164,7 @@ documentation for the function `tempo-complete-tag' for more info. "Indicates if the tag collection needs to be rebuilt.") (defvar-local tempo-marks nil - "A list of marks to jump to with `\\[tempo-forward-mark]' and `\\[tempo-backward-mark]'.") + "A list of marks to jump to with \\[tempo-forward-mark] and \\[tempo-backward-mark].") (defvar-local tempo-match-finder "\\b\\([[:word:]]+\\)\\=" "The regexp or function used to find the string to match against tags. @@ -582,7 +582,7 @@ TAG-LIST is a symbol whose variable value is a tag list created with `tempo-add-tag'. COMPLETION-FUNCTION is an obsolete option for specifying an optional -function or string that is used by `\\[tempo-complete-tag]' to find a +function or string that is used by \\[tempo-complete-tag] to find a string to match the tag against. It has the same definition as the variable `tempo-match-finder'. In this version, supplying a COMPLETION-FUNCTION just sets `tempo-match-finder' locally." diff --git a/lisp/time.el b/lisp/time.el index e561f36398c..9b932e945ba 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -589,7 +589,7 @@ See `world-clock'." (defun world-clock () "Display a world clock buffer with times in various time zones. The variable `world-clock-list' specifies which time zones to use. -To turn off the world time display, go to the window and type `\\[quit-window]'." +To turn off the world time display, go to the window and type \\[quit-window]." (interactive) (if-let ((buffer (get-buffer world-clock-buffer-name))) (pop-to-buffer buffer) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 1ef1388e21f..1493845e2d9 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -185,7 +185,7 @@ revision number and lock status." "Version Control minor mode. This minor mode is automatically activated whenever you visit a file under control of one of the revision control systems in `vc-handled-backends'. -VC commands are globally reachable under the prefix `\\[vc-prefix-map]': +VC commands are globally reachable under the prefix \\[vc-prefix-map]: \\{vc-prefix-map}") (defmacro vc-error-occurred (&rest body) diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 6f47e32beb5..15c1b83fcc1 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1774,10 +1774,10 @@ cleaning up these problems." (when has-bogus (goto-char (point-max)) (insert (substitute-command-keys - " Type `\\[whitespace-cleanup]'") + " Type \\[whitespace-cleanup]") " to cleanup the buffer.\n\n" (substitute-command-keys - " Type `\\[whitespace-cleanup-region]'") + " Type \\[whitespace-cleanup-region]") " to cleanup a region.\n\n")) (whitespace-display-window (current-buffer)))))) has-bogus))) diff --git a/lisp/windmove.el b/lisp/windmove.el index bc2beed5055..b4e77102abd 100644 --- a/lisp/windmove.el +++ b/lisp/windmove.el @@ -641,7 +641,7 @@ Default value of MODIFIERS is `shift-meta'." (defun windmove-delete-in-direction (dir &optional arg) "Delete the window at direction DIR. -If prefix ARG is `\\[universal-argument]', also kill the buffer in that window. +If prefix ARG is \\[universal-argument], also kill the buffer in that window. With \\`M-0' prefix, delete the selected window and select the window at direction DIR. When `windmove-wrap-around' is non-nil, takes the window -- cgit v1.2.3 From 51ca049608cd116e5ec5b8bb4fd815bed1cbf4ca Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 21 Jan 2024 14:41:27 +0100 Subject: Fix image-dired-tags-db-file void variable error * lisp/image/image-dired-tags.el (image-dired-sane-db-file): Require 'image-dired'. (Bug#68636) --- lisp/image/image-dired-tags.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/image/image-dired-tags.el b/lisp/image/image-dired-tags.el index 7b4ca35a15e..2b5248cb14b 100644 --- a/lisp/image/image-dired-tags.el +++ b/lisp/image/image-dired-tags.el @@ -51,6 +51,7 @@ Return the value of last form in BODY." "Check if `image-dired-tags-db-file' exists. If not, try to create it (including any parent directories). Signal error if there are problems creating it." + (require 'image-dired) ; for `image-dired-dir' (or (file-exists-p image-dired-tags-db-file) (let (dir buf) (unless (file-directory-p (setq dir (file-name-directory -- cgit v1.2.3 From 9364c28959a5b00e8ffd5d0d283ff0c0042f1bb0 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 21 Jan 2024 15:28:06 +0100 Subject: ; Fix typos in symbol names --- admin/cus-test.el | 2 +- lisp/emacs-lisp/comp-cstr.el | 2 +- lisp/erc/erc-button.el | 2 +- lisp/erc/erc-track.el | 2 +- lisp/filesets.el | 2 +- lisp/forms.el | 2 +- lisp/jsonrpc.el | 2 +- lisp/net/tramp-sh.el | 2 +- lisp/org/ox-latex.el | 2 +- lisp/progmodes/c-ts-common.el | 7 +++---- lisp/progmodes/cc-engine.el | 2 +- lisp/progmodes/cc-fonts.el | 2 +- lisp/progmodes/cc-langs.el | 2 +- lisp/progmodes/flymake.el | 2 +- lisp/term/android-win.el | 2 +- lisp/touch-screen.el | 2 +- 16 files changed, 18 insertions(+), 19 deletions(-) diff --git a/admin/cus-test.el b/admin/cus-test.el index b86643a769a..68907f4f5e5 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -146,7 +146,7 @@ Names should be as they appear in loaddefs.el.") (defvar cus-test-errors nil "List of problematic variables found by `cus-test-apropos'. -Each element is (VARIABLE . PROBLEM); see `cus-test--format-errors'.") +Each element is (VARIABLE . PROBLEM); see `cus-test--format-error'.") (defvar cus-test-tested-variables nil "List of options tested by last call of `cus-test-apropos'.") diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index c65af16b725..2984bedb1dd 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -130,7 +130,7 @@ Integer values are handled in the `range' slot.") ;; TODO we should be able to just cons hash this. (common-supertype-mem (make-hash-table :test #'equal) :type hash-table :documentation "Serve memoization for -`comp-common-supertype'.") +`comp-ctxt-common-supertype-mem'.") (subtype-p-mem (make-hash-table :test #'equal) :type hash-table :documentation "Serve memoization for `comp-cstr-ctxt-subtype-p-mem'.") diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 27406a76f59..6b78e451b54 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -443,7 +443,7 @@ of the channel. However, don't bother creating an actual Instead, just spoof an `erc-server-user' and stash it during \"PRIVMSG\" handling via `erc--cmem-from-nick-function' and retrieve it during buttonizing via -`erc-button--fallback-user-function'." +`erc-button--fallback-cmem-function'." :interactive nil (if erc-button--phantom-users-mode (progn diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 7e5ed165fb9..04ee76a9349 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -924,7 +924,7 @@ and expected types. This function should return a face or nil.") Expect RANKS to be a list of faces and both NORMALS and the car of NEW-FACES to be hash tables mapping faces to non-nil values. Assume the latter's makeup and that of RANKS to resemble -`erc-track-face-normal-list' and `erc-track-faces-priority-list'. +`erc-track-faces-normal-list' and `erc-track-faces-priority-list'. If NEW-FACES has a cdr, expect it to be its car's contents ordered from most recently seen (later in the buffer) to earliest. In general, act like `erc-track-select-mode-line-face' diff --git a/lisp/filesets.el b/lisp/filesets.el index 11576a46936..4e2de8fed1b 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -286,7 +286,7 @@ See `easy-menu-add-item' for documentation." ) (defcustom filesets-menu-in-menu nil - "Use that instead of `current-menubar' as the menu to change. + "Use that instead of `current-global-map' as the menu to change. See `easy-menu-add-item' for documentation." :set #'filesets-set-default :type 'sexp) diff --git a/lisp/forms.el b/lisp/forms.el index e38fa7ae873..009667af273 100644 --- a/lisp/forms.el +++ b/lisp/forms.el @@ -343,7 +343,7 @@ suitable for forms processing.") (defvar forms-write-file-filter nil "The name of a function that is called before writing the data file. -This can be used to undo the effects of `form-read-file-hook'.") +This can be used to undo the effects of `form-read-file-filter'.") (defvar forms-new-record-filter nil "The name of a function that is called when a new record is created.") diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 1f8e1b1a876..14fe0447008 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -438,7 +438,7 @@ ignored." `(canceled ,cancel-on-input-retval)) (t (while t (accept-process-output nil 30))))) ;; In normal operation, continuations for error/success is - ;; handled by `jsonrpc-continue'. Timeouts also remove + ;; handled by `jsonrpc--continue'. Timeouts also remove ;; the continuation... (pcase-let* ((`(,id ,_) id-and-timer)) ;; ...but we still have to guard against exist explicit diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 8ec9467ab45..de515e40345 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4112,7 +4112,7 @@ Only send the definition if it has not already been done." (unless (member name scripts) (with-tramp-progress-reporter vec 5 (format-message "Sending script `%s'" name) - ;; In bash, leading TABs like in `tramp-vc-registered-read-file-names' + ;; In bash, leading TABs like in `tramp-bundle-read-file-names' ;; could result in unwanted command expansion. Avoid this. (setq script (tramp-compat-string-replace (make-string 1 ?\t) (make-string 8 ? ) script)) diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index 834fb957329..b409f552a2b 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -3667,7 +3667,7 @@ CONTENTS is the contents of the object." ;; takes care of tables with a "verbatim" mode. Otherwise, it ;; delegates the job to either `org-latex--table.el-table', ;; `org-latex--org-table', `org-latex--math-table' or -;; `org-latex--org-align-string-tabbing' functions, +;; `org-table--org-tabbing' functions, ;; depending of the type of the table and the mode requested. ;; ;; `org-latex--align-string' is a subroutine used to build alignment diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index 07161025d5d..0095d83e302 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -37,9 +37,8 @@ ;; ;; For indenting statements: ;; -;; - Set `c-ts-common-indent-offset', -;; `c-ts-common-indent-block-type-regexp', and -;; `c-ts-common-indent-bracketless-type-regexp', then use simple-indent +;; - Set `c-ts-common-indent-offset', and +;; `c-ts-common-indent-type-regexp-alist', then use simple-indent ;; offset `c-ts-common-statement-offset' in ;; `treesit-simple-indent-rules'. @@ -331,7 +330,7 @@ If NODE is nil, return nil." Assumes the anchor is (point-min), i.e., the 0th column. This function basically counts the number of block nodes (i.e., -brackets) (defined by `c-ts-common-indent-block-type-regexp') +brackets) (see `c-ts-common-indent-type-regexp-alist') between NODE and the root node (not counting NODE itself), and multiply that by `c-ts-common-indent-offset'. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 4c591fbba36..ea4ee3d7b7c 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -11476,7 +11476,7 @@ This function might do hidden buffer changes." ;; an arglist it would be a meaningless expression because ;; the result isn't used. We therefore choose to recognize ;; it as a declaration when there's "symmetrical WS" around - ;; the "*" or the flag `c-assymetry-fontification-flag' is + ;; the "*" or the flag `c-asymmetry-fontification-flag' is ;; not set. We only allow a suffix (which makes the ;; construct look like a function call) when `at-decl-start' ;; provides additional evidence that we do have a diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 89f197b98e6..6419d6cf05a 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1112,7 +1112,7 @@ casts and declarations are fontified. Used on level 2 and higher." ;; 'c-decl-type-start (according to TYPES). Stop at LIMIT. ;; ;; If TYPES is t, fontify all identifiers as types; if it is a number, a - ;; buffer position, additionally set the `c-deftype' text property on the + ;; buffer position, additionally set the `c-typedef' text property on the ;; keyword at that position; if it is nil fontify as either variables or ;; functions, otherwise TYPES is a face to use. If NOT-TOP is non-nil, we ;; are not at the top-level ("top-level" includes being directly inside a diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index ad21bd1d5ef..ba0d1d0fc49 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -817,7 +817,7 @@ there be copies of the opener contained in the multi-line string." (c-lang-defconst c-cpp-or-ml-match-offset ;; The offset to be added onto match numbers for a multi-line string in - ;; matches for `c-cpp-or-ml-string-opener-re'. + ;; matches for `c-ml-string-cpp-or-opener-re'. t (if (c-lang-const c-anchored-cpp-prefix) (+ 2 (regexp-opt-depth (c-lang-const c-anchored-cpp-prefix))) 2)) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 3f8aec27833..225f8ecf874 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -715,7 +715,7 @@ associated `flymake-category' return DEFAULT." (delete-overlay ov))) (defun flymake--eol-overlay-summary (src-ovs) - "Helper function for `flymake--eol-overlay-update'." + "Helper function for `flymake--update-eol-overlays'." (cl-flet ((summarize (d) (propertize (flymake-diagnostic-oneliner d t) 'face (flymake--lookup-type-property (flymake--diag-type d) diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index 876b24683bc..e0d252f17e0 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -406,7 +406,7 @@ to grant such permissions. FANCY-P non-nil means the notice will be displayed with faces, in the style appropriate for its incorporation within the fancy splash -screen display; see `francy-splash-insert'." +screen display; see `fancy-splash-insert'." (unless (android-external-storage-available-p) (if fancy-p (fancy-splash-insert diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index c2f8f8068d7..a1ec4bca89f 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -1027,7 +1027,7 @@ POINT was initially placed upon, and pixel deltas describing how much point has moved relative to its previous position in the X and Y axes. -If the fourth element of `touchscreen-current-tool' is `scroll', +If the fourth element of `touch-screen-current-tool' is `scroll', then generate a `touchscreen-scroll' event with the window that POINT was initially placed upon, and pixel deltas describing how much point has moved relative to its previous position in the X -- cgit v1.2.3 From 3b7518e3d15ac7474493ea50fd24bb1c5c1685a4 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 22 Jan 2024 08:47:34 +0800 Subject: Update from Gnulib --- lib/readutmp.h | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/lib/readutmp.h b/lib/readutmp.h index b62eb3beaa1..dcfd44dbbc9 100644 --- a/lib/readutmp.h +++ b/lib/readutmp.h @@ -114,21 +114,21 @@ enum { UT_HOST_SIZE = -1 }; Field Type Platforms ---------- ------ --------- - ⎡ ut_user char[] glibc, musl, macOS, FreeBSD, AIX, HP-UX, IRIX, Solaris, Cygwin + ⎡ ut_user char[] glibc, musl, macOS, FreeBSD, AIX, HP-UX, IRIX, Solaris, Cygwin, Android ⎣ ut_name char[] NetBSD, Minix - ut_id char[] glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin - ut_line char[] glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin - ut_pid pid_t glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin - ut_type short glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin - ⎡ ut_tv struct glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin + ut_id char[] glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android + ut_line char[] glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android + ut_pid pid_t glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android + ut_type short glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android + ⎡ ut_tv struct glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android ⎢ { tv_sec; tv_usec; } ⎣ ut_time time_t Cygwin - ut_host char[] glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin - ut_exit struct glibc, musl, NetBSD, Minix, HP-UX, IRIX, Solaris + ut_host char[] glibc, musl, macOS, FreeBSD, NetBSD, Minix, AIX, HP-UX, IRIX, Solaris, Cygwin, Android + ut_exit struct glibc, musl, NetBSD, Minix, HP-UX, IRIX, Solaris, Android { e_termination; e_exit; } - ut_session [long] int glibc, musl, NetBSD, Minix, IRIX, Solaris + ut_session [long] int glibc, musl, NetBSD, Minix, IRIX, Solaris, Android ⎡ ut_addr [long] int HP-UX, Cygwin - ⎢ ut_addr_v6 [u]int[4] glibc, musl + ⎢ ut_addr_v6 [u]int[4] glibc, musl, Android ⎣ ut_ss struct sockaddr_storage NetBSD, Minix */ @@ -177,6 +177,10 @@ struct utmpx32 # define UTMP_NAME_FUNCTION utmpxname # elif defined UTXDB_ACTIVE /* FreeBSD */ # define UTMP_NAME_FUNCTION(x) setutxdb (UTXDB_ACTIVE, x) +# elif defined __ANDROID__ /* Android */ +/* As of Android NDK r26, the getutxent, setutxent functions are no-ops. + Therefore we can ignore the file name. */ +# define UTMP_NAME_FUNCTION(x) ((void) (x)) # endif #elif HAVE_UTMP_H -- cgit v1.2.3 From 7e490dd63979e2695605205f0bb4fa5131f8c2d9 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 22 Jan 2024 08:48:19 +0800 Subject: * configure.ac: Cease suppressing detection of utmp.h. --- configure.ac | 6 ------ 1 file changed, 6 deletions(-) diff --git a/configure.ac b/configure.ac index dffe7696ac5..55f742ba8ef 100644 --- a/configure.ac +++ b/configure.ac @@ -160,12 +160,6 @@ variable when you ran configure.]) ;; esac AC_MSG_RESULT([$host_alias]) - - # Suppress the detection of utmpx.h on Android versions older than - # 34, for the header will be present yet define no functions, - # which Gnulib is not prepared to handle. - AS_IF([test "$ANDROID_SDK" -lt "34"], - [ac_cv_header_utmpx_h=no]) fi AC_CANONICAL_HOST -- cgit v1.2.3 From df7c6211cb960b88bc0aaef85babf7e9384d5f2e Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 21 Jan 2024 17:18:23 -0800 Subject: Speed up builtin_lisp_symbol when not optimizing MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This should help when building with --enable-checking and compiling with gcc -O0. Problem reorted by Stefan Monnier in: https://lists.gnu.org/r/emacs-devel/2024-01/msg00770.html * src/lisp.h (lisp_h_builtin_lisp_symbol): New macro, with a body equivalent in effect to the old ‘builtin_lisp_symbol’ but faster when not optimizing. (builtin_lisp_symbol): Use it. If DEFINE_KEY_OPS_AS_MACROS, also define as macro. --- src/lisp.h | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index ae78947805e..29d2a08785a 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -409,6 +409,10 @@ typedef EMACS_INT Lisp_Word; & ((1 << INTTYPEBITS) - 1))) #define lisp_h_FLOATP(x) TAGGEDP (x, Lisp_Float) #define lisp_h_NILP(x) BASE_EQ (x, Qnil) +/* Equivalent to "make_lisp_symbol (&lispsym[INDEX])", + and typically faster when compiling without optimization. */ +#define lisp_h_builtin_lisp_symbol(index) \ + TAG_PTR (Lisp_Symbol, (index) * sizeof *lispsym) #define lisp_h_SET_SYMBOL_VAL(sym, v) \ (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \ (sym)->u.s.val.value = (v)) @@ -475,6 +479,7 @@ typedef EMACS_INT Lisp_Word; # define FLOATP(x) lisp_h_FLOATP (x) # define FIXNUMP(x) lisp_h_FIXNUMP (x) # define NILP(x) lisp_h_NILP (x) +# define builtin_lisp_symbol(index) lisp_h_builtin_lisp_symbol (index) # define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v) # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) # define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym) @@ -1171,9 +1176,9 @@ make_lisp_symbol (struct Lisp_Symbol *sym) } INLINE Lisp_Object -builtin_lisp_symbol (int index) +(builtin_lisp_symbol) (int index) { - return make_lisp_symbol (&lispsym[index]); + return lisp_h_builtin_lisp_symbol (index); } INLINE bool -- cgit v1.2.3 From 088afa7e2f08f4eb4e39aae5db4faa33857bf544 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 21 Jan 2024 20:34:03 -0800 Subject: Add an eassert back to XSYMBOL MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Problem reported by Alan Mackenzie in: https://lists.gnu.org/r/emacs-devel/2024-01/msg00755.html * src/lisp.h (XSYMBOL): If the arg is not a bare symbol, then eassert (symbols_with_pos_enabled). This shouldn’t affect code generated for regular builds, and could catch caller errors in debug builds. For debug builds although this slows things down XSYMBOL should still be faster than it was the day before yesterday, as there’s still no need to eassert (SYMBOLP (a)). --- src/lisp.h | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/lisp.h b/src/lisp.h index 29d2a08785a..efdb3886141 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1161,7 +1161,12 @@ XBARE_SYMBOL (Lisp_Object a) INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED XSYMBOL (Lisp_Object a) { - return XBARE_SYMBOL (BARE_SYMBOL_P (a) ? a : XSYMBOL_WITH_POS (a)->sym); + if (!BARE_SYMBOL_P (a)) + { + eassert (symbols_with_pos_enabled); + a = XSYMBOL_WITH_POS (a)->sym; + } + return XBARE_SYMBOL (a); } INLINE Lisp_Object -- cgit v1.2.3 From 05495bfa6c39816e210bf655c0cbd44ba6dfcc7c Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 22 Jan 2024 15:29:18 +0800 Subject: Correct values of INSTCTRL flags tested * src/sfnt.c (sfnt_mul_f26dot6_round): New function. (sfnt_mul_f26dot6_fixed): Replace by call to sfnt_mul_fixed_round. (MUL): Round result, as the Apple and MS scalers do. (sfnt_interpret_control_value_program): The instruction control flag which reverts CVT modifications is 2, not 4. --- src/sfnt.c | 82 +++++++++++++++++++++++++++----------------------------------- 1 file changed, 36 insertions(+), 46 deletions(-) diff --git a/src/sfnt.c b/src/sfnt.c index a70994fbe67..7b4c5544dc1 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -6490,19 +6490,21 @@ sfnt_mul_f26dot6 (sfnt_f26dot6 a, sfnt_f26dot6 b) #endif } -/* Multiply the specified 2.14 number with another signed 32 bit - number. Return the result as a signed 32 bit number. */ +/* Multiply the specified two 26.6 fixed point numbers A and B, with + rounding. Return the result, or an undefined value upon + overflow. */ -static int32_t -sfnt_mul_f2dot14 (sfnt_f2dot14 a, int32_t b) +static sfnt_f26dot6 +sfnt_mul_f26dot6_round (sfnt_f26dot6 a, sfnt_f26dot6 b) { #ifdef INT64_MAX int64_t product; product = (int64_t) a * (int64_t) b; - return product / (int64_t) 16384; -#else + /* This can be done quickly with int64_t. */ + return (product + 32) / (int64_t) 64; +#else /* !INT64_MAX */ int sign; sign = 1; @@ -6513,61 +6515,48 @@ sfnt_mul_f2dot14 (sfnt_f2dot14 a, int32_t b) if (b < 0) sign = -sign; - return sfnt_multiply_divide (abs (a), abs (b), - 16384) * sign; -#endif + return sfnt_multiply_divide_round (abs (a), abs (b), + 32, 64) * sign; +#endif /* INT64_MAX */ } -/* Multiply the specified 26.6 fixed point number X by the specified - 16.16 fixed point number Y with symmetric rounding. - - The 26.6 fixed point number must fit inside -32768 to 32767.ffff. - Value is otherwise undefined. */ +/* Multiply the specified 2.14 number with another signed 32 bit + number. Return the result as a signed 32 bit number. */ -static sfnt_f26dot6 -sfnt_mul_f26dot6_fixed (sfnt_f26dot6 x, sfnt_fixed y) +static int32_t +sfnt_mul_f2dot14 (sfnt_f2dot14 a, int32_t b) { #ifdef INT64_MAX - uint64_t product; - int sign; - - sign = 1; - - if (x < 0) - { - x = -x; - sign = -sign; - } - - if (y < 0) - { - y = -y; - sign = -sign; - } + int64_t product; - product = (uint64_t) y * (uint64_t) x; + product = (int64_t) a * (int64_t) b; - /* This can be done quickly with int64_t. */ - return ((int64_t) (product + 32768) - / (int64_t) 65536) * sign; + return product / (int64_t) 16384; #else - struct sfnt_large_integer temp; int sign; sign = 1; - if (x < 0) + if (a < 0) sign = -sign; - if (y < 0) + if (b < 0) sign = -sign; - sfnt_multiply_divide_1 (abs (x), abs (y), &temp); - sfnt_large_integer_add (&temp, 32768); - return sfnt_multiply_divide_2 (&temp, 65536) * sign; + return sfnt_multiply_divide (abs (a), abs (b), + 16384) * sign; #endif } +/* Multiply the specified 26.6 fixed point number X by the specified + 16.16 fixed point number Y with rounding. */ + +static sfnt_f26dot6 +sfnt_mul_f26dot6_fixed (sfnt_f26dot6 x, sfnt_fixed y) +{ + return sfnt_mul_fixed (x, y); +} + /* Return the floor of the specified 26.6 fixed point value X. */ static sfnt_f26dot6 @@ -7582,12 +7571,13 @@ sfnt_interpret_trap (struct sfnt_interpreter *interpreter, #define MUL() \ { \ - sfnt_f26dot6 n2, n1; \ + sfnt_f26dot6 n2, n1, r; \ \ n2 = POP (); \ n1 = POP (); \ \ - PUSH_UNCHECKED (sfnt_mul_f26dot6 (n2, n1)); \ + r = sfnt_mul_f26dot6_round (n2, n1); \ + PUSH_UNCHECKED (r); \ } #define ABS() \ @@ -12357,10 +12347,10 @@ sfnt_interpret_control_value_program (struct sfnt_interpreter *interpreter, sfnt_interpret_run (interpreter, SFNT_RUN_CONTEXT_CONTROL_VALUE_PROGRAM); - /* If instruct_control & 4, then changes to the graphics state made + /* If instruct_control & 2, then changes to the graphics state made in this program should be reverted. */ - if (interpreter->state.instruct_control & 4) + if (interpreter->state.instruct_control & 2) sfnt_init_graphics_state (&interpreter->state); else { -- cgit v1.2.3 From b2366900d4981c13152ef7fe15a44ad9b4b7663b Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 22 Jan 2024 16:01:13 +0800 Subject: Do not overwrite flags of succeeding points during generic move * src/sfnt.c (sfnt_move): Save FLAGS and restore it after X axis movement loop. --- src/sfnt.c | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/sfnt.c b/src/sfnt.c index 7b4c5544dc1..ce7765e8f3e 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -10776,6 +10776,7 @@ sfnt_move (sfnt_f26dot6 *restrict x, sfnt_f26dot6 *restrict y, sfnt_f26dot6 versor, k; sfnt_f2dot14 dot_product; size_t num; + unsigned char *flags_start; dot_product = interpreter->state.vector_dot_product; @@ -10788,6 +10789,10 @@ sfnt_move (sfnt_f26dot6 *restrict x, sfnt_f26dot6 *restrict y, other out, so the result is 26.6. */ versor = interpreter->state.freedom_vector.x; + /* Save flags that it may be restored for the second Y axis + loop. */ + flags_start = flags; + if (versor) { /* Move along X axis, converting the distance to the freedom @@ -10807,6 +10812,7 @@ sfnt_move (sfnt_f26dot6 *restrict x, sfnt_f26dot6 *restrict y, } } + flags = flags_start; versor = interpreter->state.freedom_vector.y; if (versor) -- cgit v1.2.3 From e780f98944fbb14a22a2b1e15d0e7cb435f55550 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 22 Jan 2024 09:20:46 +0100 Subject: * lisp/leim/quail/indian.el (tamil-input): Use `quail' as parent group. --- lisp/leim/quail/indian.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el index c1348081d58..9ea23ec087c 100644 --- a/lisp/leim/quail/indian.el +++ b/lisp/leim/quail/indian.el @@ -476,7 +476,7 @@ Full key sequences are listed below:" (defgroup tamil-input nil "Translation rules for the Tamil input method." :prefix "tamil-" - :group 'leim) + :group 'quail) (defcustom tamil-translation-rules ;; Vowels. -- cgit v1.2.3 From 269d3515608e4e91cdd03f90bac9c2a9d5e3d094 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 22 Jan 2024 08:49:17 +0100 Subject: Revert "* Update a comp test (bug#68523)" * test/src/comp-tests.el (comp-tests-ret-type-spec-71): Reverts commit c5031a52c5c6ad74fab27d3754700e7457717516 to compensate for 50201e03b9c. --- test/src/comp-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index f479d175c43..0aa9e76fa2d 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -1421,7 +1421,7 @@ Return a list of results." (if (= x 0.0) x (error ""))) - '(or (member 0.0 -0.0) (integer 0 0))) + '(or (member -0.0 0.0) (integer 0 0))) ;; 72 ((defun comp-tests-ret-type-spec-f (x) -- cgit v1.2.3 From 14d68221d26af5c3e99ae0fbc7ade44494aaf4f3 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 22 Jan 2024 10:08:45 +0100 Subject: Fix nasty cut'n'waste error in Tramp * lisp/net/tramp.el (tramp-parse-passwd): Use `tramp-parse-passwd-group'. Reported by Tim Landscheidt . --- lisp/net/tramp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 56b00bdeb42..bd556753261 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3518,7 +3518,7 @@ Host is always \"localhost\"." (when (zerop (tramp-call-process nil "getent" nil t nil "passwd")) (goto-char (point-min)) (cl-loop while (not (eobp)) collect - (tramp-parse-etc-group-group)))) + (tramp-parse-passwd-group)))) (tramp-parse-file filename #'tramp-parse-passwd-group)))) (defun tramp-parse-passwd-group () -- cgit v1.2.3 From 797c688f4ab33a196477fd85f83f7438d113dc7d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 22 Jan 2024 09:48:48 -0500 Subject: * src/pdumper.c (dump_object_needs_dumping_p): Simplify (hash_table_contents): Use DOHASH. --- src/pdumper.c | 19 ++++--------------- 1 file changed, 4 insertions(+), 15 deletions(-) diff --git a/src/pdumper.c b/src/pdumper.c index 8d030585c83..bff11ada02c 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -1331,13 +1331,7 @@ dump_queue_dequeue (struct dump_queue *dump_queue, dump_off basis) static bool dump_object_needs_dumping_p (Lisp_Object object) { - /* Some objects, like symbols, are self-representing because they - have invariant bit patterns, but sometimes these objects have - associated data too, and these data-carrying objects need to be - included in the dump despite all references to them being - bitwise-invariant. */ - return (!dump_object_self_representing_p (object) - || dump_object_emacs_ptr (object)); + return !(FIXNUMP (object)); } static void @@ -2651,7 +2645,6 @@ dump_vectorlike_generic (struct dump_context *ctx, static Lisp_Object * hash_table_contents (struct Lisp_Hash_Table *h) { - ptrdiff_t old_size = HASH_TABLE_SIZE (h); ptrdiff_t size = h->count; Lisp_Object *key_and_value = hash_table_alloc_bytes (2 * size * sizeof *key_and_value); @@ -2660,14 +2653,10 @@ hash_table_contents (struct Lisp_Hash_Table *h) /* Make sure key_and_value ends up in the same order; charset.c relies on it by expecting hash table indices to stay constant across the dump. */ - for (ptrdiff_t i = 0; i < old_size; i++) + DOHASH (h, i) { - Lisp_Object key = HASH_KEY (h, i); - if (!hash_unused_entry_key_p (key)) - { - key_and_value[n++] = key; - key_and_value[n++] = HASH_VALUE (h, i); - } + key_and_value[n++] = HASH_KEY (h, i); + key_and_value[n++] = HASH_VALUE (h, i); } return key_and_value; -- cgit v1.2.3 From f821ac29e0cf69316d6c721bafe9b749b47a6db3 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 22 Jan 2024 15:06:24 -0500 Subject: * src/regex-emacs.c (forall_firstchar_1): Improve corner case Fixes a "FORALL_FIRSTCHAR: Broken assumption2!!" warning with: "^\\(# *\\)\\([^ ]+?\\) *: *\\(.*?\\(?:\n\\1[ \t]+.*?\\)*\\)[[:space:]]*$" --- src/regex-emacs.c | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/regex-emacs.c b/src/regex-emacs.c index dfc6c1fd691..0ec0c6eb63f 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -2923,8 +2923,18 @@ forall_firstchar_1 (re_char *p, re_char *pend, forward over a subsequent `jump`. Recognize this pattern since that subsequent `jump` is the one that jumps to the loop-entry. */ - newp2 = ((re_opcode_t) *newp2 == jump) - ? extract_address (newp2 + 1) : newp2; + if ((re_opcode_t) *newp2 == jump) + { + re_char *p3 = extract_address (newp2 + 1); + /* Only recognize this pattern if one of the two destinations + is going forward, otherwise we'll fall into the pessimistic + "Both destinations go backward" below. + This is important if the `jump` at newp2 is the end of an + outer loop while the `on_failure_jump` is the end of an + inner loop. */ + if (p3 > p_orig || newp1 > p_orig) + newp2 = p3; + } do_twoway_jump: /* We have to check that both destinations are safe. -- cgit v1.2.3 From a3d10046d9945148c20aa1db4e6ba8ba1bc5eb3e Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 23 Jan 2024 09:41:41 +0800 Subject: * src/sfnt.c (sfnt_mul_f26dot6_fixed): Correct typo in last change. --- src/sfnt.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/sfnt.c b/src/sfnt.c index ce7765e8f3e..36a7fbf3ea0 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -6554,7 +6554,7 @@ sfnt_mul_f2dot14 (sfnt_f2dot14 a, int32_t b) static sfnt_f26dot6 sfnt_mul_f26dot6_fixed (sfnt_f26dot6 x, sfnt_fixed y) { - return sfnt_mul_fixed (x, y); + return sfnt_mul_fixed_round (x, y); } /* Return the floor of the specified 26.6 fixed point value X. */ -- cgit v1.2.3 From 54abf10dfeeb890fa46c43f13e6c7468a0d945e4 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 23 Jan 2024 10:30:51 +0800 Subject: Correct crash when executing IP within twilight zone * src/sfnt.c (sfnt_address_zp2, sfnt_address_zp1) (sfnt_address_zp0): Don't save into X or Y if the zone is set to the twilight zone and they are NULL. --- src/sfnt.c | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/sfnt.c b/src/sfnt.c index 36a7fbf3ea0..41dba8b486e 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -8563,8 +8563,12 @@ sfnt_address_zp2 (struct sfnt_interpreter *interpreter, if (number >= interpreter->twilight_zone_size) TRAP ("address to ZP2 (twilight zone) out of bounds"); + if (!x || !y) + goto next; + *x = interpreter->twilight_x[number]; *y = interpreter->twilight_y[number]; + next: if (!x_org || !y_org) return; @@ -8614,8 +8618,12 @@ sfnt_address_zp1 (struct sfnt_interpreter *interpreter, if (number >= interpreter->twilight_zone_size) TRAP ("address to ZP1 (twilight zone) out of bounds"); + if (!x || !y) + goto next; + *x = interpreter->twilight_x[number]; *y = interpreter->twilight_y[number]; + next: if (!x_org || !y_org) return; @@ -8665,8 +8673,12 @@ sfnt_address_zp0 (struct sfnt_interpreter *interpreter, if (number >= interpreter->twilight_zone_size) TRAP ("address to ZP0 (twilight zone) out of bounds"); + if (!x || !y) + goto next; + *x = interpreter->twilight_x[number]; *y = interpreter->twilight_y[number]; + next: if (!x_org || !y_org) return; -- cgit v1.2.3 From 21e272fe4f336827611c4005a56829a0ab02f3f8 Mon Sep 17 00:00:00 2001 From: Gerd Möllmann Date: Tue, 23 Jan 2024 06:47:40 +0100 Subject: ; Fix DOHASH --- src/lisp.h | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/lisp.h b/src/lisp.h index efdb3886141..54d2f4d3dd1 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2600,7 +2600,9 @@ hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) mutate TABLE in any other way. */ #define DOHASH(TABLE, IDXVAR) \ for (ptrdiff_t IDXVAR = 0; IDXVAR < (TABLE)->table_size; IDXVAR++) \ - if (!hash_unused_entry_key_p (HASH_KEY (TABLE, IDXVAR))) + if (hash_unused_entry_key_p (HASH_KEY (TABLE, IDXVAR))) \ + ; \ + else void hash_table_thaw (Lisp_Object hash_table); -- cgit v1.2.3 From 87cf30fba37346a179c6307a29d5d39b39311cef Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Fri, 19 Jan 2024 13:50:29 +0100 Subject: Further shrink eglot--{} Up to and including Emacs 29, :size 0 was an alias for :size 1. Emacs 30 gained support for :size 0 hash tables (bug#68244). * lisp/progmodes/eglot.el (eglot--{}): Define as truly zero-sized. --- lisp/progmodes/eglot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index c5cfdd3cedd..511000927cf 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -575,7 +575,7 @@ It is nil if Eglot is not byte-complied.") (defvaralias 'eglot-{} 'eglot--{}) -(defconst eglot--{} (make-hash-table :size 1) "The empty JSON object.") +(defconst eglot--{} (make-hash-table :size 0) "The empty JSON object.") (defun eglot--executable-find (command &optional remote) "Like Emacs 27's `executable-find', ignore REMOTE on Emacs 26." -- cgit v1.2.3 From aa6c24da61fd1419ac0a7c491c5aec20e52cc964 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 20 Dec 2023 13:40:47 +0100 Subject: Fix broken links to Freedesktop notifications spec * doc/lispref/os.texi (Desktop Notifications): * lisp/notifications.el: Replace broken developer.gnome.org links with specifications.freedesktop.org (bug#67939). --- doc/lispref/os.texi | 2 +- lisp/notifications.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index e9d81038d4b..c8c64ddde89 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -2913,7 +2913,7 @@ interpreted as icon name. @item :category @var{category} The type of notification this is, a string. See the -@uref{https://developer.gnome.org/notification-spec/#categories, +@url{https://specifications.freedesktop.org/notification-spec/notification-spec-latest.html#categories, Desktop Notifications Specification} for a list of standard categories. diff --git a/lisp/notifications.el b/lisp/notifications.el index f284fb46b20..3509968a6cd 100644 --- a/lisp/notifications.el +++ b/lisp/notifications.el @@ -23,7 +23,7 @@ ;;; Commentary: ;; This package provides an implementation of the Desktop Notifications -;; . +;; . ;; In order to activate this package, you must add the following code ;; into your .emacs: -- cgit v1.2.3 From fb4cf0ab46df5a0bb70ebe51ac31becfe21deb8d Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 20 Dec 2023 13:42:53 +0100 Subject: ; Fix xref under Output Overrides in Elisp manual. --- doc/lispref/streams.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lispref/streams.texi b/doc/lispref/streams.texi index 5d6a382cbb0..9fd2d074efe 100644 --- a/doc/lispref/streams.texi +++ b/doc/lispref/streams.texi @@ -986,7 +986,7 @@ having their own escape syntax such as newline. @cindex overrides, in output functions @cindex output variables, overriding -The previous section (@pxref{Output Functions}) lists the numerous +The previous section (@pxref{Output Variables}) lists the numerous variables that control how the Emacs Lisp printer formats data for outputs. These are generally available for users to change, but sometimes you want to output data in the default format, or override -- cgit v1.2.3 From 13c7249105ec0d1a070c6d4e9f73f3c21d905bc8 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 23 Jan 2024 19:24:29 +0100 Subject: Fix cus-test-deps * admin/cus-test.el (cus-test-deps): Add the "quail/" subdirectory to default-directory, temporarily. --- admin/cus-test.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/admin/cus-test.el b/admin/cus-test.el index 68907f4f5e5..10d6e34358d 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -424,7 +424,12 @@ in the Emacs source directory." (mapatoms ;; This code is mainly from `custom-load-symbol'. (lambda (symbol) - (let ((custom-load-recursion t)) + (let ((custom-load-recursion t) + (load-path + (cons + (expand-file-name + "quail" (file-name-directory (locate-library leim-list-file-name))) + load-path))) (dolist (load (get symbol 'custom-loads)) (cond ((symbolp load) -- cgit v1.2.3 From 33b8d5b6c5a22bab069cdac4bddda932b3d18b13 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 23 Jan 2024 22:30:13 -0500 Subject: (struct charset): Remove dependency on hash-table internals `struct charset` kept an index into the internal `key_and_value` array of hash tables, which only worked because of details of how hash-tables are handled. Replace it with a reference to the value stored at that location in the hash-table, which saves us an indirection while at it. * src/charset.h (struct charset): Replace `hash_index` field with `attributes` field. (CHARSET_ATTRIBUTES): Simplify accordingly. (CHARSET_HASH_INDEX): Delete unused macro. * src/charset.c (Fdefine_charset_internal): * src/pdumper.c (dump_charset): Adjust accordingly. (dump_charset_table): Set the referrer since that's needed while dumping Lisp_Object fields. --- src/charset.c | 25 ++++++++++++++++++------- src/charset.h | 7 ++----- src/pdumper.c | 13 +++++++++---- 3 files changed, 29 insertions(+), 16 deletions(-) diff --git a/src/charset.c b/src/charset.c index f562af90cb2..9633ccaaef9 100644 --- a/src/charset.c +++ b/src/charset.c @@ -1108,18 +1108,18 @@ usage: (define-charset-internal ...) */) ASET (attrs, charset_plist, args[charset_arg_plist]); hash_hash_t hash_code; - charset.hash_index = hash_lookup_get_hash (hash_table, args[charset_arg_name], - &hash_code); - if (charset.hash_index >= 0) + ptrdiff_t hash_index + = hash_lookup_get_hash (hash_table, args[charset_arg_name], + &hash_code); + if (hash_index >= 0) { - new_definition_p = 0; + new_definition_p = false; id = XFIXNAT (CHARSET_SYMBOL_ID (args[charset_arg_name])); - set_hash_value_slot (hash_table, charset.hash_index, attrs); + set_hash_value_slot (hash_table, hash_index, attrs); } else { - charset.hash_index = hash_put (hash_table, args[charset_arg_name], attrs, - hash_code); + hash_put (hash_table, args[charset_arg_name], attrs, hash_code); if (charset_table_used == charset_table_size) { /* Ensure that charset IDs fit into 'int' as well as into the @@ -1150,6 +1150,7 @@ usage: (define-charset-internal ...) */) ASET (attrs, charset_id, make_fixnum (id)); charset.id = id; + charset.attributes = attrs; charset_table[id] = charset; if (charset.method == CHARSET_METHOD_MAP) @@ -2269,6 +2270,16 @@ See also `charset-priority-list' and `set-charset-priority'. */) return charsets; } +/* Not strictly necessary, because all charset attributes are also + reachable from `Vcharset_hash_table`. +void +mark_charset (void) +{ + for (int i = 0; i < charset_table_used; i++) + mark_object (charset_table[i].attributes); +} +*/ + void init_charset (void) diff --git a/src/charset.h b/src/charset.h index ba83cd5ccb2..1edb4a248ac 100644 --- a/src/charset.h +++ b/src/charset.h @@ -150,8 +150,7 @@ struct charset /* Index to charset_table. */ int id; - /* Index to Vcharset_hash_table. */ - ptrdiff_t hash_index; + Lisp_Object attributes; /* Dimension of the charset: 1, 2, 3, or 4. */ int dimension; @@ -289,11 +288,9 @@ extern int emacs_mule_charset[256]; hash_lookup (XHASH_TABLE (Vcharset_hash_table), symbol) /* Return the attribute vector of CHARSET. */ -#define CHARSET_ATTRIBUTES(charset) \ - HASH_VALUE (XHASH_TABLE (Vcharset_hash_table), (charset)->hash_index) +#define CHARSET_ATTRIBUTES(charset) (charset)->attributes #define CHARSET_ID(charset) ((charset)->id) -#define CHARSET_HASH_INDEX(charset) ((charset)->hash_index) #define CHARSET_DIMENSION(charset) ((charset)->dimension) #define CHARSET_CODE_SPACE(charset) ((charset)->code_space) #define CHARSET_CODE_LINEAR_P(charset) ((charset)->code_linear_p) diff --git a/src/pdumper.c b/src/pdumper.c index bff11ada02c..9c9a1ff382c 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2650,9 +2650,11 @@ hash_table_contents (struct Lisp_Hash_Table *h) * sizeof *key_and_value); ptrdiff_t n = 0; - /* Make sure key_and_value ends up in the same order; charset.c - relies on it by expecting hash table indices to stay constant - across the dump. */ + /* Make sure key_and_value ends up in the same order; the `hash_index` + field of `struct composition` relies on it by expecting hash table + indices to stay constant across the dump. + FIXME: Remove such dependency on hash table internals (there might + be another one in `composition_gstring_from_id`). */ DOHASH (h, i) { key_and_value[n++] = HASH_KEY (h, i); @@ -3224,7 +3226,7 @@ dump_charset (struct dump_context *ctx, int cs_i) struct charset out; dump_object_start (ctx, &out, sizeof (out)); DUMP_FIELD_COPY (&out, cs, id); - DUMP_FIELD_COPY (&out, cs, hash_index); + dump_field_lv (ctx, &out, cs, &cs->attributes, WEIGHT_NORMAL); DUMP_FIELD_COPY (&out, cs, dimension); memcpy (out.code_space, &cs->code_space, sizeof (cs->code_space)); if (cs_i < charset_table_used && cs->code_space_mask) @@ -3262,12 +3264,15 @@ dump_charset_table (struct dump_context *ctx) ctx->flags.pack_objects = true; dump_align_output (ctx, DUMP_ALIGNMENT); dump_off offset = ctx->offset; + if (dump_set_referrer (ctx)) + ctx->current_referrer = build_string ("charset_table"); /* We are dumping the entire table, not just the used slots, because otherwise when we restore from the pdump file, the actual size of the table will be smaller than charset_table_size, and we will crash if/when a new charset is defined. */ for (int i = 0; i < charset_table_size; ++i) dump_charset (ctx, i); + dump_clear_referrer (ctx); dump_emacs_reloc_to_dump_ptr_raw (ctx, &charset_table, offset); ctx->flags = old_flags; return offset; -- cgit v1.2.3 From 802821b81ac5ad0dee7f26caa519326251b262c1 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 23 Jan 2024 23:35:22 -0800 Subject: Remove too-tricky make_lisp_symbol optimization MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Simplify optimization for make_lisp_symbol, so that it’s less tricky and works well enough for gcc -Og or -O2. * src/lisp.h (lisp_h_builtin_lisp_symbol): Remove. (builtin_lisp_symbol) [DEFINE_KEY_OPS_AS_MACROS]: Remove. (make_lisp_symbol_nodebug): New internal static function, which is like the old make_lisp_symbol but without the eassert. (make_lisp_symbol, builtin_lisp_symbol): Use it, so that make_lisp_symbol has the eassert but builtin_lisp_symbol doesn’t. Co-authored-by: Paul Eggert --- src/lisp.h | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index 54d2f4d3dd1..09fcd6689bf 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -409,10 +409,6 @@ typedef EMACS_INT Lisp_Word; & ((1 << INTTYPEBITS) - 1))) #define lisp_h_FLOATP(x) TAGGEDP (x, Lisp_Float) #define lisp_h_NILP(x) BASE_EQ (x, Qnil) -/* Equivalent to "make_lisp_symbol (&lispsym[INDEX])", - and typically faster when compiling without optimization. */ -#define lisp_h_builtin_lisp_symbol(index) \ - TAG_PTR (Lisp_Symbol, (index) * sizeof *lispsym) #define lisp_h_SET_SYMBOL_VAL(sym, v) \ (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \ (sym)->u.s.val.value = (v)) @@ -479,7 +475,6 @@ typedef EMACS_INT Lisp_Word; # define FLOATP(x) lisp_h_FLOATP (x) # define FIXNUMP(x) lisp_h_FIXNUMP (x) # define NILP(x) lisp_h_NILP (x) -# define builtin_lisp_symbol(index) lisp_h_builtin_lisp_symbol (index) # define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v) # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) # define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym) @@ -1169,21 +1164,30 @@ XSYMBOL (Lisp_Object a) return XBARE_SYMBOL (a); } +/* Internal use only. */ INLINE Lisp_Object -make_lisp_symbol (struct Lisp_Symbol *sym) +make_lisp_symbol_internal (struct Lisp_Symbol *sym) { /* GCC 7 x86-64 generates faster code if lispsym is - cast to char * rather than to intptr_t. */ + cast to char * rather than to intptr_t. + Do not use eassert here, so that builtin symbols like Qnil compile to + constants; this is needed for some circa-2024 GCCs even with -O2. */ char *symoffset = (char *) ((char *) sym - (char *) lispsym); - Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset); + return TAG_PTR (Lisp_Symbol, symoffset); +} + +INLINE Lisp_Object +make_lisp_symbol (struct Lisp_Symbol *sym) +{ + Lisp_Object a = make_lisp_symbol_internal (sym); eassert (XBARE_SYMBOL (a) == sym); return a; } INLINE Lisp_Object -(builtin_lisp_symbol) (int index) +builtin_lisp_symbol (int index) { - return lisp_h_builtin_lisp_symbol (index); + return make_lisp_symbol_internal (&lispsym[index]); } INLINE bool -- cgit v1.2.3 From 3018c6e7ba5d35b756aea5eed7f3981548a597b4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 24 Jan 2024 08:07:54 -0500 Subject: (DOHASH): Change calling convention This leads to simpler code in the users, and more efficient machine code because we don't repeatedly need to fetch the `table_size` and `key_and_value` fields of the hash table object. * src/lisp.h (DOHASH): Rewrite. * src/composite.c (composition_gstring_lookup_cache): Simplify. (composition_gstring_cache_clear_font): * src/print.c (print): * src/pdumper.c (hash_table_contents): * src/minibuf.c (Ftest_completion): * src/json.c (lisp_to_json_nonscalar_1): * src/emacs-module.c (module_global_reference_p): * src/comp.c (compile_function, Fcomp__compile_ctxt_to_file): * src/fns.c (Fmaphash): Adjust to new calling convention. --- src/comp.c | 19 ++++++++----------- src/composite.c | 16 ++++------------ src/emacs-module.c | 4 ++-- src/fns.c | 5 +++-- src/json.c | 5 ++--- src/lisp.h | 20 ++++++++++++++------ src/minibuf.c | 22 ++++++++++++---------- src/pdumper.c | 6 +++--- src/print.c | 6 +++--- 9 files changed, 51 insertions(+), 52 deletions(-) diff --git a/src/comp.c b/src/comp.c index 25c4cb2f22c..5f28cf046b5 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4330,12 +4330,9 @@ compile_function (Lisp_Object func) declare_block (Qentry); Lisp_Object blocks = CALL1I (comp-func-blocks, func); struct Lisp_Hash_Table *ht = XHASH_TABLE (blocks); - DOHASH (ht, i) - { - Lisp_Object block_name = HASH_KEY (ht, i); - if (!EQ (block_name, Qentry)) - declare_block (block_name); - } + DOHASH (ht, block_name, block) + if (!EQ (block_name, Qentry)) + declare_block (block_name); gcc_jit_block_add_assignment (retrive_block (Qentry), NULL, @@ -4343,10 +4340,8 @@ compile_function (Lisp_Object func) gcc_jit_lvalue_as_rvalue (comp.func_relocs)); - DOHASH (ht, i) + DOHASH (ht, block_name, block) { - Lisp_Object block_name = HASH_KEY (ht, i); - Lisp_Object block = HASH_VALUE (ht, i); Lisp_Object insns = CALL1I (comp-block-insns, block); if (NILP (block) || NILP (insns)) xsignal1 (Qnative_ice, @@ -4961,10 +4956,12 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, struct Lisp_Hash_Table *func_h = XHASH_TABLE (CALL1I (comp-ctxt-funcs-h, Vcomp_ctxt)); - DOHASH (func_h, i) declare_function (HASH_VALUE (func_h, i)); + DOHASH (func_h, k, v) + declare_function (v); /* Compile all functions. Can't be done before because the relocation structs has to be already defined. */ - DOHASH (func_h, i) compile_function (HASH_VALUE (func_h, i)); + DOHASH (func_h, k, v) + compile_function (v); /* Work around bug#46495 (GCC PR99126). */ #if defined (WIDE_EMACS_INT) \ diff --git a/src/composite.c b/src/composite.c index d9233fe0cc0..0b78a78fa79 100644 --- a/src/composite.c +++ b/src/composite.c @@ -643,10 +643,7 @@ static Lisp_Object gstring_hash_table; Lisp_Object composition_gstring_lookup_cache (Lisp_Object header) { - struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table); - ptrdiff_t i = hash_lookup (h, header); - - return (i >= 0 ? HASH_VALUE (h, i) : Qnil); + return Fgethash (header, gstring_hash_table, Qnil); } Lisp_Object @@ -687,14 +684,9 @@ composition_gstring_cache_clear_font (Lisp_Object font_object) { struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table); - DOHASH (h, i) - { - Lisp_Object k = HASH_KEY (h, i); - Lisp_Object gstring = HASH_VALUE (h, i); - - if (EQ (LGSTRING_FONT (gstring), font_object)) - hash_remove_from_table (h, k); - } + DOHASH (h, k, gstring) + if (EQ (LGSTRING_FONT (gstring), font_object)) + hash_remove_from_table (h, k); } DEFUN ("clear-composition-cache", Fclear_composition_cache, diff --git a/src/emacs-module.c b/src/emacs-module.c index 77dd2b9152c..08db39b0b0d 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -410,8 +410,8 @@ module_global_reference_p (emacs_value v, ptrdiff_t *n) struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); /* Note that we can't use `hash_lookup' because V might be a local reference that's identical to some global reference. */ - DOHASH (h, i) - if (&XMODULE_GLOBAL_REFERENCE (HASH_VALUE (h, i))->value == v) + DOHASH (h, k, val) + if (&XMODULE_GLOBAL_REFERENCE (val)->value == v) return true; /* Only used for debugging, so we don't care about overflow, just make sure the operation is defined. */ diff --git a/src/fns.c b/src/fns.c index f34e069ddbe..859df6748f7 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5617,7 +5617,7 @@ If KEY is not found, return DFLT which defaults to nil. */) (Lisp_Object key, Lisp_Object table, Lisp_Object dflt) { struct Lisp_Hash_Table *h = check_hash_table (table); - ptrdiff_t i = hash_lookup_with_hash (h, key, hash_from_key (h, key)); + ptrdiff_t i = hash_lookup (h, key); return i >= 0 ? HASH_VALUE (h, i) : dflt; } @@ -5662,7 +5662,8 @@ set a new value for KEY, or `remhash' to remove KEY. (Lisp_Object function, Lisp_Object table) { struct Lisp_Hash_Table *h = check_hash_table (table); - DOHASH (h, i) call2 (function, HASH_KEY (h, i), HASH_VALUE (h, i)); + DOHASH (h, k, v) + call2 (function, k, v); return Qnil; } diff --git a/src/json.c b/src/json.c index 5434780ba13..e849ccaf722 100644 --- a/src/json.c +++ b/src/json.c @@ -361,9 +361,8 @@ lisp_to_json_nonscalar_1 (Lisp_Object lisp, json = json_check (json_object ()); count = SPECPDL_INDEX (); record_unwind_protect_ptr (json_release_object, json); - DOHASH (h, i) + DOHASH (h, key, v) { - Lisp_Object key = HASH_KEY (h, i); CHECK_STRING (key); Lisp_Object ekey = json_encode (key); /* We can't specify the length, so the string must be @@ -376,7 +375,7 @@ lisp_to_json_nonscalar_1 (Lisp_Object lisp, wrong_type_argument (Qjson_value_p, lisp); int status = json_object_set_new (json, key_str, - lisp_to_json (HASH_VALUE (h, i), conf)); + lisp_to_json (v, conf)); if (status == -1) { /* A failure can be caused either by an invalid key or diff --git a/src/lisp.h b/src/lisp.h index 09fcd6689bf..82ce367392e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2598,16 +2598,24 @@ hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) return h->test->hashfn (key, h); } -/* Hash table iteration construct (roughly an inlined maphash): - Iterate IDXVAR as index over valid entries of TABLE. +/* Iterate K and V as key and value of valid entries in hash table H. The body may remove the current entry or alter its value slot, but not mutate TABLE in any other way. */ -#define DOHASH(TABLE, IDXVAR) \ - for (ptrdiff_t IDXVAR = 0; IDXVAR < (TABLE)->table_size; IDXVAR++) \ - if (hash_unused_entry_key_p (HASH_KEY (TABLE, IDXVAR))) \ - ; \ +#define DOHASH(h, k, v) \ + for (Lisp_Object *dohash_##k##_##v##_kv = (h)->key_and_value, \ + *dohash_##k##_##v##_end = dohash_##k##_##v##_kv \ + + 2 * HASH_TABLE_SIZE (h), \ + k, v; \ + dohash_##k##_##v##_kv < dohash_##k##_##v##_end \ + && (k = dohash_##k##_##v##_kv[0], \ + v = dohash_##k##_##v##_kv[1], /*maybe unsed*/ (void)v, \ + true); \ + dohash_##k##_##v##_kv += 2) \ + if (hash_unused_entry_key_p (k)) \ + ; \ else + void hash_table_thaw (Lisp_Object hash_table); /* Default size for hash tables if not specified. */ diff --git a/src/minibuf.c b/src/minibuf.c index 857b62d94f0..7c0c9799a60 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -2059,8 +2059,7 @@ If COLLECTION is a function, it is called with three arguments: the values STRING, PREDICATE and `lambda'. */) (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate) { - Lisp_Object tail, tem = Qnil; - ptrdiff_t i = 0; + Lisp_Object tail, tem = Qnil, arg = Qnil; CHECK_STRING (string); @@ -2079,7 +2078,7 @@ the values STRING, PREDICATE and `lambda'. */) SBYTES (string)); if (completion_ignore_case && !SYMBOLP (tem)) { - for (i = ASIZE (collection) - 1; i >= 0; i--) + for (ptrdiff_t i = ASIZE (collection) - 1; i >= 0; i--) { tail = AREF (collection, i); if (SYMBOLP (tail)) @@ -2107,24 +2106,27 @@ the values STRING, PREDICATE and `lambda'. */) else if (HASH_TABLE_P (collection)) { struct Lisp_Hash_Table *h = XHASH_TABLE (collection); - i = hash_lookup (h, string); + ptrdiff_t i = hash_lookup (h, string); if (i >= 0) { tem = HASH_KEY (h, i); + arg = HASH_VALUE (h, i); goto found_matching_key; } else - DOHASH (h, j) + DOHASH (h, k, v) { - i = j; - tem = HASH_KEY (h, i); + tem = k; Lisp_Object strkey = (SYMBOLP (tem) ? Fsymbol_name (tem) : tem); if (!STRINGP (strkey)) continue; if (BASE_EQ (Fcompare_strings (string, Qnil, Qnil, strkey, Qnil, Qnil, completion_ignore_case ? Qt : Qnil), - Qt)) - goto found_matching_key; + Qt)) + { + arg = v; + goto found_matching_key; + } } return Qnil; found_matching_key: ; @@ -2141,7 +2143,7 @@ the values STRING, PREDICATE and `lambda'. */) if (!NILP (predicate)) { return HASH_TABLE_P (collection) - ? call2 (predicate, tem, HASH_VALUE (XHASH_TABLE (collection), i)) + ? call2 (predicate, tem, arg) : call1 (predicate, tem); } else diff --git a/src/pdumper.c b/src/pdumper.c index 9c9a1ff382c..7f1a78b4f2d 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2655,10 +2655,10 @@ hash_table_contents (struct Lisp_Hash_Table *h) indices to stay constant across the dump. FIXME: Remove such dependency on hash table internals (there might be another one in `composition_gstring_from_id`). */ - DOHASH (h, i) + DOHASH (h, k, v) { - key_and_value[n++] = HASH_KEY (h, i); - key_and_value[n++] = HASH_VALUE (h, i); + key_and_value[n++] = k; + key_and_value[n++] = v; } return key_and_value; diff --git a/src/print.c b/src/print.c index c99d8d5fe3a..c6a3dba3163 100644 --- a/src/print.c +++ b/src/print.c @@ -1285,9 +1285,9 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) { /* Remove unnecessary objects, which appear only once in OBJ; that is, whose status is Qt. */ struct Lisp_Hash_Table *h = XHASH_TABLE (Vprint_number_table); - DOHASH (h, i) - if (EQ (HASH_VALUE (h, i), Qt)) - Fremhash (HASH_KEY (h, i), Vprint_number_table); + DOHASH (h, k, v) + if (EQ (v, Qt)) + Fremhash (k, Vprint_number_table); } } -- cgit v1.2.3 From cc861fc528b49fc459bb9a1e5054f5fd82e1b689 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 24 Jan 2024 08:16:11 -0500 Subject: (struct composition): Remove dependency on hash-table internals `struct composition` kept an index into the internal `key_and_value` array of hash tables, which only worked because of details of how hash-tables are handled. Replace it with a reference to the key stored at that location in the hash-table, which saves us an indirection while at it. * src/composite.h (struct composition): Replace `hash_index` with the actual `key`. (COMPOSITION_KEY): Simplify accordingly. (mark_composite): Declare. * src/composite.c (get_composition_id): Adjust accordingly. (mark_composite): New function. * src/charset.c (mark_charset): Uncomment. * src/lisp.h (mark_charset): Declare. * src/alloc.c (garbage_collect): Call `mark_charset` and `mark_composite`. * src/pdumper.c (hash_table_contents): Remove invalid comment, since compositions aren't dumped. --- src/alloc.c | 2 ++ src/charset.c | 3 +-- src/composite.c | 14 ++++++++++++-- src/composite.h | 8 ++++---- src/lisp.h | 1 + src/pdumper.c | 5 ----- 6 files changed, 20 insertions(+), 13 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 2a1690d2cff..ab31d21fb33 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6594,6 +6594,8 @@ garbage_collect (void) mark_terminals (); mark_kboards (); mark_threads (); + mark_charset (); + mark_composite (); mark_profiler (); #ifdef HAVE_PGTK mark_pgtkterm (); diff --git a/src/charset.c b/src/charset.c index 9633ccaaef9..4bacc011e85 100644 --- a/src/charset.c +++ b/src/charset.c @@ -2271,14 +2271,13 @@ See also `charset-priority-list' and `set-charset-priority'. */) } /* Not strictly necessary, because all charset attributes are also - reachable from `Vcharset_hash_table`. + reachable from `Vcharset_hash_table`. */ void mark_charset (void) { for (int i = 0; i < charset_table_used; i++) mark_object (charset_table[i].attributes); } -*/ void diff --git a/src/composite.c b/src/composite.c index 0b78a78fa79..111b1cea88b 100644 --- a/src/composite.c +++ b/src/composite.c @@ -321,7 +321,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, cmp = xmalloc (sizeof *cmp); cmp->method = method; - cmp->hash_index = hash_index; + cmp->key = key; cmp->glyph_len = glyph_len; cmp->offsets = xnmalloc (glyph_len, 2 * sizeof *cmp->offsets); cmp->font = NULL; @@ -673,7 +673,7 @@ Lisp_Object composition_gstring_from_id (ptrdiff_t id) { struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table); - + /* FIXME: The stability of this value depends on the hash table internals! */ return HASH_VALUE (h, id); } @@ -2148,6 +2148,16 @@ of the way buffer text is examined for matching one of the rules. */) } +/* Not strictly necessary, because all those "keys" are also + reachable from `composition_hash_table`. */ +void +mark_composite (void) +{ + for (int i = 0; i < n_compositions; i++) + mark_object (composition_table[i]->key); +} + + void syms_of_composite (void) { diff --git a/src/composite.h b/src/composite.h index 37f494d69e0..4b412cea696 100644 --- a/src/composite.h +++ b/src/composite.h @@ -84,8 +84,7 @@ composition_registered_p (Lisp_Object prop) ? XCDR (XCDR (XCDR (prop))) \ : CONSP (prop) ? XCDR (prop) : Qnil) -#define COMPOSITION_KEY(cmp) \ - HASH_KEY (XHASH_TABLE (composition_hash_table), (cmp)->hash_index) +#define COMPOSITION_KEY(cmp) (cmp)->key /* Return the Nth glyph of composition specified by CMP. CMP is a pointer to `struct composition'. */ @@ -163,8 +162,8 @@ struct composition { /* Method of the composition. */ enum composition_method method; - /* Index to the composition hash table. */ - ptrdiff_t hash_index; + /* The key under which it's found in the composition hash table. */ + Lisp_Object key; /* For which font we have calculated the remaining members. The actual type is device dependent. */ @@ -200,6 +199,7 @@ extern bool find_composition (ptrdiff_t, ptrdiff_t, ptrdiff_t *, ptrdiff_t *, extern void update_compositions (ptrdiff_t, ptrdiff_t, int); extern void make_composition_value_copy (Lisp_Object); extern void syms_of_composite (void); +extern void mark_composite (void); extern void compose_text (ptrdiff_t, ptrdiff_t, Lisp_Object, Lisp_Object, Lisp_Object); diff --git a/src/lisp.h b/src/lisp.h index 82ce367392e..eb0ee51d9f9 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4073,6 +4073,7 @@ extern ptrdiff_t multibyte_chars_in_text (const unsigned char *, ptrdiff_t); extern void syms_of_character (void); /* Defined in charset.c. */ +extern void mark_charset (void); extern void init_charset (void); extern void init_charset_once (void); extern void syms_of_charset (void); diff --git a/src/pdumper.c b/src/pdumper.c index 7f1a78b4f2d..8907d25cc13 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2650,11 +2650,6 @@ hash_table_contents (struct Lisp_Hash_Table *h) * sizeof *key_and_value); ptrdiff_t n = 0; - /* Make sure key_and_value ends up in the same order; the `hash_index` - field of `struct composition` relies on it by expecting hash table - indices to stay constant across the dump. - FIXME: Remove such dependency on hash table internals (there might - be another one in `composition_gstring_from_id`). */ DOHASH (h, k, v) { key_and_value[n++] = k; -- cgit v1.2.3 From a043cccb62bfd1812cedf107db327039dfdfe89b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 24 Jan 2024 08:21:26 -0500 Subject: * lisp/emacs-lisp/pcase.el (Commentary:): Add paper reference --- lisp/emacs-lisp/pcase.el | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 5ac4b289a80..4754d4e720d 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -42,6 +42,14 @@ ;; - ideally we'd want (pcase s ((re RE1) E1) ((re RE2) E2)) to be able to ;; generate a lex-style DFA to decide whether to run E1 or E2. +;; While the first version was written before I knew about Racket's `match' +;; construct, the second version was significantly influenced by it, +;; so a good presentation of the underlying ideas can be found at: +;; +;; Extensible Pattern Matching in an Extensible Language +;; Sam Tobin-Hochstadt, 2010 +;; https://arxiv.org/abs/1106.2578 + ;;; Code: (require 'macroexp) -- cgit v1.2.3 From c9705037e98a398d0e6e145f16e0ce8cdd4a8973 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 24 Jan 2024 10:21:44 -0500 Subject: Fix build when CHECK_LISP_OBJECT_TYPE is set * src/lisp.h (make_lisp_symbol_internal): Fix last commit. --- src/lisp.h | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/lisp.h b/src/lisp.h index eb0ee51d9f9..f822417ffb1 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1173,7 +1173,12 @@ make_lisp_symbol_internal (struct Lisp_Symbol *sym) Do not use eassert here, so that builtin symbols like Qnil compile to constants; this is needed for some circa-2024 GCCs even with -O2. */ char *symoffset = (char *) ((char *) sym - (char *) lispsym); - return TAG_PTR (Lisp_Symbol, symoffset); + /* FIXME: We need this silly `a = ... return` η-redex because otherwise GCC + complains about: + lisp.h:615:28: error: expected expression before ‘{’ token + 615 | # define LISP_INITIALLY(w) {w} */ + Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset); + return a; } INLINE Lisp_Object -- cgit v1.2.3 From 1f3371b46e8a6a51f88c56785175b48af2a0bed7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 24 Jan 2024 12:57:33 -0500 Subject: Take stock of the wheel-up/down confusion While we're hopefully all aware of the usual confusion between the scroll operation moving the document or moving the viewport, Emacs has its very own instance of that confusion where the `mouse-wheel-down-event` variable is the one that (used to) hold the value `wheel-up` and vice versa. Thanks for Po Lu's commit 957b4f826a4 which not only fixed my change but brought that confusion to my attention. This patch doesn't fix the problem, but tries to fix the other places in the code where we did not take it into account. * doc/lispref/commands.texi (Misc Events): Mention the wheel-up/down confusion. * lisp/progmodes/flymake.el (flymake--mode-line-counter-map): * lisp/completion-preview.el (completion-preview--mouse-map): Fix wheel-up/down confusion. * lisp/mwheel.el (mouse-wheel-down-event, mouse-wheel-up-event): Fix docstrings. --- doc/lispref/commands.texi | 3 +++ lisp/completion-preview.el | 6 ++++-- lisp/mwheel.el | 8 ++++---- lisp/progmodes/flymake.el | 6 ++++-- 4 files changed, 15 insertions(+), 8 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 5f840ac21ec..6c8d42337d0 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2567,6 +2567,9 @@ some kinds of systems. On other systems, other events like @code{mouse-4} and @code{wheel-up} and @code{wheel-down} events as well as the events specified in the variables @code{mouse-wheel-up-event} and @code{mouse-wheel-down-event}, defined in @file{mwheel.el}. +Beware that for historical reasons the @code{mouse-wheel-@emph{up}-event} +is the variable that holds an event that should be handled similarly to +@code{wheel-@emph{down}} and vice versa. @vindex mouse-wheel-left-event @vindex mouse-wheel-right-event diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index f552db7aa8e..6fd60f3c416 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -135,12 +135,14 @@ If this option is nil, these commands do not display any message." "" #'completion-preview-insert "C-" #'completion-at-point "" #'completion-at-point + ;; BEWARE: `mouse-wheel-UP-event' corresponds to `wheel-DOWN' events + ;; and vice versa!! "" #'completion-preview-prev-candidate "" #'completion-preview-next-candidate (key-description (vector mouse-wheel-up-event)) - #'completion-preview-prev-candidate + #'completion-preview-next-candidate (key-description (vector mouse-wheel-down-event)) - #'completion-preview-next-candidate) + #'completion-preview-prev-candidate) (defvar-local completion-preview--overlay nil) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 1e08328c875..53042085bf6 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -34,8 +34,8 @@ ;; Implementation note: ;; ;; I for one would prefer some way of converting the mouse-4/mouse-5 -;; events into different event types, like 'mwheel-up' or -;; 'mwheel-down', but I cannot find a way to do this very easily (or +;; events into different event types, like 'wheel-up' or +;; 'wheel-down', but I cannot find a way to do this very easily (or ;; portably), so for now I just live with it. (require 'timer) @@ -63,14 +63,14 @@ They are sometimes generated by things like `xterm-mouse-mode' as well.") (defcustom mouse-wheel-down-event (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-4) - "Event used for scrolling down, beside `wheel-down', if any." + "Event used for scrolling down, beside `wheel-up', if any." :group 'mouse :type 'symbol :set #'mouse-wheel-change-button) (defcustom mouse-wheel-up-event (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-5) - "Event used for scrolling up, beside `wheel-up', if any." + "Event used for scrolling up, beside `wheel-down', if any." :group 'mouse :type 'symbol :set #'mouse-wheel-change-button) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 225f8ecf874..5974f076556 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1637,14 +1637,16 @@ correctly.") (defvar flymake--mode-line-counter-map (let ((map (make-sparse-keymap))) + ;; BEWARE: `mouse-wheel-UP-event' corresponds to `wheel-DOWN' events + ;; and vice versa!! (define-key map (vector 'mode-line mouse-wheel-down-event) #'flymake--mode-line-counter-scroll-prev) (define-key map [mode-line wheel-down] - #'flymake--mode-line-counter-scroll-prev) + #'flymake--mode-line-counter-scroll-next) (define-key map (vector 'mode-line mouse-wheel-up-event) #'flymake--mode-line-counter-scroll-next) (define-key map [mode-line wheel-up] - #'flymake--mode-line-counter-scroll-next) + #'flymake--mode-line-counter-scroll-prev) map)) (defun flymake--mode-line-counter-1 (type) -- cgit v1.2.3 From 5483a1df99c4c36a96435e1c81ffd021f9355af9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 24 Jan 2024 21:34:16 +0200 Subject: Improve documentation of profiler commands * doc/lispref/debugging.texi (Profiling): Document more commands. Improve indexing. (Bug#68693) --- doc/lispref/debugging.texi | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 774fcaf68bf..47851be0f7c 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -1093,10 +1093,19 @@ argument (@kbd{C-u @key{RET}}) to see the whole call tree below a function. Pressing @kbd{@key{RET}} again will collapse back to the original state. -Press @kbd{j} or @kbd{mouse-2} to jump to the definition of a function -at point. Press @kbd{d} to view a function's documentation. You can -save a profile to a file using @kbd{C-x C-w}. You can compare two -profiles using @kbd{=}. +@findex profiler-report-find-entry +@findex profiler-report-describe-entry +@findex profiler-find-profile +@findex profiler-find-profile-other-window +@findex profiler-report-compare-profile +Press @kbd{j} (@code{profiler-report-find-entry}) or @kbd{mouse-2} to +jump to the definition of a function at point. Press @kbd{d} +(@code{profiler-report-describe-entry}) to view a function's +documentation. You can save a profile to a file using @kbd{C-x C-w} +(@code{profiler-report-write-profile}) and read a saved profile with +@w{@kbd{M-x profiler-find-profile}} or @w{@kbd{M-x +profiler-find-profile-other-window}}. You can compare two profiles +using @kbd{=} (@code{profiler-report-compare-profile}). @c FIXME reversed calltree? -- cgit v1.2.3 From ad004f10f3668d464d32ed8da18639da9bcc01bb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 24 Jan 2024 14:52:09 -0500 Subject: * src/lisp.h (DOHASH): Handle rehashing (bug#68690) I gave too much credit to the comment, and didn't realize that macro was used in places that didn't obey the comment. This macro is getting pretty hideous! --- src/lisp.h | 38 ++++++++++++++++++++++++-------------- 1 file changed, 24 insertions(+), 14 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index f822417ffb1..d07d9d14e2f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2604,20 +2604,30 @@ hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) } /* Iterate K and V as key and value of valid entries in hash table H. - The body may remove the current entry or alter its value slot, but not - mutate TABLE in any other way. */ -#define DOHASH(h, k, v) \ - for (Lisp_Object *dohash_##k##_##v##_kv = (h)->key_and_value, \ - *dohash_##k##_##v##_end = dohash_##k##_##v##_kv \ - + 2 * HASH_TABLE_SIZE (h), \ - k, v; \ - dohash_##k##_##v##_kv < dohash_##k##_##v##_end \ - && (k = dohash_##k##_##v##_kv[0], \ - v = dohash_##k##_##v##_kv[1], /*maybe unsed*/ (void)v, \ - true); \ - dohash_##k##_##v##_kv += 2) \ - if (hash_unused_entry_key_p (k)) \ - ; \ + The body may mutate the hash-table. */ +#define DOHASH(h, k, v) \ + for (Lisp_Object *dohash_##k##_##v##_base = (h)->key_and_value, \ + *dohash_##k##_##v##_kv = dohash_##k##_##v##_base, \ + *dohash_##k##_##v##_end = dohash_##k##_##v##_base \ + + 2 * HASH_TABLE_SIZE (h), \ + k, v; \ + dohash_##k##_##v##_kv < dohash_##k##_##v##_end \ + && (dohash_##k##_##v##_base == (h)->key_and_value \ + /* The `key_and_value` table has been reallocated! */ \ + || (dohash_##k##_##v##_kv \ + = (dohash_##k##_##v##_kv - dohash_##k##_##v##_base) \ + + (h)->key_and_value, \ + dohash_##k##_##v##_base = (h)->key_and_value, \ + dohash_##k##_##v##_end = dohash_##k##_##v##_base \ + + 2 * HASH_TABLE_SIZE (h), \ + /* Check again, in case the table has shrunk. */ \ + dohash_##k##_##v##_kv < dohash_##k##_##v##_end)) \ + && (k = dohash_##k##_##v##_kv[0], \ + v = dohash_##k##_##v##_kv[1], /*maybe unused*/ (void)v, \ + true); \ + dohash_##k##_##v##_kv += 2) \ + if (hash_unused_entry_key_p (k)) \ + ; \ else -- cgit v1.2.3 From 65ea742ed5ec505837706d64690e3cc2073825c7 Mon Sep 17 00:00:00 2001 From: João Távora Date: Thu, 25 Jan 2024 01:37:57 +0000 Subject: Eglot: try even harder to avoid other completion styles (bug#68699) Any completion style except for eglot--dumb-flex spells trouble for Eglot, for the well known reason that LSP is geared towards completion tooltips and none of Emacs' partial-completion shenanigans. This commit puts a "try-completion" function that doesn't return nil in the eglot--dumb-flex completion style so that other styles aren't tried (partial-completion, in particular, errors out). The function often doesn't do anything very useful, but at least it doesn't stop the more usual *Completions* buffer from appearing. * lisp/progmodes/eglot.el (eglot--dumb-tryc): New helper. (completion-styles-alist): Add it to the dumb-flex style. --- lisp/progmodes/eglot.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 511000927cf..c5fbf5eb9d5 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -3060,9 +3060,13 @@ for which LSP on-type-formatting should be requested." finally (cl-return comp))) (defun eglot--dumb-allc (pat table pred _point) (funcall table pat pred t)) +(defun eglot--dumb-tryc (pat table pred point) + (if-let ((probe (funcall table pat pred nil))) + (cons probe (length probe)) + (cons pat point))) (add-to-list 'completion-category-defaults '(eglot-capf (styles eglot--dumb-flex))) -(add-to-list 'completion-styles-alist '(eglot--dumb-flex ignore eglot--dumb-allc)) +(add-to-list 'completion-styles-alist '(eglot--dumb-flex eglot--dumb-tryc eglot--dumb-allc)) (defun eglot-completion-at-point () "Eglot's `completion-at-point' function." -- cgit v1.2.3 From caea0c1649d1df96b811c1388fde396e66bc356b Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 25 Jan 2024 12:17:54 +0800 Subject: Prevent matrices from remaining invalid post mini-window resize * src/androidfns.c (android_create_tip_frame): Enable building with GLYPH_DEBUG. * src/window.c (resize_mini_window_apply): Garbage the frame if F->redisplay is already set to indicate that redisplay_internal should nevertheless return to it. --- src/androidfns.c | 3 --- src/window.c | 12 +++++++++++- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/src/androidfns.c b/src/androidfns.c index bf8ab5b45cc..34f1f533684 100644 --- a/src/androidfns.c +++ b/src/androidfns.c @@ -1931,9 +1931,6 @@ android_create_tip_frame (struct android_display_info *dpyinfo, image_cache_refcount = FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0; -#ifdef GLYPH_DEBUG - dpyinfo_refcount = dpyinfo->reference_count; -#endif /* GLYPH_DEBUG */ gui_default_parameter (f, parms, Qfont_backend, Qnil, "fontBackend", "FontBackend", RES_TYPE_STRING); diff --git a/src/window.c b/src/window.c index 3a54f7ce7b1..915f591221d 100644 --- a/src/window.c +++ b/src/window.c @@ -5331,7 +5331,17 @@ resize_mini_window_apply (struct window *w, int delta) w->pixel_top = r->pixel_top + r->pixel_height; w->top_line = r->top_line + r->total_lines; - /* Enforce full redisplay of the frame. */ + /* Enforce full redisplay of the frame. If f->redisplay is already + set, which it generally is in the wake of a ConfigureNotify + (frame resize) event, merely setting f->redisplay is insufficient + for redisplay_internal to continue redisplaying the frame, as + redisplay_internal cannot distinguish between f->redisplay set + before it calls redisplay_window and that after, so garbage the + frame as well. */ + + if (f->redisplay) + SET_FRAME_GARBAGED (f); + /* FIXME: Shouldn't some of the caller do it? */ fset_redisplay (f); adjust_frame_glyphs (f); -- cgit v1.2.3 From d85f561da03cd4705341a5a73f5c643f778e0f35 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 19 Jan 2024 09:11:37 -0800 Subject: Reserve negative depth range for ERC's insert hooks * etc/ERC-NEWS: Mention additional reserved depth range of -80 to -20. Also mention possibly having to cycle module activation state after updating options. * lisp/erc/erc-goodies.el (erc-irccontrols-mode, erc-irccontrols-enable): Add `erc-controls-highlight' to `erc-insert-modify-hook' at depth -50. * lisp/erc/erc.el (erc-insert-modify-hook): Mention negative hook-depth range in doc string. --- etc/ERC-NEWS | 13 ++++++++++++- lisp/erc/erc-goodies.el | 2 +- lisp/erc/erc.el | 4 ++-- 3 files changed, 15 insertions(+), 4 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 6cfa704d995..b673d36220a 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -325,6 +325,15 @@ to enable the displaying of status prefixes on the speaker nicks of incoming chat messages. Prefixes on your speaker nick for outgoing chat messages continue to always be present. +** Updating user options requires cycling associated minor modes. +During a live ERC session, you may need to disable and re-enable a +module's minor mode via 'M-x erc-foo-mode RET' or similar before an +option's updated value takes effect. This primarily impacts new +options introduced by this release and existing ones whose behavior +has changed in some way. At present, ERC does not perform this step +automatically on your behalf, even if a change was made in a +'Custom-mode' buffer or via 'setopt'. + ** Miscellaneous UX changes. Some minor quality-of-life niceties have finally made their way to ERC. For example, fool visibility has become togglable with the new @@ -387,8 +396,10 @@ when present, at depths beginning at 20 and ending below 80. Of most interest to module authors is the new relative positioning of the first three, which have been rotated leftward with respect to their previous places in recent ERC versions (fill, button, match ,stamp). +A similar designated range from -80 to -20 also exists and is home to +the function 'erc-controls-highlight'. -ERC also provisionally reserves the same depth interval for +ERC also provisionally reserves the same depth intervals for 'erc-insert-pre-hook' and possibly other, similar hooks, but will continue to modify non-ERC hooks locally whenever possible, especially in new code. diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 23589657b2d..bf361ff91fb 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -822,7 +822,7 @@ The value `erc-interpret-controls-p' must also be t for this to work." ;;;###autoload(autoload 'erc-irccontrols-mode "erc-goodies" nil t) (define-erc-module irccontrols nil "This mode enables the interpretation of IRC control chars." - ((add-hook 'erc-insert-modify-hook #'erc-controls-highlight) + ((add-hook 'erc-insert-modify-hook #'erc-controls-highlight -50) (add-hook 'erc-send-modify-hook #'erc-controls-highlight) (erc--modify-local-map t "C-c C-c" #'erc-toggle-interpret-controls)) ((remove-hook 'erc-insert-modify-hook #'erc-controls-highlight) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 767a693a52e..e9d6099317f 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1278,8 +1278,8 @@ of `erc-insert-this' is t. ERC runs this hook with the buffer narrowed to the bounds of the inserted message plus a trailing newline. Built-in modules place -their hook members at depths between 20 and 80, with those from -the stamp module always running last. Use the functions +their hook members in two depth ranges: the first between -80 and +-20 and the second between 20 and 80. Use the functions `erc-find-parsed-property' and `erc-get-parsed-vector' to locate and extract the `erc-response' object for the inserted message." :group 'erc-hooks -- cgit v1.2.3 From aedc8b55bfc4d2864d777ac17f6bcf70e4ee04ce Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 17 Jan 2024 21:42:02 -0800 Subject: Actually derive channel membership from PREFIX in ERC * lisp/erc/erc-backend.el (erc--with-isupport-data): Add comment for possibly superior alternate implementation. * lisp/erc/erc-common.el (erc--get-isupport-entry): Use helper to initialize traditional prefix slots in overridden well-known constructor. (erc--parsed-prefix): Reverse order of characters in the `letters' and `statuses' slots, in their defaults and also their definitions. (erc--strpos): New function, a utility for finding a single character in a string. * lisp/erc/erc.el (erc--define-channel-user-status-compat-getter): Modify to query advertised value for associated mode letter at runtime instead of baking it in. (erc-channel-user-voice, erc-channel-user-halfop, erc-channel-user-op, erc-channel-user-admin, erc-channel-user-owner): Supply second argument for fallback mode letter. (erc--cusr-status-p, erc--cusr-change-status): New functions for querying and modifying `erc-channel-user' statuses. (erc-send-input-line): Update speaker time in own nick's `erc-channel-member' entry. (erc-get-channel-membership-prefix): Adapt code to prefer advertised prefix for mode letter. (erc--parsed-prefix): Save "reversed" `letters' and `statuses' so that they're ordered from lowest to highest semantically. (erc--get-prefix-flag, erc--init-cusr-fallback-status, erc--compute-cusr-fallback-status): New functions for retrieving internal prefix values and massaging hard-coded traditional prefixes so they're compatible with existing `erc-channel-member' update code. (erc--partition-prefixed-names): New function, separated for testing and for conversion to a generic in the future when ERC supports extensions that list member rolls in a different format. (erc-channel-receive-names): Refactor to use new status-aware update and init workhorse functions for updating and initializing a `erc-channel-members' entry. (erc--create-current-channel-member): New "status-aware" function comprising the `addp' path of `erc-update-current-channel-member'. (erc--update-current-channel-member): New "status-aware" function comprising the "update" path of `erc-update-current-channel-member', which ran when an existing `erc-channel-members' entry for the queried nick was found. (erc-update-current-channel-member): Split code body into two constituent functions, both for readability and for usability, so callers can more explicitly request the desired operation in a "status-aware" manner. (erc--update-membership-prefix): Remove unused function, originally meant to be new in ERC 5.6. (erc--process-channel-modes): Call `erc--cusr-change-status' instead of `erc--update-membership-prefix'. (erc--shuffle-nuh-nickward): New utility function to ensure code like `erc--partition-prefixed-names' can use `erc--parse-nuh' in a practical and relatively convenient way in the near future. * test/lisp/erc/erc-scenarios-base-chan-modes.el (erc-scenarios-base-chan-modes--speaker-status): New test. * test/lisp/erc/erc-tests.el (erc--parsed-prefix): Reverse expected order of various slot values in `erc--parsed-prefix' objects. (erc--get-prefix-flag, erc--init-cusr-fallback-status, erc--compute-cusr-fallback-status, erc--cusr-status-p, erc--cusr-change-status): New tests. (erc--update-channel-modes, erc-process-input-line): Use newly available utilities imported from common library. * test/lisp/erc/resources/base/modes/speaker-status.eld: New file. (Bug#67220) --- lisp/erc/erc-backend.el | 4 +- lisp/erc/erc-common.el | 24 +- lisp/erc/erc.el | 362 +++++++++++++-------- test/lisp/erc/erc-scenarios-base-chan-modes.el | 58 ++++ test/lisp/erc/erc-tests.el | 122 +++++-- .../erc/resources/base/modes/speaker-status.eld | 69 ++++ 6 files changed, 471 insertions(+), 168 deletions(-) create mode 100644 test/lisp/erc/resources/base/modes/speaker-status.eld diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 95207e56fd1..e379066b08e 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -2201,7 +2201,9 @@ primitive value." ;; While it's better to depend on interfaces than specific types, ;; using `cl-struct-slot-value' or similar to extract a known slot at ;; runtime would incur a small "ducktyping" tax, which should probably -;; be avoided when running dozens of times per incoming message. +;; be avoided when running hundreds of times per incoming message. +;; Instead of separate keys per data type, we could increment a +;; counter whenever a new 005 arrives. (defmacro erc--with-isupport-data (param var &rest body) "Return structured data stored in VAR for \"ISUPPORT\" PARAM. Expect VAR's value to be an instance of `erc--isupport-data'. If diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index e7e70fffd3a..e39e414b290 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -37,6 +37,7 @@ (defvar erc-session-server) (declare-function erc--get-isupport-entry "erc-backend" (key &optional single)) +(declare-function erc--init-cusr-fallback-status "erc" (v h o a q)) (declare-function erc-get-buffer "erc" (target &optional proc)) (declare-function erc-server-buffer "erc" nil) (declare-function widget-apply-action "wid-edit" (widget &optional event)) @@ -76,11 +77,11 @@ make-erc-channel-user ( &key voice halfop op admin owner last-message-time - &aux (status (+ (if voice 1 0) - (if halfop 2 0) - (if op 4 0) - (if admin 8 0) - (if owner 16 0))))) + &aux (status + (if (or voice halfop op admin owner) + (erc--init-cusr-fallback-status + voice halfop op admin owner) + 0)))) :named) "Object containing channel-specific data for a single user." ;; voice halfop op admin owner @@ -140,9 +141,12 @@ For use with the macro `erc--with-isupport-data'." (cl-defstruct (erc--parsed-prefix (:include erc--isupport-data)) "Server-local data for recognized membership-status prefixes. Derived from the advertised \"PREFIX\" ISUPPORT parameter." - (letters "qaohv" :type string) - (statuses "~&@%+" :type string) - (alist nil :type (list-of cons))) + ( letters "vhoaq" :type string + :documentation "Status letters ranked lowest to highest.") + ( statuses "+%@&~" :type string + :documentation "Status prefixes ranked lowest to highest.") + ( alist nil :type (list-of cons) + :documentation "Alist of letters-prefix pairs.")) (cl-defstruct (erc--channel-mode-types (:include erc--isupport-data)) "Server-local \"CHANMODES\" data." @@ -594,6 +598,10 @@ the resulting variables will end up with more useful doc strings." (debug (symbolp [&rest [keywordp form]] &rest (symbolp . form)))) `(erc--define-catalog ,language ,entries)) +(define-inline erc--strpos (char string) + "Return position of CHAR in STRING or nil if not found." + (inline-quote (string-search (string ,char) ,string))) + (defmacro erc--doarray (spec &rest body) "Map over ARRAY, running BODY with VAR bound to iteration element. Behave more or less like `seq-doseq', but tailor operations for diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index e9d6099317f..fc6f51950e2 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -598,28 +598,52 @@ Removes all users in the current channel. This is called by erc-channel-users) (clrhash erc-channel-users))) -(defmacro erc--define-channel-user-status-compat-getter (name n) +(defmacro erc--define-channel-user-status-compat-getter (name c d) "Define a gv getter for historical `erc-channel-user' status slot NAME. -Expect NAME to be a string and N to be its associated power-of-2 -\"enumerated flag\" integer." +Expect NAME to be a string, C to be its traditionally associated +letter, and D to be its fallback power-of-2 integer for non-ERC +buffers." `(defun ,(intern (concat "erc-channel-user-" name)) (u) ,(format "Get equivalent of pre-5.6 `%s' slot for `erc-channel-user'." name) (declare (gv-setter (lambda (v) (macroexp-let2 nil v v - (,'\`(let ((val (erc-channel-user-status ,',u))) + (,'\`(let ((val (erc-channel-user-status ,',u)) + (n (or (erc--get-prefix-flag ,c) ,d))) (setf (erc-channel-user-status ,',u) (if ,',v - (logior val ,n) - (logand val ,(lognot n)))) + (logior val n) + (logand val (lognot n)))) ,',v)))))) - (= ,n (logand ,n (erc-channel-user-status u))))) - -(erc--define-channel-user-status-compat-getter "voice" 1) -(erc--define-channel-user-status-compat-getter "halfop" 2) -(erc--define-channel-user-status-compat-getter "op" 4) -(erc--define-channel-user-status-compat-getter "admin" 8) -(erc--define-channel-user-status-compat-getter "owner" 16) + (let ((n (or (erc--get-prefix-flag ,c) ,d))) + (= n (logand n (erc-channel-user-status u)))))) + +(erc--define-channel-user-status-compat-getter "voice" ?v 1) +(erc--define-channel-user-status-compat-getter "halfop" ?h 2) +(erc--define-channel-user-status-compat-getter "op" ?o 4) +(erc--define-channel-user-status-compat-getter "admin" ?a 8) +(erc--define-channel-user-status-compat-getter "owner" ?q 16) + +;; This is a generalized version of the compat-oriented getters above. +(defun erc--cusr-status-p (nick-or-cusr letter) + "Return non-nil if NICK-OR-CUSR has channel membership status LETTER." + (and-let* ((cusr (or (and (erc-channel-user-p nick-or-cusr) nick-or-cusr) + (cdr (erc-get-channel-member nick-or-cusr)))) + (n (erc--get-prefix-flag letter))) + (= n (logand n (erc-channel-user-status cusr))))) + +(defun erc--cusr-change-status (nick-or-cusr letter enablep &optional resetp) + "Add or remove membership status associated with LETTER for NICK-OR-CUSR. +With RESETP, clear the user's status info completely. If ENABLEP +is non-nil, add the status value associated with LETTER." + (when-let ((cusr (or (and (erc-channel-user-p nick-or-cusr) nick-or-cusr) + (cdr (erc-get-channel-member nick-or-cusr)))) + (n (erc--get-prefix-flag letter))) + (cl-callf (lambda (v) + (if resetp + (if enablep n 0) + (if enablep (logior v n) (logand v (lognot n))))) + (erc-channel-user-status cusr)))) (defun erc-channel-user-owner-p (nick) "Return non-nil if NICK is an owner of the current channel." @@ -3900,6 +3924,10 @@ for other purposes.") (defun erc-send-input-line (target line &optional force) "Send LINE to TARGET." + (when-let ((target) + (cmem (erc-get-channel-member (erc-current-nick)))) + (setf (erc-channel-user-last-message-time (cdr cmem)) + (erc-compat--current-lisp-time))) (when (and (not erc--allow-empty-outgoing-lines-p) (string= line "\n")) (setq line " \n")) (erc-message "PRIVMSG" (concat target " " line) force)) @@ -6141,17 +6169,15 @@ return a possibly empty string." (catch 'done (pcase-dolist (`(,letter . ,pfx) (erc--parsed-prefix-alist pfx-obj)) - (pcase letter - ((and ?q (guard (erc-channel-user-owner nick-or-cusr))) - (throw 'done (propertize (string pfx) 'help-echo "owner"))) - ((and ?a (guard (erc-channel-user-admin nick-or-cusr))) - (throw 'done (propertize (string pfx) 'help-echo "admin"))) - ((and ?o (guard (erc-channel-user-op nick-or-cusr))) - (throw 'done (propertize (string pfx) 'help-echo "operator"))) - ((and ?h (guard (erc-channel-user-halfop nick-or-cusr))) - (throw 'done (propertize (string pfx) 'help-echo "half-op"))) - ((and ?v (guard (erc-channel-user-voice nick-or-cusr))) - (throw 'done (propertize (string pfx) 'help-echo "voice"))))) + (when (erc--cusr-status-p nick-or-cusr letter) + (throw 'done + (pcase letter + (?q (propertize (string pfx) 'help-echo "owner")) + (?a (propertize (string pfx) 'help-echo "admin")) + (?o (propertize (string pfx) 'help-echo "operator")) + (?h (propertize (string pfx) 'help-echo "half-op")) + (?v (propertize (string pfx) 'help-echo "voice")) + (_ (string pfx)))))) ""))) (t (cond ((erc-channel-user-owner nick-or-cusr) @@ -6763,12 +6789,52 @@ parameter advertised by the current server, with the original ordering intact. If no such parameter has yet arrived, return a stand-in from the fallback value \"(qaohv)~&@%+\"." (erc--with-isupport-data PREFIX erc--parsed-prefix - (let ((alist (nreverse (erc-parse-prefix)))) + (let ((alist (erc-parse-prefix))) (make-erc--parsed-prefix :key key :letters (apply #'string (map-keys alist)) :statuses (apply #'string (map-values alist)) - :alist alist)))) + :alist (nreverse alist))))) + +(defun erc--get-prefix-flag (char &optional parsed-prefix from-prefix-p) + "Return numeric rank for CHAR or nil if unknown. +For example, given letters \"qaohv\" return 1 for ?v, 2 for ?h, +and 4 for ?o, etc. If given, expect PARSED-PREFIX to be a +`erc--parse-prefix' object. With FROM-PREFIX-P, expect CHAR to +be a prefix instead." + (and-let* ((obj (or parsed-prefix (erc--parsed-prefix))) + (pos (erc--strpos char (if from-prefix-p + (erc--parsed-prefix-statuses obj) + (erc--parsed-prefix-letters obj))))) + (ash 1 pos))) + +(defun erc--init-cusr-fallback-status (voice halfop op admin owner) + "Return channel-membership based on traditional status semantics. +Massage boolean switches VOICE, HALFOP, OP, ADMIN, and OWNER into +an internal numeric value suitable for the `status' slot of a new +`erc-channel-user' object." + (let ((pfx (erc--parsed-prefix))) + (+ (if voice (if pfx (or (erc--get-prefix-flag ?v pfx) 0) 1) 0) + (if halfop (if pfx (or (erc--get-prefix-flag ?h pfx) 0) 2) 0) + (if op (if pfx (or (erc--get-prefix-flag ?o pfx) 0) 4) 0) + (if admin (if pfx (or (erc--get-prefix-flag ?a pfx) 0) 8) 0) + (if owner (if pfx (or (erc--get-prefix-flag ?q pfx) 0) 16) 0)))) + +(defun erc--compute-cusr-fallback-status (current v h o a q) + "Return current channel membership after toggling V H O A Q as requested. +Assume `erc--parsed-prefix' is non-nil in the current buffer. +Expect status switches V, H, O, A, Q, when non-nil, to be the +symbol `on' or `off'. Return an internal numeric value suitable +for the `status' slot of an `erc-channel-user' object." + (let (on off) + (when v (push (or (erc--get-prefix-flag ?v) 0) (if (eq v 'on) on off))) + (when h (push (or (erc--get-prefix-flag ?h) 0) (if (eq h 'on) on off))) + (when o (push (or (erc--get-prefix-flag ?o) 0) (if (eq o 'on) on off))) + (when a (push (or (erc--get-prefix-flag ?a) 0) (if (eq a 'on) on off))) + (when q (push (or (erc--get-prefix-flag ?q) 0) (if (eq q 'on) on off))) + (when on (setq current (apply #'logior current on))) + (when off (setq current (apply #'logand current (mapcar #'lognot off))))) + current) (defcustom erc-channel-members-changed-hook nil "This hook is called every time the variable `channel-members' changes. @@ -6776,48 +6842,40 @@ The buffer where the change happened is current while this hook is called." :group 'erc-hooks :type 'hook) -(defun erc-channel-receive-names (names-string) - "This function is for internal use only. +(defun erc--partition-prefixed-names (name) + "From NAME, return a list of (STATUS NICK LOGIN HOST). +Expect NAME to be a prefixed name, like @bob." + (unless (string-empty-p name) + (let* ((status (erc--get-prefix-flag (aref name 0) nil 'from-prefix-p)) + (nick (if status (substring name 1) name))) + (unless (string-empty-p nick) + (list status nick nil nil))))) -Update `erc-channel-users' according to NAMES-STRING. -NAMES-STRING is a string listing some of the names on the -channel." - (let* ((prefix (erc--parsed-prefix-alist (erc--parsed-prefix))) - (voice-ch (cdr (assq ?v prefix))) - (op-ch (cdr (assq ?o prefix))) - (hop-ch (cdr (assq ?h prefix))) - (adm-ch (cdr (assq ?a prefix))) - (own-ch (cdr (assq ?q prefix))) - (names (delete "" (split-string names-string))) - name op voice halfop admin owner) - (let ((erc-channel-members-changed-hook nil)) - (dolist (item names) - (let ((updatep t) - (ch (aref item 0))) - (setq name item op 'off voice 'off halfop 'off admin 'off owner 'off) - (if (rassq ch prefix) - (if (= (length item) 1) - (setq updatep nil) - (setq name (substring item 1)) - (setf (pcase ch - ((pred (eq voice-ch)) voice) - ((pred (eq hop-ch)) halfop) - ((pred (eq op-ch)) op) - ((pred (eq adm-ch)) admin) - ((pred (eq own-ch)) owner) - (_ (message "Unknown prefix char `%S'" ch) voice)) - 'on))) - (when updatep +(defun erc-channel-receive-names (names-string) + "Update `erc-channel-members' from NAMES-STRING. +Expect NAMES-STRING to resemble the trailing argument of a 353 +RPL_NAMREPLY. Call internal handlers for parsing individual +names, whose expected composition may differ depending on enabled +extensions." + (let ((names (delete "" (split-string names-string))) + (erc-channel-members-changed-hook nil)) + (dolist (name names) + (when-let ((args (erc--partition-prefixed-names name))) + (pcase-let* ((`(,status ,nick ,login ,host) args) + (cmem (erc-get-channel-user nick))) + (progn ;; If we didn't issue the NAMES request (consider two clients ;; talking to an IRC proxy), `erc-channel-begin-receiving-names' ;; will not have been called, so we have to do it here. (unless erc-channel-new-member-names (erc-channel-begin-receiving-names)) - (puthash (erc-downcase name) t - erc-channel-new-member-names) - (erc-update-current-channel-member - name name t voice halfop op admin owner))))) - (run-hooks 'erc-channel-members-changed-hook))) + (puthash (erc-downcase nick) t erc-channel-new-member-names) + (if cmem + (erc--update-current-channel-member cmem status nil + nick host login) + (erc--create-current-channel-member nick status nil + nick host login))))))) + (run-hooks 'erc-channel-members-changed-hook)) (defun erc-update-user-nick (nick &optional new-nick host login full-name info) @@ -6869,17 +6927,85 @@ which USER is a member, and t is returned." (run-hooks 'erc-channel-members-changed-hook)))))) changed)) +(defun erc--create-current-channel-member + (nick status timep &optional new-nick host login full-name info) + "Add an `erc-channel-member' entry for NICK. +Create a new `erc-server-users' entry if necessary, and ensure +`erc-channel-members-changed-hook' runs exactly once, regardless. +Pass STATUS to the `erc-channel-user' constructor. With TIMEP, +assume NICK has just spoken, and initialize `last-message-time'. +Pass NEW-NICK, HOST, LOGIN, FULL-NAME, and INFO to +`erc-update-user' if a server user exists and otherwise to the +`erc-server-user' constructor." + (cl-assert (null (erc-get-channel-member nick))) + (let* ((user-changed-p nil) + (down (erc-downcase nick)) + (user (gethash down (erc-with-server-buffer erc-server-users)))) + (if user + (progn + (cl-pushnew (current-buffer) (erc-server-user-buffers user)) + ;; Update *after* ^ so hook has chance to run. + (setf user-changed-p (erc-update-user user new-nick host login + full-name info))) + (erc-add-server-user nick + (setq user (make-erc-server-user + :nickname (or new-nick nick) + :host host + :full-name full-name + :login login + :info nil + :buffers (list (current-buffer)))))) + (let ((cusr (erc-channel-user--make + :status (or status 0) + :last-message-time (and timep + (erc-compat--current-lisp-time))))) + (puthash down (cons user cusr) erc-channel-users)) + ;; An existing `cusr' was changed or a new one was added, and + ;; `user' was not updated, though possibly just created (since + ;; `erc-update-user' runs this same hook in all a user's buffers). + (unless user-changed-p + (run-hooks 'erc-channel-members-changed-hook)) + t)) + +(defun erc--update-current-channel-member (cmem status timep &rest user-args) + "Update existing `erc-channel-member' entry. +Set the `status' slot of the entry's `erc-channel-user' side to +STATUS and, with TIMEP, update its `last-message-time'. When +actual changes are made, run `erc-channel-members-changed-hook', +and return non-nil." + (cl-assert cmem) + (let ((cusr (cdr cmem)) + (user (car cmem)) + cusr-changed-p user-changed-p) + (when (and status (/= status (erc-channel-user-status cusr))) + (setf (erc-channel-user-status cusr) status + cusr-changed-p t)) + (when timep + (setf (erc-channel-user-last-message-time cusr) + (erc-compat--current-lisp-time))) + ;; Ensure `erc-channel-members-changed-hook' runs on change. + (cl-assert (memq (current-buffer) (erc-server-user-buffers user))) + (setq user-changed-p (apply #'erc-update-user user user-args)) + ;; An existing `cusr' was changed or a new one was added, and + ;; `user' was not updated, though possibly just created (since + ;; `erc-update-user' runs this same hook in all a user's buffers). + (when (and cusr-changed-p (null user-changed-p)) + (run-hooks 'erc-channel-members-changed-hook)) + (erc-log (format "update-member: user = %S, cusr = %S" user cusr)) + (or cusr-changed-p user-changed-p))) + (defun erc-update-current-channel-member - (nick new-nick &optional addp voice halfop op admin owner host login full-name info - update-message-time) + (nick new-nick &optional addp voice halfop op admin owner host login + full-name info update-message-time) "Update or create entry for NICK in current `erc-channel-members' table. -With ADDP, ensure an entry exists. If one already does, call -`erc-update-user' to handle updates to HOST, LOGIN, FULL-NAME, -INFO, and NEW-NICK. Expect any non-nil membership status -switches among VOICE, HALFOP, OP, ADMIN, and OWNER to be the -symbol `on' or `off' when needing to influence a new or existing -`erc-channel-user' object's `status' slot. Likewise, when -UPDATE-MESSAGE-TIME is non-nil, update or initialize the +With ADDP, ensure an entry exists. When an entry does exist or +when ADDP is non-nil and an `erc-server-users' entry already +exists, call `erc-update-user' with NEW-NICK, HOST, LOGIN, +FULL-NAME, and INFO. Expect any non-nil membership +status switches among VOICE, HALFOP, OP, ADMIN, and OWNER to be +the symbol `on' or `off' when needing to influence a new or +existing `erc-channel-user' object's `status' slot. Likewise, +when UPDATE-MESSAGE-TIME is non-nil, update or initialize the `last-message-time' slot to the current-time. If changes occur, including creation, run `erc-channel-members-changed-hook'. Return non-nil when meaningful changes, including creation, have @@ -6889,62 +7015,26 @@ Without ADDP, do nothing unless a `erc-channel-members' entry exists. When it doesn't, assume the sender is a non-joined entity, like the server itself or a historical speaker, or assume the prior buffer for the channel was killed without parting." - (let* (cusr-changed-p - user-changed-p - (cmem (erc-get-channel-member nick)) - (cusr (cdr cmem)) - (down (erc-downcase nick)) - (user (or (car cmem) - (gethash down (erc-with-server-buffer erc-server-users))))) - (if cusr - (progn - (erc-log (format "update-member: user = %S, cusr = %S" user cusr)) - (when-let (((or voice halfop op admin owner)) - (existing (erc-channel-user-status cusr))) - (when voice (setf (erc-channel-user-voice cusr) (eq voice 'on))) - (when halfop (setf (erc-channel-user-halfop cusr) (eq halfop 'on))) - (when op (setf (erc-channel-user-op cusr) (eq op 'on))) - (when admin (setf (erc-channel-user-admin cusr) (eq admin 'on))) - (when owner (setf (erc-channel-user-owner cusr) (eq owner 'on))) - (setq cusr-changed-p (= existing (erc-channel-user-status cusr)))) - (when update-message-time - (setf (erc-channel-user-last-message-time cusr) (current-time))) - ;; Assume `user' exists and its `buffers' slot contains the - ;; current buffer so that `erc-channel-members-changed-hook' - ;; will run if changes are made. - (setq user-changed-p - (erc-update-user user new-nick - host login full-name info))) - (when addp - (if (null user) - (progn - (setq user (make-erc-server-user - :nickname nick - :host host - :full-name full-name - :login login - :info info - :buffers (list (current-buffer)))) - (erc-add-server-user nick user)) - (setf (erc-server-user-buffers user) - (cons (current-buffer) - (erc-server-user-buffers user)))) - (setq cusr (make-erc-channel-user - :voice (and voice (eq voice 'on)) - :halfop (and halfop (eq halfop 'on)) - :op (and op (eq op 'on)) - :admin (and admin (eq admin 'on)) - :owner (and owner (eq owner 'on)) - :last-message-time (if update-message-time - (current-time)))) - (puthash down (cons user cusr) erc-channel-users) - (setq cusr-changed-p t))) - ;; An existing `cusr' was changed or a new one was added, and - ;; `user' was not updated, though possibly just created (since - ;; `erc-update-user' runs this same hook in all a user's buffers). - (when (and cusr-changed-p (null user-changed-p)) - (run-hooks 'erc-channel-members-changed-hook)) - (or cusr-changed-p user-changed-p))) +(let* ((cmem (erc-get-channel-member nick)) + (status (and (or voice halfop op admin owner) + (if cmem + (erc--compute-cusr-fallback-status + (erc-channel-user-status (cdr cmem)) + voice halfop op admin owner) + (erc--init-cusr-fallback-status + (and voice (eq voice 'on)) + (and halfop (eq halfop 'on)) + (and op (eq op 'on)) + (and admin (eq admin 'on)) + (and owner (eq owner 'on))))))) + (if cmem + (erc--update-current-channel-member cmem status update-message-time + new-nick host login + full-name info) + (when addp + (erc--create-current-channel-member nick status update-message-time + new-nick host login + full-name info))))) (defun erc-update-channel-member (channel nick new-nick &optional add voice halfop op admin owner host login @@ -7134,16 +7224,6 @@ person who changed the modes." ;; nick modes - ignored at this point (t nil)))) -(defun erc--update-membership-prefix (nick letter state) - "Update status prefixes for NICK in current channel buffer. -Expect LETTER to be a status char and STATE to be a boolean." - (erc-update-current-channel-member nick nil nil - (and (= letter ?v) state) - (and (= letter ?h) state) - (and (= letter ?o) state) - (and (= letter ?a) state) - (and (= letter ?q) state))) - (defvar-local erc--channel-modes nil "When non-nil, a hash table of current channel modes. Keys are characters. Values are either a string, for types A-C, @@ -7189,7 +7269,7 @@ complement relevant letters in STRING." (cond ((= ?+ c) (setq +p t)) ((= ?- c) (setq +p nil)) ((and status-letters (string-search (string c) status-letters)) - (erc--update-membership-prefix (pop args) c (if +p 'on 'off))) + (erc--cusr-change-status (pop args) c +p)) ((and-let* ((group (or (aref table c) (and fallbackp ?d)))) (erc--handle-channel-mode group c +p (and (/= group ?d) @@ -7511,6 +7591,12 @@ See associated unit test for precise behavior." (match-string 2 string) (match-string 3 string)))) +(defun erc--shuffle-nuh-nickward (nick login host) + "Interpret results of `erc--parse-nuh', promoting loners to nicks." + (cond (nick (cl-assert (null login)) (list nick login host)) + ((and (null login) host) (list host nil nil)) + ((and login (null host)) (list login nil nil)))) + (defun erc-extract-nick (string) "Return the nick corresponding to a user specification STRING. diff --git a/test/lisp/erc/erc-scenarios-base-chan-modes.el b/test/lisp/erc/erc-scenarios-base-chan-modes.el index 73fba65acf4..3183cd27370 100644 --- a/test/lisp/erc/erc-scenarios-base-chan-modes.el +++ b/test/lisp/erc/erc-scenarios-base-chan-modes.el @@ -81,4 +81,62 @@ (should-not erc-channel-user-limit) (funcall expect 10 " after")))) +;; This asserts proper recognition of nonstandard prefixes advertised +;; via the "PREFIX=" ISUPPORT parameter. Note that without the IRCv3 +;; `multi-prefix' extension, we can't easily sync a user's channel +;; membership status on receipt of a 352/353 by parsing the "flags" +;; parameter because even though servers remember multiple prefixes, +;; they only ever return the one with the highest rank. For example, +;; if on receipt of a 352, we were to "update" someone we believe to +;; be @+ by changing them to a to @, we'd be guilty of willful +;; munging. And if they later lose that @, we'd then see them as null +;; when in fact they're still +. However, we *could* use a single +;; degenerate prefix to "validate" an existing record to ensure +;; correctness of our processing logic, but it's unclear how such a +;; discrepancy ought to be handled beyond asking the user to file a +;; bug. +(ert-deftest erc-scenarios-base-chan-modes--speaker-status () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/modes") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'speaker-status)) + (erc-show-speaker-membership-status t) + (erc-autojoin-channels-alist '(("." "#chan"))) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port (process-contact dumb-server :service) + :nick "tester" + :user "tester") + (funcall expect 5 "Here on foonet, we provide services"))) + + (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan")) + + (ert-info ("Prefixes printed correctly in 353") + (funcall expect 10 "chan: +alice @fsbot -bob !foop")) + + (ert-info ("Speakers honor option `erc-show-speaker-membership-status'") + (funcall expect 10 "<-bob> alice: Of that which hath") + (funcall expect 10 "<+alice> Hie you, make haste") + (funcall expect 10 " hi")) + + (ert-info ("Status conferred and rescinded") + (funcall expect 10 "*** foop (user@netadmin.example.net) has changed ") + (funcall expect 10 "mode for #chan to +v bob") + (funcall expect 10 "<+bob> alice: Fair as a text B") + (funcall expect 10 "<+alice> bob: Even as Apemantus") + (funcall expect 10 "mode for #chan to -v bob") + (funcall expect 10 "<-bob> alice: That's the way") + (funcall expect 10 "<+alice> Give it the beasts")) + + ;; If it had instead overwritten it, our two states would be + ;; out of sync. (See comment above.) + (ert-info ("/WHO output confirms server shadowed V status") + (erc-scenarios-common-say "/who #chan") + (funcall expect 10 '(: "bob" (+ " ") "H-")) + (funcall expect 10 "<-bob> alice: Remains in danger") + (erc-cmd-QUIT ""))))) + ;;; erc-scenarios-base-chan-modes.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 49c72836a22..b51bd67ae04 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -674,7 +674,7 @@ ;; checking if null beforehand. (should-not erc--parsed-prefix) (should (equal (erc--parsed-prefix) - #s(erc--parsed-prefix nil "qaohv" "~&@%+" + #s(erc--parsed-prefix nil "vhoaq" "+%@&~" ((?q . ?~) (?a . ?&) (?o . ?@) (?h . ?%) (?v . ?+))))) (let ((cached (should erc--parsed-prefix))) @@ -696,7 +696,7 @@ (should (equal expected (erc--parsed-prefix-alist erc--parsed-prefix))) (setq cached erc--parsed-prefix) (should (equal cached - #s(erc--parsed-prefix ("(ov)@+") "ov" "@+" + #s(erc--parsed-prefix ("(ov)@+") "vo" "+@" ((?o . ?@) (?v . ?+))))) ;; Second target buffer reuses cached value. (with-temp-buffer @@ -714,6 +714,88 @@ (erc-with-server-buffer erc--parsed-prefix)) '((?q . ?~) (?h . ?%))))))) +(ert-deftest erc--get-prefix-flag () + (erc-tests-common-make-server-buf (buffer-name)) + (should-not erc--parsed-prefix) + (should (= (erc--get-prefix-flag ?v) 1)) + (should (= (erc--get-prefix-flag ?h) 2)) + (should (= (erc--get-prefix-flag ?o) 4)) + (should (= (erc--get-prefix-flag ?a) 8)) + (should (= (erc--get-prefix-flag ?q) 16)) + + (ert-info ("With optional `from-prefix-p'") + (should (= (erc--get-prefix-flag ?+ nil 'fpp) 1)) + (should (= (erc--get-prefix-flag ?% nil 'fpp) 2)) + (should (= (erc--get-prefix-flag ?@ nil 'fpp) 4)) + (should (= (erc--get-prefix-flag ?& nil 'fpp) 8)) + (should (= (erc--get-prefix-flag ?~ nil 'fpp) 16))) + (should erc--parsed-prefix)) + +(ert-deftest erc--init-cusr-fallback-status () + ;; Fallback behavior active because no `erc--parsed-prefix'. + (should-not erc--parsed-prefix) + (should (= 0 (erc--init-cusr-fallback-status nil nil nil nil nil))) + (should (= 1 (erc--init-cusr-fallback-status t nil nil nil nil))) + (should (= 4 (erc--init-cusr-fallback-status nil nil t nil nil))) + (should-not erc--parsed-prefix) ; not created in non-ERC buffer. + + ;; Uses advertised server parameter. + (erc-tests-common-make-server-buf (buffer-name)) + (setq erc-server-parameters '(("PREFIX" . "(YqaohvV)!~&@%+-"))) + (should (= 0 (erc--init-cusr-fallback-status nil nil nil nil nil))) + (should (= 2 (erc--init-cusr-fallback-status t nil nil nil nil))) + (should (= 8 (erc--init-cusr-fallback-status nil nil t nil nil))) + (should erc--parsed-prefix)) + +(ert-deftest erc--compute-cusr-fallback-status () + ;; Useless without an `erc--parsed-prefix'. + (should (= 0 (erc--compute-cusr-fallback-status 0 nil nil nil nil nil))) + (should (= 0 (erc--compute-cusr-fallback-status 0 'on 'on 'on 'on 'on))) + + (erc-tests-common-make-server-buf (buffer-name)) + (should (= 0 (erc--compute-cusr-fallback-status 0 nil nil nil nil nil))) + (should (= 1 (erc--compute-cusr-fallback-status 0 'on nil nil nil nil))) + (should (= 1 (erc--compute-cusr-fallback-status 0 'on 'off 'off 'off 'off))) + (should (= 1 (erc--compute-cusr-fallback-status 1 'on 'off 'off 'off 'off))) + (should (= 1 (erc--compute-cusr-fallback-status 1 nil nil nil nil nil))) + (should (= 1 (erc--compute-cusr-fallback-status 3 nil 'off nil nil nil))) + (should (= 1 (erc--compute-cusr-fallback-status 7 nil 'off 'off nil nil))) + (should (= 4 (erc--compute-cusr-fallback-status 1 'off nil 'on nil nil)))) + +(ert-deftest erc--cusr-status-p () + (erc-tests-common-make-server-buf (buffer-name)) + (should-not erc--parsed-prefix) + (let ((cusr (make-erc-channel-user :voice t :op t))) + (should-not (erc--cusr-status-p cusr ?q)) + (should-not (erc--cusr-status-p cusr ?a)) + (should-not (erc--cusr-status-p cusr ?h)) + (should (erc--cusr-status-p cusr ?o)) + (should (erc--cusr-status-p cusr ?v))) + (should erc--parsed-prefix)) + +(ert-deftest erc--cusr-change-status () + (erc-tests-common-make-server-buf (buffer-name)) + (let ((cusr (make-erc-channel-user))) + (should-not (erc--cusr-status-p cusr ?o)) + (should-not (erc--cusr-status-p cusr ?v)) + (erc--cusr-change-status cusr ?o t) + (erc--cusr-change-status cusr ?v t) + (should (erc--cusr-status-p cusr ?o)) + (should (erc--cusr-status-p cusr ?v)) + + (ert-info ("Reset with optional param") + (erc--cusr-change-status cusr ?q t 'reset) + (should-not (erc--cusr-status-p cusr ?o)) + (should-not (erc--cusr-status-p cusr ?v)) + (should (erc--cusr-status-p cusr ?q))) + + (ert-info ("Clear with optional param") + (erc--cusr-change-status cusr ?v t) + (should (erc--cusr-status-p cusr ?v)) + (erc--cusr-change-status cusr ?q nil 'reset) + (should-not (erc--cusr-status-p cusr ?v)) + (should-not (erc--cusr-status-p cusr ?q))))) + ;; This exists as a reference to assert legacy behavior in order to ;; preserve and incorporate it as a fallback in the 5.6+ replacement. (ert-deftest erc-parse-modes () @@ -737,12 +819,9 @@ (should (equal (erc-parse-modes "-l") '(nil nil (("l" off nil)))))))) (ert-deftest erc--update-channel-modes () - (erc-mode) + (erc-tests-common-make-server-buf) (setq erc-channel-users (make-hash-table :test #'equal) - erc-server-users (make-hash-table :test #'equal) - erc--isupport-params (make-hash-table) erc--target (erc--target-from-string "#test")) - (erc-tests-common-init-server-proc "sleep" "1") (let ((orig-handle-fn (symbol-function 'erc--handle-channel-mode)) calls) @@ -1715,13 +1794,13 @@ ;; regardless of whether a command handler is summoned. (ert-deftest erc-process-input-line () - (let (erc-server-last-sent-time - erc-server-flood-queue - (orig-erc-cmd-MSG (symbol-function 'erc-cmd-MSG)) - (erc-default-recipients '("#chan")) + (erc-tests-common-make-server-buf) + (let ((orig-erc-cmd-MSG (symbol-function 'erc-cmd-MSG)) + (pop-flood-queue (lambda () (erc-with-server-buffer + (pop erc-server-flood-queue)))) calls) - (with-temp-buffer - (erc-tests-common-init-server-proc "sleep" "1") + (setq erc-server-current-nick "tester") + (with-current-buffer (erc--open-target "#chan") (cl-letf (((symbol-function 'erc-cmd-MSG) (lambda (line) (push line calls) @@ -1735,49 +1814,50 @@ (ert-info ("Baseline") (erc-process-input-line "/msg #chan hi\n") (should (equal (pop calls) " #chan hi")) - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :hi\r\n" . utf-8)))) (ert-info ("Quote preserves line intact") (erc-process-input-line "/QUOTE FAKE foo bar\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("FAKE foo bar\r\n" . utf-8)))) (ert-info ("Unknown command respected") (erc-process-input-line "/FAKE foo bar\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("FAKE foo bar\r\n" . utf-8)))) (ert-info ("Spaces preserved") (erc-process-input-line "/msg #chan hi you\n") (should (equal (pop calls) " #chan hi you")) - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :hi you\r\n" . utf-8)))) (ert-info ("Empty line honored") (erc-process-input-line "/msg #chan\n") (should (equal (pop calls) " #chan")) - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :\r\n" . utf-8))))) (ert-info ("Implicit cmd via `erc-send-input-line-function'") (ert-info ("Baseline") (erc-process-input-line "hi\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :hi\r\n" . utf-8)))) (ert-info ("Spaces preserved") (erc-process-input-line "hi you\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :hi you\r\n" . utf-8)))) (ert-info ("Empty line transmitted with injected-space kludge") (erc-process-input-line "\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan : \r\n" . utf-8)))) - (should-not calls)))))) + (should-not calls))))) + (erc-tests-common-kill-buffers)) (ert-deftest erc--get-inserted-msg-beg/basic () (erc-tests-common-assert-get-inserted-msg/basic diff --git a/test/lisp/erc/resources/base/modes/speaker-status.eld b/test/lisp/erc/resources/base/modes/speaker-status.eld new file mode 100644 index 00000000000..4a7d508e35c --- /dev/null +++ b/test/lisp/erc/resources/base/modes/speaker-status.eld @@ -0,0 +1,69 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER tester 0 * :unknown") + (0.00 ":irc.example.net NOTICE * :*** Looking up your hostname...") + (0.00 ":irc.example.net NOTICE tester :*** Could not resolve your hostname: Domain not found; using your IP address (10.0.2.100) instead.") + (0.09 ":irc.example.net 001 tester :Welcome to the foonet IRC Network tester!tester@10.0.2.100") + (0.01 ":irc.example.net 002 tester :Your host is irc.example.net, running version InspIRCd-3") + (0.01 ":irc.example.net 003 tester :This server was created 07:50:59 Jan 22 2024") + (0.03 ":irc.example.net 004 tester irc.example.net InspIRCd-3 BIRcgikorsw ACHIKMORTVXabcefghijklmnopqrstvyz :HIVXabefghjkloqvy") + (0.00 ":irc.example.net 005 tester ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=ascii CHANLIMIT=#:20 CHANMODES=IXbeg,k,Hfjl,ACKMORTcimnprstz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server") + (0.01 ":irc.example.net 005 tester EXTBAN=,ACORTUacjrwz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=foonet :are supported by this server") + (0.01 ":irc.example.net 005 tester NICKLEN=30 PREFIX=(yqaohvV)!~&@%+- SAFELIST SILENCE=32 STATUSMSG=!~&@%+- TOPICLEN=307 UHNAMES USERIP USERLEN=10 USERMODES=,,s,BIRcgikorw WHOX :are supported by this server") + (0.01 ":irc.example.net 251 tester :There are 2 users and 2 invisible on 2 servers") + (0.00 ":irc.example.net 252 tester 1 :operator(s) online") + (0.00 ":irc.example.net 253 tester 1 :unknown connections") + (0.00 ":irc.example.net 254 tester 2 :channels formed") + (0.00 ":irc.example.net 255 tester :I have 4 clients and 1 servers") + (0.00 ":irc.example.net 265 tester :Current local users: 4 Max: 5") + (0.00 ":irc.example.net 266 tester :Current global users: 4 Max: 5") + (0.00 ":irc.example.net 375 tester :irc.example.net message of the day") + (0.00 ":irc.example.net 372 tester : https://github.com/inspircd/inspircd-docker/issues") + (0.00 ":irc.example.net 372 tester : ") + (0.00 ":irc.example.net 372 tester : Have fun with the image!") + (0.00 ":irc.example.net 376 tester :End of message of the day.") + (0.00 ":irc.example.net 501 tester x :is not a recognised user mode.") + (0.00 ":NickServ!NickServ@services.int NOTICE tester :Welcome to foonet, tester! Here on foonet, we provide services to enable the registration of nicknames and channels! For details, type \2/msg NickServ help\2 and \2/msg ChanServ help\2.")) + +((mode 10 "MODE tester +i") + (0.01 ":tester!tester@10.0.2.100 MODE tester :+i")) + +((join 10 "JOIN #chan") + (0.02 ":tester!tester@10.0.2.100 JOIN :#chan") + (0.02 ":irc.example.net 353 tester = #chan :+alice @fsbot -bob !foop tester") + (0.03 ":irc.example.net 366 tester #chan :End of /NAMES list.") + (0.00 ":bob!bob@localhost PRIVMSG #chan :tester, welcome!") + (0.01 ":alice!alice@localhost PRIVMSG #chan :tester, welcome!")) + +((mode-chan 10 "MODE #chan") + (0.00 ":irc.example.net 324 tester #chan :+nt") + (0.01 ":irc.example.net 329 tester #chan :1705909863") + (0.03 ":bob!bob@localhost PRIVMSG #chan :alice: Of that which hath so faithfully been paid.") + (0.03 ":alice!alice@localhost PRIVMSG #chan :Hie you, make haste, for it grows very late.") + (0.03 ":foop!user@netadmin.example.net PRIVMSG #chan :hi") + ;; (0.07 ":alice!alice@localhost PRIVMSG #chan :bob: And make a clear way to the gods.") + ;; (0.04 ":bob!bob@localhost PRIVMSG #chan :Why, that they have; and bid them so be gone.") + ;; (0.08 ":bob!bob@localhost PRIVMSG #chan :alice: Now stay your strife: what shall be is dispatch'd.") + (0.06 ":foop!user@netadmin.example.net MODE #chan +v :bob") + (0.05 ":bob!bob@localhost PRIVMSG #chan :alice: Fair as a text B in a copy-book.") + (0.07 ":alice!alice@localhost PRIVMSG #chan :bob: Even as Apemantus does now; hate a lord with my heart.") + (0.03 ":bob!bob@localhost PRIVMSG #chan :Then here is a supplication for you. And when you come to him, at the first approach you must kneel; then kiss his foot; then deliver up your pigeons; and then look for your reward. I'll be at hand, sir; see you do it bravely.") + (0.05 ":foop!user@netadmin.example.net MODE #chan -v :bob") + (0.04 ":bob!bob@localhost PRIVMSG #chan :alice: That's the way: for women are light at midnight.") + (0.04 ":alice!alice@localhost PRIVMSG #chan :Give it the beasts, to be rid of the men.") + ;; (0.02 ":alice!alice@localhost PRIVMSG #chan :bob: Here comes young Master Ganymede, my new mistress's brother.") + ) + +((who-chan 10 "who #chan") + (0.03 ":irc.example.net 352 tester #chan alice localhost irc.example.net alice H+ :0 Irc bot based on irc3 http://irc3.readthedocs.io") + (0.03 ":irc.example.net 352 tester #chan fsbot localhost irc.example.net fsbot H@ :0 fsbot") + (0.01 ":irc.example.net 352 tester #chan bob localhost irc.example.net bob H- :0 Irc bot based on irc3 http://irc3.readthedocs.io") + (0.01 ":irc.example.net 352 tester #chan user netadmin.example.net irc.example.net foop H*! :0 unknown") + (0.01 ":irc.example.net 352 tester #chan tester 10.0.2.100 irc.example.net tester H :0 unknown") + (0.01 ":irc.example.net 315 tester #chan :End of /WHO list.") + ;; (0.09 ":bob!bob@localhost PRIVMSG #chan :alice: Shall nothing wrong him. Thus it is, general.") + ;; (0.04 ":alice!alice@localhost PRIVMSG #chan :bob: His father and I were soldiers together; to whom I have been often bound for no less than my life. Here comes the Briton: let him be so entertained amongst you as suits, with gentlemen of your knowing, to a stranger of his quality.") + (0.04 ":bob!bob@localhost PRIVMSG #chan :alice: Remains in danger of her former tooth.")) + +((quit 10 "QUIT :\2ERC\2") + (0.03 "ERROR :Closing link: (tester@10.0.2.100) [Quit: \2ERC\2 5.x (IRC client for GNU Emacs)]")) -- cgit v1.2.3 From aae131b8dd9ab3c3ceb23079796005873e107bee Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 16 Jan 2024 10:42:21 -0800 Subject: Force erc-speedbar to update on insertion * lisp/erc/erc-speedbar.el (erc-speedbar--force-update-interval-secs, erc-speedbar--last-ran): New variables. (erc-speedbar--reset-last-ran-on-timer, erc-speedbar--run-timer-on-post-insert): New functions. (erc-nickbar-mode, erc-nickbar-enable, erc-nickbar-disable): Use `erc-insert-post-hook' and `speedbar-timer-hook' to update the speedbar periodically. (Bug#63595) --- lisp/erc/erc-speedbar.el | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index 5fcea056e3e..e3d28aa60dd 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -545,6 +545,29 @@ The INDENT level is ignored." (speedbar-set-mode-line-format)))) (defvar erc-speedbar--shutting-down-p nil) +(defvar erc-speedbar--force-update-interval-secs 5 "Speedbar update period.") + +(defvar-local erc-speedbar--last-ran nil + "When non-nil, a lisp timestamp updated when the speedbar timer runs.") + +(defun erc-speedbar--run-timer-on-post-insert () + "Refresh speedbar if idle for `erc-speedbar--force-update-interval-secs'." + (when speedbar-buffer + (with-current-buffer speedbar-buffer + (when-let + ((dframe-timer) + ((erc--check-msg-prop 'erc--cmd 'PRIVMSG)) + (interval erc-speedbar--force-update-interval-secs) + ((or (null erc-speedbar--last-ran) + (time-less-p erc-speedbar--last-ran + (time-subtract (current-time) interval))))) + (run-at-time 0 nil #'dframe-timer-fn))))) + +(defun erc-speedbar--reset-last-ran-on-timer () + "Reset `erc-speedbar--last-ran'." + (when speedbar-buffer + (setf (buffer-local-value 'erc-speedbar--last-ran speedbar-buffer) + (current-time)))) ;;;###autoload(autoload 'erc-nickbar-mode "erc-speedbar" nil t) (define-erc-module nickbar nil @@ -559,6 +582,8 @@ raising of frames or the stealing of input focus. If you witness such a thing and can reproduce it, please file a bug report with \\[erc-bug]." ((add-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure) + (add-hook 'erc-insert-post-hook #'erc-speedbar--run-timer-on-post-insert) + (add-hook 'speedbar-timer-hook #'erc-speedbar--reset-last-ran-on-timer) (erc-speedbar--ensure) (unless (or erc--updating-modules-p (and-let* ((speedbar-buffer) @@ -569,6 +594,8 @@ such a thing and can reproduce it, please file a bug report with (with-current-buffer buf (erc-speedbar--ensure 'force))))) ((remove-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure) + (remove-hook 'erc-insert-post-hook #'erc-speedbar--run-timer-on-post-insert) + (remove-hook 'speedbar-timer-hook #'erc-speedbar--reset-last-ran-on-timer) (when erc-track-mode (setq erc-track--switch-fallback-blockers (remove '(derived-mode . speedbar-mode) -- cgit v1.2.3 From d6be068ffe8c151575ea784ce508711b41cec7c5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 1 Jan 2024 06:37:25 -0800 Subject: Add replacement-text field to erc-input struct * etc/ERC-NEWS: Promote `refoldp' slot from simulated to real. Mention new `substxt' slot of `erc-input' struct. * lisp/erc/erc-common.el (erc-input): Add `substxt' and `refoldp' slots. (erc--input-split): Move `refoldp' to "superclass". * lisp/erc/erc-goodies.el (erc--command-indicator-permit-insertion): Use `substxt' field instead of overloading `insertp'. (erc--command-indicator-display): Accept extra lines for compatibility. * lisp/erc/erc.el (erc-pre-send-functions): Revise doc. (erc--input-ensure-hook-context, erc-input-refoldp): Remove unused functions, originally meant to be new in ERC 5.6. (erc--run-send-hooks): Copy data from additional fields of `erc-input' object to `erc--input-split' workspace object. (erc--send-input-lines): Handle `substxt' field of `erc-input' object when it's non-nil. (Bug#68265) --- etc/ERC-NEWS | 14 ++++++-- lisp/erc/erc-common.el | 19 +++++++++-- lisp/erc/erc-goodies.el | 7 ++-- lisp/erc/erc.el | 89 +++++++++++++++++++++++-------------------------- 4 files changed, 74 insertions(+), 55 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index b673d36220a..f91d3fcb351 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -581,9 +581,17 @@ ERC now adjusts input lines to fall within allowed length limits before showing hook members the result. For compatibility, third-party code can request that the final input be adjusted again prior to being sent. To facilitate this, the 'erc-input' object -shared among hook members has gained a "phony" 'refoldp' slot that's -only accessible from 'erc-pre-send-functions'. See doc string for -details. +shared among hook members has gained a 'refoldp' slot. See doc string +for details. + +*** More flexibility in sending and displaying prompt input. +The abnormal hook 'erc-pre-send-functions' previously married outgoing +message text to its inserted representation in an ERC target buffer. +Going forward, users can populate the new slot 'substxt' with +alternate text to insert in place of the 'string' slot's contents, +which ERC still sends to the server. This dichotomy lets users +completely avoid the often fiddly 'erc-send-modify-hook' and friends +for use cases like language translation and subprotocol encoding. *** ERC's prompt survives the insertion of user input and messages. Previously, ERC's prompt and its input marker disappeared while diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index e39e414b290..abcdc4c8843 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -50,7 +50,23 @@ (declare-function widget-type "wid-edit" (widget)) (cl-defstruct erc-input - string insertp sendp) + "Object shared among members of `erc-pre-send-functions'. +Any use outside of the hook is not supported." + ( string "" :type string + :documentation "String to send and, without `substxt', insert. +ERC treats separate lines as separate messages.") + ( insertp nil :type boolean + :documentation "Whether to insert outgoing message. +When nil, ERC still sends `string'.") + ( sendp nil :type boolean + :documentation "Whether to send and (for compat reasons) insert. +To insert without sending, define a (slash) command.") + ( substxt nil :type (or function string null) + :documentation "Alternate string to insert without splitting. +The function form is for internal use.") + ( refoldp nil :type boolean + :documentation "Whether to resplit a possibly overlong `string'. +ERC only refolds `string', never `substxt'.")) (cl-defstruct (erc--input-split (:include erc-input (string "" :read-only t) @@ -58,7 +74,6 @@ (sendp (with-suppressed-warnings ((obsolete erc-send-this)) erc-send-this)))) - (refoldp nil :type boolean) (lines nil :type (list-of string)) (abortp nil :type (list-of symbol)) (cmdp nil :type boolean)) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index bf361ff91fb..8293994c5d4 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -583,15 +583,18 @@ Do nothing if the variable `erc-command-indicator' is nil." "Insert `erc-input' STATE's message if it's an echoed command." (cl-assert erc-command-indicator-mode) (when (erc--input-split-cmdp state) - (setf (erc--input-split-insertp state) #'erc--command-indicator-display) + (setf (erc--input-split-insertp state) t + (erc--input-split-substxt state) #'erc--command-indicator-display) (erc-send-distinguish-noncommands state))) ;; This function used to be called `erc-display-command'. It was ;; neutered in ERC 5.3.x (Emacs 24.5), commented out in 5.4, removed ;; in 5.5, and restored in 5.6. -(defun erc--command-indicator-display (line) +(defun erc--command-indicator-display (line &rest rest) "Insert command LINE as echoed input resembling that of REPLs and shells." (when erc-insert-this + (when rest + (setq line (string-join (cons line rest) "\n"))) (save-excursion (erc--assert-input-bounds) (let ((insert-position (marker-position (goto-char erc-insert-marker))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index fc6f51950e2..0da211a5f28 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1235,30 +1235,30 @@ anyway." (make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1") (defcustom erc-pre-send-functions nil - "Special hook run to possibly alter the string that is sent. -The functions are called with one argument, an `erc-input' struct, -and should alter that struct. + "Special hook to possibly alter the string to send and insert. +ERC calls the member functions with one argument, an `erc-input' +struct instance to modify as needed. -The struct has three slots: - - `string': The current input string. - `insertp': Whether the string should be inserted into the erc buffer. - `sendp': Whether the string should be sent to the irc server. - -And one \"phony\" slot only accessible by hook members at runtime: +The struct has five slots: - `refoldp': Whether the string should be re-split per protocol limits. + `string': String to send, originally from prompt input. + `insertp': Whether a string should be inserted in the buffer. + `sendp': Whether `string' should be sent to the IRC server. + `substxt': String to display (but not send) instead of `string'. + `refoldp': Whether to re-split `string' per protocol limits. This hook runs after protocol line splitting has taken place, so -the value of `string' is originally \"pre-filled\". If you need -ERC to refill the entire payload before sending it, set the phony -`refoldp' slot to a non-nil value. Note that this refilling is -only a convenience, and modules with special needs, such as -preserving \"preformatted\" text or encoding for subprotocol -\"tunneling\", should handle splitting manually." - :group 'erc - :type 'hook - :version "27.1") +the value of `string' comes \"pre-split\" according to the option +`erc-split-line-length'. If you need ERC to refill the entire +payload before sending it, set the `refoldp' slot to a non-nil +value. Note that this refilling is only a convenience, and +modules with special needs, such as preserving \"preformatted\" +text or encoding for subprotocol \"tunneling\", should handle +splitting manually and possibly also specify replacement text to +display via the `substxt' slot." + :package-version '(ERC . "5.3") + :group 'erc-hooks + :type 'hook) (define-obsolete-variable-alias 'erc--pre-send-split-functions 'erc--input-review-functions "30.1") @@ -7899,22 +7899,6 @@ When all lines are empty, remove all but the first." (setf (erc--input-split-lines state) (mapcan #'erc--split-line (erc--input-split-lines state))))) -(defun erc--input-ensure-hook-context () - (unless (erc--input-split-p erc--current-line-input-split) - (error "Invoked outside of `erc-pre-send-functions'"))) - -(defun erc-input-refoldp (_) - "Impersonate accessor for phony `erc-input' `refoldp' slot. -This function only works inside `erc-pre-send-functions' members." - (declare (gv-setter (lambda (v) - `(progn - (erc--input-ensure-hook-context) - (setf (erc--input-split-refoldp - erc--current-line-input-split) - ,v))))) - (erc--input-ensure-hook-context) - (erc--input-split-refoldp erc--current-line-input-split)) - (defun erc--run-send-hooks (lines-obj) "Run send-related hooks that operate on the entire prompt input. Sequester some of the back and forth involved in honoring old @@ -7932,12 +7916,17 @@ queue. Expect LINES-OBJ to be an `erc--input-split' object." (state (progn ;; This may change `str' and `erc-*-this'. (run-hook-with-args 'erc-send-pre-hook str) - (make-erc-input :string str - :insertp erc-insert-this - :sendp erc-send-this)))) + (make-erc-input + :string str + :insertp erc-insert-this + :sendp erc-send-this + :substxt (erc--input-split-substxt lines-obj) + :refoldp (erc--input-split-refoldp lines-obj))))) (run-hook-with-args 'erc-pre-send-functions state) (setf (erc--input-split-sendp lines-obj) (erc-input-sendp state) (erc--input-split-insertp lines-obj) (erc-input-insertp state) + (erc--input-split-substxt lines-obj) (erc-input-substxt state) + (erc--input-split-refoldp lines-obj) (erc-input-refoldp state) ;; See note in test of same name re trailing newlines. (erc--input-split-lines lines-obj) (let ((lines (split-string (erc-input-string state) @@ -7955,15 +7944,19 @@ queue. Expect LINES-OBJ to be an `erc--input-split' object." (defun erc--send-input-lines (lines-obj) "Send lines in `erc--input-split-lines' object LINES-OBJ." (when (erc--input-split-sendp lines-obj) - (dolist (line (erc--input-split-lines lines-obj)) - (when (erc--input-split-insertp lines-obj) - (if (eq (erc--input-split-insertp lines-obj) - 'erc--command-indicator-display) - (funcall (erc--input-split-insertp lines-obj) line) - (erc-display-msg line))) - (erc-process-input-line (concat line "\n") - (null erc-flood-protect) - (not (erc--input-split-cmdp lines-obj)))))) + (let ((insertp (erc--input-split-insertp lines-obj)) + (substxt (erc--input-split-substxt lines-obj))) + (when (and insertp substxt) + (setq insertp nil) + (if (functionp substxt) + (apply substxt (erc--input-split-lines lines-obj)) + (erc-display-msg substxt))) + (dolist (line (erc--input-split-lines lines-obj)) + (when insertp + (erc-display-msg line)) + (erc-process-input-line (concat line "\n") + (null erc-flood-protect) + (not (erc--input-split-cmdp lines-obj))))))) (defun erc-send-input (input &optional skip-ws-chk) "Treat INPUT as typed in by the user. -- cgit v1.2.3 From 1ba8d1c43702cf8ddd5d7159401d7b3ebc51f4fe Mon Sep 17 00:00:00 2001 From: Corwin Brust Date: Fri, 19 Jan 2024 23:51:36 -0600 Subject: Add more erc-message-type choices * lisp/erc/erc.el (erc-message-type): Add more of the possible IRC message types to customize widget for `erc-*hide-list'. New options have tags informed by these descriptions: https://modern.ircdocs.horse/#numerics (Bug#68601) --- lisp/erc/erc.el | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 0da211a5f28..edac1060c3e 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -386,6 +386,16 @@ If nil, only \"> \" will be shown." (const "PART") (const "QUIT") (const "MODE") + (const :tag "Away notices (RPL_AWAY 301)" "301") + (const :tag "Self back notice (REP_UNAWAY 305)" "305") + (const :tag "Self away notice (REP_NOWAWAY 306)" "306") + (const :tag "Channel modes on join (RPL_CHANNELMODEIS 324)" "324") + (const :tag "Channel creation time (RPL_CREATIONTIME 329)" "329") + (const :tag "Channel no-topic on join (RPL_NOTOPIC 331)" "331") + (const :tag "Channel topic on join (RPL_TOPIC 332)" "332") + (const :tag "Topic author and time on join (RPL_TOPICWHOTIME 333)" "333") + (const :tag "Invitation success notice (RPL_INVITING 341)" "341") + (const :tag "Channel member names (353 RPL_NAMEREPLY)" "353") (repeat :inline t :tag "Others" (string :tag "IRC Message Type")))) (defcustom erc-hide-list nil -- cgit v1.2.3 From 28c9c7cf464c87e90567f8b0e04f854163aa6187 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Wed, 24 Jan 2024 10:52:40 -0500 Subject: Fix next-line-completion for multi-line completions Previously it would not move out of a multi-line completion, and now it will. * lisp/simple.el (next-line-completion): Move to the completion start or end before going forward or backward lines. (bug#68688) --- lisp/simple.el | 20 +++++++++++++++++--- test/lisp/minibuffer-tests.el | 14 ++++++++++++++ 2 files changed, 31 insertions(+), 3 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index 692c0dacefc..4ffe159dc88 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -9940,6 +9940,20 @@ Also see the `completion-auto-wrap' variable." (interactive "p") (next-completion (- n))) +(defun completion--move-to-candidate-start () + "If in a completion candidate, move point to its start." + (when (and (get-text-property (point) 'mouse-face) + (not (bobp)) + (get-text-property (1- (point)) 'mouse-face)) + (goto-char (previous-single-property-change (point) 'mouse-face)))) + +(defun completion--move-to-candidate-end () + "If in a completion candidate, move point to its end." + (when (and (get-text-property (point) 'mouse-face) + (not (eobp)) + (get-text-property (1+ (point)) 'mouse-face)) + (goto-char (or (next-single-property-change (point) 'mouse-face) (point-max))))) + (defun next-completion (n) "Move to the next item in the completions buffer. With prefix argument N, move N items (negative N means move @@ -10029,9 +10043,7 @@ Also see the `completion-auto-wrap' variable." (if (get-text-property (point) 'mouse-face) ;; If in a completion, move to the start of it. - (when (and (not (bobp)) - (get-text-property (1- (point)) 'mouse-face)) - (goto-char (previous-single-property-change (point) 'mouse-face))) + (completion--move-to-candidate-start) ;; Try to move to the previous completion. (setq pos (previous-single-property-change (point) 'mouse-face)) (if pos @@ -10046,6 +10058,7 @@ Also see the `completion-auto-wrap' variable." (while (> n 0) (setq found nil pos nil column (current-column) line (line-number-at-pos)) + (completion--move-to-candidate-end) (while (and (not found) (eq (forward-line 1) 0) (not (eobp)) @@ -10070,6 +10083,7 @@ Also see the `completion-auto-wrap' variable." (while (< n 0) (setq found nil pos nil column (current-column) line (line-number-at-pos)) + (completion--move-to-candidate-start) (while (and (not found) (eq (forward-line -1) 0) (eq (move-to-column column) column)) diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index c1fe3032cb5..d104858b0d0 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -465,6 +465,20 @@ (previous-line-completion 4) (should (equal "ac" (get-text-property (point) 'completion--string)))))) +(ert-deftest completion-next-line-multline-test () + (let ((completion-auto-wrap t)) + (completing-read-with-minibuffer-setup + '("a\na" "a\nb" "ac") + (insert "a") + (minibuffer-completion-help) + (switch-to-completions) + (goto-char (point-min)) + (next-line-completion 5) + (should (equal "a\nb" (get-text-property (point) 'completion--string))) + (goto-char (point-min)) + (previous-line-completion 5) + (should (equal "a\nb" (get-text-property (point) 'completion--string)))))) + (ert-deftest completions-header-format-test () (let ((completion-show-help nil) (completions-header-format nil)) -- cgit v1.2.3 From b5d36efa5777e4cc6db1067d58224d676cedbdd3 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Wed, 24 Jan 2024 11:10:40 -0500 Subject: Update minibuffer-show-help based on minibuffer-visible-completions minibuffer-visible-completions makes some more convenient bindings available, but the help shown by minibuffer-show-help wasn't suggesting them. Now it is. * lisp/simple.el (completion-setup-function): Change help text when minibuffer-visible-completions is non-nil. (bug#68689) --- lisp/simple.el | 28 +++++++++++++++++++++------- 1 file changed, 21 insertions(+), 7 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index 4ffe159dc88..1157bd578fd 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10335,13 +10335,27 @@ Called from `temp-buffer-show-hook'." ;; Maybe insert help string. (when completion-show-help (goto-char (point-min)) - (insert (substitute-command-keys - (if (display-mouse-p) - "Click or type \\[minibuffer-choose-completion] on a completion to select it.\n" - "Type \\[minibuffer-choose-completion] on a completion to select it.\n"))) - (insert (substitute-command-keys - "Type \\[minibuffer-next-completion] or \\[minibuffer-previous-completion] \ -to move point between completions.\n\n")))))) + (if minibuffer-visible-completions + (let ((helps + (with-current-buffer (window-buffer (active-minibuffer-window)) + (list + (substitute-command-keys + (if (display-mouse-p) + "Click or type \\[minibuffer-choose-completion-or-exit] on a completion to select it.\n" + "Type \\[minibuffer-choose-completion-or-exit] on a completion to select it.\n")) + (substitute-command-keys + "Type \\[minibuffer-next-completion], \\[minibuffer-previous-completion], \ +\\[minibuffer-next-line-completion], \\[minibuffer-previous-line-completion] \ +to move point between completions.\n\n"))))) + (dolist (help helps) + (insert help))) + (insert (substitute-command-keys + (if (display-mouse-p) + "Click or type \\[minibuffer-choose-completion] on a completion to select it.\n" + "Type \\[minibuffer-choose-completion] on a completion to select it.\n"))) + (insert (substitute-command-keys + "Type \\[minibuffer-next-completion] or \\[minibuffer-previous-completion] \ +to move point between completions.\n\n"))))))) (add-hook 'completion-setup-hook #'completion-setup-function) -- cgit v1.2.3 From 5d88c98e7c101ebad68b562334020b8c082c2ca5 Mon Sep 17 00:00:00 2001 From: João Távora Date: Thu, 25 Jan 2024 12:10:40 +0000 Subject: Eglot: fix bug introduced when "fixing" middle-of-symbol completions MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Culprit: commit a6ef458e3831001b0acad57cf8fa75b77a4aff3f Author: João Távora Date: Tue Dec 26 00:31:29 2023 +0000 Eglot: partial fix for middle-of-symbol completions The decision to restore the buffer state to when the last LSP completion set was invoked is rock-solid (because that the state those completions' edits apply to). However, when caching the LSP completions across multiple eglot-completion-at-point calls, we must make sure to also restore the values of the local values, such as 'bounds-string'. This allows us to do that restoration. * lisp/progmodes/eglot.el (eglot-completion-at-point): Also restore bounds-string from capf session cache. Github-reference: https://github.com/joaotavora/eglot/issues/1349 --- lisp/progmodes/eglot.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index c5fbf5eb9d5..f8d96051606 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -3125,7 +3125,8 @@ for which LSP on-type-formatting should be requested." items))) ;; (trace-values "Requested" (length proxies) cachep bounds) (setq eglot--capf-session - (if cachep (list bounds retval resolved orig-pos) :none)) + (if cachep (list bounds retval resolved orig-pos + bounds-string) :none)) (setq local-cache retval))))) (resolve-maybe ;; Maybe completion/resolve JSON object `lsp-comp' into @@ -3145,7 +3146,8 @@ for which LSP on-type-formatting should be requested." (>= (cdr bounds) (cdr (nth 0 eglot--capf-session)))) (setq local-cache (nth 1 eglot--capf-session) resolved (nth 2 eglot--capf-session) - orig-pos (nth 3 eglot--capf-session)) + orig-pos (nth 3 eglot--capf-session) + bounds-string (nth 4 eglot--capf-session)) ;; (trace-values "Recalling cache" (length local-cache) bounds orig-pos) ) (list -- cgit v1.2.3 From b014bca833a17f5b2258e88115f03cffa983d0bd Mon Sep 17 00:00:00 2001 From: João Távora Date: Thu, 25 Jan 2024 12:18:58 +0000 Subject: Eglot: bump to 1.17 * etc/EGLOT-NEWS: Update. * lisp/progmodes/eglot.el (Version): Bump to 1.17 (Package-Requires): Bump jsonrpc depedency to 1.24 --- etc/EGLOT-NEWS | 13 +++++++++++++ lisp/progmodes/eglot.el | 4 ++-- 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 1f913f81236..12e7d3f6b9b 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -20,6 +20,19 @@ https://github.com/joaotavora/eglot/issues/1234. * Changes in upcoming Eglot + +* Changes in Eglot 1.17 (25/1/2024) + +** Fixes to completion (github#847, github#1349) + +** Fix code-action gathering for some servers (github#847) + +** Experimental support for Eglot-only subprojects + +Until project.el's support for subprojects improves, github#1337 +describes a reasonably sane way to configure nested sub-projects +within a larger one just for Eglot purposes. + * Changes in Eglot 1.16 (27/12/2023) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index f8d96051606..40837074573 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2,12 +2,12 @@ ;; Copyright (C) 2018-2024 Free Software Foundation, Inc. -;; Version: 1.16 +;; Version: 1.17 ;; Author: João Távora ;; Maintainer: João Távora ;; URL: https://github.com/joaotavora/eglot ;; Keywords: convenience, languages -;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.23") (flymake "1.2.1") (project "0.9.8") (xref "1.6.2") (eldoc "1.14.0") (seq "2.23") (external-completion "0.1")) +;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.24") (flymake "1.2.1") (project "0.9.8") (xref "1.6.2") (eldoc "1.14.0") (seq "2.23") (external-completion "0.1")) ;; This is a GNU ELPA :core package. Avoid adding functionality ;; that is not available in the version of Emacs recorded above or any -- cgit v1.2.3 From 5d91cbf9a57d519968a6fb3ad6edfbf9709574a5 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 25 Jan 2024 14:37:17 +0100 Subject: * Make comp tests robust against sxhash-equal internal changes * test/src/comp-tests.el (cl-seq): Require. (comp-tests--types-equal): New function. (comp-tests-check-ret-type-spec): Make use of. --- test/src/comp-tests.el | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 0aa9e76fa2d..4e7ca88d197 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -28,6 +28,7 @@ (require 'ert) (require 'ert-x) (require 'cl-lib) +(require 'cl-seq) (require 'comp) (require 'comp-cstr) @@ -903,14 +904,26 @@ Return a list of results." (should (subr-native-elisp-p (symbol-function 'comp-tests-fw-prop-1-f))) (should (= (comp-tests-fw-prop-1-f) 6)))) +(defun comp-tests--types-equal (t1 t2) + "Whether the types T1 and T2 are equal." + (or (equal t1 t2) ; optimisation for the common case + (and (consp t1) (consp t2) + (eq (car t1) (car t2)) + (if (memq (car t1) '(and or member)) + (null (cl-set-exclusive-or (cdr t1) (cdr t2) + :test #'comp-tests--types-equal)) + (and (= (length t1) (length t2)) + (cl-every #'comp-tests--types-equal (cdr t1) (cdr t2))))))) + (defun comp-tests-check-ret-type-spec (func-form ret-type) (let ((lexical-binding t) (native-comp-speed 2) (f-name (cl-second func-form))) (eval func-form t) (native-compile f-name) - (should (equal (cl-third (subr-type (symbol-function f-name))) - ret-type)))) + (should (comp-tests--types-equal + (cl-third (subr-type (symbol-function f-name))) + ret-type)))) (cl-eval-when (compile eval load) (cl-defstruct comp-foo a b) -- cgit v1.2.3 From e13653ae5cb86c26e5b9ae0c3bb5753ebb7bc98c Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 24 Jan 2024 10:50:46 +0100 Subject: ; * .mailmap: Change own email address. --- .mailmap | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.mailmap b/.mailmap index 5d80e4aa082..18e55b0d1e7 100644 --- a/.mailmap +++ b/.mailmap @@ -28,6 +28,7 @@ Arash Esbati Arash Esbati Artur Malabarba Artur Malabarba Artur Malabarba +Basil L. Contovounesios Bastien Guerry Bastien Guerry Bastien Guerry @@ -163,8 +164,8 @@ Ronnie Schnell Ryan C. Thompson Sam Steingold Simen Heggestøyl -Simen Heggestøyl Simen Heggestøyl +Simen Heggestøyl Simon Josefsson Stefan Kangas Stefan Monnier -- cgit v1.2.3 From a8cfe3bda8b8008071818d6ac5e5103002ed6c08 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Thu, 25 Jan 2024 15:57:54 +0100 Subject: ; Update 'struct charset' hash for CHECK_STRUCTS This follows commit 33b8d5b6c5 of 2024-01-23 "(struct charset): Remove dependency on hash-table internals". --- src/pdumper.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/pdumper.c b/src/pdumper.c index 8907d25cc13..f42d1777371 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -3213,7 +3213,7 @@ dump_object_for_offset (struct dump_context *ctx, Lisp_Object object) static dump_off dump_charset (struct dump_context *ctx, int cs_i) { -#if CHECK_STRUCTS && !defined (HASH_charset_317C49E291) +#if CHECK_STRUCTS && !defined (HASH_charset_E31F4B5D96) # error "charset changed. See CHECK_STRUCTS comment in config.h." #endif dump_align_output (ctx, alignof (struct charset)); -- cgit v1.2.3 From b07265f8eed74dda792e13062baae94319484b4b Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 25 Jan 2024 19:38:03 +0200 Subject: * lisp/dired.el (dired--move-to-next-line): Improve to avoid an infinite loop. An infinite loop is possible in a directory without files and subdirectories, where even lines with . and .. are omitted, so 'dired-between-files' is true for all Dired lines. For the case of dired-movement-style=cycle a guard is triggered when the loop wraps twice while the value 'arg' is not changing. And for the case of dired-movement-style=bounded a guard is triggered when point doesn't move while trying to go back to the last non-empty line. --- lisp/dired.el | 29 +++++++++++++++++++++-------- 1 file changed, 21 insertions(+), 8 deletions(-) diff --git a/lisp/dired.el b/lisp/dired.el index 69fa15dde73..cef93ab757c 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2817,7 +2817,9 @@ is controlled by `dired-movement-style'." (dired--trivial-next-line arg))) (defun dired--move-to-next-line (arg jumpfun) - (let ((old-position (progn + (let ((wrapped nil) + (old-arg arg) + (old-position (progn ;; It's always true that we should move ;; to the filename when possible. (dired-move-to-filename) @@ -2832,16 +2834,27 @@ is controlled by `dired-movement-style'." (when (= old-position (point)) ;; Now point is at beginning/end of movable area, ;; but it still wants to move farther. - (if (eq dired-movement-style 'cycle) - ;; `cycle': go to the other end. + (cond + ;; `cycle': go to the other end. + ((eq dired-movement-style 'cycle) + ;; Argument not changing on the second wrap + ;; means infinite loop with no files found. + (if (and wrapped (eq old-arg arg)) + (setq arg 0) (goto-char (if (cl-plusp moving-down) (point-min) - (point-max))) - ;; `bounded': go back to the last non-empty line. - (while (dired-between-files) - (funcall jumpfun (- moving-down))) + (point-max)))) + (setq wrapped t)) + ;; `bounded': go back to the last non-empty line. + ((eq dired-movement-style 'bounded) + (while (and (dired-between-files) (not (zerop arg))) + (funcall jumpfun (- moving-down)) + ;; Point not moving means infinite loop. + (if (= old-position (point)) + (setq arg 0) + (setq old-position (point)))) ;; Encountered a boundary, so let's stop movement. - (setq arg moving-down))) + (setq arg (if (dired-between-files) 0 moving-down))))) (unless (dired-between-files) ;; Has moved to a non-empty line. This movement does ;; make sense. -- cgit v1.2.3 From d22a3e5afe75c9f4a18926cce16c1a13fa912df2 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 25 Jan 2024 19:52:08 +0200 Subject: * lisp/simple.el (next-line-completion): Better handing of group lines. Simplify to not compare the result of 'move-to-column' with the value 'column'. Such comparison prevented from moving over lines without completion candidates such as group lines (bug#68688). * test/lisp/minibuffer-tests.el (completions-group-navigation-test): Add more group candidates to create more columns and to test moving over group lines and over columns without candidates. --- lisp/simple.el | 4 +-- test/lisp/minibuffer-tests.el | 64 +++++++++++++++++++++++++++++++------------ 2 files changed, 48 insertions(+), 20 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index 1157bd578fd..8246b9cab81 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10062,7 +10062,7 @@ Also see the `completion-auto-wrap' variable." (while (and (not found) (eq (forward-line 1) 0) (not (eobp)) - (eq (move-to-column column) column)) + (move-to-column column)) (when (get-text-property (point) 'mouse-face) (setq found t))) (when (not found) @@ -10086,7 +10086,7 @@ Also see the `completion-auto-wrap' variable." (completion--move-to-candidate-start) (while (and (not found) (eq (forward-line -1) 0) - (eq (move-to-column column) column)) + (move-to-column column)) (when (get-text-property (point) 'mouse-face) (setq found t))) (when (not found) diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index d104858b0d0..07c4dbc3197 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -565,35 +565,63 @@ (if transform name (pcase name - (`"aa" "Group 1") - (`"ab" "Group 2") - (`"ac" "Group 3"))))) + (`"aa1" "Group 1") + (`"aa2" "Group 1") + (`"aa3" "Group 1") + (`"aa4" "Group 1") + (`"ab1" "Group 2") + (`"ac1" "Group 3") + (`"ac2" "Group 3"))))) (category . unicode-name)) - (complete-with-action action '("aa" "ab" "ac") string pred))) + (complete-with-action action '("aa1" "aa2" "aa3" "aa4" "ab1" "ac1" "ac2") + string pred))) (insert "a") (minibuffer-completion-help) (switch-to-completions) - (should (equal "aa" (get-text-property (point) 'completion--string))) + (should (equal "aa1" (get-text-property (point) 'completion--string))) (let ((completion-auto-wrap t)) - (next-completion 3)) - (should (equal "aa" (get-text-property (point) 'completion--string))) + (next-completion 7)) + (should (equal "aa1" (get-text-property (point) 'completion--string))) (let ((completion-auto-wrap nil)) - (next-completion 3)) - (should (equal "ac" (get-text-property (point) 'completion--string))) + (next-completion 7)) + (should (equal "ac2" (get-text-property (point) 'completion--string))) - (first-completion) (let ((completion-auto-wrap t)) + ;; First column + (first-completion) (next-line-completion 1) - (should (equal "ab" (get-text-property (point) 'completion--string))) - (next-line-completion 2) - (should (equal "aa" (get-text-property (point) 'completion--string))) + (should (equal "aa4" (get-text-property (point) 'completion--string))) + (next-line-completion 3) + (should (equal "aa1" (get-text-property (point) 'completion--string))) (previous-line-completion 2) - (should (equal "ab" (get-text-property (point) 'completion--string)))) + (should (equal "ab1" (get-text-property (point) 'completion--string))) + + ;; Second column + (first-completion) + (next-completion 1) + (should (equal "aa2" (get-text-property (point) 'completion--string))) + (next-line-completion 1) + (should (equal "ac2" (get-text-property (point) 'completion--string))) + (next-line-completion 1) + (should (equal "aa2" (get-text-property (point) 'completion--string))) + (previous-line-completion 1) + (should (equal "ac2" (get-text-property (point) 'completion--string))) + (previous-line-completion 1) + (should (equal "aa2" (get-text-property (point) 'completion--string))) + + ;; Third column + (first-completion) + (next-completion 2) + (should (equal "aa3" (get-text-property (point) 'completion--string))) + (next-line-completion 1) + (should (equal "aa3" (get-text-property (point) 'completion--string)))) + (let ((completion-auto-wrap nil)) - (next-line-completion 3) - (should (equal "ac" (get-text-property (point) 'completion--string))) - (previous-line-completion 3) - (should (equal "aa" (get-text-property (point) 'completion--string)))))) + (first-completion) + (next-line-completion 7) + (should (equal "ac2" (get-text-property (point) 'completion--string))) + (previous-line-completion 7) + (should (equal "aa1" (get-text-property (point) 'completion--string)))))) (provide 'minibuffer-tests) ;;; minibuffer-tests.el ends here -- cgit v1.2.3 From 4e260bfc47e5b507df1db218f49729fbae91900c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 25 Jan 2024 14:24:20 -0500 Subject: * lisp/emacs-lisp/cl-generic.el (cl--generic-compiler): Clarify the test Use `compiled-function-p`. --- lisp/emacs-lisp/cl-generic.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 48f5c06e390..bdccdcc48ce 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -672,7 +672,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined ;; compiled. Otherwise the byte-compiler and all the code on ;; which it depends needs to be usable before cl-generic is loaded, ;; which imposes a significant burden on the bootstrap. - (if (consp (lambda (x) (+ x 1))) + (if (not (compiled-function-p (lambda (x) (+ x 1)))) (lambda (exp) (eval exp t)) ;; But do byte-compile the dispatchers once bootstrap is passed: ;; the performance difference is substantial (like a 5x speedup on -- cgit v1.2.3 From 22a58fccb763da6ec52f4bea98f91647b71ee1f0 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Fri, 26 Jan 2024 02:52:35 +0200 Subject: project--read-project-list: Handle corrupted file contents * lisp/progmodes/project.el (project--read-project-list): Handle the 'end-of-file' error (bug#68546). --- lisp/progmodes/project.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index ab4504fa027..da782ad5537 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1707,7 +1707,10 @@ With some possible metadata (to be decided).") (let ((name (car elem))) (list (if (file-remote-p name) name (abbreviate-file-name name))))) - (read (current-buffer)))))) + (condition-case nil + (read (current-buffer)) + (end-of-file + (warn "Failed to read the projects list file due to unexpected EOF"))))))) (unless (seq-every-p (lambda (elt) (stringp (car-safe elt))) project--list) -- cgit v1.2.3 From 737d46e04d73dbad84bf0225cebb1c936ff89365 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Fri, 26 Jan 2024 03:00:04 +0200 Subject: python--treesit-syntax-propertize: Fix edits in the middle * lisp/progmodes/python.el (python--treesit-syntax-propertize): Process the beginning and the end of the triple-quoted string's delimiters separately. Among other things, that still works when the beginning is outside of the propertized region (bug#68445). --- lisp/progmodes/python.el | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index e2f614f52c2..41f612c8b1c 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1359,15 +1359,15 @@ For NODE, OVERRIDE, START, END, and ARGS, see (save-excursion (goto-char start) (while (re-search-forward (rx (or "\"\"\"" "'''")) end t) - (let ((node (treesit-node-at (point)))) - ;; The triple quotes surround a non-empty string. - (when (equal (treesit-node-type node) "string_content") - (let ((start (treesit-node-start node)) - (end (treesit-node-end node))) - (put-text-property (1- start) start - 'syntax-table (string-to-syntax "|")) - (put-text-property end (min (1+ end) (point-max)) - 'syntax-table (string-to-syntax "|")))))))) + (let ((node (treesit-node-at (- (point) 3)))) + ;; Handle triple-quoted strings. + (pcase (treesit-node-type node) + ("string_start" + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax "|"))) + ("string_end" + (put-text-property (- (point) 3) (- (point) 2) + 'syntax-table (string-to-syntax "|")))))))) ;;; Indentation -- cgit v1.2.3 From 4834be0949e13a728b69ab97ac9c8a0dbec65f3a Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Thu, 25 Jan 2024 17:12:28 -0800 Subject: ; For compatibility, eshell/make should print to Eshell unless backgrounded * lisp/eshell/em-unix.el (eshell/make): Pass 'plain' to eshell-compile when in the foreground (bug#68724). --- lisp/eshell/em-unix.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 75afaf1c104..b066e9eeb8e 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -741,7 +741,7 @@ Fallback to standard make when called synchronously." (eshell-compile "make" args ;; Use plain output unless we're executing in the ;; background. - (not eshell-current-subjob-p))) + (unless eshell-current-subjob-p 'plain))) (put 'eshell/make 'eshell-no-numeric-conversions t) -- cgit v1.2.3 From 65829b27ca4898ff0905a8124980243977a1382f Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Thu, 25 Jan 2024 17:54:13 -0800 Subject: Improve handling of local variable settings in Eshell This ensures that these commands work the same as normal commands, aside from making environment variable settings local to that command. Among other things, this means that "VAR=value cd dir/" now changes the directory correctly. * lisp/eshell/esh-var.el (eshell-in-local-scope-p) (eshell-local-variable-bindings): New variables. (eshell-var-initialize, eshell-set-variable): Use 'eshell-local-variable-bindings'. (eshell-handle-local-variables): Don't use 'eshell-as-subcommand'. * test/lisp/eshell/esh-var-tests.el (esh-var-test/local-variables/cd): New test. --- lisp/eshell/esh-var.el | 57 +++++++++++++++++++++------------------ test/lisp/eshell/esh-var-tests.el | 8 ++++++ 2 files changed, 39 insertions(+), 26 deletions(-) diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index ae0b18cd13a..1d90fbdd8ee 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -255,6 +255,20 @@ copied (a.k.a. \"exported\") to the environment of created subprocesses." (defvar-keymap eshell-var-mode-map "C-c M-v" #'eshell-insert-envvar) +;;; Internal Variables: + +(defvar eshell-in-local-scope-p nil + "Non-nil if the current command has a local variable scope. +This is set to t in `eshell-local-variable-bindings' (which see).") + +(defvar eshell-local-variable-bindings + '((eshell-in-local-scope-p t) + (process-environment (eshell-copy-environment)) + (eshell-variable-aliases-list eshell-variable-aliases-list) + (eshell-path-env-list eshell-path-env-list) + (comint-pager comint-pager)) + "A list of `let' bindings for local variable (and subcommand) environments.") + ;;; Functions: (define-minor-mode eshell-var-mode @@ -271,12 +285,8 @@ copied (a.k.a. \"exported\") to the environment of created subprocesses." (setq-local process-environment (eshell-copy-environment))) (make-local-variable 'comint-pager) (setq-local eshell-subcommand-bindings - (append - '((process-environment (eshell-copy-environment)) - (eshell-variable-aliases-list eshell-variable-aliases-list) - (eshell-path-env-list eshell-path-env-list) - (comint-pager comint-pager)) - eshell-subcommand-bindings)) + (append eshell-local-variable-bindings + eshell-subcommand-bindings)) (setq-local eshell-special-chars-inside-quoting (append eshell-special-chars-inside-quoting '(?$))) @@ -296,30 +306,25 @@ copied (a.k.a. \"exported\") to the environment of created subprocesses." (defun eshell-handle-local-variables () "Allow for the syntax `VAR=val '." - ;; Eshell handles local variable settings (e.g. 'CFLAGS=-O2 make') - ;; by making the whole command into a subcommand, and calling - ;; `eshell-set-variable' immediately before the command is invoked. - ;; This means that 'FOO=x cd bar' won't work exactly as expected, - ;; but that is by no means a typical use of local environment - ;; variables. + ;; Handle local variable settings by let-binding the entries in + ;; `eshell-local-variable-bindings' and calling `eshell-set-variable' + ;; for each variable before the command is invoked. (let ((setvar "\\`\\([A-Za-z_][A-Za-z0-9_]*\\)=\\(.*\\)\\'") (command eshell-last-command-name) (args eshell-last-arguments)) (when (and (stringp command) (string-match setvar command)) (throw 'eshell-replace-command - `(eshell-as-subcommand - (progn - ,@(let (locals) - (while (and (stringp command) - (string-match setvar command)) - (push `(eshell-set-variable - ,(match-string 1 command) - ,(match-string 2 command)) - locals) - (setq command (pop args))) - (nreverse locals)) - (eshell-named-command ,command ,(list 'quote args))) - ))))) + `(let ,eshell-local-variable-bindings + ,@(let (locals) + (while (and (stringp command) + (string-match setvar command)) + (push `(eshell-set-variable + ,(match-string 1 command) + ,(match-string 2 command)) + locals) + (setq command (pop args))) + (nreverse locals)) + (eshell-named-command ,command ,(list 'quote args))))))) (defun eshell-interpolate-variable () "Parse a variable interpolation. @@ -709,7 +714,7 @@ to a Lisp variable)." ((functionp target) (funcall target nil value)) ((null target) - (unless eshell-in-subcommand-p + (unless eshell-in-local-scope-p (error "Variable `%s' is not settable" (eshell-stringify name))) (push `(,name ,(lambda () value) t t) eshell-variable-aliases-list) diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el index 39c278a6277..bb3d18abf6d 100644 --- a/test/lisp/eshell/esh-var-tests.el +++ b/test/lisp/eshell/esh-var-tests.el @@ -653,6 +653,14 @@ nil, use FUNCTION instead." "VAR=hello\n") (should (equal (getenv "VAR") "value")))) +(ert-deftest esh-var-test/local-variables/cd () + "Test that \"VAR=value cd DIR\" properly changes the directory." + (let ((parent-directory (file-name-directory + (directory-file-name default-directory)))) + (with-temp-eshell + (eshell-insert-command "VAR=hello cd ..") + (should (equal default-directory parent-directory))))) + ;; Variable aliases -- cgit v1.2.3 From 16831e290ed29f5f70dfe144ec63c583527485e8 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 26 Jan 2024 11:24:51 +0800 Subject: Avert race condition between window attachment and buffer swap * java/org/gnu/emacs/EmacsView.java (swapBuffers): Synchronize such that code cannot execute between the bitmap's being loaded and being transferred to surfaceView. (onDetachedFromWindow): Recycle bitmap after the surface view is reset. * java/org/gnu/emacs/EmacsWindow.java (recreateActivity): * src/android.c (android_init_emacs_window) (android_recreate_activity): * src/androidfns.c (Fandroid_recreate_activity) (syms_of_androidfns): New functions for debugging window attachment. * src/androidgui.h: Update prototypes. --- java/org/gnu/emacs/EmacsView.java | 27 +++++++++++++++------------ java/org/gnu/emacs/EmacsWindow.java | 28 ++++++++++++++++++++++++++++ src/android.c | 21 ++++++++++++++++++++- src/androidfns.c | 19 +++++++++++++++++++ src/androidgui.h | 1 + 5 files changed, 83 insertions(+), 13 deletions(-) diff --git a/java/org/gnu/emacs/EmacsView.java b/java/org/gnu/emacs/EmacsView.java index 136d8abc713..8398e4b784c 100644 --- a/java/org/gnu/emacs/EmacsView.java +++ b/java/org/gnu/emacs/EmacsView.java @@ -456,7 +456,6 @@ public final class EmacsView extends ViewGroup { Canvas canvas; Rect damageRect; - Bitmap bitmap; /* Make sure this function is called only from the Emacs thread. */ @@ -474,11 +473,12 @@ public final class EmacsView extends ViewGroup damageRect = damageRegion.getBounds (); damageRegion.setEmpty (); - bitmap = getBitmap (); - - /* Transfer the bitmap to the surface view, then invalidate - it. */ - surfaceView.setBitmap (bitmap, damageRect); + synchronized (this) + { + /* Transfer the bitmap to the surface view, then invalidate + it. */ + surfaceView.setBitmap (bitmap, damageRect); + } } @Override @@ -724,17 +724,20 @@ public final class EmacsView extends ViewGroup public synchronized void onDetachedFromWindow () { - isAttachedToWindow = false; - - /* Recycle the bitmap and call GC. */ - - if (bitmap != null) - bitmap.recycle (); + Bitmap savedBitmap; + savedBitmap = bitmap; + isAttachedToWindow = false; bitmap = null; canvas = null; + surfaceView.setBitmap (null, null); + /* Recycle the bitmap and call GC. */ + + if (savedBitmap != null) + savedBitmap.recycle (); + /* Collect the bitmap storage; it could be large. */ Runtime.getRuntime ().gc (); diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index 207bd22c538..304304a328b 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java @@ -1784,4 +1784,32 @@ public final class EmacsWindow extends EmacsHandleObject return true; } + + + + /* Miscellaneous functions for debugging graphics code. */ + + /* Recreate the activity to which this window is attached, if any. + This is nonfunctional on Android 2.3.7 and earlier. */ + + public void + recreateActivity () + { + final EmacsWindowAttachmentManager.WindowConsumer attached; + + attached = this.attached; + + if (Build.VERSION.SDK_INT < Build.VERSION_CODES.HONEYCOMB) + return; + + view.post (new Runnable () { + @Override + public void + run () + { + if (attached instanceof EmacsActivity) + ((EmacsActivity) attached).recreate (); + } + }); + } }; diff --git a/src/android.c b/src/android.c index 509f30a759b..51eb85a97e8 100644 --- a/src/android.c +++ b/src/android.c @@ -111,6 +111,7 @@ struct android_emacs_window jmethodID set_dont_focus_on_map; jmethodID define_cursor; jmethodID damage_rect; + jmethodID recreate_activity; }; struct android_emacs_cursor @@ -1802,12 +1803,12 @@ android_init_emacs_window (void) FIND_METHOD (set_dont_accept_focus, "setDontAcceptFocus", "(Z)V"); FIND_METHOD (define_cursor, "defineCursor", "(Lorg/gnu/emacs/EmacsCursor;)V"); - /* In spite of the declaration of this function being located within EmacsDrawable, the ID of the `damage_rect' method is retrieved from EmacsWindow, which avoids virtual function dispatch within android_damage_window. */ FIND_METHOD (damage_rect, "damageRect", "(IIII)V"); + FIND_METHOD (recreate_activity, "recreateActivity", "()V"); #undef FIND_METHOD } @@ -6638,6 +6639,24 @@ android_request_storage_access (void) android_exception_check (); } +/* Recreate the activity to which WINDOW is attached to debug graphics + code executed in response to window attachment. */ + +void +android_recreate_activity (android_window window) +{ + jobject object; + jmethodID method; + + object = android_resolve_handle (window, ANDROID_HANDLE_WINDOW); + method = window_class.recreate_activity; + + (*android_java_env)->CallNonvirtualVoidMethod (android_java_env, object, + window_class.class, + method); + android_exception_check (); +} + /* The thread from which a query against a thread is currently being diff --git a/src/androidfns.c b/src/androidfns.c index 34f1f533684..eaecb78338b 100644 --- a/src/androidfns.c +++ b/src/androidfns.c @@ -3164,6 +3164,24 @@ android_set_preeditarea (struct window *w, int x, int y) y + w->phys_cursor_height); } + + +/* Debugging. */ + +DEFUN ("android-recreate-activity", Fandroid_recreate_activity, + Sandroid_recreate_activity, 0, 0, "", + doc: /* Recreate the activity attached to the current frame. +This function exists for debugging purposes and is of no interest to +users. */) + (void) +{ + struct frame *f; + + f = decode_window_system_frame (Qnil); + android_recreate_activity (FRAME_ANDROID_WINDOW (f)); + return Qnil; +} + #endif /* !ANDROID_STUBIFY */ @@ -3550,6 +3568,7 @@ language to be US English if LANGUAGE is empty. */); defsubr (&Sandroid_request_directory_access); defsubr (&Sandroid_external_storage_available_p); defsubr (&Sandroid_request_storage_access); + defsubr (&Sandroid_recreate_activity); tip_timer = Qnil; staticpro (&tip_timer); diff --git a/src/androidgui.h b/src/androidgui.h index 69efd393d55..89317581191 100644 --- a/src/androidgui.h +++ b/src/androidgui.h @@ -708,6 +708,7 @@ extern void android_translate_coordinates (android_window, int, extern int android_wc_lookup_string (android_key_pressed_event *, wchar_t *, int, int *, enum android_lookup_status *); +extern void android_recreate_activity (android_window); extern void android_update_ic (android_window, ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t); extern void android_reset_ic (android_window, enum android_ic_mode); -- cgit v1.2.3 From f897b82ab16ac92e7fd800f75b00e55762b0df31 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Thu, 25 Jan 2024 20:54:48 -0800 Subject: ; * etc/NEWS: Fix thinko in Eshell entry. --- etc/NEWS | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index a1874313502..0d7d7d5ab60 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -660,9 +660,10 @@ manual. *** New special reference type '#'. This special reference type returns a marker at 'POSITION' in 'BUFFER'. You can insert it by typing or using the new interactive -command 'eshell-insert-marker'. You can also insert markers of any -type with the new command 'eshell-insert-special-reference'. See the -"(eshell) Arguments" node in the Eshell manual for more details. +command 'eshell-insert-marker'. You can also insert special +references of any type using the new interactive command +'eshell-insert-special-reference'. See the "(eshell) Arguments" node +in the Eshell manual for more details. +++ *** New splice operator for Eshell dollar expansions. -- cgit v1.2.3 From 723b0973512c0e6e9fb0f07678124347ccd44b54 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Thu, 25 Jan 2024 20:58:34 -0800 Subject: Add support for running commands via Eshell's "env" command * (eshell-handle-local-variables): Move most of the code to... (eshell-parse-local-variables): ... here. (eshell/env): Call 'eshell-parse-local-variables'. * test/lisp/eshell/esh-var-tests.el (esh-var-test/local-variables/env): New test. * doc/misc/eshell.texi (Built-ins): Describe the new behavior. * etc/NEWS: Announce this change. --- doc/misc/eshell.texi | 8 ++++--- etc/NEWS | 7 ++++++ lisp/eshell/esh-var.el | 50 ++++++++++++++++++++++++--------------- test/lisp/eshell/esh-var-tests.el | 7 ++++++ 4 files changed, 50 insertions(+), 22 deletions(-) diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index fb9a563b696..da5e1ef1d03 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -624,9 +624,11 @@ each argument as a string, separated by a space. @item env @cmindex env -Prints the current environment variables. Unlike in Bash, this -command does not yet support running commands with a modified -environment. +With no arguments, print the current environment variables. If you +pass arguments to this command, then @command{env} will execute the +arguments as a command. If you pass any initial arguments of the form +@samp{@var{var}=@var{value}}, @command{env} will first set @var{var} +to @var{value} before running the command. @item eshell-debug @cmindex eshell-debug diff --git a/etc/NEWS b/etc/NEWS index 0d7d7d5ab60..37264f2f1f1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -656,6 +656,13 @@ appropriate, but still allow piping the output elsewhere if desired. For more information, see the "(eshell) Built-ins" node in the Eshell manual. ++++ +*** Eshell's 'env' command now supports running commands. +Like in many other shells, Eshell's 'env' command now lets you run a +command passed as arguments to 'env'. If you pass any initial +arguments of the form 'VAR=VALUE', 'env' will first set 'VAR' to +'VALUE' before running the command. + +++ *** New special reference type '#'. This special reference type returns a marker at 'POSITION' in diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 1d90fbdd8ee..627cbb17797 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -304,27 +304,36 @@ This is set to t in `eshell-local-variable-bindings' (which see).") (add-hook 'pcomplete-try-first-hook #'eshell-complete-variable-assignment nil t))) -(defun eshell-handle-local-variables () - "Allow for the syntax `VAR=val '." +(defun eshell-parse-local-variables (args) + "Parse a list of ARGS, looking for variable assignments. +Variable assignments are of the form \"VAR=value\". If ARGS +begins with any such assignments, throw `eshell-replace-command' +with a form that will temporarily set those variables. +Otherwise, return nil." ;; Handle local variable settings by let-binding the entries in ;; `eshell-local-variable-bindings' and calling `eshell-set-variable' ;; for each variable before the command is invoked. (let ((setvar "\\`\\([A-Za-z_][A-Za-z0-9_]*\\)=\\(.*\\)\\'") - (command eshell-last-command-name) - (args eshell-last-arguments)) - (when (and (stringp command) (string-match setvar command)) + (head (car args)) + (rest (cdr args))) + (when (and (stringp head) (string-match setvar head)) (throw 'eshell-replace-command `(let ,eshell-local-variable-bindings ,@(let (locals) - (while (and (stringp command) - (string-match setvar command)) + (while (and (stringp head) + (string-match setvar head)) (push `(eshell-set-variable - ,(match-string 1 command) - ,(match-string 2 command)) + ,(match-string 1 head) + ,(match-string 2 head)) locals) - (setq command (pop args))) + (setq head (pop rest))) (nreverse locals)) - (eshell-named-command ,command ,(list 'quote args))))))) + (eshell-named-command ,head ',rest)))))) + +(defun eshell-handle-local-variables () + "Allow for the syntax `VAR=val '." + (eshell-parse-local-variables (cons eshell-last-command-name + eshell-last-arguments))) (defun eshell-interpolate-variable () "Parse a variable interpolation. @@ -414,19 +423,22 @@ the values of nil for each." obarray #'boundp)) (pcomplete-here)))) -;; FIXME the real "env" command does more than this, it runs a program -;; in a modified environment. (defun eshell/env (&rest args) "Implementation of `env' in Lisp." - (eshell-init-print-buffer) (eshell-eval-using-options "env" args - '((?h "help" nil nil "show this usage screen") + '(;; FIXME: Support more "env" options, like "--unset". + (?h "help" nil nil "show this usage screen") :external "env" - :usage "") - (dolist (setting (sort (eshell-environment-variables) 'string-lessp)) - (eshell-buffered-print setting "\n")) - (eshell-flush))) + :parse-leading-options-only + :usage "[NAME=VALUE]... [COMMAND [ARG]...]") + (if args + (or (eshell-parse-local-variables args) + (eshell-named-command (car args) (cdr args))) + (eshell-init-print-buffer) + (dolist (setting (sort (eshell-environment-variables) 'string-lessp)) + (eshell-buffered-print setting "\n")) + (eshell-flush)))) (defun eshell-insert-envvar (envvar-name) "Insert ENVVAR-NAME into the current buffer at point." diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el index bb3d18abf6d..b94e8a276d7 100644 --- a/test/lisp/eshell/esh-var-tests.el +++ b/test/lisp/eshell/esh-var-tests.el @@ -661,6 +661,13 @@ nil, use FUNCTION instead." (eshell-insert-command "VAR=hello cd ..") (should (equal default-directory parent-directory))))) +(ert-deftest esh-var-test/local-variables/env () + "Test that \"env VAR=value command\" temporarily sets variables." + (with-temp-eshell + (push "VAR=value" process-environment) + (eshell-match-command-output "env VAR=hello env" "VAR=hello\n") + (should (equal (getenv "VAR") "value")))) + ;; Variable aliases -- cgit v1.2.3 From de020255a5cef4349d786fceb19481352c49557b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 26 Jan 2024 15:01:51 +0200 Subject: Fix crash backtraces on MS-Windows, broken by ASLR * src/w32fns.c (DEFAULT_IMAGE_BASE): Define for 64-bit and 32-bit MinGW builds. (emacs_abort): Correct the callstack addresses for potential relocation of the image base due to ASLR. This makes 'addr2line' be able to interpret emacs_backtrace.txt when ASLR is in effect, which it is on every modern version of MS-Windows. (Bug#63365) * configure.ac (LD_SWITCH_SYSTEM_TEMACS) [mingw32]: Add comment about keeping the image-base values in sync with w32fns.c. * etc/DEBUG (How to disable ASLR): New section. --- configure.ac | 2 ++ etc/DEBUG | 33 ++++++++++++++++++++++++++++++++- src/w32fns.c | 26 +++++++++++++++++++++++--- 3 files changed, 57 insertions(+), 4 deletions(-) diff --git a/configure.ac b/configure.ac index 55f742ba8ef..fa8b04ec685 100644 --- a/configure.ac +++ b/configure.ac @@ -7463,6 +7463,8 @@ case "$opsys" in mingw32) ## Is it any better under MinGW64 to relocate emacs into higher addresses? + ## If the values of -image-base are modified, the corresponding + ## values of DEFAULT_IMAGE_BASE in w32fns.c should be kept in sync. case "$canonical" in x86_64-*-*) LD_SWITCH_SYSTEM_TEMACS="-Wl,-stack,0x00800000 -Wl,-heap,0x00100000 -Wl,-image-base,0x400000000 -Wl,-entry,__start -Wl,-Map,./temacs.map" ;; *) LD_SWITCH_SYSTEM_TEMACS="-Wl,-stack,0x00800000 -Wl,-heap,0x00100000 -Wl,-image-base,0x01000000 -Wl,-entry,__start -Wl,-Map,./temacs.map" ;; diff --git a/etc/DEBUG b/etc/DEBUG index 1680aab4385..6c7f4040b8d 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -928,7 +928,10 @@ data that is modified only very rarely.) It is also useful to look at the corrupted object or data structure in a fresh Emacs session and compare its contents with a session that you -are debugging. +are debugging. This might be somewhat harder on modern systems which +randomize addresses of running executables (the so-called Address +Space Layout Randomization, or ASLR, feature). If you have this +problem, see below under "How to disable ASLR". ** Debugging the TTY (non-windowed) version @@ -1080,6 +1083,34 @@ suppresses some Valgrind false alarms during Emacs garbage collection: Unfortunately Valgrind suppression files tend to be system-dependent, so you will need to keep one around that matches your system. +** How to disable ASLR + +Modern systems use the so-called Address Space Layout Randomization, +(ASLR) feature, which randomizes the base address of running programs, +making it harder for malicious software or hackers to find the address +of some function or variable in a running program by looking at its +executable file. This causes the address of the same symbol to be +different across rerunning of the same program. Sometimes, it can be +useful to disable ASLR, for example, if you want to compare objects in +two different Emacs sessions. + +On GNU/Linux, you can disable ASLR temporarily with the following +shell command: + + echo 0 > /proc/sys/kernel/randomize_va_space + +or by running Emacs in an environment where ASLR is temporarily +disabled: + + setarch -R emacs [args...] + +To disable ASLR in Emacs on MS-Windows, you will have to rebuild Emacs +while adding '-Wl,-disable-dynamicbase' to LD_SWITCH_SYSTEM_TEMACS +variable defined in src/Makefile. Alternatively, use some tool to +edit the PE header of the Emacs executable file and reset the +DYNAMIC_BASE (0x40) flag in the DllCharacteristics flags recorded by +the PE header. + ** How to recover buffer contents from an Emacs core dump file The file etc/emacs-buffer.gdb defines a set of GDB commands for diff --git a/src/w32fns.c b/src/w32fns.c index f8de45da7c9..f44460e52c0 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -11121,12 +11121,20 @@ my_exception_handler (EXCEPTION_POINTERS * exception_data) return prev_exception_handler (exception_data); return EXCEPTION_EXECUTE_HANDLER; } -#endif +#endif /* !CYGWIN */ typedef USHORT (WINAPI * CaptureStackBackTrace_proc) (ULONG, ULONG, PVOID *, PULONG); #define BACKTRACE_LIMIT_MAX 62 +/* The below must be kept in sync with the value of the + -Wl,-image-base switch we use in LD_SWITCH_SYSTEM_TEMACS, see + configure.ac. */ +#if defined MINGW_W64 && EMACS_INT_MAX > LONG_MAX +# define DEFAULT_IMAGE_BASE (ptrdiff_t)0x400000000 +#else /* 32-bit MinGW build */ +# define DEFAULT_IMAGE_BASE (ptrdiff_t)0x01000000 +#endif static int w32_backtrace (void **buffer, int limit) @@ -11181,6 +11189,13 @@ emacs_abort (void) { void *stack[BACKTRACE_LIMIT_MAX + 1]; int i = w32_backtrace (stack, BACKTRACE_LIMIT_MAX + 1); +#ifdef CYGWIN + ptrdiff_t addr_offset = 0; +#else /* MinGW */ + /* The offset below is zero unless ASLR is in effect. */ + ptrdiff_t addr_offset + = DEFAULT_IMAGE_BASE - (ptrdiff_t)GetModuleHandle (NULL); +#endif /* MinGW */ if (i) { @@ -11231,8 +11246,13 @@ emacs_abort (void) { /* stack[] gives the return addresses, whereas we want the address of the call, so decrease each address - by approximate size of 1 CALL instruction. */ - sprintf (buf, "%p\r\n", (char *)stack[j] - sizeof(void *)); + by approximate size of 1 CALL instruction. We add + ADDR_OFFSET to account for ASLR which changes the + base address of the program's image in memory, + whereas 'addr2line' needs to see addresses relative + to the fixed base recorded in the PE header. */ + sprintf (buf, "%p\r\n", + (char *)stack[j] - sizeof(void *) + addr_offset); if (stderr_fd >= 0) write (stderr_fd, buf, strlen (buf)); if (errfile_fd >= 0) -- cgit v1.2.3 From 047607f6e611709f89f6c93ae0e2fc97b25bf18f Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Fri, 26 Jan 2024 10:17:19 -0800 Subject: Fix detection of directly-invokable commands in Eshell I think this regressed partly due to eef32d13da58, so let's add some regression tests to make sure that doesn't happen again. * lisp/eshell/em-unix.el (eshell-unix-initialize): Add "compile". * lisp/eshell/esh-cmd.el (eshell--find-subcommands): Yield the second element of the subcommand. (eshell--invoke-command-directly-p): Rename and account for 'eshell-with-copied-handles'. (eshell-invoke-directly): Rename to... (eshell-invoke-directly-p): ... this, and use 'pcase' to make the logic clearer. * lisp/eshell/esh-mode.el (eshell-send-input): Always queue input if the process is running; rename some locals to be clearer. * lisp/eshell/esh-var.el (eshell-var-initialize): Add "env" as a complex command. * test/lisp/eshell/esh-cmd-tests.el (esh-cmd-test--deftest-invoke-directly): New macro. (no-args, with-args, multiple-cmds, subcmd, complex, complex-subcmd): New test cases. --- lisp/eshell/em-unix.el | 6 ++--- lisp/eshell/esh-cmd.el | 54 +++++++++++++++++++++------------------ lisp/eshell/esh-mode.el | 17 ++++++------ lisp/eshell/esh-var.el | 2 ++ test/lisp/eshell/esh-cmd-tests.el | 20 +++++++++++++++ 5 files changed, 63 insertions(+), 36 deletions(-) diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index b066e9eeb8e..dad02206759 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -166,9 +166,9 @@ Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine." (add-hook 'pcomplete-try-first-hook 'eshell-complete-host-reference nil t)) (setq-local eshell-complex-commands - (append '("grep" "egrep" "fgrep" "agrep" "rgrep" - "glimpse" "locate" "cat" "time" "cp" "mv" - "make" "du" "diff") + (append '("compile" "grep" "egrep" "fgrep" "agrep" + "rgrep" "glimpse" "locate" "cat" "time" "cp" + "mv" "make" "du" "diff") eshell-complex-commands))) (defalias 'eshell/date 'current-time-string) diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 2746800ea78..30494bafb48 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -934,48 +934,52 @@ This yields the SUBCOMMANDs when found in forms like (dolist (elem haystack) (cond ((eq (car-safe elem) 'eshell-as-subcommand) - (iter-yield (cdr elem))) + (iter-yield (cadr elem))) ((listp elem) (iter-yield-from (eshell--find-subcommands elem)))))) -(defun eshell--invoke-command-directly (command) +(defun eshell--invoke-command-directly-p (command) "Determine whether the given COMMAND can be invoked directly. COMMAND should be a non-top-level Eshell command in parsed form. A command can be invoked directly if all of the following are true: * The command is of the form - \"(eshell-trap-errors (eshell-named-command NAME ARGS))\", - where ARGS is optional. + (eshell-with-copied-handles + (eshell-trap-errors (eshell-named-command NAME [ARGS])) _). * NAME is a string referring to an alias function and isn't a complex command (see `eshell-complex-commands'). * Any subcommands in ARGS can also be invoked directly." - (when (and (eq (car command) 'eshell-trap-errors) - (eq (car (cadr command)) 'eshell-named-command)) - (let ((name (cadr (cadr command))) - (args (cdr-safe (nth 2 (cadr command))))) - (and name (stringp name) - (not (member name eshell-complex-commands)) - (catch 'simple - (dolist (pred eshell-complex-commands t) - (when (and (functionp pred) - (funcall pred name)) - (throw 'simple nil)))) - (eshell-find-alias-function name) - (catch 'indirect-subcommand - (iter-do (subcommand (eshell--find-subcommands args)) - (unless (eshell--invoke-command-directly subcommand) - (throw 'indirect-subcommand nil))) - t))))) - -(defun eshell-invoke-directly (command) + (pcase command + (`(eshell-with-copied-handles + (eshell-trap-errors (eshell-named-command ,name . ,args)) + ,_) + (and name (stringp name) + (not (member name eshell-complex-commands)) + (catch 'simple + (dolist (pred eshell-complex-commands t) + (when (and (functionp pred) + (funcall pred name)) + (throw 'simple nil)))) + (eshell-find-alias-function name) + (catch 'indirect-subcommand + (iter-do (subcommand (eshell--find-subcommands (car args))) + (unless (eshell--invoke-command-directly-p subcommand) + (throw 'indirect-subcommand nil))) + t))))) + +(defun eshell-invoke-directly-p (command) "Determine whether the given COMMAND can be invoked directly. COMMAND should be a top-level Eshell command in parsed form, as produced by `eshell-parse-command'." - (let ((base (cadr (nth 2 (nth 2 (cadr command)))))) - (eshell--invoke-command-directly base))) + (pcase command + (`(eshell-commands (progn ,_ (unwind-protect (progn ,base) . ,_))) + (eshell--invoke-command-directly-p base)))) + +(define-obsolete-function-alias 'eshell-invoke-directly + 'eshell-invoke-directly-p "30.1") (defun eshell-eval-argument (argument) "Evaluate a single Eshell ARGUMENT and return the result." diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 21e3f00086f..fd279f61673 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -619,14 +619,14 @@ If NO-NEWLINE is non-nil, the input is sent without an implied final newline." (interactive "P") ;; Note that the input string does not include its terminal newline. - (let ((proc-running-p (and (eshell-head-process) - (not queue-p))) - (inhibit-modification-hooks t)) - (unless (and proc-running-p + (let* ((proc-running-p (eshell-head-process)) + (send-to-process-p (and proc-running-p (not queue-p))) + (inhibit-modification-hooks t)) + (unless (and send-to-process-p (not (eq (process-status (eshell-head-process)) 'run))) - (if (or proc-running-p + (if (or send-to-process-p (>= (point) eshell-last-output-end)) (goto-char (point-max)) (let ((copy (eshell-get-old-input use-region))) @@ -634,7 +634,7 @@ newline." (insert-and-inherit copy))) (unless (or no-newline (and eshell-send-direct-to-subprocesses - proc-running-p)) + send-to-process-p)) (insert-before-markers-and-inherit ?\n)) ;; Delete and reinsert input. This seems like a no-op, except ;; for the resulting entries in the undo list: undoing this @@ -644,7 +644,7 @@ newline." (inhibit-read-only t)) (delete-region eshell-last-output-end (point)) (insert text)) - (if proc-running-p + (if send-to-process-p (progn (eshell-update-markers eshell-last-output-end) (if (or eshell-send-direct-to-subprocesses @@ -673,7 +673,8 @@ newline." (run-hooks 'eshell-input-filter-functions) (and (catch 'eshell-terminal (ignore - (if (eshell-invoke-directly cmd) + (if (and (not proc-running-p) + (eshell-invoke-directly-p cmd)) (eval cmd) (eshell-eval-command cmd input)))) (eshell-life-is-too-much))))) diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 627cbb17797..537bc4b0641 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -287,6 +287,8 @@ This is set to t in `eshell-local-variable-bindings' (which see).") (setq-local eshell-subcommand-bindings (append eshell-local-variable-bindings eshell-subcommand-bindings)) + (setq-local eshell-complex-commands + (append '("env") eshell-complex-commands)) (setq-local eshell-special-chars-inside-quoting (append eshell-special-chars-inside-quoting '(?$))) diff --git a/test/lisp/eshell/esh-cmd-tests.el b/test/lisp/eshell/esh-cmd-tests.el index be31681267b..c37e6d14187 100644 --- a/test/lisp/eshell/esh-cmd-tests.el +++ b/test/lisp/eshell/esh-cmd-tests.el @@ -468,6 +468,26 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil." (eshell-command-result-equal "unless {[ foo = bar ]} {echo no} {echo yes}" "no")) + +;; Direct invocation + +(defmacro esh-cmd-test--deftest-invoke-directly (name command expected) + "FIXME" + (declare (indent 2)) + `(ert-deftest ,(intern (concat "esh-cmd-test/invoke-directly/" + (symbol-name name))) () + (with-temp-eshell + (should (equal (eshell-invoke-directly + (eshell-parse-command ,command nil t)) + ,expected))))) + +(esh-cmd-test--deftest-invoke-directly no-args "echo" t) +(esh-cmd-test--deftest-invoke-directly with-args "echo hi" t) +(esh-cmd-test--deftest-invoke-directly multiple-cmds "echo hi; echo bye" nil) +(esh-cmd-test--deftest-invoke-directly subcmd "echo ${echo hi}" t) +(esh-cmd-test--deftest-invoke-directly complex "ls ." nil) +(esh-cmd-test--deftest-invoke-directly complex-subcmd "echo {ls .}" nil) + ;; Error handling -- cgit v1.2.3 From 330284e7f6d5191bc107caaa1c6e8d4b319af259 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Fri, 26 Jan 2024 10:26:57 -0800 Subject: ; * test/lisp/eshell/esh-cmd-tests.el: Fix last change. --- test/lisp/eshell/esh-cmd-tests.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/test/lisp/eshell/esh-cmd-tests.el b/test/lisp/eshell/esh-cmd-tests.el index c37e6d14187..741333ff52b 100644 --- a/test/lisp/eshell/esh-cmd-tests.el +++ b/test/lisp/eshell/esh-cmd-tests.el @@ -475,9 +475,10 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil." "FIXME" (declare (indent 2)) `(ert-deftest ,(intern (concat "esh-cmd-test/invoke-directly/" - (symbol-name name))) () + (symbol-name name))) + () (with-temp-eshell - (should (equal (eshell-invoke-directly + (should (equal (eshell-invoke-directly-p (eshell-parse-command ,command nil t)) ,expected))))) -- cgit v1.2.3 From 9d985f24a7fe298980f9af7b9e44318d145cfae5 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 26 Jan 2024 21:02:10 +0200 Subject: ; * etc/DEBUG: Add a blurb about disabling ASLR on macOS. --- etc/DEBUG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/etc/DEBUG b/etc/DEBUG index 6c7f4040b8d..4eae090621f 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -1111,6 +1111,9 @@ edit the PE header of the Emacs executable file and reset the DYNAMIC_BASE (0x40) flag in the DllCharacteristics flags recorded by the PE header. +On macOS, there's no official way for disabling ASLR, but there are +various hacks that can be found by searching the Internet. + ** How to recover buffer contents from an Emacs core dump file The file etc/emacs-buffer.gdb defines a set of GDB commands for -- cgit v1.2.3 From 7338af9c9862f7581f8a246efbd2ee35040b0219 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 26 Jan 2024 21:05:43 +0200 Subject: ; * etc/PROBLEMS: Document that GnuPG 2.4.4 solves the EasyPG hangs. --- etc/PROBLEMS | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/etc/PROBLEMS b/etc/PROBLEMS index cc9f9176f70..1254f6a3bc9 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -530,11 +530,10 @@ The solution is to use gawk (GNU awk). *** Saving a file encrypted with GnuPG via EasyPG hangs. This is known to happen with GnuPG v2.4.1. The only known workaround -is to downgrade to a version of GnuPG older than 2.4.1 (or, in the -future, upgrade to a newer version which solves the problem, when such -a fixed version becomes available). Note that GnuPG v2.2.42 and later -also has this problem, so you should also avoid those later 2.2.4x -versions; v2.2.41 is reported to work fine. +is to downgrade to a version of GnuPG older than 2.4.1, or upgrade to +version 2.4.4 and newer, which reportedly solves the problem. Note +that GnuPG v2.2.42 and later also has this problem, so you should also +avoid those later 2.2.4x versions; v2.2.41 is reported to work fine. *** EasyPG loopback pinentry does not work with gpgsm. -- cgit v1.2.3 From b803d10d5fa550338e184baded42cc17d01c866e Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Fri, 26 Jan 2024 11:56:47 -0800 Subject: ; Add docstring to test Note to self: coffee first, *then* push upstream. * test/lisp/eshell/esh-cmd-tests.el (esh-cmd-test--deftest-invoke-directly): Add missing docstring. --- test/lisp/eshell/esh-cmd-tests.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/lisp/eshell/esh-cmd-tests.el b/test/lisp/eshell/esh-cmd-tests.el index 741333ff52b..ef965a896c1 100644 --- a/test/lisp/eshell/esh-cmd-tests.el +++ b/test/lisp/eshell/esh-cmd-tests.el @@ -472,7 +472,8 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil." ;; Direct invocation (defmacro esh-cmd-test--deftest-invoke-directly (name command expected) - "FIXME" + "Test `eshell-invoke-directly-p' returns EXPECTED for COMMAND. +NAME is the name of the test case." (declare (indent 2)) `(ert-deftest ,(intern (concat "esh-cmd-test/invoke-directly/" (symbol-name name))) -- cgit v1.2.3 From 972466dce268c5697f47a7f342b13dbf01f23a39 Mon Sep 17 00:00:00 2001 From: João Távora Date: Fri, 26 Jan 2024 17:18:55 -0600 Subject: Eglot: fix eglot--dumb-tryc for "only possible completion" case * lisp/progmodes/eglot.el (eglot--dumb-tryc): Fix for "only possible completion" case. --- lisp/progmodes/eglot.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 40837074573..beba268f923 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -3061,9 +3061,10 @@ for which LSP on-type-formatting should be requested." (defun eglot--dumb-allc (pat table pred _point) (funcall table pat pred t)) (defun eglot--dumb-tryc (pat table pred point) - (if-let ((probe (funcall table pat pred nil))) - (cons probe (length probe)) - (cons pat point))) + (let ((probe (funcall table pat pred nil))) + (cond ((eq probe t) t) + (probe (cons probe (length probe))) + (t (cons pat point))))) (add-to-list 'completion-category-defaults '(eglot-capf (styles eglot--dumb-flex))) (add-to-list 'completion-styles-alist '(eglot--dumb-flex eglot--dumb-tryc eglot--dumb-allc)) -- cgit v1.2.3 From 6667d6c19c3934871ed54d89dc153efc72f947de Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 27 Jan 2024 09:30:16 +0800 Subject: Import ELPA package adaptive-wrap as visual-wrap * doc/emacs/basic.texi (Continuation Lines): Document visual-wrap and its applications. * etc/NEWS (Editing Changes in Emacs 30.1): Ditto. * lisp/visual-wrap.el (visual-wrap-extra-indent) (visual-wrap--face-extend-p, visual-wrap--prefix-face) (visual-wrap--prefix, visual-wrap-fill-context-prefix) (visual-wrap-prefix-function, visual-wrap-prefix-mode, lookup-key) (visual-wrap): New file. Update copyright years and rename to `visual-wrap'. --- doc/emacs/basic.texi | 11 +++ etc/NEWS | 12 +++ lisp/visual-wrap.el | 203 +++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 226 insertions(+) create mode 100644 lisp/visual-wrap.el diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index f64b3995d25..a6b71db4bea 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -630,6 +630,17 @@ before they get too long, by inserting newlines. If you prefer, you can make Emacs insert a newline automatically when a line gets too long, by using Auto Fill mode. @xref{Filling}. +@cindex continuation lines, wrapping with prefix +@findex 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. + 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 newlines. In that case, you can use Visual Line mode, which enables diff --git a/etc/NEWS b/etc/NEWS index 37264f2f1f1..37a017c4db1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -317,6 +317,18 @@ name detection. * Editing Changes in Emacs 30.1 ++++ +** New minor mode 'visual-wrap-prefix-mode'. + +When enabled, continuation lines displayed for a folded long line will +receive a 'wrap-prefix' automatically computed from the line's +surrounding context by the function 'fill-context-prefix', which +generally indents continuation lines as if the line were filled with +'M-q', or similar. + +This minor mode is the 'adaptive-wrap' ELPA package renamed and +lightly edited for inclusion in Emacs. + +++ ** New user option 'gud-highlight-current-line'. When enabled, Gud will visually emphasize the line being executed upon diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el new file mode 100644 index 00000000000..9f52a1868c1 --- /dev/null +++ b/lisp/visual-wrap.el @@ -0,0 +1,203 @@ +;;; visual-wrap.el --- Smart line-wrapping with wrap-prefix + +;; Copyright (C) 2011-2021, 2024 Free Software Foundation, Inc. + +;; Author: Stephen Berman +;; Stefan Monnier +;; Maintainer: emacs-devel@gnu.org +;; Keywords: convenience +;; Package: emacs + +;; This file is part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This package provides the `visual-wrap-prefix-mode' minor mode +;; which sets the wrap-prefix property on the fly so that +;; single-long-line paragraphs get word-wrapped in a way similar to +;; what you'd get with M-q using visual-fill-mode, but without +;; actually changing the buffer's text. + +;;; Code: + +(defcustom visual-wrap-extra-indent 0 + "Number of extra spaces to indent in `visual-wrap-prefix-mode'. + +`visual-wrap-prefix-mode' indents the visual lines to the level +of the actual line plus `visual-wrap-extra-indent'. A negative +value will do a relative de-indent. + +Examples: + +actual indent = 2 +extra indent = -1 + + Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed + do eiusmod tempor incididunt ut labore et dolore magna + aliqua. Ut enim ad minim veniam, quis nostrud exercitation + ullamco laboris nisi ut aliquip ex ea commodo consequat. + +actual indent = 2 +extra indent = 2 + + Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed + do eiusmod tempor incididunt ut labore et dolore magna + aliqua. Ut enim ad minim veniam, quis nostrud exercitation + ullamco laboris nisi ut aliquip ex ea commodo consequat." + :type 'integer + :safe 'integerp + :group 'visual-line) + +(defun visual-wrap--face-extend-p (face) + ;; Before Emacs 27, faces always extended beyond EOL, so we check + ;; for a non-default background instead. + (cond + ((listp face) + (plist-get face (if (fboundp 'face-extend-p) :extend :background))) + ((symbolp face) + (if (fboundp 'face-extend-p) + (face-extend-p face nil t) + (face-background face nil t))))) + +(defun visual-wrap--prefix-face (fcp _beg end) + ;; If the fill-context-prefix already specifies a face, just use that. + (cond ((get-text-property 0 'face fcp)) + ;; Else, if the last character is a newline and has a face + ;; that extends beyond EOL, assume that this face spans the + ;; whole line and apply it to the prefix to preserve the + ;; "block" visual effect. + ;; + ;; NB: the face might not actually span the whole line: see + ;; for example removed lines in diff-mode, where the first + ;; character has the diff-indicator-removed face, while the + ;; rest of the line has the diff-removed face. + ((= (char-before end) ?\n) + (let ((eol-face (get-text-property (1- end) 'face))) + ;; `eol-face' can be a face, a "face value" + ;; (plist of face properties) or a list of one of those. + (if (or (not (consp eol-face)) (keywordp (car eol-face))) + ;; A single face. + (if (visual-wrap--face-extend-p eol-face) eol-face) + ;; A list of faces. Keep the ones that extend beyond EOL. + (delq nil (mapcar (lambda (f) + (if (visual-wrap--face-extend-p f) f)) + eol-face))))))) + +(defun visual-wrap--prefix (fcp) + (let ((fcp-len (string-width fcp))) + (cond + ((= 0 visual-wrap-extra-indent) + fcp) + ((< 0 visual-wrap-extra-indent) + (concat fcp (make-string visual-wrap-extra-indent ?\s))) + ((< 0 (+ visual-wrap-extra-indent fcp-len)) + (substring fcp + 0 + (+ visual-wrap-extra-indent fcp-len))) + (t + "")))) + +(defun visual-wrap-fill-context-prefix (beg end) + "Like `fill-context-prefix', but with length adjusted by +`visual-wrap-extra-indent'." + (let* ((fcp + ;; `fill-context-prefix' ignores prefixes that look like + ;; paragraph starts, in order to avoid inadvertently + ;; creating a new paragraph while filling, but here we're + ;; only dealing with single-line "paragraphs" and we don't + ;; actually modify the buffer, so this restriction doesn't + ;; make much sense (and is positively harmful in + ;; taskpaper-mode where paragraph-start matches everything). + (or (let ((paragraph-start "\\`\\'a")) + (fill-context-prefix beg end)) + ;; Note: fill-context-prefix may return nil; See: + ;; http://article.gmane.org/gmane.emacs.devel/156285 + "")) + (prefix (visual-wrap--prefix fcp)) + (face (visual-wrap--prefix-face fcp beg end))) + (if face + (propertize prefix 'face face) + prefix))) + +(defun visual-wrap-prefix-function (beg end) + "Indent the region between BEG and END with visual filling." + ;; Any change at the beginning of a line might change its wrap + ;; prefix, which affects the whole line. So we need to "round-up" + ;; `end' to the nearest end of line. We do the same with `beg' + ;; although it's probably not needed. + (goto-char end) + (unless (bolp) (forward-line 1)) + (setq end (point)) + (goto-char beg) + (forward-line 0) + (setq beg (point)) + (while (< (point) end) + (let ((lbp (point))) + (put-text-property + (point) (progn (search-forward "\n" end 'move) (point)) + 'wrap-prefix + (let ((pfx (visual-wrap-fill-context-prefix + lbp (point)))) + ;; Remove any `wrap-prefix' property that might have been + ;; added earlier. Otherwise, we end up with a string + ;; containing a `wrap-prefix' string containing a + ;; `wrap-prefix' string ... + (remove-text-properties + 0 (length pfx) '(wrap-prefix) pfx) + (let ((dp (get-text-property 0 'display pfx))) + (when (and dp (eq dp (get-text-property (1- lbp) 'display))) + ;; There's a `display' property which covers not just the + ;; prefix but also the previous newline. So it's not + ;; just making the prefix more pretty and could interfere + ;; or even defeat our efforts (e.g. it comes from + ;; `visual-fill-mode'). + (remove-text-properties + 0 (length pfx) '(display) pfx))) + pfx)))) + `(jit-lock-bounds ,beg . ,end)) + +;;;###autoload +(define-minor-mode visual-wrap-prefix-mode + "Wrap the buffer text with visual filling." + :lighter "" + :group 'visual-line + (if visual-wrap-prefix-mode + (progn + ;; HACK ATTACK! We want to run after font-lock (so our + ;; wrap-prefix includes the faces applied by font-lock), but + ;; jit-lock-register doesn't accept an `append' argument, so + ;; we add ourselves beforehand, to make sure we're at the end + ;; of the hook (bug#15155). + (add-hook 'jit-lock-functions + #'visual-wrap-prefix-function 'append t) + (jit-lock-register #'visual-wrap-prefix-function)) + (jit-lock-unregister #'visual-wrap-prefix-function) + (with-silent-modifications + (save-restriction + (widen) + (remove-text-properties (point-min) (point-max) '(wrap-prefix nil)))))) + +;;;###autoload +(define-key-after (lookup-key menu-bar-options-menu [line-wrapping]) + [visual-wrap] + '(menu-item "Visual Wrap" visual-wrap-prefix-mode + :visible (menu-bar-menu-frame-live-and-visible-p) + :help "Display continuation lines with prefix derived from context" + :button (:toggle . (bound-and-true-p visual-wrap-prefix-mode))) + word-wrap) + +(provide 'visual-wrap) +;;; visual-wrap.el ends here -- cgit v1.2.3 From d50300c50028a81ade1eb08405036168d5a24f00 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 27 Jan 2024 09:31:38 +0800 Subject: * lisp/visual-wrap.el (visual-wrap-prefix-mode): Improve doc string. --- lisp/visual-wrap.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index 9f52a1868c1..6e6e45a480c 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -171,7 +171,7 @@ extra indent = 2 ;;;###autoload (define-minor-mode visual-wrap-prefix-mode - "Wrap the buffer text with visual filling." + "Display continuation lines with prefixes from surrounding context." :lighter "" :group 'visual-line (if visual-wrap-prefix-mode -- cgit v1.2.3 From 55f0b3e561034a1ad4235770d1c0685439a64fe5 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 27 Jan 2024 09:38:46 +0800 Subject: Move Visual Wrap menu to menu-bar.el * lisp/menu-bar.el (menu-bar-line-wrapping-menu): Insert new menu item controlling visual-wrap-prefix-mode. * lisp/visual-wrap.el: Remove menu bar autoload. --- lisp/menu-bar.el | 7 +++++++ lisp/visual-wrap.el | 11 +---------- 2 files changed, 8 insertions(+), 10 deletions(-) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 477e3036b47..761f0603c75 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1467,6 +1467,13 @@ mail status in mode line")) (not word-wrap))) :visible (menu-bar-menu-frame-live-and-visible-p) :enable (not (truncated-partial-width-window-p)))) + + (bindings--define-key menu [visual-wrap] + '(menu-item "Visual Wrap Prefix" visual-wrap-prefix-mode + :help "Display continuation lines with contextual prefix" + :visible (menu-bar-menu-frame-live-and-visible-p) + :button (:toggle . (bound-and-true-p visual-wrap-prefix-mode)) + :enable t)) menu)) (defvar menu-bar-search-options-menu diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index 6e6e45a480c..f8e00b9c685 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -1,4 +1,4 @@ -;;; visual-wrap.el --- Smart line-wrapping with wrap-prefix +;;; visual-wrap.el --- Smart line-wrapping with wrap-prefix -*- lexical-binding: t -*- ;; Copyright (C) 2011-2021, 2024 Free Software Foundation, Inc. @@ -190,14 +190,5 @@ extra indent = 2 (widen) (remove-text-properties (point-min) (point-max) '(wrap-prefix nil)))))) -;;;###autoload -(define-key-after (lookup-key menu-bar-options-menu [line-wrapping]) - [visual-wrap] - '(menu-item "Visual Wrap" visual-wrap-prefix-mode - :visible (menu-bar-menu-frame-live-and-visible-p) - :help "Display continuation lines with prefix derived from context" - :button (:toggle . (bound-and-true-p visual-wrap-prefix-mode))) - word-wrap) - (provide 'visual-wrap) ;;; visual-wrap.el ends here -- cgit v1.2.3 From c37b50ad417c6cb340f54ffe218f5d889345451a Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 27 Jan 2024 10:36:30 +0800 Subject: Intercept calls to `openat' under Android * exec/configure.ac (OPEN_SYSCALL, OPENAT_SYSCALL): Define new macros. * exec/exec.h (struct exec_tracee): New field `sp'. * exec/trace.c (handle_openat): New function. (process_system_call): If handle_openat executes successfully, save the unmodified stack pointer within the tracee structure to be restored once the system call completes. --- exec/configure.ac | 13 +++++- exec/exec.h | 4 ++ exec/trace.c | 135 +++++++++++++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 150 insertions(+), 2 deletions(-) diff --git a/exec/configure.ac b/exec/configure.ac index 9008c84f6a6..d70dbea3477 100644 --- a/exec/configure.ac +++ b/exec/configure.ac @@ -131,6 +131,8 @@ AH_TEMPLATE([CLONE_SYSCALL], [Define to number of the `clone' system call.]) AH_TEMPLATE([CLONE3_SYSCALL], [Define to number of the `clone3' system call.]) AH_TEMPLATE([READLINK_SYSCALL], [Define to number of the `readlink' system call.]) AH_TEMPLATE([READLINKAT_SYSCALL], [Define to number of the `readlinkat' system call.]) +AH_TEMPLATE([OPEN_SYSCALL], [Define to number of the `open' system call.]) +AH_TEMPLATE([OPENAT_SYSCALL], [Define to number of the `openat' system call.]) AH_TEMPLATE([REENTRANT], [Define to 1 if the library is used within a signal handler.]) AC_CANONICAL_HOST @@ -257,6 +259,8 @@ AS_CASE([$host], [x86_64-*linux*], AC_DEFINE([CLONE_SYSCALL], [__NR_clone]) AC_DEFINE([READLINK_SYSCALL], [__NR_readlink]) AC_DEFINE([READLINKAT_SYSCALL], [__NR_readlinkat]) + AC_DEFINE([OPEN_SYSCALL], [__NR_open]) + AC_DEFINE([OPENAT_SYSCALL], [__NR_openat]) exec_CHECK_LINUX_CLONE3 # Make sure the loader doesn't conflict with other position # dependent code. @@ -285,6 +289,8 @@ AS_CASE([$host], [x86_64-*linux*], AC_DEFINE([CLONE_SYSCALL], [__NR_clone]) AC_DEFINE([READLINK_SYSCALL], [__NR_readlink]) AC_DEFINE([READLINKAT_SYSCALL], [__NR_readlinkat]) + AC_DEFINE([OPEN_SYSCALL], [__NR_open]) + AC_DEFINE([OPENAT_SYSCALL], [__NR_openat]) exec_CHECK_LINUX_CLONE3 # Make sure the loader doesn't conflict with other position # dependent code. @@ -312,8 +318,9 @@ AS_CASE([$host], [x86_64-*linux*], AC_DEFINE([INTERPRETER_BASE], [0x3f00000000]) AC_DEFINE([STACK_GROWS_DOWNWARDS], [1]) AC_DEFINE([CLONE_SYSCALL], [__NR_clone]) - # Note that aarch64 has no `readlink'. + # Note that aarch64 has neither `readlink' nor `open'. AC_DEFINE([READLINKAT_SYSCALL], [__NR_readlinkat]) + AC_DEFINE([OPENAT_SYSCALL], [__NR_openat]) exec_CHECK_LINUX_CLONE3 # Make sure the loader doesn't conflict with other position # dependent code. ARM places rather significant restrictions on @@ -343,6 +350,8 @@ AS_CASE([$host], [x86_64-*linux*], AC_DEFINE([CLONE_SYSCALL], [__NR_clone]) AC_DEFINE([READLINK_SYSCALL], [__NR_readlink]) AC_DEFINE([READLINKAT_SYSCALL], [__NR_readlinkat]) + AC_DEFINE([OPEN_SYSCALL], [__NR_open]) + AC_DEFINE([OPENAT_SYSCALL], [__NR_openat]) exec_CHECK_LINUX_CLONE3 LOADERFLAGS="$LOADERFLAGS $LDPREFIX-Ttext=0x20000000" exec_loader=loader-armeabi.s], @@ -365,6 +374,8 @@ AS_CASE([$host], [x86_64-*linux*], AC_DEFINE([CLONE_SYSCALL], [__NR_clone]) AC_DEFINE([READLINK_SYSCALL], [__NR_readlink]) AC_DEFINE([READLINKAT_SYSCALL], [__NR_readlinkat]) + AC_DEFINE([OPEN_SYSCALL], [__NR_open]) + AC_DEFINE([OPENAT_SYSCALL], [__NR_openat]) exec_CHECK_LINUX_CLONE3 LOADERFLAGS="$LOADERFLAGS $LDPREFIX-Ttext=0x20000000" exec_loader=loader-armeabi.s], diff --git a/exec/exec.h b/exec/exec.h index bed5edc9bab..ad1b50276c8 100644 --- a/exec/exec.h +++ b/exec/exec.h @@ -148,6 +148,10 @@ struct exec_tracee /* The next process being traced. */ struct exec_tracee *next; + /* Address of any stack pointer to restore after system call + completion. */ + USER_WORD sp; + /* The thread ID of this process. */ pid_t pid; diff --git a/exec/trace.c b/exec/trace.c index 8e190c94f79..a7cbda54d68 100644 --- a/exec/trace.c +++ b/exec/trace.c @@ -961,7 +961,7 @@ handle_readlinkat (USER_WORD callno, USER_REGS_STRUCT *regs, return 0; /* Copy over tracee->exec_file. Truncate it to PATH_MAX, length, or - size, whichever is less. */ + size, whichever is smaller. */ length = strlen (tracee->exec_file); length = MIN (size, MIN (PATH_MAX, length)); @@ -979,6 +979,98 @@ handle_readlinkat (USER_WORD callno, USER_REGS_STRUCT *regs, #endif /* REENTRANT */ } +/* Handle an `open' or `openat' system call. + + CALLNO is the system call number, and REGS are the current user + registers of the TRACEE. + + If the file name specified in such system call is `/proc/self/exe', + replace the file name with the executable loaded into the process + issuing this system call. + + Value is 0 upon success and 1 upon failure. */ + +static int +handle_openat (USER_WORD callno, USER_REGS_STRUCT *regs, + struct exec_tracee *tracee, USER_WORD *result) +{ +#ifdef REENTRANT + /* readlinkat cannot be handled specially when the library is built + to be reentrant, as the file name information cannot be + recorded. */ + return 0; +#else /* !REENTRANT */ + char buffer[PATH_MAX + 1]; + USER_WORD address; + size_t length; + USER_REGS_STRUCT original; + + /* Read the file name. */ + +#ifdef OPEN_SYSCALL + if (callno == OPEN_SYSCALL) + address = regs->SYSCALL_ARG_REG; + else +#endif /* OPEN_SYSCALL */ + address = regs->SYSCALL_ARG1_REG; + + /* Read the file name into the buffer and verify that it is NULL + terminated. */ + read_memory (tracee, buffer, PATH_MAX, address); + + if (!memchr (buffer, '\0', PATH_MAX)) + { + errno = ENAMETOOLONG; + return 1; + } + + /* Now check if the caller is looking for /proc/self/exe. + + dirfd can be ignored, as for now only absolute file names are + handled. FIXME. */ + + if (strcmp (buffer, "/proc/self/exe") || !tracee->exec_file) + return 0; + + /* Copy over tracee->exec_file. This doesn't correctly handle the + scenario where tracee->exec_file is longer than PATH_MAX, but + that has yet to be encountered in practice. */ + + original = *regs; + length = strlen (tracee->exec_file); + address = user_alloca (tracee, &original, regs, length + 1); + + if (!address + || user_copy (tracee, (unsigned char *) tracee->exec_file, + address, length)) + goto fail; + + /* Replace the file name buffer with ADDRESS. */ + +#ifdef OPEN_SYSCALL + if (callno == OPEN_SYSCALL) + regs->SYSCALL_ARG_REG = address; + else +#endif /* OPEN_SYSCALL */ + regs->SYSCALL_ARG1_REG = address; + +#ifdef __aarch64__ + if (aarch64_set_regs (tracee->pid, regs, false)) + goto fail; +#else /* !__aarch64__ */ + if (ptrace (PTRACE_SETREGS, tracee->pid, NULL, regs)) + goto fail; +#endif /* __aarch64__ */ + + /* Resume the system call. */ + return 0; + + fail: + errno = EIO; + return 1; +#endif /* REENTRANT */ +} + /* Process the system call at which TRACEE is stopped. If the system call is not known or not exec, send TRACEE on its way. Otherwise, rewrite it to load the loader and perform an appropriate action. */ @@ -1056,9 +1148,50 @@ process_system_call (struct exec_tracee *tracee) goto emulate_syscall; } + goto continue_syscall; + +#ifdef OPEN_SYSCALL + case OPEN_SYSCALL: +#endif /* OPEN_SYSCALL */ + case OPENAT_SYSCALL: + + /* This system call is already in progress if + TRACEE->waiting_for_syscall is true. */ + + if (!tracee->waiting_for_syscall) + { + /* Handle this open system call. */ + rc = handle_openat (callno, ®s, tracee, &result); + + /* rc means the same as in `handle_exec', except that `open' + is never emulated. */ + + if (rc == 1) + goto report_syscall_error; + + /* The stack pointer must be restored after it was modified + by `user_alloca'; record sp in TRACEE, which will be + restored after this system call completes. */ + tracee->sp = sp; + } + else + { + /* Restore that stack pointer. */ + regs.STACK_POINTER = tracee->sp; + +#ifdef __aarch64__ + if (aarch64_set_regs (tracee->pid, ®s, true)) + return; +#else /* !__aarch64__ */ + if (ptrace (PTRACE_SETREGS, tracee->pid, NULL, ®s)) + return; +#endif /* __aarch64__ */ + } + /* Fallthrough. */ default: + continue_syscall: /* Don't wait for the system call to finish; instead, the system will DTRT upon the next call to PTRACE_SYSCALL after the syscall-trap signal is delivered. */ -- cgit v1.2.3 From 89734c4f1d2fb9aa18e44481174eb595134f497b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 26 Jan 2024 23:03:00 -0500 Subject: pdumder.c: Fix bug#68690 The problem was that the offset computed for the `charset_table` array was a multiple of 4 but the `struct charset` needed an alignment on a multiple of 8, so `dump_charset` inserted 4 bytes of padding, whereas you can't have padding at the beginning of an array. * src/pdumper.c (dump_charset): Don't set alignment here. (dump_charset_table): Set it here instead. --- src/pdumper.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/pdumper.c b/src/pdumper.c index f42d1777371..6b0178227bd 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -3216,7 +3216,9 @@ dump_charset (struct dump_context *ctx, int cs_i) #if CHECK_STRUCTS && !defined (HASH_charset_E31F4B5D96) # error "charset changed. See CHECK_STRUCTS comment in config.h." #endif - dump_align_output (ctx, alignof (struct charset)); + /* We can't change the alignment here, because `offset` is what + will be used for the whole array. */ + eassert (ctx->offset % alignof (struct charset) == 0); const struct charset *cs = charset_table + cs_i; struct charset out; dump_object_start (ctx, &out, sizeof (out)); @@ -3257,7 +3259,7 @@ dump_charset_table (struct dump_context *ctx) { struct dump_flags old_flags = ctx->flags; ctx->flags.pack_objects = true; - dump_align_output (ctx, DUMP_ALIGNMENT); + dump_align_output (ctx, alignof (struct charset)); dump_off offset = ctx->offset; if (dump_set_referrer (ctx)) ctx->current_referrer = build_string ("charset_table"); -- cgit v1.2.3 From 08007a030e03762b888dcfcd64e84f03e5a2d54f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 26 Jan 2024 23:15:57 -0500 Subject: pdumper.c: Minor improvements found while debugging * src/pdumper.c (dump_hash_table_list): Remove unused return value; and simplify with `vconcat`. (dump_charset): Don't copy uninitialized fields. --- src/pdumper.c | 57 +++++++++++++++++++++++++++++---------------------------- 1 file changed, 29 insertions(+), 28 deletions(-) diff --git a/src/pdumper.c b/src/pdumper.c index 6b0178227bd..6d0abc5d835 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2659,13 +2659,11 @@ hash_table_contents (struct Lisp_Hash_Table *h) return key_and_value; } -static dump_off +static void dump_hash_table_list (struct dump_context *ctx) { if (!NILP (ctx->hash_tables)) - return dump_object (ctx, CALLN (Fapply, Qvector, ctx->hash_tables)); - else - return 0; + dump_object (ctx, CALLN (Fvconcat, ctx->hash_tables)); } static hash_table_std_test_t @@ -3222,30 +3220,33 @@ dump_charset (struct dump_context *ctx, int cs_i) const struct charset *cs = charset_table + cs_i; struct charset out; dump_object_start (ctx, &out, sizeof (out)); - DUMP_FIELD_COPY (&out, cs, id); - dump_field_lv (ctx, &out, cs, &cs->attributes, WEIGHT_NORMAL); - DUMP_FIELD_COPY (&out, cs, dimension); - memcpy (out.code_space, &cs->code_space, sizeof (cs->code_space)); - if (cs_i < charset_table_used && cs->code_space_mask) - dump_field_fixup_later (ctx, &out, cs, &cs->code_space_mask); - DUMP_FIELD_COPY (&out, cs, code_linear_p); - DUMP_FIELD_COPY (&out, cs, iso_chars_96); - DUMP_FIELD_COPY (&out, cs, ascii_compatible_p); - DUMP_FIELD_COPY (&out, cs, supplementary_p); - DUMP_FIELD_COPY (&out, cs, compact_codes_p); - DUMP_FIELD_COPY (&out, cs, unified_p); - DUMP_FIELD_COPY (&out, cs, iso_final); - DUMP_FIELD_COPY (&out, cs, iso_revision); - DUMP_FIELD_COPY (&out, cs, emacs_mule_id); - DUMP_FIELD_COPY (&out, cs, method); - DUMP_FIELD_COPY (&out, cs, min_code); - DUMP_FIELD_COPY (&out, cs, max_code); - DUMP_FIELD_COPY (&out, cs, char_index_offset); - DUMP_FIELD_COPY (&out, cs, min_char); - DUMP_FIELD_COPY (&out, cs, max_char); - DUMP_FIELD_COPY (&out, cs, invalid_code); - memcpy (out.fast_map, &cs->fast_map, sizeof (cs->fast_map)); - DUMP_FIELD_COPY (&out, cs, code_offset); + if (cs_i < charset_table_used) /* Don't look at uninitialized data. */ + { + DUMP_FIELD_COPY (&out, cs, id); + dump_field_lv (ctx, &out, cs, &cs->attributes, WEIGHT_NORMAL); + DUMP_FIELD_COPY (&out, cs, dimension); + memcpy (out.code_space, &cs->code_space, sizeof (cs->code_space)); + if (cs->code_space_mask) + dump_field_fixup_later (ctx, &out, cs, &cs->code_space_mask); + DUMP_FIELD_COPY (&out, cs, code_linear_p); + DUMP_FIELD_COPY (&out, cs, iso_chars_96); + DUMP_FIELD_COPY (&out, cs, ascii_compatible_p); + DUMP_FIELD_COPY (&out, cs, supplementary_p); + DUMP_FIELD_COPY (&out, cs, compact_codes_p); + DUMP_FIELD_COPY (&out, cs, unified_p); + DUMP_FIELD_COPY (&out, cs, iso_final); + DUMP_FIELD_COPY (&out, cs, iso_revision); + DUMP_FIELD_COPY (&out, cs, emacs_mule_id); + DUMP_FIELD_COPY (&out, cs, method); + DUMP_FIELD_COPY (&out, cs, min_code); + DUMP_FIELD_COPY (&out, cs, max_code); + DUMP_FIELD_COPY (&out, cs, char_index_offset); + DUMP_FIELD_COPY (&out, cs, min_char); + DUMP_FIELD_COPY (&out, cs, max_char); + DUMP_FIELD_COPY (&out, cs, invalid_code); + memcpy (out.fast_map, &cs->fast_map, sizeof (cs->fast_map)); + DUMP_FIELD_COPY (&out, cs, code_offset); + } dump_off offset = dump_object_finish (ctx, &out, sizeof (out)); if (cs_i < charset_table_used && cs->code_space_mask) dump_remember_cold_op (ctx, COLD_OP_CHARSET, -- cgit v1.2.3 From 1ef8b90ae06d698ab2ba9b43f67fde7289db2c5d Mon Sep 17 00:00:00 2001 From: Randy Taylor Date: Wed, 24 Jan 2024 21:39:45 -0500 Subject: Simplify imenu setup for {cmake,dockerfile}-ts-modes * lisp/progmodes/cmake-ts-mode.el (treesit-induce-sparse-tree, treesit-node-child, treesit-node-start, cmake-ts-mode--imenu, cmake-ts-mode--imenu-1): Remove. (treesit-search-subtree): Declare. (cmake-ts-mode--function-name): New function. (cmake-ts-mode): Use it. * lisp/progmodes/dockerfile-ts-mode.el (treesit-induce-sparse-tree, treesit-node-start, dockerfile-ts-mode--imenu, dockerfile-ts-mode--imenu-1): Remove. (dockerfile-ts-mode--stage-name): New function. (dockerfile-ts-mode): Use it. --- lisp/progmodes/cmake-ts-mode.el | 46 +++++++++-------------------------- lisp/progmodes/dockerfile-ts-mode.el | 47 +++++++++--------------------------- 2 files changed, 22 insertions(+), 71 deletions(-) diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el index d933e4ebb81..29c9e957d3c 100644 --- a/lisp/progmodes/cmake-ts-mode.el +++ b/lisp/progmodes/cmake-ts-mode.el @@ -32,10 +32,8 @@ (declare-function treesit-parser-create "treesit.c") (declare-function treesit-query-capture "treesit.c") -(declare-function treesit-induce-sparse-tree "treesit.c") -(declare-function treesit-node-child "treesit.c") -(declare-function treesit-node-start "treesit.c") (declare-function treesit-node-type "treesit.c") +(declare-function treesit-search-subtree "treesit.c") (defcustom cmake-ts-mode-indent-offset 2 "Number of spaces for each indentation step in `cmake-ts-mode'." @@ -195,37 +193,14 @@ Check if a node type is available, then return the right font lock rules." '((ERROR) @font-lock-warning-face)) "Tree-sitter font-lock settings for `cmake-ts-mode'.") -(defun cmake-ts-mode--imenu () - "Return Imenu alist for the current buffer." - (let* ((node (treesit-buffer-root-node)) - (func-tree (treesit-induce-sparse-tree - node "function_def" nil 1000)) - (func-index (cmake-ts-mode--imenu-1 func-tree))) - (append - (when func-index `(("Function" . ,func-index)))))) - -(defun cmake-ts-mode--imenu-1 (node) - "Helper for `cmake-ts-mode--imenu'. -Find string representation for NODE and set marker, then recurse -the subtrees." - (let* ((ts-node (car node)) - (children (cdr node)) - (subtrees (mapcan #'cmake-ts-mode--imenu-1 - children)) - (name (when ts-node - (pcase (treesit-node-type ts-node) - ("function_def" - (treesit-node-text - (treesit-node-child (treesit-node-child ts-node 0) 2) t))))) - (marker (when ts-node - (set-marker (make-marker) - (treesit-node-start ts-node))))) - (cond - ((or (null ts-node) (null name)) subtrees) - (subtrees - `((,name ,(cons name marker) ,@subtrees))) - (t - `((,name . ,marker)))))) +(defun cmake-ts-mode--function-name (node) + "Return the function name of NODE. +Return nil if there is no name or if NODE is not a function node." + (pcase (treesit-node-type node) + ("function_command" + (treesit-node-text + (treesit-search-subtree node "^argument$" nil nil 2) + t)))) ;;;###autoload (define-derived-mode cmake-ts-mode prog-mode "CMake" @@ -242,7 +217,8 @@ the subtrees." (setq-local comment-start-skip (rx "#" (* (syntax whitespace)))) ;; Imenu. - (setq-local imenu-create-index-function #'cmake-ts-mode--imenu) + (setq-local treesit-simple-imenu-settings + `(("Function" "\\`function_command\\'" nil cmake-ts-mode--function-name))) (setq-local which-func-functions nil) ;; Indent. diff --git a/lisp/progmodes/dockerfile-ts-mode.el b/lisp/progmodes/dockerfile-ts-mode.el index d5b7f953e31..878335431af 100644 --- a/lisp/progmodes/dockerfile-ts-mode.el +++ b/lisp/progmodes/dockerfile-ts-mode.el @@ -31,10 +31,8 @@ (eval-when-compile (require 'rx)) (declare-function treesit-parser-create "treesit.c") -(declare-function treesit-induce-sparse-tree "treesit.c") (declare-function treesit-node-child "treesit.c") (declare-function treesit-node-child-by-field-name "treesit.c") -(declare-function treesit-node-start "treesit.c") (declare-function treesit-node-type "treesit.c") (defvar dockerfile-ts-mode--syntax-table @@ -118,38 +116,15 @@ continuation to the previous entry." '((ERROR) @font-lock-warning-face)) "Tree-sitter font-lock settings.") -(defun dockerfile-ts-mode--imenu () - "Return Imenu alist for the current buffer." - (let* ((node (treesit-buffer-root-node)) - (stage-tree (treesit-induce-sparse-tree - node "from_instruction" - nil 1000)) - (stage-index (dockerfile-ts-mode--imenu-1 stage-tree))) - (when stage-index `(("Stage" . ,stage-index))))) - -(defun dockerfile-ts-mode--imenu-1 (node) - "Helper for `dockerfile-ts-mode--imenu'. -Find string representation for NODE and set marker, then recurse -the subtrees." - (let* ((ts-node (car node)) - (children (cdr node)) - (subtrees (mapcan #'dockerfile-ts-mode--imenu-1 - children)) - (name (when ts-node - (pcase (treesit-node-type ts-node) - ("from_instruction" - (treesit-node-text - (or (treesit-node-child-by-field-name ts-node "as") - (treesit-node-child ts-node 1)) t))))) - (marker (when ts-node - (set-marker (make-marker) - (treesit-node-start ts-node))))) - (cond - ((or (null ts-node) (null name)) subtrees) - (subtrees - `((,name ,(cons name marker) ,@subtrees))) - (t - `((,name . ,marker)))))) +(defun dockerfile-ts-mode--stage-name (node) + "Return the stage name of NODE. +Return nil if there is no name or if NODE is not a stage node." + (pcase (treesit-node-type node) + ("from_instruction" + (treesit-node-text + (or (treesit-node-child-by-field-name node "as") + (treesit-node-child node 1)) + t)))) ;;;###autoload (define-derived-mode dockerfile-ts-mode prog-mode "Dockerfile" @@ -166,8 +141,8 @@ the subtrees." (setq-local comment-start-skip (rx "#" (* (syntax whitespace)))) ;; Imenu. - (setq-local imenu-create-index-function - #'dockerfile-ts-mode--imenu) + (setq-local treesit-simple-imenu-settings + `(("Stage" "\\`from_instruction\\'" nil dockerfile-ts-mode--stage-name))) (setq-local which-func-functions nil) ;; Indent. -- cgit v1.2.3 From 53481cc954641256602830a6d74def86440ac4a9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 10:11:32 +0200 Subject: Fix description of when "\xNNN" is considered a unibyte character * doc/lispref/objects.texi (Non-ASCII in Strings): More accurate description of when a hexadecimal escape sequence yields a unibyte character. (Bug#68751) --- doc/lispref/objects.texi | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 13c5f06b0bd..7b2a4af303f 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -1180,13 +1180,14 @@ character), Emacs automatically assumes that it is multibyte. You can also use hexadecimal escape sequences (@samp{\x@var{n}}) and octal escape sequences (@samp{\@var{n}}) in string constants. -@strong{But beware:} If a string constant contains hexadecimal or -octal escape sequences, and these escape sequences all specify unibyte -characters (i.e., less than 256), and there are no other literal -non-@acronym{ASCII} characters or Unicode-style escape sequences in -the string, then Emacs automatically assumes that it is a unibyte -string. That is to say, it assumes that all non-@acronym{ASCII} -characters occurring in the string are 8-bit raw bytes. +@strong{But beware:} If a string constant contains octal escape +sequences or one- or two-digit hexadecimal escape sequences, and these +escape sequences all specify unibyte characters (i.e., codepoints less +than 256), and there are no other literal non-@acronym{ASCII} +characters or Unicode-style escape sequences in the string, then Emacs +automatically assumes that it is a unibyte string. That is to say, it +assumes that all non-@acronym{ASCII} characters occurring in the +string are 8-bit raw bytes. In hexadecimal and octal escape sequences, the escaped character code may contain a variable number of digits, so the first subsequent -- cgit v1.2.3 From 43e2f3acdd2dbd040ec2fc473ca60ee3179bb796 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 10:38:14 +0200 Subject: ; Minor improvements in 'visual-wrap-prefix-mode' * lisp/visual-wrap.el (visual-wrap-extra-indent): Add :version. (visual-wrap-fill-context-prefix): Doc fix. * lisp/menu-bar.el (menu-bar-line-wrapping-menu): Move the menu to a better place, improve the help-echo text. * etc/NEWS: * doc/emacs/basic.texi (Continuation Lines): Improve documentation and indexing of 'visual-wrap-prefix-mode'. --- doc/emacs/basic.texi | 5 +++-- etc/NEWS | 18 +++++++++--------- lisp/menu-bar.el | 15 ++++++++------- lisp/visual-wrap.el | 6 ++++-- 4 files changed, 24 insertions(+), 20 deletions(-) diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index a6b71db4bea..cdc183c2a40 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -630,7 +630,7 @@ before they get too long, by inserting newlines. If you prefer, you can make Emacs insert a newline automatically when a line gets too long, by using Auto Fill mode. @xref{Filling}. -@cindex continuation lines, wrapping with prefix +@cindex continuation lines, visual wrap prefix @findex 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. @@ -639,7 +639,8 @@ 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. +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 37a017c4db1..d69d0001135 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -319,15 +319,15 @@ name detection. +++ ** New minor mode 'visual-wrap-prefix-mode'. - -When enabled, continuation lines displayed for a folded long line will -receive a 'wrap-prefix' automatically computed from the line's -surrounding context by the function 'fill-context-prefix', which -generally indents continuation lines as if the line were filled with -'M-q', or similar. - -This minor mode is the 'adaptive-wrap' ELPA package renamed and -lightly edited for inclusion in Emacs. +When enabled, continuation lines displayed for a wrapped long line +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. + +(This minor mode is the 'adaptive-wrap' ELPA package renamed and +lightly edited for inclusion in Emacs.) +++ ** New user option 'gud-highlight-current-line'. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 761f0603c75..47c6a8f0613 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1438,6 +1438,14 @@ mail status in mode line")) (defvar menu-bar-line-wrapping-menu (let ((menu (make-sparse-keymap "Line Wrapping"))) + (bindings--define-key menu [visual-wrap] + '(menu-item "Visual Wrap Prefix mode" visual-wrap-prefix-mode + :help "Display continuation lines with visual context-dependent prefix" + :visible (menu-bar-menu-frame-live-and-visible-p) + :button (:toggle + . (bound-and-true-p visual-wrap-prefix-mode)) + :enable t)) + (bindings--define-key menu [word-wrap] '(menu-item "Word Wrap (Visual Line mode)" menu-bar--visual-line-mode-enable @@ -1467,13 +1475,6 @@ mail status in mode line")) (not word-wrap))) :visible (menu-bar-menu-frame-live-and-visible-p) :enable (not (truncated-partial-width-window-p)))) - - (bindings--define-key menu [visual-wrap] - '(menu-item "Visual Wrap Prefix" visual-wrap-prefix-mode - :help "Display continuation lines with contextual prefix" - :visible (menu-bar-menu-frame-live-and-visible-p) - :button (:toggle . (bound-and-true-p visual-wrap-prefix-mode)) - :enable t)) menu)) (defvar menu-bar-search-options-menu diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index f8e00b9c685..1cb49538eae 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -59,6 +59,7 @@ extra indent = 2 ullamco laboris nisi ut aliquip ex ea commodo consequat." :type 'integer :safe 'integerp + :version "30.1" :group 'visual-line) (defun visual-wrap--face-extend-p (face) @@ -111,8 +112,9 @@ extra indent = 2 "")))) (defun visual-wrap-fill-context-prefix (beg end) - "Like `fill-context-prefix', but with length adjusted by -`visual-wrap-extra-indent'." + "Compute visual wrap prefix from text between FROM and TO. +This is like `fill-context-prefix', but with prefix length adjusted +by `visual-wrap-extra-indent'." (let* ((fcp ;; `fill-context-prefix' ignores prefixes that look like ;; paragraph starts, in order to avoid inadvertently -- cgit v1.2.3 From 8163e0b20c97a8394225a7165a8ab361af09ec29 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 10:52:47 +0200 Subject: Improve 'refill-mode' in Org buffers * lisp/textmodes/refill.el (refill-fill-paragraph-at): Use 'fill-forward-paragraph' instead of 'forward/backward-paragraph', so that modes could customize the behavior. (Bug#68418) --- lisp/textmodes/refill.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el index bb6b6ebda0f..244c96b60df 100644 --- a/lisp/textmodes/refill.el +++ b/lisp/textmodes/refill.el @@ -106,10 +106,10 @@ This is used to optimize refilling.") ;; FIXME: forward-paragraph seems to disregard `use-hard-newlines', ;; leading to excessive refilling and wrong choice of fill-prefix. ;; might be a bug in my paragraphs.el. - (forward-paragraph) + (fill-forward-paragraph) (skip-syntax-backward "-") (let ((end (point)) - (beg (progn (backward-paragraph) (point))) + (beg (progn (fill-forward-paragraph -1) (point))) (obeg (overlay-start refill-ignorable-overlay)) (oend (overlay-end refill-ignorable-overlay))) (unless (> beg pos) ;Don't fill if point is outside the paragraph. -- cgit v1.2.3 From fa7543eeb72342544d324a54010b6cb96c246733 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 11:44:54 +0200 Subject: Minor fix in 'describe-language-environment' * lisp/international/mule-cmds.el (describe-language-environment): Use 'current-language-environment' as DEFAULT in the prompt. Patch by Thierry Volpiatto . (Bug#68602) --- lisp/international/mule-cmds.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 07f11a62594..6b4c83112e3 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -2159,7 +2159,9 @@ See `set-language-info-alist' for use in programs." (interactive (list (read-language-name 'documentation - (format-prompt "Describe language environment" current-language-environment)))) + (format-prompt "Describe language environment" + current-language-environment) + current-language-environment))) (let ((help-buffer-under-preparation t)) (if (null language-name) (setq language-name current-language-environment)) -- cgit v1.2.3 From f0c573d8069f7ee654a550ae3d148325c49900a3 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 20 Jan 2024 12:24:32 +0100 Subject: Optionally avoid extending 'completion-at-point-functions' It is now possible to avoid extending 'completion-at-point-functions' in Text mode and its descendants. * lisp/textmodes/text-mode.el (text-mode-meta-tab-ispell-complete-word): Rename to... (text-mode-ispell-word-completion): ...this. Extend with another option 'completion-at-point'. (text-mode): Only extend 'completion-at-point-functions' when 'text-mode-ispell-word-completion' is 'completion-at-point'. (Bug#67527) * etc/NEWS: Update the entry about 'M-TAB' in Text mode. --- etc/NEWS | 13 +++++++------ lisp/textmodes/text-mode.el | 19 ++++++++++++++----- 2 files changed, 21 insertions(+), 11 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index d69d0001135..b249f7e1ecb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1346,12 +1346,13 @@ files and save the changes. +++ ** 'M-TAB' now invokes 'completion-at-point' also in Text mode. -Text mode no longer binds 'M-TAB' to 'ispell-complete-word', and -instead this mode arranges for 'completion-at-point', globally bound -to 'M-TAB', to perform word completion as well. If you want 'M-TAB' -to invoke 'ispell-complete-word', as it did in previous Emacs -versions, customize the new user option -'text-mode-meta-tab-ispell-complete-word' to non-nil. +By default, Text mode no longer binds 'M-TAB' to +'ispell-complete-word'. Instead this mode arranges for +'completion-at-point', globally bound to 'M-TAB', to perform word +completion as well. You can have Text mode bind 'M-TAB' to +'ispell-complete-word' as it did in previous Emacs versions, or +disable Ispell word completion in Text mode altogether, by customizing +the new user option 'text-mode-ispell-word-completion'. ** 'pp' and 'pp-to-string' now always include a terminating newline. In the past they included a terminating newline in most cases but not all. diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index 7d3b47a9c03..87f6668cecb 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -75,8 +75,15 @@ Many other modes, such as `mail-mode' and `outline-mode', inherit all the commands defined in this map.") -(defcustom text-mode-meta-tab-ispell-complete-word nil - "Whether M-TAB invokes `ispell-complete-word' in Text mode. +(defcustom text-mode-ispell-word-completion 'completion-at-point + "How Text mode provides Ispell word completion. + +By default, this option is set to `completion-at-point', which +means that Text mode adds an Ispell word completion function to +`completion-at-point-functions'. Any other non-nil value says to +bind M-TAB directly to `ispell-complete-word' instead. If this +is nil, Text mode neither binds M-TAB to `ispell-complete-word' +nor does it extend `completion-at-point-functions'. This user option only takes effect when you customize it in Custom or with `setopt', not with `setq'." @@ -84,8 +91,9 @@ Custom or with `setopt', not with `setq'." :type 'boolean :version "30.1" :set (lambda (sym val) - (if (set sym val) - (keymap-set text-mode-map "C-M-i" #'ispell-complete-word) + (if (and (set sym val) + (not (eq val 'completion-at-point))) + (keymap-set text-mode-map "C-M-i" #'ispell-complete-word) (keymap-unset text-mode-map "C-M-i" t)))) (easy-menu-define text-mode-menu text-mode-map @@ -144,7 +152,8 @@ Turning on Text mode runs the normal hook `text-mode-hook'." ;; Enable text conversion in this buffer. (setq-local text-conversion-style t) (add-hook 'context-menu-functions 'text-mode-context-menu 10 t) - (add-hook 'completion-at-point-functions #'ispell-completion-at-point 10 t)) + (when (eq text-mode-ispell-word-completion 'completion-at-point) + (add-hook 'completion-at-point-functions #'ispell-completion-at-point 10 t))) (define-derived-mode paragraph-indent-text-mode text-mode "Parindent" "Major mode for editing text, with leading spaces starting a paragraph. -- cgit v1.2.3 From 09cdf8a406c5b73e8924a7396c2aaabe74a1a638 Mon Sep 17 00:00:00 2001 From: Jakub Ječmínek Date: Fri, 19 Jan 2024 16:38:21 +0100 Subject: Fix syntax highlighting after string literal concat in python-mode * lisp/progmodes/python.el (python-syntax-stringify): Fix incorrect font-lock after string literal concatenation. (Bug#45897) * test/lisp/progmodes/python-tests.el (python-font-lock-string-literal-concatenation): New test. Co-authored-by: kobarity Copyright-paperwork-exempt: yes --- lisp/progmodes/python.el | 3 +++ test/lisp/progmodes/python-tests.el | 12 ++++++++++++ 2 files changed, 15 insertions(+) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 41f612c8b1c..9d840efb9da 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -909,6 +909,7 @@ is used to limit the scan." "Put `syntax-table' property correctly on single/triple quotes." (let* ((ppss (save-excursion (backward-char 3) (syntax-ppss))) (string-start (and (eq t (nth 3 ppss)) (nth 8 ppss))) + (string-literal-concat (numberp (nth 3 ppss))) (quote-starting-pos (- (point) 3)) (quote-ending-pos (point))) (cond ((or (nth 4 ppss) ;Inside a comment @@ -921,6 +922,8 @@ is used to limit the scan." ((nth 5 ppss) ;; The first quote is escaped, so it's not part of a triple quote! (goto-char (1+ quote-starting-pos))) + ;; Handle string literal concatenation (bug#45897) + (string-literal-concat nil) ((null string-start) ;; This set of quotes delimit the start of a string. Put ;; string fence syntax on last quote. (bug#49518) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 97ffd5fe20f..59957ff0712 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -660,6 +660,18 @@ r'\\x12 \123 \\n \\u1234 \\U00010348 \\N{Plus-Minus Sign}'" (3 . font-lock-string-face) (14) (16 . font-lock-string-face)))) +(ert-deftest python-font-lock-string-literal-concatenation () + "Test for bug#45897." + (python-tests-assert-faces + "x = \"hello\"\"\" +y = \"confused\"" + '((1 . font-lock-variable-name-face) (2) + (3 . font-lock-operator-face) (4) + (5 . font-lock-string-face) (14) + (15 . font-lock-variable-name-face) (16) + (17 . font-lock-operator-face) (18) + (19 . font-lock-string-face)))) + ;;; Indentation -- cgit v1.2.3 From 756daa93b3ef7ce33e741ab30000fa397fcd9783 Mon Sep 17 00:00:00 2001 From: Mekeor Melire Date: Mon, 4 Dec 2023 16:37:37 +0100 Subject: Add option Info-url-alist * lisp/info.el (Info-url-alist): New option mapping manuals to URLs. (Info-url-for-node): Use it. * test/lisp/info-tests.el (test-info-urls): Add more tests. In particular, 'Info-url-for-node' should error when manual-name is not handled in 'Info-url-alist'. * etc/NEWS: Announce the change. (Bug#67615) --- etc/NEWS | 9 ++++ lisp/info.el | 108 ++++++++++++++++++++++++++++++++++++++---------- test/lisp/info-tests.el | 14 +++++-- 3 files changed, 105 insertions(+), 26 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index b249f7e1ecb..7e30cda7226 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -436,6 +436,15 @@ only to specify the 'mouse-4/5/6/7' events generated by older configurations such as X11 when the X server does not support at least version 2.1 of the X Input Extension, and 'xterm-mouse-mode'. +** Info + +--- +*** New user option 'Info-url-alist'. +This user option associates manual-names with URLs. It affects the +'Info-goto-node-web' command. By default, associations for all +Emacs-included manuals are set. Further associations can be added for +arbitrary Info manuals. + +++ ** New command 'lldb'. Run the LLDB debugger, analogous to the 'gud-gdb' command. diff --git a/lisp/info.el b/lisp/info.el index e56344825b9..e91cc7b8e54 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -213,6 +213,53 @@ a version of Emacs without installing it.") These directories are searched after those in `Info-directory-list'." :type '(repeat directory)) +(defcustom Info-url-alist + '((("auth" "autotype" "bovine" "calc" "ccmode" "cl" "dbus" "dired-x" + "ebrowse" "ede" "ediff" "edt" "efaq" "efaq-w32" "eglot" "eieio" + "eintr" "elisp" "emacs" "emacs-gnutls" "emacs-mime" "epa" "erc" + "ert" "eshell" "eudc" "eww" "flymake" "forms" "gnus" + "htmlfontify" "idlwave" "ido" "info" "mairix-el" "message" + "mh-e" "modus-themes" "newsticker" "nxml-mode" "octave-mode" + "org" "pcl-cvs" "pgg" "rcirc" "reftex" "remember" "sasl" "sc" + "semantic" "ses" "sieve" "smtpmail" "speedbar" "srecode" + "todo-mode" "tramp" "transient" "url" "use-package" "vhdl-mode" + "vip" "viper" "vtable" "widget" "wisent" "woman") . + "https://www.gnu.org/software/emacs/manual/html_node/%m/%e")) + "Alist telling `Info-mode' where manuals are accessible online. + +Each element of this list has the form (MANUALs . URL-SPEC). +MANUALs represents the name of one or more manuals. It can +either be a string or a list of strings. URL-SPEC can be a +string in which the substring \"%m\" will be expanded to the +manual-name, \"%n\" to the node-name, and \"%e\" to the +URL-encoded node-name (without a `.html' suffix). (The +URL-encoding of the node-name mimics GNU Texinfo, as documented +at Info node `(texinfo)HTML Xref Node Name Expansion'.) +Alternatively, URL-SPEC can be a function which is given +manual-name, node-name and URL-encoded node-name as arguments, +and is expected to return the corresponding URL as a string. + +This variable particularly affects the command +`Info-goto-node-web', which see. + +The default value of this variable refers to the official, +HTTPS-accessible HTML-representations of all manuals that Emacs +includes. These URLs refer to the most recently released version +of Emacs, disregarding the version of the running Emacs. In +other words, the content of your local Info node and the +associated online node may differ. The resource represented by +the generated URL may even be not found by the gnu.org server." + :version "30.1" + :type '(alist + :tag "Mapping from manual-name(s) to URL-specification" + :key-type (choice + (string :tag "A single manual-name") + (repeat :tag "List of manual-names" string)) + :value-type (choice + (string :tag "URL-specification string") + (function + :tag "URL-specification function")))) + (defcustom Info-scroll-prefer-subnodes nil "If non-nil, \\\\[Info-scroll-up] in a menu visits subnodes. @@ -1854,33 +1901,50 @@ By default, go to the current Info node." (Info-url-for-node (format "(%s)%s" filename node))))) (defun Info-url-for-node (node) - "Return a URL for NODE, a node in the GNU Emacs or Elisp manual. -NODE should be a string on the form \"(manual)Node\". Only emacs -and elisp manuals are supported." - (unless (string-match "\\`(\\(.+\\))\\(.+\\)\\'" node) - (error "Invalid node name %s" node)) - (let ((manual (match-string 1 node)) - (node (match-string 2 node))) - (unless (member manual '("emacs" "elisp")) - (error "Only emacs/elisp manuals are supported")) - ;; Encode a bunch of characters the way that makeinfo does. - (setq node - (mapconcat (lambda (ch) - (if (or (< ch 32) ; ^@^A-^Z^[^\^]^^^- + "Return the URL corresponding to NODE. + +NODE should be a string of the form \"(manual)Node\"." + ;; GNU Texinfo skips whitespaces and newlines between the closing + ;; parenthesis and the node-name, i.e. space, tab, line feed and + ;; carriage return. + (unless (string-match "\\`(\\(.+\\))[ \t\n\r]*\\(.+\\)\\'" node) + (error "Invalid node-name %s" node)) + ;; Use `if-let*' instead of `let*' so we check if an association was + ;; found. + (if-let* ((manual (match-string 1 node)) + (node (match-string 2 node)) + (association (seq-find + (lambda (pair) + (seq-contains-p (ensure-list (car pair)) + manual #'string-equal-ignore-case)) + Info-url-alist)) + (url-spec (cdr association)) + (encoded-node + ;; Reproduce GNU Texinfo's way of URL-encoding. + ;; (info "(texinfo) HTML Xref Node Name Expansion") + (if (equal node "Top") + "" + (url-hexify-string + (string-replace " " "-" + (mapconcat + (lambda (ch) + (if (or (< ch 32) ; ^@^A-^Z^[^\^]^^^- (<= 33 ch 47) ; !"#$%&'()*+,-./ (<= 58 ch 64) ; :;<=>?@ (<= 91 ch 96) ; [\]_` (<= 123 ch 127)) ; {|}~ DEL (format "_00%x" ch) - (char-to-string ch))) - node - "")) - (concat "https://www.gnu.org/software/emacs/manual/html_node/" - manual "/" - (and (not (equal node "Top")) - (concat - (url-hexify-string (string-replace " " "-" node)) - ".html"))))) + (char-to-string ch))) + node "")))))) + (cond + ((stringp url-spec) + (format-spec url-spec + `((?m . ,manual) (?n . ,node) (?e . ,encoded-node)))) + ((functionp url-spec) + (funcall url-spec manual node encoded-node)) + (t (error "URL-specification neither string nor function"))) + (error "No URL-specification associated with manual-name `%s'" + manual))) (defvar Info-read-node-completion-table) diff --git a/test/lisp/info-tests.el b/test/lisp/info-tests.el index ebe718167bf..0dfdbf417e8 100644 --- a/test/lisp/info-tests.el +++ b/test/lisp/info-tests.el @@ -29,11 +29,17 @@ (ert-deftest test-info-urls () (should (equal (Info-url-for-node "(emacs)Minibuffer") - "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer.html")) + "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer")) (should (equal (Info-url-for-node "(emacs)Minibuffer File") - "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer-File.html")) + "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer-File")) (should (equal (Info-url-for-node "(elisp)Backups and Auto-Saving") - "https://www.gnu.org/software/emacs/manual/html_node/elisp/Backups-and-Auto_002dSaving.html")) - (should-error (Info-url-for-node "(gnus)Minibuffer File"))) + "https://www.gnu.org/software/emacs/manual/html_node/elisp/Backups-and-Auto_002dSaving")) + (should (equal (Info-url-for-node "(eintr)car & cdr") + "https://www.gnu.org/software/emacs/manual/html_node/eintr/car-_0026-cdr")) + (should (equal (Info-url-for-node "(emacs-mime)\tIndex") + "https://www.gnu.org/software/emacs/manual/html_node/emacs-mime/Index")) + (should (equal (Info-url-for-node "(gnus) Don't Panic") + "https://www.gnu.org/software/emacs/manual/html_node/gnus/Don_0027t-Panic")) + (should-error (Info-url-for-node "(nonexistent)Example"))) ;;; info-tests.el ends here -- cgit v1.2.3 From fc70eced27832bde0f3702a1f9033d5b81a8d61d Mon Sep 17 00:00:00 2001 From: Brad Howes Date: Sun, 21 Jan 2024 10:07:24 +0100 Subject: Downcase host names in ansi-osc.el to match URL parsing behavior * lisp/ansi-osc.el (ansi-osc-directory-tracker): Compare with 'system-name' case-insensitively. (Bug#68632) Copyright-paperwork-exempt: yes --- lisp/ansi-osc.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/ansi-osc.el b/lisp/ansi-osc.el index 7e686193f69..8dbaeb45132 100644 --- a/lisp/ansi-osc.el +++ b/lisp/ansi-osc.el @@ -121,7 +121,8 @@ and `shell-dirtrack-mode'." (let ((url (url-generic-parse-url text))) (when (and (string= (url-type url) "file") (or (null (url-host url)) - (string= (url-host url) (system-name)))) + ;; Use `downcase' to match `url-generic-parse-url' behavior + (string= (url-host url) (downcase (system-name))))) (ignore-errors (cd-absolute (url-unhex-string (url-filename url))))))) -- cgit v1.2.3 From 6b93e16e436735003d49a5a2ab451394937ee76c Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Mon, 8 Jan 2024 15:08:01 +0100 Subject: Add new option to 'register-use-preview' When set to 'insist', exit minibuffer with same key as register name, instead of pressing RET. E.g., pressing "a" selects register "a", then pressing "a" again exits the minibuffer. * lisp/register.el (register-use-preview): New option 'insist'. (register-read-with-preview-fancy): Handle new option. * doc/emacs/regs.texi: Document it. * etc/NEWS: Mention 'insist'. (Bug#68654) --- doc/emacs/regs.texi | 5 +++++ etc/NEWS | 2 +- lisp/register.el | 18 ++++++++++++++++-- 3 files changed, 22 insertions(+), 3 deletions(-) diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi index fdcddbbc739..c30bcc37999 100644 --- a/doc/emacs/regs.texi +++ b/doc/emacs/regs.texi @@ -71,6 +71,11 @@ by @code{insert-register} will only show registers whose values can be inserted into the buffer, omitting registers which hold window configurations, positions, and other un-insertable values. +@item insist +This value is like @code{t}, but in addition of pressing @key{RET} to +exit with the choosen value, you can press the same key as the name of +register. + @item nil This value requests behavior similar to @code{traditional}, but the preview is shown without delay, and is filtered according to the diff --git a/etc/NEWS b/etc/NEWS index 7e30cda7226..e854873b8d0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -639,7 +639,7 @@ This allows to customize different switches for different remote machines. +++ *** New mode of prompting for register names and showing preview. The new user option 'register-use-preview' can be customized to the -value t to request a different user interface of prompting for +value t or insist to request a different user interface of prompting for register names and previewing the registers: Emacs will require confirmation for overwriting the value of a register, and will show the preview of registers without delay. You can also customize this diff --git a/lisp/register.el b/lisp/register.el index f5b0365dec2..73d1b24b231 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -131,7 +131,11 @@ to the value of `register--read-with-preview-function'.") (defcustom register-use-preview 'traditional "Whether to show register preview when modifying registers. -When set to `t', show a preview buffer with navigation and highlighting. +When set to `t', show a preview buffer with navigation and +highlighting. +When set to \\='insist behave as with `t' but allow exiting minibuffer +by pressing a second time the selected register, e.g pressing \"a\" +select register \"a\" and pressing again \"a\" exit minibuffer. When nil, show a preview buffer without navigation and highlighting, and exit the minibuffer immediately after inserting response in minibuffer. When set to \\='never, behave as with nil, but with no preview buffer at @@ -141,6 +145,7 @@ according to `register-preview-delay'; this preserves the traditional behavior of Emacs 29 and before." :type '(choice (const :tag "Use preview" t) + (const :tag "Use preview and exit on second hit" insist) (const :tag "Use quick preview" nil) (const :tag "Never use preview" never) (const :tag "Basic preview like Emacs-29" traditional)) @@ -541,7 +546,12 @@ or \\='never." (member new strs)) new old)) (delete-minibuffer-contents) - (insert input))) + (insert input) + ;; Exit minibuffer on second hit + ;; when *-use-preview == insist. + (when (and (string= new old) + (eq register-use-preview 'insist)) + (setq noconfirm t)))) (when (and smatch (not (string= input "")) (not (member input strs))) (setq input "") @@ -551,6 +561,10 @@ or \\='never." (setq pat input)))) (if (setq win (get-buffer-window buffer)) (with-selected-window win + (when noconfirm + ;; Happen only when + ;; *-use-preview == insist. + (exit-minibuffer)) (let ((ov (make-overlay (point-min) (point-min))) ;; Allow upper-case and lower-case letters -- cgit v1.2.3 From d36c370ce555849d3d19f25999998230361cc828 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 12:52:55 +0200 Subject: ; Minor improvements of last change * lisp/register.el (register-use-preview): Doc fix. * doc/emacs/regs.texi (Registers): Fix wording. (Bug#68654) --- doc/emacs/regs.texi | 6 +++--- lisp/register.el | 9 +++++---- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi index c30bcc37999..cac5b32c566 100644 --- a/doc/emacs/regs.texi +++ b/doc/emacs/regs.texi @@ -72,9 +72,9 @@ inserted into the buffer, omitting registers which hold window configurations, positions, and other un-insertable values. @item insist -This value is like @code{t}, but in addition of pressing @key{RET} to -exit with the choosen value, you can press the same key as the name of -register. +This value is like @code{t}, but in addition you can press the same +key as the name of register one more time to exit the minibuffer, +instead of pressing @key{RET}. @item nil This value requests behavior similar to @code{traditional}, but the diff --git a/lisp/register.el b/lisp/register.el index 73d1b24b231..822467a0d72 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -133,9 +133,10 @@ to the value of `register--read-with-preview-function'.") When set to `t', show a preview buffer with navigation and highlighting. -When set to \\='insist behave as with `t' but allow exiting minibuffer -by pressing a second time the selected register, e.g pressing \"a\" -select register \"a\" and pressing again \"a\" exit minibuffer. +When set to \\='insist, behave as with `t', but allow exiting the +minibuffer by pressing the register name a second time. E.g., +press \"a\" to select register \"a\", then press \"a\" again to +exit the minibuffer. When nil, show a preview buffer without navigation and highlighting, and exit the minibuffer immediately after inserting response in minibuffer. When set to \\='never, behave as with nil, but with no preview buffer at @@ -145,7 +146,7 @@ according to `register-preview-delay'; this preserves the traditional behavior of Emacs 29 and before." :type '(choice (const :tag "Use preview" t) - (const :tag "Use preview and exit on second hit" insist) + (const :tag "Use preview and exit by pressing register name" insist) (const :tag "Use quick preview" nil) (const :tag "Never use preview" never) (const :tag "Basic preview like Emacs-29" traditional)) -- cgit v1.2.3 From 9b3f43fa08b2672a5ef33b872b2c6d1b0e881b88 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 13:28:32 +0200 Subject: ; * lisp/textmodes/refill.el (refill-fill-paragraph-at): Fix typo. --- lisp/textmodes/refill.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el index 244c96b60df..63789e887e2 100644 --- a/lisp/textmodes/refill.el +++ b/lisp/textmodes/refill.el @@ -106,7 +106,7 @@ This is used to optimize refilling.") ;; FIXME: forward-paragraph seems to disregard `use-hard-newlines', ;; leading to excessive refilling and wrong choice of fill-prefix. ;; might be a bug in my paragraphs.el. - (fill-forward-paragraph) + (fill-forward-paragraph 1) (skip-syntax-backward "-") (let ((end (point)) (beg (progn (fill-forward-paragraph -1) (point))) -- cgit v1.2.3 From da726c6de201cdb9123bd99e22206dbed5fdc50f Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 25 Jan 2024 18:56:03 +0100 Subject: Add DOHASH_SAFE, make DOHASH faster (bug#68690) Revert DOHASH to the fast (field-caching) implementation but with an assertion to detect misuses. Add DOHASH_SAFE for use in code that must tolerate arbitrary mutation of the table being iterated through. * src/lisp.h (DOHASH): Go back to fast design that only allows restricted mutation, but with a checking assertion. (DOHASH_SAFE): New macro that tolerates arbitrary mutation while being much simpler (and acceptably fast). * src/fns.c (Fmaphash): * src/comp.c (compile_function, Fcomp__compile_ctxt_to_file): Use DOHASH_SAFE. --- src/comp.c | 21 +++++++++++++-------- src/fns.c | 7 +++++-- src/lisp.h | 54 ++++++++++++++++++++++++++++++------------------------ 3 files changed, 48 insertions(+), 34 deletions(-) diff --git a/src/comp.c b/src/comp.c index 5f28cf046b5..853757f6162 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4330,9 +4330,12 @@ compile_function (Lisp_Object func) declare_block (Qentry); Lisp_Object blocks = CALL1I (comp-func-blocks, func); struct Lisp_Hash_Table *ht = XHASH_TABLE (blocks); - DOHASH (ht, block_name, block) - if (!EQ (block_name, Qentry)) - declare_block (block_name); + DOHASH_SAFE (ht, i) + { + Lisp_Object block_name = HASH_KEY (ht, i); + if (!EQ (block_name, Qentry)) + declare_block (block_name); + } gcc_jit_block_add_assignment (retrive_block (Qentry), NULL, @@ -4340,8 +4343,10 @@ compile_function (Lisp_Object func) gcc_jit_lvalue_as_rvalue (comp.func_relocs)); - DOHASH (ht, block_name, block) + DOHASH_SAFE (ht, i) { + Lisp_Object block_name = HASH_KEY (ht, i); + Lisp_Object block = HASH_VALUE (ht, i); Lisp_Object insns = CALL1I (comp-block-insns, block); if (NILP (block) || NILP (insns)) xsignal1 (Qnative_ice, @@ -4956,12 +4961,12 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, struct Lisp_Hash_Table *func_h = XHASH_TABLE (CALL1I (comp-ctxt-funcs-h, Vcomp_ctxt)); - DOHASH (func_h, k, v) - declare_function (v); + DOHASH_SAFE (func_h, i) + declare_function (HASH_VALUE (func_h, i)); /* Compile all functions. Can't be done before because the relocation structs has to be already defined. */ - DOHASH (func_h, k, v) - compile_function (v); + DOHASH_SAFE (func_h, i) + compile_function (HASH_VALUE (func_h, i)); /* Work around bug#46495 (GCC PR99126). */ #if defined (WIDE_EMACS_INT) \ diff --git a/src/fns.c b/src/fns.c index 859df6748f7..e4fa8157000 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5662,8 +5662,11 @@ set a new value for KEY, or `remhash' to remove KEY. (Lisp_Object function, Lisp_Object table) { struct Lisp_Hash_Table *h = check_hash_table (table); - DOHASH (h, k, v) - call2 (function, k, v); + /* We can't use DOHASH here since FUNCTION may violate the rules and + we shouldn't crash as a result (although the effects are + unpredictable). */ + DOHASH_SAFE (h, i) + call2 (function, HASH_KEY (h, i), HASH_VALUE (h, i)); return Qnil; } diff --git a/src/lisp.h b/src/lisp.h index d07d9d14e2f..c2dfd1afad5 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2604,32 +2604,38 @@ hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) } /* Iterate K and V as key and value of valid entries in hash table H. - The body may mutate the hash-table. */ -#define DOHASH(h, k, v) \ - for (Lisp_Object *dohash_##k##_##v##_base = (h)->key_and_value, \ - *dohash_##k##_##v##_kv = dohash_##k##_##v##_base, \ - *dohash_##k##_##v##_end = dohash_##k##_##v##_base \ - + 2 * HASH_TABLE_SIZE (h), \ - k, v; \ - dohash_##k##_##v##_kv < dohash_##k##_##v##_end \ - && (dohash_##k##_##v##_base == (h)->key_and_value \ - /* The `key_and_value` table has been reallocated! */ \ - || (dohash_##k##_##v##_kv \ - = (dohash_##k##_##v##_kv - dohash_##k##_##v##_base) \ - + (h)->key_and_value, \ - dohash_##k##_##v##_base = (h)->key_and_value, \ - dohash_##k##_##v##_end = dohash_##k##_##v##_base \ - + 2 * HASH_TABLE_SIZE (h), \ - /* Check again, in case the table has shrunk. */ \ - dohash_##k##_##v##_kv < dohash_##k##_##v##_end)) \ - && (k = dohash_##k##_##v##_kv[0], \ - v = dohash_##k##_##v##_kv[1], /*maybe unused*/ (void)v, \ - true); \ - dohash_##k##_##v##_kv += 2) \ - if (hash_unused_entry_key_p (k)) \ - ; \ + The body may remove the current entry or alter its value slot, but not + mutate TABLE in any other way. */ +#define DOHASH(h, k, v) \ + for (Lisp_Object *dohash_##k##_##v##_kv = (h)->key_and_value, \ + *dohash_##k##_##v##_end = dohash_##k##_##v##_kv \ + + 2 * HASH_TABLE_SIZE (h), \ + *dohash_##k##_##v##_base = dohash_##k##_##v##_kv, \ + k, v; \ + dohash_##k##_##v##_kv < dohash_##k##_##v##_end \ + && (k = dohash_##k##_##v##_kv[0], \ + v = dohash_##k##_##v##_kv[1], /*maybe unused*/ (void)v, \ + true); \ + eassert (dohash_##k##_##v##_base == (h)->key_and_value \ + && dohash_##k##_##v##_end \ + == dohash_##k##_##v##_base \ + + 2 * HASH_TABLE_SIZE (h)), \ + dohash_##k##_##v##_kv += 2) \ + if (hash_unused_entry_key_p (k)) \ + ; \ else +/* Iterate I as index of valid entries in hash table H. + Unlike DOHASH, this construct copes with arbitrary table mutations + in the body. The consequences of such mutations are limited to + whether and in what order entries are encountered by the loop + (which is usually bad enough), but not crashing or corrupting the + Lisp state. */ +#define DOHASH_SAFE(h, i) \ + for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); i++) \ + if (hash_unused_entry_key_p (HASH_KEY (h, i))) \ + ; \ + else void hash_table_thaw (Lisp_Object hash_table); -- cgit v1.2.3 From 85faf907618798eb09f34ba49527827b0e4026bc Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 27 Jan 2024 12:36:15 +0100 Subject: ; * lisp/visual-wrap.el: use regexp-unmatchable --- lisp/visual-wrap.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index 1cb49538eae..c23a886801d 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -123,7 +123,7 @@ by `visual-wrap-extra-indent'." ;; actually modify the buffer, so this restriction doesn't ;; make much sense (and is positively harmful in ;; taskpaper-mode where paragraph-start matches everything). - (or (let ((paragraph-start "\\`\\'a")) + (or (let ((paragraph-start regexp-unmatchable)) (fill-context-prefix beg end)) ;; Note: fill-context-prefix may return nil; See: ;; http://article.gmane.org/gmane.emacs.devel/156285 -- cgit v1.2.3 From 47ee5aacdc12516a24dbcec1d9fddae85345aa0b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 15:05:40 +0200 Subject: ; Declare tree-sitter functions in yaml-ts-mode.el * lisp/textmodes/yaml-ts-mode.el (treesit-node-start) (treesit-node-end, treesit-node-type): Declare. --- lisp/textmodes/yaml-ts-mode.el | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el index 08fe4c49733..c0185457bc2 100644 --- a/lisp/textmodes/yaml-ts-mode.el +++ b/lisp/textmodes/yaml-ts-mode.el @@ -30,6 +30,9 @@ (require 'treesit) (declare-function treesit-parser-create "treesit.c") +(declare-function treesit-node-start "treesit.c") +(declare-function treesit-node-end "treesit.c") +(declare-function treesit-node-type "treesit.c") (defvar yaml-ts-mode--syntax-table (let ((table (make-syntax-table))) -- cgit v1.2.3 From 3c2baa1b95442c114f717aaf2d017986bc07a270 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 27 Jan 2024 14:01:47 +0100 Subject: Avoid signaling errors in emoji.el on empty input * lisp/international/emoji.el (emoji--read-emoji): Signal user-error on empty input. (Bug#68671) Do not merge to master. --- lisp/international/emoji.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el index 8134214bba5..3bb5c36e4c7 100644 --- a/lisp/international/emoji.el +++ b/lisp/international/emoji.el @@ -680,11 +680,12 @@ We prefer the earliest unique letter." strings)))) (complete-with-action action table string pred))) nil t))) - (when (cl-plusp (length name)) - (let ((glyph (if emoji-alternate-names - (cadr (split-string name "\t")) - (gethash name emoji--all-bases)))) - (cons glyph (gethash glyph emoji--derived)))))) + (if (cl-plusp (length name)) + (let ((glyph (if emoji-alternate-names + (cadr (split-string name "\t")) + (gethash name emoji--all-bases)))) + (cons glyph (gethash glyph emoji--derived))) + (user-error "You didn't specify an emoji")))) (defun emoji--choose-emoji () (pcase-let ((`(,glyph . ,derived) (emoji--read-emoji))) -- cgit v1.2.3 From 63a12ffbc37e46d2752b3903228fc8ec2c1fc611 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 27 Jan 2024 14:01:47 +0100 Subject: Avoid signaling errors in emoji.el * lisp/international/emoji.el (emoji--read-emoji): Signal user-error on empty input (bug#68671). --- lisp/international/emoji.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el index 3a191c5ecd3..4f3aab5a6be 100644 --- a/lisp/international/emoji.el +++ b/lisp/international/emoji.el @@ -683,11 +683,12 @@ We prefer the earliest unique letter." strings)))) (complete-with-action action table string pred))) nil t))) - (when (cl-plusp (length name)) - (let ((glyph (if emoji-alternate-names - (cadr (split-string name "\t")) - (gethash name emoji--all-bases)))) - (cons glyph (gethash glyph emoji--derived)))))) + (if (cl-plusp (length name)) + (let ((glyph (if emoji-alternate-names + (cadr (split-string name "\t")) + (gethash name emoji--all-bases)))) + (cons glyph (gethash glyph emoji--derived))) + (user-error "You didn't specify an emoji")))) (defvar-keymap emoji-zoom-map "+" #'emoji-zoom-increase -- cgit v1.2.3 From 77d9d05df87965409c537f49d59cb5ea632abda1 Mon Sep 17 00:00:00 2001 From: Daniel Brooks Date: Sun, 5 Nov 2023 01:03:37 -0700 Subject: Calc parses fractions written using U+2044 FRACTION SLASH MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fractions of the form 123⁄456 are handled as if written 123:456. Note in particular the difference in behavior from U+2215 DIVISION SLASH and U+002F SOLIDUS, which result in division rather than a rational fraction. * lisp/calc/calc-aent.el (math-read-replacement-list): Substitute a colon for any fraction slash. (Bug#66944) * test/lisp/calc/calc-tests.el (calc-frac-input): Test various fraction types. * etc/NEWS: * doc/misc/calc.texi (Fractions): Mention fraction slash, precomposed fractions. Copyright-paperwork-exempt: yes --- doc/misc/calc.texi | 16 ++++++++++++++++ etc/NEWS | 11 ++++++++++- lisp/calc/calc-aent.el | 1 + test/lisp/calc/calc-tests.el | 25 +++++++++++++++++++++++++ 4 files changed, 52 insertions(+), 1 deletion(-) diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index 7ae338307a5..31db77a0720 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -10571,6 +10571,22 @@ Non-decimal fractions are entered and displayed as @samp{@var{radix}#@var{num}:@var{denom}} (or in the analogous three-part form). The numerator and denominator always use the same radix. +@ifnottex +Fractions may also be entered with @kbd{@U{2044}} (U+2044 FRACTION +SLASH) in place of any @kbd{:}. Precomposed fraction characters from +@kbd{@U{00BD}} (U+00BD VULGAR FRACTION ONE HALF) through +@kbd{@U{215E}} (U+215E VULGAR FRACTION SEVEN EIGHTHS) as supported as +well. Thus @samp{2:3}, @samp{2@U{2044}3}, and @samp{@U{2154}} are all +equivalent. +@end ifnottex +@iftex +Fractions may also be entered with U+2044 FRACTION SLASH in place of +any @kbd{:}. Precomposed fraction characters from U+00BD VULGAR +FRACTION ONE HALF through U+215E VULGAR FRACTION SEVEN EIGHTHS as +supported as well. +@end iftex + + @node Floats @section Floats diff --git a/etc/NEWS b/etc/NEWS index 0af275787d1..dd4a9c2afcf 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1288,7 +1288,16 @@ chat buffers use by default. +++ *** New command 'customize-dirlocals'. This command pops up a buffer to edit the settings in ".dir-locals.el". - +** Calc ++++ +*** Calc parses fractions written using U+2044 FRACTION SLASH +Fractions of the form 123⁄456 are handled as if written 123:456. Note +in particular the difference in behavior from U+2215 DIVISION SLASH +and U+002F SOLIDUS, which result in division rather than a rational +fraction. You may also be interested to know that precomposed +fraction characters, such as ½ (U+00BD VULGAR FRACTION ONE HALF), are +also recognized as rational fractions. They have been since 2004, but +it looks like it was never mentioned in the NEWS, or even the manual. * New Modes and Packages in Emacs 30.1 diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index 08e8d9fcd6f..a21efc0238d 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -505,6 +505,7 @@ The value t means abort and give an error message.") ("⅝" "(5:8)") ; 5/8 ("⅞" "(7:8)") ; 7/8 ("⅟" "1:") ; 1/... + ("⁄" ":") ; arbitrary fractions of the form 123⁄456 ;; superscripts ("⁰" "0") ; 0 ("¹" "1") ; 1 diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el index a44a5898055..d96672c04a1 100644 --- a/test/lisp/calc/calc-tests.el +++ b/test/lisp/calc/calc-tests.el @@ -734,6 +734,31 @@ An existing calc stack is reused, otherwise a new one is created." (var c var-c)))))) (calc-set-language nil))) +(ert-deftest calc-frac-input () + ;; precomposed fraction + (should (equal (math-read-expr "½") + '(frac 1 2))) + ;; ascii solidus + (should (equal (math-read-expr "123/456") + '(/ 123 456))) + (should (equal (math-read-expr "a/b") + '(/ (var a var-a) (var b var-b)))) + ;; fraction slash + (should (equal (math-read-expr "123⁄456") + '(frac 41 152))) + (should (equal (math-read-expr "a⁄b") + '(error 1 "Syntax error"))) + ;; division slash + (should (equal (math-read-expr "123∕456") + '(/ 123 456))) + (should (equal (math-read-expr "a∕b") + '(/ (var a var-a) (var b var-b)))) + ;; division sign + (should (equal (math-read-expr "123÷456") + '(frac 41 152))) + (should (equal (math-read-expr "a÷b") ; I think this one is wrong + '(error 1 "Syntax error")))) + (defvar var-g) ;; Test `let'. -- cgit v1.2.3 From 4e5dd1a796ab3fbf26a9c6f0119776327068cafd Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 16:47:10 +0200 Subject: ; * doc/misc/calc.texi (Fractions): Fix typos. (Bug#66944) --- doc/misc/calc.texi | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index 31db77a0720..dacf1451cc2 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -10575,14 +10575,14 @@ form). The numerator and denominator always use the same radix. Fractions may also be entered with @kbd{@U{2044}} (U+2044 FRACTION SLASH) in place of any @kbd{:}. Precomposed fraction characters from @kbd{@U{00BD}} (U+00BD VULGAR FRACTION ONE HALF) through -@kbd{@U{215E}} (U+215E VULGAR FRACTION SEVEN EIGHTHS) as supported as -well. Thus @samp{2:3}, @samp{2@U{2044}3}, and @samp{@U{2154}} are all +@kbd{@U{215E}} (U+215E VULGAR FRACTION SEVEN EIGHTHS) are supported as +well. Thus, @samp{2:3}, @samp{2@U{2044}3}, and @samp{@U{2154}} are all equivalent. @end ifnottex @iftex Fractions may also be entered with U+2044 FRACTION SLASH in place of any @kbd{:}. Precomposed fraction characters from U+00BD VULGAR -FRACTION ONE HALF through U+215E VULGAR FRACTION SEVEN EIGHTHS as +FRACTION ONE HALF through U+215E VULGAR FRACTION SEVEN EIGHTHS are supported as well. @end iftex -- cgit v1.2.3 From 3c4b6823c3f92291888a24b7fee40de82bb92d68 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 27 Jan 2024 11:15:54 -0500 Subject: * src/pdumper.c (Fdump_emacs_portable): Simplify commit 16a16645f524 --- src/pdumper.c | 21 +++++++++------------ 1 file changed, 9 insertions(+), 12 deletions(-) diff --git a/src/pdumper.c b/src/pdumper.c index 6d0abc5d835..e1c71ae56c0 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -4226,22 +4226,19 @@ types. */) dump_drain_deferred_symbols (ctx); dump_drain_normal_queue (ctx); } - while (!dump_queue_empty_p (&ctx->dump_queue) - || !NILP (ctx->deferred_hash_tables) - || !NILP (ctx->deferred_symbols)); + while (!(dump_queue_empty_p (&ctx->dump_queue) + && NILP (ctx->deferred_hash_tables) + && NILP (ctx->deferred_symbols))); ctx->header.hash_list = ctx->offset; dump_hash_table_list (ctx); - do - { - dump_drain_deferred_hash_tables (ctx); - dump_drain_deferred_symbols (ctx); - dump_drain_normal_queue (ctx); - } - while (!dump_queue_empty_p (&ctx->dump_queue) - || !NILP (ctx->deferred_hash_tables) - || !NILP (ctx->deferred_symbols)); + /* `dump_hash_table_list` just adds a new vector to the dump but all its + content should already have been in the dump, so it doesn't add anything + to any queue. */ + eassert (dump_queue_empty_p (&ctx->dump_queue) + && NILP (ctx->deferred_hash_tables) + && NILP (ctx->deferred_symbols)); dump_sort_copied_objects (ctx); -- cgit v1.2.3 From 58f0603d40d238383aaa911eb09b3e2809177bfa Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 19:11:22 +0200 Subject: Allow users to opt out of following Windows Dark mode * src/w32fns.c (globals_of_w32fns) : New variable. (w32_applytheme): Disable application of Dark mode if 'w32-follow-system-dark-mode' is nil. * etc/NEWS: * doc/emacs/msdos.texi (Windows Misc): Document 'w32-follow-system-dark-mode'. --- doc/emacs/msdos.texi | 23 +++++++++++++++++------ etc/NEWS | 10 ++++++++++ lisp/cus-start.el | 2 ++ src/w32fns.c | 10 +++++++++- 4 files changed, 38 insertions(+), 7 deletions(-) diff --git a/doc/emacs/msdos.texi b/doc/emacs/msdos.texi index b00f116ee4e..861c0d90dc6 100644 --- a/doc/emacs/msdos.texi +++ b/doc/emacs/msdos.texi @@ -1182,12 +1182,23 @@ click-to-focus policy. @end ifnottex On Windows 10 (version 1809 and higher) and Windows 11, Emacs title -bars and scroll bars will follow the system's Light or Dark mode, -similar to other programs such as Explorer and Command Prompt. To -change the color mode, select @code{Personalization} from -@w{@code{Windows Settings}}, then -@w{@code{Colors->Choose your color}} (or @w{@code{Choose your default -app mode}}); then restart Emacs. +bars and scroll bars by default follow the system's Light or Dark +mode, similar to other programs such as Explorer and Command Prompt. +To change the color mode, select @code{Personalization} from +@w{@code{Windows Settings}}, then @w{@code{Colors->Choose your color}} +(or @w{@code{Choose your default app mode}} or @w{@code{Choose your +mode}}); then restart Emacs. On Windows 11, you can select separate +default modes for Windows and for applications. + +@vindex w32-follow-system-dark-mode + If you don't want Emacs to follow the system's Dark mode setting, +customize the variable @code{w32-follow-system-dark-mode} to a +@code{nil} value; then Emacs will use the default Light mode +regardless of system-wide settings. Changing the value of this +variable affects only the Emacs frames created after the change, so +you should set its value in your init file (@pxref{Init File}), either +directly or via @kbd{M-x customize-variable}, which lets you save the +customized value, see @ref{Saving Customizations}. @ifnottex @include msdos-xtra.texi diff --git a/etc/NEWS b/etc/NEWS index dd4a9c2afcf..ee113e5614e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1880,6 +1880,16 @@ always omitted, and ignored if present when the object is read back in. * Changes in Emacs 30.1 on Non-Free Operating Systems +** MS-Windows + ++++ +*** You can now opt out of following the system's Dark mode. +By default, Emacs on MS-Windows follows the system's Dark mode for its +title bars' and scroll bars' appearance. If the new user option +'w32-follow-system-dark-mode' is customized to the nil value, Emacs +will disregard the system's Dark mode and will always use the default +Light mode. + ---------------------------------------------------------------------- This file is part of GNU Emacs. diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 36879029282..7e0b64e9067 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -606,6 +606,8 @@ This should only be chosen under exceptional circumstances, since it could result in memory overflow and make Emacs crash." nil)) "27.1") + ;; w32fns.c + (w32-follow-system-dark-mode display boolean "30.1") ;; window.c (temp-buffer-show-function windows (choice (const nil) function)) (next-screen-context-lines windows integer) diff --git a/src/w32fns.c b/src/w32fns.c index f44460e52c0..8d4bd00b91c 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -2376,7 +2376,7 @@ w32_init_class (HINSTANCE hinst) static void w32_applytheme (HWND hwnd) { - if (w32_darkmode) + if (w32_darkmode && w32_follow_system_dark_mode) { /* Set window theme to that of a built-in Windows app (Explorer), because it has dark scroll bars and other UI elements. */ @@ -11393,6 +11393,14 @@ This variable is used for debugging, and takes precedence over any value of the `inhibit-double-buffering' frame parameter. */); w32_disable_double_buffering = false; + DEFVAR_BOOL ("w32-follow-system-dark-mode", w32_follow_system_dark_mode, + doc: /* Whether to follow the system's Dark mode on MS-Windows. +If this is nil, Emacs on MS-Windows will not follow the system's Dark +mode as far as the appearance of title bars and scroll bars is +concerned, it will always use the default Light mode instead. +Changing the value takes effect only for frames created after the change. */); + w32_follow_system_dark_mode = true; + if (os_subtype == OS_SUBTYPE_NT) w32_unicode_gui = 1; else -- cgit v1.2.3 From 37c0607241506540b033e2feebe152e249517794 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 19:15:00 +0200 Subject: ; * lisp/visual-wrap.el (visual-wrap-fill-context-prefix): Doc fix. --- lisp/visual-wrap.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index c23a886801d..809df005dcb 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -112,7 +112,7 @@ extra indent = 2 "")))) (defun visual-wrap-fill-context-prefix (beg end) - "Compute visual wrap prefix from text between FROM and TO. + "Compute visual wrap prefix from text between BEG and END. This is like `fill-context-prefix', but with prefix length adjusted by `visual-wrap-extra-indent'." (let* ((fcp -- cgit v1.2.3 From 6da9dc90481fc5678dd79ac211c9d92b5e1ee8a5 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 19:18:16 +0200 Subject: ; * lisp/visual-wrap.el: Fix typos. --- lisp/visual-wrap.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index 809df005dcb..20e55444082 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -28,7 +28,7 @@ ;; This package provides the `visual-wrap-prefix-mode' minor mode ;; which sets the wrap-prefix property on the fly so that ;; single-long-line paragraphs get word-wrapped in a way similar to -;; what you'd get with M-q using visual-fill-mode, but without +;; what you'd get with M-q using adaptive-fill-mode, but without ;; actually changing the buffer's text. ;;; Code: @@ -165,7 +165,7 @@ by `visual-wrap-extra-indent'." ;; prefix but also the previous newline. So it's not ;; just making the prefix more pretty and could interfere ;; or even defeat our efforts (e.g. it comes from - ;; `visual-fill-mode'). + ;; `adaptive-fill-mode'). (remove-text-properties 0 (length pfx) '(display) pfx))) pfx)))) -- cgit v1.2.3 From 12afe75cf7af99eabf821e40dd2fab2f9c3efcf9 Mon Sep 17 00:00:00 2001 From: Manuel Giraud Date: Sat, 27 Jan 2024 17:23:06 +0100 Subject: Enable marking tagged with ls -F Bug#68637 * lisp/image/image-dired-dired.el (image-dired-mark-tagged-files): Enable marking tagged for executable and symlink images when 'dired-listing-switches' includes -F. --- lisp/image/image-dired-dired.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/image/image-dired-dired.el b/lisp/image/image-dired-dired.el index f4778d8e121..7219a106ca8 100644 --- a/lisp/image/image-dired-dired.el +++ b/lisp/image/image-dired-dired.el @@ -383,7 +383,7 @@ matching tag will be marked in the Dired buffer." (file-name-directory curr-file))) (setq curr-file (file-name-nondirectory curr-file)) (goto-char (point-min)) - (when (search-forward-regexp (format "\\s %s$" curr-file) nil t) + (when (search-forward-regexp (format "\\s %s[*@]?$" curr-file) nil t) (setq hits (+ hits 1)) (dired-mark 1)))) (message "%d files with matching tag marked" hits))) -- cgit v1.2.3 From 54c6588952b469df8d7983b6735461f542cd806e Mon Sep 17 00:00:00 2001 From: Konstantin Kharlamov Date: Fri, 19 Jan 2024 10:33:47 +0300 Subject: Support a local repo as URL in 'treesit-language-source-alist' Sometimes people may need to bisect to find specific revision in a grammar library's repo. In this case they'd want to point the URL to the local repo to avoid cloning it on every rebuild. So add support for a directory instead of URL in 'treesit-language-source-alist'. * lisp/treesit.el (treesit--install-language-grammar-1): Test if URL is a local directory. Then if it is, avoid cloning the repo and removing the path on success. (treesit--git-clone-repo): Factor out the code for cloning to a separate function. (treesit--git-checkout-branch): A helper to checkout the revision for cases where we didn't clone the repo but want it to point the revision. (Bug#68579) --- etc/NEWS | 8 ++++++++ lisp/treesit.el | 46 ++++++++++++++++++++++++++++++++++------------ 2 files changed, 42 insertions(+), 12 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index ee113e5614e..c2bc25d6289 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1877,6 +1877,14 @@ The 'test' parameter is omitted if it is 'eql' (the default), as is 'data' if empty. 'rehash-size', 'rehash-threshold' and 'size' are always omitted, and ignored if present when the object is read back in. ++++ +** 'treesit-install-language-grammar' can handle local directory instead of URL. +It is now possible to pass a directory of a local repository as URL +inside 'treesit-language-source-alist', so that calling +'treesit-install-language-grammar' would avoid cloning the repository. +It may be useful, for example, for the purposes of bisecting a +treesitter grammar. + * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/lisp/treesit.el b/lisp/treesit.el index 89f688b61c1..d1e0beaaac9 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -3417,7 +3417,8 @@ The value should be an alist where each element has the form (LANG . (URL REVISION SOURCE-DIR CC C++)) Only LANG and URL are mandatory. LANG is the language symbol. -URL is the Git repository URL for the grammar. +URL is the URL of the grammar's Git repository or a directory +where the repository has been cloned. REVISION is the Git tag or branch of the desired version, defaulting to the latest default branch. @@ -3551,6 +3552,26 @@ content as signal data, and erase buffer afterwards." (buffer-string))) (erase-buffer))) +(defun treesit--git-checkout-branch (repo-dir revision) + "Checkout REVISION in a repo located in REPO-DIR." + (treesit--call-process-signal + "git" nil t nil "-C" repo-dir "checkout" revision)) + +(defun treesit--git-clone-repo (url revision workdir) + "Clone repo pointed by URL at commit REVISION to WORKDIR. + +REVISION may be nil, in which case the cloned repo will be at its +default branch." + (message "Cloning repository") + ;; git clone xxx --depth 1 --quiet [-b yyy] workdir + (if revision + (treesit--call-process-signal + "git" nil t nil "clone" url "--depth" "1" "--quiet" + "-b" revision workdir) + (treesit--call-process-signal + "git" nil t nil "clone" url "--depth" "1" "--quiet" + workdir))) + (defun treesit--install-language-grammar-1 (out-dir lang url &optional revision source-dir cc c++) "Install and compile a tree-sitter language grammar library. @@ -3564,8 +3585,12 @@ For LANG, URL, REVISION, SOURCE-DIR, GRAMMAR-DIR, CC, C++, see `treesit-language-source-alist'. If anything goes wrong, this function signals an error." (let* ((lang (symbol-name lang)) + (maybe-repo-dir (expand-file-name url)) + (url-is-dir (file-accessible-directory-p maybe-repo-dir)) (default-directory (make-temp-file "treesit-workdir" t)) - (workdir (expand-file-name "repo")) + (workdir (if url-is-dir + maybe-repo-dir + (expand-file-name "repo"))) (source-dir (expand-file-name (or source-dir "src") workdir)) (cc (or cc (seq-find #'executable-find '("cc" "gcc" "c99")) ;; If no C compiler found, just use cc and let @@ -3580,15 +3605,10 @@ function signals an error." (lib-name (concat "libtree-sitter-" lang soext))) (unwind-protect (with-temp-buffer - (message "Cloning repository") - ;; git clone xxx --depth 1 --quiet [-b yyy] workdir - (if revision - (treesit--call-process-signal - "git" nil t nil "clone" url "--depth" "1" "--quiet" - "-b" revision workdir) - (treesit--call-process-signal - "git" nil t nil "clone" url "--depth" "1" "--quiet" - workdir)) + (if url-is-dir + (when revision + (treesit--git-checkout-branch workdir revision)) + (treesit--git-clone-repo url revision workdir)) ;; We need to go into the source directory because some ;; header files use relative path (#include "../xxx"). ;; cd "${sourcedir}" @@ -3635,7 +3655,9 @@ function signals an error." ;; Ignore errors, in case the old version is still used. (ignore-errors (delete-file old-fname))) (message "Library installed to %s/%s" out-dir lib-name)) - (when (file-exists-p workdir) + ;; Remove workdir if it's not a repo owned by user and we + ;; managed to create it in the first place. + (when (and (not url-is-dir) (file-exists-p workdir)) (delete-directory workdir t))))) ;;; Etc -- cgit v1.2.3 From aa386cd92f403b2441d09e06743c78d6f2c8a7f5 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 22:21:11 +0200 Subject: ; * src/pdumper.c: Fix comments. --- src/pdumper.c | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/src/pdumper.c b/src/pdumper.c index e1c71ae56c0..ee554cda55a 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -1858,11 +1858,10 @@ dump_field_lv_or_rawptr (struct dump_context *ctx, /* Set a pointer field on an output object during dump. - CTX is the dump context. OFFSET is the offset at which the current - object starts. OUT is a pointer to the dump output object. - IN_START is the start of the current Emacs object. IN_FIELD is a - pointer to the field in that object. TYPE is the type of pointer - to which IN_FIELD points. + CTX is the dump context. OUT is a pointer to the dump output + object. IN_START is the start of the current Emacs object. + IN_FIELD is a pointer to the field in that object. TYPE is the + type of pointer to which IN_FIELD points. */ static void dump_field_lv_rawptr (struct dump_context *ctx, @@ -1877,8 +1876,7 @@ dump_field_lv_rawptr (struct dump_context *ctx, /* Set a Lisp_Object field on an output object during dump. - CTX is a dump context. OFFSET is the offset at which the current - object starts. OUT is a pointer to the dump output object. + CTX is a dump context. OUT is a pointer to the dump output object. IN_START is the start of the current Emacs object. IN_FIELD is a pointer to a Lisp_Object field in that object. @@ -3214,7 +3212,7 @@ dump_charset (struct dump_context *ctx, int cs_i) #if CHECK_STRUCTS && !defined (HASH_charset_E31F4B5D96) # error "charset changed. See CHECK_STRUCTS comment in config.h." #endif - /* We can't change the alignment here, because `offset` is what + /* We can't change the alignment here, because ctx->offset is what will be used for the whole array. */ eassert (ctx->offset % alignof (struct charset) == 0); const struct charset *cs = charset_table + cs_i; @@ -4233,9 +4231,9 @@ types. */) ctx->header.hash_list = ctx->offset; dump_hash_table_list (ctx); - /* `dump_hash_table_list` just adds a new vector to the dump but all its - content should already have been in the dump, so it doesn't add anything - to any queue. */ + /* dump_hash_table_list just adds a new vector to the dump but all + its content should already have been in the dump, so it doesn't + add anything to any queue. */ eassert (dump_queue_empty_p (&ctx->dump_queue) && NILP (ctx->deferred_hash_tables) && NILP (ctx->deferred_symbols)); -- cgit v1.2.3 From 3c680968e492acf8891fda22c28baef5078ca768 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Wed, 24 Jan 2024 18:32:00 -0800 Subject: Fix command replacement with the Eshell builtin versions of "sudo" and "doas" This is particularly important when the inner command to execute is an alias. Aliases throw 'eshell-replace-command' too, so we want to do this in two phases: first, replace the "sudo"/"doas" with a let-binding of 'default-directory', and then later, let the alias code do its own replacement (bug#68074). * lisp/eshell/em-tramp.el (eshell/sudo, eshell/doas): Use 'eshell-replace-command' to wrap the inner command. * test/lisp/eshell/em-tramp-tests.el (mock-eshell-named-command): Remove. (em-tramp-test/sudo-basic, em-tramp-test/sudo-user) (em-tramp-test/doas-basic, em-tramp-test/doas-user): Catch 'eshell-replace-command'. --- lisp/eshell/em-tramp.el | 22 +++++----- test/lisp/eshell/em-tramp-tests.el | 89 +++++++++++++++++--------------------- 2 files changed, 50 insertions(+), 61 deletions(-) diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el index 90f9c6cf78d..efb37225651 100644 --- a/lisp/eshell/em-tramp.el +++ b/lisp/eshell/em-tramp.el @@ -121,12 +121,11 @@ Uses the system sudo through Tramp's sudo method." :usage "[(-u | --user) USER] (-s | --shell) | COMMAND Execute a COMMAND as the superuser or another USER.") (let ((dir (eshell--method-wrap-directory default-directory "sudo" user))) - (if shell - (throw 'eshell-replace-command - (eshell-parse-command "cd" (list dir))) - (throw 'eshell-external - (let ((default-directory dir)) - (eshell-named-command (car args) (cdr args)))))))) + (throw 'eshell-replace-command + (if shell + (eshell-parse-command "cd" (list dir)) + `(let ((default-directory ,dir)) + (eshell-named-command ',(car args) ',(cdr args)))))))) (put 'eshell/sudo 'eshell-no-numeric-conversions t) @@ -144,12 +143,11 @@ Uses the system doas through Tramp's doas method." :usage "[(-u | --user) USER] (-s | --shell) | COMMAND Execute a COMMAND as the superuser or another USER.") (let ((dir (eshell--method-wrap-directory default-directory "doas" user))) - (if shell - (throw 'eshell-replace-command - (eshell-parse-command "cd" (list dir))) - (throw 'eshell-external - (let ((default-directory dir)) - (eshell-named-command (car args) (cdr args)))))))) + (throw 'eshell-replace-command + (if shell + (eshell-parse-command "cd" (list dir)) + `(let ((default-directory ,dir)) + (eshell-named-command ',(car args) ',(cdr args)))))))) (put 'eshell/doas 'eshell-no-numeric-conversions t) diff --git a/test/lisp/eshell/em-tramp-tests.el b/test/lisp/eshell/em-tramp-tests.el index d33f6a2b46a..3be5d3542ca 100644 --- a/test/lisp/eshell/em-tramp-tests.el +++ b/test/lisp/eshell/em-tramp-tests.el @@ -59,35 +59,31 @@ "cd" (list ,(format "/su:root@%s:~/" tramp-default-host)))))) -(defun mock-eshell-named-command (&rest args) - "Dummy function to test Eshell `sudo' command rewriting." - (list default-directory args)) - (ert-deftest em-tramp-test/sudo-basic () "Test Eshell `sudo' command with default user." - (cl-letf (((symbol-function 'eshell-named-command) - #'mock-eshell-named-command)) - (should (equal - (catch 'eshell-external (eshell/sudo "echo" "hi")) - `(,(format "/sudo:root@%s:%s" tramp-default-host default-directory) - ("echo" ("hi"))))) - (should (equal - (catch 'eshell-external (eshell/sudo "echo" "-u" "hi")) - `(,(format "/sudo:root@%s:%s" tramp-default-host default-directory) - ("echo" ("-u" "hi"))))))) + (let ((sudo-directory (format "/sudo:root@%s:%s" + tramp-default-host default-directory))) + (should (equal (catch 'eshell-replace-command + (eshell/sudo "echo" "hi")) + `(let ((default-directory ,sudo-directory)) + (eshell-named-command '"echo" '("hi"))))) + (should (equal (catch 'eshell-replace-command + (eshell/sudo "echo" "-u" "hi")) + `(let ((default-directory ,sudo-directory)) + (eshell-named-command '"echo" '("-u" "hi"))))))) (ert-deftest em-tramp-test/sudo-user () "Test Eshell `sudo' command with specified user." - (cl-letf (((symbol-function 'eshell-named-command) - #'mock-eshell-named-command)) - (should (equal - (catch 'eshell-external (eshell/sudo "-u" "USER" "echo" "hi")) - `(,(format "/sudo:USER@%s:%s" tramp-default-host default-directory) - ("echo" ("hi"))))) - (should (equal - (catch 'eshell-external (eshell/sudo "-u" "USER" "echo" "-u" "hi")) - `(,(format "/sudo:USER@%s:%s" tramp-default-host default-directory) - ("echo" ("-u" "hi"))))))) + (let ((sudo-directory (format "/sudo:USER@%s:%s" + tramp-default-host default-directory))) + (should (equal (catch 'eshell-replace-command + (eshell/sudo "-u" "USER" "echo" "hi")) + `(let ((default-directory ,sudo-directory)) + (eshell-named-command '"echo" '("hi"))))) + (should (equal (catch 'eshell-replace-command + (eshell/sudo "-u" "USER" "echo" "-u" "hi")) + `(let ((default-directory ,sudo-directory)) + (eshell-named-command '"echo" '("-u" "hi"))))))) (ert-deftest em-tramp-test/sudo-shell () "Test Eshell `sudo' command with -s/--shell option." @@ -109,34 +105,29 @@ (ert-deftest em-tramp-test/doas-basic () "Test Eshell `doas' command with default user." - (cl-letf (((symbol-function 'eshell-named-command) - #'mock-eshell-named-command)) - (should (equal - (catch 'eshell-external (eshell/doas "echo" "hi")) - `(,(format "/doas:root@%s:%s" - tramp-default-host default-directory) - ("echo" ("hi"))))) - (should (equal - (catch 'eshell-external (eshell/doas "echo" "-u" "hi")) - `(,(format "/doas:root@%s:%s" - tramp-default-host default-directory) - ("echo" ("-u" "hi"))))))) + (let ((doas-directory (format "/doas:root@%s:%s" + tramp-default-host default-directory))) + (should (equal (catch 'eshell-replace-command + (eshell/doas "echo" "hi")) + `(let ((default-directory ,doas-directory)) + (eshell-named-command '"echo" '("hi"))))) + (should (equal (catch 'eshell-replace-command + (eshell/doas "echo" "-u" "hi")) + `(let ((default-directory ,doas-directory)) + (eshell-named-command '"echo" '("-u" "hi"))))))) (ert-deftest em-tramp-test/doas-user () "Test Eshell `doas' command with specified user." - (cl-letf (((symbol-function 'eshell-named-command) - #'mock-eshell-named-command)) - (should (equal - (catch 'eshell-external (eshell/doas "-u" "USER" "echo" "hi")) - `(,(format "/doas:USER@%s:%s" - tramp-default-host default-directory) - ("echo" ("hi"))))) - (should (equal - (catch 'eshell-external - (eshell/doas "-u" "USER" "echo" "-u" "hi")) - `(,(format "/doas:USER@%s:%s" - tramp-default-host default-directory) - ("echo" ("-u" "hi"))))))) + (let ((doas-directory (format "/doas:USER@%s:%s" + tramp-default-host default-directory))) + (should (equal (catch 'eshell-replace-command + (eshell/doas "-u" "USER" "echo" "hi")) + `(let ((default-directory ,doas-directory)) + (eshell-named-command '"echo" '("hi"))))) + (should (equal (catch 'eshell-replace-command + (eshell/doas "-u" "USER" "echo" "-u" "hi")) + `(let ((default-directory ,doas-directory)) + (eshell-named-command '"echo" '("-u" "hi"))))))) (ert-deftest em-tramp-test/doas-shell () "Test Eshell `doas' command with -s/--shell option." -- cgit v1.2.3 From 744a10a4d722a361bc21561b4162045e4ec97ed6 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Wed, 2 Aug 2023 21:51:18 -0700 Subject: * doc/lispref/package.texi (Multi-file Packages): Document ".elpaignore". --- doc/lispref/package.texi | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi index 6f52a33d194..ebe578932bf 100644 --- a/doc/lispref/package.texi +++ b/doc/lispref/package.texi @@ -284,6 +284,13 @@ variable @code{load-file-name} (@pxref{Loading}). Here is an example: (expand-file-name file superfrobnicator-base)) @end smallexample + If your project contains files that you don't wish to distribute to +users (e.g.@: regression tests), you can add them to an +@file{.elpaignore} file. In this file, each line lists a file or +wildcard matching files to ignore when producing your package's tar +file on ELPA. (ELPA will pass this file to @command{tar} with the +@code{-X} option.) + @node Package Archives @section Creating and Maintaining Package Archives @cindex package archive -- cgit v1.2.3 From b2db82c5aecd2d6f5f34941cc973177311465683 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Wed, 2 Aug 2023 21:51:18 -0700 Subject: * doc/lispref/package.texi (Multi-file Packages): Document ".elpaignore". (cherry picked from commit 744a10a4d722a361bc21561b4162045e4ec97ed6) --- doc/lispref/package.texi | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi index 6f52a33d194..ebe578932bf 100644 --- a/doc/lispref/package.texi +++ b/doc/lispref/package.texi @@ -284,6 +284,13 @@ variable @code{load-file-name} (@pxref{Loading}). Here is an example: (expand-file-name file superfrobnicator-base)) @end smallexample + If your project contains files that you don't wish to distribute to +users (e.g.@: regression tests), you can add them to an +@file{.elpaignore} file. In this file, each line lists a file or +wildcard matching files to ignore when producing your package's tar +file on ELPA. (ELPA will pass this file to @command{tar} with the +@code{-X} option.) + @node Package Archives @section Creating and Maintaining Package Archives @cindex package archive -- cgit v1.2.3 From 6d76e3991241905b0841effc6f8cd42394d9aa64 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 28 Jan 2024 07:43:25 +0200 Subject: ; Fix last change in package.texi * doc/lispref/package.texi (Multi-file Packages): Fix wording and markup. (Bug#65027) --- doc/lispref/package.texi | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi index ebe578932bf..f75023d4039 100644 --- a/doc/lispref/package.texi +++ b/doc/lispref/package.texi @@ -284,12 +284,14 @@ variable @code{load-file-name} (@pxref{Loading}). Here is an example: (expand-file-name file superfrobnicator-base)) @end smallexample - If your project contains files that you don't wish to distribute to +@cindex @file{.elpaignore} file + If your package contains files that you don't wish to distribute to users (e.g.@: regression tests), you can add them to an -@file{.elpaignore} file. In this file, each line lists a file or -wildcard matching files to ignore when producing your package's tar -file on ELPA. (ELPA will pass this file to @command{tar} with the -@code{-X} option.) +@file{.elpaignore} file. In this file, each line lists a file or a +wildcard matching files; those files should be ignored when producing +your package's tarball on ELPA (@pxref{Package Archives}). (ELPA +will pass this file to the @command{tar} command via the @option{-X} +command-line option, when it prepares the package for download.) @node Package Archives @section Creating and Maintaining Package Archives -- cgit v1.2.3 From 236317e5d2284399d6ca0413ea2a29b84270d545 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sat, 27 Jan 2024 22:03:28 -0800 Subject: Fix treesit-range-rules * lisp/treesit.el (treesit-range-rules): Reset :local like other keywords. The other chunk is indentation fix. --- lisp/treesit.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/treesit.el b/lisp/treesit.el index d1e0beaaac9..96222ed81cb 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -595,8 +595,8 @@ that encompasses the region between START and END." (unless (and (consp range-offset) (numberp (car range-offset)) (numberp (cdr range-offset))) - (signal 'treesit-error (list "Value of :offset option should be a pair of numbers" range-offset))) - (setq offset range-offset))) + (signal 'treesit-error (list "Value of :offset option should be a pair of numbers" range-offset))) + (setq offset range-offset))) (query (if (functionp query) (push (list query nil nil) result) (when (null embed) @@ -606,7 +606,7 @@ that encompasses the region between START and END." (push (list (treesit-query-compile host query) embed local offset) result)) - (setq host nil embed nil offset nil)))) + (setq host nil embed nil offset nil local nil)))) (nreverse result))) (defun treesit--merge-ranges (old-ranges new-ranges start end) -- cgit v1.2.3 From a3cd284b90edcc7e06b21110cdbf55d11fb6fd0d Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Sat, 4 Mar 2023 22:11:23 -0800 Subject: Support setting umask symbolically in Eshell * lisp/eshell/em-basic.el (eshell/umask): Handle setting umask symbolically, and make setting umask take precedence over "-S". * test/lisp/eshell/em-basic-tests.el (em-basic-test/umask-print-numeric, em-basic-test/umask-read-symbolic, em-basic-test/umask-set): Rename to... (em-basic-test/umask/print-numeric) (em-basic-test/umask/print-symbolic, em-basic-test/umask/set-numeric): ... these. (em-basic-test/umask/set-symbolic, em-basic-test/umask/set-with-S): New tests. * etc/NEWS: Announce this change. --- etc/NEWS | 8 ++++++++ lisp/eshell/em-basic.el | 24 ++++++++++++++---------- test/lisp/eshell/em-basic-tests.el | 34 ++++++++++++++++++++++++++++++---- 3 files changed, 52 insertions(+), 14 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index c2bc25d6289..061ac9a7d10 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -678,6 +678,14 @@ command passed as arguments to 'env'. If you pass any initial arguments of the form 'VAR=VALUE', 'env' will first set 'VAR' to 'VALUE' before running the command. +--- +*** Eshell's 'umask' command now supports setting the mask symbolically. +Now, you can pass an argument like "u+w,o-r" to Eshell's 'umask' +command, which will give write permission for owners of newly-created +files and deny read permission for users who are not members of the +file's group. See the Info node '(coreutils)File permissions' for +more information on this notation. + +++ *** New special reference type '#'. This special reference type returns a marker at 'POSITION' in diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el index 8f68a750bd7..6ec53ef9412 100644 --- a/lisp/eshell/em-basic.el +++ b/lisp/eshell/em-basic.el @@ -160,6 +160,18 @@ or `eshell-printn' for display." :preserve-args :usage "[-S] [mode]") (cond + (args + (let* ((mask (car args)) + (modes + (if (stringp mask) + (if (string-match (rx bos (+ (any "0-7")) eos) mask) + (- #o777 (string-to-number mask 8)) + (file-modes-symbolic-to-number + mask (default-file-modes))) + (- #o777 mask)))) + (set-default-file-modes modes) + (eshell-print + "Warning: umask changed for all new files created by Emacs.\n"))) (symbolic-p (let ((mode (default-file-modes))) (eshell-printn @@ -173,17 +185,9 @@ or `eshell-printn' for display." (concat (and (= (logand mode 1) 1) "r") (and (= (logand mode 2) 2) "w") (and (= (logand mode 4) 4) "x")))))) - ((not args) - (eshell-printn (format "%03o" (logand (lognot (default-file-modes)) - #o777)))) (t - (when (stringp (car args)) - (if (string-match "^[0-7]+$" (car args)) - (setcar args (string-to-number (car args) 8)) - (error "Setting umask symbolically is not yet implemented"))) - (set-default-file-modes (- #o777 (car args))) - (eshell-print - "Warning: umask changed for all new files created by Emacs.\n"))) + (eshell-printn (format "%03o" (logand (lognot (default-file-modes)) + #o777))))) nil)) (put 'eshell/umask 'eshell-no-numeric-conversions t) diff --git a/test/lisp/eshell/em-basic-tests.el b/test/lisp/eshell/em-basic-tests.el index 960e04690a5..ebb91cdeea0 100644 --- a/test/lisp/eshell/em-basic-tests.el +++ b/test/lisp/eshell/em-basic-tests.el @@ -33,7 +33,7 @@ ;;; Tests: -(ert-deftest em-basic-test/umask-print-numeric () +(ert-deftest em-basic-test/umask/print-numeric () "Test printing umask numerically." (cl-letf (((symbol-function 'default-file-modes) (lambda () #o775))) (eshell-command-result-equal "umask" "002\n")) @@ -43,7 +43,7 @@ (cl-letf (((symbol-function 'default-file-modes) (lambda () #o1775))) (eshell-command-result-equal "umask" "002\n"))) -(ert-deftest em-basic-test/umask-read-symbolic () +(ert-deftest em-basic-test/umask/print-symbolic () "Test printing umask symbolically." (cl-letf (((symbol-function 'default-file-modes) (lambda () #o775))) (eshell-command-result-equal "umask -S" @@ -56,8 +56,8 @@ (eshell-command-result-equal "umask -S" "u=rwx,g=rwx,o=rx\n"))) -(ert-deftest em-basic-test/umask-set () - "Test setting umask." +(ert-deftest em-basic-test/umask/set-numeric () + "Test setting umask numerically." (let ((file-modes 0)) (cl-letf (((symbol-function 'set-default-file-modes) (lambda (mode) (setq file-modes mode)))) @@ -68,4 +68,30 @@ (eshell-test-command-result "umask $(identity #o222)") (should (= file-modes #o555))))) +(ert-deftest em-basic-test/umask/set-symbolic () + "Test setting umask symbolically." + (let ((file-modes 0)) + (cl-letf (((symbol-function 'default-file-modes) + (lambda() file-modes)) + ((symbol-function 'set-default-file-modes) + (lambda (mode) (setq file-modes mode)))) + (eshell-test-command-result "umask u=rwx,g=rwx,o=rx") + (should (= file-modes #o775)) + (eshell-test-command-result "umask u=rw,g=rx,o=x") + (should (= file-modes #o651)) + (eshell-test-command-result "umask u+x,o-x") + (should (= file-modes #o750)) + (eshell-test-command-result "umask a+rx") + (should (= file-modes #o755))))) + +(ert-deftest em-basic-test/umask/set-with-S () + "Test that passing \"-S\" and a umask still sets the umask." + (let ((file-modes 0)) + (cl-letf (((symbol-function 'set-default-file-modes) + (lambda (mode) (setq file-modes mode)))) + (eshell-test-command-result "umask -S 002") + (should (= file-modes #o775)) + (eshell-test-command-result "umask -S 123") + (should (= file-modes #o654))))) + ;; em-basic-tests.el ends here -- cgit v1.2.3 From c4d16909fa4c30fd5f11bd66de7936790349cb7d Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Tue, 15 Aug 2023 18:52:11 -0700 Subject: ; Be more strict with command arguments for a few Eshell commands * lisp/eshell/em-dirs.el (eshell/pwd): * lisp/eshell/em-unix.el (eshell/whoami): * lisp/eshell/esh-proc.el (eshell/jobs): Don't accept arguments. --- lisp/eshell/em-dirs.el | 2 +- lisp/eshell/em-unix.el | 2 +- lisp/eshell/esh-proc.el | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index cf90a8bb230..85036620c57 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -316,7 +316,7 @@ Thus, this does not include the current directory.") (`(boundaries . ,suffix) `(boundaries 0 . ,(string-search "/" suffix)))))))))) -(defun eshell/pwd (&rest _args) +(defun eshell/pwd () "Change output from `pwd' to be cleaner." (let* ((path default-directory) (len (length path))) diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index dad02206759..c3c3fea691a 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -1018,7 +1018,7 @@ Show wall-clock time elapsed during execution of COMMAND.") (eshell-stringify-list (flatten-tree (cdr time-args)))))))) -(defun eshell/whoami (&rest _args) +(defun eshell/whoami () "Make \"whoami\" Tramp aware." (eshell-user-login-name)) diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 2bb0043bddb..35c81f6a4b2 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -193,7 +193,7 @@ This is like `process-live-p', but additionally checks whether (defalias 'eshell/wait #'eshell-wait-for-process) -(defun eshell/jobs (&rest _args) +(defun eshell/jobs () "List processes, if there are any." (and (fboundp 'process-list) (process-list) -- cgit v1.2.3 From e1970c99f097715fc5bb3b88154799bfe13de90f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 28 Jan 2024 10:19:48 +0200 Subject: Fix "emacs -nw" on MS-Windows * src/w32term.c (w32_flip_buffers_if_dirty): Do nothing if F is not a GUI frame. This avoids rare crashes in "emacs -nw". * src/w32console.c (initialize_w32_display): Set the ENABLE_EXTENDED_FLAGS bit in 'prev_console_mode'. --- src/w32console.c | 4 ++++ src/w32term.c | 5 +++-- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/w32console.c b/src/w32console.c index c2b87928cc1..0936b5f37e6 100644 --- a/src/w32console.c +++ b/src/w32console.c @@ -705,6 +705,10 @@ initialize_w32_display (struct terminal *term, int *width, int *height) /* Remember original console settings. */ keyboard_handle = GetStdHandle (STD_INPUT_HANDLE); GetConsoleMode (keyboard_handle, &prev_console_mode); + /* Make sure ENABLE_EXTENDED_FLAGS is set in console settings, + otherwise restoring the original setting of ENABLE_MOUSE_INPUT + will not work. */ + prev_console_mode |= ENABLE_EXTENDED_FLAGS; prev_screen = GetStdHandle (STD_OUTPUT_HANDLE); diff --git a/src/w32term.c b/src/w32term.c index f5611772637..7afd1303b4d 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -776,12 +776,13 @@ w32_buffer_flipping_unblocked_hook (struct frame *f) /* Flip buffers on F if drawing has happened. This function is not called to flush the display connection of a frame (which doesn't - exist on MS Windows), but also called in some situations in + exist on MS Windows), but is called in some situations in minibuf.c to make the contents of the back buffer visible. */ void w32_flip_buffers_if_dirty (struct frame *f) { - if (FRAME_OUTPUT_DATA (f)->paint_buffer + if (FRAME_W32_P (f) /* do nothing in TTY frames */ + && FRAME_OUTPUT_DATA (f)->paint_buffer && FRAME_OUTPUT_DATA (f)->paint_buffer_dirty && !f->garbaged && !buffer_flipping_blocked_p ()) w32_show_back_buffer (f); -- cgit v1.2.3 From 99a122b5b816f6c5dd2acc67eeca13eb4d1d8cd5 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 28 Jan 2024 00:15:38 -0800 Subject: Fix C conformance issue in LISPSYM_INITIALLY * src/lisp.h (LISPSYM_INITIALLY): Remove unnecessary cast to char *. The C standard allows but does not require support for casts to pointers in constant expressions in static initializers. --- src/lisp.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lisp.h b/src/lisp.h index c2dfd1afad5..eb78176aed6 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -938,7 +938,7 @@ typedef EMACS_UINT Lisp_Word_tag; /* LISPSYM_INITIALLY (Qfoo) is equivalent to Qfoo except it is designed for use as an initializer, even for a constant initializer. */ #define LISPSYM_INITIALLY(name) \ - TAG_PTR (Lisp_Symbol, (char *) (intptr_t) ((i##name) * sizeof *lispsym)) + TAG_PTR (Lisp_Symbol, (intptr_t) ((i##name) * sizeof *lispsym)) /* Declare extern constants for Lisp symbols. These can be helpful when using a debugger like GDB, on older platforms where the debug -- cgit v1.2.3 From fcf69960e89b826841a8c6ccc2af4019b5dc5e31 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 28 Jan 2024 00:15:38 -0800 Subject: * src/lisp.h: Improve TAG_PTR comments. --- src/lisp.h | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index eb78176aed6..db886c65204 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -303,6 +303,9 @@ DEFINE_GDB_SYMBOL_END (VALMASK) #define LISP_WORDS_ARE_POINTERS (EMACS_INT_MAX == INTPTR_MAX) #if LISP_WORDS_ARE_POINTERS +/* TAG_PTR casts to Lisp_Word and can be used in static initializers, + so this typedef assumes static initializers can contain casts to pointers. + All Emacs targets support this extension to the C standard. */ typedef struct Lisp_X *Lisp_Word; #else typedef EMACS_INT Lisp_Word; @@ -931,12 +934,14 @@ typedef EMACS_UINT Lisp_Word_tag; #define LISP_WORD_TAG(tag) \ ((Lisp_Word_tag) (tag) << (USE_LSB_TAG ? 0 : VALBITS)) -/* An initializer for a Lisp_Object that contains TAG along with PTR. */ -#define TAG_PTR(tag, ptr) \ - LISP_INITIALLY ((Lisp_Word) ((uintptr_t) (ptr) + LISP_WORD_TAG (tag))) +/* An initializer for a Lisp_Object that contains TAG along with P. + P can be a pointer or an integer. The result is usable in a static + initializer if TAG and P are both integer constant expressions. */ +#define TAG_PTR(tag, p) \ + LISP_INITIALLY ((Lisp_Word) ((uintptr_t) (p) + LISP_WORD_TAG (tag))) /* LISPSYM_INITIALLY (Qfoo) is equivalent to Qfoo except it is - designed for use as an initializer, even for a constant initializer. */ + designed for use as a (possibly static) initializer. */ #define LISPSYM_INITIALLY(name) \ TAG_PTR (Lisp_Symbol, (intptr_t) ((i##name) * sizeof *lispsym)) -- cgit v1.2.3 From a3d7092114db09fee392ccc8187fde03376f2089 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 28 Jan 2024 00:15:38 -0800 Subject: Rename TAG_PTR to TAG_PTR_INITIALLY MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/lisp.h (TAG_PTR_INITIALLY): Rename from TAG_PTR, since calls can be used only as initializers, and the convention elsewhere in lisp.c is to give these macros names ending in ‘_INITIALLY’. This should help avoid confusion such as we recently experienced in make_lisp_symbol_internal. All uses changed. --- src/alloc.c | 2 +- src/lisp.h | 18 +++++++----------- 2 files changed, 8 insertions(+), 12 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index ab31d21fb33..b144396948e 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6295,7 +6295,7 @@ android_make_lisp_symbol (struct Lisp_Symbol *sym) &symoffset); { - Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset); + Lisp_Object a = TAG_PTR_INITIALLY (Lisp_Symbol, symoffset); return a; } } diff --git a/src/lisp.h b/src/lisp.h index db886c65204..75134425a07 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -303,7 +303,7 @@ DEFINE_GDB_SYMBOL_END (VALMASK) #define LISP_WORDS_ARE_POINTERS (EMACS_INT_MAX == INTPTR_MAX) #if LISP_WORDS_ARE_POINTERS -/* TAG_PTR casts to Lisp_Word and can be used in static initializers, +/* TAG_PTR_INITIALLY casts to Lisp_Word and can be used in static initializers so this typedef assumes static initializers can contain casts to pointers. All Emacs targets support this extension to the C standard. */ typedef struct Lisp_X *Lisp_Word; @@ -937,13 +937,13 @@ typedef EMACS_UINT Lisp_Word_tag; /* An initializer for a Lisp_Object that contains TAG along with P. P can be a pointer or an integer. The result is usable in a static initializer if TAG and P are both integer constant expressions. */ -#define TAG_PTR(tag, p) \ +#define TAG_PTR_INITIALLY(tag, p) \ LISP_INITIALLY ((Lisp_Word) ((uintptr_t) (p) + LISP_WORD_TAG (tag))) /* LISPSYM_INITIALLY (Qfoo) is equivalent to Qfoo except it is designed for use as a (possibly static) initializer. */ #define LISPSYM_INITIALLY(name) \ - TAG_PTR (Lisp_Symbol, (intptr_t) ((i##name) * sizeof *lispsym)) + TAG_PTR_INITIALLY (Lisp_Symbol, (intptr_t) ((i##name) * sizeof *lispsym)) /* Declare extern constants for Lisp symbols. These can be helpful when using a debugger like GDB, on older platforms where the debug @@ -1178,11 +1178,7 @@ make_lisp_symbol_internal (struct Lisp_Symbol *sym) Do not use eassert here, so that builtin symbols like Qnil compile to constants; this is needed for some circa-2024 GCCs even with -O2. */ char *symoffset = (char *) ((char *) sym - (char *) lispsym); - /* FIXME: We need this silly `a = ... return` η-redex because otherwise GCC - complains about: - lisp.h:615:28: error: expected expression before ‘{’ token - 615 | # define LISP_INITIALLY(w) {w} */ - Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset); + Lisp_Object a = TAG_PTR_INITIALLY (Lisp_Symbol, symoffset); return a; } @@ -1383,7 +1379,7 @@ clip_to_bounds (intmax_t lower, intmax_t num, intmax_t upper) INLINE Lisp_Object make_lisp_ptr (void *ptr, enum Lisp_Type type) { - Lisp_Object a = TAG_PTR (type, ptr); + Lisp_Object a = TAG_PTR_INITIALLY (type, ptr); eassert (TAGGEDP (a, type) && XUNTAG (a, type, char) == ptr); return a; } @@ -1456,7 +1452,7 @@ XFIXNUMPTR (Lisp_Object a) INLINE Lisp_Object make_pointer_integer_unsafe (void *p) { - Lisp_Object a = TAG_PTR (Lisp_Int0, p); + Lisp_Object a = TAG_PTR_INITIALLY (Lisp_Int0, p); return a; } @@ -2749,7 +2745,7 @@ extern Lisp_Object make_misc_ptr (void *); INLINE Lisp_Object make_mint_ptr (void *a) { - Lisp_Object val = TAG_PTR (Lisp_Int0, a); + Lisp_Object val = TAG_PTR_INITIALLY (Lisp_Int0, a); return FIXNUMP (val) && XFIXNUMPTR (val) == a ? val : make_misc_ptr (a); } -- cgit v1.2.3 From ad2c81082a62f9f781e4f5771fc223520d91cefd Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 28 Jan 2024 00:15:38 -0800 Subject: Prefer C23 ckd_* to Gnulib *_WRAPV and *_OK macros * src/alloc.c (android_make_lisp_symbol) [HAVE_ANDROID && !__clang__]: * src/android.c (android_blit_copy, android_blit_xor) (android_get_image): * src/androidmenu.c (android_menu_show): * src/androidselect.c (Fandroid_get_clipboard_data) (android_notifications_notify_1): * src/androidterm.c (android_decode_utf16) (android_text_to_string): * src/haiku_select.cc (be_display_notification): * src/sfnt.c (sfnt_read_cmap_format_8, sfnt_read_cmap_format_12) (sfnt_read_cmap_format_14, sfnt_read_cmap_table_1) (sfnt_expand_compound_glyph_context, sfnt_poly_edges_exact) (sfnt_read_meta_table, sfnt_read_ttc_header) (sfnt_read_cvt_table, sfnt_read_fpgm_table) (sfnt_read_prep_table, sfnt_make_interpreter) (sfnt_interpret_simple_glyph, sfnt_interpret_compound_glyph_2) (sfnt_interpret_compound_glyph, sfnt_read_default_uvs_table) (sfnt_read_nondefault_uvs_table, sfnt_create_uvs_context) (sfnt_read_fvar_table, sfnt_read_gvar_table) (sfnt_read_avar_table, sfnt_read_cvar_table): * src/sfntfont-android.c (GET_SCANLINE_BUFFER): * src/textconv.c (really_commit_text, really_set_composing_text) (really_replace_text, get_surrounding_text): Prefer C2x stdckdint.h macros to intprops.h macros. --- src/alloc.c | 3 +- src/android.c | 22 ++--- src/androidmenu.c | 2 +- src/androidselect.c | 4 +- src/androidterm.c | 6 +- src/haiku_select.cc | 3 +- src/sfnt.c | 256 ++++++++++++++++++++----------------------------- src/sfntfont-android.c | 4 +- src/textconv.c | 28 ++---- 9 files changed, 135 insertions(+), 193 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index b144396948e..15bb65cf74f 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6291,8 +6291,7 @@ android_make_lisp_symbol (struct Lisp_Symbol *sym) intptr_t symoffset; symoffset = (intptr_t) sym; - INT_SUBTRACT_WRAPV (symoffset, (intptr_t) &lispsym, - &symoffset); + ckd_sub (&symoffset, symoffset, (intptr_t) &lispsym); { Lisp_Object a = TAG_PTR_INITIALLY (Lisp_Symbol, symoffset); diff --git a/src/android.c b/src/android.c index 51eb85a97e8..4a74f5b2af4 100644 --- a/src/android.c +++ b/src/android.c @@ -3963,10 +3963,10 @@ android_blit_copy (int src_x, int src_y, int width, int height, /* Turn both into offsets. */ - if (INT_MULTIPLY_WRAPV (temp, pixel, &offset) - || INT_MULTIPLY_WRAPV (i, mask_info->stride, &offset1) - || INT_ADD_WRAPV (offset, offset1, &offset) - || INT_ADD_WRAPV ((uintptr_t) mask, offset, &start)) + if (ckd_mul (&offset, temp, pixel) + || ckd_mul (&offset1, i, mask_info->stride) + || ckd_add (&offset, offset, offset1) + || ckd_add (&start, (uintptr_t) mask, offset)) return; if (height <= 0) @@ -4271,10 +4271,10 @@ android_blit_xor (int src_x, int src_y, int width, int height, /* Turn both into offsets. */ - if (INT_MULTIPLY_WRAPV (temp, pixel, &offset) - || INT_MULTIPLY_WRAPV (i, mask_info->stride, &offset1) - || INT_ADD_WRAPV (offset, offset1, &offset) - || INT_ADD_WRAPV ((uintptr_t) mask, offset, &start)) + if (ckd_mul (&offset, temp, pixel) + || ckd_mul (&offset1, i, mask_info->stride) + || ckd_add (&offset, offset, offset1) + || ckd_add (&start, (uintptr_t) mask, offset)) return; mask = mask_current = (unsigned char *) start; @@ -4899,9 +4899,9 @@ android_get_image (android_drawable handle, if (bitmap_info.format != ANDROID_BITMAP_FORMAT_A_8) { - if (INT_MULTIPLY_WRAPV ((size_t) bitmap_info.stride, - (size_t) bitmap_info.height, - &byte_size)) + if (ckd_mul (&byte_size, + (size_t) bitmap_info.stride, + (size_t) bitmap_info.height)) { ANDROID_DELETE_LOCAL_REF (bitmap); memory_full (0); diff --git a/src/androidmenu.c b/src/androidmenu.c index 1728ae81e42..362d500ac1a 100644 --- a/src/androidmenu.c +++ b/src/androidmenu.c @@ -437,7 +437,7 @@ android_menu_show (struct frame *f, int x, int y, int menuflags, /* Compute the item ID. This is the index of value. Make sure it doesn't overflow. */ - if (!INT_ADD_OK (0, i + MENU_ITEMS_ITEM_VALUE, &item_id)) + if (ckd_add (&item_id, i + MENU_ITEMS_ITEM_VALUE, 0)) memory_full (i + MENU_ITEMS_ITEM_VALUE * sizeof (Lisp_Object)); /* Add this menu item with the appropriate state. */ diff --git a/src/androidselect.c b/src/androidselect.c index 3ba3058aeb9..5b23c559d2c 100644 --- a/src/androidselect.c +++ b/src/androidselect.c @@ -446,7 +446,7 @@ does not have any corresponding data. In that case, use { rc = emacs_read_quit (fd, start, BUFSIZ); - if (!INT_ADD_OK (rc, length, &length) + if (ckd_add (&length, length, rc) || PTRDIFF_MAX - length < BUFSIZ) memory_full (PTRDIFF_MAX); @@ -588,7 +588,7 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, if (NILP (replaces_id)) { /* Generate a new identifier. */ - INT_ADD_WRAPV (counter, 1, &counter); + ckd_add (&counter, counter, 1); id = counter; } else diff --git a/src/androidterm.c b/src/androidterm.c index 8632df1d4fc..d4612bb20fa 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -619,7 +619,7 @@ android_decode_utf16 (unsigned short *utf16, size_t n) struct coding_system coding; ptrdiff_t size; - if (INT_MULTIPLY_WRAPV (n, sizeof *utf16, &size)) + if (ckd_mul (&size, n, sizeof *utf16)) return Qnil; /* Set up the coding system. Decoding a UTF-16 string (with no BOM) @@ -5010,7 +5010,7 @@ android_text_to_string (JNIEnv *env, char *buffer, ptrdiff_t n, { /* This buffer holds no multibyte characters. */ - if (INT_MULTIPLY_WRAPV (n, sizeof *utf16, &size)) + if (ckd_mul (&size, n, sizeof *utf16)) return NULL; utf16 = malloc (size); @@ -5033,7 +5033,7 @@ android_text_to_string (JNIEnv *env, char *buffer, ptrdiff_t n, /* Allocate enough to hold N characters. */ - if (INT_MULTIPLY_WRAPV (n, sizeof *utf16, &size)) + if (ckd_mul (&size, n, sizeof *utf16)) return NULL; utf16 = malloc (size); diff --git a/src/haiku_select.cc b/src/haiku_select.cc index 02f3272514f..74467edf710 100644 --- a/src/haiku_select.cc +++ b/src/haiku_select.cc @@ -619,8 +619,7 @@ be_display_notification (const char *title, const char *body, /* SUPERSEDES hasn't been provided, so allocate a new notification ID. */ - INT_ADD_WRAPV (last_notification_id, 1, - &last_notification_id); + ckd_add (&last_notification_id, last_notification_id, 1); id = last_notification_id; } else diff --git a/src/sfnt.c b/src/sfnt.c index 41dba8b486e..030442fad68 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -663,14 +663,13 @@ sfnt_read_cmap_format_8 (int fd, min_size = SFNT_ENDOF (struct sfnt_cmap_format_8, num_groups, uint32_t); - if (INT_MULTIPLY_WRAPV (format8->num_groups, sizeof *format8->groups, - &temp)) + if (ckd_mul (&temp, format8->num_groups, sizeof *format8->groups)) { xfree (format8); return NULL; } - if (INT_ADD_WRAPV (min_size, temp, &min_size)) + if (ckd_add (&min_size, min_size, temp)) { xfree (format8); return NULL; @@ -755,14 +754,13 @@ sfnt_read_cmap_format_12 (int fd, min_size = SFNT_ENDOF (struct sfnt_cmap_format_12, num_groups, uint32_t); - if (INT_MULTIPLY_WRAPV (format12->num_groups, sizeof *format12->groups, - &temp)) + if (ckd_mul (&temp, format12->num_groups, sizeof *format12->groups)) { xfree (format12); return NULL; } - if (INT_ADD_WRAPV (min_size, temp, &min_size)) + if (ckd_add (&min_size, min_size, temp)) { xfree (format12); return NULL; @@ -841,9 +839,8 @@ sfnt_read_cmap_format_14 (int fd, 14 cmap table. */ size = sizeof *format14; - if (INT_MULTIPLY_WRAPV (num_records, sizeof *format14->records, - &temp) - || INT_ADD_WRAPV (size, temp, &size)) + if (ckd_mul (&temp, num_records, sizeof *format14->records) + || ckd_add (&size, size, temp)) return NULL; format14 = xmalloc (size); @@ -901,7 +898,7 @@ sfnt_read_cmap_table_1 (int fd, uint32_t directory_offset, off_t offset; struct sfnt_cmap_encoding_subtable_data header; - if (INT_ADD_WRAPV (directory_offset, table_offset, &offset)) + if (ckd_add (&offset, directory_offset, table_offset)) return (struct sfnt_cmap_encoding_subtable_data *) -1; if (lseek (fd, offset, SEEK_SET) == (off_t) -1) @@ -2632,24 +2629,21 @@ sfnt_expand_compound_glyph_context (struct sfnt_compound_glyph_context *context, size_t size_bytes; /* Add each field while checking for overflow. */ - if (INT_ADD_WRAPV (number_of_contours, context->num_end_points, - &context->num_end_points)) + if (ckd_add (&context->num_end_points, number_of_contours, + context->num_end_points)) return 1; - if (INT_ADD_WRAPV (number_of_points, context->num_points, - &context->num_points)) + if (ckd_add (&context->num_points, number_of_points, context->num_points)) return 1; /* Reallocate each array to the new size if necessary. */ if (context->points_size < context->num_points) { - if (INT_MULTIPLY_WRAPV (context->num_points, 2, - &context->points_size)) + if (ckd_mul (&context->points_size, context->num_points, 2)) context->points_size = context->num_points; - if (INT_MULTIPLY_WRAPV (context->points_size, - sizeof *context->x_coordinates, - &size_bytes)) + if (ckd_mul (&size_bytes, context->points_size, + sizeof *context->x_coordinates)) return 1; context->x_coordinates = xrealloc (context->x_coordinates, @@ -2673,13 +2667,11 @@ sfnt_expand_compound_glyph_context (struct sfnt_compound_glyph_context *context, if (context->end_points_size < context->num_end_points) { - if (INT_MULTIPLY_WRAPV (context->num_end_points, 2, - &context->end_points_size)) + if (ckd_mul (&context->end_points_size, context->num_end_points, 2)) context->end_points_size = context->num_end_points; - if (INT_MULTIPLY_WRAPV (context->end_points_size, - sizeof *context->contour_end_points, - &size_bytes)) + if (ckd_mul (&size_bytes, context->end_points_size, + sizeof *context->contour_end_points)) return 1; context->contour_end_points @@ -5109,7 +5101,7 @@ sfnt_poly_edges_exact (struct sfnt_fedge *edges, size_t nedges, raster.scanlines = height; raster.chunks = NULL; - if (!INT_MULTIPLY_OK (height, sizeof *raster.steps, &size)) + if (ckd_mul (&size, height, sizeof *raster.steps)) abort (); raster.steps = xzalloc (size); @@ -6040,11 +6032,10 @@ sfnt_read_meta_table (int fd, struct sfnt_offset_subtable *subtable) so an unswapped copy of the whole meta contents must be retained. */ - if (INT_MULTIPLY_WRAPV (sizeof *meta->data_maps, meta->num_data_maps, - &map_size) + if (ckd_mul (&map_size, sizeof *meta->data_maps, meta->num_data_maps) /* Do so while checking for overflow from bad sfnt files. */ - || INT_ADD_WRAPV (map_size, sizeof *meta, &data_size) - || INT_ADD_WRAPV (data_size, directory->length, &data_size)) + || ckd_add (&data_size, map_size, sizeof *meta) + || ckd_add (&data_size, data_size, directory->length)) { xfree (meta); return NULL; @@ -6094,9 +6085,8 @@ sfnt_read_meta_table (int fd, struct sfnt_offset_subtable *subtable) /* Verify the data offsets. Overflow checking is particularly important here. */ - if (INT_ADD_WRAPV (meta->data_maps[i].data_offset, - meta->data_maps[i].data_length, - &offset)) + if (ckd_add (&offset, meta->data_maps[i].data_offset, + meta->data_maps[i].data_length)) { xfree (meta); return NULL; @@ -6182,9 +6172,7 @@ sfnt_read_ttc_header (int fd) /* Now, read the variable length data. Make sure to check for overflow. */ - if (INT_MULTIPLY_WRAPV (ttc->num_fonts, - sizeof *ttc->offset_table, - &size)) + if (ckd_mul (&size, ttc->num_fonts, sizeof *ttc->offset_table)) { xfree (ttc); return NULL; @@ -6303,7 +6291,7 @@ sfnt_read_cvt_table (int fd, struct sfnt_offset_subtable *subtable) return NULL; /* Figure out the minimum amount that has to be read. */ - if (INT_ADD_WRAPV (sizeof *cvt, directory->length, &required)) + if (ckd_add (&required, directory->length, sizeof *cvt)) return NULL; /* Allocate enough for that much data. */ @@ -6354,7 +6342,7 @@ sfnt_read_fpgm_table (int fd, struct sfnt_offset_subtable *subtable) return NULL; /* Figure out the minimum amount that has to be read. */ - if (INT_ADD_WRAPV (sizeof *fpgm, directory->length, &required)) + if (ckd_add (&required, directory->length, sizeof *fpgm)) return NULL; /* Allocate enough for that much data. */ @@ -6402,7 +6390,7 @@ sfnt_read_prep_table (int fd, struct sfnt_offset_subtable *subtable) return NULL; /* Figure out the minimum amount that has to be read. */ - if (INT_ADD_WRAPV (sizeof *prep, directory->length, &required)) + if (ckd_add (&required, directory->length, sizeof *prep)) return NULL; /* Allocate enough for that much data. */ @@ -6654,59 +6642,51 @@ sfnt_make_interpreter (struct sfnt_maxp_table *maxp, size = sizeof (*interpreter); /* Add program stack. */ - if (INT_ADD_WRAPV ((maxp->max_stack_elements - * sizeof *interpreter->stack), - size, &size)) + if (ckd_add (&size, size, (maxp->max_stack_elements + * sizeof *interpreter->stack))) return NULL; /* Add twilight zone. */ - if (INT_ADD_WRAPV ((maxp->max_twilight_points - * sizeof *interpreter->twilight_x), - size, &size)) + if (ckd_add (&size, size, (maxp->max_twilight_points + * sizeof *interpreter->twilight_x))) return NULL; - if (INT_ADD_WRAPV ((maxp->max_twilight_points - * sizeof *interpreter->twilight_y), - size, &size)) + if (ckd_add (&size, size, (maxp->max_twilight_points + * sizeof *interpreter->twilight_y))) return NULL; - if (INT_ADD_WRAPV ((maxp->max_twilight_points - * sizeof *interpreter->twilight_y), - size, &size)) + if (ckd_add (&size, size, (maxp->max_twilight_points + * sizeof *interpreter->twilight_y))) return NULL; - if (INT_ADD_WRAPV ((maxp->max_twilight_points - * sizeof *interpreter->twilight_y), - size, &size)) + if (ckd_add (&size, size, (maxp->max_twilight_points + * sizeof *interpreter->twilight_y))) return NULL; /* Add the storage area. */ storage_size = maxp->max_storage * sizeof *interpreter->storage; - if (INT_ADD_WRAPV (storage_size, size, &size)) + if (ckd_add (&size, size, storage_size)) return NULL; /* Add padding for the storage area. */ pad = alignof (struct sfnt_interpreter_definition); pad -= size & (pad - 1); - if (INT_ADD_WRAPV (pad, size, &size)) + if (ckd_add (&size, size, pad)) return NULL; /* Add function and instruction definitions. */ - if (INT_ADD_WRAPV ((((int) maxp->max_instruction_defs - + maxp->max_function_defs) - * sizeof *interpreter->function_defs), - size, &size)) + if (ckd_add (&size, size, (((int) maxp->max_instruction_defs + + maxp->max_function_defs) + * sizeof *interpreter->function_defs))) return NULL; /* Add control value table. */ if (cvt) { - if (INT_MULTIPLY_WRAPV (cvt->num_elements, - sizeof *interpreter->cvt, - &temp) - || INT_ADD_WRAPV (temp, size, &size)) + if (ckd_mul (&temp, cvt->num_elements, sizeof *interpreter->cvt) + || ckd_add (&size, size, temp)) return NULL; } @@ -12648,19 +12628,16 @@ sfnt_interpret_simple_glyph (struct sfnt_glyph *glyph, /* Calculate the size of the zone structure. */ - if (INT_MULTIPLY_WRAPV (glyph->simple->number_of_points + 2, - sizeof *zone->x_points * 4, - &temp) - || INT_ADD_WRAPV (temp, zone_size, &zone_size) - || INT_MULTIPLY_WRAPV (glyph->number_of_contours, - sizeof *zone->contour_end_points, - &temp) - || INT_ADD_WRAPV (temp, zone_size, &zone_size) - || INT_MULTIPLY_WRAPV (glyph->simple->number_of_points + 2, - sizeof *zone->flags, - &temp) - || INT_ADD_WRAPV (temp, zone_size, &zone_size) - || INT_ADD_WRAPV (sizeof *zone, zone_size, &zone_size)) + if (ckd_mul (&temp, glyph->simple->number_of_points + 2, + sizeof *zone->x_points * 4) + || ckd_add (&zone_size, zone_size, temp) + || ckd_mul (&temp, glyph->number_of_contours, + sizeof *zone->contour_end_points) + || ckd_add (&zone_size, zone_size, temp) + || ckd_mul (&temp, glyph->simple->number_of_points + 2, + sizeof *zone->flags) + || ckd_add (&zone_size, zone_size, temp) + || ckd_add (&zone_size, zone_size, sizeof *zone)) return "Glyph exceeded maximum permissible size"; /* Don't use malloc if possible. */ @@ -12947,19 +12924,13 @@ sfnt_interpret_compound_glyph_2 (struct sfnt_glyph *glyph, zone_size = 0; zone_was_allocated = false; - if (INT_MULTIPLY_WRAPV (num_points + 2, - sizeof *zone->x_points * 4, - &temp) - || INT_ADD_WRAPV (temp, zone_size, &zone_size) - || INT_MULTIPLY_WRAPV (num_contours, - sizeof *zone->contour_end_points, - &temp) - || INT_ADD_WRAPV (temp, zone_size, &zone_size) - || INT_MULTIPLY_WRAPV (num_points + 2, - sizeof *zone->flags, - &temp) - || INT_ADD_WRAPV (temp, zone_size, &zone_size) - || INT_ADD_WRAPV (sizeof *zone, zone_size, &zone_size)) + if (ckd_mul (&temp, num_points + 2, sizeof *zone->x_points * 4) + || ckd_add (&zone_size, zone_size, temp) + || ckd_mul (&temp, num_contours, sizeof *zone->contour_end_points) + || ckd_add (&zone_size, zone_size, temp) + || ckd_mul (&temp, num_points + 2, sizeof *zone->flags) + || ckd_add (&zone_size, zone_size, temp) + || ckd_add (&zone_size, zone_size, sizeof *zone)) return "Glyph exceeded maximum permissible size"; /* Don't use malloc if possible. */ @@ -13602,16 +13573,12 @@ sfnt_interpret_compound_glyph (struct sfnt_glyph *glyph, /* Copy the compound glyph data into an instructed outline. */ outline_size = sizeof (*outline); - if (INT_MULTIPLY_WRAPV (context.num_end_points, - sizeof *outline->contour_end_points, - &temp) - || INT_ADD_WRAPV (outline_size, temp, &outline_size) - || INT_MULTIPLY_WRAPV (context.num_points, - sizeof *outline->x_points * 2, - &temp) - || INT_ADD_WRAPV (outline_size, temp, &outline_size) - || INT_ADD_WRAPV (context.num_points, outline_size, - &outline_size)) + if (ckd_mul (&temp, context.num_end_points, + sizeof *outline->contour_end_points) + || ckd_add (&outline_size, outline_size, temp) + || ckd_mul (&temp, context.num_points, sizeof *outline->x_points * 2) + || ckd_add (&outline_size, outline_size, temp) + || ckd_add (&outline_size, outline_size, context.num_points)) { xfree (context.x_coordinates); xfree (context.y_coordinates); @@ -13734,9 +13701,8 @@ sfnt_read_default_uvs_table (int fd, off_t offset) /* Now, allocate enough to hold the UVS table. */ size = sizeof *uvs; - if (INT_MULTIPLY_WRAPV (sizeof *uvs->ranges, num_ranges, - &temp) - || INT_ADD_WRAPV (temp, size, &size)) + if (ckd_mul (&temp, num_ranges, sizeof *uvs->ranges) + || ckd_add (&size, size, temp)) return NULL; uvs = xmalloc (size); @@ -13805,9 +13771,8 @@ sfnt_read_nondefault_uvs_table (int fd, off_t offset) /* Now, allocate enough to hold the UVS table. */ size = sizeof *uvs; - if (INT_MULTIPLY_WRAPV (sizeof *uvs->mappings, num_mappings, - &temp) - || INT_ADD_WRAPV (temp, size, &size)) + if (ckd_mul (&temp, num_mappings, sizeof *uvs->mappings) + || ckd_add (&size, size, temp)) return NULL; uvs = xmalloc (size); @@ -13887,9 +13852,9 @@ sfnt_create_uvs_context (struct sfnt_cmap_format_14 *cmap, int fd) off_t offset; struct sfnt_uvs_context *context; - if (INT_MULTIPLY_WRAPV (cmap->num_var_selector_records, - sizeof *table_offsets, &size) - || INT_MULTIPLY_WRAPV (size, 2, &size)) + if (ckd_mul (&size, cmap->num_var_selector_records, + sizeof *table_offsets) + || ckd_mul (&size, size, 2)) return NULL; context = NULL; @@ -13909,9 +13874,8 @@ sfnt_create_uvs_context (struct sfnt_cmap_format_14 *cmap, int fd) if (cmap->records[i].default_uvs_offset) { - if (INT_ADD_WRAPV (cmap->offset, - cmap->records[i].default_uvs_offset, - &table_offsets[j].offset)) + if (ckd_add (&table_offsets[j].offset, cmap->offset, + cmap->records[i].default_uvs_offset)) goto bail; table_offsets[j++].is_nondefault_table = false; @@ -13919,9 +13883,8 @@ sfnt_create_uvs_context (struct sfnt_cmap_format_14 *cmap, int fd) if (cmap->records[i].nondefault_uvs_offset) { - if (INT_ADD_WRAPV (cmap->offset, - cmap->records[i].nondefault_uvs_offset, - &table_offsets[j].offset)) + if (ckd_add (&table_offsets[j].offset, cmap->offset, + cmap->records[i].nondefault_uvs_offset)) goto bail; table_offsets[j++].is_nondefault_table = true; @@ -14359,14 +14322,12 @@ sfnt_read_fvar_table (int fd, struct sfnt_offset_subtable *subtable) name identifier, or 3 * sizeof (uint16_t) + axisCount * sizeof (sfnt_fixed), meaning there is. */ - if (INT_MULTIPLY_WRAPV (fvar->axis_count, sizeof (sfnt_fixed), - &temp) - || INT_ADD_WRAPV (2 * sizeof (uint16_t), temp, &non_ps_size)) + if (ckd_mul (&temp, fvar->axis_count, sizeof (sfnt_fixed)) + || ckd_add (&non_ps_size, temp, 2 * sizeof (uint16_t))) goto bail; - if (INT_MULTIPLY_WRAPV (fvar->axis_count, sizeof (sfnt_fixed), - &temp) - || INT_ADD_WRAPV (3 * sizeof (uint16_t), temp, &ps_size)) + if (ckd_mul (&temp, fvar->axis_count, sizeof (sfnt_fixed)) + || ckd_add (&ps_size, temp, 3 * sizeof (uint16_t))) goto bail; if (fvar->instance_size != non_ps_size @@ -14376,8 +14337,7 @@ sfnt_read_fvar_table (int fd, struct sfnt_offset_subtable *subtable) /* Now compute the offset of the axis data from the start of the font file. */ - if (INT_ADD_WRAPV (fvar->offset_to_data, directory->offset, - &offset)) + if (ckd_add (&offset, fvar->offset_to_data, directory->offset)) goto bail; /* Seek there. */ @@ -14394,28 +14354,23 @@ sfnt_read_fvar_table (int fd, struct sfnt_offset_subtable *subtable) sfnt_instance) + sizeof (sfnt_fixed) * fvar->instance_count * fvar->axis_count. */ - if (INT_MULTIPLY_WRAPV (fvar->axis_count, sizeof *fvar->axis, - &temp) - || INT_ADD_WRAPV (min_bytes, temp, &min_bytes)) + if (ckd_mul (&temp, fvar->axis_count, sizeof *fvar->axis) + || ckd_add (&min_bytes, min_bytes, temp)) goto bail; pad = alignof (struct sfnt_instance); pad -= min_bytes & (pad - 1); - if (INT_ADD_WRAPV (min_bytes, pad, &min_bytes)) + if (ckd_add (&min_bytes, min_bytes, pad)) goto bail; - if (INT_MULTIPLY_WRAPV (fvar->instance_count, - sizeof *fvar->instance, - &temp) - || INT_ADD_WRAPV (min_bytes, temp, &min_bytes)) + if (ckd_mul (&temp, fvar->instance_count, sizeof *fvar->instance) + || ckd_add (&min_bytes, min_bytes, temp)) goto bail; - if (INT_MULTIPLY_WRAPV (fvar->instance_count, - sizeof *fvar->instance->coords, - &temp) - || INT_MULTIPLY_WRAPV (temp, fvar->axis_count, &temp) - || INT_ADD_WRAPV (min_bytes, temp, &min_bytes)) + if (ckd_mul (&temp, fvar->instance_count, sizeof *fvar->instance->coords) + || ckd_mul (&temp, temp, fvar->axis_count) + || ckd_add (&min_bytes, min_bytes, temp)) goto bail; /* Reallocate fvar. */ @@ -14597,9 +14552,9 @@ sfnt_read_gvar_table (int fd, struct sfnt_offset_subtable *subtable) goto bail; /* Figure out how big gvar needs to be. */ - if (INT_ADD_WRAPV (sizeof *gvar, coordinate_size, &min_bytes) - || INT_ADD_WRAPV (min_bytes, off_size, &min_bytes) - || INT_ADD_WRAPV (min_bytes, data_size, &min_bytes)) + if (ckd_add (&min_bytes, coordinate_size, sizeof *gvar) + || ckd_add (&min_bytes, min_bytes, off_size) + || ckd_add (&min_bytes, min_bytes, data_size)) goto bail; /* Now allocate enough for all of this extra data. */ @@ -14635,8 +14590,7 @@ sfnt_read_gvar_table (int fd, struct sfnt_offset_subtable *subtable) if (gvar->shared_coord_count) { - if (INT_ADD_WRAPV (gvar->offset_to_coord, directory->offset, - &offset)) + if (ckd_add (&offset, gvar->offset_to_coord, directory->offset)) goto bail; if (lseek (fd, offset, SEEK_SET) != offset) @@ -14660,8 +14614,7 @@ sfnt_read_gvar_table (int fd, struct sfnt_offset_subtable *subtable) if (gvar->data_size) { - if (INT_ADD_WRAPV (gvar->offset_to_data, directory->offset, - &offset)) + if (ckd_add (&offset, gvar->offset_to_data, directory->offset)) goto bail; if (lseek (fd, offset, SEEK_SET) != offset) @@ -14757,10 +14710,10 @@ sfnt_read_avar_table (int fd, struct sfnt_offset_subtable *subtable) /* Now add one struct sfnt_short_frac_segment for each axis and each of its correspondences. */ - if (INT_ADD_WRAPV (sizeof (struct sfnt_short_frac_segment), - min_size, &min_size) - || INT_ADD_WRAPV (sizeof (struct sfnt_short_frac_correspondence) - * buffer[k], min_size, &min_size)) + if (ckd_add (&min_size, min_size, sizeof (struct sfnt_short_frac_segment)) + || ckd_add (&min_size, min_size, + (sizeof (struct sfnt_short_frac_correspondence) + * buffer[k]))) goto bail1; /* Verify that words from here to buffer[1 + buffer[k] * 2], the @@ -15109,8 +15062,7 @@ sfnt_read_cvar_table (int fd, struct sfnt_offset_subtable *subtable, goto bail2; tuple += sizeof *coords * fvar->axis_count; - if (INT_ADD_WRAPV (size, sizeof *coords * fvar->axis_count, - &size)) + if (ckd_add (&size, size, sizeof *coords * fvar->axis_count)) goto bail2; } else @@ -15122,20 +15074,20 @@ sfnt_read_cvar_table (int fd, struct sfnt_offset_subtable *subtable, if (index & 0x4000) { tuple += fvar->axis_count * 4; - if (INT_ADD_WRAPV (size, fvar->axis_count * 4, &size)) + if (ckd_add (&size, size, fvar->axis_count * 4)) goto bail2; } /* Add one point and one delta for each CVT element. */ - if (INT_ADD_WRAPV (size, cvt->num_elements * 4, &size)) + if (ckd_add (&size, size, cvt->num_elements * 4)) goto bail2; /* Now add the size of the tuple. */ - if (INT_ADD_WRAPV (size, sizeof *cvar->variation, &size)) + if (ckd_add (&size, size, sizeof *cvar->variation)) goto bail2; } - if (INT_ADD_WRAPV (sizeof *cvar, size, &size)) + if (ckd_add (&size, size, sizeof *cvar)) goto bail2; /* Reallocate cvar. */ diff --git a/src/sfntfont-android.c b/src/sfntfont-android.c index 9ead43a9c5d..94aedd0cd66 100644 --- a/src/sfntfont-android.c +++ b/src/sfntfont-android.c @@ -78,7 +78,7 @@ static size_t max_scanline_buffer_size; { \ size_t _size; \ \ - if (INT_MULTIPLY_WRAPV (height, stride, &_size)) \ + if (ckd_mul (&_size, height, stride)) \ memory_full (SIZE_MAX); \ \ if (_size < MAX_ALLOCA) \ @@ -112,7 +112,7 @@ static size_t max_scanline_buffer_size; size_t _size; \ void *_temp; \ \ - if (INT_MULTIPLY_WRAPV (height, stride, &_size)) \ + if (ckd_mul (&_size, height, stride)) \ memory_full (SIZE_MAX); \ \ if (_size > scanline_buffer.buffer_size) \ diff --git a/src/textconv.c b/src/textconv.c index 2a7b0ed330d..0d35ec19c55 100644 --- a/src/textconv.c +++ b/src/textconv.c @@ -649,8 +649,7 @@ really_commit_text (struct frame *f, EMACS_INT position, start of the text that was inserted. */ wanted = start; - if (INT_ADD_WRAPV (wanted, position, &wanted) - || wanted < BEGV) + if (ckd_add (&wanted, wanted, position) || wanted < BEGV) wanted = BEGV; if (wanted > ZV) @@ -664,8 +663,7 @@ really_commit_text (struct frame *f, EMACS_INT position, TEXT. */ wanted = PT; - if (INT_ADD_WRAPV (wanted, position - 1, &wanted) - || wanted > ZV) + if (ckd_add (&wanted, wanted, position - 1) || wanted > ZV) wanted = ZV; if (wanted < BEGV) @@ -712,8 +710,7 @@ really_commit_text (struct frame *f, EMACS_INT position, if (position <= 0) { - if (INT_ADD_WRAPV (wanted, position, &wanted) - || wanted < BEGV) + if (ckd_add (&wanted, wanted, position) || wanted < BEGV) wanted = BEGV; if (wanted > ZV) @@ -725,8 +722,7 @@ really_commit_text (struct frame *f, EMACS_INT position, { wanted = PT; - if (INT_ADD_WRAPV (wanted, position - 1, &wanted) - || wanted > ZV) + if (ckd_add (&wanted, wanted, position - 1) || wanted > ZV) wanted = ZV; if (wanted < BEGV) @@ -870,8 +866,7 @@ really_set_composing_text (struct frame *f, ptrdiff_t position, { wanted = start; - if (INT_SUBTRACT_WRAPV (wanted, position, &wanted) - || wanted < BEGV) + if (ckd_sub (&wanted, wanted, position) || wanted < BEGV) wanted = BEGV; if (wanted > ZV) @@ -885,8 +880,7 @@ really_set_composing_text (struct frame *f, ptrdiff_t position, /* end should be PT after the edit. */ eassert (end == PT); - if (INT_ADD_WRAPV (wanted, position - 1, &wanted) - || wanted > ZV) + if (ckd_add (&wanted, wanted, position - 1) || wanted > ZV) wanted = ZV; if (wanted < BEGV) @@ -1256,8 +1250,7 @@ really_replace_text (struct frame *f, ptrdiff_t start, ptrdiff_t end, if (position <= 0) { - if (INT_ADD_WRAPV (wanted, position, &wanted) - || wanted < BEGV) + if (ckd_add (&wanted, wanted, position) || wanted < BEGV) wanted = BEGV; if (wanted > ZV) @@ -1269,8 +1262,7 @@ really_replace_text (struct frame *f, ptrdiff_t start, ptrdiff_t end, { wanted = PT; - if (INT_ADD_WRAPV (wanted, position - 1, &wanted) - || wanted > ZV) + if (ckd_add (&wanted, wanted, position - 1) || wanted > ZV) wanted = ZV; if (wanted < BEGV) @@ -2020,8 +2012,8 @@ get_surrounding_text (struct frame *f, ptrdiff_t left, /* And subtract left and right. */ - if (INT_SUBTRACT_WRAPV (start, left, &start) - || INT_ADD_WRAPV (end, right, &end)) + if (ckd_sub (&start, start, left) + || ckd_add (&end, end, right)) goto finish; start = max (start, BEGV); -- cgit v1.2.3 From 78fc49407b8ef8ec649fe70fcce09101801dbc05 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 28 Jan 2024 16:31:33 +0800 Subject: Improve filling of ChangeLog entries * lisp/vc/log-edit.el (log-edit--insert-filled-defuns): Rewrite completely. (log-edit-fill-entry): Abandon pcase and cl-lib. --- lisp/vc/log-edit.el | 133 +++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 101 insertions(+), 32 deletions(-) diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 72867f14d2f..5f370511b14 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -575,19 +575,79 @@ the \\[vc-prefix-map] prefix for VC commands, for example). "Insert FUNC-NAMES, following ChangeLog formatting." (if (not func-names) (insert ":") + ;; Insert a space unless this list of file names is being inserted + ;; at the start of a line or after a space character. (unless (or (memq (char-before) '(?\n ?\s)) (> (current-column) fill-column)) (insert " ")) - (cl-loop for first-fun = t then nil - for def in func-names do - (when (> (+ (current-column) (string-width def)) fill-column) - (unless first-fun - (insert ")")) - (insert "\n")) - (insert (if (memq (char-before) '(?\n ?\s)) - "(" ", ") - def)) - (insert "):"))) + (let ((inside-paren-pair nil) + (first-line t) + name) + ;; Now insert the functions names one by one, inserting newlines + ;; as appropriate. + (while func-names + (setq name (car func-names)) + (setq func-names (cdr func-names)) + ;; If inserting `name' in at the current column would overflow + ;; the fill column, place it on its own line. + (if (and first-line + (> (+ (current-column) + (string-width name) + ;; If this be the last name, the column must be + ;; followed by an extra colon character. + (if func-names 1 2)) + fill-column)) + (progn + (insert "\n") + ;; Iterate over this function name again. + (setq func-names (cons name func-names))) + (if inside-paren-pair + ;; If `name' is not the first item in a list of defuns + ;; and inserting it would overflow the fill column, + ;; start a new list of defuns on the next line. + (if (> (+ (current-column) + (string-width name) + ;; If this be the last name, the column must + ;; be followed by an extra colon character; + ;; however, there are two separator characters + ;; that will be deleted, so the number of + ;; columns to add to this in the case of + ;; `name' being final and in other cases are + ;; -1 and -2 respectively. + (if func-names -1 -2)) + fill-column) + (progn + (delete-char -2) + (insert ")\n") + (setq inside-paren-pair nil + ;; Iterate over this function name again. + func-names (cons name func-names))) + ;; Insert this file name with a separator attached. + (insert name ", ")) + ;; Otherwise, decide whether to start a list of defuns or + ;; to insert `name' on its own line. + (if (> (+ (current-column) + (string-width name) + (if func-names 1 2)) ; The column number of + ; line after inserting + ; `name'... + fill-column) + ;; ...would leave insufficient space for any subsequent + ;; file names, so insert it on its own line. + (insert (if func-names + (format "(%s)\n" name) + (format "(%s):" name))) + ;; Insert a new defun list, unless `name' is the last + ;; function name. + (insert (if (not func-names) + (format "(%s):" name) + (setq inside-paren-pair t) + (format "(%s, " name)))))) + (setq first-line nil)) + ;; Close any open list of defuns. + (when inside-paren-pair + (delete-char -2) + (insert "):"))))) (defun log-edit-fill-entry (&optional justify) "Like \\[fill-paragraph], but for filling ChangeLog-formatted entries. @@ -595,32 +655,41 @@ Consecutive function entries without prose (i.e., lines of the form \"(FUNCTION):\") will be combined into \"(FUNC1, FUNC2):\" according to `fill-column'." (save-excursion - (pcase-let ((`(,beg ,end) (log-edit-changelog-paragraph))) + (let* ((range (log-edit-changelog-paragraph)) + (beg (car range)) + (end (cadr range))) (if (= beg end) ;; Not a ChangeLog entry, fill as normal. nil - (cl-callf copy-marker end) + (setq end (copy-marker end)) (goto-char beg) - (cl-loop - for defuns-beg = - (and (< beg end) - (re-search-forward - (concat "\\(?1:" change-log-unindented-file-names-re - "\\)\\|^\\(?1:\\)[[:blank:]]*(") - end t) - (copy-marker (match-end 1))) - ;; Fill prose between log entries. - do (let ((fill-indent-according-to-mode t) - (end (if defuns-beg (match-beginning 0) end)) - (beg (progn (goto-char beg) (line-beginning-position)))) - (when (<= (line-end-position) end) - (fill-region beg end justify))) - while defuns-beg - for defuns = (progn (goto-char defuns-beg) - (change-log-read-defuns end)) - do (progn (delete-region defuns-beg (point)) - (log-edit--insert-filled-defuns defuns) - (setq beg (point)))) + (let* ((defuns-beg nil) + (defuns nil)) + (while + (progn + (setq defuns-beg + (and (< beg end) + (re-search-forward + (concat "\\(?1:" + change-log-unindented-file-names-re + "\\)\\|^\\(?1:\\)[[:blank:]]*(") + end t) + (copy-marker (match-end 1)))) + (let ((fill-indent-according-to-mode t) + (end (if defuns-beg + (match-beginning 0) end)) + (beg (progn (goto-char beg) + (line-beginning-position)))) + (when (<= (line-end-position) end) + (fill-region beg end justify))) + defuns-beg) + (goto-char defuns-beg) + (setq defuns (change-log-read-defuns end)) + (progn + (delete-region defuns-beg (point)) + (log-edit--insert-filled-defuns defuns) + (setq beg (point)))) + nil) t)))) (defun log-edit-hide-buf (&optional buf where) -- cgit v1.2.3 From d664814a8d40da63f1906218b73aec62f2cd4d18 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 28 Jan 2024 16:55:33 +0800 Subject: ; New log-edit tests * test/lisp/vc/log-edit-tests.el (log-edit-fill-entry-confinement): Test confinement in various contrived scenarious. --- test/lisp/vc/log-edit-tests.el | 51 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 51 insertions(+) diff --git a/test/lisp/vc/log-edit-tests.el b/test/lisp/vc/log-edit-tests.el index 1a2af716f34..5b555809f4c 100644 --- a/test/lisp/vc/log-edit-tests.el +++ b/test/lisp/vc/log-edit-tests.el @@ -134,4 +134,55 @@ lines.")))) * a-very-long-directory-name/another-long-directory-name/and-a-long-file-name.ext \(a-really-long-function-name):")))) +(ert-deftest log-edit-fill-entry-confinement () + (let (string string1 string2 string3 string4) + (setq string + ;; This entry is precisely 65 columns in length; + ;; log-edit-fill-column should leave it unmodified. + "* file2.txt (fun4, fun5, fun6, fun7, fun8, fun9, fun10, fun1134):" + string1 + ;; This entry is 66 columns in length, and must be filled. + "* file2.txt (fun4, fun5, fun6, fun7, fun8, fun9, fun10, fun11345):" + string2 + ;; The first line of this entry totals 65 columns in length, + ;; and should be preserved intact. + "* file2.txt (fun4, fun5, fun6, fun7, fun8, fun9, fun10, fun11345) +(fun11356):" + string3 + ;; The first defun in this entry is a file name that brings + ;; the total to 40 columns in length and should be preserved + ;; intact. + "* file2.txt (abcdefghijklmnopqrstuvwxyz) +(ABC):" + string4 + ;; The first defun brings that total to 41, and should be + ;; placed on the next line. + "* file2.txt (abcdefghijklmnopqrstuvwxyz):") + (with-temp-buffer + (insert string) + (let ((fill-column 64)) (log-edit-fill-entry)) + (should (equal (buffer-string) string)) + (erase-buffer) + (insert string1) + (let ((fill-column 64)) (log-edit-fill-entry)) + (should (equal (buffer-string) + "* file2.txt (fun4, fun5, fun6, fun7, fun8, fun9, fun10) +(fun11345):")) + (erase-buffer) + (insert string2) + (let ((fill-column 64)) (log-edit-fill-entry)) + (should (equal (buffer-string) string2)) + (erase-buffer) + (insert string3) + (let ((fill-column 39)) (log-edit-fill-entry)) + (should (equal (buffer-string) string3)) + (erase-buffer) + (insert string4) + (let ((fill-column 39)) (log-edit-fill-entry)) + (should (equal (buffer-string) + ;; There is whitespace after "file2.txt" which + ;; should not be erased! + "* file2.txt +(abcdefghijklmnopqrstuvwxyz):"))))) + ;;; log-edit-tests.el ends here -- cgit v1.2.3 From adf32eb69ea34b9c057c9a4321e5f05b00a7c940 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 28 Jan 2024 16:55:56 +0800 Subject: ; Correct typo * lisp/vc/log-edit.el (log-edit--insert-filled-defuns): Correct typo in alignment constants. --- lisp/vc/log-edit.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 5f370511b14..b5f12f0b4fc 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -612,9 +612,9 @@ the \\[vc-prefix-map] prefix for VC commands, for example). ;; however, there are two separator characters ;; that will be deleted, so the number of ;; columns to add to this in the case of - ;; `name' being final and in other cases are - ;; -1 and -2 respectively. - (if func-names -1 -2)) + ;; `name' being final and in other cases are 0 + ;; and 1 respectively. + (if func-names 0 1)) fill-column) (progn (delete-char -2) -- cgit v1.2.3 From 833d2636ff8a65c9f9f982618f1974d424baa3fe Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 28 Jan 2024 17:08:50 +0800 Subject: ; * lisp/vc/log-edit.el (log-edit--insert-filled-defuns): Fix typos. --- lisp/vc/log-edit.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index b5f12f0b4fc..b847fb953f2 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -575,8 +575,8 @@ the \\[vc-prefix-map] prefix for VC commands, for example). "Insert FUNC-NAMES, following ChangeLog formatting." (if (not func-names) (insert ":") - ;; Insert a space unless this list of file names is being inserted - ;; at the start of a line or after a space character. + ;; Insert a space unless this list of defun names is being + ;; inserted at the start of a line or after a space character. (unless (or (memq (char-before) '(?\n ?\s)) (> (current-column) fill-column)) (insert " ")) @@ -622,7 +622,7 @@ the \\[vc-prefix-map] prefix for VC commands, for example). (setq inside-paren-pair nil ;; Iterate over this function name again. func-names (cons name func-names))) - ;; Insert this file name with a separator attached. + ;; Insert this defun name with a separator attached. (insert name ", ")) ;; Otherwise, decide whether to start a list of defuns or ;; to insert `name' on its own line. @@ -632,8 +632,9 @@ the \\[vc-prefix-map] prefix for VC commands, for example). ; line after inserting ; `name'... fill-column) - ;; ...would leave insufficient space for any subsequent - ;; file names, so insert it on its own line. + ;; ...would leave insufficient space for any + ;; subsequent defun names so insert it on its own + ;; line. (insert (if func-names (format "(%s)\n" name) (format "(%s):" name))) -- cgit v1.2.3 From e11c9f9c6e843779c4b69097490dd78de522a79d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 28 Jan 2024 10:31:45 +0100 Subject: Handle wrong login program in Tramp * lisp/net/tramp-sh.el (tramp-maybe-open-connection): Exit remote shell when login fails. --- lisp/net/tramp-sh.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 38925652376..1301cd633da 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -5340,7 +5340,7 @@ connection if a previous connection has died for some reason." "2>" (tramp-get-remote-null-device previous-hop)) ?l (concat remote-shell " " extra-args " -i")) ;; A restricted shell does not allow "exec". - (when r-shell '("&&" "exit" "||" "exit"))) + (when r-shell '("&&" "exit")) '("||" "exit")) " ")) ;; Send the command. -- cgit v1.2.3 From 396b49871aa5432e2ff00230868013a22b180656 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 28 Jan 2024 07:43:25 +0200 Subject: ; Fix last change in package.texi * doc/lispref/package.texi (Multi-file Packages): Fix wording and markup. (Bug#65027) (cherry picked from commit 6d76e3991241905b0841effc6f8cd42394d9aa64) --- doc/lispref/package.texi | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi index ebe578932bf..f75023d4039 100644 --- a/doc/lispref/package.texi +++ b/doc/lispref/package.texi @@ -284,12 +284,14 @@ variable @code{load-file-name} (@pxref{Loading}). Here is an example: (expand-file-name file superfrobnicator-base)) @end smallexample - If your project contains files that you don't wish to distribute to +@cindex @file{.elpaignore} file + If your package contains files that you don't wish to distribute to users (e.g.@: regression tests), you can add them to an -@file{.elpaignore} file. In this file, each line lists a file or -wildcard matching files to ignore when producing your package's tar -file on ELPA. (ELPA will pass this file to @command{tar} with the -@code{-X} option.) +@file{.elpaignore} file. In this file, each line lists a file or a +wildcard matching files; those files should be ignored when producing +your package's tarball on ELPA (@pxref{Package Archives}). (ELPA +will pass this file to the @command{tar} command via the @option{-X} +command-line option, when it prepares the package for download.) @node Package Archives @section Creating and Maintaining Package Archives -- cgit v1.2.3 From c22d0ae2dd899ebc1f74e4e67f098216899ea202 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 28 Jan 2024 10:19:48 +0200 Subject: Fix "emacs -nw" on MS-Windows * src/w32term.c (w32_flip_buffers_if_dirty): Do nothing if F is not a GUI frame. This avoids rare crashes in "emacs -nw". * src/w32console.c (initialize_w32_display): Set the ENABLE_EXTENDED_FLAGS bit in 'prev_console_mode'. (cherry picked from commit e1970c99f097715fc5bb3b88154799bfe13de90f) --- src/w32console.c | 4 ++++ src/w32term.c | 5 +++-- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/w32console.c b/src/w32console.c index c2b87928cc1..0936b5f37e6 100644 --- a/src/w32console.c +++ b/src/w32console.c @@ -705,6 +705,10 @@ initialize_w32_display (struct terminal *term, int *width, int *height) /* Remember original console settings. */ keyboard_handle = GetStdHandle (STD_INPUT_HANDLE); GetConsoleMode (keyboard_handle, &prev_console_mode); + /* Make sure ENABLE_EXTENDED_FLAGS is set in console settings, + otherwise restoring the original setting of ENABLE_MOUSE_INPUT + will not work. */ + prev_console_mode |= ENABLE_EXTENDED_FLAGS; prev_screen = GetStdHandle (STD_OUTPUT_HANDLE); diff --git a/src/w32term.c b/src/w32term.c index 6dae118108e..281ce3c663a 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -776,12 +776,13 @@ w32_buffer_flipping_unblocked_hook (struct frame *f) /* Flip buffers on F if drawing has happened. This function is not called to flush the display connection of a frame (which doesn't - exist on MS Windows), but also called in some situations in + exist on MS Windows), but is called in some situations in minibuf.c to make the contents of the back buffer visible. */ void w32_flip_buffers_if_dirty (struct frame *f) { - if (FRAME_OUTPUT_DATA (f)->paint_buffer + if (FRAME_W32_P (f) /* do nothing in TTY frames */ + && FRAME_OUTPUT_DATA (f)->paint_buffer && FRAME_OUTPUT_DATA (f)->paint_buffer_dirty && !f->garbaged && !buffer_flipping_blocked_p ()) w32_show_back_buffer (f); -- cgit v1.2.3 From 71b5d5a9799a37948b2e8cca125a59e2bfb71e96 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 28 Jan 2024 16:59:50 +0100 Subject: ; Fix typos --- admin/codespell/codespell.exclude | 70 ++++++++++++++++------ doc/emacs/buffers.texi | 2 +- doc/misc/ses.texi | 2 +- lisp/progmodes/hideif.el | 2 +- src/eval.c | 4 +- src/xdisp.c | 2 +- .../lisp/erc/erc-scenarios-keep-place-indicator.el | 2 +- test/lisp/erc/resources/erc-tests-common.el | 2 +- .../progmodes/elixir-ts-mode-resources/indent.erts | 2 +- test/src/comp-tests.el | 2 +- 10 files changed, 62 insertions(+), 28 deletions(-) diff --git a/admin/codespell/codespell.exclude b/admin/codespell/codespell.exclude index 2503f4a9a16..416d79cf131 100644 --- a/admin/codespell/codespell.exclude +++ b/admin/codespell/codespell.exclude @@ -1,3 +1,54 @@ + say "And this happens inbetween"; + @ture) + ($sig,$na,@ture) +($sig,$na,@ture) +@ture) +((squery 10 "SQUERY alis :help list") + (0.01 ":Alis@hub.uk NOTICE tester :See also: HELP EXAMPLES")) + (0.04 ":Alis@hub.uk NOTICE tester :[...]") + (0.01 ":Alis@hub.uk NOTICE tester :/SQUERY Alis LIST mask [-options]") + (0.08 ":Alis@hub.uk NOTICE tester :Searches for a channel") + (erc-scenarios-common-say "/SQUERY alis help list") + (should (equal '((regexp . "(string-match-p \"^[fo]+\" \"foobar\")\n => 0")) + (or "comm" "comma" "comman" "command" "commands" + (when (and (not (or skipp erc-timestamp-format)) + (unless skipp + (skipp (or (and erc-stamp--skip-when-invisible invisible) +;; if you type "foo", but typing just "fo" doesn't show the preview. + (Emacs main thre), pid 32619 (org.gnu.emacs) +F DEBUG : pid: 32619, tid: 32644, name: Emacs main thre >>> org.gnu.emacs <<< + bnez $t2, .filld # start filling longs + j .filld # fill either doubleword or byte +.filld: + + (0.01 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:08:40] alice: My sons would never so dishonour me.") + interger intger lits bool boolen constant filename + with typess = (sort (mapcar #'comp-supertypes + for types in typess +;; FIXME: normalise `seq', both the construct and implicit sequences, +;; `intersection', we may end up normalising subtrees multiple times +;; One way to avoid this is to aggressively normalise the entire tree +;; Such normalisation could normalise synonyms, eliminate `minimal-match' + ;; Normalise the constructor to `or' and the args recursively. + "Intersection of the normalised FORMS, as an interval set." +FORM must be normalised (from `rx--normalise-char-pattern')." + "Optimise `or' arguments. Return a new rx form. +Each element of ARGS should have been normalised using + (search-forward "retur") ; leaves point before the "n" +with typess = (sort (mapcar #'comp-supertypes + (font-spec :registry "iso10646-1" :otf '(khmr nil (pres))))) +(0.01 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:08:40] alice: My sons would never so dishonour me.") + (0.05 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :alice: Pawn me to this your honour, she is his.")) + (funcall expect 1 "Entirely honour")) + (0 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :You have paid the heavens your function, and the prisoner the very debt of your calling. I have laboured for the poor gentleman to the extremest shore of my modesty; but my brother justice have I found so severe, that he hath forced me to tell him he is indeed Justice.") + (0.00 ":irc.example.net 501 tester x :is not a recognised user mode.") + (0.00 ":irc.example.net 501 dummy` x :is not a recognised user mode.") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #utf-8 :alice: Entirely honour; I would not be delay'd.")) + integer integer list bool boolean constant filename + "def" "defi" "defin" "define" + "doc" "docu" "docum" "docume" "documen" "document" + case Aadd : overflow = ckd_add (&a, accum, next); break; + And this the second, again with the same distinction therefrom. Bonus: Return a cons cell: (COMPILED . UPTODATE). Bonus: Return a cons cell: (COMPILED . UPTODATE)." (defun semantic-grammar-create-package (&optional force uptodate) @@ -57,7 +108,6 @@ order but are now listed consecutively en bloc. 2003-06-11 Daniel Néri 2001-07-26 10:00:00 Steven E. Harris 2001-01-15 Jack Twilley - matching LAMDA as a word. Noted by Stefan Monnier. completion variant for every "LAMDA" name (bug#30513). "foto" @@ -195,7 +245,7 @@ mode setting. With the Inverse flag [@code{alog}], this command is @r{ a b@: I B @: @: 2 @:alog@:(a,b) b^a} @r{ a b@: I f I @: @: 2 @:alog@:(a,b) b^a} Change comment about the iif hook to reflect the actual reason. - "I + E (ln), L (exp), B (alog: B^X); f E (lnp1), f L (expm1)" + "\\`I' + \\`E' (ln), \\`L' (exp), \\`B' (alog: B^X); \\`f E' (lnp1), \\`f L' (expm1)" (let (numer denom) (setq numer (car (math-read-expr-list))) (if (and (Math-num-integerp numer) @@ -1177,9 +1227,6 @@ In CLOS, the argument list is (CLASS OBJECT SLOT-NAME), but const char *cm_right; /* right (nd) */ (should (equal (ert-test-result-messages result) "a\nb\nc\nd\n"))))) (insert "a\nb\nc\nd\n") - (insert "a\nb\nc\nd\n") - (insert "a\nb\nc\nd\n") - (insert "a\nb\nc\nd\n") (insert "a\nb\nc\nd\n") (should (string= (buffer-string) "Abc\nd efg\n(h ijk).")))) (nd (read-directory-name "Create directory: " @@ -1192,7 +1239,6 @@ DESCRIPTION:In this meeting\\, we will cover topics from product and enginee ;; RFC5546 refers to uninvited attendees as "party crashers". That includes both spelling (e.g., "behavior", not "behaviour") and * doc/lispref/control.texi (Signalling Errors) - * doc/lispref/control.texi (Signalling Errors) Re "behavior" vs "behaviour", etc. + [[https://protesilaos.com/codelog/2020-07-08-modus-themes-nuanced-colours/][Modus themes: major review of "nuanced" colours]] (2020-07-08) + [[https://protesilaos.com/codelog/2020-09-14-modus-themes-review-blues/][Modus themes: review of blue colours]] (2020-09-14) @@ -1256,7 +1302,6 @@ Put dialogue in buffer." "Given start brace BRA, and end brace KET, expand one line into many lines." (regexp-quote ket) (int-to-string (car vec)) ket sig-tail "\n")) - "Given start brace BRA, and end brace KET, expand one line into many lines." m | mo | mot | moti | motif ) val=motif ;; i | in | ino | inot | inoti | inotif | inotify ) val=inotify ;; 2001-04-23 Kahlil Hodgson @@ -1270,14 +1315,11 @@ Put dialogue in buffer." Rename from whitespace-skipping-for-quotes-not-ouside. (whitespace-skipping-for-quotes-not-ouside) Thread-Modell: posix -Thread-Modell: posix (ert-deftest indent-sexp-cant-go () (ert-deftest thunk-let-bound-vars-cant-be-set-test () (mml-secure-cust-fpr-lookup context 'encrypt "sub@example.org"))) (let ((p-e-fprs (mml-secure-cust-fpr-lookup (p-s-fprs (mml-secure-cust-fpr-lookup - (let ((p-e-fprs (mml-secure-cust-fpr-lookup - (p-s-fprs (mml-secure-cust-fpr-lookup (let ((s-e-fprs (mml-secure-cust-fpr-lookup (s-s-fprs (mml-secure-cust-fpr-lookup (ert-deftest doesnt-time-out () @@ -1308,7 +1350,6 @@ doc/emacs/docstyle.texi:14: fied ==> field * follow.el (follow-inactive-menu): Rename from follow-deactive-menu. * emacs-lisp/cconv.el (cconv-analyse-form): Warn use of ((λ ...) ...). (feedmail-sendmail-f-doesnt-sell-me-out) - (feedmail-sendmail-f-doesnt-sell-me-out) Respect feedmail-sendmail-f-doesnt-sell-me-out. * terminal.el (te-get-char, te-tic-sentinel): from server-external-socket-initialised, since it should be @@ -1401,7 +1442,6 @@ Paul Raines (raines at slac.stanford.edu), (car secnd))) ; fetch_date secnd (cdr secnd)) (car secnd))) ; Keep_flag - secnd (cdr secnd)) (car secnd))) ; NOV_entry_position @c LocalWords: DesBrisay Dcc devel dir dired docstring filll forw Older versions of the themes provided options ~grayscale~ (or ~greyscale~) @@ -1450,14 +1490,12 @@ DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0, 2006-10-12 Magnus Henoch 2006-10-11 Magnus Henoch 2006-10-09 Magnus Henoch -2008-10-16 Magnus Henoch 2007-12-31 Magnus Henoch 2007-12-05 Magnus Henoch (ENUMABLE): Remove; no longer needed. * lisp.h (ENUMABLE) [!_AIX]: Don't define to 0 merely because we're * lisp.h (ENUMABLE, DEFINE_GDB_SYMBOL_ENUM): New macros. * lisp.h (ENUMABLE, DEFINE_GDB_SYMBOL_ENUM): Delete macros. - * lisp.h (ENUMABLE, DEFINE_GDB_SYMBOL_ENUM): New macros. 2023-06-29 Andrew G Cohen 2023-05-07 Andrew G Cohen C-x b fo @@ -1467,10 +1505,8 @@ DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0, 2022-03-22 Andrew G Cohen 2022-03-20 Andrew G Cohen 2022-03-17 Andrew G Cohen -2022-03-17 Andrew G Cohen 2022-03-04 Andrew G Cohen 2022-02-18 Andrew G Cohen -2022-02-18 Andrew G Cohen 2022-02-11 Andrew G Cohen 2022-02-08 Andrew G Cohen 2022-02-03 Andrew G Cohen @@ -1490,7 +1526,6 @@ extern struct servent *hes_getservbyname (/* char *, char * */); servent = hes_getservbyname (service, "tcp"); if (servent) servent = getservbyname (service, "tcp"); - if (servent) struct servent *srv = getservbyname (service, protocol); 2003-04-10 Sebastian Tennant (tiny change) Reported by Sebastian Tennant . @@ -1515,7 +1550,6 @@ extern struct servent *hes_getservbyname (/* char *, char * */); (substring strin pos end-pos)))))) (defun dun-listify-string2 (strin) (while (setq end-pos (string-search " " (substring strin pos))) - (substring strin pos end-pos)))))) "any" "append" "as" "asc" "ascic" "async" "at_begin" "at_end" "audit" "attribute" "(d)eclaration or (s)pecification?" t) ?s) "quantity" "(f)ree, (b)ranch, or (s)ource quantity?" t))) diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi index 80e552fa46a..d9113a6811a 100644 --- a/doc/emacs/buffers.texi +++ b/doc/emacs/buffers.texi @@ -764,7 +764,7 @@ you first type @kbd{C-M-i}. By default, when you press @kbd{C-M-i}, both Icomplete mode's in-buffer display of possible completions and the @file{*Completions*} buffer appear. If you are using @code{icomplete-in-buffer}, then you -may wish to suppress this apperance of the @file{*Completions*} +may wish to suppress this appearance of the @file{*Completions*} buffer. To do that, add the following to your initialization file (@pxref{Init File}): diff --git a/doc/misc/ses.texi b/doc/misc/ses.texi index b48ed0c1949..8500a0f08c4 100644 --- a/doc/misc/ses.texi +++ b/doc/misc/ses.texi @@ -507,7 +507,7 @@ To list the local printers in a help buffer. Except for @code{ses-prin1}, the other standard printers are suitable only for cells, not columns or default, because they format the value using the column-printer (or default-printer if @code{nil}) and then -post-proces the result, eg.@: center it: +post-process the result, eg.@: center it: @ftable @code @item ses-center diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 3b7eb393561..71f55379d96 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -1750,7 +1750,7 @@ and `+='...)." ;; Split REM-BODY @ __VA_ARGS__ into LEFT and right (setq part nil) (if (zerop va) - (setq left nil ; __VA_ARGS__ trimed + (setq left nil ; __VA_ARGS__ trimmed rem-body (cdr rem-body)) (setq left rem-body rem-body (cdr (nthcdr va rem-body))) ; _V_ removed diff --git a/src/eval.c b/src/eval.c index c995183ceb8..6f1c39ffb0e 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1377,7 +1377,7 @@ DEFUN ("handler-bind-1", Fhandler_bind_1, Shandler_bind_1, 1, MANY, 0, doc: /* Setup error handlers around execution of BODYFUN. BODYFUN be a function and it is called with no arguments. CONDITIONS should be a list of condition names (symbols). -When an error is signaled during executon of BODYFUN, if that +When an error is signaled during execution of BODYFUN, if that error matches one of CONDITIONS, then the associated HANDLER is called with the error as argument. HANDLER should either transfer the control via a non-local exit, @@ -1392,7 +1392,7 @@ usage: (handler-bind BODYFUN [CONDITIONS HANDLER]...) */) Lisp_Object bodyfun = args[0]; int count = 0; if (nargs % 2 == 0) - error ("Trailing CONDITIONS withount HANDLER in `handler-bind`"); + error ("Trailing CONDITIONS without HANDLER in `handler-bind`"); for (ptrdiff_t i = nargs - 2; i > 0; i -= 2) { Lisp_Object conditions = args[i], handler = args[i + 1]; diff --git a/src/xdisp.c b/src/xdisp.c index e69336d5abe..19f176459c7 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -30956,7 +30956,7 @@ draw_glyphs (struct window *w, int x, struct glyph_row *row, #ifdef HAVE_RSVG /* Update SVG image glyphs with mouse face features. FIXME: it - should be possible to have this behaviour with transparent + should be possible to have this behavior with transparent background PNG. */ if (hl == DRAW_MOUSE_FACE) { diff --git a/test/lisp/erc/erc-scenarios-keep-place-indicator.el b/test/lisp/erc/erc-scenarios-keep-place-indicator.el index 572045cf0bc..ccd6f81b7d2 100644 --- a/test/lisp/erc/erc-scenarios-keep-place-indicator.el +++ b/test/lisp/erc/erc-scenarios-keep-place-indicator.el @@ -101,7 +101,7 @@ (recenter 0) (redisplay) ; force ^ to appear on first line - (other-window 1) ; upper still at indicator, swtiches first + (other-window 1) ; upper still at indicator, switches first (switch-to-buffer "#spam") (other-window 1) (switch-to-buffer "#spam") ; lower follows, speaks to sync diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index 906aa891352..05dbe1d50d6 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -206,7 +206,7 @@ For simplicity, assume string evaluates to itself." (defun erc-tests-common-snapshot-compare (name dir trans-fn buf-init-fn) "Compare `buffer-string' to snapshot NAME.eld in DIR, if present. -When non-nil, run TRANS-FN to fiter the current buffer string, +When non-nil, run TRANS-FN to filter the current buffer string, and expect a similar string in return. Call BUF-INIT-FN, when non-nil, in the preview buffer after inserting the filtered string." diff --git a/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts b/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts index fe09a37a32b..f2d0eacee5b 100644 --- a/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts @@ -134,7 +134,7 @@ Name: Pipe statements with fn end) =-=-= -Name: Pipe statements stab clases +Name: Pipe statements stab clauses =-= [1, 2] diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 4e7ca88d197..54a9a6c11cc 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -906,7 +906,7 @@ Return a list of results." (defun comp-tests--types-equal (t1 t2) "Whether the types T1 and T2 are equal." - (or (equal t1 t2) ; optimisation for the common case + (or (equal t1 t2) ; optimization for the common case (and (consp t1) (consp t2) (eq (car t1) (car t2)) (if (memq (car t1) '(and or member)) -- cgit v1.2.3 From 77f5d4d523a406650036b7cd0d872d39a114a9ac Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Sun, 12 Nov 2023 13:21:50 -0800 Subject: Fix completing-read functional REQUIRE-MATCH behavior * lisp/minibuffer.el (completion--complete-and-exit): If minibuffer-completion-confirm is a function which returns nil, immediately fail to complete. See bug#66187. --- lisp/minibuffer.el | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 3c4315b87fc..faa7f543ece 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1847,10 +1847,13 @@ appear to be a match." ;; Allow user to specify null string ((= beg end) (funcall exit-function)) ;; The CONFIRM argument is a predicate. - ((and (functionp minibuffer-completion-confirm) - (funcall minibuffer-completion-confirm - (buffer-substring beg end))) - (funcall exit-function)) + ((functionp minibuffer-completion-confirm) + (if (funcall minibuffer-completion-confirm + (buffer-substring beg end)) + (funcall exit-function) + (unless completion-fail-discreetly + (ding) + (completion--message "No match")))) ;; See if we have a completion from the table. ((test-completion (buffer-substring beg end) minibuffer-completion-table -- cgit v1.2.3 From e734f8e502e315441214936e89ecd1e11e981fca Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 28 Jan 2024 18:51:11 -0500 Subject: xt-mouse.el: Obey `mouse-wheel-*-event` variables (bug#68698) * lisp/xt-mouse.el (xterm-mouse--same-button-p): New function. (xterm-mouse--read-event-sequence): Use it to obey `mouse-wheel-*-event` variables. * lisp/mwheel.el (mouse-wheel-obey-old-style-wheel-buttons): Update docstring. --- etc/NEWS | 6 ++++++ lisp/mwheel.el | 2 +- lisp/xt-mouse.el | 31 ++++++++++++++++++++++++------- 3 files changed, 31 insertions(+), 8 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 061ac9a7d10..ecb24724ab3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -430,6 +430,12 @@ only to specify the 'mouse-4/5/6/7' events generated by older configurations such as X11 when the X server does not support at least version 2.1 of the X Input Extension, and 'xterm-mouse-mode'. +** 'xterm-mouse-mode' +This mode now emits `wheel-up/down/right/left' events instead of +'mouse-4/5/6/7' events for the mouse wheel. +It uses the 'mouse-wheel-up/down/left/right-event' +variables to decide which button maps to which wheel event (if any). + ** Info --- diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 53042085bf6..66a1fa1a706 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -59,7 +59,7 @@ (defvar mouse-wheel-obey-old-style-wheel-buttons t "If non-nil, treat mouse-4/5/6/7 events as mouse wheel events. These are the event names used historically in X11 before XInput2. -They are sometimes generated by things like `xterm-mouse-mode' as well.") +They are sometimes generated by things like text-terminals as well.") (defcustom mouse-wheel-down-event (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-4) diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index cd00467f14f..081b8f32456 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -40,6 +40,8 @@ ;;; Code: +(require 'mwheel) + (defvar xterm-mouse-debug-buffer nil) (defun xterm-mouse-translate (_event) @@ -193,6 +195,12 @@ single byte." (cons n c)) (cons (- (setq c (xterm-mouse--read-coordinate)) 32) c)))) +(defun xterm-mouse--button-p (event btn) + (and (symbolp event) + (string-prefix-p "mouse-" (symbol-name event)) + (eq btn (car (read-from-string (symbol-name event) + (length "mouse-")))))) + ;; XTerm reports mouse events as ;; in default mode, and ;; ";" ";" <"M" or "m"> in extended mode. @@ -230,13 +238,22 @@ single byte." ;; Spurious release event without previous button-down ;; event: assume, that the last button was button 1. (t 1))) - (sym (if move 'mouse-movement - (intern (concat (if ctrl "C-" "") - (if meta "M-" "") - (if shift "S-" "") - (if down "down-" "") - "mouse-" - (number-to-string btn)))))) + (sym + (if move 'mouse-movement + (intern + (concat + (if ctrl "C-" "") + (if meta "M-" "") + (if shift "S-" "") + (if down "down-" "") + (cond + ;; BEWARE: `mouse-wheel-UP-event' corresponds to + ;; `wheel-DOWN' events and vice versa!! + ((xterm-mouse--button-p mouse-wheel-down-event btn) "wheel-up") + ((xterm-mouse--button-p mouse-wheel-up-event btn) "wheel-down") + ((xterm-mouse--button-p mouse-wheel-left-event btn) "wheel-left") + ((xterm-mouse--button-p mouse-wheel-right-event btn) "wheel-right") + (t (format "mouse-%d" btn)))))))) (list sym (1- x) (1- y)))) (defun xterm-mouse--set-click-count (event click-count) -- cgit v1.2.3 From 1f5a13d5843306af2e6a74fbdfd6d00af8804a23 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Sun, 28 Jan 2024 15:49:03 -0800 Subject: In Eshell, allow an escaped newline at the end of a command Normally, "echo" runs the command "echo". Likewise, "echo\" should too: we escape the first newline, and then the second one is unescaped and should send the command input to Eshell. Previously, you had to press RET a third time, but now it works as expected. * lisp/eshell/esh-arg.el (eshell-looking-at-backslash-return): Make obsolete. (eshell-parse-backslash): A backslash sequence is only incomplete if there's nothing at all after it. * test/lisp/eshell/esh-arg-tests.el (esh-arg-test/escape/newline) (esh-arg-test/escape-quoted/newline): Remove inaccurate comment; escaped newlines are always special. (esh-arg-test/escape/trailing-newline): New test. --- lisp/eshell/esh-arg.el | 5 +++-- test/lisp/eshell/esh-arg-tests.el | 14 ++++++++------ 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 1880cc03885..97ddac58629 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -440,6 +440,7 @@ Point is left at the end of the arguments." (defsubst eshell-looking-at-backslash-return (pos) "Test whether a backslash-return sequence occurs at POS." + (declare (obsolete nil "30.1")) (and (eq (char-after pos) ?\\) (or (= (1+ pos) (point-max)) (and (eq (char-after (1+ pos)) ?\n) @@ -464,8 +465,8 @@ backslash is ignored and the character after is returned. If the backslash is in a quoted string, the backslash and the character after are both returned." (when (eq (char-after) ?\\) - (when (eshell-looking-at-backslash-return (point)) - (throw 'eshell-incomplete "\\")) + (when (= (1+ (point)) (point-max)) + (throw 'eshell-incomplete "\\")) (forward-char 2) ; Move one char past the backslash. (let ((special-chars (if eshell-current-quoted eshell-special-chars-inside-quoting diff --git a/test/lisp/eshell/esh-arg-tests.el b/test/lisp/eshell/esh-arg-tests.el index b626cf10bf1..b748c5ab4c0 100644 --- a/test/lisp/eshell/esh-arg-tests.el +++ b/test/lisp/eshell/esh-arg-tests.el @@ -60,13 +60,17 @@ chars." "he\\\\llo\n"))) (ert-deftest esh-arg-test/escape/newline () - "Test that an escaped newline is equivalent to the empty string. -When newlines are *nonspecial*, an escaped newline should be -treated as just a newline." + "Test that an escaped newline is equivalent to the empty string." (with-temp-eshell (eshell-match-command-output "echo hi\\\nthere" "hithere\n"))) +(ert-deftest esh-arg-test/escape/trailing-newline () + "Test that an escaped newline is equivalent to the empty string." + (with-temp-eshell + (eshell-match-command-output "echo hi\\\n" + "hi\n"))) + (ert-deftest esh-arg-test/escape/newline-conditional () "Test invocation of an if/else statement using line continuations." (let ((eshell-test-value t)) @@ -95,9 +99,7 @@ chars." "\\\"hi\\\\\n"))) (ert-deftest esh-arg-test/escape-quoted/newline () - "Test that an escaped newline is equivalent to the empty string. -When newlines are *nonspecial*, an escaped newline should be -treated literally, as a backslash and a newline." + "Test that an escaped newline is equivalent to the empty string." (with-temp-eshell (eshell-match-command-output "echo \"hi\\\nthere\"" "hithere\n"))) -- cgit v1.2.3 From d2abe91d4bf68f20e4b1cd39f88ed98fd5731524 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Sat, 2 Sep 2023 22:29:22 -0700 Subject: In Eshell, don't expand quoted tildes into a user's home directory * lisp/eshell/em-dirs.el (eshell-parse-user-reference): Don't expand quoted tildes. * test/lisp/eshell/em-dirs-tests.el (em-dirs-test/expand-user-reference/local) (em-dirs-test/expand-user-reference/quoted): New tests. --- lisp/eshell/em-dirs.el | 1 + test/lisp/eshell/em-dirs-tests.el | 22 ++++++++++++++++++++++ 2 files changed, 23 insertions(+) diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 85036620c57..07063afc286 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -262,6 +262,7 @@ Thus, this does not include the current directory.") (defun eshell-parse-user-reference () "An argument beginning with ~ is a filename to be expanded." (when (and (not eshell-current-argument) + (not eshell-current-quoted) (eq (char-after) ?~)) ;; Apply this modifier fairly early so it happens before things ;; like glob expansion. diff --git a/test/lisp/eshell/em-dirs-tests.el b/test/lisp/eshell/em-dirs-tests.el index 2f170fb0c63..9789e519f4c 100644 --- a/test/lisp/eshell/em-dirs-tests.el +++ b/test/lisp/eshell/em-dirs-tests.el @@ -34,6 +34,9 @@ default-directory)))) ;;; Tests: + +;; Variables + (ert-deftest em-dirs-test/pwd-var () "Test using the $PWD variable." (let ((default-directory "/some/path")) @@ -99,6 +102,25 @@ (eshell-match-command-output "echo $-[1][/ 1 3]" "(\"some\" \"here\")\n")))) + +;; Argument expansion + +(ert-deftest em-dirs-test/expand-user-reference/local () + "Test expansion of \"~USER\" references." + (eshell-command-result-equal "echo ~" (expand-file-name "~")) + (eshell-command-result-equal + (format "echo ~%s" user-login-name) + (expand-file-name (format "~%s" user-login-name)))) + +(ert-deftest em-dirs-test/expand-user-reference/quoted () + "Test that a quoted \"~\" isn't expanded." + (eshell-command-result-equal "echo \\~" "~") + (eshell-command-result-equal "echo \"~\"" "~") + (eshell-command-result-equal "echo '~'" "~")) + + +;; `cd' + (ert-deftest em-dirs-test/cd () "Test that changing directories with `cd' works." (ert-with-temp-directory tmpdir -- cgit v1.2.3 From e9cf215d7067d5375425e605461b155216ed23b5 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 29 Jan 2024 10:54:49 +0800 Subject: Prevent filling from mangling ChangeLog defun lists * lisp/vc/log-edit.el (log-edit-fill-entry): Replace space characters within defun lists with NBSPs for the duration of `fill-region''s execution, so that they are never considered break points. * test/lisp/vc/log-edit-tests.el (log-edit-fill-entry-space-substitution): New test. --- lisp/vc/log-edit.el | 37 +++++++++- test/lisp/vc/log-edit-tests.el | 149 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 184 insertions(+), 2 deletions(-) diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index b847fb953f2..644ea691a76 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -668,6 +668,9 @@ according to `fill-column'." (defuns nil)) (while (progn + ;; Match a regexp against the next ChangeLog entry. + ;; `defuns-beg' will be the end of the file name, + ;; which marks the beginning of the list of defuns. (setq defuns-beg (and (< beg end) (re-search-forward @@ -676,13 +679,39 @@ according to `fill-column'." "\\)\\|^\\(?1:\\)[[:blank:]]*(") end t) (copy-marker (match-end 1)))) + ;; Fill the intervening prose between the end of the + ;; last match and the beginning of the current match. (let ((fill-indent-according-to-mode t) (end (if defuns-beg (match-beginning 0) end)) (beg (progn (goto-char beg) - (line-beginning-position)))) + (line-beginning-position))) + space-beg space-end) (when (<= (line-end-position) end) - (fill-region beg end justify))) + ;; Replace space characters within parentheses + ;; that resemble ChangeLog defun names between BEG + ;; and END with non-breaking spaces to prevent + ;; them from being considered break points by + ;; `fill-region'. + (save-excursion + (goto-char beg) + (when (re-search-forward + "^[[:blank:]]*(.*\\([[:space:]]\\).*):" + end t) + (replace-regexp-in-region "[[:space:]]" " " + (setq space-beg + (copy-marker + (match-beginning 0))) + (setq space-end + (copy-marker + (match-end 0)))))) + (fill-region beg end justify)) + ;; Restore the spaces replaced by NBSPs. + (when space-beg + (replace-string-in-region " " " " + space-beg space-end) + (set-marker space-beg nil) + (set-marker space-end nil))) defuns-beg) (goto-char defuns-beg) (setq defuns (change-log-read-defuns end)) @@ -1358,3 +1387,7 @@ line of MSG." (provide 'log-edit) ;;; log-edit.el ends here + +;; Local Variables: +;; coding: utf-8-unix +;; End: diff --git a/test/lisp/vc/log-edit-tests.el b/test/lisp/vc/log-edit-tests.el index 5b555809f4c..57407d47ca8 100644 --- a/test/lisp/vc/log-edit-tests.el +++ b/test/lisp/vc/log-edit-tests.el @@ -185,4 +185,153 @@ lines.")))) "* file2.txt (abcdefghijklmnopqrstuvwxyz):"))))) +(ert-deftest log-edit-fill-entry-space-substitution () + ;; This test verifies that filling the paragraph surrounding the + ;; last line of defuns does not break between defun lists with + ;; spaces in identifiers. + (setq string " +* src/sfnt.c (xmalloc, xrealloc): Improve behavior upon allocation +failures during test. +(sfnt_table_names): Add prep. +(sfnt_transform_coordinates): Allow applying offsets during +coordinate transform. +(sfnt_decompose_compound_glyph): Defer offset computation until +any component compound glyph is loaded, then apply it during the +transform process. +(sfnt_multiply_divide): Make available everywhere. Implement on +64 bit systems. +(sfnt_multiply_divide_signed): New function. +(sfnt_mul_fixed): Fix division overflow. +(sfnt_curve_to_and_build_1, sfnt_build_glyph_outline): Remove +outdated comment. +(sfnt_build_outline_edges): Fix coding style. +(sfnt_lookup_glyph_metrics): Allow looking up metrics without +scaling. +(struct sfnt_cvt_table): Fix type of cvt values. +(struct sfnt_prep_table): New structure. +(sfnt_read_cvt_table): Read cvt values in terms of fwords, not +longs (as Apple's doc seems to say). +(sfnt_read_fpgm_table): Fix memory allocation for font program +table. +(sfnt_read_prep_table): New function. +(struct sfnt_interpreter_zone): New structure. +(struct sfnt_interpreter_graphics_state): New fields `project', +`move', `vector_dot_product'. Rename to `sfnt_graphics_state'. +(struct sfnt_interpreter, sfnt_mul_f26dot6): Stop doing rounding +division. +(sfnt_init_graphics_state, sfnt_make_interpreter, MOVE, SSW, RAW) +(SDS, ADD, SUB, ABS, NEG, WCVTF, _MIN, S45ROUND, SVTCAx) +(sfnt_set_srounding_state, sfnt_skip_code) +(sfnt_interpret_unimplemented, sfnt_interpret_fdef) +(sfnt_interpret_idef, sfnt_interpret_if, sfnt_interpret_else) +(sfnt_round_none, sfnt_round_to_grid, sfnt_round_to_double_grid) +" + wanted " +* src/sfnt.c +(xmalloc, xrealloc): +Improve behavior +upon allocation +failures during +test. +(sfnt_table_names): +Add prep. + +(sfnt_transform_coordinates): +Allow applying +offsets during +coordinate +transform. + +(sfnt_decompose_compound_glyph): +Defer offset +computation until +any component +compound glyph is +loaded, then apply +it during the +transform process. + +(sfnt_multiply_divide): +Make available +everywhere. +Implement on 64 bit +systems. + +(sfnt_multiply_divide_signed): +New function. +(sfnt_mul_fixed): +Fix division +overflow. + +(sfnt_curve_to_and_build_1) +(sfnt_build_glyph_outline): +Remove outdated +comment. + +(sfnt_build_outline_edges): +Fix coding style. + +(sfnt_lookup_glyph_metrics): +Allow looking up +metrics without +scaling. + +(struct sfnt_cvt_table): +Fix type of cvt +values. + +(struct sfnt_prep_table): +New structure. + +(sfnt_read_cvt_table): +Read cvt values in +terms of fwords, not +longs (as Apple's +doc seems to say). + +(sfnt_read_fpgm_table): +Fix memory +allocation for font +program table. + +(sfnt_read_prep_table): +New function. + +(struct sfnt_interpreter_zone): +New structure. + +(struct sfnt_interpreter_graphics_state): +New fields +`project', `move', +`vector_dot_product'. +Rename to +`sfnt_graphics_state'. + +(struct sfnt_interpreter) +(sfnt_mul_f26dot6): +Stop doing rounding +division. + +(sfnt_init_graphics_state) +(sfnt_make_interpreter) +(MOVE, SSW, RAW, SDS) +(ADD, SUB, ABS, NEG) +(WCVTF, _MIN) +(S45ROUND, SVTCAx) +(sfnt_set_srounding_state) +(sfnt_skip_code) +(sfnt_interpret_unimplemented) +(sfnt_interpret_fdef) +(sfnt_interpret_idef) +(sfnt_interpret_if) +(sfnt_interpret_else) +(sfnt_round_none) +(sfnt_round_to_grid) +(sfnt_round_to_double_grid): +") + (with-temp-buffer + (insert string) + (let ((fill-column 20)) (log-edit-fill-entry)) + (should (equal (buffer-string) wanted)))) + ;;; log-edit-tests.el ends here -- cgit v1.2.3 From f83d9e16d08347db2a509b65c9c9c9e85a7d97e6 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 29 Jan 2024 11:01:33 +0800 Subject: ; * test/lisp/vc/log-edit-tests.el: Pacify compiler warnings. --- test/lisp/vc/log-edit-tests.el | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/test/lisp/vc/log-edit-tests.el b/test/lisp/vc/log-edit-tests.el index 57407d47ca8..fe0248d05f7 100644 --- a/test/lisp/vc/log-edit-tests.el +++ b/test/lisp/vc/log-edit-tests.el @@ -189,7 +189,8 @@ lines.")))) ;; This test verifies that filling the paragraph surrounding the ;; last line of defuns does not break between defun lists with ;; spaces in identifiers. - (setq string " + (let (string wanted) + (setq string " * src/sfnt.c (xmalloc, xrealloc): Improve behavior upon allocation failures during test. (sfnt_table_names): Add prep. @@ -226,7 +227,7 @@ division. (sfnt_interpret_idef, sfnt_interpret_if, sfnt_interpret_else) (sfnt_round_none, sfnt_round_to_grid, sfnt_round_to_double_grid) " - wanted " + wanted " * src/sfnt.c (xmalloc, xrealloc): Improve behavior @@ -329,9 +330,9 @@ division. (sfnt_round_to_grid) (sfnt_round_to_double_grid): ") - (with-temp-buffer - (insert string) - (let ((fill-column 20)) (log-edit-fill-entry)) - (should (equal (buffer-string) wanted)))) + (with-temp-buffer + (insert string) + (let ((fill-column 20)) (log-edit-fill-entry)) + (should (equal (buffer-string) wanted))))) ;;; log-edit-tests.el ends here -- cgit v1.2.3 From b9f348ce1e2f56fcf8ed5e42adc4027026cde347 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 29 Jan 2024 11:54:46 +0800 Subject: * exec/configure.ac (OPENAT_SYSCALL): Define on MIPS. --- exec/configure.ac | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/exec/configure.ac b/exec/configure.ac index d70dbea3477..317250332cb 100644 --- a/exec/configure.ac +++ b/exec/configure.ac @@ -404,6 +404,8 @@ AS_CASE([$host], [x86_64-*linux*], AC_DEFINE([CLONE_SYSCALL], [__NR_clone]) AC_DEFINE([READLINK_SYSCALL], [__NR_readlink]) AC_DEFINE([READLINKAT_SYSCALL], [__NR_readlinkat]) + AC_DEFINE([OPEN_SYSCALL], [__NR_open]) + AC_DEFINE([OPENAT_SYSCALL], [__NR_openat]) AC_CHECK_DECL([_MIPS_SIM], [exec_CHECK_MIPS_NABI], [AC_MSG_ERROR([_MIPS_SIM could not be determined]), [[ @@ -432,6 +434,8 @@ AS_CASE([$host], [x86_64-*linux*], AC_DEFINE([CLONE_SYSCALL], [__NR_clone]) AC_DEFINE([READLINK_SYSCALL], [__NR_readlink]) AC_DEFINE([READLINKAT_SYSCALL], [__NR_readlinkat]) + AC_DEFINE([OPEN_SYSCALL], [__NR_open]) + AC_DEFINE([OPENAT_SYSCALL], [__NR_openat]) AC_CACHE_CHECK([whether as understands `daddi'], [exec_cv_as_daddi], [exec_cv_as_daddi=no -- cgit v1.2.3 From 0aec3117b5f9632d85401b6a4c7e6d99dcd21db0 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 29 Jan 2024 15:45:47 +0800 Subject: Don't open a new line for long defuns being inserted at column 0 * lisp/vc/log-edit.el (log-edit--insert-filled-defuns): Don't open a new line for long defuns at column 0. * test/lisp/vc/log-edit-tests.el (log-edit-fill-entry-space-substitution): Adjust expected results to match change. (log-edit-fill-entry-initial-wrapping): New test. --- lisp/vc/log-edit.el | 6 ++++-- test/lisp/vc/log-edit-tests.el | 41 +++++++++++++++++++++++++---------------- 2 files changed, 29 insertions(+), 18 deletions(-) diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 644ea691a76..1f766eea455 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -588,9 +588,11 @@ the \\[vc-prefix-map] prefix for VC commands, for example). (while func-names (setq name (car func-names)) (setq func-names (cdr func-names)) - ;; If inserting `name' in at the current column would overflow - ;; the fill column, place it on its own line. + ;; If inserting `name' after preexisting text in the first + ;; line would overflow the fill column, place it on its own + ;; line. (if (and first-line + (> (current-column) 0) (> (+ (current-column) (string-width name) ;; If this be the last name, the column must be diff --git a/test/lisp/vc/log-edit-tests.el b/test/lisp/vc/log-edit-tests.el index fe0248d05f7..8373156587d 100644 --- a/test/lisp/vc/log-edit-tests.el +++ b/test/lisp/vc/log-edit-tests.el @@ -236,13 +236,11 @@ failures during test. (sfnt_table_names): Add prep. - (sfnt_transform_coordinates): Allow applying offsets during coordinate transform. - (sfnt_decompose_compound_glyph): Defer offset computation until @@ -251,68 +249,54 @@ compound glyph is loaded, then apply it during the transform process. - (sfnt_multiply_divide): Make available everywhere. Implement on 64 bit systems. - (sfnt_multiply_divide_signed): New function. (sfnt_mul_fixed): Fix division overflow. - (sfnt_curve_to_and_build_1) (sfnt_build_glyph_outline): Remove outdated comment. - (sfnt_build_outline_edges): Fix coding style. - (sfnt_lookup_glyph_metrics): Allow looking up metrics without scaling. - (struct sfnt_cvt_table): Fix type of cvt values. - (struct sfnt_prep_table): New structure. - (sfnt_read_cvt_table): Read cvt values in terms of fwords, not longs (as Apple's doc seems to say). - (sfnt_read_fpgm_table): Fix memory allocation for font program table. - (sfnt_read_prep_table): New function. - (struct sfnt_interpreter_zone): New structure. - (struct sfnt_interpreter_graphics_state): New fields `project', `move', `vector_dot_product'. Rename to `sfnt_graphics_state'. - (struct sfnt_interpreter) (sfnt_mul_f26dot6): Stop doing rounding division. - (sfnt_init_graphics_state) (sfnt_make_interpreter) (MOVE, SSW, RAW, SDS) @@ -335,4 +319,29 @@ division. (let ((fill-column 20)) (log-edit-fill-entry)) (should (equal (buffer-string) wanted))))) +(ert-deftest log-edit-fill-entry-initial-wrapping () + ;; This test verifies that a newline is inserted before a defun + ;; itself longer than the fill column when such a defun is being + ;; inserted after a file name, and not otherwise. + (let (string wanted) + (setq string " +* src/sfnt.c (long_entry_1): This entry should be placed on a +new line. +(but_this_entry_should_not): With the prose displaced to the +next line instead." + wanted " +* src/sfnt.c +(long_entry_1): This +entry should be +placed on a new +line. +(but_this_entry_should_not): +With the prose +displaced to the +next line instead.") + (with-temp-buffer + (insert string) + (let ((fill-column 20)) (log-edit-fill-entry)) + (should (equal (buffer-string) wanted))))) + ;;; log-edit-tests.el ends here -- cgit v1.2.3 From 116c47874eb25f03483b094f64e31c78613da220 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 29 Jan 2024 00:20:09 -0800 Subject: ; Spelling fixes --- etc/NEWS | 2 +- lisp/leim/quail/persian.el | 2 +- lisp/net/tramp.el | 2 +- test/lisp/emacs-lisp/hierarchy-tests.el | 2 +- test/lisp/progmodes/c-ts-mode-resources/indent.erts | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index ecb24724ab3..a21f45481fd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -408,7 +408,7 @@ functions in CJK locales. --- *** New input methods for the Urdu, Pashto, and Sindhi languages. -These languages are spoken in Pakistan and Afganistan. +These languages are spoken in Pakistan and Afghanistan. *** Additional 'C-x 8' key translations for "æ" and "Æ". These characters can now be input with 'C-x 8 a e' and 'C-x 8 A E', diff --git a/lisp/leim/quail/persian.el b/lisp/leim/quail/persian.el index de61481d7f1..676b3ab5c2e 100644 --- a/lisp/leim/quail/persian.el +++ b/lisp/leim/quail/persian.el @@ -500,7 +500,7 @@ ;; RIGHT-TO-LEFT EMBEDDING (sets base dir to RTL but allows embedded text) ("&rle;" ?\u202B) ;; (ucs-insert #x202B) named: زیرمتنِ راست‌به‌چپ ;; POP DIRECTIONAL FORMATTING (used for RLE or LRE and RLO or LRO) - ;; EMACS ANOMOLY --- Why does &pdf not show up in (describe-input-method 'farsi-transliterate-banan) + ;; EMACS ANOMALY --- Why does &pdf not show up in (describe-input-method 'farsi-transliterate-banan) ("&pdf;" ?\u202C) ;; (ucs-insert #x202C) named: پایانِ زیرمتن ("P" ?\u202C) ;; LEFT-TO-RIGHT OVERRIDE (overrides the bidirectional algorithm, display LTR) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index a369e28f021..74d95757e46 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -219,7 +219,7 @@ pair of the form (KEY VALUE). The following KEYs are defined: set this to any value other than \"/bin/sh\": Tramp wants to use a shell which groks tilde expansion, but it can search for it. Also note that \"/bin/sh\" exists on all Unixen - except Andtoid, this might not be true for the value that you + except Android, this might not be true for the value that you decide to use. You Have Been Warned. * `tramp-remote-shell-login' diff --git a/test/lisp/emacs-lisp/hierarchy-tests.el b/test/lisp/emacs-lisp/hierarchy-tests.el index 97a0f7ba52c..49c812edb05 100644 --- a/test/lisp/emacs-lisp/hierarchy-tests.el +++ b/test/lisp/emacs-lisp/hierarchy-tests.el @@ -570,7 +570,7 @@ should fail as this function will crash." (defun hierarchy-examples-delayed--childrenfn (hier-elem) "Return the children of HIER-ELEM. -Basially, feed the number, minus 1, to `hierarchy-examples-delayed--find-number' +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) diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent.erts b/test/lisp/progmodes/c-ts-mode-resources/indent.erts index 2fd26d75844..24b244c1611 100644 --- a/test/lisp/progmodes/c-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts @@ -84,7 +84,7 @@ int main() } =-=-= -Name: Concecutive blocks (GNU Style) (bug#60873) +Name: Consecutive blocks (GNU Style) (bug#60873) =-= int -- cgit v1.2.3 From 59d0b353d543d9fb3fc308ceb4d4bd389e0ac84a Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 29 Jan 2024 12:17:26 +0000 Subject: * src/haiku_select.cc: Include stdckdint.h. --- src/haiku_select.cc | 1 + 1 file changed, 1 insertion(+) diff --git a/src/haiku_select.cc b/src/haiku_select.cc index 74467edf710..f497eb3d24b 100644 --- a/src/haiku_select.cc +++ b/src/haiku_select.cc @@ -18,6 +18,7 @@ along with GNU Emacs. If not, see . */ #include #include +#include #include #include -- cgit v1.2.3 From 5d81371cc4a87335c96eaadbeaaf1eb18f35688d Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 29 Jan 2024 20:28:31 +0800 Subject: ; * src/sfnt.c: Fix standalone compilation. --- src/sfnt.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/sfnt.c b/src/sfnt.c index 030442fad68..6df43af4293 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -27,6 +27,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include #include #include @@ -20799,8 +20800,8 @@ main (int argc, char **argv) return 1; } -#define FANCY_PPEM 14 -#define EASY_PPEM 14 +#define FANCY_PPEM 12 +#define EASY_PPEM 12 interpreter = NULL; head = sfnt_read_head_table (fd, font); -- cgit v1.2.3 From e3620796ffc65c36697bced54988a1a383a4deeb Mon Sep 17 00:00:00 2001 From: Daniel Brooks Date: Sun, 28 Jan 2024 00:17:50 -0800 Subject: Fix 'calc-math-read-preprocess-string' test (bug#66944). Copyright-paperwork-exempt: yes --- test/lisp/calc/calc-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el index d96672c04a1..b64c1682efe 100644 --- a/test/lisp/calc/calc-tests.el +++ b/test/lisp/calc/calc-tests.el @@ -861,7 +861,7 @@ An existing calc stack is reused, otherwise a new one is created." ;; exponent/subscript (should (string= (concat "+/-*:-/*inf<=>=<=>=μ(1:4)(1:2)(3:4)(1:3)(2:3)" "(1:5)(2:5)(3:5)(4:5)(1:6)(5:6)" - "(1:8)(3:8)(5:8)(7:8)1:^(0123456789+-()ni)" + "(1:8)(3:8)(5:8)(7:8)1::^(0123456789+-()ni)" "_(0123456789+-())") (math-read-preprocess-string (mapconcat #'car math-read-replacement-list)))) -- cgit v1.2.3 From 2f98b13ed0522ef37c7bb2ca37f24b1be2f9fde5 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 29 Jan 2024 14:56:40 +0200 Subject: ; Fix doc strings of splash-screen data structures * lisp/startup.el (fancy-startup-text, fancy-about-text): Doc fixes. (Bug#68788) --- lisp/startup.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/startup.el b/lisp/startup.el index dcc99fd3dea..eb1e027d2cb 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1749,7 +1749,7 @@ If this is nil, no message will be displayed." "\n")) "A list of texts to show in the middle part of splash screens. Each element in the list should be a list of strings or pairs -`:face FACE', like `fancy-splash-insert' accepts them.") +`:KEYWORD VALUE', like what `fancy-splash-insert' accepts.") (defconst fancy-about-text `((:face (variable-pitch font-lock-comment-face) @@ -1842,7 +1842,7 @@ Each element in the list should be a list of strings or pairs "\tDisplay the Emacs manual in Info mode")) "A list of texts to show in the middle part of the About screen. Each element in the list should be a list of strings or pairs -`:face FACE', like `fancy-splash-insert' accepts them.") +`:KEYWORD VALUE', like what `fancy-splash-insert' accepts.") (defgroup fancy-splash-screen () -- cgit v1.2.3 From 98c906e5be2a3f5a14ff0172fdab38507b7746e3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 29 Jan 2024 21:21:50 +0200 Subject: ; * lisp/minibuffer.el (minibuffer-visible-completions): Doc fix. --- lisp/minibuffer.el | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 45aab398078..642ffad171a 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3149,15 +3149,14 @@ the mode hook of this mode." (setq-local minibuffer-completion-auto-choose nil))) (defcustom minibuffer-visible-completions nil - "When non-nil, visible completions can be navigated from the minibuffer. -This means that when the *Completions* buffer is visible in a window, -then you can use the arrow keys in the minibuffer to move the cursor -in the *Completions* buffer. Then you can type `RET', -and the candidate highlighted in the *Completions* buffer -will be accepted. -But when the *Completions* buffer is not displayed on the screen, -then the arrow keys move point in the minibuffer as usual, and -`RET' accepts the input typed in the minibuffer." + "Whether candidates shown in *Completions* can be navigated from minibuffer. +When non-nil, if the *Completions* buffer is displayed in a window, +you can use the arrow keys in the minibuffer to move the cursor in +the window showing the *Completions* buffer. Typing `RET' selects +the highlighted completion candidate. +If the *Completions* buffer is not displayed on the screen, or this +variable is nil, the arrow keys move point in the minibuffer as usual, +and `RET' accepts the input typed into the minibuffer." :type 'boolean :version "30.1") -- cgit v1.2.3 From cfc1779f4676b1be3ff34abc913e97a1b2a7de37 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 29 Jan 2024 21:18:12 +0100 Subject: * Better type comparison in comp tests * test/src/comp-tests.el (comp-tests--type-lists-equal): New function. (comp-tests--types-equal): Handle function types. --- test/src/comp-tests.el | 25 ++++++++++++++++--------- 1 file changed, 16 insertions(+), 9 deletions(-) diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 54a9a6c11cc..fbcb6ca9560 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -904,16 +904,23 @@ Return a list of results." (should (subr-native-elisp-p (symbol-function 'comp-tests-fw-prop-1-f))) (should (= (comp-tests-fw-prop-1-f) 6)))) +(defun comp-tests--type-lists-equal (l1 l2) + (and (= (length l1) (length l2)) + (cl-every #'comp-tests--types-equal l1 l2))) + (defun comp-tests--types-equal (t1 t2) - "Whether the types T1 and T2 are equal." - (or (equal t1 t2) ; optimization for the common case - (and (consp t1) (consp t2) - (eq (car t1) (car t2)) - (if (memq (car t1) '(and or member)) - (null (cl-set-exclusive-or (cdr t1) (cdr t2) - :test #'comp-tests--types-equal)) - (and (= (length t1) (length t2)) - (cl-every #'comp-tests--types-equal (cdr t1) (cdr t2))))))) + "Whether the types T1 and T2 are equal." + (or (equal t1 t2) ; for atoms, and optimization for the common case + (and (consp t1) (consp t2) + (eq (car t1) (car t2)) + (cond ((memq (car t1) '(and or member)) + ;; Order or duplicates don't matter. + (null (cl-set-exclusive-or (cdr t1) (cdr t2) + :test #'comp-tests--types-equal))) + ((eq (car t1) 'function) + (and (comp-tests--type-lists-equal (nth 1 t1) (nth 1 t2)) + (comp-tests--types-equal (nth 2 t1) (nth 2 t2)))) + (t (comp-tests--type-lists-equal (cdr t1) (cdr t2))))))) (defun comp-tests-check-ret-type-spec (func-form ret-type) (let ((lexical-binding t) -- cgit v1.2.3 From e625f2044a37f638e8c76b18e0b2d030031d6eda Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 29 Jan 2024 18:56:19 -0500 Subject: (byte-compile): Try and make it a bit more readable * lisp/emacs-lisp/bytecomp.el (byte-compile--reify-function): Use `macroexp-parse-body` and only handle closures. (byte-compile): Clarify the control and data flow a bit. --- lisp/emacs-lisp/bytecomp.el | 82 ++++++++++++++++++++------------------------- 1 file changed, 36 insertions(+), 46 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index ea9298c6646..e87595b3e77 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3018,18 +3018,10 @@ otherwise, print without quoting." (defun byte-compile--reify-function (fun) "Return an expression which will evaluate to a function value FUN. -FUN should be either a `lambda' value or a `closure' value." - (pcase-let* (((or (and `(lambda ,args . ,body) (let env nil)) - `(closure ,env ,args . ,body)) - fun) - (preamble nil) +FUN should be an interpreted closure." + (pcase-let* ((`(closure ,env ,args . ,body) fun) + (`(,preamble . ,body) (macroexp-parse-body body)) (renv ())) - ;; Split docstring and `interactive' form from body. - (when (stringp (car body)) - (push (pop body) preamble)) - (when (eq (car-safe (car body)) 'interactive) - (push (pop body) preamble)) - (setq preamble (nreverse preamble)) ;; Turn the function's closed vars (if any) into local let bindings. (dolist (binding env) (cond @@ -3051,41 +3043,39 @@ If FORM is a lambda or a macro, byte-compile it as a function." (fun (if (symbolp form) (symbol-function form) form)) - (macro (eq (car-safe fun) 'macro))) - (if macro - (setq fun (cdr fun))) - (prog1 - (cond - ;; Up until Emacs-24.1, byte-compile silently did nothing - ;; when asked to compile something invalid. So let's tone - ;; down the complaint from an error to a simple message for - ;; the known case where signaling an error causes problems. - ((compiled-function-p fun) - (message "Function %s is already compiled" - (if (symbolp form) form "provided")) - fun) - (t - (let (final-eval) - (when (or (symbolp form) (eq (car-safe fun) 'closure)) - ;; `fun' is a function *value*, so try to recover its corresponding - ;; source code. - (setq lexical-binding (eq (car fun) 'closure)) - (setq fun (byte-compile--reify-function fun)) - (setq final-eval t)) - ;; Expand macros. - (setq fun (byte-compile-preprocess fun)) - (setq fun (byte-compile-top-level fun nil 'eval)) - (if (symbolp form) - ;; byte-compile-top-level returns an *expression* equivalent to the - ;; `fun' expression, so we need to evaluate it, tho normally - ;; this is not needed because the expression is just a constant - ;; byte-code object, which is self-evaluating. - (setq fun (eval fun t))) - (if final-eval - (setq fun (eval fun t))) - (if macro (push 'macro fun)) - (if (symbolp form) (fset form fun)) - fun)))))))) + (macro (eq (car-safe fun) 'macro)) + (need-a-value nil)) + (when macro + (setq need-a-value t) + (setq fun (cdr fun))) + (cond + ;; Up until Emacs-24.1, byte-compile silently did nothing + ;; when asked to compile something invalid. So let's tone + ;; down the complaint from an error to a simple message for + ;; the known case where signaling an error causes problems. + ((compiled-function-p fun) + (message "Function %s is already compiled" + (if (symbolp form) form "provided")) + fun) + (t + (when (or (symbolp form) (eq (car-safe fun) 'closure)) + ;; `fun' is a function *value*, so try to recover its + ;; corresponding source code. + (when (setq lexical-binding (eq (car-safe fun) 'closure)) + (setq fun (byte-compile--reify-function fun))) + (setq need-a-value t)) + ;; Expand macros. + (setq fun (byte-compile-preprocess fun)) + (setq fun (byte-compile-top-level fun nil 'eval)) + (when need-a-value + ;; `byte-compile-top-level' returns an *expression* equivalent to + ;; the `fun' expression, so we need to evaluate it, tho normally + ;; this is not needed because the expression is just a constant + ;; byte-code object, which is self-evaluating. + (setq fun (eval fun lexical-binding))) + (if macro (push 'macro fun)) + (if (symbolp form) (fset form fun)) + fun)))))) (defun byte-compile-sexp (sexp) "Compile and return SEXP." -- cgit v1.2.3 From c385e966e18bebd52b1a692f13e2a7495891966d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 29 Jan 2024 19:04:59 -0500 Subject: derived.el: Delete old code (bug#68625) * lisp/emacs-lisp/derived.el (derived-mode-setup-function-name) (derived-mode-init-mode-variables, derived-mode-set-keymap) (derived-mode-set-syntax-table, derived-mode-set-abbrev-table) (derived-mode-run-hooks, derived-mode-merge-keymaps) (derived-mode-merge-syntax-tables, derived-mode-merge-abbrev-tables): Delete functions. --- etc/NEWS | 10 ++++ lisp/emacs-lisp/derived.el | 131 --------------------------------------------- 2 files changed, 10 insertions(+), 131 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index a21f45481fd..a9d6eb6789d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1370,6 +1370,16 @@ files and save the changes. * Incompatible Lisp Changes in Emacs 30.1 +--- +** Old 'derived.el' functions removed. +The following functions have been deleted because they were only used +by code compiled with Emacs<21: +'derived-mode-setup-function-name', 'derived-mode-init-mode-variables', +'derived-mode-set-keymap', 'derived-mode-set-syntax-table', +'derived-mode-set-abbrev-table', 'derived-mode-run-hooks', +'derived-mode-merge-keymaps', 'derived-mode-merge-syntax-tables', +'derived-mode-merge-abbrev-tables'. + +++ ** 'M-TAB' now invokes 'completion-at-point' also in Text mode. By default, Text mode no longer binds 'M-TAB' to diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 726f96a25f7..2423426dca0 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -365,137 +365,6 @@ which more-or-less shadow%s %s's corresponding table%s." docstring)) -;;; OBSOLETE -;; The functions below are only provided for backward compatibility with -;; code byte-compiled with versions of derived.el prior to Emacs-21. - -(defsubst derived-mode-setup-function-name (mode) - "Construct a setup-function name based on a MODE name." - (declare (obsolete nil "28.1")) - (intern (concat (symbol-name mode) "-setup"))) - - -;; Utility functions for defining a derived mode. - -;;;###autoload -(defun derived-mode-init-mode-variables (mode) - "Initialize variables for a new MODE. -Right now, if they don't already exist, set up a blank keymap, an -empty syntax table, and an empty abbrev table -- these will be merged -the first time the mode is used." - - (if (boundp (derived-mode-map-name mode)) - t - (eval `(defvar ,(derived-mode-map-name mode) - (make-sparse-keymap) - ,(format "Keymap for %s." mode))) - (put (derived-mode-map-name mode) 'derived-mode-unmerged t)) - - (if (boundp (derived-mode-syntax-table-name mode)) - t - (eval `(defvar ,(derived-mode-syntax-table-name mode) - ;; Make a syntax table which doesn't specify anything - ;; for any char. Valid data will be merged in by - ;; derived-mode-merge-syntax-tables. - (make-char-table 'syntax-table nil) - ,(format "Syntax table for %s." mode))) - (put (derived-mode-syntax-table-name mode) 'derived-mode-unmerged t)) - - (if (boundp (derived-mode-abbrev-table-name mode)) - t - (eval `(defvar ,(derived-mode-abbrev-table-name mode) - (progn - (define-abbrev-table (derived-mode-abbrev-table-name ',mode) nil) - (make-abbrev-table)) - ,(format "Abbrev table for %s." mode))))) - -;; Utility functions for running a derived mode. - -(defun derived-mode-set-keymap (mode) - "Set the keymap of the new MODE, maybe merging with the parent." - (let* ((map-name (derived-mode-map-name mode)) - (new-map (eval map-name)) - (old-map (current-local-map))) - (and old-map - (get map-name 'derived-mode-unmerged) - (derived-mode-merge-keymaps old-map new-map)) - (put map-name 'derived-mode-unmerged nil) - (use-local-map new-map))) - -(defun derived-mode-set-syntax-table (mode) - "Set the syntax table of the new MODE, maybe merging with the parent." - (let* ((table-name (derived-mode-syntax-table-name mode)) - (old-table (syntax-table)) - (new-table (eval table-name))) - (if (get table-name 'derived-mode-unmerged) - (derived-mode-merge-syntax-tables old-table new-table)) - (put table-name 'derived-mode-unmerged nil) - (set-syntax-table new-table))) - -(defun derived-mode-set-abbrev-table (mode) - "Set the abbrev table for MODE if it exists. -Always merge its parent into it, since the merge is non-destructive." - (let* ((table-name (derived-mode-abbrev-table-name mode)) - (old-table local-abbrev-table) - (new-table (eval table-name))) - (derived-mode-merge-abbrev-tables old-table new-table) - (setq local-abbrev-table new-table))) - -(defun derived-mode-run-hooks (mode) - "Run the mode hook for MODE." - (let ((hooks-name (derived-mode-hook-name mode))) - (if (boundp hooks-name) - (run-hooks hooks-name)))) - -;; Functions to merge maps and tables. - -(defun derived-mode-merge-keymaps (old new) - "Merge an OLD keymap into a NEW one. -The old keymap is set to be the last cdr of the new one, so that there will -be automatic inheritance." - ;; ?? Can this just use `set-keymap-parent'? - (let ((tail new)) - ;; Scan the NEW map for prefix keys. - (while (consp tail) - (and (consp (car tail)) - (let* ((key (vector (car (car tail)))) - (subnew (lookup-key new key)) - (subold (lookup-key old key))) - ;; If KEY is a prefix key in both OLD and NEW, merge them. - (and (keymapp subnew) (keymapp subold) - (derived-mode-merge-keymaps subold subnew)))) - (and (vectorp (car tail)) - ;; Search a vector of ASCII char bindings for prefix keys. - (let ((i (1- (length (car tail))))) - (while (>= i 0) - (let* ((key (vector i)) - (subnew (lookup-key new key)) - (subold (lookup-key old key))) - ;; If KEY is a prefix key in both OLD and NEW, merge them. - (and (keymapp subnew) (keymapp subold) - (derived-mode-merge-keymaps subold subnew))) - (setq i (1- i))))) - (setq tail (cdr tail)))) - (setcdr (nthcdr (1- (length new)) new) old)) - -(defun derived-mode-merge-syntax-tables (old new) - "Merge an OLD syntax table into a NEW one. -Where the new table already has an entry, nothing is copied from the old one." - (set-char-table-parent new old)) - -;; Merge an old abbrev table into a new one. -;; This function requires internal knowledge of how abbrev tables work, -;; presuming that they are obarrays with the abbrev as the symbol, the expansion -;; as the value of the symbol, and the hook as the function definition. -(defun derived-mode-merge-abbrev-tables (old new) - (if old - (mapatoms - (lambda (symbol) - (or (intern-soft (symbol-name symbol) new) - (define-abbrev new (symbol-name symbol) - (symbol-value symbol) (symbol-function symbol)))) - old))) - (provide 'derived) ;;; derived.el ends here -- cgit v1.2.3 From a470dfb7f8a0f6d561b1f7c9665408d73b578e18 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Mon, 29 Jan 2024 17:33:35 -0800 Subject: Fix typo in Eshell's "du" command This option is supposed to be "--si", for "International System of Units", not "--is". * lisp/eshell/em-unix.el (eshell/du): Change "is" to "si". --- lisp/eshell/em-unix.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index c3c3fea691a..a88c7e09946 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -940,7 +940,7 @@ external command." "display data only this many levels of data") (?h "human-readable" 1024 human-readable "print sizes in human readable format") - (?H "is" 1000 human-readable + (?H "si" 1000 human-readable "likewise, but use powers of 1000 not 1024") (?k "kilobytes" 1024 block-size "like --block-size 1024") -- cgit v1.2.3 From c8b9ec923f2838321aafd6c0912c7e6371145ce0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 30 Jan 2024 16:15:59 +0200 Subject: ; Rename a lexical variable in vhdl-mode.el * lisp/progmodes/vhdl-mode.el (vhdl-speedbar-insert-hierarchy): Rename a variable to avoid shadowing a global. (Bug#68810) --- lisp/progmodes/vhdl-mode.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index afdf52629c4..f52baf049aa 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -14978,9 +14978,9 @@ otherwise use cached data." (vhdl-aput 'vhdl-directory-alist directory (list (list directory)))) (defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg - package-alist ent-inst-list depth) - "Insert hierarchy of ENT-ALIST-ARG, CONF-ALIST-ARG, and PACKAGE-ALIST." - (if (not (or ent-alist-arg conf-alist-arg package-alist)) + pkg-alist ent-inst-list depth) + "Insert hierarchy of ENT-ALIST-ARG, CONF-ALIST-ARG, and PKG-ALIST." + (if (not (or ent-alist-arg conf-alist-arg pkg-alist)) (vhdl-speedbar-make-title-line "No VHDL design units!" depth) (let ((ent-alist ent-alist-arg) (conf-alist conf-alist-arg) @@ -15010,15 +15010,15 @@ otherwise use cached data." 'vhdl-speedbar-configuration-face depth) (setq conf-alist (cdr conf-alist))) ;; insert packages - (when package-alist (vhdl-speedbar-make-title-line "Packages:" depth)) - (while package-alist - (setq pack-entry (car package-alist)) + (when pkg-alist (vhdl-speedbar-make-title-line "Packages:" depth)) + (while pkg-alist + (setq pack-entry (car pkg-alist)) (vhdl-speedbar-make-pack-line (nth 0 pack-entry) (nth 1 pack-entry) (cons (nth 2 pack-entry) (nth 3 pack-entry)) (cons (nth 7 pack-entry) (nth 8 pack-entry)) depth) - (setq package-alist (cdr package-alist)))))) + (setq pkg-alist (cdr pkg-alist)))))) (declare-function speedbar-line-directory "speedbar" (&optional depth)) -- cgit v1.2.3 From 3afbab2f1d6ce7d75cadf12af096314123b6d56f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 30 Jan 2024 13:14:32 -0500 Subject: * lisp/emacs-lisp/inline.el (inline-const-val): Improve docstring --- lisp/emacs-lisp/inline.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el index c774296084e..ddbd6fdc017 100644 --- a/lisp/emacs-lisp/inline.el +++ b/lisp/emacs-lisp/inline.el @@ -80,7 +80,9 @@ (error "inline-const-p can only be used within define-inline")) (defmacro inline-const-val (_exp) - "Return the value of EXP." + "Return the value of EXP. +During inlining, if the value of EXP is not yet known, this aborts the +inlining and makes us revert to a non-inlined function call." (declare (debug t)) (error "inline-const-val can only be used within define-inline")) -- cgit v1.2.3 From 17771b2a425e776c81e7454d942ec238264ce12b Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 30 Jan 2024 17:09:37 -0800 Subject: ; Spelling fixes --- lisp/emacs-lisp/comp.el | 7 +++---- lisp/progmodes/gud.el | 2 +- src/sfnt.h | 2 +- test/lisp/net/tramp-tests.el | 4 ++-- 4 files changed, 7 insertions(+), 8 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 8441b228898..2a516246ed4 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -569,10 +569,9 @@ In use by the back-end." finally return t) t)) -(defsubst comp--symbol-func-to-fun (symbol-funcion) - "Given a function called SYMBOL-FUNCION return its `comp-func'." - (gethash (gethash symbol-funcion (comp-ctxt-sym-to-c-name-h - comp-ctxt)) +(defsubst comp--symbol-func-to-fun (symbol-func) + "Given a function called SYMBOL-FUNC return its `comp-func'." + (gethash (gethash symbol-func (comp-ctxt-sym-to-c-name-h comp-ctxt)) (comp-ctxt-funcs-h comp-ctxt))) (defun comp--function-pure-p (f) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index be6357f4139..b7c85fe7f43 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -243,7 +243,7 @@ Check it when `gud-running' is t") :visible (eq gud-minor-mode 'gdbmi)] ["Print Expression" gud-print :enable (not gud-running)] - ["Dump object-Derefenrece" gud-pstar + ["Dump object-Dereference" gud-pstar :label (if (eq gud-minor-mode 'jdb) "Dump object" "Print Dereference") diff --git a/src/sfnt.h b/src/sfnt.h index 5b01270e8ce..444b1dfe427 100644 --- a/src/sfnt.h +++ b/src/sfnt.h @@ -248,7 +248,7 @@ enum sfnt_macintosh_platform_specific_id SFNT_MACINTOSH_GREEK = 6, SFNT_MACINTOSH_RUSSIAN = 7, SFNT_MACINTOSH_RSYMBOL = 8, - SFNT_MACINTOSH_DEVANGARI = 9, + SFNT_MACINTOSH_DEVANAGARI = 9, SFNT_MACINTOSH_GURMUKHI = 10, SFNT_MACINTOSH_GUJARATI = 11, SFNT_MACINTOSH_ORIYA = 12, diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 2a3b3e16891..489b682d0c3 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5155,8 +5155,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should-not (get-buffer-window (current-buffer) t)) (delete-file tmp-name))) - ;; Check remote and local DESTNATION file. This isn't - ;; implemented yet ina all file name handler backends. + ;; Check remote and local DESTINATION file. This isn't + ;; implemented yet in all file name handler backends. ;; (dolist (local '(nil t)) ;; (setq tmp-name (tramp--test-make-temp-name local quoted)) ;; (should -- cgit v1.2.3 From dd177b7b88c81ab71e1d5a97b872d85d524fee9b Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 30 Jan 2024 17:22:50 -0800 Subject: Update from Gnulib by running admin/merge-gnulib --- lib/cdefs.h | 4 ++-- lib/gnulib.mk.in | 4 ++++ lib/string.in.h | 14 ++++++++++++-- lib/time.in.h | 14 ++++++++++++-- m4/copy-file-range.m4 | 41 ++++++++++++++++++++++++++--------------- m4/gettime.m4 | 4 ++-- m4/gnulib-common.m4 | 4 ++-- m4/gnulib-comp.m4 | 3 ++- m4/memset_explicit.m4 | 6 +++++- m4/string_h.m4 | 3 ++- m4/time_h.m4 | 3 ++- 11 files changed, 71 insertions(+), 29 deletions(-) diff --git a/lib/cdefs.h b/lib/cdefs.h index 87ddce319dc..d38382ad9d8 100644 --- a/lib/cdefs.h +++ b/lib/cdefs.h @@ -42,8 +42,8 @@ #if (defined __has_attribute \ && (!defined __clang_minor__ \ || (defined __apple_build_version__ \ - ? 6000000 <= __apple_build_version__ \ - : 3 < __clang_major__ + (5 <= __clang_minor__)))) + ? 7000000 <= __apple_build_version__ \ + : 5 <= __clang_major__))) # define __glibc_has_attribute(attr) __has_attribute (attr) #else # define __glibc_has_attribute(attr) 0 diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index fcf2b186038..e10aab5fc8d 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -1185,6 +1185,7 @@ REPLACE_MB_CUR_MAX = @REPLACE_MB_CUR_MAX@ REPLACE_MEMCHR = @REPLACE_MEMCHR@ REPLACE_MEMMEM = @REPLACE_MEMMEM@ REPLACE_MEMPCPY = @REPLACE_MEMPCPY@ +REPLACE_MEMSET_EXPLICIT = @REPLACE_MEMSET_EXPLICIT@ REPLACE_MKDIR = @REPLACE_MKDIR@ REPLACE_MKFIFO = @REPLACE_MKFIFO@ REPLACE_MKFIFOAT = @REPLACE_MKFIFOAT@ @@ -1271,6 +1272,7 @@ REPLACE_SYMLINKAT = @REPLACE_SYMLINKAT@ REPLACE_TIME = @REPLACE_TIME@ REPLACE_TIMEGM = @REPLACE_TIMEGM@ REPLACE_TIMESPEC_GET = @REPLACE_TIMESPEC_GET@ +REPLACE_TIMESPEC_GETRES = @REPLACE_TIMESPEC_GETRES@ REPLACE_TMPFILE = @REPLACE_TMPFILE@ REPLACE_TRUNCATE = @REPLACE_TRUNCATE@ REPLACE_TTYNAME_R = @REPLACE_TTYNAME_R@ @@ -3560,6 +3562,7 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''REPLACE_MEMCHR''@|$(REPLACE_MEMCHR)|g' \ -e 's|@''REPLACE_MEMMEM''@|$(REPLACE_MEMMEM)|g' \ -e 's|@''REPLACE_MEMPCPY''@|$(REPLACE_MEMPCPY)|g' \ + -e 's|@''REPLACE_MEMSET_EXPLICIT''@|$(REPLACE_MEMSET_EXPLICIT)|g' \ -e 's|@''REPLACE_FREE''@|$(REPLACE_FREE)|g' \ -e 's|@''REPLACE_STPCPY''@|$(REPLACE_STPCPY)|g' \ -e 's|@''REPLACE_STPNCPY''@|$(REPLACE_STPNCPY)|g' \ @@ -3892,6 +3895,7 @@ time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $( -e 's|@''REPLACE_TIME''@|$(REPLACE_TIME)|g' \ -e 's|@''REPLACE_TIMEGM''@|$(REPLACE_TIMEGM)|g' \ -e 's|@''REPLACE_TIMESPEC_GET''@|$(REPLACE_TIMESPEC_GET)|g' \ + -e 's|@''REPLACE_TIMESPEC_GETRES''@|$(REPLACE_TIMESPEC_GETRES)|g' \ -e 's|@''REPLACE_TZSET''@|$(REPLACE_TZSET)|g' \ -e 's|@''PTHREAD_H_DEFINES_STRUCT_TIMESPEC''@|$(PTHREAD_H_DEFINES_STRUCT_TIMESPEC)|g' \ -e 's|@''SYS_TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(SYS_TIME_H_DEFINES_STRUCT_TIMESPEC)|g' \ diff --git a/lib/string.in.h b/lib/string.in.h index 01ea3e3913b..44ec2e7ecdb 100644 --- a/lib/string.in.h +++ b/lib/string.in.h @@ -414,11 +414,21 @@ _GL_WARN_ON_USE (memrchr, "memrchr is unportable - " /* Overwrite a block of memory. The compiler will not optimize effects away, even if the block is dead after the call. */ #if @GNULIB_MEMSET_EXPLICIT@ -# if ! @HAVE_MEMSET_EXPLICIT@ +# if @REPLACE_MEMSET_EXPLICIT@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef memset_explicit +# define memset_explicit rpl_memset_explicit +# endif +_GL_FUNCDECL_RPL (memset_explicit, void *, + (void *__dest, int __c, size_t __n) _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (memset_explicit, void *, (void *__dest, int __c, size_t __n)); +# else +# if !@HAVE_MEMSET_EXPLICIT@ _GL_FUNCDECL_SYS (memset_explicit, void *, (void *__dest, int __c, size_t __n) _GL_ARG_NONNULL ((1))); -# endif +# endif _GL_CXXALIAS_SYS (memset_explicit, void *, (void *__dest, int __c, size_t __n)); +# endif _GL_CXXALIASWARN (memset_explicit); #elif defined GNULIB_POSIXCHECK # undef memset_explicit diff --git a/lib/time.in.h b/lib/time.in.h index 58e103af07c..ce28f1af25d 100644 --- a/lib/time.in.h +++ b/lib/time.in.h @@ -154,11 +154,21 @@ _GL_WARN_ON_USE (timespec_get, "timespec_get is unportable - " /* Set *TS to the current time resolution, and return BASE. Upon failure, return 0. */ # if @GNULIB_TIMESPEC_GETRES@ -# if ! @HAVE_TIMESPEC_GETRES@ +# if @REPLACE_TIMESPEC_GETRES@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef timespec_getres +# define timespec_getres rpl_timespec_getres +# endif +_GL_FUNCDECL_RPL (timespec_getres, int, (struct timespec *ts, int base) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (timespec_getres, int, (struct timespec *ts, int base)); +# else +# if !@HAVE_TIMESPEC_GETRES@ _GL_FUNCDECL_SYS (timespec_getres, int, (struct timespec *ts, int base) _GL_ARG_NONNULL ((1))); -# endif +# endif _GL_CXXALIAS_SYS (timespec_getres, int, (struct timespec *ts, int base)); +# endif _GL_CXXALIASWARN (timespec_getres); # elif defined GNULIB_POSIXCHECK # undef timespec_getres diff --git a/m4/copy-file-range.m4 b/m4/copy-file-range.m4 index e9198549510..443e598ba55 100644 --- a/m4/copy-file-range.m4 +++ b/m4/copy-file-range.m4 @@ -1,4 +1,4 @@ -# copy-file-range.m4 +# copy-file-range.m4 serial 5 dnl Copyright 2019-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -17,22 +17,33 @@ AC_DEFUN([gl_FUNC_COPY_FILE_RANGE], dnl Programs that use copy_file_range must fall back on read+write dnl anyway, and there's little point to substituting the Gnulib stub dnl for a glibc stub. - AC_CACHE_CHECK([for copy_file_range], [gl_cv_func_copy_file_range], - [AC_LINK_IFELSE( - [AC_LANG_PROGRAM( - [[#include - ]], - [[ssize_t (*func) (int, off_t *, int, off_t *, size_t, unsigned) - = copy_file_range; - return func (0, 0, 0, 0, 0, 0) & 127; - ]]) - ], - [gl_cv_func_copy_file_range=yes], - [gl_cv_func_copy_file_range=no]) - ]) - + case "$host_os" in + *-gnu* | gnu*) + AC_CACHE_CHECK([for copy_file_range], [gl_cv_func_copy_file_range], + [AC_LINK_IFELSE( + [AC_LANG_PROGRAM( + [[#include + ]], + [[ssize_t (*func) (int, off_t *, int, off_t *, size_t, unsigned) + = copy_file_range; + return func (0, 0, 0, 0, 0, 0) & 127; + ]]) + ], + [gl_cv_func_copy_file_range=yes], + [gl_cv_func_copy_file_range=no]) + ]) + gl_cv_onwards_func_copy_file_range="$gl_cv_func_copy_file_range" + ;; + *) + gl_CHECK_FUNCS_ANDROID([copy_file_range], [[#include ]]) + gl_cv_func_copy_file_range="$ac_cv_func_copy_file_range" + ;; + esac if test "$gl_cv_func_copy_file_range" != yes; then HAVE_COPY_FILE_RANGE=0 + case "$gl_cv_onwards_func_copy_file_range" in + future*) REPLACE_COPY_FILE_RANGE=1 ;; + esac else AC_DEFINE([HAVE_COPY_FILE_RANGE], 1, [Define to 1 if the function copy_file_range exists.]) diff --git a/m4/gettime.m4 b/m4/gettime.m4 index e450e6b9d05..1ec018d5154 100644 --- a/m4/gettime.m4 +++ b/m4/gettime.m4 @@ -1,4 +1,4 @@ -# gettime.m4 serial 14 +# gettime.m4 serial 15 dnl Copyright (C) 2002, 2004-2006, 2009-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -64,5 +64,5 @@ AC_DEFUN([gl_GETTIME_RES], dnl Prerequisites of lib/gettime-res.c. AC_REQUIRE([gl_CLOCK_TIME]) AC_REQUIRE([gl_TIMESPEC]) - AC_CHECK_FUNCS_ONCE([timespec_getres]) + gl_CHECK_FUNCS_ANDROID([timespec_getres], [[#include ]]) ]) diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index 03d10fa51ea..00691c0d6c3 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -1,4 +1,4 @@ -# gnulib-common.m4 serial 90 +# gnulib-common.m4 serial 91 dnl Copyright (C) 2007-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -79,7 +79,7 @@ AC_DEFUN([gl_COMMON_BODY], [ #if (defined __has_attribute \ && (!defined __clang_minor__ \ || (defined __apple_build_version__ \ - ? 6000000 <= __apple_build_version__ \ + ? 7000000 <= __apple_build_version__ \ : 5 <= __clang_major__))) # define _GL_HAS_ATTRIBUTE(attr) __has_attribute (__##attr##__) #else diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 2e5b328e3d8..7a7ebb0f34e 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -432,7 +432,8 @@ AC_DEFUN([gl_INIT], ]) gl_STRING_MODULE_INDICATOR([memrchr]) gl_FUNC_MEMSET_EXPLICIT - gl_CONDITIONAL([GL_COND_OBJ_MEMSET_EXPLICIT], [test $HAVE_MEMSET_EXPLICIT = 0]) + gl_CONDITIONAL([GL_COND_OBJ_MEMSET_EXPLICIT], + [test $HAVE_MEMSET_EXPLICIT = 0 || test $REPLACE_MEMSET_EXPLICIT = 1]) AM_COND_IF([GL_COND_OBJ_MEMSET_EXPLICIT], [ gl_PREREQ_MEMSET_EXPLICIT ]) diff --git a/m4/memset_explicit.m4 b/m4/memset_explicit.m4 index 6ac798d4557..19514ff917e 100644 --- a/m4/memset_explicit.m4 +++ b/m4/memset_explicit.m4 @@ -1,3 +1,4 @@ +# memset_explicit.m4 serial 2 dnl Copyright 2022-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -7,9 +8,12 @@ AC_DEFUN([gl_FUNC_MEMSET_EXPLICIT], [ AC_REQUIRE([gl_STRING_H_DEFAULTS]) - AC_CHECK_FUNCS_ONCE([memset_explicit]) + gl_CHECK_FUNCS_ANDROID([memset_explicit], [[#include ]]) if test $ac_cv_func_memset_explicit = no; then HAVE_MEMSET_EXPLICIT=0 + case "$gl_cv_onwards_func_memset_explicit" in + future*) REPLACE_MEMSET_EXPLICIT=1 ;; + esac fi ]) diff --git a/m4/string_h.m4 b/m4/string_h.m4 index 8b12101447f..9ea748cc774 100644 --- a/m4/string_h.m4 +++ b/m4/string_h.m4 @@ -5,7 +5,7 @@ # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. -# serial 38 +# serial 39 # Written by Paul Eggert. @@ -132,6 +132,7 @@ AC_DEFUN([gl_STRING_H_DEFAULTS], REPLACE_MEMCHR=0; AC_SUBST([REPLACE_MEMCHR]) REPLACE_MEMMEM=0; AC_SUBST([REPLACE_MEMMEM]) REPLACE_MEMPCPY=0; AC_SUBST([REPLACE_MEMPCPY]) + REPLACE_MEMSET_EXPLICIT=0; AC_SUBST([REPLACE_MEMSET_EXPLICIT]) REPLACE_STPCPY=0; AC_SUBST([REPLACE_STPCPY]) REPLACE_STPNCPY=0; AC_SUBST([REPLACE_STPNCPY]) REPLACE_STRCHRNUL=0; AC_SUBST([REPLACE_STRCHRNUL]) diff --git a/m4/time_h.m4 b/m4/time_h.m4 index 367f69efae6..32fade0f401 100644 --- a/m4/time_h.m4 +++ b/m4/time_h.m4 @@ -2,7 +2,7 @@ # Copyright (C) 2000-2001, 2003-2007, 2009-2024 Free Software Foundation, Inc. -# serial 24 +# serial 25 # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, @@ -175,5 +175,6 @@ AC_DEFUN([gl_TIME_H_DEFAULTS], REPLACE_TIME=0; AC_SUBST([REPLACE_TIME]) REPLACE_TIMEGM=0; AC_SUBST([REPLACE_TIMEGM]) REPLACE_TIMESPEC_GET=0; AC_SUBST([REPLACE_TIMESPEC_GET]) + REPLACE_TIMESPEC_GETRES=0; AC_SUBST([REPLACE_TIMESPEC_GETRES]) REPLACE_TZSET=0; AC_SUBST([REPLACE_TZSET]) ]) -- cgit v1.2.3 From f63bcf2dfeb26de511f468adc237e6ea8a3cb6cc Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Tue, 30 Jan 2024 22:18:33 -0800 Subject: Fix treesit--indent-1 regarding local parsers Take this code as an example: 1 class Foo 2 { 3 /** 4 * Block comment 5 */ 6 function foo($c) { 7 } 8 } Suppose the block comment is covered by a local parser. When we indent line 3, treesit--indent-1 will try to get the local parser at the BOL, and it'll get the local parser. But it shouldn't use the local parser to indent this line, it should use the host parser of that local parser instead. So now, if treesit--indent-1 gets a local parser, but the local parser's root node's start coincides with BOL, treesit--indent-1 will use the host parser to indent this line. We also need to make treesit--update-ranges-local to save the host parser along with the local parser, and make treesit-local-parsers-at/on extract and return the host parser. I also switch the two cases in the cond form in treesit--indent-1: (null (treesit-parser-list)) and (car local-parsers), (car local-parsers) now takes precedence. * lisp/treesit.el (treesit-local-parsers-at): (treesit-local-parsers-on): Add WITH-HOST parameter. (treesit--update-ranges-local): Save the host parser to the local overlay. (treesit--indent-1): If the root node of the local parser is at BOL, use the host parser instead. --- lisp/treesit.el | 44 +++++++++++++++++++++++++++++++------------- 1 file changed, 31 insertions(+), 13 deletions(-) diff --git a/lisp/treesit.el b/lisp/treesit.el index 96222ed81cb..fab2ddd88e6 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -655,37 +655,47 @@ those inside are kept." if (<= start (car range) (cdr range) end) collect range)) -(defun treesit-local-parsers-at (&optional pos language) +(defun treesit-local-parsers-at (&optional pos language with-host) "Return all the local parsers at POS. POS defaults to point. Local parsers are those which only parse a limited region marked by an overlay with non-nil `treesit-parser' property. -If LANGUAGE is non-nil, only return parsers for LANGUAGE." +If LANGUAGE is non-nil, only return parsers for LANGUAGE. + +If WITH-HOST is non-nil, return a list of (PARSER . HOST-PARSER) +instead. HOST-PARSER is the host parser which created the local +PARSER." (let ((res nil)) (dolist (ov (overlays-at (or pos (point)))) - (when-let ((parser (overlay-get ov 'treesit-parser))) + (when-let ((parser (overlay-get ov 'treesit-parser)) + (host-parser (overlay-get ov 'treesit-host-parser))) (when (or (null language) (eq (treesit-parser-language parser) language)) - (push parser res)))) + (push (if with-host (cons parser host-parser) parser) res)))) (nreverse res))) -(defun treesit-local-parsers-on (&optional beg end language) +(defun treesit-local-parsers-on (&optional beg end language with-host) "Return all the local parsers between BEG END. BEG and END default to the beginning and end of the buffer's accessible portion. Local parsers are those which have an `embedded' tag, and only parse a limited region marked by an overlay with a non-nil `treesit-parser' -property. If LANGUAGE is non-nil, only return parsers for LANGUAGE." +property. If LANGUAGE is non-nil, only return parsers for LANGUAGE. + +If WITH-HOST is non-nil, return a list of (PARSER . HOST-PARSER) +instead. HOST-PARSER is the host parser which created the local +PARSER." (let ((res nil)) (dolist (ov (overlays-in (or beg (point-min)) (or end (point-max)))) - (when-let ((parser (overlay-get ov 'treesit-parser))) + (when-let ((parser (overlay-get ov 'treesit-parser)) + (host-parser (overlay-get ov 'treesit-host-parser))) (when (or (null language) (eq (treesit-parser-language parser) language)) - (push parser res)))) + (push (if with-host (cons parser host-parser) parser) res)))) (nreverse res))) (defun treesit--update-ranges-local @@ -701,7 +711,8 @@ parser for EMBEDDED-LANG." (treesit-parser-delete parser)))) ;; Update range. (let* ((host-lang (treesit-query-language query)) - (ranges (treesit-query-range host-lang query beg end))) + (host-parser (treesit-parser-create host-lang)) + (ranges (treesit-query-range host-parser query beg end))) (pcase-dolist (`(,beg . ,end) ranges) (let ((has-parser nil)) (dolist (ov (overlays-in beg end)) @@ -719,6 +730,7 @@ parser for EMBEDDED-LANG." embedded-lang nil t 'embedded)) (ov (make-overlay beg end nil nil t))) (overlay-put ov 'treesit-parser embedded-parser) + (overlay-put ov 'treesit-host-parser host-parser) (treesit-parser-set-included-ranges embedded-parser `((,beg . ,end))))))))) @@ -1800,11 +1812,17 @@ Return (ANCHOR . OFFSET). This function is used by (forward-line 0) (skip-chars-forward " \t") (point))) - (local-parsers (treesit-local-parsers-at bol)) + (local-parsers (treesit-local-parsers-at bol nil t)) (smallest-node - (cond ((null (treesit-parser-list)) nil) - (local-parsers (treesit-node-at - bol (car local-parsers))) + (cond ((car local-parsers) + (let ((local-parser (caar local-parsers)) + (host-parser (cdar local-parsers))) + (if (eq (treesit-node-start + (treesit-parser-root-node local-parser)) + bol) + (treesit-node-at bol host-parser) + (treesit-node-at bol local-parser)))) + ((null (treesit-parser-list)) nil) ((eq 1 (length (treesit-parser-list nil nil t))) (treesit-node-at bol)) ((treesit-language-at bol) -- cgit v1.2.3 From 5f24c9a4c82f7106e22cac8a5201db8307239837 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 31 Jan 2024 14:34:19 +0800 Subject: Don't hang when display objects are displaced by line or wrap-prefixes This fixes a hang that would frequently rear its ugly head while displaying messages in the `telega.el' instant messenger client, which inserts images approaching the width of the window with line and wrap prefixes. * src/xdisp.c (move_it_in_display_line_to): If a line or wrap prefix is set in place, do not generate continuation lines until a minimum of one glyph has been produced outside that prefix. (move_it_to): Remove the previous workaround that could not recover from errors caused by display strings. (display_line): Synchronize with move_it_in_display_line_to; remove old workaround that only provided for oversized wrap prefixes comprising `space' display objects. --- src/xdisp.c | 200 ++++++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 135 insertions(+), 65 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 19f176459c7..066217a2f0f 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -9733,6 +9733,13 @@ move_it_in_display_line_to (struct it *it, ptrdiff_t prev_pos = IT_CHARPOS (*it); bool saw_smaller_pos = prev_pos < to_charpos; bool line_number_pending = false; + int this_line_subject_to_line_prefix = 0; + +#ifdef GLYPH_DEBUG + /* atx_flag, atpos_flag and wrap_flag are assigned but never used; + these hold information useful while debugging. */ + int atx_flag, atpos_flag, wrap_flag; +#endif /* GLYPH_DEBUG */ /* Don't produce glyphs in produce_glyphs. */ saved_glyph_row = it->glyph_row; @@ -9798,6 +9805,11 @@ move_it_in_display_line_to (struct it *it, /* If there's a line-/wrap-prefix, handle it, if we didn't already. */ if (it->area == TEXT_AREA && !it->string_from_prefix_prop_p) handle_line_prefix (it); + + /* Save whether this line has received a wrap prefix, as this + affects whether Emacs attempts to move glyphs into + continuation lines. */ + this_line_subject_to_line_prefix = it->string_from_prefix_prop_p; } if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos)) @@ -9841,10 +9853,15 @@ move_it_in_display_line_to (struct it *it, break; } else if (it->line_wrap == WORD_WRAP && atpos_it.sp < 0) - /* If wrap_it is valid, the current position might be in a - word that is wrapped. So, save the iterator in - atpos_it and continue to see if wrapping happens. */ - SAVE_IT (atpos_it, *it, atpos_data); + { + /* If wrap_it is valid, the current position might be in + a word that is wrapped. So, save the iterator in + atpos_it and continue to see if wrapping happens. */ + SAVE_IT (atpos_it, *it, atpos_data); +#ifdef GLYPH_DEBUG + atpos_flag = this_line_subject_to_line_prefix; +#endif /* GLYPH_DEBUG */ + } } /* Stop when ZV reached. @@ -9906,6 +9923,9 @@ move_it_in_display_line_to (struct it *it, } /* Otherwise, we can wrap here. */ SAVE_IT (wrap_it, *it, wrap_data); +#ifdef GLYPH_DEBUG + wrap_flag = this_line_subject_to_line_prefix; +#endif /* GLYPH_DEBUG */ } /* Update may_wrap for the next iteration. */ may_wrap = next_may_wrap; @@ -9984,6 +10004,9 @@ move_it_in_display_line_to (struct it *it, { SAVE_IT (atpos_it, *it, atpos_data); IT_RESET_X_ASCENT_DESCENT (&atpos_it); +#ifdef GLYPH_DEBUG + atpos_flag = this_line_subject_to_line_prefix; +#endif /* GLYPH_DEBUG */ } } else @@ -9998,6 +10021,9 @@ move_it_in_display_line_to (struct it *it, { SAVE_IT (atx_it, *it, atx_data); IT_RESET_X_ASCENT_DESCENT (&atx_it); +#ifdef GLYPH_DEBUG + atx_flag = this_line_subject_to_line_prefix; +#endif /* GLYPH_DEBUG */ } } } @@ -10012,12 +10038,27 @@ move_it_in_display_line_to (struct it *it, && FRAME_WINDOW_P (it->f) && ((it->bidi_p && it->bidi_it.paragraph_dir == R2L) ? WINDOW_LEFT_FRINGE_WIDTH (it->w) - : WINDOW_RIGHT_FRINGE_WIDTH (it->w))))) + : WINDOW_RIGHT_FRINGE_WIDTH (it->w)))) + /* There is no line prefix, next to which the + iterator _must_ produce a minimum of one actual + glyph. */ + && (!this_line_subject_to_line_prefix + /* Or this is the second glyph to be produced + beyond the confines of the line. */ + || (i != 0 + && (x > it->last_visible_x + || (x == it->last_visible_x + && FRAME_WINDOW_P (it->f) + && ((it->bidi_p + && it->bidi_it.paragraph_dir == R2L) + ? WINDOW_LEFT_FRINGE_WIDTH (it->w) + : WINDOW_RIGHT_FRINGE_WIDTH (it->w))))))) { bool moved_forward = false; if (/* IT->hpos == 0 means the very first glyph - doesn't fit on the line, e.g. a wide image. */ + doesn't fit on the line, e.g. a wide + image. */ it->hpos == 0 || (new_x == it->last_visible_x && FRAME_WINDOW_P (it->f))) @@ -10078,6 +10119,9 @@ move_it_in_display_line_to (struct it *it, SAVE_IT (atpos_it, *it, atpos_data); atpos_it.current_x = x_before_this_char; atpos_it.hpos = hpos_before_this_char; +#ifdef GLYPH_DEBUG + atpos_flag = this_line_subject_to_line_prefix; +#endif /* GLYPH_DEBUG */ } } @@ -10175,6 +10219,9 @@ move_it_in_display_line_to (struct it *it, if (it->line_wrap == WORD_WRAP && atpos_it.sp < 0) { SAVE_IT (atpos_it, *it, atpos_data); +#ifdef GLYPH_DEBUG + atpos_flag = this_line_subject_to_line_prefix; +#endif /* GLYPH_DEBUG */ IT_RESET_X_ASCENT_DESCENT (&atpos_it); } } @@ -10273,24 +10320,24 @@ move_it_in_display_line_to (struct it *it, if (it->method == GET_FROM_BUFFER) prev_pos = IT_CHARPOS (*it); - /* Detect overly-wide wrap-prefixes made of (space ...) display - properties. When such a wrap prefix reaches past the right - margin of the window, we need to avoid the call to - set_iterator_to_next below, so that it->line_wrap is left at - its TRUNCATE value wisely set by handle_line_prefix. - Otherwise, set_iterator_to_next will pop the iterator stack, - restore it->line_wrap, and we might miss the opportunity to - exit the loop and return. */ - bool overwide_wrap_prefix = - CONSP (it->object) && EQ (XCAR (it->object), Qspace) - && it->sp > 0 && it->method == GET_FROM_STRETCH - && it->current_x >= it->last_visible_x - && it->continuation_lines_width > 0 - && it->line_wrap == TRUNCATE && it->stack[0].line_wrap != TRUNCATE; - /* The current display element has been consumed. Advance - to the next. */ - if (!overwide_wrap_prefix) - set_iterator_to_next (it, true); + /* The current display element has been consumed. Advance to + the next. */ + set_iterator_to_next (it, true); + + /* If IT has just finished producing glyphs for the wrap prefix + and is proceeding to the next method, there might not be + sufficient space remaining in this line to accommodate its + glyphs, and one real glyph must be produced to prevent an + infinite loop. Next, clear this flag if such a glyph has + already been produced. */ + + if (this_line_subject_to_line_prefix == 1 + && !it->string_from_prefix_prop_p) + this_line_subject_to_line_prefix = 2; + else if (this_line_subject_to_line_prefix == 2 + && !it->string_from_prefix_prop_p) + this_line_subject_to_line_prefix = 0; + if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos)) SET_TEXT_POS (this_line_min_pos, IT_CHARPOS (*it), IT_BYTEPOS (*it)); if (IT_CHARPOS (*it) < to_charpos) @@ -10374,11 +10421,26 @@ move_it_in_display_line_to (struct it *it, && wrap_it.sp >= 0 && ((atpos_it.sp >= 0 && wrap_it.current_x < atpos_it.current_x) || (atx_it.sp >= 0 && wrap_it.current_x < atx_it.current_x))) - RESTORE_IT (it, &wrap_it, wrap_data); + { +#ifdef GLYPH_DEBUG + this_line_subject_to_line_prefix = wrap_flag; +#endif /* GLYPH_DEBUG */ + RESTORE_IT (it, &wrap_it, wrap_data); + } else if (atpos_it.sp >= 0) - RESTORE_IT (it, &atpos_it, atpos_data); + { +#ifdef GLYPH_DEBUG + this_line_subject_to_line_prefix = atpos_flag; +#endif /* GLYPH_DEBUG */ + RESTORE_IT (it, &atpos_it, atpos_data); + } else if (atx_it.sp >= 0) - RESTORE_IT (it, &atx_it, atx_data); + { +#ifdef GLYPH_DEBUG + this_line_subject_to_line_prefix = atx_flag; +#endif /* GLYPH_DEBUG */ + RESTORE_IT (it, &atx_it, atx_data); + } done: @@ -10452,13 +10514,9 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos int line_height, line_start_x = 0, reached = 0; int max_current_x = 0; void *backup_data = NULL; - ptrdiff_t orig_charpos = -1; - enum it_method orig_method = NUM_IT_METHODS; for (;;) { - orig_charpos = IT_CHARPOS (*it); - orig_method = it->method; if (op & MOVE_TO_VPOS) { /* If no TO_CHARPOS and no TO_X specified, stop at the @@ -10730,21 +10788,7 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos } } else - { - /* Make sure we do advance, otherwise we might infloop. - This could happen when the first display element is - wider than the window, or if we have a wrap-prefix - that doesn't leave enough space after it to display - even a single character. We only do this for moving - through buffer text, as with display/overlay strings - we'd need to also compare it->object's, and this is - unlikely to happen in that case anyway. */ - if (IT_CHARPOS (*it) == orig_charpos - && it->method == orig_method - && orig_method == GET_FROM_BUFFER) - set_iterator_to_next (it, false); - it->continuation_lines_width += it->current_x; - } + it->continuation_lines_width += it->current_x; break; default: @@ -24943,6 +24987,7 @@ display_line (struct it *it, int cursor_vpos) int first_visible_x = it->first_visible_x; int last_visible_x = it->last_visible_x; int x_incr = 0; + int this_line_subject_to_line_prefix = 0; /* We always start displaying at hpos zero even if hscrolled. */ eassert (it->hpos == 0 && it->current_x == 0); @@ -25048,6 +25093,7 @@ display_line (struct it *it, int cursor_vpos) /* We only do this when not calling move_it_in_display_line_to above, because that function calls itself handle_line_prefix. */ handle_line_prefix (it); + this_line_subject_to_line_prefix = it->string_from_prefix_prop_p; } else { @@ -25214,12 +25260,15 @@ display_line (struct it *it, int cursor_vpos) process the prefix now. */ if (it->area == TEXT_AREA && pending_handle_line_prefix) { - /* Line numbers should precede the line-prefix or wrap-prefix. */ + /* Line numbers should precede the line-prefix or + wrap-prefix. */ if (line_number_needed) maybe_produce_line_number (it); pending_handle_line_prefix = false; handle_line_prefix (it); + this_line_subject_to_line_prefix + = it->string_from_prefix_prop_p; } continue; } @@ -25240,7 +25289,16 @@ display_line (struct it *it, int cursor_vpos) if (/* Not a newline. */ nglyphs > 0 /* Glyphs produced fit entirely in the line. */ - && it->current_x < it->last_visible_x) + && (it->current_x < it->last_visible_x + /* Or a line or wrap prefix is in effect, and not + truncating the glyph produced immediately after it + would cause an infinite cycle. */ + || (it->line_wrap != TRUNCATE + /* This code is not valid if multiple glyphs were + produced, as some of these glyphs might remain + within this line. */ + && nglyphs == 1 + && this_line_subject_to_line_prefix))) { it->hpos += nglyphs; row->ascent = max (row->ascent, it->max_ascent); @@ -25291,7 +25349,20 @@ display_line (struct it *it, int cursor_vpos) && FRAME_WINDOW_P (it->f) && (row->reversed_p ? WINDOW_LEFT_FRINGE_WIDTH (it->w) - : WINDOW_RIGHT_FRINGE_WIDTH (it->w))))) + : WINDOW_RIGHT_FRINGE_WIDTH (it->w)))) + /* There is no line prefix, next to which the + iterator _must_ produce a minimum of one actual + glyph. */ + && (!this_line_subject_to_line_prefix + /* Or this is the second glyph to be produced + beyond the confines of the line. */ + || (i != 0 + && (x > it->last_visible_x + || (x == it->last_visible_x + && FRAME_WINDOW_P (it->f) + && (row->reversed_p + ? WINDOW_LEFT_FRINGE_WIDTH (it->w) + : WINDOW_RIGHT_FRINGE_WIDTH (it->w))))))) { /* End of a continued line. */ @@ -25588,24 +25659,23 @@ display_line (struct it *it, int cursor_vpos) break; } - /* Detect overly-wide wrap-prefixes made of (space ...) display - properties. When such a wrap prefix reaches past the right - margin of the window, we need to avoid the call to - set_iterator_to_next below, so that it->line_wrap is left at - its TRUNCATE value wisely set by handle_line_prefix. - Otherwise, set_iterator_to_next will pop the iterator stack, - restore it->line_wrap, and redisplay might infloop. */ - bool overwide_wrap_prefix = - CONSP (it->object) && EQ (XCAR (it->object), Qspace) - && it->sp > 0 && it->method == GET_FROM_STRETCH - && it->current_x >= it->last_visible_x - && it->continuation_lines_width > 0 - && it->line_wrap == TRUNCATE && it->stack[0].line_wrap != TRUNCATE; - /* Proceed with next display element. Note that this skips over lines invisible because of selective display. */ - if (!overwide_wrap_prefix) - set_iterator_to_next (it, true); + set_iterator_to_next (it, true); + + /* If IT has just finished producing glyphs for the wrap prefix + and is proceeding to the next method, there might not be + sufficient space remaining in this line to accommodate its + glyphs, and one real glyph must be produced to prevent an + infinite loop. Next, clear this flag if such a glyph has + already been produced. */ + + if (this_line_subject_to_line_prefix == 1 + && !it->string_from_prefix_prop_p) + this_line_subject_to_line_prefix = 2; + else if (this_line_subject_to_line_prefix == 2 + && !it->string_from_prefix_prop_p) + this_line_subject_to_line_prefix = 0; /* If we truncate lines, we are done when the last displayed glyphs reach past the right margin of the window. */ -- cgit v1.2.3 From 7e85311a9113a4720ec9d7b06188646fc7bdae0b Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Wed, 31 Jan 2024 12:21:12 +0100 Subject: 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. --- src/fns.c | 5 ++++- test/src/fns-tests.el | 10 ++++++++++ 2 files changed, 14 insertions(+), 1 deletion(-) 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")) -- cgit v1.2.3 From 9bcc9690a8076a22398c27a7ccf836ee95eb16a2 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Tue, 30 Jan 2024 17:55:19 +0100 Subject: 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. --- doc/lispref/compile.texi | 66 --------------------------------------------- doc/lispref/elisp.texi | 1 - etc/NEWS | 7 +++++ lisp/emacs-lisp/bytecomp.el | 66 +++++++-------------------------------------- lisp/emacs-lisp/disass.el | 2 -- lisp/subr.el | 2 ++ src/bytecode.c | 27 +++++++++---------- src/eval.c | 59 ++-------------------------------------- src/lread.c | 49 ++++++++++++++++----------------- 9 files changed, 58 insertions(+), 221 deletions(-) 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; -- cgit v1.2.3 From 344a846b07dfcc9ad38e510da9115fadae94a477 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Wed, 31 Jan 2024 17:35:59 +0100 Subject: 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. --- src/bytecode.c | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) 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); -- cgit v1.2.3 From cd2c45a3890601e1bc498c81e64791fead6efc86 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Wed, 31 Jan 2024 17:50:30 +0100 Subject: ; hierarchy-tests.el: keep doc string within 80 columns --- test/lisp/emacs-lisp/hierarchy-tests.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) 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)))) -- cgit v1.2.3 From b86bc02096c65517b9a29c20635ece100864fc62 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 1 Feb 2024 16:08:47 +0800 Subject: 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. --- doc/emacs/basic.texi | 17 ++++++++++------- etc/NEWS | 4 +++- lisp/visual-wrap.el | 10 +++++++++- 3 files changed, 22 insertions(+), 9 deletions(-) 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 -- cgit v1.2.3 From 5ce02c91bc128f390bcf0beb82e37a3fa7f251ba Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 1 Feb 2024 09:08:19 +0100 Subject: Improve `desktop-save-mode` docstring * lisp/desktop.el (desktop-save-mode): Improve docstring. --- lisp/desktop.el | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/lisp/desktop.el b/lisp/desktop.el index 56841b49595..9100d825547 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -163,13 +163,22 @@ Used at desktop read to provide backward compatibility.") (define-minor-mode desktop-save-mode "Toggle desktop saving (Desktop Save mode). -When Desktop Save mode is enabled, the state of Emacs is saved from -one session to another. In particular, Emacs will save the desktop when -it exits (this may prompt you; see the option `desktop-save'). The next -time Emacs starts, if this mode is active it will restore the desktop. +When Desktop Save mode is enabled, the state of Emacs is saved from one +session to another. The saved Emacs \"desktop configuration\" includes the +buffers, their file names, major modes, buffer positions, window and frame +configuration, and some important global variables. -To manually save the desktop at any time, use the command `\\[desktop-save]'. -To load it, use `\\[desktop-read]'. +To enable this feature for future sessions, customize `desktop-save-mode' +to t, or add this line in your init file: + + (desktop-save-mode 1) + +When this mode is enabled, Emacs will save the desktop when it exits +(this may prompt you, see the option `desktop-save'). The next time +Emacs starts, if this mode is active it will restore the desktop. + +To manually save the desktop at any time, use the command \\[desktop-save]. +To load it, use \\[desktop-read]. Once a desktop file exists, Emacs will auto-save it according to the option `desktop-auto-save-timeout'. -- cgit v1.2.3 From 881a1ade30d2efacf9fcbd136b8fea722760f36e Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 1 Feb 2024 16:16:09 +0800 Subject: 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. --- src/dispextern.h | 10 ++++++++ src/term.c | 8 +++++- src/xdisp.c | 74 +++++++++++++++++++++++++++++++++++++++++++------------- 3 files changed, 74 insertions(+), 18 deletions(-) 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) { -- cgit v1.2.3 From 4e1661e96c4412e8bf04cd1ec8948df4a782a10c Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 1 Feb 2024 16:18:53 +0800 Subject: * src/term.c (produce_glyphs): Synchronize with gui_produce_glyphs. --- src/term.c | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) 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) -- cgit v1.2.3 From 849f8c1d49edc93cd8133d2f0dee5ceeb8f659e5 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 1 Feb 2024 16:25:09 +0800 Subject: ; * doc/emacs/basic.texi (Continuation Lines): Rearrange pxref. --- doc/emacs/basic.texi | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) 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 -- cgit v1.2.3 From 169c704d74747d411a545eff9c497ddafb9c886c Mon Sep 17 00:00:00 2001 From: Sacha Chua Date: Fri, 26 Jan 2024 08:54:03 -0500 Subject: 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. --- lisp/net/shr.el | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 74 insertions(+), 2 deletions(-) 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) -- cgit v1.2.3 From ff63da26b6b00fd0e2ba04239b56b385bd83b53a Mon Sep 17 00:00:00 2001 From: Stanislav Yaglo Date: Mon, 12 Jun 2023 11:56:37 +0100 Subject: 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) --- src/macfont.m | 96 ++++++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 68 insertions(+), 28 deletions(-) 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 @@ macfont_store_descriptor_attributes (CTFontDescriptorRef desc, 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 @@ macfont_create_attributes_with_spec (Lisp_Object spec) 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) -- cgit v1.2.3 From 4adb4b2ac507636a82373ed1323dabcb7ee9258d Mon Sep 17 00:00:00 2001 From: Graham Marlow Date: Mon, 29 Jan 2024 17:16:04 -0800 Subject: 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) --- lisp/textmodes/yaml-ts-mode.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) 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" -- cgit v1.2.3 From d0766c0999e1e78b2f63e1d97881e926e5e6f905 Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Wed, 31 Jan 2024 13:54:16 +0000 Subject: Fix search error in woman.el * lisp/woman.el (woman-if-body): Avoid signaling an error if "el }" is not found. (Bug#68852) --- lisp/woman.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) 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)) -- cgit v1.2.3 From 5f3b46c61e23786295e8e532f7eadeee8cd4340b Mon Sep 17 00:00:00 2001 From: Ulrich Müller Date: Wed, 31 Jan 2024 08:49:36 +0100 Subject: * configure.ac: Include X11/Xlib.h for XOpenDisplay. (Bug#68842) Do not merge to master. --- configure.ac | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/configure.ac b/configure.ac index 78d5475f75a..34a5a89bea9 100644 --- a/configure.ac +++ b/configure.ac @@ -2697,7 +2697,7 @@ if test "${HAVE_X11}" = "yes"; then if test "${opsys}" = "gnu-linux"; then AC_CACHE_CHECK([whether X on GNU/Linux needs -b to link], [emacs_cv_b_link], - [AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], + [AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], [[XOpenDisplay ("foo");]])], [xgnu_linux_first_failure=no], [xgnu_linux_first_failure=yes]) @@ -2706,7 +2706,7 @@ if test "${HAVE_X11}" = "yes"; then OLD_LIBS="$LIBS" CPPFLAGS="$CPPFLAGS -b i486-linuxaout" LIBS="$LIBS -b i486-linuxaout" - AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], + AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], [[XOpenDisplay ("foo");]])], [xgnu_linux_second_failure=no], [xgnu_linux_second_failure=yes]) -- cgit v1.2.3 From 886f4207ab71b2a3367566d013cbcb27eec25639 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 1 Feb 2024 11:06:51 -0500 Subject: * src/lread.c (bytecode_from_rev_list): Re-group checks Bring together all the conditions for well-formedness of the resulting bytecode object. --- src/lread.c | 52 +++++++++++++++++++++++++++------------------------- 1 file changed, 27 insertions(+), 25 deletions(-) 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 -- cgit v1.2.3 From 8b92449b706e33da256142e190008bb1ead2e539 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 1 Feb 2024 11:08:56 -0500 Subject: * src/lread.c (bytecode_from_rev_list): Fix thinko --- src/lread.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 -- cgit v1.2.3 From caecbf3e8db57d93715b8d20587b2ed54064cadb Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 1 Feb 2024 17:17:36 +0100 Subject: Fix stale cache in Tramp (do not merge with master) * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Flush file properties when needed. (Bug#68805) --- lisp/net/tramp-sh.el | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 1301cd633da..44c0bdc7aea 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2521,6 +2521,12 @@ The method used must be an out-of-band method." ;; cached password). (tramp-cleanup-connection v 'keep-debug 'keep-password)))) + ;; The cached file properties might be wrong if NEWNAME didn't + ;; exist. Flush them. + (when v2 + (with-parsed-tramp-file-name newname v2 + (tramp-flush-file-properties v2 v2-localname))) + ;; Handle KEEP-DATE argument. (when (and keep-date (not copy-keep-date)) (tramp-compat-set-file-times -- cgit v1.2.3 From d89e427852a63dbeed3d5e03d9deb2ae9a8e3e1b Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 1 Feb 2024 19:16:37 +0200 Subject: * 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). --- lisp/simple.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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)) -- cgit v1.2.3 From c14c978e3b1be9802a5c1fdf1b29e0ee48e16364 Mon Sep 17 00:00:00 2001 From: dalu Date: Thu, 1 Feb 2024 11:45:13 +0800 Subject: Support kotlin-ts-mode in Eglot * lisp/progmodes/eglot.el (eglot-server-programs): Support kotlin-ts-mode. (Bug#68865) Copyright-paperwork-exempt: yes --- lisp/progmodes/eglot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 1e90e26a537..cbc77b331f0 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -216,7 +216,7 @@ chosen (interactively or automatically)." . ("haskell-language-server-wrapper" "--lsp")) (elm-mode . ("elm-language-server")) (mint-mode . ("mint" "ls")) - (kotlin-mode . ("kotlin-language-server")) + ((kotlin-mode kotlin-ts-mode) . ("kotlin-language-server")) ((go-mode go-dot-mod-mode go-dot-work-mode go-ts-mode go-mod-ts-mode) . ("gopls")) ((R-mode ess-r-mode) . ("R" "--slave" "-e" -- cgit v1.2.3 From 5f56bc1cdfcd474dd9cfad07240df6c252abd35c Mon Sep 17 00:00:00 2001 From: Piotr Kwiecinski Date: Thu, 1 Feb 2024 14:02:20 +0100 Subject: eglot: Add php-ts-mode to eglot-server-programs * lisp/progmodes/eglot.el (eglot-server-programs): Add php-ts-mode. (Bug#68870) Copyright-paperwork-exempt: yes --- lisp/progmodes/eglot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index cbc77b331f0..55b54ed6dc6 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -200,7 +200,7 @@ chosen (interactively or automatically)." (typescript-mode :language-id "typescript")) . ("typescript-language-server" "--stdio")) ((bash-ts-mode sh-mode) . ("bash-language-server" "start")) - ((php-mode phps-mode) + ((php-mode phps-mode php-ts-mode) . ,(eglot-alternatives '(("phpactor" "language-server") ("php" "vendor/felixfbecker/language-server/bin/php-language-server.php")))) -- cgit v1.2.3 From a3987127618b9fe49b88807f0268ec9abcc7396f Mon Sep 17 00:00:00 2001 From: nibon7 Date: Thu, 18 Jan 2024 00:01:48 +0800 Subject: eglot: Add nushell language server * lisp/progmodes/eglot.el (eglot-server-programs): Add nushell language server. (Bug#68823) --- lisp/progmodes/eglot.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 55b54ed6dc6..9eaa92da03e 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -235,6 +235,7 @@ chosen (interactively or automatically)." (erlang-mode . ("erlang_ls" "--transport" "stdio")) ((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio")) (nix-mode . ,(eglot-alternatives '("nil" "rnix-lsp" "nixd"))) + ((nushell-mode nushell-ts-mode) . ("nu" "--lsp")) (gdscript-mode . ("localhost" 6008)) ((fortran-mode f90-mode) . ("fortls")) (futhark-mode . ("futhark" "lsp")) -- cgit v1.2.3 From 72b1379f0795a5e2e9c57615c0b1d78c0b97cd1f Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 2 Feb 2024 12:28:54 +0100 Subject: Increase `emacs-lisp-docstring-fill-column` to 72 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- .dir-locals.el | 4 ++-- etc/NEWS | 5 +++++ lisp/emacs-lisp/lisp-mode.el | 5 +++-- 3 files changed, 10 insertions(+), 4 deletions(-) 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. -- cgit v1.2.3 From 4b79c80c999fe95654b7db196b12e0844473f6da Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 2 Feb 2024 15:24:55 +0200 Subject: 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'. --- doc/lispref/sequences.texi | 37 +++++++++++++++++++++++++++++++++---- etc/NEWS | 5 +++++ lisp/sort.el | 20 ++++++++++++++++++++ 3 files changed, 58 insertions(+), 4 deletions(-) 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) -- cgit v1.2.3 From dcce1e07fe750df060ab3a7c6782dc5145710fa3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 2 Feb 2024 15:27:25 +0200 Subject: ; Fix last change * doc/lispref/sequences.texi (Sequence Functions): Improve indexing of last change --- doc/lispref/sequences.texi | 2 ++ 1 file changed, 2 insertions(+) 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 -- cgit v1.2.3 From f9a15b8a1559999b8dd9895a5f5bb922c4e6730f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 2 Feb 2024 17:39:23 +0200 Subject: ; Fix last change * lisp/sort.el (sort-on): Doc fix. * doc/lispref/sequences.texi (Sequence Functions): Fix description of 'sort-on'. --- doc/lispref/sequences.texi | 38 +++++++++++++++++++------------------- lisp/sort.el | 3 ++- 2 files changed, 21 insertions(+), 20 deletions(-) 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 -- cgit v1.2.3 From 02bdb1e4c50153a1754b251538d705d7d81668f8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 2 Feb 2024 17:46:19 +0200 Subject: ; Another fix of last change. --- doc/lispref/sequences.texi | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) 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}. -- cgit v1.2.3 From eb9bdb8948683e9870a3e52d085bf0c57d049130 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 2 Feb 2024 17:48:28 +0200 Subject: ; And another fix... --- lisp/sort.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 -- cgit v1.2.3 From e2d1ac2f258a069f950d4df80c8096bfa34081fc Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 2 Feb 2024 18:33:54 +0200 Subject: ; * doc/lispref/sequences.texi (Sequence Functions): Fix typo. --- doc/lispref/sequences.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 -- cgit v1.2.3 From e9a668274e441645aed28e8c353187dfed35fcae Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 31 Jan 2024 18:56:43 -0500 Subject: 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. --- lisp/cus-face.el | 2 +- lisp/emacs-lisp/bytecomp.el | 466 +++++++++++++++++--------------------------- lisp/faces.el | 4 +- lisp/help-fns.el | 5 +- src/doc.c | 58 ++---- src/print.c | 19 +- 6 files changed, 218 insertions(+), 336 deletions(-) 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 -- cgit v1.2.3 From 82e50a23fea8bc435bfae8390008702aa7d74bda Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 2 Feb 2024 18:59:21 -0500 Subject: cperl-mode.el: Don't use obsolete `special-display-popup-frame` * lisp/progmodes/cperl-mode.el (cperl-info-on-command): Simplify, to let `pop-to-buffer` decide whether to create a new frame or not, so it can be controlled by `display-buffer-alist`. --- lisp/progmodes/cperl-mode.el | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index bfc1742610c..758a6e17f72 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6612,14 +6612,13 @@ and \"Whitesmith\"." read)))) (let ((cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///" - pos isvar height iniheight frheight buf win fr1 fr2 iniwin not-loner + pos isvar height iniheight frheight buf win iniwin not-loner max-height char-height buf-list) (if (string-match "^-[a-zA-Z]$" command) (setq cmd-desc "^-X[ \t\n]")) (setq isvar (string-match "^[$@%]" command) buf (cperl-info-buffer isvar) - iniwin (selected-window) - fr1 (window-frame iniwin)) + iniwin (selected-window)) (set-buffer buf) (goto-char (point-min)) (or isvar @@ -6640,11 +6639,7 @@ and \"Whitesmith\"." (or (not win) (eq (window-buffer win) buf) (set-window-buffer win buf)) - (and win (setq fr2 (window-frame win))) - (if (or (not fr2) (eq fr1 fr2)) - (pop-to-buffer buf) - (special-display-popup-frame buf) ; Make it visible - (select-window win)) + (pop-to-buffer buf) (goto-char pos) ; Needed (?!). ;; Resize (setq iniheight (window-height) -- cgit v1.2.3 From bb894845ed6a06e8b301251d62f8b4a73a09d5ea Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 29 Jan 2024 19:04:58 -0800 Subject: Teach customize-option about erc-modules * lisp/erc/erc-goodies.el (erc-scrolltobottom-mode) (erc-scrolltobottom-enable): Use `setq' instead of `setopt' because the latter isn't defined in Emacs 27 and 28. This fix is unrelated to the main thrust of this commit. * lisp/erc/erc.el (erc-modules): Make good on decades old language in info node "(erc) Modules" by ensuring `customize-option' can find this option before its containing library is loaded. Like `gnus-select-method', this option serves as an entry point for configuring the application and is presented that way in tutorials and library front matter. Moreover, it can't be reasonably autoloaded in the traditional way because of its many dependencies and large textual footprint. (erc-display-message): Revise doc string. --- lisp/erc/erc-goodies.el | 2 +- lisp/erc/erc.el | 37 ++++++++++++++++++++----------------- 2 files changed, 21 insertions(+), 18 deletions(-) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 8293994c5d4..7e30b1060fd 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -83,7 +83,7 @@ be experimental. It currently only works with Emacs 28+." (when (and erc-scrolltobottom-all (< emacs-major-version 28)) (erc-button--display-error-notice-with-keys "Option `erc-scrolltobottom-all' requires Emacs 28+. Disabling.") - (setopt erc-scrolltobottom-all nil)) + (setq erc-scrolltobottom-all nil)) (unless erc--updating-modules-p (erc-buffer-do #'erc--scrolltobottom-setup)) (if erc-scrolltobottom-all (progn diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index edac1060c3e..67c31d961e3 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2183,13 +2183,17 @@ buffer rather than a server buffer.") (cl-pushnew mod (if (get mod 'erc--module) built-in third-party))) `(,@(sort built-in #'string-lessp) ,@(nreverse third-party)))) +;;;###autoload(custom-autoload 'erc-modules "erc") + (defcustom erc-modules '( autojoin button completion fill imenu irccontrols list match menu move-to-prompt netsplit networks readonly ring stamp track) - "A list of modules which ERC should enable. -If you set the value of this without using `customize' remember to call -\(erc-update-modules) after you change it. When using `customize', modules -removed from the list will be disabled." + "Modules to enable while connecting. +When modifying this option in lisp code, use a Custom-friendly +facilitator, like `setopt', or call `erc-update-modules' +afterward. This ensures a consistent ordering and disables +removed modules. It also gives packages access to the hook +`erc-before-connect'." :get (lambda (sym) ;; replace outdated names with their newer equivalents (erc-migrate-modules (symbol-value sym))) @@ -3828,14 +3832,14 @@ TYPE, when non-nil, to be a symbol handled by string MSG). Expect BUFFER to be among the sort accepted by the function `erc-display-line'. -Expect BUFFER to be a live `erc-mode' buffer, a list of such -buffers, or the symbols `all' or `active'. If `all', insert -STRING in all buffers for the current session. If `active', -defer to the function `erc-active-buffer', which may return the -session's server buffer if the previously active buffer has been -killed. If BUFFER is nil or a network process, pretend it's set -to the appropriate server buffer. Otherwise, use the current -buffer. +When non-nil, expect BUFFER to be a live `erc-mode' buffer, a +list of such buffers, or the symbols `all' or `active'. If +`all', insert STRING in all buffers for the current session. If +`active', defer to the function `erc-active-buffer', which may +return the session's server buffer if the previously active +buffer has been killed. If BUFFER is nil or a network process, +pretend it's set to the appropriate server buffer. Otherwise, +use the current buffer. When TYPE is a list of symbols, call handlers from left to right without influencing how they behave when encountering existing @@ -3848,11 +3852,10 @@ being (erc-error-face erc-notice-face) throughout MSG when `erc-notice-highlight-type' is left at its default, `all'. As of ERC 5.6, assume third-party code will use this function -instead of lower-level ones, like `erc-insert-line', when needing -ERC to process arbitrary informative messages as if they'd been -sent from a server. That is, guarantee \"local\" messages, for -which PARSED is typically nil, will be subject to buttonizing, -filling, and other effects." +instead of lower-level ones, like `erc-insert-line', to insert +arbitrary informative messages as if sent by the server. That +is, tell modules to treat a \"local\" message for which PARSED is +nil like any other server-sent message." (let* ((erc--msg-props (or erc--msg-props (let ((table (make-hash-table)) -- cgit v1.2.3 From b7cdce097003a645ae396470cfab221bf789189e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 30 Jan 2024 18:17:41 -0800 Subject: Fix local variable persistence in erc-stamp * etc/ERC-NEWS: Mention renaming of `erc-munge-invisible-property'. * lisp/erc/erc-stamp.el (erc-stamp-mode, erc-stamp-disable): Remove correct function from `erc-mode-hook'. (erc-stamp--recover-on-reconnect): Revise doc string. (erc-munge-invisibility-spec, erc-stamp--manage-local-options-state): Mark former name as obsolete and rename to latter. Don't use helper macro meant only for local modules. This bug originated from c68dc778 "Manage some text props for ERC insertion-hook members", which stemmed from bug#60936. (erc-stamp--setup, erc-hide-timestamps, erc-show-timestamps) (erc-toggle-timestamps): Use new name for `erc-munge-invisibility-spec'. * lisp/erc/erc.el (erc--restore-initialize-priors): Raise error at runtime if mode var doesn't belong to a local module. * test/lisp/erc/erc-stamp-tests.el (erc-stamp-tests--insert-right) (erc-timestamp-intangible--left): Use new name for `erc-munge-invisibility-spec'. * test/lisp/erc/erc-tests.el (erc--refresh-prompt): Shadow `erc-last-input-time'. (erc--restore-initialize-priors): Add error form to expected expansion, and skip test on Emacs 27. * test/lisp/erc/resources/erc-scenarios-common.el (erc-scenarios-common--make-bindings): Shadow `erc-last-input-time'. --- etc/ERC-NEWS | 9 ++++-- lisp/erc/erc-stamp.el | 39 ++++++++++++++++--------- lisp/erc/erc.el | 4 ++- test/lisp/erc/erc-stamp-tests.el | 4 +-- test/lisp/erc/erc-tests.el | 5 ++++ test/lisp/erc/resources/erc-scenarios-common.el | 1 + 6 files changed, 42 insertions(+), 20 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index f91d3fcb351..1e88500d169 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -435,9 +435,12 @@ contains unique closures and thus no longer proves effective for traversing inserted messages. For now, ERC only provides an internal means of visiting messages, but a public interface is forthcoming. Also affecting the 'stamp' module is the deprecation of the function -'erc-insert-aligned' and its removal from client code. Additionally, -the module now merges its 'invisible' property with existing ones and -includes all white space around stamps when doing so. +'erc-insert-aligned' and its removal from the default client's code. +In the same library, the function 'erc-munge-invisibility-spec' has +been renamed to 'erc-stamp--manage-local-options-state' to better +reflect its purpose. Additionally, the module now merges its +'invisible' property with existing ones and includes all white space +around stamps when doing so. This "propertizing" of surrounding white space extends to all 'stamp'-applied properties, like 'field', in all intervening space diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 558afd19427..a11739a4195 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -184,7 +184,7 @@ from entering them and instead jump over them." (add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) (add-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear 40) (unless erc--updating-modules-p (erc-buffer-do #'erc-stamp--setup))) - ((remove-hook 'erc-mode-hook #'erc-munge-invisibility-spec) + ((remove-hook 'erc-mode-hook #'erc-stamp--setup) (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) (remove-hook 'erc-send-modify-hook #'erc-add-timestamp) (remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) @@ -198,6 +198,7 @@ from entering them and instead jump over them." "Escape hatch for omitting stamps when first char is invisible.") (defun erc-stamp--recover-on-reconnect () + "Attempt to restore \"last-inserted\" snapshots from prior session." (when-let ((priors (or erc--server-reconnecting erc--target-priors))) (dolist (var '(erc-timestamp-last-inserted erc-timestamp-last-inserted-left @@ -854,12 +855,20 @@ Return the empty string if FORMAT is nil." (defvar-local erc-stamp--csf-props-updated-p nil) -;; This function is used to munge `buffer-invisibility-spec' to an -;; appropriate value. Currently, it only handles timestamps, thus its -;; location. If you add other features which affect invisibility, -;; please modify this function and move it to a more appropriate -;; location. -(defun erc-munge-invisibility-spec () +(define-obsolete-function-alias 'erc-munge-invisibility-spec + #'erc-stamp--manage-local-options-state "30.1" + "Perform setup and teardown of `stamp'-owned options. + +Note that this function's role in practice has long defied its +stated mandate as claimed in a now deleted comment, which +envisioned it as evolving into a central toggle for modifying +`buffer-invisibility-spec' on behalf of options and features +ERC-wide.") +(defun erc-stamp--manage-local-options-state () + "Perform local setup and teardown for `stamp'-owned options. +For `erc-timestamp-intangible', toggle `cursor-intangible-mode'. +For `erc-echo-timestamps', integrate with `cursor-sensor-mode'. +For `erc-hide-timestamps, modify `buffer-invisibility-spec'." (if erc-timestamp-intangible (cursor-intangible-mode +1) ; idempotent (when (bound-and-true-p cursor-intangible-mode) @@ -869,10 +878,12 @@ Return the empty string if FORMAT is nil." (unless erc-stamp--permanent-cursor-sensor-functions (dolist (hook '(erc-insert-post-hook erc-send-post-hook)) (add-hook hook #'erc-stamp--add-csf-on-post-modify nil t)) - (erc--restore-initialize-priors erc-stamp-mode - erc-stamp--csf-props-updated-p nil) + (setq erc-stamp--csf-props-updated-p + (alist-get 'erc-stamp--csf-props-updated-p + (or erc--server-reconnecting erc--target-priors))) (unless erc-stamp--csf-props-updated-p (setq erc-stamp--csf-props-updated-p t) + ;; Spoof `erc--ts' as being non-nil. (let ((erc--msg-props (map-into '((erc--ts . t)) 'hash-table))) (with-silent-modifications (erc--traverse-inserted @@ -902,9 +913,9 @@ Return the empty string if FORMAT is nil." (defun erc-stamp--setup () "Enable or disable buffer-local `erc-stamp-mode' modifications." (if erc-stamp-mode - (erc-munge-invisibility-spec) + (erc-stamp--manage-local-options-state) (let (erc-echo-timestamps erc-hide-timestamps erc-timestamp-intangible) - (erc-munge-invisibility-spec)) + (erc-stamp--manage-local-options-state)) ;; Undo local mods from `erc-insert-timestamp-left-and-right'. (erc-stamp--date-mode -1) ; kills `erc-timestamp-last-inserted-left' (kill-local-variable 'erc-stamp--last-stamp) @@ -916,7 +927,7 @@ Return the empty string if FORMAT is nil." "Hide timestamp information from display." (interactive) (setq erc-hide-timestamps t) - (erc-munge-invisibility-spec)) + (erc-stamp--manage-local-options-state)) (defun erc-show-timestamps () "Show timestamp information on display. @@ -924,7 +935,7 @@ This function only works if `erc-timestamp-format' was previously set, and timestamping is already active." (interactive) (setq erc-hide-timestamps nil) - (erc-munge-invisibility-spec)) + (erc-stamp--manage-local-options-state)) (defun erc-toggle-timestamps () "Hide or show timestamps in ERC buffers. @@ -938,7 +949,7 @@ enabled when the message was inserted." (setq erc-hide-timestamps t)) (mapc (lambda (buffer) (with-current-buffer buffer - (erc-munge-invisibility-spec))) + (erc-stamp--manage-local-options-state))) (erc-buffer-list))) (defvar-local erc-stamp--last-stamp nil) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 67c31d961e3..ef047201251 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1531,7 +1531,7 @@ Bound to local variables from an existing (logical) session's buffer during local-module setup and `erc-mode-hook' activation.") (defmacro erc--restore-initialize-priors (mode &rest vars) - "Restore local VARS for MODE from a previous session." + "Restore local VARS for local minor MODE from a previous session." (declare (indent 1)) (let ((priors (make-symbol "priors")) (initp (make-symbol "initp")) @@ -1541,6 +1541,8 @@ buffer during local-module setup and `erc-mode-hook' activation.") (push `(,k (if ,initp (alist-get ',k ,priors) ,(pop vars))) forms)) `(let* ((,priors (or erc--server-reconnecting erc--target-priors)) (,initp (and ,priors (alist-get ',mode ,priors)))) + (unless (local-variable-if-set-p ',mode) + (error "Not a local minor mode var: %s" ',mode)) (setq ,@(mapcan #'identity (nreverse forms)))))) (defun erc--target-from-string (string) diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index ef292ccb618..70ca224ac74 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -46,7 +46,7 @@ (with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*") (erc-mode) - (erc-munge-invisibility-spec) + (erc-stamp--manage-local-options-state) (erc--initialize-markers (point) nil) (erc-tests-common-init-server-proc "sleep" "1") @@ -235,7 +235,7 @@ (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*") (erc-mode) (erc--initialize-markers (point) nil) - (erc-munge-invisibility-spec) + (erc-stamp--manage-local-options-state) (erc-display-message nil 'notice (current-buffer) "Welcome") ;; ;; Pretend `fill' is active and that these lines are diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b51bd67ae04..7890049a325 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -302,6 +302,7 @@ (cl-incf counter)))) erc-accidental-paste-threshold-seconds erc-insert-modify-hook + (erc-last-input-time 0) (erc-modules (remq 'stamp erc-modules)) (erc-send-input-line-function #'ignore) (erc--input-review-functions erc--input-review-functions) @@ -1189,12 +1190,16 @@ (should (erc--valid-local-channel-p "&local"))))) (ert-deftest erc--restore-initialize-priors () + (unless (>= emacs-major-version 28) + (ert-skip "Lisp nesting exceeds `max-lisp-eval-depth'")) (should (pcase (macroexpand-1 '(erc--restore-initialize-priors erc-my-mode foo (ignore 1 2 3) bar #'spam baz nil)) (`(let* ((,p (or erc--server-reconnecting erc--target-priors)) (,q (and ,p (alist-get 'erc-my-mode ,p)))) + (unless (local-variable-if-set-p 'erc-my-mode) + (error "Not a local minor mode var: %s" 'erc-my-mode)) (setq foo (if ,q (alist-get 'foo ,p) (ignore 1 2 3)) bar (if ,q (alist-get 'bar ,p) #'spam) baz (if ,q (alist-get 'baz ,p) nil))) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 0ec48d766ef..042b3a8c05b 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -151,6 +151,7 @@ (erc-autojoin-channels-alist nil) (erc-server-auto-reconnect nil) (erc-after-connect nil) + (erc-last-input-time 0) (erc-d-linger-secs 10) ,@bindings))) -- cgit v1.2.3 From aa6315ee685185dd1b9b63ee94636e662d68106b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 31 Jan 2024 06:01:54 -0800 Subject: Reassociate erc-networks--id for orphaned queries * lisp/erc/erc-networks.el (erc-networks--examine-targets): Adopt the server's network ID in query buffers created before MOTD's end. Do this to avoid a type error in the process filter when renaming buffers. * lisp/erc/erc-networks.el (erc-networks--examine-targets): New test. * test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el (erc-scenarios-upstream-recon--znc/severed): New test. * test/lisp/erc/erc-scenarios-misc.el (erc-scenarios-base-mask-target-routing): Adjust timeout. * test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld: New file. * test/lisp/erc/resources/erc-tests-common.el (erc-tests-common-make-server-buf): Use NAME parameter for creating ID. --- lisp/erc/erc-networks.el | 25 ++++++- test/lisp/erc/erc-networks-tests.el | 46 ++++++++++++ .../erc/erc-scenarios-base-upstream-recon-znc.el | 46 ++++++++++++ test/lisp/erc/erc-scenarios-misc.el | 2 +- .../base/upstream-reconnect/znc-severed.eld | 87 ++++++++++++++++++++++ test/lisp/erc/resources/erc-tests-common.el | 2 +- 6 files changed, 202 insertions(+), 6 deletions(-) create mode 100644 test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 99c3c0563d0..1b26afa1164 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -1123,10 +1123,27 @@ TARGET to be an `erc--target' object." (lambda () (when (and erc--target (eq (erc--target-symbol erc--target) (erc--target-symbol target))) - (let ((oursp (if (erc--target-channel-local-p target) - (equal announced erc-server-announced-name) - (erc-networks--id-equal-p identity erc-networks--id)))) - (funcall (if oursp on-dupe on-collision)))))))) + ;; When a server sends administrative queries immediately + ;; after connection registration and before the session has a + ;; net-id, the buffer remains orphaned until reassociated + ;; here retroactively. + (unless erc-networks--id + (let ((id (erc-with-server-buffer erc-networks--id)) + (server-buffer (process-buffer erc-server-process))) + (apply #'erc-button--display-error-notice-with-keys + server-buffer + (concat "Missing network session (ID) for %S. " + (if id "Using `%S' from %S." "Ignoring.")) + (current-buffer) + (and id (list (erc-networks--id-symbol + (setq erc-networks--id id)) + server-buffer))))) + (when erc-networks--id + (let ((oursp (if (erc--target-channel-local-p target) + (equal announced erc-server-announced-name) + (erc-networks--id-equal-p identity + erc-networks--id)))) + (funcall (if oursp on-dupe on-collision))))))))) (defconst erc-networks--qualified-sep "@" "Separator used for naming a target buffer.") diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index d8d8c6fa9cd..53cff8f489c 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el @@ -1761,4 +1761,50 @@ (should (equal (erc-ports-list (nth 4 srv)) '(6697 9999)))))) +(ert-deftest erc-networks--examine-targets () + (with-current-buffer (erc-tests-common-make-server-buf "foonet") + (erc--open-target "#chan") + (erc--open-target "#spam")) + + (with-current-buffer (erc-tests-common-make-server-buf "barnet") + (with-current-buffer (erc--open-target "*query") + (setq erc-networks--id nil)) + (with-current-buffer (erc--open-target "#chan") + (let ((calls ()) + (snap (lambda (parameter) + (list parameter + (erc-target) + (erc-networks--id-symbol erc-networks--id))))) + + ;; Search for "#chan" dupes among targets of all servers. + (should (equal + (erc-networks--examine-targets erc-networks--id erc--target + (lambda () (push (funcall snap 'ON-DUPE) calls)) + (lambda () (push (funcall snap 'ON-COLL) calls))) + (list (get-buffer "#chan@foonet") + (get-buffer "#chan@barnet")))) + + (should (equal (pop calls) '(ON-DUPE "#chan" barnet))) + (should (equal (pop calls) '(ON-COLL "#chan" foonet))) + (should-not calls) + (should-not (get-buffer "#chan")) + (should (get-buffer "#chan@barnet")) + (should (get-buffer "#chan@foonet")) + + ;; Search for "*query" dupes among targets of all servers. + (should (equal (erc-networks--examine-targets erc-networks--id + (buffer-local-value 'erc--target + (get-buffer "*query")) + (lambda () (push (funcall snap 'ON-DUPE) calls)) + (lambda () (push (funcall snap 'ON-COLL) calls))) + (list (get-buffer "*query")))) + + (should (equal (pop calls) '(ON-DUPE "*query" barnet))) + (should-not calls))) + + (goto-char (point-min)) + (should (search-forward "Missing network session" nil t))) + + (erc-tests-common-kill-buffers)) + ;;; erc-networks-tests.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el b/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el index bbd9c79f593..f3905974a11 100644 --- a/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el +++ b/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el @@ -42,4 +42,50 @@ 'znc-foonet 'znc-barnet)) +;; Here, the upstream connection is already severed when first +;; connecting. The bouncer therefore sends query messages from an +;; administrative bot before the first numerics burst, which results +;; in a target buffer not being associated with an `erc-networks--id'. +;; The problem only manifests later, when the buffer-association +;; machinery checks the names of all target buffers and assumes a +;; non-nil `erc-networks--id'. +(ert-deftest erc-scenarios-upstream-recon--znc/severed () + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/upstream-reconnect") + (erc-d-t-cleanup-sleep-secs 1) + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'znc-severed)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester@vanilla/foonet" + :password "changeme" + :full-name "tester") + (erc-scenarios-common-assert-initial-buf-name nil port) + (erc-d-t-wait-for 6 (eq (erc-network) 'foonet)))) + + (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "*status")) + (funcall expect 10 "Connection Refused. Reconnecting...") + (funcall expect 10 "Connected!")) + + (ert-info ("Join #chan") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 " tester, welcome!") + (funcall expect 10 " alice: And see a fearful sight") + (funcall expect 10 " hola") + (funcall expect 10 " hell o") + ;; + (funcall expect 10 " bob: Or to drown my clothes"))) + + (ert-info ("Buffer not renamed with net id") + (should (get-buffer "*status"))) + + (ert-info ("No error") + (with-current-buffer (messages-buffer) + (funcall expect -0.1 "error in process filter"))))) + ;;; erc-scenarios-base-upstream-recon-znc.el ends here diff --git a/test/lisp/erc/erc-scenarios-misc.el b/test/lisp/erc/erc-scenarios-misc.el index 8f6042de5c2..2afa1ce67a4 100644 --- a/test/lisp/erc/erc-scenarios-misc.el +++ b/test/lisp/erc/erc-scenarios-misc.el @@ -126,7 +126,7 @@ (erc-d-t-wait-for 10 (get-buffer "foonet")) (ert-info ("Channel buffer #foo playback received") - (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#foo")) + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#foo")) (funcall expect 10 "Excellent workman"))) (ert-info ("Global notices routed to server buffer") diff --git a/test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld b/test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld new file mode 100644 index 00000000000..32d05cc8a3a --- /dev/null +++ b/test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld @@ -0,0 +1,87 @@ +;; -*- mode: lisp-data; -*- +((pass 10 "PASS :changeme")) +((nick 10 "NICK tester")) +((user 10 "USER tester@vanilla/foonet 0 * :tester") + (0.00 ":irc.znc.in 001 tester :Welcome to ZNC") + (0.03 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") + (0.01 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") + (0.00 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") + (0.01 ":*status!znc@znc.in PRIVMSG tester :Connected!") + (0.02 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Wed, 31 Jan 2024 10:58:16 UTC") + (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0.00 ":irc.foonet.org 422 tester :MOTD File is missing") + (0.00 ":irc.foonet.org 221 tester +Zi") + (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((mode 10 "MODE tester +i") + (0.01 ":irc.foonet.org 352 tester * ~u pfa3tpa5ig5ty.irc irc.foonet.org tester H :0 ZNC - https://znc.in") + (0.01 ":irc.foonet.org 315 tester tester :End of WHO list") + + (0.02 ":tester!~u@pfa3tpa5ig5ty.irc JOIN #chan") + (0.03 ":irc.foonet.org 353 tester = #chan :bob tester @alice eve")) + +((mode 10 "MODE #chan") + (0.00 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.00 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") + (0.01 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") + (0.01 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: And see how he will take it at your hands.") + (0.02 ":irc.foonet.org 221 tester +Zi") + (0.01 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Fear not, my lord, your servant shall do so.") + (0.02 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: If I thrive well, I'll visit thee again.") + (0.01 ":irc.foonet.org 324 tester #chan +Cnt") + (0.03 ":irc.foonet.org 329 tester #chan 1706698713") + (0.05 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Let it be forbid, sir; so should I be a great deal of his act.") + (0.04 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: And see a fearful sight of blood and death.") + (0.00 ":eve!~u@euegh6mj3y8r2.irc PRIVMSG #chan :hola") + (0.01 ":eve!~u@euegh6mj3y8r2.irc NICK :Evel") + (0.01 ":Evel!~u@euegh6mj3y8r2.irc PRIVMSG #chan :hell o") + (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: His highness comes post from Marseilles, of as able body as when he numbered thirty: he will be here to-morrow, or I am deceived by him that in such intelligence hath seldom failed.") + (0.03 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: See, by good hap, yonder's my lord; I have sweat to see his honour.") + (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: With the rich worth of your virginity.") + + (0.02 ":*status!znc@znc.in PRIVMSG tester :Disconnected from IRC. Reconnecting...") + (0.05 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") + (0.03 ":*status!znc@znc.in PRIVMSG tester :Connected!") + (0.01 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.04 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Wed, 31 Jan 2024 10:58:16 UTC") + (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.03 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0.00 ":irc.foonet.org 422 tester :MOTD File is missing") + (0.02 ":irc.foonet.org 221 tester +i") + (0.01 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.") + (0.02 ":irc.foonet.org 352 tester * ~u hrn2ea3rpeyck.irc irc.foonet.org tester H :0 ZNC - https://znc.in") + (0.01 ":irc.foonet.org 315 tester tester :End of WHO list") + (0.02 ":tester!~u@hrn2ea3rpeyck.irc JOIN #chan")) + +((mode 10 "MODE #chan") + (0.00 ":irc.foonet.org 353 tester = #chan :tester @alice bob") + (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.00 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") + (0.01 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") + (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Nay, I assure you, a peace concluded.") + (0.03 ":irc.foonet.org 324 tester #chan +Cnt") + (0.01 ":irc.foonet.org 329 tester #chan 1706698713") + (0.05 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: But, in defence, by mercy, 'tis most just.") + (0.04 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Or to drown my clothes, and say I was stripped.")) diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index 05dbe1d50d6..99f15b89b03 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -122,7 +122,7 @@ Use NAME for the network and the session server as well." erc--isupport-params (make-hash-table) erc-session-port 6667 erc-network (intern name) - erc-networks--id (erc-networks--id-create nil)) + erc-networks--id (erc-networks--id-create name)) (current-buffer))) (defun erc-tests-common-string-to-propertized-parts (string) -- cgit v1.2.3 From 138decdc9e68a5fc9dddd1a212ed5d63d77d5d22 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 2 Feb 2024 22:53:23 -0800 Subject: Pacify gcc -Wpointer-sign MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/print.c (print_object): SDATA → SSDATA. --- src/print.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/print.c b/src/print.c index c2beff0ed55..e2252562915 100644 --- a/src/print.c +++ b/src/print.c @@ -2267,7 +2267,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) } else if (STRINGP (num)) { - strout (SDATA (num), SCHARS (num), SBYTES (num), printcharfun); + strout (SSDATA (num), SCHARS (num), SBYTES (num), printcharfun); goto next_obj; } } -- cgit v1.2.3 From d49124fc14b0bb37617b34b5839f873cea3817c8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Feb 2024 11:09:36 +0200 Subject: Avoid signaling errors from 'pixel-fill-region' * lisp/textmodes/pixel-fill.el (pixel-fill-region): Make sure the selected window displays the current buffer. This is important when this function is called inside 'with-current-buffer' or similar forms which temporarily change the buffer displayed in the selected window. (Bug#67791) --- lisp/textmodes/pixel-fill.el | 68 +++++++++++++++++++++++--------------------- 1 file changed, 35 insertions(+), 33 deletions(-) diff --git a/lisp/textmodes/pixel-fill.el b/lisp/textmodes/pixel-fill.el index 25c0b46cee9..d26eaec2111 100644 --- a/lisp/textmodes/pixel-fill.el +++ b/lisp/textmodes/pixel-fill.el @@ -73,39 +73,41 @@ lines that are visually wider than PIXEL-WIDTH. If START isn't at the start of a line, the horizontal position of START, converted to pixel units, will be used as the indentation prefix on subsequent lines." - (save-excursion - (goto-char start) - (let ((indentation - (car (window-text-pixel-size nil (line-beginning-position) - (point)))) - (newline-end nil)) - (when (> indentation pixel-width) - (error "The indentation (%s) is wider than the fill width (%s)" - indentation pixel-width)) - (save-restriction - (narrow-to-region start end) - (goto-char (point-max)) - (when (looking-back "\n[ \t]*" (point-min)) - (setq newline-end t)) - (goto-char (point-min)) - ;; First replace all whitespace with space. - (while (re-search-forward "[ \t\n]+" nil t) - (cond - ((or (= (match-beginning 0) start) - (= (match-end 0) end)) - (delete-region (match-beginning 0) (match-end 0))) - ;; If there's just a single space here, don't replace. - ((not (and (= (- (match-end 0) (match-beginning 0)) 1) - (= (char-after (match-beginning 0)) ?\s))) - (replace-match - ;; We need to use a space that has an appropriate width. - (propertize " " 'face - (get-text-property (match-beginning 0) 'face)))))) - (goto-char start) - (pixel-fill--fill-line pixel-width indentation) - (goto-char (point-max)) - (when newline-end - (insert "\n")))))) + (save-window-excursion + (set-window-buffer nil (current-buffer)) + (save-excursion + (goto-char start) + (let ((indentation + (car (window-text-pixel-size nil (line-beginning-position) + (point)))) + (newline-end nil)) + (when (> indentation pixel-width) + (error "The indentation (%s) is wider than the fill width (%s)" + indentation pixel-width)) + (save-restriction + (narrow-to-region start end) + (goto-char (point-max)) + (when (looking-back "\n[ \t]*" (point-min)) + (setq newline-end t)) + (goto-char (point-min)) + ;; First replace all whitespace with space. + (while (re-search-forward "[ \t\n]+" nil t) + (cond + ((or (= (match-beginning 0) start) + (= (match-end 0) end)) + (delete-region (match-beginning 0) (match-end 0))) + ;; If there's just a single space here, don't replace. + ((not (and (= (- (match-end 0) (match-beginning 0)) 1) + (= (char-after (match-beginning 0)) ?\s))) + (replace-match + ;; We need to use a space that has an appropriate width. + (propertize " " 'face + (get-text-property (match-beginning 0) 'face)))))) + (goto-char start) + (pixel-fill--fill-line pixel-width indentation) + (goto-char (point-max)) + (when newline-end + (insert "\n"))))))) (defun pixel-fill--goto-pixel (width) (vertical-motion (cons (/ width (frame-char-width)) 0))) -- cgit v1.2.3 From 2f69353e4a756cf53459c14c5618bd262331b568 Mon Sep 17 00:00:00 2001 From: Vincenzo Pupillo Date: Thu, 1 Feb 2024 16:57:39 +0100 Subject: Fix incompatibility with tree-sitter-javascript >= 0.20.2 Starting from version 0.20.2 the grammar's primary expression "function" has been renamed to "function_expression". A new function checks if the new primary expression is available, and if so, it returns the correct rules. * lisp/progmodes/js.el (js--treesit-font-lock-compatibility-definition-feature): New function. (js--treesit-font-lock-settings): Use it. (Bug#68879) --- lisp/progmodes/js.el | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index e4ccfd73cc7..12c4d0aedb8 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3427,6 +3427,26 @@ This function is intended for use in `after-change-functions'." ;;; Tree sitter integration +(defun js--treesit-font-lock-compatibility-definition-feature () + "Font lock helper, to handle different releases of tree-sitter-javascript. +Check if a node type is available, then return the right font lock rules +for \"definition\" feature." + (condition-case nil + (progn (treesit-query-capture 'javascript '((function_expression) @cap)) + ;; starting from 0.20.2 + '((function_expression + name: (identifier) @font-lock-function-name-face) + (variable_declarator + name: (identifier) @font-lock-function-name-face + value: [(function_expression) (arrow_function)]))) + (error + ;; older version + '((function + name: (identifier) @font-lock-function-name-face) + (variable_declarator + name: (identifier) @font-lock-function-name-face + value: [(function) (arrow_function)]))))) + (defun js-jsx--treesit-indent-compatibility-bb1f97b () "Indent rules helper, to handle different releases of tree-sitter-javascript. Check if a node type is available, then return the right indent rules." @@ -3538,8 +3558,7 @@ Check if a node type is available, then return the right indent rules." :language 'javascript :feature 'definition - '((function - name: (identifier) @font-lock-function-name-face) + `(,@(js--treesit-font-lock-compatibility-definition-feature) (class_declaration name: (identifier) @font-lock-type-face) @@ -3558,10 +3577,6 @@ Check if a node type is available, then return the right indent rules." (variable_declarator name: (identifier) @font-lock-variable-name-face) - (variable_declarator - name: (identifier) @font-lock-function-name-face - value: [(function) (arrow_function)]) - (variable_declarator name: [(array_pattern (identifier) @font-lock-variable-name-face) (object_pattern -- cgit v1.2.3 From b91f0ee2fcc52b6ef2d747c5fc7f37573adc7ca5 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Feb 2024 11:20:11 +0200 Subject: ; Fix last change * lisp/progmodes/js.el (js--treesit-font-lock-compatibility-definition-feature): Fix comments. --- lisp/progmodes/js.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 12c4d0aedb8..20350c0ccb6 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3433,14 +3433,14 @@ Check if a node type is available, then return the right font lock rules for \"definition\" feature." (condition-case nil (progn (treesit-query-capture 'javascript '((function_expression) @cap)) - ;; starting from 0.20.2 + ;; Starting from version 0.20.2 of the grammar. '((function_expression name: (identifier) @font-lock-function-name-face) (variable_declarator name: (identifier) @font-lock-function-name-face value: [(function_expression) (arrow_function)]))) (error - ;; older version + ;; An older version of the grammar. '((function name: (identifier) @font-lock-function-name-face) (variable_declarator -- cgit v1.2.3 From 37efb63a3df969fb2eeed70dfe7fcf6c187e05be Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Feb 2024 11:52:30 +0200 Subject: ; * lisp/eshell/em-unix.el (eshell/cp, eshell/ln): Delete extra space. Bug#68862. --- lisp/eshell/em-unix.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index a88c7e09946..78dfd0654e2 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -590,7 +590,7 @@ Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY. :external "cp" :show-usage :usage "[OPTION]... SOURCE DEST - or: cp [OPTION]... SOURCE... DIRECTORY + or: cp [OPTION]... SOURCE... DIRECTORY Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.") (if archive (setq preserve t no-dereference t em-recursive t)) @@ -619,7 +619,7 @@ Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.") :external "ln" :show-usage :usage "[OPTION]... TARGET [LINK_NAME] - or: ln [OPTION]... TARGET... DIRECTORY + or: ln [OPTION]... TARGET... DIRECTORY Create a link to the specified TARGET with optional LINK_NAME. If there is more than one TARGET, the last argument must be a directory; create links in DIRECTORY to each TARGET. Create hard links by default, symbolic links -- cgit v1.2.3 From 492e16f2ff33e7ff65ff965e9cd2ba658c9f9a45 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Feb 2024 13:00:15 +0200 Subject: Fix downcasing of mode-name in compile.el * lisp/progmodes/compile.el (compilation--downcase-mode-name): New function. (compilation-start, kill-compilation): Use it instead of calling 'downcase' on 'mode-name'. (Bug#68795) --- lisp/progmodes/compile.el | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 51c81b9d2f6..11d400e145a 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1890,6 +1890,12 @@ process from additional information inserted by Emacs." (defvar-local compilation--start-time nil "The time when the compilation started as returned by `float-time'.") +(defun compilation--downcase-mode-name (mode) + "Downcase the name of major MODE, even if MODE is not a string. +The function `downcase' will barf if passed the name of a `major-mode' +which is not a string, but instead a symbol or a list." + (downcase (format-mode-line mode))) + ;;;###autoload (defun compilation-start (command &optional mode name-function highlight-regexp continue) @@ -2081,11 +2087,12 @@ Returns the compilation buffer created." (get-buffer-process (with-no-warnings (comint-exec - outbuf (downcase mode-name) + outbuf (compilation--downcase-mode-name mode-name) shell-file-name nil `(,shell-command-switch ,command))))) - (start-file-process-shell-command (downcase mode-name) - outbuf command)))) + (start-file-process-shell-command + (compilation--downcase-mode-name mode-name) + outbuf command)))) ;; Make the buffer's mode line show process state. (setq mode-line-process '((:propertize ":%s" face compilation-mode-line-run) @@ -2790,7 +2797,8 @@ Prefix arg N says how many files to move backwards (or forwards, if negative)." (let ((buffer (compilation-find-buffer))) (if (get-buffer-process buffer) (interrupt-process (get-buffer-process buffer)) - (error "The %s process is not running" (downcase mode-name))))) + (error "The %s process is not running" + (compilation--downcase-mode-name mode-name))))) (defalias 'compile-mouse-goto-error 'compile-goto-error) -- cgit v1.2.3 From 5e4a0a29fa3562ce9b2b8e497c6e71e6bc169082 Mon Sep 17 00:00:00 2001 From: João Távora Date: Thu, 30 Nov 2023 06:00:44 -0600 Subject: Make sure read-symbol-shorthands is permanently local bug#63480, bug#67390 * lisp/files.el (permanently-enabled-local-variables): Add read-symbol-shorthands. --- lisp/files.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/files.el b/lisp/files.el index 9c8914bfc50..fd9088206d7 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3754,7 +3754,8 @@ function is allowed to change the contents of this alist. This hook is called only if there is at least one file-local variable to set.") -(defvar permanently-enabled-local-variables '(lexical-binding) +(defvar permanently-enabled-local-variables + '(lexical-binding read-symbol-shorthands) "A list of file-local variables that are always enabled. This overrides any `enable-local-variables' setting.") -- cgit v1.2.3 From c2aaa8f15aa8fb3415a6c9f421f539ee34b7f52c Mon Sep 17 00:00:00 2001 From: João Távora Date: Thu, 30 Nov 2023 06:00:38 -0600 Subject: Process read-symbol-shorthands from longest to shortest (bug#67390) This ensures that overlapping shorthands are handled correctly and consistently even if specified out-of-order by the user. * doc/lispref/symbols.texi (Shorthands): Describe shorthand sort order. * lisp/files.el (hack-local-variables--find-variables): Specially handle read-symbol-shorthands. --- doc/lispref/symbols.texi | 17 +++++++++++++++++ lisp/files.el | 7 +++++++ 2 files changed, 24 insertions(+) diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 367bd195f16..e95e53d972d 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -761,6 +761,23 @@ instead of @code{snu-}. ;; End: @end example +Note that if you have two shorthands in the same file where one is the +prefix of the other, the longer shorthand will be attempted first. +This happens regardless of the order you specify shorthands in the +local variables section of your file. + +@example +'( + t//foo ; reads to 'my-tricks--foo', not 'my-tricks-/foo' + t/foo ; reads to 'my-tricks-foo' + ) + +;; Local Variables: +;; read-symbol-shorthands: (("t/" . "my-tricks-") +;; ("t//" . "my-tricks--") +;; End: +@end example + @subsection Exceptions There are two exceptions to rules governing Shorthand transformations: diff --git a/lisp/files.el b/lisp/files.el index fd9088206d7..172237ceb82 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4191,6 +4191,13 @@ major-mode." ;; to use 'thisbuf's name in the ;; warning message. (or (buffer-file-name thisbuf) "")))))) + ((eq var 'read-symbol-shorthands) + ;; Sort automatically by shorthand length + ;; descending + (setq val (sort val + (lambda (sh1 sh2) (> (length (car sh1)) + (length (car sh2)))))) + (push (cons 'read-symbol-shorthands val) result)) ((and (eq var 'mode) handle-mode)) (t (ignore-errors -- cgit v1.2.3 From 17c3610c56155dd5b1efd5b7e8d6a58112f43a59 Mon Sep 17 00:00:00 2001 From: João Távora Date: Wed, 29 Nov 2023 06:21:29 -0600 Subject: Consider read-symbol-shorthands in check-declare.el (bug#67523) * lisp/emacs-lisp/check-declare.el (check-declare-verify): Consider read-symbol-shorthands. --- lisp/emacs-lisp/check-declare.el | 101 ++++++++++++++++++++------------------- 1 file changed, 53 insertions(+), 48 deletions(-) diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el index 8e40b227b65..b4a7b4b33e6 100644 --- a/lisp/emacs-lisp/check-declare.el +++ b/lisp/emacs-lisp/check-declare.el @@ -145,64 +145,69 @@ is a string giving details of the error." (if (file-regular-p fnfile) (with-temp-buffer (insert-file-contents fnfile) + (unless cflag + ;; If in Elisp, ensure syntax and shorthands available + (set-syntax-table emacs-lisp-mode-syntax-table) + (let (enable-local-variables) (hack-local-variables))) ;; defsubst's don't _have_ to be known at compile time. - (setq re (format (if cflag - "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\"" - "^[ \t]*(\\(fset[ \t]+'\\|\ + (setq re (if cflag + (format "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\"" + (regexp-opt (mapcar 'cadr fnlist) t)) + "^[ \t]*(\\(fset[ \t]+'\\|\ cl-def\\(?:generic\\|method\\|un\\)\\|\ def\\(?:un\\|subst\\|foo\\|method\\|class\\|\ ine-\\(?:derived\\|generic\\|\\(?:global\\(?:ized\\)?-\\)?minor\\)-mode\\|\ \\(?:ine-obsolete-function-\\)?alias[ \t]+'\\|\ ine-overloadable-function\\)\\)\ -[ \t]*%s\\([ \t;]+\\|$\\)") - (regexp-opt (mapcar 'cadr fnlist) t))) +[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)\\([ \t;]+\\|$\\)")) (while (re-search-forward re nil t) (skip-chars-forward " \t\n") - (setq fn (match-string 2) - type (match-string 1) - ;; (min . max) for a fixed number of arguments, or - ;; arglists with optional elements. - ;; (min) for arglists with &rest. - ;; sig = 'err means we could not find an arglist. - sig (cond (cflag - (or - (when (search-forward "," nil t 3) - (skip-chars-forward " \t\n") - ;; Assuming minargs and maxargs on same line. - (when (looking-at "\\([0-9]+\\)[ \t]*,[ \t]*\ + (setq fn (symbol-name (car (read-from-string (match-string 2))))) + (when (member fn (mapcar 'cadr fnlist)) + (setq type (match-string 1) + ;; (min . max) for a fixed number of arguments, or + ;; arglists with optional elements. + ;; (min) for arglists with &rest. + ;; sig = 'err means we could not find an arglist. + sig (cond (cflag + (or + (when (search-forward "," nil t 3) + (skip-chars-forward " \t\n") + ;; Assuming minargs and maxargs on same line. + (when (looking-at "\\([0-9]+\\)[ \t]*,[ \t]*\ \\([0-9]+\\|MANY\\|UNEVALLED\\)") - (setq minargs (string-to-number - (match-string 1)) - maxargs (match-string 2)) - (cons minargs (unless (string-match "[^0-9]" - maxargs) - (string-to-number - maxargs))))) - 'err)) - ((string-match - "\\`define-\\(derived\\|generic\\)-mode\\'" - type) - '(0 . 0)) - ((string-match - "\\`define\\(-global\\(ized\\)?\\)?-minor-mode\\'" - type) - '(0 . 1)) - ;; Prompt to update. - ((string-match - "\\`define-obsolete-function-alias\\>" - type) - 'obsolete) - ;; Can't easily check arguments in these cases. - ((string-match "\\`\\(def\\(alias\\|class\\)\\|\ + (setq minargs (string-to-number + (match-string 1)) + maxargs (match-string 2)) + (cons minargs (unless (string-match "[^0-9]" + maxargs) + (string-to-number + maxargs))))) + 'err)) + ((string-match + "\\`define-\\(derived\\|generic\\)-mode\\'" + type) + '(0 . 0)) + ((string-match + "\\`define\\(-global\\(ized\\)?\\)?-minor-mode\\'" + type) + '(0 . 1)) + ;; Prompt to update. + ((string-match + "\\`define-obsolete-function-alias\\>" + type) + 'obsolete) + ;; Can't easily check arguments in these cases. + ((string-match "\\`\\(def\\(alias\\|class\\)\\|\ fset\\|\\(?:cl-\\)?defmethod\\)\\>" type) - t) - ((looking-at "\\((\\|nil\\)") - (byte-compile-arglist-signature - (read (current-buffer)))) - (t - 'err)) - ;; alist of functions and arglist signatures. - siglist (cons (cons fn sig) siglist))))) + t) + ((looking-at "\\((\\|nil\\)") + (byte-compile-arglist-signature + (read (current-buffer)))) + (t + 'err)) + ;; alist of functions and arglist signatures. + siglist (cons (cons fn sig) siglist)))))) (dolist (e fnlist) (setq arglist (nth 2 e) type -- cgit v1.2.3 From 0f715f9c154a47de57a2f24f19b4a402604e6dc0 Mon Sep 17 00:00:00 2001 From: João Távora Date: Wed, 29 Nov 2023 16:48:34 -0600 Subject: Improve shorthands-font-lock-shorthands (bug#67390) Add font locking to the shorthand prefix of a given printed symbol name by checking if any of the shorthand prefixes in read-symbol-shorthands are a prefix for that print name. Although this does more string comparisons, it didn't prove to be any slower than the existing approach, and is more correct. This version is more accurate when highlighting files with many overlapping shorthands. Given: ;; Local Variables: ;; read-symbol-shorthands: (("bc-" . "breadcrumb-") ;; ("aw-" . "ace-window-") ;; ("zorglub/" . "ace-window-") ;; ("he//" . "hyperdrive-entry--") ;; ("h//" . "hyperdrive--") ;; ("he/" . "hyperdrive-entry-") ;; ("h/" . "hyperdrive-")) ;; End: The following are correct highlights on print names '(zorglub/blerh ; hilits "zorglub/" reads to 'ace-window-blerh' he/foo ; hilits "he/" reads to 'hyperdrive-entry-foo' he//bar ; hilits "he//" reads to 'hyperdrive-entry--bar' h/coiso ; hilits "h/" reads to 'hyperdrive-coiso' h//thingy ; hilits "h//" reads to 'hyperdrive--thingy' bc-yo ; hilits "bc-" reads to 'breadcrumb-yo' aw-thingy ; hilits "aw-" reads to 'ace-window-thingy' ) Co-authored-by: Jonas Bernoulli Co-authored-by: Joseph Turner * lisp/emacs-lisp/shorthands.el (shorthands-font-lock-shorthands): --- lisp/emacs-lisp/shorthands.el | 34 +++++++++++----------------------- 1 file changed, 11 insertions(+), 23 deletions(-) diff --git a/lisp/emacs-lisp/shorthands.el b/lisp/emacs-lisp/shorthands.el index 6348aaccf93..379fb0baec9 100644 --- a/lisp/emacs-lisp/shorthands.el +++ b/lisp/emacs-lisp/shorthands.el @@ -52,38 +52,26 @@ :version "28.1" :group 'font-lock-faces) -(defun shorthands--mismatch-from-end (str1 str2) - "Tell index of first mismatch in STR1 and STR2, from end. -The index is a valid 0-based index on STR1. Returns nil if STR1 -equals STR2. Return 0 if STR1 is a suffix of STR2." - (cl-loop with l1 = (length str1) with l2 = (length str2) - for i from 1 - for i1 = (- l1 i) for i2 = (- l2 i) - while (eq (aref str1 i1) (aref str2 i2)) - if (zerop i2) return (if (zerop i1) nil i1) - if (zerop i1) return 0 - finally (return i1))) - (defun shorthands-font-lock-shorthands (limit) + "Font lock until LIMIT considering `read-symbol-shorthands'." (when read-symbol-shorthands (while (re-search-forward (concat "\\_<\\(" (rx lisp-mode-symbol) "\\)\\_>") limit t) (let* ((existing (get-text-property (match-beginning 1) 'face)) + (print-name (match-string 1)) (probe (and (not (memq existing '(font-lock-comment-face font-lock-string-face))) - (intern-soft (match-string 1)))) - (sname (and probe (symbol-name probe))) - (mismatch (and sname (shorthands--mismatch-from-end - (match-string 1) sname))) - (guess (and mismatch (1+ mismatch)))) - (when guess - (when (and (< guess (1- (length (match-string 1)))) - ;; In bug#67390 we allow other separators - (eq (char-syntax (aref (match-string 1) guess)) ?_)) - (setq guess (1+ guess))) + (intern-soft print-name))) + (symbol-name (and probe (symbol-name probe))) + (prefix (and symbol-name + (not (string-equal print-name symbol-name)) + (car (assoc print-name + read-symbol-shorthands + #'string-prefix-p))))) + (when prefix (add-face-text-property (match-beginning 1) - (+ (match-beginning 1) guess) + (+ (match-beginning 1) (length prefix)) 'elisp-shorthand-font-lock-face)))))) (font-lock-add-keywords 'emacs-lisp-mode '((shorthands-font-lock-shorthands)) t) -- cgit v1.2.3 From c52d17d91ade6c789d8672dbd1301ba86ba4d7d1 Mon Sep 17 00:00:00 2001 From: João Távora Date: Wed, 29 Nov 2023 20:09:57 -0600 Subject: Also teach loaddefs-gen.el about shorthands (bug#63480) * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--parse-file): Make aware of read-symbol-shorthands. --- lisp/emacs-lisp/loaddefs-gen.el | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 5f152d3b509..bf5cd24f161 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -378,6 +378,7 @@ don't include." (let ((defs nil) (load-name (loaddefs-generate--file-load-name file main-outfile)) (compute-prefixes t) + read-symbol-shorthands local-outfile inhibit-autoloads) (with-temp-buffer (insert-file-contents file) @@ -399,7 +400,19 @@ don't include." (setq inhibit-autoloads (read (current-buffer))))) (save-excursion (when (re-search-forward "autoload-compute-prefixes: *" nil t) - (setq compute-prefixes (read (current-buffer)))))) + (setq compute-prefixes (read (current-buffer))))) + (save-excursion + ;; since we're "open-coding" we have to repeat more + ;; complicated logic in `hack-local-variables'. + (when (re-search-forward "read-symbol-shorthands: *" nil t) + (let* ((commentless (replace-regexp-in-string + "\n\\s-*;+" "" + (buffer-substring (point) (point-max)))) + (unsorted-shorthands (car (read-from-string commentless)))) + (setq read-symbol-shorthands + (sort unsorted-shorthands + (lambda (sh1 sh2) + (> (length (car sh1)) (length (car sh2)))))))))) ;; We always return the package version (even for pre-dumped ;; files). -- cgit v1.2.3 From 817140a852e79c5ef3cf7dc5e4c50aa710e8c4a2 Mon Sep 17 00:00:00 2001 From: João Távora Date: Thu, 30 Nov 2023 07:32:50 -0600 Subject: Fix prefix discovery for files with read-symbol-shorthands (bug#67325) In a previous commit, the local-variable read-symbol-shorthands is already read into the temporary buffer used for the autoload parsing aerobatics, so all we needed to do in 'l-g--compute-prefixes' is use 'read' to give 'read-symbol-shorthands' a chance to kick in. * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--compute-prefixes): --- lisp/emacs-lisp/loaddefs-gen.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index bf5cd24f161..8aacbf406b6 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -499,7 +499,11 @@ don't include." (while (re-search-forward "^(\\(def[^ \t\n]+\\)[ \t\n]+['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t) (unless (member (match-string 1) autoload-ignored-definitions) - (let ((name (match-string-no-properties 2))) + (let* ((name (match-string-no-properties 2)) + ;; Consider `read-symbol-shorthands'. + (probe (let ((obarray (obarray-make))) + (car (read-from-string name))))) + (setq name (symbol-name probe)) (when (save-excursion (goto-char (match-beginning 0)) (or (bobp) -- cgit v1.2.3 From 9a51fbb69fc9dc4aa415308889ae667ee65660d7 Mon Sep 17 00:00:00 2001 From: João Távora Date: Sat, 3 Feb 2024 08:27:27 -0600 Subject: ; Also consider shorthands in check-declare-scan (bug#67523) * lisp/emacs-lisp/check-declare.el (check-declare-scan): Also consider shorthands here. --- lisp/emacs-lisp/check-declare.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el index b4a7b4b33e6..a6d1a330d90 100644 --- a/lisp/emacs-lisp/check-declare.el +++ b/lisp/emacs-lisp/check-declare.el @@ -85,6 +85,9 @@ don't know how to recognize (e.g. some macros)." (let (alist) (with-temp-buffer (insert-file-contents file) + ;; Ensure shorthands available, as we will be `read'ing Elisp + ;; (bug#67523) + (let (enable-local-variables) (hack-local-variables)) ;; FIXME we could theoretically be inside a string. (while (re-search-forward "^[ \t]*\\((declare-function\\)[ \t\n]" nil t) (let ((pos (match-beginning 1))) @@ -147,6 +150,7 @@ is a string giving details of the error." (insert-file-contents fnfile) (unless cflag ;; If in Elisp, ensure syntax and shorthands available + ;; (bug#67523) (set-syntax-table emacs-lisp-mode-syntax-table) (let (enable-local-variables) (hack-local-variables))) ;; defsubst's don't _have_ to be known at compile time. -- cgit v1.2.3 From f266622cdb34044f364976796a4e7ac003d7a1b3 Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Sat, 3 Feb 2024 08:32:37 -0600 Subject: ; Optimize shorthand insertion in loaddefs-generate--parse-file * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--parse-file): Optimize. --- lisp/emacs-lisp/loaddefs-gen.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 8aacbf406b6..fe29469d08c 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -404,10 +404,13 @@ don't include." (save-excursion ;; since we're "open-coding" we have to repeat more ;; complicated logic in `hack-local-variables'. - (when (re-search-forward "read-symbol-shorthands: *" nil t) - (let* ((commentless (replace-regexp-in-string + (when-let ((beg + (re-search-forward "read-symbol-shorthands: *" nil t))) + ;; `read-symbol-shorthands' alist ends with two parens. + (let* ((end (re-search-forward ")[;\n\s]*)")) + (commentless (replace-regexp-in-string "\n\\s-*;+" "" - (buffer-substring (point) (point-max)))) + (buffer-substring beg end))) (unsorted-shorthands (car (read-from-string commentless)))) (setq read-symbol-shorthands (sort unsorted-shorthands -- cgit v1.2.3 From ecb69c8bd8c3dba205187c6296c8cac9b6a65121 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Feb 2024 18:05:55 +0200 Subject: ; Fix a comment in loaddefs-gen.el --- lisp/emacs-lisp/loaddefs-gen.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index fe29469d08c..7eced43e735 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -402,7 +402,7 @@ don't include." (when (re-search-forward "autoload-compute-prefixes: *" nil t) (setq compute-prefixes (read (current-buffer))))) (save-excursion - ;; since we're "open-coding" we have to repeat more + ;; Since we're "open-coding", we have to repeat more ;; complicated logic in `hack-local-variables'. (when-let ((beg (re-search-forward "read-symbol-shorthands: *" nil t))) -- cgit v1.2.3 From 8fc7e8c2b0cb33b0e8e9822f116e6dbb530ab1b6 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Feb 2024 18:09:35 +0200 Subject: ; * lisp/files.el (hack-local-variables--find-variables): Fix comment. --- lisp/files.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/files.el b/lisp/files.el index 172237ceb82..229771810fb 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4193,7 +4193,7 @@ major-mode." (or (buffer-file-name thisbuf) "")))))) ((eq var 'read-symbol-shorthands) ;; Sort automatically by shorthand length - ;; descending + ;; in descending order. (setq val (sort val (lambda (sh1 sh2) (> (length (car sh1)) (length (car sh2)))))) -- cgit v1.2.3 From d41cdceb133e30c71a95fe893d70645472b326e3 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 3 Feb 2024 16:07:24 -0500 Subject: textconv.c: Fix warnings with-wide-int * src/textconv.c (set_composing_region, textconv_set_point_and_mark): Use `min/max`. --- src/textconv.c | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/src/textconv.c b/src/textconv.c index 0d35ec19c55..0941848dd09 100644 --- a/src/textconv.c +++ b/src/textconv.c @@ -1705,11 +1705,8 @@ set_composing_region (struct frame *f, ptrdiff_t start, { struct text_conversion_action *action, **last; - if (start > MOST_POSITIVE_FIXNUM) - start = MOST_POSITIVE_FIXNUM; - - if (end > MOST_POSITIVE_FIXNUM) - end = MOST_POSITIVE_FIXNUM; + start = min (start, MOST_POSITIVE_FIXNUM); + end = min (end, MOST_POSITIVE_FIXNUM); action = xmalloc (sizeof *action); action->operation = TEXTCONV_SET_COMPOSING_REGION; @@ -1734,8 +1731,7 @@ textconv_set_point_and_mark (struct frame *f, ptrdiff_t point, { struct text_conversion_action *action, **last; - if (point > MOST_POSITIVE_FIXNUM) - point = MOST_POSITIVE_FIXNUM; + point = min (point, MOST_POSITIVE_FIXNUM); action = xmalloc (sizeof *action); action->operation = TEXTCONV_SET_POINT_AND_MARK; -- cgit v1.2.3 From b0049c942b8fa4093a02a9bb4ffc9c5da2261765 Mon Sep 17 00:00:00 2001 From: Richard M Stallman Date: Sat, 3 Feb 2024 17:47:02 -0500 Subject: bytecomp.el: Warn for `,' not within backquote construct (bytecomp--report-comma): New function with `compiler-macro' property. --- lisp/emacs-lisp/bytecomp.el | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 6e66771658e..5d2aa3355be 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5742,6 +5742,16 @@ and corresponding effects." (eval form) form))) +;; Report comma operator used outside of backquote. +;; Inside backquote, backquote will transform it before it gets here. + +(put '\, 'compiler-macro #'bytecomp--report-comma) +(defun bytecomp--report-comma (form &rest _ignore) + (macroexp-warn-and-return + (format-message "`%s' called -- perhaps used not within backquote" + (car form)) + form (list 'suspicious (car form)) t)) + ;; Check for (in)comparable constant values in calls to `eq', `memq' etc. (defun bytecomp--dodgy-eq-arg-p (x number-ok) -- cgit v1.2.3 From ecf3488477c6a4382737b97698443fdf26db8bd1 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 3 Feb 2024 18:22:05 -0500 Subject: * doc/emacs/buffers.texi (List Buffers): Update example --- doc/emacs/buffers.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi index d9113a6811a..00160afd844 100644 --- a/doc/emacs/buffers.texi +++ b/doc/emacs/buffers.texi @@ -205,7 +205,7 @@ Here is an example of a buffer list: @smallexample CRM Buffer Size Mode File -. * .emacs 3294 Emacs-Lisp ~/.emacs +. * .emacs 3294 ELisp/l ~/.emacs % *Help* 101 Help search.c 86055 C ~/cvs/emacs/src/search.c % src 20959 Dired by name ~/cvs/emacs/src/ -- cgit v1.2.3 From 4ebded3f5ee8617ac6b1debaa01706cd78206f39 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 3 Feb 2024 18:22:41 -0500 Subject: * lisp/emacs-lisp/easy-mmode.el (easy-mmode--mode-docstring): Add comment --- lisp/emacs-lisp/easy-mmode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 05b23a86fc0..4fa05008dd8 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -132,7 +132,7 @@ it is disabled.") (string-replace "'" "\\='" (format "%S" getter))))) (let ((start (point))) (insert argdoc) - (when (fboundp 'fill-region) + (when (fboundp 'fill-region) ;Don't break bootstrap! (fill-region start (point) 'left t)))) ;; Finally, insert the keymap. (when (and (boundp keymap-sym) -- cgit v1.2.3 From 45125e019c3698ff74ccb2183b789c25f9d3f574 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 3 Feb 2024 23:05:03 -0500 Subject: tramp: Tweak the ls-lisp declarations * lisp/net/tramp-sh.el (ls-lisp-use-insert-directory-program): Don't declare its existence... (tramp-sh-handle-insert-directory): ...test it instead. * lisp/net/tramp.el (ls-lisp-dirs-first, ls-lisp-emulation) (ls-lisp-ignore-case, ls-lisp-use-insert-directory-program) (ls-lisp-verbosity): Move declaration... (tramp-handle-insert-directory): ...to the point where we have a good reason to think these variables exist. --- lisp/net/tramp-sh.el | 3 +-- lisp/net/tramp.el | 10 +++++----- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 6bb1d976ec5..7656da81dcc 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -38,7 +38,6 @@ (declare-function dired-compress-file "dired-aux") (declare-function dired-remove-file "dired-aux") (defvar dired-compress-file-suffixes) -(defvar ls-lisp-use-insert-directory-program) ;; Added in Emacs 28.1. (defvar process-file-return-signal-string) (defvar vc-handled-backends) @@ -2636,7 +2635,7 @@ The method used must be an out-of-band method." (defun tramp-sh-handle-insert-directory (filename switches &optional wildcard full-directory-p) "Like `insert-directory' for Tramp files." - (if (and (featurep 'ls-lisp) + (if (and (boundp 'ls-lisp-use-insert-directory-program) (not ls-lisp-use-insert-directory-program)) (tramp-handle-insert-directory filename switches wildcard full-directory-p) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 74d95757e46..7800efc2a5e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -67,11 +67,6 @@ (declare-function file-notify-rm-watch "filenotify") (declare-function netrc-parse "netrc") (defvar auto-save-file-name-transforms) -(defvar ls-lisp-dirs-first) -(defvar ls-lisp-emulation) -(defvar ls-lisp-ignore-case) -(defvar ls-lisp-use-insert-directory-program) -(defvar ls-lisp-verbosity) (defvar tramp-prefix-format) (defvar tramp-prefix-regexp) (defvar tramp-method-regexp) @@ -4189,6 +4184,11 @@ Let-bind it when necessary.") (filename switches &optional wildcard full-directory-p) "Like `insert-directory' for Tramp files." (require 'ls-lisp) + (defvar ls-lisp-dirs-first) + (defvar ls-lisp-emulation) + (defvar ls-lisp-ignore-case) + (defvar ls-lisp-use-insert-directory-program) + (defvar ls-lisp-verbosity) (unless switches (setq switches "")) ;; Mark trailing "/". (when (and (directory-name-p filename) -- cgit v1.2.3 From dd81e767b7782c275af4221fe258fa3d2948724a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 4 Feb 2024 11:45:15 +0200 Subject: Fix display of invisible text with opposite directionality * src/xdisp.c (handle_invisible_prop): Skip invisible text correctly when it starts at position whose resolved bidi level is above the base paragraph level. (Bug#68446) --- src/xdisp.c | 191 +++++++++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 158 insertions(+), 33 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 4ff689b2df7..40311ee8ea7 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -5062,31 +5062,169 @@ handle_invisible_prop (struct it *it) { enum prop_handled handled = HANDLED_NORMALLY; int invis; - Lisp_Object prop; + ptrdiff_t curpos, endpos; + Lisp_Object prop, pos, overlay; + /* Get the value of the invisible text property at the current + position. Value will be nil if there is no such property. */ if (STRINGP (it->string)) { - Lisp_Object end_charpos, limit; + curpos = IT_STRING_CHARPOS (*it); + endpos = SCHARS (it->string); + pos = make_fixnum (curpos); + prop = Fget_text_property (pos, Qinvisible, it->string); + } + else /* buffer */ + { + curpos = IT_CHARPOS (*it); + endpos = ZV; + pos = make_fixnum (curpos); + prop = get_char_property_and_overlay (pos, Qinvisible, it->window, + &overlay); + } - /* Get the value of the invisible text property at the - current position. Value will be nil if there is no such - property. */ - end_charpos = make_fixnum (IT_STRING_CHARPOS (*it)); - prop = Fget_text_property (end_charpos, Qinvisible, it->string); - invis = TEXT_PROP_MEANS_INVISIBLE (prop); + /* Do we have anything to do here? */ + invis = TEXT_PROP_MEANS_INVISIBLE (prop); + if (invis == 0 || curpos >= it->end_charpos) + return handled; - if (invis != 0 && IT_STRING_CHARPOS (*it) < it->end_charpos) + /* If not bidi, or the bidi iteration is at base paragraph level, we + can use a faster method; otherwise we need to check invisibility + of every character while bidi-iterating out of invisible text. */ + bool slow = it->bidi_p && !BIDI_AT_BASE_LEVEL (it->bidi_it); + /* Record whether we have to display an ellipsis for the + invisible text. */ + bool display_ellipsis_p = (invis == 2); + + handled = HANDLED_RECOMPUTE_PROPS; + + if (slow) + { + if (it->bidi_it.first_elt && it->bidi_it.charpos < endpos) + bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, true); + + if (STRINGP (it->string)) { - /* Record whether we have to display an ellipsis for the - invisible text. */ - bool display_ellipsis_p = (invis == 2); - ptrdiff_t len, endpos; + bool done = false; + /* Bidi-iterate out of the invisible part of the string. */ + do + { + bidi_move_to_visually_next (&it->bidi_it); + if (it->bidi_it.charpos < 0 || it->bidi_it.charpos >= endpos) + done = true; + else + { + pos = make_fixnum (it->bidi_it.charpos); + prop = Fget_text_property (pos, Qinvisible, it->string); + invis = TEXT_PROP_MEANS_INVISIBLE (prop); + /* If there are adjacent invisible texts, don't lose + the second one's ellipsis. */ + if (invis == 2) + display_ellipsis_p = true; + } + } + while (!done && invis != 0); + + if (display_ellipsis_p) + it->ellipsis_p = true; + IT_STRING_CHARPOS (*it) = it->bidi_it.charpos; + IT_STRING_BYTEPOS (*it) = it->bidi_it.bytepos; + if (IT_STRING_BYTEPOS (*it) >= endpos) + { + /* The rest of the string is invisible. If this is an + overlay string, proceed with the next overlay string + or whatever comes and return a character from there. */ + if (it->current.overlay_string_index >= 0 + && !display_ellipsis_p) + { + next_overlay_string (it); + /* Don't check for overlay strings when we just + finished processing them. */ + handled = HANDLED_OVERLAY_STRING_CONSUMED; + } + } + } + else + { + bool done = false; + /* Bidi-iterate out of the invisible text. */ + do + { + bidi_move_to_visually_next (&it->bidi_it); + if (it->bidi_it.charpos < BEGV || it->bidi_it.charpos >= endpos) + done = true; + else + { + pos = make_fixnum (it->bidi_it.charpos); + prop = Fget_char_property (pos, Qinvisible, it->window); + invis = TEXT_PROP_MEANS_INVISIBLE (prop); + /* If there are adjacent invisible texts, don't lose + the second one's ellipsis. */ + if (invis == 2) + display_ellipsis_p = true; + } + } + while (!done && invis != 0); + + IT_CHARPOS (*it) = it->bidi_it.charpos; + IT_BYTEPOS (*it) = it->bidi_it.bytepos; + if (display_ellipsis_p) + { + /* Make sure that the glyphs of the ellipsis will get + correct `charpos' values. See below for detailed + explanation why this is needed. */ + it->position.charpos = IT_CHARPOS (*it) - 1; + it->position.bytepos = CHAR_TO_BYTE (it->position.charpos); + } + /* If there are before-strings at the start of invisible + text, and the text is invisible because of a text + property, arrange to show before-strings because 20.x did + it that way. (If the text is invisible because of an + overlay property instead of a text property, this is + already handled in the overlay code.) */ + if (NILP (overlay) + && get_overlay_strings (it, it->stop_charpos)) + { + handled = HANDLED_RECOMPUTE_PROPS; + if (it->sp > 0) + { + it->stack[it->sp - 1].display_ellipsis_p = display_ellipsis_p; + /* The call to get_overlay_strings above recomputes + it->stop_charpos, but it only considers changes + in properties and overlays beyond iterator's + current position. This causes us to miss changes + that happen exactly where the invisible property + ended. So we play it safe here and force the + iterator to check for potential stop positions + immediately after the invisible text. Note that + if get_overlay_strings returns true, it + normally also pushed the iterator stack, so we + need to update the stop position in the slot + below the current one. */ + it->stack[it->sp - 1].stop_charpos + = CHARPOS (it->stack[it->sp - 1].current.pos); + } + } + else if (display_ellipsis_p) + { + it->ellipsis_p = true; + /* Let the ellipsis display before + considering any properties of the following char. + Fixes jasonr@gnu.org 01 Oct 07 bug. */ + handled = HANDLED_RETURN; + } + } + } + else if (STRINGP (it->string)) + { + Lisp_Object end_charpos = pos, limit; - handled = HANDLED_RECOMPUTE_PROPS; + if (invis != 0 && IT_STRING_CHARPOS (*it) < it->end_charpos) + { + ptrdiff_t len = endpos; /* Get the position at which the next visible text can be found in IT->string, if any. */ - endpos = len = SCHARS (it->string); XSETINT (limit, len); do { @@ -5137,7 +5275,7 @@ handle_invisible_prop (struct it *it) IT_STRING_CHARPOS (*it) = it->bidi_it.charpos; IT_STRING_BYTEPOS (*it) = it->bidi_it.bytepos; - if (IT_CHARPOS (*it) >= endpos) + if (IT_STRING_CHARPOS (*it) >= endpos) it->prev_stop = endpos; } else @@ -5167,27 +5305,14 @@ handle_invisible_prop (struct it *it) } } } - else + else /* we are iterating over buffer text at base paragraph level */ { - ptrdiff_t newpos, next_stop, start_charpos, tem; - Lisp_Object pos, overlay; - - /* First of all, is there invisible text at this position? */ - tem = start_charpos = IT_CHARPOS (*it); - pos = make_fixnum (tem); - prop = get_char_property_and_overlay (pos, Qinvisible, it->window, - &overlay); - invis = TEXT_PROP_MEANS_INVISIBLE (prop); + ptrdiff_t newpos, next_stop, tem = curpos; + Lisp_Object pos; /* If we are on invisible text, skip over it. */ - if (invis != 0 && start_charpos < it->end_charpos) + if (invis != 0 && curpos < it->end_charpos) { - /* Record whether we have to display an ellipsis for the - invisible text. */ - bool display_ellipsis_p = invis == 2; - - handled = HANDLED_RECOMPUTE_PROPS; - /* Loop skipping over invisible text. The loop is left at ZV or with IT on the first char being visible again. */ do -- cgit v1.2.3 From fc8b09484a2fbe182a0351c47afc3bf71f3b2a1b Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 4 Feb 2024 09:48:04 +0100 Subject: ; Fix typos --- ChangeLog.3 | 4 ++-- admin/codespell/codespell.exclude | 2 ++ lisp/erc/erc-common.el | 2 +- lisp/erc/erc.el | 2 +- lisp/eshell/esh-arg.el | 2 +- lisp/forms.el | 2 +- lisp/progmodes/eglot.el | 2 +- src/fns.c | 2 +- 8 files changed, 10 insertions(+), 8 deletions(-) diff --git a/ChangeLog.3 b/ChangeLog.3 index dc712df43ad..7db4986410d 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -137530,7 +137530,7 @@ Bind `enable-local-variables' in `hack-connection-local-variables' * lisp/files-x.el (hack-connection-local-variables): - Bind `enable-local-variables', instead of re-declaring + Bind `enable-local-variables', instead of redeclaring `safe-local-variable-p'. 2019-03-23 Eli Zaretskii @@ -163179,7 +163179,7 @@ Quieten compilation of octave.el - * lisp/progmodes/octave.el (compilation-forget-errors): Re-declare. + * lisp/progmodes/octave.el (compilation-forget-errors): Redeclare. 2018-02-28 Glenn Morris diff --git a/admin/codespell/codespell.exclude b/admin/codespell/codespell.exclude index 416d79cf131..6413a73701b 100644 --- a/admin/codespell/codespell.exclude +++ b/admin/codespell/codespell.exclude @@ -1583,3 +1583,5 @@ VERY VERY LONG STRIN | VERY VERY LONG STRIN (ert-info ("Joined by bouncer to #chan@foonet, pal persent") (ert-info ("Joined by bouncer to #chan@barnet, pal persent") .UE . + (0.03 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: See, by good hap, yonder's my lord; I have sweat to see his honour.") + (0.05 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: But, in defence, by mercy, 'tis most just.") diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index abcdc4c8843..8388efe062c 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -171,7 +171,7 @@ Derived from the advertised \"PREFIX\" ISUPPORT parameter." ;; After dropping 28, we can use prefixed "erc-autoload" cookies. (defun erc--normalize-module-symbol (symbol) - "Return preferred SYMBOL for `erc--modules'." + "Return preferred SYMBOL for `erc--module'." (while-let ((canonical (get symbol 'erc--module)) ((not (eq canonical symbol)))) (setq symbol canonical)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index ef047201251..08dfa4b8f1b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6815,7 +6815,7 @@ stand-in from the fallback value \"(qaohv)~&@%+\"." "Return numeric rank for CHAR or nil if unknown. For example, given letters \"qaohv\" return 1 for ?v, 2 for ?h, and 4 for ?o, etc. If given, expect PARSED-PREFIX to be a -`erc--parse-prefix' object. With FROM-PREFIX-P, expect CHAR to +`erc--parsed-prefix' object. With FROM-PREFIX-P, expect CHAR to be a prefix instead." (and-let* ((obj (or parsed-prefix (erc--parsed-prefix))) (pos (erc--strpos char (if from-prefix-p diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 97ddac58629..78cf28d785a 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -285,7 +285,7 @@ QUOTED is passed to `eshell-concat' (which see) and, if non-nil, allows values to be converted to numbers where appropriate. ARGS should be a list of lists of arguments, such as that -produced by `eshell-prepare-slice'. \"Adjacent\" values of +produced by `eshell-prepare-splice'. \"Adjacent\" values of consecutive arguments will be passed to `eshell-concat'. For example, if ARGS is diff --git a/lisp/forms.el b/lisp/forms.el index 009667af273..3a3160a0c8b 100644 --- a/lisp/forms.el +++ b/lisp/forms.el @@ -343,7 +343,7 @@ suitable for forms processing.") (defvar forms-write-file-filter nil "The name of a function that is called before writing the data file. -This can be used to undo the effects of `form-read-file-filter'.") +This can be used to undo the effects of `forms-read-file-filter'.") (defvar forms-new-record-filter nil "The name of a function that is called when a new record is created.") diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index df8a287b4f2..2f32a8e6eda 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -591,7 +591,7 @@ It is nil if Eglot is not byte-complied.") (let ((vec (copy-sequence url-path-allowed-chars))) (aset vec ?: nil) ;; see github#639 vec) - "Like `url-path-allows-chars' but more restrictive.") + "Like `url-path-allowed-chars' but more restrictive.") ;;; Message verification helpers diff --git a/src/fns.c b/src/fns.c index 1262e3e749e..08908d481a3 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5374,7 +5374,7 @@ mark_fns (void) } } -/* Find the hash_table_test object correponding to the (bare) symbol TEST, +/* Find the hash_table_test object corresponding to the (bare) symbol TEST, creating one if none existed. */ static struct hash_table_test * get_hash_table_user_test (Lisp_Object test) -- cgit v1.2.3 From 56d0fbd99a87858717e08488df57db7fc08a2891 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 4 Feb 2024 10:28:18 +0100 Subject: Add alias progress-reporter-make * lisp/subr.el (progress-reporter-make): New alias for 'make-progress-reporter'. --- lisp/subr.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index a97824965b5..582415a9761 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1,7 +1,6 @@ ;;; subr.el --- basic lisp subroutines for Emacs -*- lexical-binding:t -*- -;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2024 Free Software -;; Foundation, Inc. +;; Copyright (C) 1985-2024 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal @@ -6736,6 +6735,8 @@ effectively rounded up." (progress-reporter-update reporter (or current-value min-value)) reporter)) +(defalias 'progress-reporter-make #'make-progress-reporter) + (defun progress-reporter-force-update (reporter &optional value new-message suffix) "Report progress of an operation in the echo area unconditionally. -- cgit v1.2.3 From 9bbf8232dba746db90b90285e9e4ed6d299d251a Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 4 Feb 2024 10:28:40 +0100 Subject: Delete compat code in `url` library * lisp/url/url-cid.el (url-cid): Delete compat code for ancient Gnus. * lisp/url/url-ldap.el (url-ldap-certificate-formatter): Delete compat code; ssl.el has never been in Emacs. * lisp/url/url-mailto.el (url-mail): Make into alias for 'message-mail', since it is always fboundp. --- lisp/url/url-cid.el | 11 +++-------- lisp/url/url-ldap.el | 10 +++------- lisp/url/url-mailto.el | 17 ++++------------- 3 files changed, 10 insertions(+), 28 deletions(-) diff --git a/lisp/url/url-cid.el b/lisp/url/url-cid.el index 17a0318e652..d80037f8fe9 100644 --- a/lisp/url/url-cid.el +++ b/lisp/url/url-cid.el @@ -1,6 +1,6 @@ ;;; url-cid.el --- Content-ID URL loader -*- lexical-binding: t; -*- -;; Copyright (C) 1998-1999, 2004-2024 Free Software Foundation, Inc. +;; Copyright (C) 1998-2024 Free Software Foundation, Inc. ;; Keywords: comm, data, processes @@ -52,12 +52,7 @@ ;;;###autoload (defun url-cid (url) - (cond - ((fboundp 'mm-get-content-id) - ;; Using Pterodactyl Gnus or later - (with-current-buffer (generate-new-buffer " *url-cid*") - (url-cid-gnus (url-filename url)))) - (t - (message "Unable to handle CID URL: %s" url)))) + (with-current-buffer (generate-new-buffer " *url-cid*") + (url-cid-gnus (url-filename url)))) ;;; url-cid.el ends here diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el index 1bdd5099637..6aaea606c27 100644 --- a/lisp/url/url-ldap.el +++ b/lisp/url/url-ldap.el @@ -1,6 +1,6 @@ ;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code -*- lexical-binding: t; -*- -;; Copyright (C) 1998-1999, 2004-2024 Free Software Foundation, Inc. +;; Copyright (C) 1998-2024 Free Software Foundation, Inc. ;; Keywords: comm, data, processes @@ -92,12 +92,8 @@ "'>" dn "")) (defun url-ldap-certificate-formatter (data) - (condition-case () - (require 'ssl) - (error nil)) - (let ((vals (if (fboundp 'ssl-certificate-information) - (ssl-certificate-information data) - (tls-certificate-information data)))) + ;; FIXME: tls.el is obsolete. + (let ((vals (tls-certificate-information data))) (if (not vals) "Unable to parse certificate" (concat "\n" diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el index c2d347a1646..50293ab3f05 100644 --- a/lisp/url/url-mailto.el +++ b/lisp/url/url-mailto.el @@ -1,6 +1,6 @@ ;;; url-mailto.el --- Mail Uniform Resource Locator retrieval code -*- lexical-binding: t; -*- -;; Copyright (C) 1996-1999, 2004-2024 Free Software Foundation, Inc. +;; Copyright (C) 1996-2024 Free Software Foundation, Inc. ;; Keywords: comm, data, processes @@ -28,12 +28,7 @@ (require 'url-util) ;;;###autoload -(defun url-mail (&rest args) - (interactive "P") - (if (fboundp 'message-mail) - (apply 'message-mail args) - (or (apply 'mail args) - (error "Mail aborted")))) +(defalias 'url-mail #'message-mail) (defun url-mail-goto-field (field) (if (not field) @@ -57,8 +52,6 @@ (save-excursion (insert "\n")))))) -(declare-function mail-send-and-exit "sendmail") - ;;;###autoload (defun url-mailto (url) "Handle the mailto: URL syntax." @@ -111,8 +104,6 @@ ;; (setq func (intern-soft (concat "mail-" (caar args)))) (insert (mapconcat 'identity (cdar args) ", "))) (setq args (cdr args))) - ;; (url-mail-goto-field "User-Agent") -;; (insert url-package-name "/" url-package-version " URL/" url-version) (if (not url-request-data) (progn (set-buffer-modified-p nil) @@ -128,8 +119,8 @@ (goto-char (point-max)) (insert url-request-data) ;; It seems Microsoft-ish to send without warning. - ;; Fixme: presumably this should depend on a privacy setting. - (if (y-or-n-p "Send this auto-generated mail? ") + ;; FIXME: presumably this should depend on a privacy setting. + (if (y-or-n-p "Send this auto-generated mail?") (let ((buffer (current-buffer))) (cond ((eq url-mail-command 'compose-mail) (funcall (get mail-user-agent 'sendfunc) nil)) -- cgit v1.2.3 From e44b9f35793d642d5155fde035e3bc92102d13a1 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 4 Feb 2024 11:26:43 +0100 Subject: * lisp/speedbar.el (imenu): Require unconditionally. --- lisp/speedbar.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 1cb72dc23e6..2ed97986fe7 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -3488,7 +3488,7 @@ functions to do caching and flushing if appropriate." nil -(eval-when-compile (condition-case nil (require 'imenu) (error nil))) +(eval-when-compile (require 'imenu)) (declare-function imenu--make-index-alist "imenu" (&optional no-error)) (defun speedbar-fetch-dynamic-imenu (file) -- cgit v1.2.3 From 4d57187a248d3243dcc8b5da5d8365cb1b54a347 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 3 Feb 2024 16:46:59 +0100 Subject: Prevent cache of diff-mode buffers to grow without bounds Previously, these " *diff-syntax:..." buffers were never removed. Now we discard the least recently used half of them every hour. * lisp/vc/diff-mode.el (diff--cached-revision-buffers) (diff--cache-clean-interval, diff--cache-clean-timer, diff--cache-clean) (diff--cache-schedule-clean, diff--get-revision-properties): New. (diff-syntax-fontify-hunk): Use diff--get-revision-properties. --- lisp/vc/diff-mode.el | 69 ++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 53 insertions(+), 16 deletions(-) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 83d580d98dd..34a4b70691d 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2817,6 +2817,57 @@ and the position in MAX." (defvar-local diff--syntax-file-attributes nil) (put 'diff--syntax-file-attributes 'permanent-local t) +(defvar diff--cached-revision-buffers nil + "List of ((FILE . REVISION) . BUFFER) in MRU order.") + +(defvar diff--cache-clean-timer nil) +(defconst diff--cache-clean-interval 3600) ; seconds + +(defun diff--cache-clean () + "Discard the least recently used half of the cache." + (let ((n (/ (length diff--cached-revision-buffers) 2))) + (mapc #'kill-buffer (mapcar #'cdr (nthcdr n diff--cached-revision-buffers))) + (setq diff--cached-revision-buffers + (ntake n diff--cached-revision-buffers))) + (diff--cache-schedule-clean)) + +(defun diff--cache-schedule-clean () + (setq diff--cache-clean-timer + (and diff--cached-revision-buffers + (run-with-timer diff--cache-clean-interval nil + #'diff--cache-clean)))) + +(defun diff--get-revision-properties (file revision text line-nb) + "Get font-lock properties from FILE at REVISION for TEXT at LINE-NB." + (let* ((file-rev (cons file revision)) + (entry (assoc file-rev diff--cached-revision-buffers)) + (buffer (cdr entry))) + (if (buffer-live-p buffer) + (progn + ;; Don't re-initialize the buffer (which would throw + ;; away the previous fontification work). + (setq file nil) + (setq diff--cached-revision-buffers + (cons entry + (delq entry diff--cached-revision-buffers)))) + ;; Cache miss: create a new entry. + (setq buffer (get-buffer-create (format " *diff-syntax:%s.~%s~*" + file revision))) + (condition-case nil + (vc-find-revision-no-save file revision diff-vc-backend buffer) + (error + (kill-buffer buffer) + (setq buffer nil)) + (:success + (push (cons file-rev buffer) + diff--cached-revision-buffers)))) + (when diff--cache-clean-timer + (cancel-timer diff--cache-clean-timer)) + (diff--cache-schedule-clean) + (and buffer + (with-current-buffer buffer + (diff-syntax-fontify-props file text line-nb))))) + (defun diff-syntax-fontify-hunk (beg end old) "Highlight source language syntax in diff hunk between BEG and END. When OLD is non-nil, highlight the hunk from the old source." @@ -2867,22 +2918,8 @@ When OLD is non-nil, highlight the hunk from the old source." (insert-file-contents file) (setq diff--syntax-file-attributes attrs))) (diff-syntax-fontify-props file text line-nb))))) - ;; Get properties from a cached revision - (let* ((buffer-name (format " *diff-syntax:%s.~%s~*" - file revision)) - (buffer (get-buffer buffer-name))) - (if buffer - ;; Don't re-initialize the buffer (which would throw - ;; away the previous fontification work). - (setq file nil) - (setq buffer (ignore-errors - (vc-find-revision-no-save - file revision - diff-vc-backend - (get-buffer-create buffer-name))))) - (when buffer - (with-current-buffer buffer - (diff-syntax-fontify-props file text line-nb)))))))) + (diff--get-revision-properties file revision + text line-nb))))) (let ((file (car (diff-hunk-file-names old)))) (cond ((and file diff-default-directory -- cgit v1.2.3 From 70c10204f0025eac844a88b0ef85cfca44cff61c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 4 Feb 2024 13:16:59 +0100 Subject: Prefer setq-local in more places * lisp/erc/erc-compat.el (erc-set-write-file-functions): * lisp/obsolete/iswitchb.el (iswitchb-minibuffer-setup-hook) (iswitchb-minibuffer-setup): * lisp/obsolete/longlines.el (longlines-mode): * lisp/obsolete/rcompile.el (remote-compile): * lisp/progmodes/cperl-mode.el (cperl-file-style): * test/lisp/erc/erc-tests.el (erc-ring-previous-command): Prefer setq-local. --- lisp/erc/erc-compat.el | 2 +- lisp/obsolete/iswitchb.el | 4 ++-- lisp/obsolete/longlines.el | 14 +++++--------- lisp/obsolete/rcompile.el | 14 +++++++------- lisp/progmodes/cperl-mode.el | 2 +- test/lisp/erc/erc-tests.el | 2 +- 6 files changed, 17 insertions(+), 21 deletions(-) diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index dede833a93d..37fcdebbe7b 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -102,7 +102,7 @@ See `erc-encoding-coding-alist'." (defun erc-set-write-file-functions (new-val) (declare (obsolete nil "28.1")) - (set (make-local-variable 'write-file-functions) new-val)) + (setq-local 'write-file-functions new-val)) (defvar erc-emacs-build-time (if (or (stringp emacs-build-time) (not emacs-build-time)) diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el index 3f05b7fe7ac..d541dc085c6 100644 --- a/lisp/obsolete/iswitchb.el +++ b/lisp/obsolete/iswitchb.el @@ -370,7 +370,7 @@ See documentation of `walk-windows' for useful values." This hook is run during minibuffer setup if `iswitchb' is active. For instance: \(add-hook \\='iswitchb-minibuffer-setup-hook - \\='\(lambda () (set (make-local-variable \\='max-mini-window-height) 3))) + \\='\(lambda () (setq-local \\='max-mini-window-height 3))) will constrain the minibuffer to a maximum height of 3 lines when iswitchb is running." :type 'hook) @@ -1262,7 +1262,7 @@ Modified from `icomplete-completions'." "Set up minibuffer for `iswitchb-buffer'. Copied from `icomplete-minibuffer-setup-hook'." (when (iswitchb-entryfn-p) - (set (make-local-variable 'iswitchb-use-mycompletion) t) + (setq-local 'iswitchb-use-mycompletion t) (add-hook 'pre-command-hook #'iswitchb-pre-command nil t) (add-hook 'post-command-hook #'iswitchb-post-command nil t) (run-hooks 'iswitchb-minibuffer-setup-hook))) diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el index 6aa388805f2..e73e9e0c85b 100644 --- a/lisp/obsolete/longlines.el +++ b/lisp/obsolete/longlines.el @@ -116,17 +116,14 @@ newlines are indicated with a symbol." ;; Turn on longlines mode (progn (use-hard-newlines 1 'never) - (set (make-local-variable 'require-final-newline) nil) + (setq-local 'require-final-newline nil) (add-to-list 'buffer-file-format 'longlines) (add-hook 'change-major-mode-hook #'longlines-mode-off nil t) (add-hook 'before-revert-hook #'longlines-before-revert-hook nil t) (make-local-variable 'longlines-auto-wrap) - (set (make-local-variable 'isearch-search-fun-function) - #'longlines-search-function) - (set (make-local-variable 'replace-search-function) - #'longlines-search-forward) - (set (make-local-variable 'replace-re-search-function) - #'longlines-re-search-forward) + (setq-local 'isearch-search-fun-function #'longlines-search-function) + (setq-local 'replace-search-function #'longlines-search-forward) + (setq-local 'replace-re-search-function #'longlines-re-search-forward) (add-function :filter-return (local 'filter-buffer-substring-function) #'longlines-encode-string) (when longlines-wrap-follows-window-size @@ -136,8 +133,7 @@ newlines are indicated with a symbol." (window-width))) longlines-wrap-follows-window-size 2))) - (set (make-local-variable 'fill-column) - (- (window-width) dw))) + (setq-local 'fill-column (- (window-width) dw))) (add-hook 'window-configuration-change-hook #'longlines-window-change-function nil t)) (let ((buffer-undo-list t) diff --git a/lisp/obsolete/rcompile.el b/lisp/obsolete/rcompile.el index e0826475e32..877a143f6ad 100644 --- a/lisp/obsolete/rcompile.el +++ b/lisp/obsolete/rcompile.el @@ -169,12 +169,12 @@ See \\[compile]." ;; compilation-parse-errors will find referenced files by Tramp. (with-current-buffer next-error-last-buffer (when (fboundp 'tramp-make-tramp-file-name) - (set (make-local-variable 'comint-file-name-prefix) - (funcall - #'tramp-make-tramp-file-name - nil ;; method. - remote-compile-user - remote-compile-host - "")))))) + (setq-local 'comint-file-name-prefix + (funcall + #'tramp-make-tramp-file-name + nil ;; method. + remote-compile-user + remote-compile-host + "")))))) ;;; rcompile.el ends here diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 758a6e17f72..dc3b31c79ac 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6557,7 +6557,7 @@ and \"Whitesmith\"." (let ((option (car setting)) (value (cdr setting))) (set (make-local-variable option) value))) - (set (make-local-variable 'cperl-file-style) style)) + (setq-local 'cperl-file-style style)) (declare-function Info-find-node "info" (filename nodename &optional no-going-back strict-case diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 7890049a325..440b52fe106 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1278,7 +1278,7 @@ (setq erc-server-current-nick "tester") (setq-local erc-last-input-time 0) (should-not (local-variable-if-set-p 'erc-send-completed-hook)) - (set (make-local-variable 'erc-send-completed-hook) nil) ; skip t (globals) + (setq-local 'erc-send-completed-hook nil) ; skip t (globals) ;; Just in case erc-ring-mode is already on (setq-local erc--input-review-functions erc--input-review-functions) (add-hook 'erc--input-review-functions #'erc-add-to-input-ring) -- cgit v1.2.3 From a4587646fabf2b7f0cb19a7e0bee090f9106a73a Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 4 Feb 2024 13:20:15 +0100 Subject: ; Fix my last commit --- lisp/erc/erc-compat.el | 2 +- lisp/obsolete/iswitchb.el | 4 ++-- lisp/obsolete/longlines.el | 10 +++++----- lisp/obsolete/rcompile.el | 2 +- lisp/progmodes/cperl-mode.el | 2 +- test/lisp/erc/erc-tests.el | 2 +- 6 files changed, 11 insertions(+), 11 deletions(-) diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 37fcdebbe7b..9b8699f6949 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -102,7 +102,7 @@ See `erc-encoding-coding-alist'." (defun erc-set-write-file-functions (new-val) (declare (obsolete nil "28.1")) - (setq-local 'write-file-functions new-val)) + (setq-local write-file-functions new-val)) (defvar erc-emacs-build-time (if (or (stringp emacs-build-time) (not emacs-build-time)) diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el index d541dc085c6..e1ea9141f0d 100644 --- a/lisp/obsolete/iswitchb.el +++ b/lisp/obsolete/iswitchb.el @@ -370,7 +370,7 @@ See documentation of `walk-windows' for useful values." This hook is run during minibuffer setup if `iswitchb' is active. For instance: \(add-hook \\='iswitchb-minibuffer-setup-hook - \\='\(lambda () (setq-local \\='max-mini-window-height 3))) + \\='\(lambda () (setq-local max-mini-window-height 3))) will constrain the minibuffer to a maximum height of 3 lines when iswitchb is running." :type 'hook) @@ -1262,7 +1262,7 @@ Modified from `icomplete-completions'." "Set up minibuffer for `iswitchb-buffer'. Copied from `icomplete-minibuffer-setup-hook'." (when (iswitchb-entryfn-p) - (setq-local 'iswitchb-use-mycompletion t) + (setq-local iswitchb-use-mycompletion t) (add-hook 'pre-command-hook #'iswitchb-pre-command nil t) (add-hook 'post-command-hook #'iswitchb-post-command nil t) (run-hooks 'iswitchb-minibuffer-setup-hook))) diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el index e73e9e0c85b..f065bcaff26 100644 --- a/lisp/obsolete/longlines.el +++ b/lisp/obsolete/longlines.el @@ -116,14 +116,14 @@ newlines are indicated with a symbol." ;; Turn on longlines mode (progn (use-hard-newlines 1 'never) - (setq-local 'require-final-newline nil) + (setq-local require-final-newline nil) (add-to-list 'buffer-file-format 'longlines) (add-hook 'change-major-mode-hook #'longlines-mode-off nil t) (add-hook 'before-revert-hook #'longlines-before-revert-hook nil t) (make-local-variable 'longlines-auto-wrap) - (setq-local 'isearch-search-fun-function #'longlines-search-function) - (setq-local 'replace-search-function #'longlines-search-forward) - (setq-local 'replace-re-search-function #'longlines-re-search-forward) + (setq-local isearch-search-fun-function #'longlines-search-function) + (setq-local replace-search-function #'longlines-search-forward) + (setq-local replace-re-search-function #'longlines-re-search-forward) (add-function :filter-return (local 'filter-buffer-substring-function) #'longlines-encode-string) (when longlines-wrap-follows-window-size @@ -133,7 +133,7 @@ newlines are indicated with a symbol." (window-width))) longlines-wrap-follows-window-size 2))) - (setq-local 'fill-column (- (window-width) dw))) + (setq-local fill-column (- (window-width) dw))) (add-hook 'window-configuration-change-hook #'longlines-window-change-function nil t)) (let ((buffer-undo-list t) diff --git a/lisp/obsolete/rcompile.el b/lisp/obsolete/rcompile.el index 877a143f6ad..258b2b519d9 100644 --- a/lisp/obsolete/rcompile.el +++ b/lisp/obsolete/rcompile.el @@ -169,7 +169,7 @@ See \\[compile]." ;; compilation-parse-errors will find referenced files by Tramp. (with-current-buffer next-error-last-buffer (when (fboundp 'tramp-make-tramp-file-name) - (setq-local 'comint-file-name-prefix + (setq-local comint-file-name-prefix (funcall #'tramp-make-tramp-file-name nil ;; method. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index dc3b31c79ac..113eed64917 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6557,7 +6557,7 @@ and \"Whitesmith\"." (let ((option (car setting)) (value (cdr setting))) (set (make-local-variable option) value))) - (setq-local 'cperl-file-style style)) + (setq-local cperl-file-style style)) (declare-function Info-find-node "info" (filename nodename &optional no-going-back strict-case diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 440b52fe106..7d189d37929 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1278,7 +1278,7 @@ (setq erc-server-current-nick "tester") (setq-local erc-last-input-time 0) (should-not (local-variable-if-set-p 'erc-send-completed-hook)) - (setq-local 'erc-send-completed-hook nil) ; skip t (globals) + (setq-local erc-send-completed-hook nil) ; skip t (globals) ;; Just in case erc-ring-mode is already on (setq-local erc--input-review-functions erc--input-review-functions) (add-hook 'erc--input-review-functions #'erc-add-to-input-ring) -- cgit v1.2.3 From d0673ea0d42048c140f4e5c6db18f78a43303256 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 4 Feb 2024 16:11:20 +0200 Subject: ; * etc/PROBLEMS: Workaround for Windows key "stuck" (bug#68914). --- etc/PROBLEMS | 32 +++++++++++++++++++++++--------- 1 file changed, 23 insertions(+), 9 deletions(-) diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 1254f6a3bc9..60904408af8 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -476,6 +476,29 @@ You are probably using a shell that doesn't support job control, even though the system itself is capable of it. Either use a different shell, or set the variable 'cannot-suspend' to a non-nil value. +*** Emacs running on WSL receives stray characters as input. + +For example, you could see Emacs inserting 'z' characters even though +nothing is typed on the keyboard, and even if you unplug the keyboard. + +The reason is a bug in the WSL X server's handling of key-press and +key-repeat events. A workaround is to use the Cygwin or native +MS-Windows build of Emacs instead. + +*** On MS-Windows, the Windows key gets "stuck". +When this problem happens, Windows behaves as if the Windows key were +permanently pressed down. This could be a side effect of Emacs on +MS-Windows hooking keyboard input on a low level, in order to support +registering the Windows keys as hot keys. If that hook takes too much +time for some reason, Windows can decide to remove the hook, which +then has this effect. + +This is arguably a bug in Emacs, for which we don't yet have a +solution. To work around, set the 'LowLevelHooksTimeout' value in the +registry key "HKEY_CURRENT_USER\Control Panel\Desktop" to a number +higher than 200 msec; the maximum allowed value is 1000 msec (create +the value if it doesn't exist under that key). + ** Mailers and other helper programs *** movemail compiled with POP support can't connect to the POP server. @@ -545,15 +568,6 @@ As a workaround, input the passphrase with a GUI-capable pinentry program like 'pinentry-gnome' or 'pinentry-qt5'. Alternatively, you can use the 'pinentry' package from Emacs 25. -*** Emacs running on WSL receives stray characters as input. - -For example, you could see Emacs inserting 'z' characters even though -nothing is typed on the keyboard, and even if you unplug the keyboard. - -The reason is a bug in the WSL X server's handling of key-press and -key-repeat events. A workaround is to use the Cygwin or native -MS-Windows build of Emacs instead. - ** Problems with hostname resolution *** Emacs does not know your host's fully-qualified domain name. -- cgit v1.2.3 From 4749699370370a6bf0d50612dafe871dbaf52924 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 4 Feb 2024 19:22:21 +0200 Subject: * doc/lispref/parsing.texi (Retrieving Nodes): Improve documentation. Update optional arguments 'predicate' and 'include-node' of 'treesit-node-top-level'. --- doc/lispref/parsing.texi | 25 ++++++++++++++----------- test/src/treesit-tests.el | 2 +- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 26204164243..fbd739b76d5 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -785,7 +785,7 @@ that comes after it in the buffer position order, i.e., nodes with start positions greater than the end position of @var{start}. In the tree shown above, @code{treesit-search-subtree} traverses node -@samp{S} (@var{start}) and nodes marked with @code{o}, where this +@samp{S} (@var{start}) and nodes marked with @code{o}, whereas this function traverses the nodes marked with numbers. This function is useful for answering questions like ``what is the first node after @var{start} in the buffer that satisfies some condition?'' @@ -860,32 +860,35 @@ nodes. @defun treesit-parent-until node predicate &optional include-node This function repeatedly finds the parents of @var{node}, and returns -the parent that satisfies @var{pred}, a function that takes a node as +the parent that satisfies @var{predicate}, a function that takes a node as argument and returns a boolean that indicates a match. If no parent -satisfies @var{pred}, this function returns @code{nil}. +satisfies @var{predicate}, this function returns @code{nil}. Normally this function only looks at the parents of @var{node} but not @var{node} itself. But if @var{include-node} is non-@code{nil}, this -function returns @var{node} if @var{node} satisfies @var{pred}. +function returns @var{node} if @var{node} satisfies @var{predicate}. @end defun -@defun treesit-parent-while node pred +@defun treesit-parent-while node predicate This function goes up the tree starting from @var{node}, and keeps -doing so as long as the nodes satisfy @var{pred}, a function that +doing so as long as the nodes satisfy @var{predicate}, a function that takes a node as argument. That is, this function returns the highest -parent of @var{node} that still satisfies @var{pred}. Note that if -@var{node} satisfies @var{pred} but its immediate parent doesn't, +parent of @var{node} that still satisfies @var{predicate}. Note that if +@var{node} satisfies @var{predicate} but its immediate parent doesn't, @var{node} itself is returned. @end defun -@defun treesit-node-top-level node &optional type +@defun treesit-node-top-level node &optional predicate include-node This function returns the highest parent of @var{node} that has the same type as @var{node}. If no such parent exists, it returns @code{nil}. Therefore this function is also useful for testing whether @var{node} is top-level. -If @var{type} is non-@code{nil}, this function matches each parent's -type with @var{type} as a regexp, rather than using @var{node}'s type. +If @var{predicate} is @code{nil}, this function uses @var{node}'s type +to find the parent. If @var{predicate} is non-@code{nil}, this +function searches the parent that satisfies @var{predicate}. If +@var{include-node} is non-@code{nil}, this function returns @var{node} +if @var{node} satisfies @var{predicate}. @end defun @node Accessing Node Information diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index 1cd783bd05e..3eda6fd3c53 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -243,7 +243,7 @@ (should (eq nil (treesit-node-text (treesit-search-subtree subarray "\\[")))) - ;; If ALL=nil, searching for number should still find the + ;; If ALL=t, searching for number should still find the ;; numbers. (should (equal "1" (treesit-node-text (treesit-search-subtree -- cgit v1.2.3 From 57024e1e9314501b103a4d36b9b166761a2ad756 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 4 Feb 2024 12:50:55 -0500 Subject: (w->base_line_number): Rework the way we flush the cache * src/xdisp.c (BASE_LINE_NUMBER_VALID_P): New macro. (try_scrolling): Use it. (redisplay_window, Fformat_mode_line): Use it to flush the base_line_number (if it's stale) once at the beginning. (decode_mode_spec): Don't use (or set) `w->start` and `w->base_line_number` when operating on another buffer! --- src/xdisp.c | 82 ++++++++++++++++++++++++++++++++++--------------------------- 1 file changed, 46 insertions(+), 36 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 40311ee8ea7..750ebb703a6 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -18861,6 +18861,14 @@ enum `scroll-conservatively' and the Emacs manual. */ #define SCROLL_LIMIT 100 +/* The freshness of the w->base_line_number cache is only ensured at every + redisplay cycle, so the cache can be used only if there's been + no relevant changes to the buffer since the last redisplay. */ +#define BASE_LINE_NUMBER_VALID_P(w) \ + (eassert (current_buffer == XBUFFER ((w)->contents)), \ + !current_buffer->clip_changed \ + && BEG_UNCHANGED >= (w)->base_line_pos) + static int try_scrolling (Lisp_Object window, bool just_this_one_p, intmax_t arg_scroll_conservatively, intmax_t scroll_step, @@ -19161,9 +19169,10 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, else { /* Maybe forget recorded base line for line number display. */ - if (!just_this_one_p - || current_buffer->clip_changed - || BEG_UNCHANGED < CHARPOS (startp)) + /* FIXME: Why do we need this? `try_scrolling` can only be called from + `redisplay_window` which should have flushed this cache already when + eeded. */ + if (!BASE_LINE_NUMBER_VALID_P (w)) w->base_line_number = 0; /* If cursor ends up on a partially visible line, @@ -19933,9 +19942,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) /* Record it now because it's overwritten. */ bool current_matrix_up_to_date_p = false; bool used_current_matrix_p = false; - /* This is less strict than current_matrix_up_to_date_p. - It indicates that the buffer contents and narrowing are unchanged. */ - bool buffer_unchanged_p = false; bool temp_scroll_step = false; specpdl_ref count = SPECPDL_INDEX (); int rc; @@ -20041,11 +20047,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) specbind (Qinhibit_point_motion_hooks, Qt); - buffer_unchanged_p - = (w->window_end_valid - && !current_buffer->clip_changed - && !window_outdated (w)); - /* When windows_or_buffers_changed is non-zero, we can't rely on the window end being valid, so set it to zero there. */ if (windows_or_buffers_changed) @@ -20185,6 +20186,10 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) } } + if (!BASE_LINE_NUMBER_VALID_P (w)) + /* Forget any recorded base line for line number display. */ + w->base_line_number = 0; + force_start: /* Handle case where place to start displaying has been specified, @@ -20205,10 +20210,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) w->preserve_vscroll_p = false; w->window_end_valid = false; - /* Forget any recorded base line for line number display. */ - if (!buffer_unchanged_p) - w->base_line_number = 0; - /* Redisplay the mode line. Select the buffer properly for that. Also, run the hook window-scroll-functions because we have scrolled. */ @@ -20537,12 +20538,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) if (w->cursor.vpos >= 0) { - if (!just_this_one_p - || current_buffer->clip_changed - || BEG_UNCHANGED < CHARPOS (startp)) - /* Forget any recorded base line for line number display. */ - w->base_line_number = 0; - if (!cursor_row_fully_visible_p (w, true, false, false)) { clear_glyph_matrix (w->desired_matrix); @@ -20613,10 +20608,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) debug_method_add (w, "recenter"); #endif - /* Forget any previously recorded base line for line number display. */ - if (!buffer_unchanged_p) - w->base_line_number = 0; - /* Determine the window start relative to point. */ init_iterator (&it, w, PT, PT_BYTE, NULL, DEFAULT_FACE_ID); it.current_y = it.last_visible_y; @@ -24783,6 +24774,13 @@ maybe_produce_line_number (struct it *it) if (!last_line) { /* If possible, reuse data cached by line-number-mode. */ + /* NOTE: We use `base_line_number` without checking + BASE_LINE_NUMBER_VALID_P because we assume that `redisplay_window` + has already flushed this cache for us when needed. + NOTE²: Checking BASE_LINE_NUMBER_VALID_P here would be + overly pessimistic because it might say that the cache + was invalid before entering `redisplay_window` yet the + value has just been refreshed. */ if (it->w->base_line_number > 0 && it->w->base_line_pos > 0 && it->w->base_line_pos <= IT_CHARPOS (*it) @@ -28175,6 +28173,11 @@ are the selected window and the WINDOW's buffer). */) init_iterator (&it, w, -1, -1, NULL, face_id); + /* Make sure `base_line_number` is fresh in case we encounter a `%l`. */ + if (current_buffer == XBUFFER ((w)->contents) + && !BASE_LINE_NUMBER_VALID_P (w)) + w->base_line_number = 0; + if (no_props) { mode_line_target = MODE_LINE_NOPROP; @@ -28627,30 +28630,29 @@ decode_mode_spec (struct window *w, register int c, int field_width, when the buffer's restriction was changed, but the window wasn't yet redisplayed after that. If that happens, we need to determine a new base line. */ - if (!(BUF_BEGV_BYTE (b) <= startpos_byte + if (current_buffer != XBUFFER (w->contents) + || !(BUF_BEGV_BYTE (b) <= startpos_byte && startpos_byte <= BUF_ZV_BYTE (b))) { startpos = BUF_BEGV (b); startpos_byte = BUF_BEGV_BYTE (b); - w->base_line_pos = 0; - w->base_line_number = 0; } /* If we decided that this buffer isn't suitable for line numbers, - don't forget that too fast. */ + don't forget that too fast. + FIXME: What if `current_buffer != w->contents`? */ if (w->base_line_pos == -1) goto no_value; /* If the buffer is very big, don't waste time. */ if (FIXNUMP (Vline_number_display_limit) && BUF_ZV (b) - BUF_BEGV (b) > XFIXNUM (Vline_number_display_limit)) - { - w->base_line_pos = 0; - w->base_line_number = 0; - goto no_value; - } + goto no_value; - if (w->base_line_number > 0 + /* Callers of `display_mode_element` are in charge of flushing + any stale `base_line_number` cache. */ + if (current_buffer == XBUFFER ((w)->contents) + && w->base_line_number > 0 && w->base_line_pos > 0 && w->base_line_pos <= startpos) { @@ -28676,7 +28678,9 @@ decode_mode_spec (struct window *w, register int c, int field_width, or too far away, or if we did not have one. "Too close" means it's plausible a scroll-down would go back past it. */ - if (startpos == BUF_BEGV (b)) + if (current_buffer != XBUFFER (w->contents)) + ; /* The base line is for another buffer, don't touch it! */ + else if (startpos == BUF_BEGV (b)) { w->base_line_number = topline; w->base_line_pos = BUF_BEGV (b); @@ -28713,6 +28717,12 @@ decode_mode_spec (struct window *w, register int c, int field_width, goto no_value; } + /* NOTE: if `clip_changed` is set or if `BEG_UNCHANGED` is + before `position`, this new cached value may get flushed + soon needlessly, because we can't reset `BEG_UNCHANGED` or + `clip_changed` from here (since they reflect the changes + since the last redisplay so they can only be reset from + `mark_window_display_accurate_1`). :-( */ w->base_line_number = topline - nlines; w->base_line_pos = BYTE_TO_CHAR (position); } -- cgit v1.2.3 From a1aa9028f83e5d3da71bdb5877d8baa5d6c1e98a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 4 Feb 2024 12:52:01 -0500 Subject: * src/window.c (set_window_buffer): Flush the `base_line_number` cache --- src/window.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/window.c b/src/window.c index 915f591221d..565ad00804f 100644 --- a/src/window.c +++ b/src/window.c @@ -4151,6 +4151,8 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, buffer); w->start_at_line_beg = false; w->force_start = false; + /* Flush the base_line cache since it applied to another buffer. */ + w->base_line_number = 0; } wset_redisplay (w); -- cgit v1.2.3 From 52abeaf1333427f156a23f0acf057e81bcc5e9e2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 4 Feb 2024 12:58:56 -0500 Subject: * src/lread.c (build_load_history): Be careful with in-place updates Don't leave a "broken" value in `Vcurrent_load_list`. --- src/lread.c | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/lread.c b/src/lread.c index cc55b009ab9..b1b109315f9 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2369,8 +2369,14 @@ build_load_history (Lisp_Object filename, bool entire) front of load-history, the most-recently-loaded position. Also do this if we didn't find an existing member for the file. */ if (entire || !foundit) - Vload_history = Fcons (Fnreverse (Vcurrent_load_list), - Vload_history); + { + Lisp_Object tem = Fnreverse (Vcurrent_load_list); + eassert (EQ (filename, Fcar (tem))); + Vload_history = Fcons (tem, Vload_history); + /* FIXME: There should be an unbind_to right after calling us which + should re-establish the previous value of Vcurrent_load_list. */ + Vcurrent_load_list = Qt; + } } static void -- cgit v1.2.3 From 7d3c3cad9392d3f8e59f85522053c249aff062e5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 4 Feb 2024 13:51:13 -0500 Subject: * src/lread.c (bytecode_from_rev_list): Fix assertion failure The assertion failure was raised at lread.c:411 during the `lread-invalid-bytecodes` test in `test/src/lread-tests.el`. I suspect we could remove the assertion instead. --- src/lread.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lread.c b/src/lread.c index b1b109315f9..b5eeb55bb70 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3496,7 +3496,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 (infile && size >= COMPILED_CONSTANTS) { /* Always read 'lazily-loaded' bytecode (generated by the `byte-compile-dynamic' feature prior to Emacs 30) eagerly, to -- cgit v1.2.3 From b2d350cfc0bf8f0e3198bffcebe60a43341fb340 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 4 Feb 2024 14:39:02 -0500 Subject: * lisp/emacs-lisp/comp.el (comp--native-compile): Use `error-message-string` --- lisp/emacs-lisp/comp.el | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 2a516246ed4..dcdc973e6c5 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3398,16 +3398,18 @@ the deferred compilation mechanism." (if (and comp-async-compilation (not (eq (car err) 'native-compiler-error))) (progn - (message (if err-val - "%s: Error: %s %s" - "%s: Error %s") + (message "%s: Error %s" function-or-file - (get (car err) 'error-message) - (car-safe err-val)) + (error-message-string err)) (kill-emacs -1)) ;; Otherwise re-signal it adding the compilation input. + ;; FIXME: We can't just insert arbitrary info in the + ;; error-data part of an error: the handler may expect + ;; specific data at specific positions! (signal (car err) (if (consp err-val) (cons function-or-file err-val) + ;; FIXME: `err-val' is supposed to be + ;; a list, so it can only be nil here! (list function-or-file err-val))))))) (if (stringp function-or-file) data -- cgit v1.2.3 From 9dbbf93a4a08f71cf5f2278ec2a22a722fe0e0f7 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sat, 3 Feb 2024 21:24:29 -0800 Subject: Improve treesit-forward-sexp behavior for leaf nodes (bug#68899) treesit-forward-sexp uses treesit--navigate-thing with 'restricted' tactic. In this tactic we don't move over the parent thing. However, this makes forward-sexp useless for symbols when point is in the symbol rather than at the beginning of it: in that case, the symbol is considered parent and treesit-forward-sexp won't move to the end of it. To solve that, we allow to move across the parent even in 'restricted' mode if the parent is a leaf thing. Here, "leaf thing" is defined as "doesn't have any child 'thing' inside it". * lisp/treesit.el (treesit--navigate-thing): Move over parent in 'restricted' tactic if the parent is a leaf thing. --- lisp/treesit.el | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/lisp/treesit.el b/lisp/treesit.el index fab2ddd88e6..93b6b56534d 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2662,9 +2662,17 @@ function is called recursively." (setq parent (treesit-node-top-level parent thing t) prev nil next nil)) - ;; If TACTIC is `restricted', the implementation is very simple. + ;; If TACTIC is `restricted', the implementation is simple. + ;; In principle we don't go to parent's beg/end for + ;; `restricted' tactic, but if the parent is a "leaf thing" + ;; (doesn't have any child "thing" inside it), then we can + ;; move to the beg/end of it (bug#68899). (if (eq tactic 'restricted) - (setq pos (funcall advance (if (> arg 0) next prev))) + (setq pos (funcall + advance + (cond ((and (null next) (null prev)) parent) + ((> arg 0) next) + (t prev)))) ;; For `nested', it's a bit more work: ;; Move... (if (> arg 0) -- cgit v1.2.3 From be6de56906f0d1c09a0fad4f5165d864dddbc3ee Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sun, 4 Feb 2024 19:26:42 -0800 Subject: Use treesit-node-match-p in treesit-parent-until/while * lisp/treesit.el (treesit-parent-until): Use treesit-node-match-p. (treesit-parent-while): Update docstring. * doc/lispref/parsing.texi (Retrieving Nodes): Update docstring. --- doc/lispref/parsing.texi | 17 ++++++++++------- lisp/treesit.el | 12 +++++------- 2 files changed, 15 insertions(+), 14 deletions(-) diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 5d79c4b27f4..ac11f88ae4d 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -916,8 +916,10 @@ nodes. @defun treesit-parent-until node predicate &optional include-node This function repeatedly finds the parents of @var{node}, and returns -the parent that satisfies @var{pred}, a function that takes a node as -argument and returns a boolean that indicates a match. If no parent +the parent that satisfies @var{pred}. @var{pred} can be either a +function that takes a node as argument and returns @code{t} or +@code{nil}, or a regexp matching node type names, or other valid +predicates described in @var{treesit-thing-settings}. If no parent satisfies @var{pred}, this function returns @code{nil}. Normally this function only looks at the parents of @var{node} but not @@ -927,11 +929,12 @@ function returns @var{node} if @var{node} satisfies @var{pred}. @defun treesit-parent-while node pred This function goes up the tree starting from @var{node}, and keeps -doing so as long as the nodes satisfy @var{pred}, a function that -takes a node as argument. That is, this function returns the highest -parent of @var{node} that still satisfies @var{pred}. Note that if -@var{node} satisfies @var{pred} but its immediate parent doesn't, -@var{node} itself is returned. +doing so as long as the nodes satisfy @var{pred}. That is, this +function returns the highest parent of @var{node} that still satisfies +@var{pred}. Note that if @var{node} satisfies @var{pred} but its +immediate parent doesn't, @var{node} itself is returned. + +@var{pred} is the same as in @code{treesit-parent-until} above. @end defun @defun treesit-node-top-level node &optional type diff --git a/lisp/treesit.el b/lisp/treesit.el index 93b6b56534d..f179204d89c 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -344,14 +344,13 @@ ancestor node which satisfies the predicate PRED; then it returns that ancestor node. It returns nil if no ancestor node was found that satisfies PRED. -PRED should be a function that takes one argument, the node to -examine, and returns a boolean value indicating whether that -node is a match. +PRED can be a predicate function, a regexp matching node type, +and more; see docstring of `treesit-thing-settings'. If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED." (let ((node (if include-node node (treesit-node-parent node)))) - (while (and node (not (funcall pred node))) + (while (and node (not (treesit-node-match-p node pred))) (setq node (treesit-node-parent node))) node)) @@ -364,9 +363,8 @@ no longer satisfies the predicate PRED; it returns the last examined node that satisfies PRED. If no node satisfies PRED, it returns nil. -PRED should be a function that takes one argument, the node to -examine, and returns a boolean value indicating whether that -node is a match." +PRED can be a predicate function, a regexp matching node type, +and more; see docstring of `treesit-thing-settings'." (let ((last nil)) (while (and node (funcall pred node)) (setq last node -- cgit v1.2.3 From 5c43ef86bf169a79b87bd082d2f884757f7c2efc Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Tue, 15 Aug 2023 18:51:20 -0700 Subject: Document arguments to Eshell's built-in commands * lisp/eshell/em-unix.el (eshell/ln): LINK_NAME is required. * lisp/eshell/esh-ext.el (eshell/addpath): * lisp/eshell/esh-var.el (eshell/env): Improve help strings slightly. * doc/misc/eshell.texi (Scripts): Explain $0, $1, etc. (Dollars Expansion): Use "@dots{}" instead of "...". (Built-ins, Tramp extensions, Extra built-in commands): Document command-line arguments. --- doc/misc/eshell.texi | 654 ++++++++++++++++++++++++++++++++++++------------- lisp/eshell/em-unix.el | 8 +- lisp/eshell/esh-ext.el | 6 +- lisp/eshell/esh-var.el | 2 +- 4 files changed, 497 insertions(+), 173 deletions(-) diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index da5e1ef1d03..5d3e5c7dbd6 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -481,72 +481,88 @@ loaded as part of the eshell-xtra module. @xref{Extension modules}. @table @code -@item . +@item . @var{file} [@var{argument}]@dots{} @cmindex . -Source an Eshell file in the current environment. This is not to be -confused with the command @command{source}, which sources a file in a -subshell environment. +Source an Eshell script named @var{file} in the current environment, +passing any @var{arguments} to the script (@pxref{Scripts}). This is +not to be confused with the command @command{source}, which sources a +file in a subshell environment. @item addpath +@itemx addpath [-b] @var{directory}@dots{} @cmindex addpath -Adds a given path or set of paths to the PATH environment variable, or, -with no arguments, prints the current paths in this variable. +Adds each specified @var{directory} to the @code{$PATH} environment +variable. By default, this adds the directories to the end of +@code{$PATH}, in the order they were passed on the command line; by +passing @code{-b} or @code{--begin}, Eshell will instead add the +directories to the beginning. + +With no directories, print the list of directories currently stored in +@code{$PATH}. @item alias +@itemx alias @var{name} [@var{command}] @cmindex alias -Define an alias (@pxref{Aliases}). This adds it to the aliases file. +Define an alias named @var{name} and expanding to @var{command}, +adding it to the aliases file (@pxref{Aliases}). If @var{command} is +omitted, delete the alias named @var{name}. With no arguments at all, +list all the currently-defined aliases. -@item basename +@item basename @var{filename} @cmindex basename -Return a file name without its directory. +Return @var{filename} without its directory. -@item cat +@item cat @var{file}@dots{} @cmindex cat -Concatenate file contents into standard output. If in a pipeline, or -if the file is not a regular file, directory, or symlink, then this -command reverts to the system's definition of @command{cat}. +Concatenate the contents of @var{file}s to standard output. If in a +pipeline, or if any of the files is not a regular file, directory, or +symlink, then this command reverts to the system's definition of +@command{cat}. @item cd +@itemx cd @var{directory} +@itemx cd -[@var{n}] +@itemx cd =[@var{regexp}] @cmindex cd -This command changes the current working directory. Usually, it is -invoked as @kbd{cd @var{dir}} where @file{@var{dir}} is the new -working directory. But @command{cd} knows about a few special -arguments: +Change the current working directory. This command can take several +forms: -@itemize @minus{} -@item -When it receives no argument at all, it changes to the home directory. +@table @code -@item -Giving the command @kbd{cd -} changes back to the previous working -directory (this is the same as @kbd{cd $-}). +@item cd +Change to the user's home directory. -@item -The command @kbd{cd =} shows the directory ring. Each line is -numbered. +@item cd @var{directory} +Change to the specified @var{directory}. -@item -With @kbd{cd =foo}, Eshell searches the directory ring for a directory -matching the regular expression @samp{foo}, and changes to that -directory. +@item cd - +Change back to the previous working directory (this is the same as +@kbd{cd $-}). -@item -With @kbd{cd -42}, you can access the directory stack slots by number. +@item cd -@var{n} +Change to the directory in the @var{nth} slot of the directory stack. + +@item cd = +Show the directory ring. Each line is numbered. + +@item cd =@var{regexp} +Search the directory ring for a directory matching the regular +expression @var{regexp} and change to that directory. + +@end table -@item @vindex eshell-cd-shows-directory @vindex eshell-list-files-after-cd If @code{eshell-cd-shows-directory} is non-@code{nil}, @command{cd} will report the directory it changes to. If @code{eshell-list-files-after-cd} is non-@code{nil}, then @command{ls} is called with any remaining arguments after changing directories. -@end itemize -@item clear +@item clear [@var{scrollback}] @cmindex clear Scrolls the contents of the Eshell window out of sight, leaving a -blank window. If provided with an optional non-@code{nil} argument, -the scrollback contents are cleared instead. +blank window. If @var{scrollback} is non-@code{nil}, the scrollback +contents are cleared instead, as with @command{clear-scrollback}. @item clear-scrollback @cmindex clear-scrollback @@ -554,21 +570,30 @@ Clear the scrollback contents of the Eshell window. Unlike the command @command{clear}, this command deletes content in the Eshell buffer. -@item compile +@item compile [-p | -i] [-m @var{mode-name}] @var{command}@dots{} @cmindex compile Run an external command, sending its output to a compilation buffer if the command would output to the screen and is not part of a pipeline -or subcommand. This is particularly useful when defining aliases, so +or subcommand. + +With the @code{-p} or @code{--plain} options, always send the output +to the Eshell buffer; similarly, with @code{-i} or +@code{--interactive}, always send the output to a compilation buffer. +You can also set the mode of the compilation buffer with @code{-m +@var{mode-name}} or @code{--mode @var{mode-name}}. + +@command{compile} is particularly useful when defining aliases, so that interactively, the output shows up in a compilation buffer, but you can still pipe the output elsewhere if desired. For example, if you have a grep-like command on your system, you might define an alias for it like so: @samp{alias mygrep 'compile --mode=grep-mode -- mygrep $*'}. -@item cp +@item cp [@var{option}@dots{}] @var{source} @var{dest} +@item cp [@var{option}@dots{}] @var{source}@dots{} @var{directory} @cmindex cp -Copy a file to a new location or copy multiple files to the same -directory. +Copy the file @var{source} to @var{dest} or @var{source} into +@var{directory}. @vindex eshell-cp-overwrite-files @vindex eshell-cp-interactive-query @@ -577,26 +602,59 @@ If @code{eshell-cp-overwrite-files} is non-@code{nil}, then @code{eshell-cp-interactive-query} is non-@code{nil}, then @command{cp} will ask before overwriting anything. -@item date +@command{cp} accepts the following options: + +@table @asis + +@item @code{-a}, @code{--archive} +Equivalent to @code{--no-dereference --preserve --recursive}. + +@item @code{-d}, @code{--no-dereference} +Don't dereference symbolic links when copying; instead, copy the link +itself. + +@item @code{-f}, @code{--force} +Never prompt for confirmation before copying a file. + +@item @code{-i}, @code{--interactive} +Prompt for confirmation before copying a file if the target already +exists. + +@item @code{-n}, @code{--preview} +Run the command, but don't copy anything. This is useful if you +want to preview what would be removed when calling @command{cp}. + +@item @code{-p}, @code{--preserve} +Attempt to preserve file attributes when copying. + +@item @code{-r}, @code{-R}, @code{--recursive} +Copy any specified directories and their contents recursively. + +@item @code{-v}, @code{--verbose} +Print the name of each file before copying it. + +@end table + +@item date [@var{specified-time} [@var{zone}]] @cmindex date Print the current local time as a human-readable string. This command -is similar to, but slightly different from, the GNU Coreutils -@command{date} command. +is an alias to the Emacs Lisp function @code{current-time-string} +(@pxref{Time of Day,,, elisp, GNU Emacs Lisp Reference Manual}). -@item diff +@item diff [@var{option}]@dots{} @var{old} @var{new} @cmindex diff -Compare files using Emacs's internal @code{diff} (not to be confused -with @code{ediff}). @xref{Comparing Files, , , emacs, The GNU Emacs -Manual}. +Compare the files @var{old} and @var{new} using Emacs's internal +@code{diff} (not to be confused with @code{ediff}). @xref{Comparing +Files, , , emacs, The GNU Emacs Manual}. @vindex eshell-plain-diff-behavior If @code{eshell-plain-diff-behavior} is non-@code{nil}, then this command does not use Emacs's internal @code{diff}. This is the same as using @samp{alias diff '*diff $@@*'}. -@item dirname +@item dirname @var{filename} @cmindex dirname -Return the directory component of a file name. +Return the directory component of @var{filename}. @item dirs @cmindex dirs @@ -604,25 +662,75 @@ Prints the directory stack. Directories can be added or removed from the stack using the commands @command{pushd} and @command{popd}, respectively. -@item du +@item du [@var{option}]@dots{} @var{file}@dots{} @cmindex du -Summarize disk usage for each file. +Summarize disk usage for each file, recursing into directories. + +@command{du} accepts the following options: + +@table @asis + +@item @code{-a}, @code{--all} +Print sizes for files, not just directories. -@item echo +@item @code{--block-size=@var{size}} +Print sizes as number of blocks of size @var{size}. + +@item @code{-b}, @code{--bytes} +Print file sizes in bytes. + +@item @code{-c}, @code{--total} +Print a grand total of the sizes at the end. + +@item @code{-d}, @code{--max-depth=@var{depth}} +Only print sizes for directories (or files with @code{--all}) that are +@var{depth} or fewer levels below the command line arguments. + +@item @code{-h}, @code{--human-readable} +Print sizes in human-readable format, with binary prefixes (so 1 KB is +1024 bytes). + +@item @code{-H}, @code{--si} +Print sizes in human-readable format, with decimal prefixes (so 1 KB +is 1000 bytes). + +@item @code{-k}, @code{--kilobytes} +Print file sizes in kilobytes (like @code{--block-size=1024}). + +@item @code{-L}, @code{--dereference} +Follow symbolic links when traversing files. + +@item @code{-m}, @code{--megabytes} +Print file sizes in megabytes (like @code{--block-size=1048576}). + +@item @code{-s}, @code{--summarize} +Don't recurse into subdirectories (like @code{--max-depth=0}). + +@item @code{-x}, @code{--one-file-system} +Skip any directories that reside on different filesystems. + +@end table + +@item echo [-n | -N] [@var{arg}]@dots{} @cmindex echo -Echoes its input. By default, this prints in a Lisp-friendly fashion -(so that the value is useful to a Lisp command using the result of -@command{echo} as an argument). If a single argument is passed, -@command{echo} prints that; if multiple arguments are passed, it -prints a list of all the arguments; otherwise, it prints the empty -string. +Prints the value of each @var{arg}. By default, this prints in a +Lisp-friendly fashion (so that the value is useful to a Lisp command +using the result of @command{echo} as an argument). If a single +argument is passed, @command{echo} prints that; if multiple arguments +are passed, it prints a list of all the arguments; otherwise, it +prints the empty string. @vindex eshell-plain-echo-behavior If @code{eshell-plain-echo-behavior} is non-@code{nil}, @command{echo} will try to behave more like a plain shell's @command{echo}, printing each argument as a string, separated by a space. -@item env +You can control whether @command{echo} outputs a trailing newline +using @code{-n} to disable the trailing newline (the default behavior) +or @code{-N} to enable it (the default when +@code{eshell-plain-echo-behavior} is non-@code{nil}). + +@item env [@var{var}=@var{value}]@dots{} [@var{command}]@dots{} @cmindex env With no arguments, print the current environment variables. If you pass arguments to this command, then @command{env} will execute the @@ -630,7 +738,7 @@ arguments as a command. If you pass any initial arguments of the form @samp{@var{var}=@var{value}}, @command{env} will first set @var{var} to @var{value} before running the command. -@item eshell-debug +@item eshell-debug [error | form | process]@dots{} @cmindex eshell-debug Toggle debugging information for Eshell itself. You can pass this command one or more of the following arguments: @@ -658,65 +766,86 @@ Exit Eshell and save the history. By default, this command kills the Eshell buffer, but if @code{eshell-kill-on-exit} is @code{nil}, then the buffer is merely buried instead. -@item export +@item export [@var{name}=@var{value}]@dots{} @cmindex export Set environment variables using input like Bash's @command{export}, as in @samp{export @var{var1}=@var{val1} @var{var2}=@var{val2} @dots{}}. -@item grep +@item grep [@var{arg}]@dots{} @cmindex grep -@itemx agrep +@itemx agrep [@var{arg}]@dots{} @cmindex agrep -@itemx egrep +@itemx egrep [@var{arg}]@dots{} @cmindex egrep -@itemx fgrep +@itemx fgrep [@var{arg}]@dots{} @cmindex fgrep -@itemx rgrep +@itemx rgrep [@var{arg}]@dots{} @cmindex rgrep -@itemx glimpse +@itemx glimpse [@var{arg}]@dots{} @cmindex glimpse The @command{grep} commands are compatible with GNU @command{grep}, -but use Emacs's internal @code{grep} instead. +but open a compilation buffer in @code{grep-mode} instead. @xref{Grep Searching, , , emacs, The GNU Emacs Manual}. @vindex eshell-plain-grep-behavior If @code{eshell-plain-grep-behavior} is non-@code{nil}, then these -commands do not use Emacs's internal @code{grep}. This is the same as -using @samp{alias grep '*grep $@@*'}, though this setting applies to -all of the built-in commands for which you would need to create a -separate alias. +commands do not use open a compilation buffer, instead printing output +to Eshell's buffer. This is the same as using @samp{alias grep '*grep +$@@*'}, though this setting applies to all of the built-in commands +for which you would need to create a separate alias. -@item history +@item history [@var{n}] +@itemx history [-arw] [@var{filename}] @cmindex history -Prints Eshell's input history. With a numeric argument @var{N}, this -command prints the @var{N} most recent items in the history. +Prints Eshell's input history. With a numeric argument @var{n}, this +command prints the @var{n} most recent items in the history. +Alternately, you can specify the following options: + +@table @asis + +@item @code{-a}, @code{--append} +Append new history items to the history file. -@item info +@item @code{-r}, @code{--read} +Read history items from the history file and append them to the +current shell's history. + +@item @code{-w}, @code{--write} +Write the current history list to the history file. + +@end table + +@item info [@var{manual} [@var{item}]@dots{}] @cmindex info -Browse the available Info documentation. This command is the same as -the external @command{info} command, but uses Emacs's internal Info -reader. -@xref{Misc Help, , , emacs, The GNU Emacs Manual}. +Browse the available Info documentation. With no arguments, browse +the top-level menu. Otherwise, show the manual for @var{manual}, +selecting the menu entry for @var{item}. + +This command is the same as the external @command{info} command, but +uses Emacs's internal Info reader. @xref{Misc Help, , , emacs, The +GNU Emacs Manual}. @item jobs @cmindex jobs List subprocesses of the Emacs process, if any, using the function @code{list-processes}. -@item kill +@item kill [-@var{signal}] [@var{pid} | @var{process}] @cmindex kill Kill processes. Takes a PID or a process object and an optional -signal specifier which can either be a number or a signal name. +@var{signal} specifier which can either be a number or a signal name. -@item listify +@item listify [@var{arg}]@dots{} @cmindex listify -Eshell version of @code{list}. Allows you to create a list using Eshell -syntax, rather than Elisp syntax. For example, @samp{listify foo bar} -and @code{("foo" "bar")} both evaluate to @code{("foo" "bar")}. +Return the arguments as a single list. With a single argument, return +it as-is if it's already a list, or otherwise wrap it in a list. With +multiple arguments, return a list of all of them. -@item ln +@item ln [@var{option}]@dots{} @var{target} [@var{link-name}] +@itemx ln [@var{option}]@dots{} @var{target}@dots{} @var{directory} @cmindex ln -Create links to files. +Create a link to the specified @var{target} named @var{link-name} or +create links to multiple @var{targets} in @var{directory}. @vindex eshell-ln-overwrite-files @vindex eshell-ln-interactive-query @@ -725,7 +854,30 @@ will overwrite files without warning. If @code{eshell-ln-interactive-query} is non-@code{nil}, then @command{ln} will ask before overwriting files. -@item locate +@command{ln} accepts the following options: + +@table @asis + +@item @code{-f}, @code{--force} +Never prompt for confirmation before linking a target. + +@item @code{-i}, @code{--interactive} +Prompt for confirmation before linking to an item if the source +already exists. + +@item @code{-n}, @code{--preview} +Run the command, but don't move anything. This is useful if you +want to preview what would be linked when calling @command{ln}. + +@item @code{-s}, @code{--symbolic} +Make symbolic links instead of hard links. + +@item @code{-v}, @code{--verbose} +Print the name of each file before linking it. + +@end table + +@item locate @var{arg}@dots{} @cmindex locate Alias to Emacs's @code{locate} function, which simply runs the external @command{locate} command and parses the results. @@ -736,51 +888,129 @@ If @code{eshell-plain-locate-behavior} is non-@code{nil}, then Emacs's internal @code{locate} is not used. This is the same as using @samp{alias locate '*locate $@@*'}. -@item ls +@item ls [@var{option}]@dots{} [@var{file}]@dots{} @cmindex ls -Lists the contents of directories. +List information about each @var{file}, including the contents of any +specified directories. If @var{file} is unspecified, list the +contents of the current directory. + +@vindex eshell-ls-initial-args +The user option @code{eshell-ls-initial-args} contains a list of +arguments to include with any call to @command{ls}. For example, you +can include the option @option{-h} to always use a more human-readable +format. @vindex eshell-ls-use-colors If @code{eshell-ls-use-colors} is non-@code{nil}, the contents of a directory is color-coded according to file type and status. These colors and the regexps used to identify their corresponding files can -be customized via @w{@kbd{M-x customize-group @key{RET} eshell-ls @key{RET}}}. +be customized via @w{@kbd{M-x customize-group @key{RET} eshell-ls +@key{RET}}}. + +@command{ls} supports the following options: + +@table @asis + +@item @code{-a}, @code{--all} +List all files, including ones starting with @samp{.}. + +@item @code{-A}, @code{--almost-all} +Like @code{--all}, but don't list the current directory (@file{.}) or +the parent directory (@file{..}). + +@item @code{-c}, @code{--by-ctime} +Sort files by last status change time, with newest files first. + +@item @code{-C} +List entries by columns. + +@item @code{-d}, @code{--directory} +List directory entries instead of their contents. + +@item @code{-h}, @code{--human-readable} +Print sizes in human-readable format, with binary prefixes (so 1 KB is +1024 bytes). + +@item @code{-H}, @code{--si} +Print sizes in human-readable format, with decimal prefixes (so 1 KB +is 1000 bytes). + +@item @code{-I@var{pattern}}, @code{--ignore=@var{pattern}} +Don't list directory entries matching @var{pattern}. + +@item @code{-k}, @code{--kilobytes} +Print sizes as 1024-byte kilobytes. @vindex eshell-ls-date-format -The user option @code{eshell-ls-date-format} determines how the date -is displayed when using the @option{-l} option. The date is produced -using the function @code{format-time-string} (@pxref{Time Parsing,,, -elisp, GNU Emacs Lisp Reference Manual}). +@item @code{-l} +Use a long listing format showing details for each file. The user +option @code{eshell-ls-date-format} determines how the date is +displayed when using this option. The date is produced using the +function @code{format-time-string} (@pxref{Time Parsing,,, elisp, GNU +Emacs Lisp Reference Manual}). -@vindex eshell-ls-initial-args -The user option @code{eshell-ls-initial-args} contains a list of -arguments to include with any call to @command{ls}. For example, you -can include the option @option{-h} to always use a more human-readable -format. +@item @code{-L}, @code{--dereference} +Follow symbolic links when listing entries. + +@item @code{-n}, @code{--numeric-uid-gid} +Show UIDs and GIDs numerically, instead of using their names. + +@item @code{-r}, @code{--reverse} +Reverse order when sorting. + +@item @code{-R}, @code{--recursive} +List subdirectories recursively. + +@item @code{-s}, @code{--size} +Show the size of each file in blocks. @vindex eshell-ls-default-blocksize -The user option @code{eshell-ls-default-blocksize} determines the -default blocksize used when displaying file sizes with the option -@option{-s}. +@item @code{-S} +Sort by file size, with largest files first. The user option +@code{eshell-ls-default-blocksize} determines the default blocksize +used when displaying file sizes with this option. + +@item @code{-t} +Sort by modification time, with newest files first. -@item make +@item @code{-u} +Sort by last access time, with newest files first. + +@item @code{-U} +Do not sort results. Instead, list entries in their directory order. + +@item @code{-x} +List entries by lines instead of by columns. + +@item @code{-X} +Sort alphabetically by file extension. + +@item @code{-1} +List one file per line. + +@end table + +@item make [@var{arg}]@dots{} @cmindex make Run @command{make} through @code{compile} when run asynchronously (e.g., @samp{make &}). @xref{Compilation, , , emacs, The GNU Emacs Manual}. Otherwise call the external @command{make} command. -@item man +@item man [@var{arg}]@dots{} @cmindex man Display Man pages using the Emacs @code{man} command. @xref{Man Page, , , emacs, The GNU Emacs Manual}. -@item mkdir +@item mkdir [-p] @var{directory}@dots{} @cmindex mkdir -Make new directories. +Make new directories. With @code{-p} or @code{--parents}, +automatically make any necessary parent directories as well. -@item mv +@item mv [@var{option}]@dots{} @var{source} @var{dest} +@itemx mv [@var{option}]@dots{} @var{source}@dots{} @var{directory} @cmindex mv -Move or rename files. +Rename the file @var{source} to @var{dest} or move @var{source} into +@var{directory}. @vindex eshell-mv-overwrite-files @vindex eshell-mv-interactive-query @@ -789,40 +1019,93 @@ will overwrite files without warning. If @code{eshell-mv-interactive-query} is non-@code{nil}, @command{mv} will prompt before overwriting anything. -@item occur +@command{mv} accepts the following options: + +@table @asis + +@item @code{-f}, @code{--force} +Never prompt for confirmation before moving an item. + +@item @code{-i}, @code{--interactive} +Prompt for confirmation before moving an item if the target already +exists. + +@item @code{-n}, @code{--preview} +Run the command, but don't move anything. This is useful if you +want to preview what would be moved when calling @command{mv}. + +@item @code{-v}, @code{--verbose} +Print the name of each item before moving it. + +@end table + +@item occur @var{regexp} [@var{nlines}] @cmindex occur Alias to Emacs's @code{occur}. @xref{Other Repeating Search, , , emacs, The GNU Emacs Manual}. @item popd +@item popd +@var{n} @cmindex popd Pop a directory from the directory stack and switch to a another place -in the stack. +in the stack. This command can take the following forms: -@item printnl +@table @code + +@item popd +Remove the current directory from the directory stack and change to +the directory beneath it. + +@item popd +@var{n} +Remove the current directory from the directory stack and change to +the @var{nth} directory in the stack (counting from zero). + +@end table + +@item printnl [@var{arg}]@dots{} @cmindex printnl -Print the arguments separated by newlines. +Print all the @var{arg}s separated by newlines. @item pushd +@itemx pushd @var{directory} +@itemx pushd +@var{n} @cmindex pushd Push the current directory onto the directory stack, then change to -another directory. +another directory. This command can take the following forms: + +@table @code + +@vindex eshell-pushd-tohome +@item pushd +Swap the current directory with the directory on the top of the stack. +If @code{eshell-pushd-tohome} is non-@code{nil}, push the current +directory onto the stack and change to the user's home directory (like +@samp{pushd ~}). @vindex eshell-pushd-dunique +@item pushd @var{directory} +Push the current directory onto the stack and change to +@var{directory}. If @code{eshell-pushd-dunique} is non-@code{nil}, +then only unique directories will be added to the stack. + @vindex eshell-pushd-dextract -If @code{eshell-pushd-dunique} is non-@code{nil}, then only unique -directories will be added to the stack. If -@code{eshell-pushd-dextract} is non-@code{nil}, then @samp{pushd -+@var{n}} will pop the @var{n}th directory to the top of the stack. +@item pushd +@var{n} +Change to the @var{nth} directory in the directory stack (counting +from zero), and ``rotate'' the stack by moving any elements before the +@var{nth} to the bottom. If @code{eshell-pushd-dextract} is +non-@code{nil}, then @samp{pushd +@var{n}} will instead pop the +@var{n}th directory to the top of the stack. + +@end table @item pwd @cmindex pwd Prints the current working directory. -@item rm +@item rm [@var{option}]@dots{} @var{item}@dots{} @cmindex rm Removes files, buffers, processes, or Emacs Lisp symbols, depending on -the argument. +the type of each @var{item}. @vindex eshell-rm-interactive-query @vindex eshell-rm-removes-directories @@ -832,56 +1115,84 @@ will prompt before removing anything. If @command{rm} can also remove directories. Otherwise, @command{rmdir} is required. -@item rmdir +@command{rm} accepts the following options: + +@table @asis + +@item @code{-f}, @code{--force} +Never prompt for confirmation before removing an item. + +@item @code{-i}, @code{--interactive} +Prompt for confirmation before removing each item. + +@item @code{-n}, @code{--preview} +Run the command, but don't remove anything. This is useful if you +want to preview what would be removed when calling @command{rm}. + +@item @code{-r}, @code{-R}, @code{--recursive} +Remove any specified directories and their contents recursively. + +@item @code{-v}, @code{--verbose} +Print the name of each item before removing it. + +@end table + +@item rmdir @var{directory}@dots{} @cmindex rmdir Removes directories if they are empty. -@item set +@item set [@var{var} @var{value}]@dots{} @cmindex set Set variable values, using the function @code{set} like a command (@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}). -A variable name can be a symbol, in which case it refers to a Lisp -variable, or a string, referring to an environment variable +The value of @var{var} can be a symbol, in which case it refers to a +Lisp variable, or a string, referring to an environment variable (@pxref{Arguments}). -@item setq +@item setq [@var{symbol} @var{value}]@dots{} @cmindex setq Set variable values, using the function @code{setq} like a command (@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}). -@item source +@item source @var{file} [@var{argument}]@dots{} @cmindex source -Source an Eshell file in a subshell environment. This is not to be -confused with the command @command{.}, which sources a file in the -current environment. +Source an Eshell script named @var{file} in a subshell environment, +passing any @var{argument}s to the script (@pxref{Scripts}). This is +not to be confused with the command @command{.}, which sources a file +in the current environment. -@item time +@item time @var{command}@dots{} @cmindex time -Show the time elapsed during a command's execution. +Show the time elapsed during the execution of @var{command}. -@item umask +@item umask [-S] +@itemx umask @var{mode} @cmindex umask -Set or view the default file permissions for newly created files and -directories. +View the default file permissions for newly created files and +directories. If you pass @code{-S} or @code{--symbolic}, view the +mode symbolically. With @var{mode}, set the default permissions to +this value. -@item unset +@item unset [@var{var}]@dots{} @cmindex unset -Unset one or more variables. As with @command{set}, a variable name -can be a symbol, in which case it refers to a Lisp variable, or a -string, referring to an environment variable. +Unset one or more variables. As with @command{set}, the value of +@var{var} can be a symbol, in which case it refers to a Lisp variable, +or a string, referring to an environment variable. -@item wait +@item wait [@var{process}]@dots{} @cmindex wait -Wait until a process has successfully completed. +Wait until each specified @var{process} has exited. -@item which +@item which @var{command}@dots{} @cmindex which -Identify a command and its location. +For each @var{command}, identify what kind of command it is and its +location. @item whoami @cmindex whoami -Print the current user. This Eshell version of @command{whoami} -supports Tramp. +Print the current user. This Eshell version of @command{whoami} is +connection-aware, so for remote directories, it will print the user +associated with that connection. @end table @subsection Defining new built-in commands @@ -1353,6 +1664,11 @@ sequence of commands, as with almost any other shell script. Scripts are invoked from Eshell with @command{source}, or from anywhere in Emacs with @code{eshell-source-file}. +Like with aliases (@pxref{Aliases}), Eshell scripts can accept any +number of arguments. Within the script, you can refer to these with +the special variables @code{$0}, @code{$1}, @dots{}, @code{$9}, and +@code{$*}. + @cmindex . If you wish to load a script into your @emph{current} environment, rather than in a subshell, use the @code{.} command. @@ -1452,7 +1768,7 @@ As with @samp{$@{@var{command}@}}, evaluates the Eshell command invocation @command{@var{command}}, but writes the output to a temporary file and returns the file name. -@item $@var{expr}[@var{i...}] +@item $@var{expr}[@var{i@dots{}}] Expands to the @var{i}th element of the result of @var{expr}, an expression in one of the above forms listed here. If multiple indices are supplied, this will return a list containing the elements for each @@ -1501,7 +1817,7 @@ Multiple sets of indices can also be specified. For example, if expand to @code{2}, i.e.@: the second element of the first list member (all indices are zero-based). -@item $@var{expr}[@var{regexp} @var{i...}] +@item $@var{expr}[@var{regexp} @var{i@dots{}}] As above (when @var{expr} expands to a string), but use @var{regexp} to split the string. @var{regexp} can be any form other than a number. For example, @samp{$@var{var}[: 0]} will return the first @@ -2275,15 +2591,23 @@ external commands. To enable it, add @code{eshell-tramp} to @table @code -@item su +@item su [- | -l] [@var{user}] @cmindex su -@itemx sudo +Uses TRAMP's @command{su} method (@pxref{Inline methods, , , tramp, +The Tramp Manual}) to change the current user to @var{user} (or root +if unspecified). With @code{-}, @code{-l}, or @code{--login}, provide +a login environment. + +@item sudo [-u @var{user}] [-s | @var{command}@dots{}] @cmindex sudo -@itemx doas +@itemx doas [-u @var{user}] [-s | @var{command}@dots{}] @cmindex doas -Uses TRAMP's @command{su}, @command{sudo}, or @command{doas} method -(@pxref{Inline methods, , , tramp, The Tramp Manual}) to run a command -via @command{su}, @command{sudo}, or @command{doas}. +Uses TRAMP's @command{sudo} or @command{doas} method (@pxref{Inline +methods, , , tramp, The Tramp Manual}) to run @var{command} as root +via @command{sudo} or @command{doas}. When specifying @code{-u +@var{user}} or @code{--user @var{user}}, run the command as @var{user} +instead. With @code{-s} or @code{--shell}, start a shell instead of +running @var{command}. @end table @@ -2296,58 +2620,58 @@ add @code{eshell-xtra} to @code{eshell-modules-list}. @table @code -@item count +@item count @var{item} @var{seq} [@var{option}]@dots{} @cmindex count A wrapper around the function @code{cl-count} (@pxref{Searching Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item expr +@item expr @var{str} [@var{separator}] [@var{arg}]@dots{} @cmindex expr An implementation of @command{expr} using the Calc package. @xref{Top,,, calc, The GNU Emacs Calculator}. -@item ff +@item ff @var{directory} @var{pattern} @cmindex ff Shorthand for the the function @code{find-name-dired} (@pxref{Dired and Find, , , emacs, The Emacs Editor}). -@item gf +@item gf @var{directory} @var{regexp} @cmindex gf Shorthand for the the function @code{find-grep-dired} (@pxref{Dired and Find, , , emacs, The Emacs Editor}). -@item intersection +@item intersection @var{list1} @var{list2} [@var{option}]@dots{} @cmindex intersection A wrapper around the function @code{cl-intersection} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item mismatch +@item mismatch @var{seq1} @var{seq2} [@var{option}]@dots{} @cmindex mismatch A wrapper around the function @code{cl-mismatch} (@pxref{Searching Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item set-difference +@item set-difference @var{list1} @var{list2} [@var{option}]@dots{} @cmindex set-difference A wrapper around the function @code{cl-set-difference} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item set-exclusive-or +@item set-exclusive-or @var{list1} @var{list2} [@var{option}]@dots{} @cmindex set-exclusive-or A wrapper around the function @code{cl-set-exclusive-or} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item substitute +@item substitute @var{new} @var{old} @var{seq} [@var{option}]@dots{} @cmindex substitute A wrapper around the function @code{cl-substitute} (@pxref{Sequence Functions,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item union +@item union @var{list1} @var{list2} [@var{option}]@dots{} @cmindex union A wrapper around the function @code{cl-union} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 78dfd0654e2..23028576f45 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -618,11 +618,11 @@ Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.") :preserve-args :external "ln" :show-usage - :usage "[OPTION]... TARGET [LINK_NAME] + :usage "[OPTION]... TARGET LINK_NAME or: ln [OPTION]... TARGET... DIRECTORY -Create a link to the specified TARGET with optional LINK_NAME. If there is -more than one TARGET, the last argument must be a directory; create links -in DIRECTORY to each TARGET. Create hard links by default, symbolic links +Create a link to the specified TARGET with LINK_NAME. If there is more +than one TARGET, the last argument must be a directory; create links in +DIRECTORY to each TARGET. Create hard links by default, symbolic links with `--symbolic'. When creating hard links, each TARGET must exist.") (let ((no-dereference t)) (eshell-mvcpln-template "ln" "linking" diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index dc2b93e574b..44861c222b8 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -253,10 +253,10 @@ An external command simply means external to Emacs." "Add a set of paths to PATH." (eshell-eval-using-options "addpath" args - '((?b "begin" nil prepend "add path element at beginning") + '((?b "begin" nil prepend "add to beginning of $PATH") (?h "help" nil nil "display this usage message") - :usage "[-b] PATH -Adds the given PATH to $PATH.") + :usage "[-b] DIR... +Adds the given DIR to $PATH.") (let ((path (eshell-get-path t))) (if args (progn diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 537bc4b0641..02b5c785625 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -433,7 +433,7 @@ the values of nil for each." (?h "help" nil nil "show this usage screen") :external "env" :parse-leading-options-only - :usage "[NAME=VALUE]... [COMMAND [ARG]...]") + :usage "[NAME=VALUE]... [COMMAND]...") (if args (or (eshell-parse-local-variables args) (eshell-named-command (car args) (cdr args))) -- cgit v1.2.3 From 7756e9c73611c25002a90194b4a32c23051cb234 Mon Sep 17 00:00:00 2001 From: Xi Lu Date: Thu, 23 Feb 2023 20:58:00 +0800 Subject: filesets: Safely invoke `shell-command*' functions * lisp/filesets.el: (filesets-select-command, filesets-quote): Remove unused functions. (filesets-external-viewers): Remove old comments. (filesets-which-command, filesets-get-quoted-selection) (filesets-spawn-external-viewer): Use `shell-quote-argument'. (Bug#61709) --- lisp/filesets.el | 40 +++++++++------------------------------- 1 file changed, 9 insertions(+), 31 deletions(-) diff --git a/lisp/filesets.el b/lisp/filesets.el index 4e2de8fed1b..bc113b80e07 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -161,18 +161,9 @@ COND-FN takes one argument: the current element." (define-obsolete-function-alias 'filesets-member #'cl-member "28.1") (define-obsolete-function-alias 'filesets-sublist #'seq-subseq "28.1") -(defun filesets-select-command (cmd-list) - "Select one command from CMD-LIST -- a string with space separated names." - (let ((this (shell-command-to-string - (format "which --skip-alias %s 2> %s | head -n 1" - cmd-list null-device)))) - (if (equal this "") - nil - (file-name-nondirectory (substring this 0 (- (length this) 1)))))) - (defun filesets-which-command (cmd) "Call \"which CMD\"." - (shell-command-to-string (format "which %s" cmd))) + (shell-command-to-string (format "which %s" (shell-quote-argument cmd)))) (defun filesets-which-command-p (cmd) "Call \"which CMD\" and return non-nil if the command was found." @@ -547,16 +538,6 @@ the filename." (defcustom filesets-external-viewers (let - ;; ((ps-cmd (or (and (boundp 'my-ps-viewer) my-ps-viewer) - ;; (filesets-select-command "ggv gv"))) - ;; (pdf-cmd (or (and (boundp 'my-ps-viewer) my-pdf-viewer) - ;; (filesets-select-command "xpdf acroread"))) - ;; (dvi-cmd (or (and (boundp 'my-ps-viewer) my-dvi-viewer) - ;; (filesets-select-command "xdvi tkdvi"))) - ;; (doc-cmd (or (and (boundp 'my-ps-viewer) my-doc-viewer) - ;; (filesets-select-command "antiword"))) - ;; (pic-cmd (or (and (boundp 'my-ps-viewer) my-pic-viewer) - ;; (filesets-select-command "gqview ee display")))) ((ps-cmd "ggv") (pdf-cmd "xpdf") (dvi-cmd "xdvi") @@ -1084,10 +1065,6 @@ Return full path if FULL-FLAG is non-nil." (t (error "Filesets: %s does not exist" dir)))) -(defun filesets-quote (txt) - "Return TXT in quotes." - (concat "\"" txt "\"")) - (defun filesets-get-selection () "Get the text between mark and point -- i.e. the selection or region." (let ((m (mark)) @@ -1098,7 +1075,7 @@ Return full path if FULL-FLAG is non-nil." (defun filesets-get-quoted-selection () "Return the currently selected text in quotes." - (filesets-quote (filesets-get-selection))) + (shell-quote-argument (filesets-get-selection))) (defun filesets-get-shortcut (n) "Create menu shortcuts based on number N." @@ -1245,12 +1222,13 @@ Use the viewer defined in EV-ENTRY (a valid element of (if fmt (mapconcat (lambda (this) - (if (stringp this) (format this file) - (format "%S" (if (functionp this) - (funcall this) - this)))) + (if (stringp this) + (format this (shell-quote-argument file)) + (shell-quote-argument (if (functionp this) + (funcall this) + this)))) fmt "") - (format "%S" file)))) + (shell-quote-argument file)))) (output (cond ((and (functionp vwr) co-flag) @@ -1259,7 +1237,7 @@ Use the viewer defined in EV-ENTRY (a valid element of (funcall vwr file) nil) (co-flag - (shell-command-to-string (format "%s %s" vwr args))) + (shell-command-to-string (format "%s %s" vwr args))) (t (shell-command (format "%s %s&" vwr args)) nil)))) -- cgit v1.2.3 From ea53a26d03da8d03652696939431b3a7e63053d7 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 5 Feb 2024 08:30:31 +0100 Subject: ; Fix last change * lisp/filesets.el (filesets-quote): Resurrect as obsolete alias for 'shell-quote-argument'. --- lisp/filesets.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/filesets.el b/lisp/filesets.el index bc113b80e07..68133ba2255 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -2461,11 +2461,15 @@ Set up hooks, load the cache file -- if existing -- and build the menu." (setq filesets-menu-use-cached-flag t))) (filesets-build-menu))) +;;; obsolete + (defun filesets-error (_class &rest args) "`error' wrapper." (declare (obsolete error "28.1")) (error "%s" (mapconcat #'identity args " "))) +(define-obsolete-function-alias 'filesets-quote #'shell-quote-argument "30.1") + (provide 'filesets) ;;; filesets.el ends here -- cgit v1.2.3 From 98d62c5f7675b24ad66e010765ce3012046f2ff8 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 5 Feb 2024 17:17:51 +0800 Subject: Don't respect ROUND_XY_TO_GRID when decomposing uninterpreted glyph * src/sfnt.c (sfnt_decompose_compound_glyph): Remove useless code; don't pretend to round glyph coordinates. --- src/sfnt.c | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/src/sfnt.c b/src/sfnt.c index 6df43af4293..8598b052044 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -2798,12 +2798,6 @@ sfnt_decompose_compound_glyph (struct sfnt_glyph *glyph, if (component->flags & 04000) /* SCALED_COMPONENT_OFFSET */ sfnt_transform_coordinates (component, &x, &y, 1, 0, 0); - - if (component->flags & 04) /* ROUND_XY_TO_GRID */ - { - x = sfnt_round_fixed (x); - y = sfnt_round_fixed (y); - } } else { @@ -20800,8 +20794,8 @@ main (int argc, char **argv) return 1; } -#define FANCY_PPEM 12 -#define EASY_PPEM 12 +#define FANCY_PPEM 18 +#define EASY_PPEM 18 interpreter = NULL; head = sfnt_read_head_table (fd, font); -- cgit v1.2.3 From c1f8fe09e6641cc6c1195edcb8666ace1e6e8829 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 5 Feb 2024 18:34:22 +0800 Subject: Fix frame focus tracking under Android * java/org/gnu/emacs/EmacsActivity.java (invalidateFocus): New argument WHENCE, a unique number identifying the circumstances leading up to the call. All callers changed. (attachWindow): Call `invalidateFocus' from the UI thread. (onWindowFocusChanged): Don't remove activity from `focusedActivities' if it already exists should `hasWindowFocus' return true. --- java/org/gnu/emacs/EmacsActivity.java | 32 ++++++++++++++++++++++++-------- java/org/gnu/emacs/EmacsWindow.java | 4 ++-- 2 files changed, 26 insertions(+), 10 deletions(-) diff --git a/java/org/gnu/emacs/EmacsActivity.java b/java/org/gnu/emacs/EmacsActivity.java index 3237f650240..b821694b18a 100644 --- a/java/org/gnu/emacs/EmacsActivity.java +++ b/java/org/gnu/emacs/EmacsActivity.java @@ -97,7 +97,7 @@ public class EmacsActivity extends Activity } public static void - invalidateFocus () + invalidateFocus (int whence) { EmacsWindow oldFocus; @@ -144,7 +144,7 @@ public class EmacsActivity extends Activity layout.removeView (window.view); window = null; - invalidateFocus (); + invalidateFocus (0); } } @@ -172,8 +172,17 @@ public class EmacsActivity extends Activity if (isPaused) window.noticeIconified (); - /* Invalidate the focus. */ - invalidateFocus (); + /* Invalidate the focus. Since attachWindow may be called from + either the main or the UI thread, post this to the UI thread. */ + + runOnUiThread (new Runnable () { + @Override + public void + run () + { + invalidateFocus (1); + } + }); } @Override @@ -261,7 +270,7 @@ public class EmacsActivity extends Activity isMultitask = this instanceof EmacsMultitaskActivity; manager.removeWindowConsumer (this, isMultitask || isFinishing ()); focusedActivities.remove (this); - invalidateFocus (); + invalidateFocus (2); /* Remove this activity from the static field, lest it leak. */ if (lastFocusedActivity == this) @@ -274,9 +283,16 @@ public class EmacsActivity extends Activity public final void onWindowFocusChanged (boolean isFocused) { - if (isFocused && !focusedActivities.contains (this)) + /* At times and on certain versions of Android ISFOCUSED does not + reflect whether the window actually holds focus, so replace it + with the value of `hasWindowFocus'. */ + isFocused = hasWindowFocus (); + + if (isFocused) { - focusedActivities.add (this); + if (!focusedActivities.contains (this)) + focusedActivities.add (this); + lastFocusedActivity = this; /* Update the window insets as the focus change may have @@ -291,7 +307,7 @@ public class EmacsActivity extends Activity else focusedActivities.remove (this); - invalidateFocus (); + invalidateFocus (3); } @Override diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index 304304a328b..b75d96b2b5a 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java @@ -240,7 +240,7 @@ public final class EmacsWindow extends EmacsHandleObject } } - EmacsActivity.invalidateFocus (); + EmacsActivity.invalidateFocus (4); if (!children.isEmpty ()) throw new IllegalStateException ("Trying to destroy window with " @@ -760,7 +760,7 @@ public final class EmacsWindow extends EmacsHandleObject public void onFocusChanged (boolean gainFocus) { - EmacsActivity.invalidateFocus (); + EmacsActivity.invalidateFocus (gainFocus ? 6 : 5); } /* Notice that the activity has been detached or destroyed. -- cgit v1.2.3 From c7539a363b8b109d24457aaeb60fb51bd0a03e4f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 5 Feb 2024 12:54:03 +0100 Subject: Fix stale cache in Tramp * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Flush file properties in time. (Bug#68805) --- lisp/net/tramp-sh.el | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 7656da81dcc..68ee541bee6 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2009,7 +2009,7 @@ ID-FORMAT valid values are `string' and `integer'." #'copy-directory (list dirname newname keep-date parents copy-contents)))) - ;; When newname did exist, we have wrong cached values. + ;; NEWNAME has wrong cached values. (when t2 (with-parsed-tramp-file-name (expand-file-name newname) nil (tramp-flush-file-properties v localname))))))) @@ -2148,24 +2148,24 @@ file names." ;; One of them must be a Tramp file. (error "Tramp implementation says this cannot happen"))) - ;; Handle `preserve-extended-attributes'. We ignore - ;; possible errors, because ACL strings could be - ;; incompatible. - (when-let ((attributes (and preserve-extended-attributes - (file-extended-attributes filename)))) - (ignore-errors - (set-file-extended-attributes newname attributes))) - ;; In case of `rename', we must flush the cache of the source file. (when (and t1 (eq op 'rename)) (with-parsed-tramp-file-name filename v1 (tramp-flush-file-properties v1 v1-localname))) - ;; When newname did exist, we have wrong cached values. + ;; NEWNAME has wrong cached values. (when t2 (with-parsed-tramp-file-name newname v2 (tramp-flush-file-properties v2 v2-localname))) + ;; Handle `preserve-extended-attributes'. We ignore + ;; possible errors, because ACL strings could be + ;; incompatible. + (when-let ((attributes (and preserve-extended-attributes + (file-extended-attributes filename)))) + (ignore-errors + (set-file-extended-attributes newname attributes))) + ;; KEEP-DATE handling. (when (and keep-date (not copy-keep-date)) (tramp-compat-set-file-times @@ -2437,7 +2437,7 @@ The method used must be an out-of-band method." copy-program (tramp-get-method-parameter v 'tramp-copy-program) copy-args ;; " " has either been a replacement of "%k" (when - ;; keep-date argument is non-nil), or a replacement for + ;; KEEP-DATE argument is non-nil), or a replacement for ;; the whole keep-date sublist. (delete " " (apply #'tramp-expand-args v 'tramp-copy-args spec)) ;; `tramp-ssh-controlmaster-options' is a string instead @@ -5353,7 +5353,7 @@ connection if a previous connection has died for some reason." "2>" (tramp-get-remote-null-device previous-hop)) ?l (concat remote-shell " " extra-args " -i")) ;; A restricted shell does not allow "exec". - (when r-shell '("&&" "exit")) '("||" "exit")) + (when r-shell '("&&" "exit")) '("||" "exit")) " ")) ;; Send the command. -- cgit v1.2.3 From edf61edfd6f04ab97785dca92fc68e8e5783586e Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 5 Feb 2024 12:54:56 +0100 Subject: Adapt cache handling in Tramp * lisp/net/tramp-cache.el (with-tramp-saved-file-property) (with-tramp-saved-file-properties) (with-tramp-saved-connection-property) (with-tramp-saved-connection-properties): Do not change KEY destructively. --- lisp/net/tramp-cache.el | 105 ++++++++++++++++++++++-------------------------- 1 file changed, 47 insertions(+), 58 deletions(-) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 25123a6e282..225a26ad1cd 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -144,7 +144,6 @@ If KEY is `tramp-cache-undefined', don't create anything, and return nil." (defun tramp-get-file-property (key file property &optional default) "Get the PROPERTY of FILE from the cache context of KEY. Return DEFAULT if not set." - ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) (if (eq key tramp-cache-undefined) default (let* ((hash (tramp-get-hash-table key)) @@ -191,7 +190,6 @@ Return DEFAULT if not set." (defun tramp-set-file-property (key file property value) "Set the PROPERTY of FILE to VALUE, in the cache context of KEY. Return VALUE." - ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) (if (eq key tramp-cache-undefined) value (let ((hash (tramp-get-hash-table key))) @@ -224,7 +222,6 @@ Return VALUE." ;;;###tramp-autoload (defun tramp-flush-file-property (key file property) "Remove PROPERTY of FILE in the cache context of KEY." - ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) (unless (eq key tramp-cache-undefined) (remhash property (tramp-get-hash-table key)) @@ -239,7 +236,6 @@ Return VALUE." ;; `file-name-directory' can return nil, for example for "~". (when-let ((file (file-name-directory file)) (file (directory-file-name file))) - ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) (unless (eq key tramp-cache-undefined) (dolist (property (hash-table-keys (tramp-get-hash-table key))) @@ -254,7 +250,6 @@ Return VALUE." (defun tramp-flush-file-properties (key file) "Remove all properties of FILE in the cache context of KEY." (let ((truename (tramp-get-file-property key file "file-truename"))) - ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) (unless (eq key tramp-cache-undefined) (tramp-message key 8 "%s" (tramp-file-name-localname key)) @@ -338,17 +333,15 @@ FILE must be a local file name on a connection identified via KEY." "Save PROPERTY, run BODY, reset PROPERTY. Preserve timestamps." (declare (indent 3) (debug t)) - `(progn - ;; Unify localname. Remove hop from `tramp-file-name' structure. - (setf ,key (tramp-file-name-unify ,key ,file)) - (let* ((hash (tramp-get-hash-table ,key)) - (cached (and (hash-table-p hash) (gethash ,property hash)))) - (unwind-protect (progn ,@body) - ;; Reset PROPERTY. Recompute hash, it could have been flushed. - (setq hash (tramp-get-hash-table ,key)) - (if (consp cached) - (puthash ,property cached hash) - (remhash ,property hash)))))) + `(let* ((key (tramp-file-name-unify ,key ,file)) + (hash (tramp-get-hash-table key)) + (cached (and (hash-table-p hash) (gethash ,property hash)))) + (unwind-protect (progn ,@body) + ;; Reset PROPERTY. Recompute hash, it could have been flushed. + (setq hash (tramp-get-hash-table key)) + (if (consp cached) + (puthash ,property cached hash) + (remhash ,property hash))))) ;;;###tramp-autoload (defmacro with-tramp-saved-file-properties (key file properties &rest body) @@ -356,22 +349,20 @@ Preserve timestamps." PROPERTIES is a list of file properties (strings). Preserve timestamps." (declare (indent 3) (debug t)) - `(progn - ;; Unify localname. Remove hop from `tramp-file-name' structure. - (setf ,key (tramp-file-name-unify ,key ,file)) - (let* ((hash (tramp-get-hash-table ,key)) - (values - (and (hash-table-p hash) - (mapcar - (lambda (property) (cons property (gethash property hash))) - ,properties)))) - (unwind-protect (progn ,@body) - ;; Reset PROPERTIES. Recompute hash, it could have been flushed. - (setq hash (tramp-get-hash-table ,key)) - (dolist (value values) - (if (consp (cdr value)) - (puthash (car value) (cdr value) hash) - (remhash (car value) hash))))))) + `(let* ((key (tramp-file-name-unify ,key ,file)) + (hash (tramp-get-hash-table key)) + (values + (and (hash-table-p hash) + (mapcar + (lambda (property) (cons property (gethash property hash))) + ,properties)))) + (unwind-protect (progn ,@body) + ;; Reset PROPERTIES. Recompute hash, it could have been flushed. + (setq hash (tramp-get-hash-table key)) + (dolist (value values) + (if (consp (cdr value)) + (puthash (car value) (cdr value) hash) + (remhash (car value) hash)))))) ;;; -- Properties -- @@ -473,38 +464,36 @@ used to cache connection properties of the local machine." (defmacro with-tramp-saved-connection-property (key property &rest body) "Save PROPERTY, run BODY, reset PROPERTY." (declare (indent 2) (debug t)) - `(progn - (setf ,key (tramp-file-name-unify ,key)) - (let* ((hash (tramp-get-hash-table ,key)) - (cached (and (hash-table-p hash) - (gethash ,property hash tramp-cache-undefined)))) - (unwind-protect (progn ,@body) - ;; Reset PROPERTY. Recompute hash, it could have been flushed. - (setq hash (tramp-get-hash-table ,key)) - (if (not (eq cached tramp-cache-undefined)) - (puthash ,property cached hash) - (remhash ,property hash)))))) + `(let* ((key (tramp-file-name-unify ,key)) + (hash (tramp-get-hash-table key)) + (cached (and (hash-table-p hash) + (gethash ,property hash tramp-cache-undefined)))) + (unwind-protect (progn ,@body) + ;; Reset PROPERTY. Recompute hash, it could have been flushed. + (setq hash (tramp-get-hash-table key)) + (if (not (eq cached tramp-cache-undefined)) + (puthash ,property cached hash) + (remhash ,property hash))))) ;;;###tramp-autoload (defmacro with-tramp-saved-connection-properties (key properties &rest body) "Save PROPERTIES, run BODY, reset PROPERTIES. PROPERTIES is a list of file properties (strings)." (declare (indent 2) (debug t)) - `(progn - (setf ,key (tramp-file-name-unify ,key)) - (let* ((hash (tramp-get-hash-table ,key)) - (values - (mapcar - (lambda (property) - (cons property (gethash property hash tramp-cache-undefined))) - ,properties))) - (unwind-protect (progn ,@body) - ;; Reset PROPERTIES. Recompute hash, it could have been flushed. - (setq hash (tramp-get-hash-table ,key)) - (dolist (value values) - (if (not (eq (cdr value) tramp-cache-undefined)) - (puthash (car value) (cdr value) hash) - (remhash (car value) hash))))))) + `(let* ((key (tramp-file-name-unify ,key)) + (hash (tramp-get-hash-table key)) + (values + (mapcar + (lambda (property) + (cons property (gethash property hash tramp-cache-undefined))) + ,properties))) + (unwind-protect (progn ,@body) + ;; Reset PROPERTIES. Recompute hash, it could have been flushed. + (setq hash (tramp-get-hash-table key)) + (dolist (value values) + (if (not (eq (cdr value) tramp-cache-undefined)) + (puthash (car value) (cdr value) hash) + (remhash (car value) hash)))))) ;;;###tramp-autoload (defun tramp-cache-print (table) -- cgit v1.2.3 From dbc5fafa311823f3a78d4ad5a395e4d87d31d9bd Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 5 Feb 2024 12:55:27 +0100 Subject: * lisp/net/tramp.el (tramp-local-host-regexp): Adapt :version. --- lisp/net/tramp-archive.el | 4 ++-- lisp/net/tramp-compat.el | 2 +- lisp/net/tramp.el | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 298cacdb0e0..752462d8fa3 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -389,7 +389,7 @@ arguments to pass to the OPERATION." "Add archive file name handler to `file-name-handler-alist'." (when (and tramp-archive-enabled (not - (rassq 'tramp-archive-file-name-handler file-name-handler-alist))) + (rassq #'tramp-archive-file-name-handler file-name-handler-alist))) (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) #'tramp-archive-autoload-file-name-handler)) @@ -443,7 +443,7 @@ arguments to pass to the OPERATION." (and (tramp-archive-file-name-p name) (match-string 2 name))) -(defvar tramp-archive-hash (make-hash-table :test 'equal) +(defvar tramp-archive-hash (make-hash-table :test #'equal) "Hash table for archive local copies. The hash key is the archive name. The value is a cons of the used `tramp-file-name' structure for tramp-gvfs, and the file diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 87b20b982f9..061766090a0 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -309,7 +309,7 @@ Also see `ignore'." ;; Macro `connection-local-p' is new in Emacs 30.1. (if (macrop 'connection-local-p) - (defalias 'tramp-compat-connection-local-p #'connection-local-p) + (defalias 'tramp-compat-connection-local-p 'connection-local-p) (defmacro tramp-compat-connection-local-p (variable) "Non-nil if VARIABLE has a connection-local binding in `default-directory'." `(let (connection-local-variables-alist file-local-variables-alist) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 7800efc2a5e..8e114912527 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -557,7 +557,7 @@ host runs a restricted shell, it shall be added to this list, too." eos) "Host names which are regarded as local host. If the local host runs a chrooted environment, set this to nil." - :version "30.1" + :version "29.3" :type '(choice (const :tag "Chrooted environment" nil) (regexp :tag "Host regexp"))) -- cgit v1.2.3 From 798310f0100e7819bc79fb7f9bdcf59b8f534b4b Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 5 Feb 2024 12:56:36 +0100 Subject: ; * etc/NEWS: Fix typos. --- etc/NEWS | 74 +++++++++++++++++++++++++++++++++------------------------------- 1 file changed, 38 insertions(+), 36 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 816613de4ec..5180c26aa92 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -76,7 +76,7 @@ see the variable 'url-request-extra-headers'. +++ ** 'completion-auto-help' now affects 'icomplete-in-buffer'. -Previously, completion-auto-help mostly affected only minibuffer +Previously, 'completion-auto-help' mostly affected only minibuffer completion. Now, if 'completion-auto-help' has the value 'lazy', then Icomplete's in-buffer display of possible completions will only appear after the 'completion-at-point' command has been invoked twice, and if @@ -85,12 +85,12 @@ completely suppressed. Thus, if you use 'icomplete-in-buffer', ensure 'completion-auto-help' is not customized to 'lazy' or nil. +++ -** The *Completions* buffer now always accompanies 'icomplete-in-buffer'. -Previously, it was not consistent when the *Completions* buffer would -appear when using 'icomplete-in-buffer'. Now the *Completions* buffer +** The "*Completions*" buffer now always accompanies 'icomplete-in-buffer'. +Previously, it was not consistent whether the "*Completions*" buffer would +appear when using 'icomplete-in-buffer'. Now the "*Completions*" buffer and Icomplete's in-buffer display of possible completions always appear together. If you would prefer to see only Icomplete's -in-buffer display, and not the *Completions* buffer, you can add this +in-buffer display, and not the "*Completions*" buffer, you can add this to your init: (advice-add 'completion-at-point :after #'minibuffer-hide-completions) @@ -258,7 +258,7 @@ right-aligned to is controlled by the new user option ** Windows -*** New action alist entry 'post-command-select-window' for display-buffer. +*** New action alist entry 'post-command-select-window' for 'display-buffer'. It specifies whether the window of the displayed buffer should be selected or deselected at the end of executing the current command. @@ -305,8 +305,7 @@ between the auto save file and the current file. --- ** 'ffap-lax-url' now defaults to nil. -Previously, it was set to 'ffap-lax-url' to t but this broke remote file -name detection. +Previously, it was set to t but this broke remote file name detection. * Editing Changes in Emacs 30.1 @@ -433,7 +432,7 @@ configurations such as X11 when the X server does not support at least version 2.1 of the X Input Extension, and 'xterm-mouse-mode'. ** 'xterm-mouse-mode' -This mode now emits `wheel-up/down/right/left' events instead of +This mode now emits 'wheel-up/down/right/left' events instead of 'mouse-4/5/6/7' events for the mouse wheel. It uses the 'mouse-wheel-up/down/left/right-event' variables to decide which button maps to which wheel event (if any). @@ -442,7 +441,7 @@ variables to decide which button maps to which wheel event (if any). --- *** New user option 'Info-url-alist'. -This user option associates manual-names with URLs. It affects the +This user option associates manual names with URLs. It affects the 'Info-goto-node-web' command. By default, associations for all Emacs-included manuals are set. Further associations can be added for arbitrary Info manuals. @@ -691,7 +690,7 @@ arguments of the form 'VAR=VALUE', 'env' will first set 'VAR' to Now, you can pass an argument like "u+w,o-r" to Eshell's 'umask' command, which will give write permission for owners of newly-created files and deny read permission for users who are not members of the -file's group. See the Info node '(coreutils)File permissions' for +file's group. See the Info node "(coreutils) File permissions" for more information on this notation. +++ @@ -810,14 +809,14 @@ in the minibuffer history, with more recent candidates appearing first. *** 'completion-category-overrides' supports more metadata. The new supported completion properties are 'cycle-sort-function', 'display-sort-function', 'annotation-function', 'affixation-function', -'group-function'. You can now customize them for any category in +and 'group-function'. You can now customize them for any category in 'completion-category-overrides' that will override the properties defined in completion metadata. +++ *** 'completion-extra-properties' supports more metadata. The new supported completion properties are 'category', -'group-function', 'display-sort-function', 'cycle-sort-function'. +'group-function', 'display-sort-function', and 'cycle-sort-function'. ** Pcomplete @@ -1059,8 +1058,8 @@ which calls 'xref-find-definitions'. If the previous one worked better for you, use 'define-key' in your init script to bind 'js-find-symbol' to that combination again. -** Json mode -`js-json-mode` does not derive from `js-mode` any more so as not +** Json mode. +'js-json-mode' does not derive from 'js-mode' any more so as not to confuse tools like Eglot or YASnippet into thinking that those buffers contain Javascript code. @@ -1195,8 +1194,8 @@ comment, like Perl mode does. *** New command 'cperl-file-style'. This command sets the indentation style for the current buffer. To -change the default style, either use the option with the same name or -use the command cperl-set-style. +change the default style, either use the user option with the same name +or use the command 'cperl-set-style'. *** Commands using the Perl info page are obsolete. The Perl documentation in info format is no longer distributed with @@ -1309,16 +1308,19 @@ chat buffers use by default. +++ *** New command 'customize-dirlocals'. This command pops up a buffer to edit the settings in ".dir-locals.el". + ** Calc + +++ -*** Calc parses fractions written using U+2044 FRACTION SLASH -Fractions of the form 123⁄456 are handled as if written 123:456. Note -in particular the difference in behavior from U+2215 DIVISION SLASH +*** Calc parses fractions written using U+2044 FRACTION SLASH. +Fractions of the form "123⁄456" are handled as if written "123:456". +Note in particular the difference in behavior from U+2215 DIVISION SLASH and U+002F SOLIDUS, which result in division rather than a rational -fraction. You may also be interested to know that precomposed -fraction characters, such as ½ (U+00BD VULGAR FRACTION ONE HALF), are -also recognized as rational fractions. They have been since 2004, but -it looks like it was never mentioned in the NEWS, or even the manual. +fraction. You may also be interested to know that precomposed fraction +characters, such as ½ (U+00BD VULGAR FRACTION ONE HALF), are also +recognized as rational fractions. They have been since 2004, but it +looks like it was never mentioned in the NEWS, or even the manual. + * New Modes and Packages in Emacs 30.1 @@ -1378,19 +1380,19 @@ files and save the changes. * Incompatible Lisp Changes in Emacs 30.1 --- -** Old 'derived.el' functions removed. +** Old derived.el functions removed. The following functions have been deleted because they were only used by code compiled with Emacs<21: -'derived-mode-setup-function-name', 'derived-mode-init-mode-variables', -'derived-mode-set-keymap', 'derived-mode-set-syntax-table', -'derived-mode-set-abbrev-table', 'derived-mode-run-hooks', +'derived-mode-init-mode-variables', 'derived-mode-merge-abbrev-tables', 'derived-mode-merge-keymaps', 'derived-mode-merge-syntax-tables', -'derived-mode-merge-abbrev-tables'. +'derived-mode-run-hooks', 'derived-mode-set-abbrev-table', +'derived-mode-set-keymap', 'derived-mode-set-syntax-table', +'derived-mode-setup-function-name'. +++ ** 'M-TAB' now invokes 'completion-at-point' also in Text mode. By default, Text mode no longer binds 'M-TAB' to -'ispell-complete-word'. Instead this mode arranges for +'ispell-complete-word'. Instead, this mode arranges for 'completion-at-point', globally bound to 'M-TAB', to perform word completion as well. You can have Text mode bind 'M-TAB' to 'ispell-complete-word' as it did in previous Emacs versions, or @@ -1498,8 +1500,8 @@ values. * Lisp Changes in Emacs 30.1 +++ -** 'define-advice' now sets the new advice's 'name' property to NAME -Named advice defined with 'define-advice' can now be removed with +** 'define-advice' now sets the new advice's 'name' property to NAME. +Named advices defined with 'define-advice' can now be removed with '(advice-remove SYMBOL NAME)' in addition to '(advice-remove SYMBOL SYMBOL@NAME)'. @@ -1516,10 +1518,10 @@ It puts a limit to the amount by which Emacs can temporarily increase +++ ** New special form 'handler-bind'. -Provides a functionality similar to `condition-case` except it runs the -handler code without unwinding the stack, such that we can record the -backtrace and other dynamic state at the point of the error. -See the Info node "(elisp) Handling Errors". +It provides a functionality similar to 'condition-case' except it runs +the handler code without unwinding the stack, such that we can record +the backtrace and other dynamic state at the point of the error. See +the Info node "(elisp) Handling Errors". +++ ** New 'pop-up-frames' action alist entry for 'display-buffer'. -- cgit v1.2.3 From 95c8bfb11ec82e67652e5903495c1fcb5c61ace2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 5 Feb 2024 10:13:56 -0500 Subject: (edebug-signal): Simplify Also, prefer #' to quote function names. * lisp/emacs-lisp/edebug.el (edebug-signal): Instead of re-signaling the error, let `signal_or_quit` continue processing it. --- lisp/emacs-lisp/edebug.el | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index a8a51502503..4c7dbb4ef8c 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -481,7 +481,7 @@ just FUNCTION is printed." (edebug--eval-defun #'eval-defun edebug-it))) ;;;###autoload -(defalias 'edebug-defun 'edebug-eval-top-level-form) +(defalias 'edebug-defun #'edebug-eval-top-level-form) ;;;###autoload (defun edebug-eval-top-level-form () @@ -1729,7 +1729,7 @@ contains a circular object." (defun edebug-match-form (cursor) (list (edebug-form cursor))) -(defalias 'edebug-match-place 'edebug-match-form) +(defalias 'edebug-match-place #'edebug-match-form) ;; Currently identical to edebug-match-form. ;; This is for common lisp setf-style place arguments. @@ -2277,12 +2277,7 @@ only be active while Edebug is. It checks `debug-on-error' to see whether it should call the debugger. When execution is resumed, the error is signaled again." (if (and (listp debug-on-error) (memq signal-name debug-on-error)) - (edebug 'error (cons signal-name signal-data))) - ;; If we reach here without another non-local exit, then send signal again. - ;; i.e. the signal is not continuable, yet. - ;; Avoid infinite recursion. - (let ((signal-hook-function nil)) - (signal signal-name signal-data))) + (edebug 'error (cons signal-name signal-data)))) ;;; Entering Edebug @@ -2326,6 +2321,12 @@ and run its entry function, and set up `edebug-before' and (debug-on-error (or debug-on-error edebug-on-error)) (debug-on-quit edebug-on-quit)) (unwind-protect + ;; FIXME: We could replace this `signal-hook-function' with + ;; a cleaner `handler-bind' but then we wouldn't be able to + ;; install it here (i.e. once and for all when entering + ;; an Edebugged function), but instead it would have to + ;; be installed into a modified `edebug-after' which wraps + ;; the `handler-bind' around its argument(s). :-( (let ((signal-hook-function #'edebug-signal)) (setq edebug-execution-mode (or edebug-next-execution-mode edebug-initial-mode @@ -3348,7 +3349,7 @@ With prefix argument, make it a temporary breakpoint." (message "%s" msg))) -(defalias 'edebug-step-through-mode 'edebug-step-mode) +(defalias 'edebug-step-through-mode #'edebug-step-mode) (defun edebug-step-mode () "Proceed to next stop point." @@ -3836,12 +3837,12 @@ be installed in `emacs-lisp-mode-map'.") ;; Global GUD bindings for all emacs-lisp-mode buffers. (unless edebug-inhibit-emacs-lisp-mode-bindings - (define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode) - (define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode) - (define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode) - (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where) + (define-key emacs-lisp-mode-map "\C-x\C-a\C-s" #'edebug-step-mode) + (define-key emacs-lisp-mode-map "\C-x\C-a\C-n" #'edebug-next-mode) + (define-key emacs-lisp-mode-map "\C-x\C-a\C-c" #'edebug-go-mode) + (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" #'edebug-where) ;; The following isn't a GUD binding. - (define-key emacs-lisp-mode-map "\C-x\C-a\C-m" 'edebug-set-initial-mode)) + (define-key emacs-lisp-mode-map "\C-x\C-a\C-m" #'edebug-set-initial-mode)) (defvar-keymap edebug-mode-map :parent emacs-lisp-mode-map -- cgit v1.2.3 From 5e69376292994ffe69b7f8f52ae1ad85c60c2d29 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 5 Feb 2024 17:56:11 +0100 Subject: Grudgingly accept function values in the function position * lisp/emacs-lisp/cconv.el (cconv-convert): Warn about (F ...) where F is a non-symbol function value (bytecode object etc), but let it pass for compatibility's sake (bug#68931). * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp--fun-value-as-head): New test. --- lisp/emacs-lisp/cconv.el | 12 ++++++++---- test/lisp/emacs-lisp/bytecomp-tests.el | 16 ++++++++++++++++ 2 files changed, 24 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index e210cfdf5ce..4ff47971351 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -621,12 +621,16 @@ places where they originally did not directly appear." (cconv-convert exp env extend)) (`(,func . ,forms) - (if (symbolp func) + (if (or (symbolp func) (functionp func)) ;; First element is function or whatever function-like forms are: ;; or, and, if, catch, progn, prog1, while, until - `(,func . ,(mapcar (lambda (form) - (cconv-convert form env extend)) - forms)) + (let ((args (mapcar (lambda (form) (cconv-convert form env extend)) + forms))) + (unless (symbolp func) + (byte-compile-warn-x + form + "Use `funcall' instead of `%s' in the function position" func)) + `(,func . ,args)) (byte-compile-warn-x form "Malformed function `%S'" func) nil)) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index dcb72e4105a..8ccac492141 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -848,6 +848,22 @@ byte-compiled. Run with dynamic binding." (should (equal (bytecomp-tests--eval-interpreted form) (bytecomp-tests--eval-compiled form))))))) +(ert-deftest bytecomp--fun-value-as-head () + ;; Check that (FUN-VALUE ...) is a valid call, for compatibility (bug#68931). + ;; (There is also a warning but this test does not check that.) + (dolist (lb '(nil t)) + (ert-info ((prin1-to-string lb) :prefix "lexical-binding: ") + (let* ((lexical-binding lb) + (s-int '(lambda (x) (1+ x))) + (s-comp (byte-compile s-int)) + (v-int (lambda (x) (1+ x))) + (v-comp (byte-compile v-int)) + (comp (lambda (f) (funcall (byte-compile `(lambda () (,f 3))))))) + (should (equal (funcall comp s-int) 4)) + (should (equal (funcall comp s-comp) 4)) + (should (equal (funcall comp v-int) 4)) + (should (equal (funcall comp v-comp) 4)))))) + (defmacro bytecomp-tests--with-fresh-warnings (&rest body) `(let ((macroexp--warned ; oh dear (make-hash-table :test #'equal :weakness 'key))) -- cgit v1.2.3 From aedfb4f04837ef7b6f50d6a9d833a3ec0f33b11d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 5 Feb 2024 14:50:45 -0500 Subject: (gitmerge-mode-font-lock-keywords): Don't use font-lock-*-face vars * admin/gitmerge.el (gitmerge-mode-font-lock-keywords): Refer to the faces directly. --- admin/gitmerge.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/admin/gitmerge.el b/admin/gitmerge.el index 7c815c729e5..32d5c3c1bea 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -111,10 +111,10 @@ If nil, the function `gitmerge-default-branch' guesses.") (defvar gitmerge-mode-font-lock-keywords `((,gitmerge-log-regexp - (1 font-lock-warning-face) - (2 font-lock-constant-face) - (3 font-lock-builtin-face) - (4 font-lock-comment-face)))) + (1 'font-lock-warning-face) + (2 'font-lock-constant-face) + (3 'font-lock-builtin-face) + (4 'font-lock-comment-face)))) (defvar gitmerge--commits nil) (defvar gitmerge--from nil) -- cgit v1.2.3 From 10faaa3c91045390755791c21349cd562546fdea Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 5 Feb 2024 17:58:47 -0500 Subject: Prefer `ITREE_FOREACH` over `overlays_in` Use `ITREE_FOREACH` instead of `overlays_in` if that can save us from allocating an array. * src/buffer.c (overlays_in): Mark as static. (mouse_face_overlay_overlaps): Use `ITREE_FOREACH` instead of `overlays_in`. (disable_line_numbers_overlay_at_eob): Same, and also change return value to a boolean. * src/buffer.h (overlays_in): Don't declare. * src/editfns.c (overlays_around): Delete function. (Fget_pos_property): Use `ITREE_FOREACH` and keep the "best so far" instead of using `overlays_in` and sorting the elements. * src/lisp.h (disable_line_numbers_overlay_at_eob): Change return type to a boolean. * src/xdisp.c (should_produce_line_number): Adjust accordingly. --- src/buffer.c | 60 +++++++++++++++---------------------------- src/buffer.h | 2 -- src/editfns.c | 82 +++++++++++++++++++---------------------------------------- src/lisp.h | 2 +- src/xdisp.c | 2 +- 5 files changed, 49 insertions(+), 99 deletions(-) diff --git a/src/buffer.c b/src/buffer.c index 352aca8ddfd..d67e1d67cd6 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -3002,7 +3002,7 @@ the normal hook `change-major-mode-hook'. */) But still return the total number of overlays. */ -ptrdiff_t +static ptrdiff_t overlays_in (ptrdiff_t beg, ptrdiff_t end, bool extend, Lisp_Object **vec_ptr, ptrdiff_t *len_ptr, bool empty, bool trailing, @@ -3125,56 +3125,38 @@ mouse_face_overlay_overlaps (Lisp_Object overlay) { ptrdiff_t start = OVERLAY_START (overlay); ptrdiff_t end = OVERLAY_END (overlay); - ptrdiff_t n, i, size; - Lisp_Object *v, tem; - Lisp_Object vbuf[10]; - USE_SAFE_ALLOCA; + Lisp_Object tem; + struct itree_node *node; - size = ARRAYELTS (vbuf); - v = vbuf; - n = overlays_in (start, end, 0, &v, &size, true, false, NULL); - if (n > size) + ITREE_FOREACH (node, current_buffer->overlays, + start, min (end, ZV) + 1, + ASCENDING) { - SAFE_NALLOCA (v, 1, n); - overlays_in (start, end, 0, &v, &n, true, false, NULL); + if (node->begin < end && node->end > start + && node->begin < node->end + && !EQ (node->data, overlay) + && (tem = Foverlay_get (overlay, Qmouse_face), + !NILP (tem))) + return true; } - - for (i = 0; i < n; ++i) - if (!EQ (v[i], overlay) - && (tem = Foverlay_get (overlay, Qmouse_face), - !NILP (tem))) - break; - - SAFE_FREE (); - return i < n; + return false; } /* Return the value of the 'display-line-numbers-disable' property at EOB, if there's an overlay at ZV with a non-nil value of that property. */ -Lisp_Object +bool disable_line_numbers_overlay_at_eob (void) { - ptrdiff_t n, i, size; - Lisp_Object *v, tem = Qnil; - Lisp_Object vbuf[10]; - USE_SAFE_ALLOCA; + Lisp_Object tem = Qnil; + struct itree_node *node; - size = ARRAYELTS (vbuf); - v = vbuf; - n = overlays_in (ZV, ZV, 0, &v, &size, false, false, NULL); - if (n > size) + ITREE_FOREACH (node, current_buffer->overlays, ZV, ZV, ASCENDING) { - SAFE_NALLOCA (v, 1, n); - overlays_in (ZV, ZV, 0, &v, &n, false, false, NULL); + if ((tem = Foverlay_get (node->data, Qdisplay_line_numbers_disable), + !NILP (tem))) + return true; } - - for (i = 0; i < n; ++i) - if ((tem = Foverlay_get (v[i], Qdisplay_line_numbers_disable), - !NILP (tem))) - break; - - SAFE_FREE (); - return tem; + return false; } diff --git a/src/buffer.h b/src/buffer.h index 9e0982f5da7..87ba2802b39 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -1174,8 +1174,6 @@ extern void delete_all_overlays (struct buffer *); extern void reset_buffer (struct buffer *); extern void compact_buffer (struct buffer *); extern ptrdiff_t overlays_at (ptrdiff_t, bool, Lisp_Object **, ptrdiff_t *, ptrdiff_t *); -extern ptrdiff_t overlays_in (ptrdiff_t, ptrdiff_t, bool, Lisp_Object **, - ptrdiff_t *, bool, bool, ptrdiff_t *); extern ptrdiff_t previous_overlay_change (ptrdiff_t); extern ptrdiff_t next_overlay_change (ptrdiff_t); extern ptrdiff_t sort_overlays (Lisp_Object *, ptrdiff_t, struct window *); diff --git a/src/editfns.c b/src/editfns.c index 0cecd81c07f..cce52cddbf8 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -272,24 +272,6 @@ If you set the marker not to point anywhere, the buffer will have no mark. */) } -/* Find all the overlays in the current buffer that touch position POS. - Return the number found, and store them in a vector in VEC - of length LEN. - - Note: this can return overlays that do not touch POS. The caller - should filter these out. */ - -static ptrdiff_t -overlays_around (ptrdiff_t pos, Lisp_Object *vec, ptrdiff_t len) -{ - /* Find all potentially rear-advance overlays at (POS - 1). Find - all overlays at POS, so end at (POS + 1). Find even empty - overlays, which due to the way 'overlays-in' works implies that - we might also fetch empty overlays starting at (POS + 1). */ - return overlays_in (pos - 1, pos + 1, false, &vec, &len, - true, false, NULL); -} - DEFUN ("get-pos-property", Fget_pos_property, Sget_pos_property, 2, 3, 0, doc: /* Return the value of POSITION's property PROP, in OBJECT. Almost identical to `get-char-property' except for the following difference: @@ -315,53 +297,41 @@ at POSITION. */) else { EMACS_INT posn = XFIXNUM (position); - ptrdiff_t noverlays; - Lisp_Object *overlay_vec, tem; + Lisp_Object tem; struct buffer *obuf = current_buffer; - USE_SAFE_ALLOCA; - - set_buffer_temp (XBUFFER (object)); + struct itree_node *node; + struct sortvec items[2]; + struct sortvec *result = NULL; + struct buffer *b = XBUFFER (object); + Lisp_Object res = Qnil; - /* First try with room for 40 overlays. */ - Lisp_Object overlay_vecbuf[40]; - noverlays = ARRAYELTS (overlay_vecbuf); - overlay_vec = overlay_vecbuf; - noverlays = overlays_around (posn, overlay_vec, noverlays); + set_buffer_temp (b); - /* If there are more than 40, - make enough space for all, and try again. */ - if (ARRAYELTS (overlay_vecbuf) < noverlays) + ITREE_FOREACH (node, b->overlays, posn - 1, posn + 1, ASCENDING) { - SAFE_ALLOCA_LISP (overlay_vec, noverlays); - noverlays = overlays_around (posn, overlay_vec, noverlays); - } - noverlays = sort_overlays (overlay_vec, noverlays, NULL); - - set_buffer_temp (obuf); - - /* Now check the overlays in order of decreasing priority. */ - while (--noverlays >= 0) - { - Lisp_Object ol = overlay_vec[noverlays]; + Lisp_Object ol = node->data; tem = Foverlay_get (ol, prop); - if (!NILP (tem)) - { + if (NILP (tem) /* Check the overlay is indeed active at point. */ - if ((OVERLAY_START (ol) == posn + || ((node->begin == posn && OVERLAY_FRONT_ADVANCE_P (ol)) - || (OVERLAY_END (ol) == posn + || (node->end == posn && ! OVERLAY_REAR_ADVANCE_P (ol)) - || OVERLAY_START (ol) > posn - || OVERLAY_END (ol) < posn) - ; /* The overlay will not cover a char inserted at point. */ - else - { - SAFE_FREE (); - return tem; - } - } + || node->begin > posn + || node->end < posn)) + /* The overlay will not cover a char inserted at point. */ + continue; + + struct sortvec *this = (result == items ? items + 1 : items); + if (NILP (res) + || (make_sortvec_item (this, node->data), + compare_overlays (result, this) < 0)) + res = tem; } - SAFE_FREE (); + set_buffer_temp (obuf); + + if (!NILP (res)) + return res; { /* Now check the text properties. */ int stickiness = text_property_stickiness (prop, position, object); diff --git a/src/lisp.h b/src/lisp.h index 75134425a07..e6fd8cacb1b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4802,7 +4802,7 @@ extern void syms_of_editfns (void); /* Defined in buffer.c. */ extern bool mouse_face_overlay_overlaps (Lisp_Object); -extern Lisp_Object disable_line_numbers_overlay_at_eob (void); +extern bool disable_line_numbers_overlay_at_eob (void); extern AVOID nsberror (Lisp_Object); extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t, bool); extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t); diff --git a/src/xdisp.c b/src/xdisp.c index 750ebb703a6..2dcf0d58a14 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -25060,7 +25060,7 @@ should_produce_line_number (struct it *it) because get-char-property always returns nil for ZV, except if the property is in 'default-text-properties'. */ if (NILP (val) && IT_CHARPOS (*it) >= ZV) - val = disable_line_numbers_overlay_at_eob (); + return !disable_line_numbers_overlay_at_eob (); return NILP (val) ? true : false; } -- cgit v1.2.3 From cebd26b2e16d75a939e2a9f91becc6ec702122a7 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Mon, 5 Feb 2024 23:12:36 -0800 Subject: Use treesit-node-match-p in treesit-parent-while The previous commit should've done this, but I missed it. * lisp/treesit.el (treesit-parent-while): Use treesit-node-match-p. --- lisp/treesit.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/treesit.el b/lisp/treesit.el index f179204d89c..6a485ae591a 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -366,7 +366,7 @@ returns nil. PRED can be a predicate function, a regexp matching node type, and more; see docstring of `treesit-thing-settings'." (let ((last nil)) - (while (and node (funcall pred node)) + (while (and node (treesit-node-match-p node pred)) (setq last node node (treesit-node-parent node))) last)) -- cgit v1.2.3 From 0d2b7120783255fbb0f8e98717573c35425f4df6 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 6 Feb 2024 13:10:57 +0800 Subject: Don't forcibly display dialogs on Android if a keyboard is present * java/org/gnu/emacs/EmacsService.java (detectKeyboard): New function. * lisp/subr.el (use-dialog-box-p): Don't always return t if a keyboard is present on Android. * src/android.c (android_init_emacs_service): Link to new function. (android_detect_keyboard): New function. * src/android.h: Update prototypes. * src/androidfns.c (Fandroid_detect_keyboard) (syms_of_androidfns): New function. --- java/org/gnu/emacs/EmacsService.java | 10 ++++++++++ lisp/subr.el | 6 +++++- src/android.c | 16 ++++++++++++++++ src/android.h | 2 ++ src/androidfns.c | 20 ++++++++++++++++++++ 5 files changed, 53 insertions(+), 1 deletion(-) diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 5cb1ceca0aa..93e34e6e694 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -60,6 +60,7 @@ import android.content.UriPermission; import android.content.pm.PackageManager; import android.content.res.AssetManager; +import android.content.res.Configuration; import android.hardware.input.InputManager; @@ -581,6 +582,15 @@ public final class EmacsService extends Service return false; } + public boolean + detectKeyboard () + { + Configuration configuration; + + configuration = getResources ().getConfiguration (); + return configuration.keyboard != Configuration.KEYBOARD_NOKEYS; + } + public String nameKeysym (int keysym) { diff --git a/lisp/subr.el b/lisp/subr.el index 582415a9761..e53ef505522 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3829,13 +3829,17 @@ confusing to some users.") (defvar from--tty-menu-p nil "Non-nil means the current command was invoked from a TTY menu.") + +(declare-function android-detect-keyboard "androidfns.c") + (defun use-dialog-box-p () "Return non-nil if the current command should prompt the user via a dialog box." (and last-input-event ; not during startup (or (consp last-nonmenu-event) ; invoked by a mouse event (and (null last-nonmenu-event) (consp last-input-event)) - (featurep 'android) ; Prefer dialog boxes on Android. + (and (featurep 'android) ; Prefer dialog boxes on Android. + (not (android-detect-keyboard))) ; If no keyboard is connected. from--tty-menu-p) ; invoked via TTY menu use-dialog-box)) diff --git a/src/android.c b/src/android.c index 4a74f5b2af4..2c0e4f845f4 100644 --- a/src/android.c +++ b/src/android.c @@ -1593,6 +1593,7 @@ android_init_emacs_service (void) FIND_METHOD (get_screen_width, "getScreenWidth", "(Z)I"); FIND_METHOD (get_screen_height, "getScreenHeight", "(Z)I"); FIND_METHOD (detect_mouse, "detectMouse", "()Z"); + FIND_METHOD (detect_keyboard, "detectKeyboard", "()Z"); FIND_METHOD (name_keysym, "nameKeysym", "(I)Ljava/lang/String;"); FIND_METHOD (browse_url, "browseUrl", "(Ljava/lang/String;Z)" "Ljava/lang/String;"); @@ -5626,6 +5627,21 @@ android_detect_mouse (void) return rc; } +bool +android_detect_keyboard (void) +{ + bool rc; + jmethodID method; + + method = service_class.detect_keyboard; + rc = (*android_java_env)->CallNonvirtualBooleanMethod (android_java_env, + emacs_service, + service_class.class, + method); + android_exception_check (); + return rc; +} + void android_set_dont_focus_on_map (android_window handle, bool no_focus_on_map) diff --git a/src/android.h b/src/android.h index 2f5f32037c5..bd19c4d9ac8 100644 --- a/src/android.h +++ b/src/android.h @@ -103,6 +103,7 @@ extern int android_get_screen_height (void); extern int android_get_mm_width (void); extern int android_get_mm_height (void); extern bool android_detect_mouse (void); +extern bool android_detect_keyboard (void); extern void android_set_dont_focus_on_map (android_window, bool); extern void android_set_dont_accept_focus (android_window, bool); @@ -265,6 +266,7 @@ struct android_emacs_service jmethodID get_screen_width; jmethodID get_screen_height; jmethodID detect_mouse; + jmethodID detect_keyboard; jmethodID name_keysym; jmethodID browse_url; jmethodID restart_emacs; diff --git a/src/androidfns.c b/src/androidfns.c index eaecb78338b..48c3f3046d6 100644 --- a/src/androidfns.c +++ b/src/androidfns.c @@ -2476,6 +2476,25 @@ there is no mouse. */) #endif } +DEFUN ("android-detect-keyboard", Fandroid_detect_keyboard, + Sandroid_detect_keyboard, 0, 0, 0, + doc: /* Return whether a keyboard is connected. +Return non-nil if a key is connected to this computer, or nil +if there is no keyboard. */) + (void) +{ +#ifndef ANDROID_STUBIFY + /* If no display connection is present, just return nil. */ + + if (!android_init_gui) + return Qnil; + + return android_detect_keyboard () ? Qt : Qnil; +#else /* ANDROID_STUBIFY */ + return Qt; +#endif /* ANDROID_STUBIFY */ +} + DEFUN ("android-toggle-on-screen-keyboard", Fandroid_toggle_on_screen_keyboard, Sandroid_toggle_on_screen_keyboard, 2, 2, 0, @@ -3560,6 +3579,7 @@ language to be US English if LANGUAGE is empty. */); defsubr (&Sx_show_tip); defsubr (&Sx_hide_tip); defsubr (&Sandroid_detect_mouse); + defsubr (&Sandroid_detect_keyboard); defsubr (&Sandroid_toggle_on_screen_keyboard); defsubr (&Sx_server_vendor); defsubr (&Sx_server_version); -- cgit v1.2.3 From 42db7292c3e05920bc9f2fa5c3478eb2ba835c5c Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 6 Feb 2024 17:52:33 +0800 Subject: Implement Lisp threading on Android Much like the NS port, only the main thread receives input from the user interface, which is fortunately not a major problem for packages such as lsp-mode that create Lisp threads. * configure.ac: Enable with_threads under Android. * src/android.c (android_init_events): Set `main_thread_id' to the ID of the main thread. (setEmacsParams): Set new global variable `android_jvm' to the JVM object, for the purpose of attaching Lisp threads to the JVM. (android_select): [THREADS_ENABLED]: If the caller isn't the main thread, resort to pselect. Don't check query before select returns. (android_check_query): Export. * src/android.h (_ANDROID_H_): Define new macro and update prototypes. * src/process.c (android_select_wrapper): New function. (wait_reading_process_output): If THREADS_ENABLED, call thread_select through the Android select wrapper. * src/thread.c (post_acquire_global_lock): Call android_check_query; replace android_java_env with the incoming Lisp thread's. (run_thread): Attach and detach the thread created to the JVM. (init_threads): Set the main thread's JNI environment object. * src/thread.h (struct thread_state) : New field. --- configure.ac | 3 ++- src/android.c | 34 ++++++++++++++++++++++++++++------ src/android.h | 7 +++++++ src/process.c | 33 ++++++++++++++++++++++++++++++--- src/thread.c | 39 +++++++++++++++++++++++++++++++++++++++ src/thread.h | 11 +++++++++++ 6 files changed, 117 insertions(+), 10 deletions(-) diff --git a/configure.ac b/configure.ac index fa8b04ec685..901980c4d8e 100644 --- a/configure.ac +++ b/configure.ac @@ -1231,6 +1231,7 @@ package will likely install on older systems but crash on startup.]) passthrough="$passthrough --with-mailutils=$with_mailutils" passthrough="$passthrough --with-pop=$with_pop" passthrough="$passthrough --with-harfbuzz=$with_harfbuzz" + passthrough="$passthrough --with-threads=$with_png" # Now pass through some checking options. emacs_val="--enable-check-lisp-object-type=$enable_check_lisp_object_type" @@ -1321,6 +1322,7 @@ if test "$ANDROID" = "yes"; then with_pop=no with_harfbuzz=no with_native_compilation=no + with_threads=no fi with_rsvg=no @@ -1331,7 +1333,6 @@ if test "$ANDROID" = "yes"; then with_gpm=no with_dbus=no with_gsettings=no - with_threads=no with_ns=no # zlib is available in android. diff --git a/src/android.c b/src/android.c index 2c0e4f845f4..46f4dcd5546 100644 --- a/src/android.c +++ b/src/android.c @@ -40,6 +40,7 @@ along with GNU Emacs. If not, see . */ #include #include +#include /* Old NDK versions lack MIN and MAX. */ #include @@ -152,6 +153,13 @@ static char *android_files_dir; /* The Java environment being used for the main thread. */ JNIEnv *android_java_env; +#ifdef THREADS_ENABLED + +/* The Java VM new threads attach to. */ +JavaVM *android_jvm; + +#endif /* THREADS_ENABLED */ + /* The EmacsGC class. */ static jclass emacs_gc_class; @@ -496,6 +504,9 @@ android_handle_sigusr1 (int sig, siginfo_t *siginfo, void *arg) This should ideally be defined further down. */ static sem_t android_query_sem; +/* ID of the Emacs thread. */ +static pthread_t main_thread_id; + /* Set up the global event queue by initializing the mutex and two condition variables, and the linked list of events. This must be called before starting the Emacs thread. Also, initialize the @@ -531,6 +542,8 @@ android_init_events (void) event_queue.events.next = &event_queue.events; event_queue.events.last = &event_queue.events; + main_thread_id = pthread_self (); + #if __ANDROID_API__ >= 16 /* Before starting the select thread, make sure the disposition for @@ -579,10 +592,6 @@ android_pending (void) return i; } -/* Forward declaration. */ - -static void android_check_query (void); - /* Wait for events to become available synchronously. Return once an event arrives. Also, reply to the UI thread whenever it requires a response. */ @@ -732,6 +741,12 @@ android_select (int nfds, fd_set *readfds, fd_set *writefds, static char byte; #endif +#ifdef THREADS_ENABLED + if (!pthread_equal (pthread_self (), main_thread_id)) + return pselect (nfds, readfds, writefds, exceptfds, timeout, + NULL); +#endif /* THREADS_ENABLED */ + /* Since Emacs is reading keyboard input again, signify that queries from input methods are no longer ``urgent''. */ @@ -837,9 +852,11 @@ android_select (int nfds, fd_set *readfds, fd_set *writefds, if (nfds_return < 0) errno = EINTR; +#ifndef THREADS_ENABLED /* Now check for and run anything the UI thread wants to run in the main thread. */ android_check_query (); +#endif /* THREADS_ENABLED */ return nfds_return; } @@ -1315,12 +1332,17 @@ NATIVE_NAME (setEmacsParams) (JNIEnv *env, jobject object, const char *java_string; struct stat statb; +#ifdef THREADS_ENABLED + /* Save the Java VM. */ + if ((*env)->GetJavaVM (env, &android_jvm)) + emacs_abort (); +#endif /* THREADS_ENABLED */ + /* Set the Android API level early, as it is used by `android_vfs_init'. */ android_api_level = api_level; /* This function should only be called from the main thread. */ - android_pixel_density_x = pixel_density_x; android_pixel_density_y = pixel_density_y; android_scaled_pixel_density = scaled_density; @@ -6717,7 +6739,7 @@ static void *android_query_context; /* Run any function that the UI thread has asked to run, and then signal its completion. */ -static void +void android_check_query (void) { void (*proc) (void *); diff --git a/src/android.h b/src/android.h index bd19c4d9ac8..e1834cebf68 100644 --- a/src/android.h +++ b/src/android.h @@ -24,6 +24,8 @@ along with GNU Emacs. If not, see . */ a table of function pointers. */ #ifndef _ANDROID_H_ +#define _ANDROID_H_ + #ifndef ANDROID_STUBIFY #include #include @@ -226,6 +228,7 @@ extern void android_display_toast (const char *); /* Event loop functions. */ +extern void android_check_query (void); extern void android_check_query_urgent (void); extern int android_run_in_emacs_thread (void (*) (void *), void *); extern void android_write_event (union android_event *); @@ -299,6 +302,10 @@ struct android_emacs_service extern JNIEnv *android_java_env; +#ifdef THREADS_ENABLED +extern JavaVM *android_jvm; +#endif /* THREADS_ENABLED */ + /* The EmacsService object. */ extern jobject emacs_service; diff --git a/src/process.c b/src/process.c index ddab9ed6c01..48a2c0c8e53 100644 --- a/src/process.c +++ b/src/process.c @@ -5209,6 +5209,27 @@ wait_reading_process_output_1 (void) { } +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY \ + && defined THREADS_ENABLED + +/* Wrapper around `android_select' that exposes a calling interface with + an extra argument for compatibility with `thread_pselect'. */ + +static int +android_select_wrapper (int nfds, fd_set *readfds, fd_set *writefds, + fd_set *exceptfds, const struct timespec *timeout, + const sigset_t *sigmask) +{ + /* sigmask is not supported. */ + if (sigmask) + emacs_abort (); + + return android_select (nfds, readfds, writefds, exceptfds, + (struct timespec *) timeout); +} + +#endif /* HAVE_ANDROID && !ANDROID_STUBIFY && THREADS_ENABLED */ + /* Read and dispose of subprocess output while waiting for timeout to elapse and/or keyboard input to be available. @@ -5701,13 +5722,19 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, timeout = short_timeout; #endif - /* Android doesn't support threads and requires using a - replacement for pselect in android.c to poll for - events. */ + /* Android requires using a replacement for pselect in + android.c to poll for events. */ #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY +#ifndef THREADS_ENABLED nfds = android_select (max_desc + 1, &Available, (check_write ? &Writeok : 0), NULL, &timeout); +#else /* THREADS_ENABLED */ + nfds = thread_select (android_select_wrapper, + max_desc + 1, + &Available, (check_write ? &Writeok : 0), + NULL, &timeout, NULL); +#endif /* THREADS_ENABLED */ #else /* Non-macOS HAVE_GLIB builds call thread_select in diff --git a/src/thread.c b/src/thread.c index 040ca39511e..2f5d7a08838 100644 --- a/src/thread.c +++ b/src/thread.c @@ -106,6 +106,12 @@ post_acquire_global_lock (struct thread_state *self) { struct thread_state *prev_thread = current_thread; + /* Switch the JNI interface pointer to the environment assigned to the + current thread. */ +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY + android_java_env = self->java_env; +#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ + /* Do this early on, so that code below could signal errors (e.g., unbind_for_thread_switch might) correctly, because we are already running in the context of the thread pointed by SELF. */ @@ -126,6 +132,12 @@ post_acquire_global_lock (struct thread_state *self) set_buffer_internal_2 (current_buffer); } +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY + /* This step is performed in android_select when built without + threads. */ + android_check_query (); +#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ + /* We could have been signaled while waiting to grab the global lock for the first time since this thread was created, in which case we didn't yet have the opportunity to set up the handlers. Delay @@ -756,6 +768,11 @@ run_thread (void *state) struct thread_state *self = state; struct thread_state **iter; +#ifdef THREADS_ENABLED +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY + jint rc; +#endif /* #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ +#endif /* THREADS_ENABLED */ #ifdef HAVE_NS /* Allocate an autorelease pool in case this thread calls any @@ -766,6 +783,16 @@ run_thread (void *state) void *pool = ns_alloc_autorelease_pool (); #endif +#ifdef THREADS_ENABLED +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY + rc + = (*android_jvm)->AttachCurrentThread (android_jvm, &self->java_env, + NULL); + if (rc != JNI_OK) + emacs_abort (); +#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ +#endif /* THREADS_ENABLED */ + self->m_stack_bottom = self->stack_top = &stack_pos.c; self->thread_id = sys_thread_self (); @@ -812,6 +839,14 @@ run_thread (void *state) ns_release_autorelease_pool (pool); #endif +#ifdef THREADS_ENABLED +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY + rc = (*android_jvm)->DetachCurrentThread (android_jvm); + if (rc != JNI_OK) + emacs_abort (); +#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ +#endif /* THREADS_ENABLED */ + /* Unlink this thread from the list of all threads. Note that we have to do this very late, after broadcasting our death. Otherwise the GC may decide to reap the thread_state object, @@ -1131,6 +1166,10 @@ init_threads (void) sys_mutex_init (&global_lock); sys_mutex_lock (&global_lock); current_thread = &main_thread.s; +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY + current_thread->java_env = android_java_env; +#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ + main_thread.s.thread_id = sys_thread_self (); init_bc_thread (&main_thread.s.bc); } diff --git a/src/thread.h b/src/thread.h index 6ce2b7f30df..1844cf03967 100644 --- a/src/thread.h +++ b/src/thread.h @@ -30,6 +30,12 @@ along with GNU Emacs. If not, see . */ #include /* sigset_t */ #endif +#ifdef HAVE_ANDROID +#ifndef ANDROID_STUBIFY +#include "android.h" +#endif /* ANDROID_STUBIFY */ +#endif /* HAVE_ANDROID */ + #include "sysselect.h" /* FIXME */ #include "systhread.h" @@ -84,6 +90,11 @@ struct thread_state Lisp_Object event_object; /* event_object must be the last Lisp field. */ +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY + /* Pointer to an object to call Java functions through. */ + JNIEnv *java_env; +#endif /* HAVE_ANDROID && !ANDROID_STUBIFY */ + /* An address near the bottom of the stack. Tells GC how to save a copy of the stack. */ char const *m_stack_bottom; -- cgit v1.2.3 From f6225d125c07bbde8c828b40eb6e81333e051c2a Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Tue, 6 Feb 2024 12:39:11 +0100 Subject: Optionally show internal buffers in Buffer Menu mode Internal buffers were never shown before but they can be of interest to Elisp developers, especially since there is no general mechanism to remove unused buffers. * lisp/buff-menu.el (Buffer-menu-show-internal) (Buffer-menu--selection-message, Buffer-menu-toggle-internal): New. (Buffer-menu-mode-map): Bind to `I`. (Buffer-menu-mode-menu): Add menu entry. (list-buffers--refresh): Extend filtering logic. * etc/NEWS: Announce. --- etc/NEWS | 6 ++++++ lisp/buff-menu.el | 33 +++++++++++++++++++++++++++++---- 2 files changed, 35 insertions(+), 4 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 5180c26aa92..f980d612a57 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1303,6 +1303,12 @@ will return the URL for that bug. This allows for rcirc logs to use a custom timestamp format, than the chat buffers use by default. +--- +*** New command 'Buffer-menu-toggle-internal', locally bound to 'I'. +This command toggles the display of internal buffers in Buffer Menu mode; +that is, buffers not visiting a file and whose names start with a space. +Previously, such buffers were never shown. + ** Customize +++ diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 5796544c534..9561141f0c3 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -100,6 +100,10 @@ as it is by default." This is set by the prefix argument to `buffer-menu' and related commands.") +(defvar-local Buffer-menu-show-internal nil + "Non-nil if the current Buffer Menu lists internal buffers. +Internal buffers are those whose names start with a space.") + (defvar-local Buffer-menu-filter-predicate nil "Function to filter out buffers in the buffer list. Buffers that don't satisfy the predicate will be skipped. @@ -140,6 +144,7 @@ then the buffer will be displayed in the buffer list.") "V" #'Buffer-menu-view "O" #'Buffer-menu-view-other-window "T" #'Buffer-menu-toggle-files-only + "I" #'Buffer-menu-toggle-internal "M-s a C-s" #'Buffer-menu-isearch-buffers "M-s a C-M-s" #'Buffer-menu-isearch-buffers-regexp "M-s a C-o" #'Buffer-menu-multi-occur @@ -197,6 +202,10 @@ then the buffer will be displayed in the buffer list.") :help "Toggle whether the current buffer-menu displays only file buffers" :style toggle :selected Buffer-menu-files-only] + ["Show Internal Buffers" Buffer-menu-toggle-internal + :help "Toggle whether the current buffer-menu displays internal buffers" + :style toggle + :selected Buffer-menu-show-internal] "---" ["Refresh" revert-buffer :help "Refresh the *Buffer List* buffer contents"] @@ -317,6 +326,11 @@ ARG, show only buffers that are visiting files." (interactive "P") (display-buffer (list-buffers-noselect arg))) +(defun Buffer-menu--selection-message () + (message (cond (Buffer-menu-files-only "Showing only file-visiting buffers.") + (Buffer-menu-show-internal "Showing all buffers.") + (t "Showing all non-internal buffers.")))) + (defun Buffer-menu-toggle-files-only (arg) "Toggle whether the current `buffer-menu' displays only file buffers. With a positive ARG, display only file buffers. With zero or @@ -325,9 +339,18 @@ negative ARG, display other buffers as well." (setq Buffer-menu-files-only (cond ((not arg) (not Buffer-menu-files-only)) ((> (prefix-numeric-value arg) 0) t))) - (message (if Buffer-menu-files-only - "Showing only file-visiting buffers." - "Showing all non-internal buffers.")) + (Buffer-menu--selection-message) + (revert-buffer)) + +(defun Buffer-menu-toggle-internal (arg) + "Toggle whether the current `buffer-menu' displays internal buffers. +With a positive ARG, display non-internal buffers only. With zero or +negative ARG, display internal buffers as well." + (interactive "P" Buffer-menu-mode) + (setq Buffer-menu-show-internal + (cond ((not arg) (not Buffer-menu-show-internal)) + ((> (prefix-numeric-value arg) 0) t))) + (Buffer-menu--selection-message) (revert-buffer)) (define-obsolete-function-alias 'Buffer-menu-sort 'tabulated-list-sort @@ -667,6 +690,7 @@ See more at `Buffer-menu-filter-predicate'." (marked-buffers (Buffer-menu-marked-buffers)) (buffer-menu-buffer (current-buffer)) (show-non-file (not Buffer-menu-files-only)) + (show-internal Buffer-menu-show-internal) (filter-predicate (and (functionp Buffer-menu-filter-predicate) Buffer-menu-filter-predicate)) entries name-width) @@ -686,7 +710,8 @@ See more at `Buffer-menu-filter-predicate'." (file buffer-file-name)) (when (and (buffer-live-p buffer) (or buffer-list - (and (or (not (string= (substring name 0 1) " ")) + (and (or show-internal + (not (string= (substring name 0 1) " ")) file) (not (eq buffer buffer-menu-buffer)) (or file show-non-file) -- cgit v1.2.3 From e66870400d45e3d08265df9f6acd4631a5712139 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 15 Jan 2024 09:25:02 +0100 Subject: Change hash range reduction from remainder to multiplication This makes both lookups and rehashing cheaper. The index vector size is now always a power of 2. The first table size is reduced to 6 (from 8), because index vectors would become excessively big otherwise. * src/lisp.h (struct Lisp_Hash_Table): Replace index_size with index_bits. All references adapted. (hash_table_index_size): New accessor; use it where applicable. * src/fns.c (hash_index_size): Replace with... (compute_hash_index_bits): ...this new function, returning the log2 of the index size. All callers adapted. (hash_index_index): Knuth multiplicative hashing instead of remainder. (maybe_resize_hash_table): Reduce first table size from 8 to 6. --- src/alloc.c | 7 +++--- src/fns.c | 78 +++++++++++++++++++++++++++++------------------------------ src/lisp.h | 13 +++++++--- src/pdumper.c | 2 +- 4 files changed, 54 insertions(+), 46 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 15bb65cf74f..6abe9e28650 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3443,7 +3443,7 @@ cleanup_vector (struct Lisp_Vector *vector) struct Lisp_Hash_Table *h = PSEUDOVEC_STRUCT (vector, Lisp_Hash_Table); if (h->table_size > 0) { - eassert (h->index_size > 1); + eassert (h->index_bits > 0); xfree (h->index); xfree (h->key_and_value); xfree (h->next); @@ -3451,7 +3451,7 @@ cleanup_vector (struct Lisp_Vector *vector) ptrdiff_t bytes = (h->table_size * (2 * sizeof *h->key_and_value + sizeof *h->hash + sizeof *h->next) - + h->index_size * sizeof *h->index); + + hash_table_index_size (h) * sizeof *h->index); hash_table_allocated_bytes -= bytes; } } @@ -5959,7 +5959,8 @@ purecopy_hash_table (struct Lisp_Hash_Table *table) for (ptrdiff_t i = 0; i < nvalues; i++) pure->key_and_value[i] = purecopy (table->key_and_value[i]); - ptrdiff_t index_bytes = table->index_size * sizeof *table->index; + ptrdiff_t index_bytes = hash_table_index_size (table) + * sizeof *table->index; pure->index = pure_alloc (index_bytes, -(int)sizeof *table->index); memcpy (pure->index, table->index, index_bytes); } diff --git a/src/fns.c b/src/fns.c index 08908d481a3..7de2616b359 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4291,7 +4291,7 @@ set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, hash_hash_t val) static void set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) { - eassert (idx >= 0 && idx < h->index_size); + eassert (idx >= 0 && idx < hash_table_index_size (h)); h->index[idx] = val; } @@ -4392,7 +4392,7 @@ HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx) static ptrdiff_t HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) { - eassert (idx >= 0 && idx < h->index_size); + eassert (idx >= 0 && idx < hash_table_index_size (h)); return h->index[idx]; } @@ -4527,26 +4527,19 @@ allocate_hash_table (void) return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Hash_Table, PVEC_HASH_TABLE); } -/* Compute the size of the index from the table capacity. */ -static ptrdiff_t -hash_index_size (ptrdiff_t size) -{ - /* An upper bound on the size of a hash table index. It must fit in - ptrdiff_t and be a valid Emacs fixnum. */ - ptrdiff_t upper_bound = min (MOST_POSITIVE_FIXNUM, - min (TYPE_MAXIMUM (hash_idx_t), - PTRDIFF_MAX / sizeof (ptrdiff_t))); - /* Single-element index vectors are used iff size=0. */ - eassert (size > 0); - ptrdiff_t lower_bound = 2; - ptrdiff_t index_size = size + max (size >> 2, 1); /* 1.25x larger */ - if (index_size < upper_bound) - index_size = (index_size < lower_bound - ? lower_bound - : next_almost_prime (index_size)); - if (index_size > upper_bound) +/* Compute the size of the index (as log2) from the table capacity. */ +static int +compute_hash_index_bits (hash_idx_t size) +{ + /* An upper bound on the size of a hash table index index. */ + hash_idx_t upper_bound = min (MOST_POSITIVE_FIXNUM, + min (TYPE_MAXIMUM (hash_idx_t), + PTRDIFF_MAX / sizeof (hash_idx_t))); + /* Use next higher power of 2. This works even for size=0. */ + int bits = elogb (size) + 1; + if (bits >= TYPE_WIDTH (uintmax_t) || ((uintmax_t)1 << bits) > upper_bound) error ("Hash table too large"); - return index_size; + return bits; } /* Constant hash index vector used when the table size is zero. @@ -4587,7 +4580,7 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size, h->key_and_value = NULL; h->hash = NULL; h->next = NULL; - h->index_size = 1; + h->index_bits = 0; h->index = (hash_idx_t *)empty_hash_index_vector; h->next_free = -1; } @@ -4605,8 +4598,9 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size, h->next[i] = i + 1; h->next[size - 1] = -1; - int index_size = hash_index_size (size); - h->index_size = index_size; + int index_bits = compute_hash_index_bits (size); + h->index_bits = index_bits; + ptrdiff_t index_size = hash_table_index_size (h); h->index = hash_table_alloc_bytes (index_size * sizeof *h->index); for (ptrdiff_t i = 0; i < index_size; i++) h->index[i] = -1; @@ -4654,7 +4648,7 @@ copy_hash_table (struct Lisp_Hash_Table *h1) h2->next = hash_table_alloc_bytes (next_bytes); memcpy (h2->next, h1->next, next_bytes); - ptrdiff_t index_bytes = h1->index_size * sizeof *h1->index; + ptrdiff_t index_bytes = hash_table_index_size (h1) * sizeof *h1->index; h2->index = hash_table_alloc_bytes (index_bytes); memcpy (h2->index, h1->index, index_bytes); } @@ -4668,8 +4662,11 @@ copy_hash_table (struct Lisp_Hash_Table *h1) static inline ptrdiff_t hash_index_index (struct Lisp_Hash_Table *h, hash_hash_t hash) { - eassert (h->index_size > 0); - return hash % h->index_size; + /* Knuth multiplicative hashing, tailored for 32-bit indices + (avoiding a 64-bit multiply). */ + uint32_t alpha = 2654435769; /* 2**32/phi */ + /* Note the cast to uint64_t, to make it work for index_bits=0. */ + return (uint64_t)((uint32_t)hash * alpha) >> (32 - h->index_bits); } /* Resize hash table H if it's too full. If H cannot be resized @@ -4681,7 +4678,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) if (h->next_free < 0) { ptrdiff_t old_size = HASH_TABLE_SIZE (h); - ptrdiff_t min_size = 8; + ptrdiff_t min_size = 6; ptrdiff_t base_size = min (max (old_size, min_size), PTRDIFF_MAX / 2); /* Grow aggressively at small sizes, then just double. */ ptrdiff_t new_size = @@ -4706,13 +4703,14 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) hash_hash_t *hash = hash_table_alloc_bytes (new_size * sizeof *hash); memcpy (hash, h->hash, old_size * sizeof *hash); - ptrdiff_t old_index_size = h->index_size; - ptrdiff_t index_size = hash_index_size (new_size); + ptrdiff_t old_index_size = hash_table_index_size (h); + ptrdiff_t index_bits = compute_hash_index_bits (new_size); + ptrdiff_t index_size = (ptrdiff_t)1 << index_bits; hash_idx_t *index = hash_table_alloc_bytes (index_size * sizeof *index); for (ptrdiff_t i = 0; i < index_size; i++) index[i] = -1; - h->index_size = index_size; + h->index_bits = index_bits; h->table_size = new_size; h->next_free = old_size; @@ -4778,18 +4776,19 @@ hash_table_thaw (Lisp_Object hash_table) h->key_and_value = NULL; h->hash = NULL; h->next = NULL; - h->index_size = 1; + h->index_bits = 0; h->index = (hash_idx_t *)empty_hash_index_vector; } else { - ptrdiff_t index_size = hash_index_size (size); - h->index_size = index_size; + ptrdiff_t index_bits = compute_hash_index_bits (size); + h->index_bits = index_bits; h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); h->next = hash_table_alloc_bytes (size * sizeof *h->next); + ptrdiff_t index_size = hash_table_index_size (h); h->index = hash_table_alloc_bytes (index_size * sizeof *h->index); for (ptrdiff_t i = 0; i < index_size; i++) h->index[i] = -1; @@ -4937,7 +4936,8 @@ hash_clear (struct Lisp_Hash_Table *h) set_hash_value_slot (h, i, Qnil); } - for (ptrdiff_t i = 0; i < h->index_size; i++) + ptrdiff_t index_size = hash_table_index_size (h); + for (ptrdiff_t i = 0; i < index_size; i++) h->index[i] = -1; h->next_free = 0; @@ -4976,7 +4976,7 @@ keep_entry_p (hash_table_weakness_t weakness, bool sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) { - ptrdiff_t n = h->index_size; + ptrdiff_t n = hash_table_index_size (h); bool marked = false; for (ptrdiff_t bucket = 0; bucket < n; ++bucket) @@ -5701,7 +5701,7 @@ DEFUN ("internal--hash-table-histogram", struct Lisp_Hash_Table *h = check_hash_table (hash_table); ptrdiff_t size = HASH_TABLE_SIZE (h); ptrdiff_t *freq = xzalloc (size * sizeof *freq); - ptrdiff_t index_size = h->index_size; + ptrdiff_t index_size = hash_table_index_size (h); for (ptrdiff_t i = 0; i < index_size; i++) { ptrdiff_t n = 0; @@ -5729,7 +5729,7 @@ Internal use only. */) { struct Lisp_Hash_Table *h = check_hash_table (hash_table); Lisp_Object ret = Qnil; - ptrdiff_t index_size = h->index_size; + ptrdiff_t index_size = hash_table_index_size (h); for (ptrdiff_t i = 0; i < index_size; i++) { Lisp_Object bucket = Qnil; @@ -5750,7 +5750,7 @@ DEFUN ("internal--hash-table-index-size", (Lisp_Object hash_table) { struct Lisp_Hash_Table *h = check_hash_table (hash_table); - return make_int (h->index_size); + return make_int (hash_table_index_size (h)); } diff --git a/src/lisp.h b/src/lisp.h index e6fd8cacb1b..d6bbf15d83b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2475,14 +2475,14 @@ struct Lisp_Hash_Table The table is physically split into three vectors (hash, next, key_and_value) which may or may not be beneficial. */ - hash_idx_t index_size; /* Size of the index vector. */ + int index_bits; /* log2 (size of the index vector). */ hash_idx_t table_size; /* Size of the next and hash vectors. */ /* Bucket vector. An entry of -1 indicates no item is present, and a nonnegative entry is the index of the first item in a collision chain. - This vector is index_size entries long. - If index_size is 1 (and table_size is 0), then this is the + This vector is 2**index_bits entries long. + If index_bits is 0 (and table_size is 0), then this is the constant read-only vector {-1}, shared between all instances. Otherwise it is heap-allocated. */ hash_idx_t *index; @@ -2597,6 +2597,13 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) return h->table_size; } +/* Size of the index vector in hash table H. */ +INLINE ptrdiff_t +hash_table_index_size (const struct Lisp_Hash_Table *h) +{ + return (ptrdiff_t)1 << h->index_bits; +} + /* Hash value for KEY in hash table H. */ INLINE hash_hash_t hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) diff --git a/src/pdumper.c b/src/pdumper.c index ee554cda55a..b8006b035ea 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2688,7 +2688,7 @@ hash_table_freeze (struct Lisp_Hash_Table *h) h->hash = NULL; h->index = NULL; h->table_size = 0; - h->index_size = 0; + h->index_bits = 0; h->frozen_test = hash_table_std_test (h->test); h->test = NULL; } -- cgit v1.2.3 From 05e3183ede3a08993a7d209fb14153abaed0c74e Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Tue, 6 Feb 2024 15:23:53 +0100 Subject: Rearrange and pack hash table fields to reduce space * src/lisp.h (struct Lisp_Hash_Table): Move and reduce width of fields where possible; this saves an entire word at no apparent cost. --- src/lisp.h | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index d6bbf15d83b..5326824bf38 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2475,9 +2475,6 @@ struct Lisp_Hash_Table The table is physically split into three vectors (hash, next, key_and_value) which may or may not be beneficial. */ - int index_bits; /* log2 (size of the index vector). */ - hash_idx_t table_size; /* Size of the next and hash vectors. */ - /* Bucket vector. An entry of -1 indicates no item is present, and a nonnegative entry is the index of the first item in a collision chain. @@ -2514,20 +2511,24 @@ struct Lisp_Hash_Table /* Index of first free entry in free list, or -1 if none. */ hash_idx_t next_free; + hash_idx_t table_size; /* Size of the next and hash vectors. */ + + unsigned char index_bits; /* log2 (size of the index vector). */ + /* Weakness of the table. */ - hash_table_weakness_t weakness : 8; + hash_table_weakness_t weakness : 3; /* Hash table test (only used when frozen in dump) */ - hash_table_std_test_t frozen_test : 8; + hash_table_std_test_t frozen_test : 2; /* True if the table can be purecopied. The table cannot be changed afterwards. */ - bool purecopy; + bool_bf purecopy : 1; /* True if the table is mutable. Ordinarily tables are mutable, but pure tables are not, and while a table is being mutated it is immutable for recursive attempts to mutate it. */ - bool mutable; + bool_bf mutable : 1; /* Next weak hash table if this is a weak hash table. The head of the list is in weak_hash_tables. Used only during garbage -- cgit v1.2.3 From ce7365b591852dd5556e0a4bf6a0ba63a8733802 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 6 Feb 2024 19:55:41 +0200 Subject: Use new variable Buffer-menu-show-internal in project-list-buffers. * lisp/progmodes/project.el (project-list-buffers): Add the new variable `Buffer-menu-show-internal' used to toggle internal buffers (bug#68949). --- lisp/progmodes/project.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index da782ad5537..983c0ed2ac2 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1515,7 +1515,8 @@ ARG, show only buffers that are visiting files." (lambda (buffer) (let ((name (buffer-name buffer)) (file (buffer-file-name buffer))) - (and (or (not (string= (substring name 0 1) " ")) + (and (or Buffer-menu-show-internal + (not (string= (substring name 0 1) " ")) file) (not (eq buffer (current-buffer))) (or file (not Buffer-menu-files-only))))) @@ -1525,6 +1526,7 @@ ARG, show only buffers that are visiting files." (let ((buf (list-buffers-noselect arg (with-current-buffer (get-buffer-create "*Buffer List*") + (setq-local Buffer-menu-show-internal nil) (let ((Buffer-menu-files-only arg)) (funcall buffer-list-function)))))) (with-current-buffer buf -- cgit v1.2.3 From a2201a2034a86b4cc90132ab2d920456866c11e3 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 6 Feb 2024 13:21:22 -0500 Subject: (loaddefs-generate--parse-file): Be a bit more defensive * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--parse-file): Don't fail in case of an error while generating the prefixes. (loaddefs-generate--compute-prefixes): Don't burp when `read-from-string` returns something else than a symbol. --- lisp/emacs-lisp/loaddefs-gen.el | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 7eced43e735..7cfb14ace5f 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -489,10 +489,12 @@ don't include." (when (and autoload-compute-prefixes compute-prefixes) - (when-let ((form (loaddefs-generate--compute-prefixes load-name))) - ;; This output needs to always go in the main loaddefs.el, - ;; regardless of `generated-autoload-file'. - (push (list main-outfile file form) defs))))) + (with-demoted-errors "%S" + (when-let + ((form (loaddefs-generate--compute-prefixes load-name))) + ;; This output needs to always go in the main loaddefs.el, + ;; regardless of `generated-autoload-file'. + (push (list main-outfile file form) defs)))))) defs)) (defun loaddefs-generate--compute-prefixes (load-name) @@ -506,14 +508,15 @@ don't include." ;; Consider `read-symbol-shorthands'. (probe (let ((obarray (obarray-make))) (car (read-from-string name))))) - (setq name (symbol-name probe)) - (when (save-excursion - (goto-char (match-beginning 0)) - (or (bobp) - (progn - (forward-line -1) - (not (looking-at ";;;###autoload"))))) - (push name prefs))))) + (when (symbolp name) + (setq name (symbol-name probe)) + (when (save-excursion + (goto-char (match-beginning 0)) + (or (bobp) + (progn + (forward-line -1) + (not (looking-at ";;;###autoload"))))) + (push name prefs)))))) (loaddefs-generate--make-prefixes prefs load-name))) (defun loaddefs-generate--rubric (file &optional type feature compile) -- cgit v1.2.3 From ab318cce1e97f4b9c78adc3290784105b78f0728 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 6 Feb 2024 21:55:57 +0200 Subject: ; Fix last change in buffer-menu.el * etc/NEWS: Elaborate about the binding of the new command. * lisp/buff-menu.el (Buffer-menu--selection-message): Fix wording of new message. (Buffer-menu-toggle-internal): Doc fix. (Bug#68949) --- etc/NEWS | 3 ++- lisp/buff-menu.el | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index f980d612a57..ee7462cb2aa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1307,7 +1307,8 @@ chat buffers use by default. *** New command 'Buffer-menu-toggle-internal', locally bound to 'I'. This command toggles the display of internal buffers in Buffer Menu mode; that is, buffers not visiting a file and whose names start with a space. -Previously, such buffers were never shown. +Previously, such buffers were never shown. This command is bound to 'I' +in Buffer menu mode. ** Customize diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 9561141f0c3..29ca3b41f0c 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -329,7 +329,7 @@ ARG, show only buffers that are visiting files." (defun Buffer-menu--selection-message () (message (cond (Buffer-menu-files-only "Showing only file-visiting buffers.") (Buffer-menu-show-internal "Showing all buffers.") - (t "Showing all non-internal buffers.")))) + (t "Hiding internal buffers.")))) (defun Buffer-menu-toggle-files-only (arg) "Toggle whether the current `buffer-menu' displays only file buffers. @@ -344,7 +344,7 @@ negative ARG, display other buffers as well." (defun Buffer-menu-toggle-internal (arg) "Toggle whether the current `buffer-menu' displays internal buffers. -With a positive ARG, display non-internal buffers only. With zero or +With a positive ARG, don't show internal buffers. With zero or negative ARG, display internal buffers as well." (interactive "P" Buffer-menu-mode) (setq Buffer-menu-show-internal -- cgit v1.2.3 From 77f240012f1e9a7cfee60adedebc8e6a230ce49b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 6 Feb 2024 15:36:18 -0500 Subject: (loaddefs-generate--compute-prefixes): Fix thinko in last change * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--compute-prefixes): Fix thinko in last change. Also, reduce memory allocation. --- lisp/emacs-lisp/loaddefs-gen.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 7cfb14ace5f..1e91e84157d 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -499,16 +499,17 @@ don't include." (defun loaddefs-generate--compute-prefixes (load-name) (goto-char (point-min)) - (let ((prefs nil)) + (let ((prefs nil) + (temp-obarray (obarray-make))) ;; Avoid (defvar ) by requiring a trailing space. (while (re-search-forward "^(\\(def[^ \t\n]+\\)[ \t\n]+['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t) (unless (member (match-string 1) autoload-ignored-definitions) (let* ((name (match-string-no-properties 2)) ;; Consider `read-symbol-shorthands'. - (probe (let ((obarray (obarray-make))) + (probe (let ((obarray temp-obarray)) (car (read-from-string name))))) - (when (symbolp name) + (when (symbolp probe) (setq name (symbol-name probe)) (when (save-excursion (goto-char (match-beginning 0)) -- cgit v1.2.3 From e25d11314d84cc3e606515d6551e878cec4cfee4 Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Tue, 30 Jan 2024 22:08:50 -0800 Subject: Pass unquoted filename to user-supplied MUSTMATCH predicate * lisp/minibuffer.el (read-file-name-default): Pass REQUIRE-MATCH argument through substitute-in-file-name. * lisp/minibuffer.el (read-file-name): Update docstring. Resolves bug#68815. --- lisp/minibuffer.el | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index faa7f543ece..a9e3ec937f9 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3262,9 +3262,10 @@ Fourth arg MUSTMATCH can take the following values: input, but she needs to confirm her choice if she called `minibuffer-complete' right before `minibuffer-complete-and-exit' and the input is not an existing file. -- a function, which will be called with the input as the - argument. If the function returns a non-nil value, the - minibuffer is exited with that argument as the value. +- a function, which will be called with a single argument, the + input unquoted by `substitute-in-file-name', which see. If the + function returns a non-nil value, the minibuffer is exited with + that argument as the value. - anything else behaves like t except that typing RET does not exit if it does non-null completion. @@ -3353,7 +3354,13 @@ See `read-file-name' for the meaning of the arguments." (let ((ignore-case read-file-name-completion-ignore-case) (minibuffer-completing-file-name t) (pred (or predicate 'file-exists-p)) - (add-to-history nil)) + (add-to-history nil) + (require-match (if (functionp mustmatch) + (lambda (input) + (funcall mustmatch + ;; User-supplied MUSTMATCH expects an unquoted filename + (substitute-in-file-name input))) + mustmatch))) (let* ((val (if (or (not (next-read-file-uses-dialog-p)) @@ -3389,7 +3396,7 @@ See `read-file-name' for the meaning of the arguments." (read-file-name--defaults dir initial)))) (set-syntax-table minibuffer-local-filename-syntax)) (completing-read prompt 'read-file-name-internal - pred mustmatch insdef + pred require-match insdef 'file-name-history default-filename))) ;; If DEFAULT-FILENAME not supplied and DIR contains ;; a file name, split it. -- cgit v1.2.3 From a45e1237b290a9c04b416703825b105321139608 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 7 Feb 2024 09:24:32 +0800 Subject: ; Fix typo in configure.ac * configure.ac: Fix typo. Reported by Juri Linkov . --- configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 901980c4d8e..b74eba879ab 100644 --- a/configure.ac +++ b/configure.ac @@ -1231,7 +1231,7 @@ package will likely install on older systems but crash on startup.]) passthrough="$passthrough --with-mailutils=$with_mailutils" passthrough="$passthrough --with-pop=$with_pop" passthrough="$passthrough --with-harfbuzz=$with_harfbuzz" - passthrough="$passthrough --with-threads=$with_png" + passthrough="$passthrough --with-threads=$with_threads" # Now pass through some checking options. emacs_val="--enable-check-lisp-object-type=$enable_check_lisp_object_type" -- cgit v1.2.3 From c1cdbb987299f6878072fec539bd363e2c3ca015 Mon Sep 17 00:00:00 2001 From: Wilhelm Kirschbaum Date: Fri, 29 Dec 2023 17:09:00 +0200 Subject: Add access_call fontification to elixir-ts-mode * lisp/progmodes/elixir-ts-mode.el (elixir-ts--font-lock-settings): Add access_call queries to the elixir-variable feature (bug#67246). --- lisp/progmodes/elixir-ts-mode.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el index b493195eedd..2c7323c318d 100644 --- a/lisp/progmodes/elixir-ts-mode.el +++ b/lisp/progmodes/elixir-ts-mode.el @@ -546,7 +546,9 @@ (body (identifier) @font-lock-variable-name-face) (unary_operator operand: (identifier) @font-lock-variable-name-face) (interpolation (identifier) @font-lock-variable-name-face) - (do_block (identifier) @font-lock-variable-name-face)) + (do_block (identifier) @font-lock-variable-name-face) + (access_call target: (identifier) @font-lock-variable-name-face) + (access_call "[" key: (identifier) @font-lock-variable-name-face "]")) :language 'elixir :feature 'elixir-builtin -- cgit v1.2.3 From eb90fb52b08a16ae2bdc8bad6929492b9e693f72 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Wed, 7 Feb 2024 03:54:29 +0200 Subject: elixir-ts-mode: Bring the faces' use closer to other ts modes * lisp/progmodes/elixir-ts-mode.el (elixir-ts--font-lock-settings): Rename feature 'elixir-function-name' to 'elixir-definition' and update all deferences. Add parameters' highlighting with font-lock-variable-name-face. Change variable references' highlighting to use font-lock-variable-use-face. Move the feature 'elixir-variable' from feature level 3 to level 4, to match other ts modes (bug#67246). --- lisp/progmodes/elixir-ts-mode.el | 53 ++++++++++++++++++++-------------------- 1 file changed, 27 insertions(+), 26 deletions(-) diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el index 2c7323c318d..57db211e881 100644 --- a/lisp/progmodes/elixir-ts-mode.el +++ b/lisp/progmodes/elixir-ts-mode.el @@ -360,13 +360,14 @@ (defvar elixir-ts--font-lock-settings (treesit-font-lock-rules :language 'elixir - :feature 'elixir-function-name + :feature 'elixir-definition `((call target: (identifier) @target-identifier (arguments (identifier) @font-lock-function-name-face) (:match ,elixir-ts--definition-keywords-re @target-identifier)) (call target: (identifier) @target-identifier (arguments - (call target: (identifier) @font-lock-function-name-face)) + (call target: (identifier) @font-lock-function-name-face + (arguments ((identifier)) @font-lock-variable-name-face))) (:match ,elixir-ts--definition-keywords-re @target-identifier)) (call target: (identifier) @target-identifier (arguments @@ -379,13 +380,15 @@ (:match ,elixir-ts--definition-keywords-re @target-identifier)) (call target: (identifier) @target-identifier (arguments - (call target: (identifier) @font-lock-function-name-face)) + (call target: (identifier) @font-lock-function-name-face + (arguments ((identifier)) @font-lock-variable-name-face))) (do_block) (:match ,elixir-ts--definition-keywords-re @target-identifier)) (call target: (identifier) @target-identifier (arguments (binary_operator - left: (call target: (identifier) @font-lock-function-name-face))) + left: (call target: (identifier) @font-lock-function-name-face + (arguments ((identifier)) @font-lock-variable-name-face)))) (do_block) (:match ,elixir-ts--definition-keywords-re @target-identifier)) (unary_operator @@ -521,8 +524,8 @@ operator: "/" right: (integer))) (call target: (dot right: (identifier) @font-lock-function-call-face)) - (unary_operator operator: "&" @font-lock-variable-name-face - operand: (integer) @font-lock-variable-name-face) + (unary_operator operator: "&" @font-lock-variable-use-face + operand: (integer) @font-lock-variable-use-face) (unary_operator operator: "&" @font-lock-operator-face operand: (list))) @@ -537,18 +540,18 @@ :language 'elixir :feature 'elixir-variable - '((binary_operator left: (identifier) @font-lock-variable-name-face) - (binary_operator right: (identifier) @font-lock-variable-name-face) - (arguments ( (identifier) @font-lock-variable-name-face)) - (tuple (identifier) @font-lock-variable-name-face) - (list (identifier) @font-lock-variable-name-face) - (pair value: (identifier) @font-lock-variable-name-face) - (body (identifier) @font-lock-variable-name-face) - (unary_operator operand: (identifier) @font-lock-variable-name-face) - (interpolation (identifier) @font-lock-variable-name-face) - (do_block (identifier) @font-lock-variable-name-face) - (access_call target: (identifier) @font-lock-variable-name-face) - (access_call "[" key: (identifier) @font-lock-variable-name-face "]")) + '((binary_operator left: (identifier) @font-lock-variable-use-face) + (binary_operator right: (identifier) @font-lock-variable-use-face) + (arguments ( (identifier) @font-lock-variable-use-face)) + (tuple (identifier) @font-lock-variable-use-face) + (list (identifier) @font-lock-variable-use-face) + (pair value: (identifier) @font-lock-variable-use-face) + (body (identifier) @font-lock-variable-use-face) + (unary_operator operand: (identifier) @font-lock-variable-use-face) + (interpolation (identifier) @font-lock-variable-use-face) + (do_block (identifier) @font-lock-variable-use-face) + (access_call target: (identifier) @font-lock-variable-use-face) + (access_call "[" key: (identifier) @font-lock-variable-use-face "]")) :language 'elixir :feature 'elixir-builtin @@ -699,11 +702,10 @@ Return nil if NODE is not a defun node or doesn't have a name." ;; Font-lock. (setq-local treesit-font-lock-settings elixir-ts--font-lock-settings) (setq-local treesit-font-lock-feature-list - '(( elixir-comment elixir-doc elixir-function-name) + '(( elixir-comment elixir-doc elixir-definition) ( elixir-string elixir-keyword elixir-data-type) - ( elixir-sigil elixir-variable elixir-builtin - elixir-string-escape) - ( elixir-function-call elixir-operator elixir-number ))) + ( elixir-sigil elixir-builtin elixir-string-escape) + ( elixir-function-call elixir-variable elixir-operator elixir-number ))) ;; Imenu. @@ -736,13 +738,12 @@ Return nil if NODE is not a defun node or doesn't have a name." heex-ts--indent-rules)) (setq-local treesit-font-lock-feature-list - '(( elixir-comment elixir-doc elixir-function-name + '(( elixir-comment elixir-doc elixir-definition heex-comment heex-keyword heex-doctype ) ( elixir-string elixir-keyword elixir-data-type heex-component heex-tag heex-attribute heex-string ) - ( elixir-sigil elixir-variable elixir-builtin - elixir-string-escape) - ( elixir-function-call elixir-operator elixir-number )))) + ( elixir-sigil elixir-builtin elixir-string-escape) + ( elixir-function-call elixir-variable elixir-operator elixir-number )))) (treesit-major-mode-setup) (setq-local syntax-propertize-function #'elixir-ts--syntax-propertize))) -- cgit v1.2.3 From 8a39216ce920d82b86a40471429e30d75c6ee42d Mon Sep 17 00:00:00 2001 From: Wilhelm Kirschbaum Date: Wed, 7 Feb 2024 04:18:30 +0200 Subject: elixir-ts-mode: Highlight more method definitions * lisp/progmodes/elixir-ts-mode.el (elixir-ts--font-lock-settings): Also highlight method definitions where the arguments are literal values, not identifiers (bug#67246). --- lisp/progmodes/elixir-ts-mode.el | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el index 57db211e881..f26c3a49203 100644 --- a/lisp/progmodes/elixir-ts-mode.el +++ b/lisp/progmodes/elixir-ts-mode.el @@ -362,6 +362,11 @@ :language 'elixir :feature 'elixir-definition `((call target: (identifier) @target-identifier + (arguments + (call target: (identifier) @font-lock-function-name-face + (arguments))) + (:match ,elixir-ts--definition-keywords-re @target-identifier)) + (call target: (identifier) @target-identifier (arguments (identifier) @font-lock-function-name-face) (:match ,elixir-ts--definition-keywords-re @target-identifier)) (call target: (identifier) @target-identifier -- cgit v1.2.3 From 9ccaa09a63548770ca8902758985aeb2c609f5ad Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 7 Feb 2024 10:48:27 +0800 Subject: ; .dir-locals.el (log-edit-mode) : Set to 64. --- .dir-locals.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.dir-locals.el b/.dir-locals.el index 1f08c882e0b..89fb76a55f3 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -32,7 +32,8 @@ (mode . bug-reference-prog))) (log-edit-mode . ((log-edit-font-lock-gnu-style . t) (log-edit-setup-add-author . t) - (vc-git-log-edit-summary-target-len . 50))) + (vc-git-log-edit-summary-target-len . 50) + (fill-column . 64))) (change-log-mode . ((add-log-time-zone-rule . t) (fill-column . 74) (mode . bug-reference))) -- cgit v1.2.3 From ccae58a425674c36cb6f17bcebc4416d34f23a37 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 7 Feb 2024 13:19:27 +0100 Subject: Declare function properties in Tramp * lisp/net/tramp-message.el (tramp-backtrace, tramp-error) (tramp-error-with-buffer, tramp-user-error): Declare `tramp-suppress-trace' property. --- lisp/net/tramp-message.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el index 96071e626a5..97e94a51e7a 100644 --- a/lisp/net/tramp-message.el +++ b/lisp/net/tramp-message.el @@ -353,6 +353,7 @@ applicable)." If VEC-OR-PROC is nil, the buffer *debug tramp* is used. FORCE forces the backtrace even if `tramp-verbose' is less than 10. This function is meant for debugging purposes." + (declare (tramp-suppress-trace t)) (let ((tramp-verbose (if force 10 tramp-verbose))) (when (>= tramp-verbose 10) (tramp-message @@ -364,6 +365,7 @@ VEC-OR-PROC identifies the connection to use, SIGNAL is the signal identifier to be raised, remaining arguments passed to `tramp-message'. Finally, signal SIGNAL is raised with FMT-STRING and ARGUMENTS." + (declare (tramp-suppress-trace t)) (let (signal-hook-function) (tramp-backtrace vec-or-proc) (unless arguments @@ -391,6 +393,7 @@ tramp-tests.el.") "Emit an error, and show BUF. If BUF is nil, show the connection buf. Wait for 30\", or until an input event arrives. The other arguments are passed to `tramp-error'." + (declare (tramp-suppress-trace t)) (save-window-excursion (let* ((buf (or (and (bufferp buf) buf) (and (processp vec-or-proc) (process-buffer vec-or-proc)) @@ -424,6 +427,7 @@ an input event arrives. The other arguments are passed to `tramp-error'." (defsubst tramp-user-error (vec-or-proc fmt-string &rest arguments) "Signal a user error (or \"pilot error\")." + (declare (tramp-suppress-trace t)) (unwind-protect (apply #'tramp-error vec-or-proc 'user-error fmt-string arguments) ;; Save exit. -- cgit v1.2.3 From e5cb268b2cf612492dfaf39d28f43357710003a6 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 7 Feb 2024 21:09:18 +0800 Subject: Fix DEBUG_THREADS in the Android port * java/org/gnu/emacs/EmacsService.java (EmacsService): New field `mainThread'. (onCreate): Set `mainThread' to the thread where the service's looper executes. (checkEmacsThread): Compare against SERVICE.mainThread. --- java/org/gnu/emacs/EmacsService.java | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 93e34e6e694..b65b10b9528 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -136,6 +136,10 @@ public final class EmacsService extends Service been created yet. */ private EmacsSafThread storageThread; + /* The Thread object representing the Android user interface + thread. */ + private Thread mainThread; + static { servicingQuery = new AtomicInteger (); @@ -236,6 +240,7 @@ public final class EmacsService extends Service / metrics.density) * pixelDensityX); resolver = getContentResolver (); + mainThread = Thread.currentThread (); /* If the density used to compute the text size is lesser than 160, there's likely a bug with display density computation. @@ -384,7 +389,13 @@ public final class EmacsService extends Service { if (DEBUG_THREADS) { - if (Thread.currentThread () instanceof EmacsThread) + /* When SERVICE is NULL, Emacs is being executed non-interactively. */ + if (SERVICE == null + /* It was previously assumed that only instances of + `EmacsThread' were valid for graphics calls, but this is + no longer true now that Lisp threads can be attached to + the JVM. */ + || (Thread.currentThread () != SERVICE.mainThread)) return; throw new RuntimeException ("Emacs thread function" -- cgit v1.2.3 From d03f3a827d80e2a0962128216223bab21998cf0a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 7 Feb 2024 15:33:51 +0200 Subject: Don't compile lib/copy-file-range.c on MS-Windows * nt/gnulib-cfg.mk (OMIT_GNULIB_MODULE_copy-file-range): Set to true to avoid compiling copy-file-range.c on MS-Windows. The function 'copy_file_range' is not used on MS-Windows, while compiling the file triggers warnings because lib/unistd.h, where its prototype is declared, is omitted in the MS-Windows build. --- nt/gnulib-cfg.mk | 1 + 1 file changed, 1 insertion(+) diff --git a/nt/gnulib-cfg.mk b/nt/gnulib-cfg.mk index 5b1c2c88ba5..048f812724a 100644 --- a/nt/gnulib-cfg.mk +++ b/nt/gnulib-cfg.mk @@ -46,6 +46,7 @@ OMIT_GNULIB_MODULE_allocator = true OMIT_GNULIB_MODULE_at-internal = true OMIT_GNULIB_MODULE_canonicalize-lgpl = true OMIT_GNULIB_MODULE_careadlinkat = true +OMIT_GNULIB_MODULE_copy-file-range = true OMIT_GNULIB_MODULE_dirent = true OMIT_GNULIB_MODULE_dirfd = true OMIT_GNULIB_MODULE_fchmodat = true -- cgit v1.2.3 From ef3fed1a4898c3e3d6012ba01006d827a4aba0ef Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Wed, 7 Feb 2024 14:35:44 +0100 Subject: ; Fix last changes in buffer-menu.el and NEWS * etc/NEWS: Remove superfluous mention of key binding. * lisp/buff-menu.el (Buffer-menu--selection-message): Go back to previous wording. It's not about what is hidden but what is shown; the message is displayed in response to different actions. --- etc/NEWS | 2 +- lisp/buff-menu.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index ee7462cb2aa..960ad2b95ac 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1304,7 +1304,7 @@ This allows for rcirc logs to use a custom timestamp format, than the chat buffers use by default. --- -*** New command 'Buffer-menu-toggle-internal', locally bound to 'I'. +*** New command 'Buffer-menu-toggle-internal'. This command toggles the display of internal buffers in Buffer Menu mode; that is, buffers not visiting a file and whose names start with a space. Previously, such buffers were never shown. This command is bound to 'I' diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 29ca3b41f0c..be62fc51e4c 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -329,7 +329,7 @@ ARG, show only buffers that are visiting files." (defun Buffer-menu--selection-message () (message (cond (Buffer-menu-files-only "Showing only file-visiting buffers.") (Buffer-menu-show-internal "Showing all buffers.") - (t "Hiding internal buffers.")))) + (t "Showing all non-internal buffers.")))) (defun Buffer-menu-toggle-files-only (arg) "Toggle whether the current `buffer-menu' displays only file buffers. -- cgit v1.2.3 From b068725d40dd1ab918178b3cbca7b5672037210f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 7 Feb 2024 11:11:38 -0500 Subject: Use slot names rather than their :initargs * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el (eieio-test-39-clone-instance-inheritor-with-args): * test/lisp/auth-source-tests.el (auth-source-ensure-ignored-backend) (auth-source-backend-parse-macos-keychain) (auth-source-backend-parse-macos-keychain-generic-string) (auth-source-backend-parse-macos-keychain-internet-string) (auth-source-backend-parse-macos-keychain-internet-symbol) (auth-source-backend-parse-macos-keychain-generic-symbol) (auth-source-backend-parse-macos-keychain-internet-default-string) (auth-source-backend-parse-plstore, auth-source-backend-parse-netrc) (auth-source-backend-parse-netrc-string) (auth-source-backend-parse-secrets) (auth-source-backend-parse-secrets-strings) (auth-source-backend-parse-secrets-alias) (auth-source-backend-parse-secrets-symbol) (auth-source-backend-parse-secrets-no-alias): Use slot names rather than their :initargs. --- test/lisp/auth-source-tests.el | 139 ++++++++++++++---------- test/lisp/emacs-lisp/eieio-tests/eieio-tests.el | 28 ++--- 2 files changed, 95 insertions(+), 72 deletions(-) diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index 0a3c1cce590..c091a7dd060 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -33,8 +33,8 @@ (require 'secrets) (defun auth-source-ensure-ignored-backend (source) - (auth-source-validate-backend source '((:source . "") - (:type . ignore)))) + (auth-source-validate-backend source '((source . "") + (type . ignore)))) (defun auth-source-validate-backend (source validation-alist) (let ((backend (auth-source-backend-parse source))) @@ -44,84 +44,101 @@ (ert-deftest auth-source-backend-parse-macos-keychain () (auth-source-validate-backend '(:source (:macos-keychain-generic foobar)) - '((:source . "foobar") - (:type . macos-keychain-generic) - (:search-function . auth-source-macos-keychain-search) - (:create-function . auth-source-macos-keychain-create)))) + '((source . "foobar") + (type . macos-keychain-generic) + (search-function . auth-source-macos-keychain-search) + (create-function . auth-source-macos-keychain-create)))) (ert-deftest auth-source-backend-parse-macos-keychain-generic-string () (auth-source-validate-backend "macos-keychain-generic:foobar" - '((:source . "foobar") - (:type . macos-keychain-generic) - (:search-function . auth-source-macos-keychain-search) - (:create-function . auth-source-macos-keychain-create)))) + '((source . "foobar") + (type . macos-keychain-generic) + (search-function + . auth-source-macos-keychain-search) + (create-function + . auth-source-macos-keychain-create)))) (ert-deftest auth-source-backend-parse-macos-keychain-internet-string () (auth-source-validate-backend "macos-keychain-internet:foobar" - '((:source . "foobar") - (:type . macos-keychain-internet) - (:search-function . auth-source-macos-keychain-search) - (:create-function . auth-source-macos-keychain-create)))) + '((source . "foobar") + (type . macos-keychain-internet) + (search-function + . auth-source-macos-keychain-search) + (create-function + . auth-source-macos-keychain-create)))) (ert-deftest auth-source-backend-parse-macos-keychain-internet-symbol () (auth-source-validate-backend 'macos-keychain-internet - '((:source . "default") - (:type . macos-keychain-internet) - (:search-function . auth-source-macos-keychain-search) - (:create-function . auth-source-macos-keychain-create)))) + '((source . "default") + (type . macos-keychain-internet) + (search-function + . auth-source-macos-keychain-search) + (create-function + . auth-source-macos-keychain-create)))) (ert-deftest auth-source-backend-parse-macos-keychain-generic-symbol () (auth-source-validate-backend 'macos-keychain-generic - '((:source . "default") - (:type . macos-keychain-generic) - (:search-function . auth-source-macos-keychain-search) - (:create-function . auth-source-macos-keychain-create)))) + '((source . "default") + (type . macos-keychain-generic) + (search-function + . auth-source-macos-keychain-search) + (create-function + . auth-source-macos-keychain-create)))) (ert-deftest auth-source-backend-parse-macos-keychain-internet-default-string () (auth-source-validate-backend 'macos-keychain-internet - '((:source . "default") - (:type . macos-keychain-internet) - (:search-function . auth-source-macos-keychain-search) - (:create-function . auth-source-macos-keychain-create)))) + '((source . "default") + (type . macos-keychain-internet) + (search-function + . auth-source-macos-keychain-search) + (create-function + . auth-source-macos-keychain-create)))) (ert-deftest auth-source-backend-parse-plstore () (auth-source-validate-backend '(:source "foo.plist") - '((:source . "foo.plist") - (:type . plstore) - (:search-function . auth-source-plstore-search) - (:create-function . auth-source-plstore-create)))) + '((source . "foo.plist") + (type . plstore) + (search-function . auth-source-plstore-search) + (create-function + . auth-source-plstore-create)))) (ert-deftest auth-source-backend-parse-netrc () (auth-source-validate-backend '(:source "foo") - '((:source . "foo") - (:type . netrc) - (:search-function . auth-source-netrc-search) - (:create-function . auth-source-netrc-create)))) + '((source . "foo") + (type . netrc) + (search-function . auth-source-netrc-search) + (create-function + . auth-source-netrc-create)))) (ert-deftest auth-source-backend-parse-netrc-string () (auth-source-validate-backend "foo" - '((:source . "foo") - (:type . netrc) - (:search-function . auth-source-netrc-search) - (:create-function . auth-source-netrc-create)))) + '((source . "foo") + (type . netrc) + (search-function . auth-source-netrc-search) + (create-function + . auth-source-netrc-create)))) (ert-deftest auth-source-backend-parse-secrets () (provide 'secrets) ; simulates the presence of the `secrets' package (let ((secrets-enabled t)) (auth-source-validate-backend '(:source (:secrets "foo")) - '((:source . "foo") - (:type . secrets) - (:search-function . auth-source-secrets-search) - (:create-function . auth-source-secrets-create))))) + '((source . "foo") + (type . secrets) + (search-function + . auth-source-secrets-search) + (create-function + . auth-source-secrets-create))))) (ert-deftest auth-source-backend-parse-secrets-strings () (provide 'secrets) ; simulates the presence of the `secrets' package (let ((secrets-enabled t)) (auth-source-validate-backend "secrets:foo" - '((:source . "foo") - (:type . secrets) - (:search-function . auth-source-secrets-search) - (:create-function . auth-source-secrets-create))))) + '((source . "foo") + (type . secrets) + (search-function + . auth-source-secrets-search) + (create-function + . auth-source-secrets-create))))) (ert-deftest auth-source-backend-parse-secrets-alias () (provide 'secrets) ; simulates the presence of the `secrets' package @@ -129,10 +146,12 @@ ;; Redefine `secrets-get-alias' to map 'foo to "foo" (cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) "foo"))) (auth-source-validate-backend '(:source (:secrets foo)) - '((:source . "foo") - (:type . secrets) - (:search-function . auth-source-secrets-search) - (:create-function . auth-source-secrets-create)))))) + '((source . "foo") + (type . secrets) + (search-function + . auth-source-secrets-search) + (create-function + . auth-source-secrets-create)))))) (ert-deftest auth-source-backend-parse-secrets-symbol () (provide 'secrets) ; simulates the presence of the `secrets' package @@ -140,10 +159,12 @@ ;; Redefine `secrets-get-alias' to map 'default to "foo" (cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) "foo"))) (auth-source-validate-backend 'default - '((:source . "foo") - (:type . secrets) - (:search-function . auth-source-secrets-search) - (:create-function . auth-source-secrets-create)))))) + '((source . "foo") + (type . secrets) + (search-function + . auth-source-secrets-search) + (create-function + . auth-source-secrets-create)))))) (ert-deftest auth-source-backend-parse-secrets-no-alias () (provide 'secrets) ; simulates the presence of the `secrets' package @@ -152,10 +173,12 @@ ;; "Login" is used by default (cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) nil))) (auth-source-validate-backend '(:source (:secrets foo)) - '((:source . "Login") - (:type . secrets) - (:search-function . auth-source-secrets-search) - (:create-function . auth-source-secrets-create)))))) + '((source . "Login") + (type . secrets) + (search-function + . auth-source-secrets-search) + (create-function + . auth-source-secrets-create)))))) (ert-deftest auth-source-backend-parse-invalid-or-nil-source () (provide 'secrets) ; simulates the presence of the `secrets' package diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index 83fc476c911..bc226757ff2 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -1011,24 +1011,24 @@ Subclasses to override slot attributes.")) (B (clone A :b "bb")) (C (clone B :a "aa"))) - (should (string= "aa" (oref C :a))) - (should (string= "bb" (oref C :b))) + (should (string= "aa" (oref C a))) + (should (string= "bb" (oref C b))) - (should (slot-boundp A :a)) - (should-not (slot-boundp A :b)) - (should-not (slot-boundp A :c)) + (should (slot-boundp A 'a)) + (should-not (slot-boundp A 'b)) + (should-not (slot-boundp A 'c)) - (should-not (slot-boundp B :a)) - (should (slot-boundp B :b)) - (should-not (slot-boundp A :c)) + (should-not (slot-boundp B 'a)) + (should (slot-boundp B 'b)) + (should-not (slot-boundp A 'c)) - (should (slot-boundp C :a)) - (should-not (slot-boundp C :b)) - (should-not (slot-boundp C :c)) + (should (slot-boundp C 'a)) + (should-not (slot-boundp C 'b)) + (should-not (slot-boundp C 'c)) - (should (eieio-instance-inheritor-slot-boundp C :a)) - (should (eieio-instance-inheritor-slot-boundp C :b)) - (should-not (eieio-instance-inheritor-slot-boundp C :c)))) + (should (eieio-instance-inheritor-slot-boundp C 'a)) + (should (eieio-instance-inheritor-slot-boundp C 'b)) + (should-not (eieio-instance-inheritor-slot-boundp C 'c)))) ;;;; Interaction with defstruct -- cgit v1.2.3 From cc5d4f15f96f97b6c4eb8b58144d0a0f217d393a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 7 Feb 2024 11:13:56 -0500 Subject: Use `defvar` for variables that are not constant * test/lisp/international/mule-tests.el (sgml-html-meta-pre) (sgml-html-meta-post): * test/lisp/net/tramp-archive-tests.el (tramp-archive-test-file-archive) (tramp-archive-test-archive): * test/lisp/emacs-lisp/macroexp-resources/vk.el (vk-b): Don't use `defconst` if it's not constant. --- test/lisp/emacs-lisp/macroexp-resources/vk.el | 2 +- test/lisp/international/mule-tests.el | 4 ++-- test/lisp/net/tramp-archive-tests.el | 4 ++-- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/test/lisp/emacs-lisp/macroexp-resources/vk.el b/test/lisp/emacs-lisp/macroexp-resources/vk.el index 460b7a8e516..5358bcaeb5c 100644 --- a/test/lisp/emacs-lisp/macroexp-resources/vk.el +++ b/test/lisp/emacs-lisp/macroexp-resources/vk.el @@ -25,7 +25,7 @@ (if (macroexp--dynamic-variable-p var) ''dyn ''lex)) (defvar vk-a 1) -(defconst vk-b 2) +(defvar vk-b 2) (defvar vk-c) (defun vk-f1 (x) diff --git a/test/lisp/international/mule-tests.el b/test/lisp/international/mule-tests.el index 5c742451a57..9a80ced55ae 100644 --- a/test/lisp/international/mule-tests.el +++ b/test/lisp/international/mule-tests.el @@ -96,10 +96,10 @@ ;;; Testing `sgml-html-meta-auto-coding-function'. -(defconst sgml-html-meta-pre "" +(defvar sgml-html-meta-pre "" "The beginning of a minimal HTML document.") -(defconst sgml-html-meta-post "" +(defvar sgml-html-meta-post "" "The end of a minimal HTML document.") (defun sgml-html-meta-run (coding-system) diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 978342b1bb1..1ca2fa9b9b3 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -77,7 +77,7 @@ A resource file is in the resource directory as per `ert-resource-directory'." `(expand-file-name ,file (ert-resource-directory))))) -(defconst tramp-archive-test-file-archive (ert-resource-file "foo.tar.gz") +(defvar tramp-archive-test-file-archive (ert-resource-file "foo.tar.gz") "The test file archive.") (defun tramp-archive-test-file-archive-hexlified () @@ -86,7 +86,7 @@ Do not hexlify \"/\". This hexlified string is used in `file:///' URLs." (let* ((url-unreserved-chars (cons ?/ url-unreserved-chars))) (url-hexify-string tramp-archive-test-file-archive))) -(defconst tramp-archive-test-archive +(defvar tramp-archive-test-archive (file-name-as-directory tramp-archive-test-file-archive) "The test archive.") -- cgit v1.2.3 From 2f3c435056dac17242b2d147bc73df8742c3e374 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 7 Feb 2024 11:15:59 -0500 Subject: * test/lisp/minibuffer-tests.el (completion-test--pcm-bug38458): New test --- test/lisp/minibuffer-tests.el | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 07c4dbc3197..c4a7de9e51f 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -201,6 +201,13 @@ 'completions-first-difference) return pos)) +(ert-deftest completion-test--pcm-bug38458 () + (should (equal (let ((completion-ignore-case t)) + (completion-pcm--merge-try '("tes" point "ing") + '("Testing" "testing") + "" "")) + '("testing" . 4)))) + (ert-deftest completion-pcm-test-1 () ;; Point is at end, this does not match anything (should (null -- cgit v1.2.3 From 12fb298e21d877c772a19fc8f2fec68a40bcda14 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 7 Feb 2024 11:17:35 -0500 Subject: Prefer \` and \' when matching the beg/end of string * test/lisp/net/tramp-tests.el (tramp--test-instrument-test-case) (tramp-test01-file-name-syntax): Use more precise regexp --- test/lisp/net/tramp-tests.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 489b682d0c3..4a964f0daf0 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -265,8 +265,8 @@ is greater than 10. `(let* ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0))) (debug-ignored-errors (append - '("^make-symbolic-link not supported$" - "^error with add-name-to-file") + '("\\`make-symbolic-link not supported\\'" + "\\`error with add-name-to-file") debug-ignored-errors)) inhibit-message) (unwind-protect @@ -379,7 +379,7 @@ is greater than 10. (let (tramp-mode) (should-not (tramp-tramp-file-p "/method:user@host:"))) ;; `tramp-ignored-file-name-regexp' suppresses Tramp. - (let ((tramp-ignored-file-name-regexp "^/method:user@host:")) + (let ((tramp-ignored-file-name-regexp "\\`/method:user@host:")) (should-not (tramp-tramp-file-p "/method:user@host:"))) ;; Methods shall be at least two characters, except the ;; default method. -- cgit v1.2.3 From f9ffa0148c3fb9e07671fae8f8ca72dd2d403163 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 7 Feb 2024 11:20:46 -0500 Subject: (file-notify--test-wait-event): Rename from `file-notify--test-read-event` * test/lisp/filenotify-tests.el (file-notify--test-wait-event): Rename to better reflect its purpose rather than its implementation. Also make it return nil so callers won't be tempted to use the return value. --- test/lisp/filenotify-tests.el | 53 ++++++++++++++++++++++--------------------- 1 file changed, 27 insertions(+), 26 deletions(-) diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 11af1f75574..28f4d5fa181 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -74,8 +74,8 @@ (defvar file-notify--test-events nil) (defvar file-notify--test-monitors nil) -(defun file-notify--test-read-event () - "Read one event. +(defun file-notify--test-wait-event () + "Wait for one event. There are different timeouts for local and remote file notification libraries." (read-event nil nil @@ -87,7 +87,8 @@ There are different timeouts for local and remote file notification libraries." ;; for any monitor. ((file-notify--test-monitor) 7) ((file-remote-p temporary-file-directory) 0.1) - (t 0.01)))) + (t 0.01))) + nil) (defun file-notify--test-timeout () "Timeout to wait for arriving a bunch of events, in seconds." @@ -103,7 +104,7 @@ There are different timeouts for local and remote file notification libraries." TIMEOUT is the maximum time to wait for, in seconds." `(with-timeout (,timeout (ignore)) (while (null ,until) - (file-notify--test-read-event)))) + (file-notify--test-wait-event)))) (defun file-notify--test-no-descriptors () "Check that `file-notify-descriptors' is an empty hash table. @@ -452,7 +453,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; Check, that removing watch descriptors out of order do not ;; harm. This fails on cygwin because of timing issues unless a ;; long `sit-for' is added before the call to - ;; `file-notify--test-read-event'. + ;; `file-notify--test-wait-event'. (unless (eq system-type 'cygwin) (let (results) (cl-flet ((first-callback (event) @@ -480,7 +481,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; Remove first watch. (file-notify-rm-watch file-notify--test-desc) ;; Only the second callback shall run. - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-file file-notify--test-tmpfile) (file-notify--test-wait-for-events (file-notify--test-timeout) results) @@ -622,7 +623,7 @@ delivered." (cons 'file-notify while-no-input-ignore-events)) create-lockfiles) ;; Flush pending actions. - (file-notify--test-read-event) + (file-notify--test-wait-event) (file-notify--test-wait-for-events (file-notify--test-timeout) (not (input-pending-p))) @@ -671,7 +672,7 @@ delivered." (t '(created changed deleted stopped))) (write-region "another text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-file file-notify--test-tmpfile)) (file-notify-rm-watch file-notify--test-desc) @@ -707,7 +708,7 @@ delivered." (changed changed deleted stopped)))) (write-region "another text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-file file-notify--test-tmpfile)) (file-notify-rm-watch file-notify--test-desc) @@ -755,7 +756,7 @@ delivered." (t '(created changed deleted deleted stopped))) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-directory file-notify--test-tmpdir 'recursive)) (file-notify-rm-watch file-notify--test-desc) @@ -805,14 +806,14 @@ delivered." deleted deleted deleted stopped))) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (copy-file file-notify--test-tmpfile file-notify--test-tmpfile1) ;; The next two events shall not be visible. - (file-notify--test-read-event) + (file-notify--test-wait-event) (set-file-modes file-notify--test-tmpfile 000 'nofollow) - (file-notify--test-read-event) + (file-notify--test-wait-event) (set-file-times file-notify--test-tmpfile '(0 0) 'nofollow) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-directory file-notify--test-tmpdir 'recursive)) (file-notify-rm-watch file-notify--test-desc) @@ -860,10 +861,10 @@ delivered." (t '(created changed renamed deleted deleted stopped))) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (rename-file file-notify--test-tmpfile file-notify--test-tmpfile1) ;; After the rename, we won't get events anymore. - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-directory file-notify--test-tmpdir 'recursive)) (file-notify-rm-watch file-notify--test-desc) @@ -912,11 +913,11 @@ delivered." (t '(attribute-changed attribute-changed))) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (set-file-modes file-notify--test-tmpfile 000 'nofollow) - (file-notify--test-read-event) + (file-notify--test-wait-event) (set-file-times file-notify--test-tmpfile '(0 0) 'nofollow) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-file file-notify--test-tmpfile)) (file-notify-rm-watch file-notify--test-desc) @@ -1087,7 +1088,7 @@ delivered." (changed changed deleted stopped)))) (write-region "another text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-file file-notify--test-tmpfile)) ;; After deleting the file, the descriptor is not valid anymore. (should-not (file-notify-valid-p file-notify--test-desc)) @@ -1134,7 +1135,7 @@ delivered." (t '(created changed deleted deleted stopped))) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-directory file-notify--test-tmpdir 'recursive)) ;; After deleting the parent directory, the descriptor must ;; not be valid anymore. @@ -1247,9 +1248,9 @@ delivered." (let ((source-file-list source-file-list) (target-file-list target-file-list)) (while (and source-file-list target-file-list) - (file-notify--test-read-event) + (file-notify--test-wait-event) (write-region "" nil (pop source-file-list) nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (write-region "" nil (pop target-file-list) nil 'no-message)))) (file-notify--test-with-actions (cond @@ -1272,11 +1273,11 @@ delivered." (let ((source-file-list source-file-list) (target-file-list target-file-list)) (while (and source-file-list target-file-list) - (file-notify--test-read-event) + (file-notify--test-wait-event) (rename-file (pop source-file-list) (pop target-file-list) t)))) (file-notify--test-with-actions (make-list n 'deleted) (dolist (file target-file-list) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-file file))) (delete-directory file-notify--test-tmpfile) (if (or (string-equal (file-notify--test-library) "w32notify") @@ -1464,7 +1465,7 @@ the file watch." ;; does not report the `changed' event. (make-list (/ n 2) 'created))) (dotimes (i n) - (file-notify--test-read-event) + (file-notify--test-wait-event) (if (zerop (mod i 2)) (write-region "any text" nil file-notify--test-tmpfile1 t 'no-message) -- cgit v1.2.3 From 2ecaa60f0521446c9d2c054a3493faaf46275223 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 7 Feb 2024 19:14:20 +0200 Subject: Improve wording of message in buff-menu.el * lisp/buff-menu.el (Buffer-menu--selection-message): Improve wording of selection messages. --- lisp/buff-menu.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index be62fc51e4c..10ea99eae9a 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -329,7 +329,7 @@ ARG, show only buffers that are visiting files." (defun Buffer-menu--selection-message () (message (cond (Buffer-menu-files-only "Showing only file-visiting buffers.") (Buffer-menu-show-internal "Showing all buffers.") - (t "Showing all non-internal buffers.")))) + (t "Showing all buffers except internal ones.")))) (defun Buffer-menu-toggle-files-only (arg) "Toggle whether the current `buffer-menu' displays only file buffers. -- cgit v1.2.3 From f444786e58737a4ae6071957dfc60075bbd96edc Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Wed, 7 Feb 2024 21:50:37 +0200 Subject: Mention 'C-h' in echo for unfinished commands * etc/NEWS: Mention it here. * lisp/cus-start.el (standard): Add type and version for it. * src/keyboard.c (echo-keystrokes-help): New user option (https://lists.gnu.org/archive/html/emacs-devel/2024-02/msg00174.html). * src/keyboard.c (echo_dash): Use it. --- etc/NEWS | 3 +++ lisp/cus-start.el | 1 + src/keyboard.c | 13 +++++++++++++ 3 files changed, 17 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 960ad2b95ac..f454b6d851c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -307,6 +307,9 @@ between the auto save file and the current file. ** 'ffap-lax-url' now defaults to nil. Previously, it was set to t but this broke remote file name detection. +** Unfinished commands' echo now ends with a suggestion to use Help. +Customize 'echo-keystrokes-help' to nil to prevent that. + * Editing Changes in Emacs 30.1 diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 7e0b64e9067..3fe62c8d0da 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -371,6 +371,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (auto-save-timeout auto-save (choice (const :tag "off" nil) (integer :format "%v"))) (echo-keystrokes minibuffer number) + (echo-keystrokes-help minibuffer boolean "30.1") (polling-period keyboard float) (double-click-time mouse (restricted-sexp :match-alternatives (integerp 'nil 't))) diff --git a/src/keyboard.c b/src/keyboard.c index 1f7253a7da1..6d3db5ab615 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -589,6 +589,15 @@ echo_dash (void) AUTO_STRING (dash, "-"); kset_echo_string (current_kboard, concat2 (KVAR (current_kboard, echo_string), dash)); + + if (echo_keystrokes_help) + { + AUTO_STRING (help, " (\\`C-h' for help)"); + kset_echo_string (current_kboard, + concat2 (KVAR (current_kboard, echo_string), + calln (Qsubstitute_command_keys, help))); + } + echo_now (); } @@ -13228,6 +13237,10 @@ The value may be integer or floating point. If the value is zero, don't echo at all. */); Vecho_keystrokes = make_fixnum (1); + DEFVAR_BOOL ("echo-keystrokes-help", echo_keystrokes_help, + doc: /* Non-nil means append small help text to the unfinished commands' echo. */); + echo_keystrokes_help = true; + DEFVAR_LISP ("polling-period", Vpolling_period, doc: /* Interval between polling for input during Lisp execution. The reason for polling is to make C-g work to stop a running program. -- cgit v1.2.3 From e34ebc0ccc6c27e7e1217baad9ca74dd7bea4c37 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 7 Feb 2024 13:17:57 -0800 Subject: Port better to Autoconf 2.72 * configure.ac: Set ac_cv_type_gid_t=yes to pacify Autoconf 2.72 AC_TYPE_GETGROUPS. Problem reported by Nick Bowler in: https://lists.gnu.org/r/autoconf-patches/2024-02/msg00001.html --- configure.ac | 1 + 1 file changed, 1 insertion(+) diff --git a/configure.ac b/configure.ac index b74eba879ab..847fdbd54d2 100644 --- a/configure.ac +++ b/configure.ac @@ -2337,6 +2337,7 @@ fi AC_DEFUN([AC_TYPE_SIZE_T]) # Likewise for obsolescent test for uid_t, gid_t; Emacs assumes them. AC_DEFUN([AC_TYPE_UID_T]) +ac_cv_type_gid_t=yes # AC_TYPE_GETGROUPS needs this in Autoconf 2.72. # Check for all math.h functions that Emacs uses; on some platforms, # -lm is needed for some of these functions. -- cgit v1.2.3 From 1f9781ee7816ad3ec786ca7e10b4e82d1ad989c5 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 8 Feb 2024 10:01:57 +0800 Subject: Fix earlier change to keyboard.c * src/keyboard.c (echo_dash): Do not pass automatic string to Lisp! (syms_of_keyboard) : Improve doc string. --- src/keyboard.c | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/keyboard.c b/src/keyboard.c index 6d3db5ab615..cd6ccbd77d0 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -592,7 +592,9 @@ echo_dash (void) if (echo_keystrokes_help) { - AUTO_STRING (help, " (\\`C-h' for help)"); + Lisp_Object help; + + help = build_string (" (\\`C-h' for help)"); kset_echo_string (current_kboard, concat2 (KVAR (current_kboard, echo_string), calln (Qsubstitute_command_keys, help))); @@ -13232,13 +13234,15 @@ Emacs also does a garbage collection if that seems to be warranted. */); XSETFASTINT (Vauto_save_timeout, 30); DEFVAR_LISP ("echo-keystrokes", Vecho_keystrokes, - doc: /* Nonzero means echo unfinished commands after this many seconds of pause. + doc: /* Nonzero means echo unfinished commands after this many seconds of pause. The value may be integer or floating point. If the value is zero, don't echo at all. */); Vecho_keystrokes = make_fixnum (1); DEFVAR_BOOL ("echo-keystrokes-help", echo_keystrokes_help, - doc: /* Non-nil means append small help text to the unfinished commands' echo. */); + doc: /* Whether to append help text to echoed commands. +When non-nil, a reference to `C-h' is printed after echoed +keystrokes. */); echo_keystrokes_help = true; DEFVAR_LISP ("polling-period", Vpolling_period, -- cgit v1.2.3 From ed2450e79b597e0306f14b542e934a90dfd9786f Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 8 Feb 2024 10:32:28 +0800 Subject: Prevent echo area help message from being printed repeatedly * src/keyboard.c (echo_dash): Detect echo_keystrokes_help messages and return if they be present. --- src/keyboard.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/keyboard.c b/src/keyboard.c index cd6ccbd77d0..78ea1893ba1 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -580,7 +580,10 @@ echo_dash (void) idx = make_fixnum (SCHARS (KVAR (current_kboard, echo_string)) - 1); last_char = Faref (KVAR (current_kboard, echo_string), idx); - if (XFIXNUM (last_char) == '-' && XFIXNUM (prev_char) != ' ') + if ((XFIXNUM (last_char) == '-' && XFIXNUM (prev_char) != ' ') + /* Or a keystroke help message. */ + || (echo_keystrokes_help + && XFIXNUM (last_char) == ')' && XFIXNUM (prev_char) == 'p')) return; } -- cgit v1.2.3 From 1db2255c7c7fc232e371d379cb60827a9931e24d Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 8 Feb 2024 13:20:28 +0800 Subject: * lisp/touch-screen.el (touch-screen): Fix defgroup version. --- lisp/touch-screen.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index a1ec4bca89f..c8de1d8ee31 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -87,7 +87,7 @@ is being called from `read-sequence' or some similar function.") (defgroup touch-screen nil "Interact with Emacs from touch screen devices." :group 'mouse - :version "30.0") + :version "30.1") (defcustom touch-screen-display-keyboard nil "If non-nil, always display the on screen keyboard. -- cgit v1.2.3 From a48cf0c94ca4a4e3fe045be6149025955e9dfa4f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 8 Feb 2024 08:48:20 +0200 Subject: ; * src/keyboard.c (echo_dash): Mention F1 in echo_keystrokes_help. --- src/keyboard.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/keyboard.c b/src/keyboard.c index 78ea1893ba1..10cdef67348 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -597,7 +597,7 @@ echo_dash (void) { Lisp_Object help; - help = build_string (" (\\`C-h' for help)"); + help = build_string (" (\\`C-h' or \\`' for help)"); kset_echo_string (current_kboard, concat2 (KVAR (current_kboard, echo_string), calln (Qsubstitute_command_keys, help))); -- cgit v1.2.3 From d6c7092ff0713087f38b9492d53be0177af67514 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 8 Feb 2024 08:56:42 +0200 Subject: ; Improve documentation of 'echo-keystrokes-help' * doc/emacs/display.texi (Display Custom): Document 'echo-keystrokes-help'. * etc/NEWS: Mark the 'echo-keystrokes-help' entry documented. --- doc/emacs/display.texi | 7 +++++++ etc/NEWS | 3 ++- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 6db9e8344c6..d2557d6148e 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -2210,6 +2210,13 @@ keys; its value is the number of seconds of pause required to cause echoing to start, or zero, meaning don't echo at all. The value takes effect when there is something to echo. @xref{Echo Area}. +@vindex echo-keystrokes-help + If the variable @code{echo-keystrokes-help} is non-@code{nil} (the +default), the multi-character key sequence echo shown according to +@code{echo-keystrokes} will include a short help text about keys which +will invoke @code{describe-prefix-bindings} (@pxref{Misc Help}) to show +the list of commands for the prefix you already typed. + @cindex mouse pointer @cindex hourglass pointer display @vindex display-hourglass diff --git a/etc/NEWS b/etc/NEWS index f454b6d851c..4d3c652aebc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -307,7 +307,8 @@ between the auto save file and the current file. ** 'ffap-lax-url' now defaults to nil. Previously, it was set to t but this broke remote file name detection. -** Unfinished commands' echo now ends with a suggestion to use Help. ++++ +** Multi-character key echo now ends with a suggestion to use Help. Customize 'echo-keystrokes-help' to nil to prevent that. -- cgit v1.2.3 From 08c81db7c8e522278fb2c8de8fbe556d109c135f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 8 Feb 2024 11:17:22 +0100 Subject: `file-remote-p' must not return an error * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler): `file-remote-p' must not return an error. (Bug#68976) --- lisp/net/tramp-gvfs.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 72589e7ce4a..4e949e7e60b 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -888,7 +888,8 @@ Operations not mentioned here will be handled by the default Emacs primitives.") "Invoke the GVFS related OPERATION and ARGS. First arg specifies the OPERATION, second arg is a list of arguments to pass to the OPERATION." - (unless tramp-gvfs-enabled + ;; `file-remote-p' must not return an error. (Bug#68976) + (unless (or tramp-gvfs-enabled (eq operation 'file-remote-p)) (tramp-user-error nil "Package `tramp-gvfs' not supported")) (if-let ((filename (apply #'tramp-file-name-for-operation operation args)) (tramp-gvfs-dbus-event-vector -- cgit v1.2.3 From bc099295dd24d059d3358acf5653ced9c9292e41 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Wed, 31 Jan 2024 21:37:18 +0100 Subject: ; Ensure 'thing-at-point-looking-at' finds full match * lisp/thingatpt.el (thing-at-point-looking-at): Regexp-search from the beginning forward, instead of the other way around. * test/lisp/thingatpt-tests.el (thing-at-point-test-data): Add tests. (Bug#68762) --- lisp/thingatpt.el | 43 +++++++++++++------------------------------ test/lisp/thingatpt-tests.el | 2 ++ 2 files changed, 15 insertions(+), 30 deletions(-) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 323d3d1cf6c..b532bafff82 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -619,36 +619,19 @@ point. Optional argument DISTANCE limits search for REGEXP forward and back from point." - (save-excursion - (let ((old-point (point)) - (forward-bound (and distance (+ (point) distance))) - (backward-bound (and distance (- (point) distance))) - match prev-pos new-pos) - (and (looking-at regexp) - (>= (match-end 0) old-point) - (setq match (point))) - ;; Search back repeatedly from end of next match. - ;; This may fail if next match ends before this match does. - (re-search-forward regexp forward-bound 'limit) - (setq prev-pos (point)) - (while (and (setq new-pos (re-search-backward regexp backward-bound t)) - ;; Avoid inflooping with some regexps, such as "^", - ;; matching which never moves point. - (< new-pos prev-pos) - (or (> (match-beginning 0) old-point) - (and (looking-at regexp) ; Extend match-end past search start - (>= (match-end 0) old-point) - (setq match (point)))))) - (if (not match) nil - (goto-char match) - ;; Back up a char at a time in case search skipped - ;; intermediate match straddling search start pos. - (while (and (not (bobp)) - (progn (backward-char 1) (looking-at regexp)) - (>= (match-end 0) old-point) - (setq match (point)))) - (goto-char match) - (looking-at regexp))))) + (let* ((old (point)) + (beg (if distance (max (point-min) (- old distance)) (point-min))) + (end (and distance (min (point-max) (+ old distance)))) + prev match) + (save-excursion + (goto-char beg) + (while (and (setq prev (point) + match (re-search-forward regexp end t)) + (< (match-end 0) old)) + ;; Avoid inflooping when `regexp' matches the empty string. + (unless (< prev (point)) (forward-char)))) + (and match (<= (match-beginning 0) old (match-end 0))))) + ;; Email addresses (defvar thing-at-point-email-regexp diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index ba51f375cc6..56bc4fdc9dc 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -92,6 +92,8 @@ ("1@example.com" 1 email "1@example.com") ;; email addresses user portion containing dots ("foo.bar@example.com" 1 email "foo.bar@example.com") + ("foo.bar@example.com" 5 email "foo.bar@example.com") + (" fo.ba@example.com" 6 email "fo.ba@example.com") (".foobar@example.com" 1 email nil) (".foobar@example.com" 2 email "foobar@example.com") ;; email addresses domain portion containing dots and dashes -- cgit v1.2.3 From e2682316867ecb22ee1db5e3028a8150d95d1a80 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 8 Feb 2024 13:51:55 +0200 Subject: Don't skip links to "." and ".." in Dired when marking files * lisp/dired.el (dired-mark): Skip "." and "..", but not symlinks to those two. (Bug#38729) (Bug#68814) --- lisp/dired.el | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/lisp/dired.el b/lisp/dired.el index c33569d79a2..d9fbafb98c3 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -4110,6 +4110,11 @@ this subdir." (prefix-numeric-value arg) (lambda () (when (or (not (looking-at-p dired-re-dot)) + ;; Don't skip symlinks to ".", "..", etc. + (save-excursion + (re-search-forward + dired-permission-flags-regexp nil t) + (eq (char-after (match-beginning 1)) ?l)) (not (equal dired-marker-char dired-del-marker))) (delete-char 1) (insert dired-marker-char)))))))) -- cgit v1.2.3 From ebf4ef2022a5f0a69cdd881eb41104e7b59d698e Mon Sep 17 00:00:00 2001 From: USAMI Kenta Date: Sun, 4 Feb 2024 03:20:24 +0900 Subject: Fix 'browse-url-url-at-point' so that scheme does not duplicate * lisp/net/browse-url.el (browse-url-url-at-point): Prepend the default scheme only if no scheme present. (Bug#68913) --- lisp/net/browse-url.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 359453ca433..bc2a7db9a8b 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -688,8 +688,10 @@ websites are increasingly rare, but they do still exist." (defun browse-url-url-at-point () (or (thing-at-point 'url t) ;; assume that the user is pointing at something like gnu.org/gnu - (let ((f (thing-at-point 'filename t))) - (and f (concat browse-url-default-scheme "://" f))))) + (when-let ((f (thing-at-point 'filename t))) + (if (string-match-p browse-url-button-regexp f) + f + (concat browse-url-default-scheme "://" f))))) ;; Having this as a separate function called by the browser-specific ;; functions allows them to be stand-alone commands, making it easier -- cgit v1.2.3 From 0b9c7148fd681c8ad63fd0eb3895db44403e9f8c Mon Sep 17 00:00:00 2001 From: Liu Hui Date: Thu, 18 Jan 2024 12:00:00 +0800 Subject: Respect the delimiter of completer in Python shell completion * lisp/progmodes/python.el: (python-shell-completion-setup-code): Fix the completion code of IPython. Change the return value to JSON string and ... (python-shell-completion-get-completions): ... simplify parsing. (inferior-python-mode): Update docstring. (python-shell-readline-completer-delims): New variable indicating the word delimiters of readline completer. (python-shell-completion-native-setup): Set the completer delimiter. (python-shell-completion-native-get-completions): Convert output string to completions properly. (python-shell--get-multiline-input) (python-shell--extra-completion-context) (python-shell-completion-extra-context): New functions. (python-shell-completion-at-point): Send text beginning from the line start if the completion backend does not need word splitting. Remove the detection of import statement because it is not needed anymore. Create proper completion table based on completions returned from different backends. * test/lisp/progmodes/python-tests.el (python-tests--completion-module) (python-tests--completion-parameters) (python-tests--completion-extra-context): New helper functions. (python-shell-completion-at-point-jedi-completer) (python-shell-completion-at-point-ipython): New tests. (bug#68559) --- lisp/progmodes/python.el | 220 ++++++++++++++++++++++++++++-------- test/lisp/progmodes/python-tests.el | 92 +++++++++++++++ 2 files changed, 264 insertions(+), 48 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 9d840efb9da..b1654b6a5aa 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -5,7 +5,7 @@ ;; Author: Fabián E. Gallina ;; URL: https://github.com/fgallina/python.el ;; Version: 0.28 -;; Package-Requires: ((emacs "24.4") (compat "28.1.2.1") (seq "2.23")) +;; Package-Requires: ((emacs "24.4") (compat "29.1.1.0") (seq "2.23")) ;; Maintainer: emacs-devel@gnu.org ;; Created: Jul 2010 ;; Keywords: languages @@ -128,9 +128,9 @@ ;; receiving escape sequences (with some limitations, i.e. completion ;; in blocks does not work). The code executed for the "fallback" ;; completion can be found in `python-shell-completion-setup-code' and -;; `python-shell-completion-string-code' variables. Their default -;; values enable completion for both CPython and IPython, and probably -;; any readline based shell (it's known to work with PyPy). If your +;; `python-shell-completion-get-completions'. Their default values +;; enable completion for both CPython and IPython, and probably any +;; readline based shell (it's known to work with PyPy). If your ;; Python installation lacks readline (like CPython for Windows), ;; installing pyreadline (URL `https://ipython.org/pyreadline.html') ;; should suffice. To troubleshoot why you are not getting any @@ -141,6 +141,12 @@ ;; If you see an error, then you need to either install pyreadline or ;; setup custom code that avoids that dependency. +;; By default, the "native" completion uses the built-in rlcompleter. +;; To use other readline completer (e.g. Jedi) or a custom one, you just +;; need to set it in the PYTHONSTARTUP file. You can set an +;; Emacs-specific completer by testing the environment variable +;; INSIDE_EMACS. + ;; Shell virtualenv support: The shell also contains support for ;; virtualenvs and other special environment modifications thanks to ;; `python-shell-process-environment' and `python-shell-exec-path'. @@ -3604,7 +3610,6 @@ interpreter is run. Variables `python-shell-prompt-block-regexp', `python-shell-font-lock-enable', `python-shell-completion-setup-code', -`python-shell-completion-string-code', `python-eldoc-setup-code', `python-ffap-setup-code' can customize this mode for different Python interpreters. @@ -4244,8 +4249,9 @@ def __PYTHON_EL_get_completions(text): completions = [] completer = None + import json try: - import readline + import readline, re try: import __builtin__ @@ -4256,16 +4262,29 @@ def __PYTHON_EL_get_completions(text): is_ipython = ('__IPYTHON__' in builtins or '__IPYTHON__active' in builtins) - splits = text.split() - is_module = splits and splits[0] in ('from', 'import') - - if is_ipython and is_module: - from IPython.core.completerlib import module_completion - completions = module_completion(text.strip()) - elif is_ipython and '__IP' in builtins: - completions = __IP.complete(text) - elif is_ipython and 'get_ipython' in builtins: - completions = get_ipython().Completer.all_completions(text) + + if is_ipython and 'get_ipython' in builtins: + def filter_c(prefix, c): + if re.match('_+(i?[0-9]+)?$', c): + return False + elif c[0] == '%' and not re.match('[%a-zA-Z]+$', prefix): + return False + return True + + import IPython + try: + if IPython.version_info[0] >= 6: + from IPython.core.completer import provisionalcompleter + with provisionalcompleter(): + completions = [ + [c.text, c.start, c.end, c.type or '?', c.signature or ''] + for c in get_ipython().Completer.completions(text, len(text)) + if filter_c(text, c.text)] + else: + part, matches = get_ipython().Completer.complete(line_buffer=text) + completions = [text + m[len(part):] for m in matches if filter_c(text, m)] + except: + pass else: # Try to reuse current completer. completer = readline.get_completer() @@ -4288,7 +4307,7 @@ def __PYTHON_EL_get_completions(text): finally: if getattr(completer, 'PYTHON_EL_WRAPPED', False): completer.print_mode = True - return completions" + return json.dumps(completions)" "Code used to setup completion in inferior Python processes." :type 'string) @@ -4329,6 +4348,10 @@ When a match is found, native completion is disabled." :version "25.1" :type 'float) +(defvar python-shell-readline-completer-delims nil + "Word delimiters used by the readline completer. +It is automatically set by Python shell.") + (defvar python-shell-completion-native-redirect-buffer " *Python completions redirect*" "Buffer to be used to redirect output of readline commands.") @@ -4467,6 +4490,10 @@ def __PYTHON_EL_native_completion_setup(): __PYTHON_EL_native_completion_setup()" process))) (when (string-match-p "python\\.el: native completion setup loaded" output) + (setq-local python-shell-readline-completer-delims + (string-trim-right + (python-shell-send-string-no-output + "import readline; print(readline.get_completer_delims())"))) (python-shell-completion-native-try)))) (defun python-shell-completion-native-turn-off (&optional msg) @@ -4534,6 +4561,8 @@ With argument MSG show activation/deactivation message." (let* ((original-filter-fn (process-filter process)) (redirect-buffer (get-buffer-create python-shell-completion-native-redirect-buffer)) + (sep (if (string= python-shell-readline-completer-delims "") + "[\n\r]+" "[ \f\t\n\r\v()]+")) (trigger "\t") (new-input (concat input trigger)) (input-length @@ -4576,28 +4605,80 @@ With argument MSG show activation/deactivation message." process python-shell-completion-native-output-timeout comint-redirect-finished-regexp) (re-search-backward "0__dummy_completion__" nil t) - (cl-remove-duplicates - (split-string - (buffer-substring-no-properties - (line-beginning-position) (point-min)) - "[ \f\t\n\r\v()]+" t) - :test #'string=)))) + (let ((str (buffer-substring-no-properties + (line-beginning-position) (point-min)))) + ;; The readline completer is allowed to return a list + ;; of (text start end type signature) as a JSON + ;; string. See the return value for IPython in + ;; `python-shell-completion-setup-code'. + (if (string= "[" (substring str 0 1)) + (condition-case nil + (python--parse-json-array str) + (t (cl-remove-duplicates (split-string str sep t) + :test #'string=))) + (cl-remove-duplicates (split-string str sep t) + :test #'string=)))))) (set-process-filter process original-filter-fn))))) (defun python-shell-completion-get-completions (process input) "Get completions of INPUT using PROCESS." (with-current-buffer (process-buffer process) - (let ((completions - (python-util-strip-string - (python-shell-send-string-no-output - (format - "%s\nprint(';'.join(__PYTHON_EL_get_completions(%s)))" + (python--parse-json-array + (python-shell-send-string-no-output + (format "%s\nprint(__PYTHON_EL_get_completions(%s))" python-shell-completion-setup-code (python-shell--encode-string input)) - process)))) - (when (> (length completions) 2) - (split-string completions - "^'\\|^\"\\|;\\|'$\\|\"$" t))))) + process)))) + +(defun python-shell--get-multiline-input () + "Return lines at a multi-line input in Python shell." + (save-excursion + (let ((p (point)) lines) + (when (progn + (beginning-of-line) + (looking-back python-shell-prompt-block-regexp (pos-bol))) + (push (buffer-substring-no-properties (point) p) lines) + (while (progn (comint-previous-prompt 1) + (looking-back python-shell-prompt-block-regexp (pos-bol))) + (push (buffer-substring-no-properties (point) (pos-eol)) lines)) + (push (buffer-substring-no-properties (point) (pos-eol)) lines)) + lines))) + +(defun python-shell--extra-completion-context () + "Get extra completion context of current input in Python shell." + (let ((lines (python-shell--get-multiline-input)) + (python-indent-guess-indent-offset nil)) + (when (not (zerop (length lines))) + (with-temp-buffer + (delay-mode-hooks + (insert (string-join lines "\n")) + (python-mode) + (python-shell-completion-extra-context)))))) + +(defun python-shell-completion-extra-context (&optional pos) + "Get extra completion context at position POS in Python buffer. +If optional argument POS is nil, use current position. + +Readline completers could use current line as the completion +context, which may be insufficient. In this function, extra +context (e.g. multi-line function call) is found and reformatted +as one line, which is required by native completion." + (let (bound p) + (save-excursion + (and pos (goto-char pos)) + (setq bound (pos-bol)) + (python-nav-up-list -1) + (when (and (< (point) bound) + (or + (looking-back + (python-rx (group (+ (or "." symbol-name)))) (pos-bol) t) + (progn + (forward-line 0) + (looking-at "^[ \t]*\\(from \\)")))) + (setq p (match-beginning 1)))) + (when p + (replace-regexp-in-string + "\n[ \t]*" "" (buffer-substring-no-properties p (1- bound)))))) (defvar-local python-shell--capf-cache nil "Variable to store cached completions and invalidation keys.") @@ -4612,21 +4693,26 @@ using that one instead of current buffer's process." ;; Working on a shell buffer: use prompt end. (cdr (python-util-comint-last-prompt)) (line-beginning-position))) - (import-statement - (when (string-match-p - (rx (* space) word-start (or "from" "import") word-end space) - (buffer-substring-no-properties line-start (point))) - (buffer-substring-no-properties line-start (point)))) + (no-delims + (and (not (if is-shell-buffer + (eq 'font-lock-comment-face + (get-text-property (1- (point)) 'face)) + (python-syntax-context 'comment))) + (with-current-buffer (process-buffer process) + (if python-shell-completion-native-enable + (string= python-shell-readline-completer-delims "") + (string-match-p "ipython[23]?\\'" python-shell-interpreter))))) (start (if (< (point) line-start) (point) (save-excursion - (if (not (re-search-backward - (python-rx - (or whitespace open-paren close-paren - string-delimiter simple-operator)) - line-start - t 1)) + (if (or no-delims + (not (re-search-backward + (python-rx + (or whitespace open-paren close-paren + string-delimiter simple-operator)) + line-start + t 1))) line-start (forward-char (length (match-string-no-properties 0))) (point))))) @@ -4666,18 +4752,56 @@ using that one instead of current buffer's process." (t #'python-shell-completion-native-get-completions)))) (prev-prompt (car python-shell--capf-cache)) (re (or (cadr python-shell--capf-cache) regexp-unmatchable)) - (prefix (buffer-substring-no-properties start end))) + (prefix (buffer-substring-no-properties start end)) + (prefix-offset 0) + (extra-context (when no-delims + (if is-shell-buffer + (python-shell--extra-completion-context) + (python-shell-completion-extra-context)))) + (extra-offset (length extra-context))) + (unless (zerop extra-offset) + (setq prefix (concat extra-context prefix))) ;; To invalidate the cache, we check if the prompt position or the ;; completion prefix changed. (unless (and (equal prev-prompt (car prompt-boundaries)) - (string-match re prefix)) + (string-match re prefix) + (setq prefix-offset (- (length prefix) (match-end 1)))) (setq python-shell--capf-cache `(,(car prompt-boundaries) ,(if (string-empty-p prefix) regexp-unmatchable - (concat "\\`" (regexp-quote prefix) "\\(?:\\sw\\|\\s_\\)*\\'")) - ,@(funcall completion-fn process (or import-statement prefix))))) - (list start end (cddr python-shell--capf-cache)))) + (concat "\\`\\(" (regexp-quote prefix) "\\)\\(?:\\sw\\|\\s_\\)*\\'")) + ,@(funcall completion-fn process prefix)))) + (let ((cands (cddr python-shell--capf-cache))) + (cond + ((stringp (car cands)) + (if no-delims + ;; Reduce completion candidates due to long prefix. + (if-let ((Lp (length prefix)) + ((string-match "\\(\\sw\\|\\s_\\)+\\'" prefix)) + (L (match-beginning 0))) + ;; If extra-offset is not zero: + ;; start end + ;; o------------------o---------o-------o + ;; |<- extra-offset ->| + ;; |<----------- L ------------>| + ;; new-start + (list (+ start L (- extra-offset)) end + (mapcar (lambda (s) (substring s L)) cands)) + (list end end (mapcar (lambda (s) (substring s Lp)) cands))) + (list start end cands))) + ;; python-shell-completion(-native)-get-completions may produce a + ;; list of (text start end type signature) for completion. + ((consp (car cands)) + (list (+ start (nth 1 (car cands)) (- extra-offset)) + ;; Candidates may be cached, so the end position should + ;; be adjusted according to current completion prefix. + (+ start (nth 2 (car cands)) (- extra-offset) prefix-offset) + cands + :annotation-function + (lambda (c) (concat " " (nth 3 (assoc c cands)))) + :company-docsig + (lambda (c) (nth 4 (assoc c cands))))))))) (define-obsolete-function-alias 'python-shell-completion-complete-at-point diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 59957ff0712..af6c199b5bd 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -4799,6 +4799,98 @@ def foo(): (end-of-line 0) (should-not (nth 2 (python-shell-completion-at-point)))))) +(defun python-tests--completion-module () + "Check if modules can be completed in Python shell." + (insert "import datet") + (completion-at-point) + (beginning-of-line) + (should (looking-at-p "import datetime")) + (kill-line) + (insert "from datet") + (completion-at-point) + (beginning-of-line) + (should (looking-at-p "from datetime")) + (end-of-line) + (insert " import timed") + (completion-at-point) + (beginning-of-line) + (should (looking-at-p "from datetime import timedelta")) + (kill-line)) + +(defun python-tests--completion-parameters () + "Check if parameters can be completed in Python shell." + (insert "import re") + (comint-send-input) + (python-tests-shell-wait-for-prompt) + (insert "re.split('b', 'abc', maxs") + (completion-at-point) + (should (string= "re.split('b', 'abc', maxsplit=" + (buffer-substring (line-beginning-position) (point)))) + (insert "0, ") + (should (python-shell-completion-at-point)) + ;; Test if cache is used. + (cl-letf (((symbol-function 'python-shell-completion-get-completions) + 'ignore) + ((symbol-function 'python-shell-completion-native-get-completions) + 'ignore)) + (insert "fla") + (completion-at-point) + (should (string= "re.split('b', 'abc', maxsplit=0, flags=" + (buffer-substring (line-beginning-position) (point))))) + (beginning-of-line) + (kill-line)) + +(defun python-tests--completion-extra-context () + "Check if extra context is used for completion." + (insert "re.split('b', 'abc',") + (comint-send-input) + (python-tests-shell-wait-for-prompt) + (insert "maxs") + (completion-at-point) + (should (string= "maxsplit=" + (buffer-substring (line-beginning-position) (point)))) + (insert "0)") + (comint-send-input) + (python-tests-shell-wait-for-prompt) + (insert "from re import (") + (comint-send-input) + (python-tests-shell-wait-for-prompt) + (insert "IGN") + (completion-at-point) + (should (string= "IGNORECASE" + (buffer-substring (line-beginning-position) (point))))) + +(ert-deftest python-shell-completion-at-point-jedi-completer () + "Check if Python shell completion works when Jedi completer is used." + (skip-unless (executable-find python-tests-shell-interpreter)) + (python-tests-with-temp-buffer-with-shell + "" + (python-shell-with-shell-buffer + (python-shell-completion-native-turn-on) + (skip-unless (string= python-shell-readline-completer-delims "")) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-tests--completion-extra-context)))) + +(ert-deftest python-shell-completion-at-point-ipython () + "Check if Python shell completion works for IPython." + (let ((python-shell-interpreter "ipython") + (python-shell-interpreter-args "-i --simple-prompt")) + (skip-unless + (and + (executable-find python-shell-interpreter) + (eql (call-process python-shell-interpreter nil nil nil "--version") 0))) + (python-tests-with-temp-buffer-with-shell + "" + (python-shell-with-shell-buffer + (python-shell-completion-native-turn-off) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-shell-completion-native-turn-on) + (skip-unless (string= python-shell-readline-completer-delims "")) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-tests--completion-extra-context))))) ;;; PDB Track integration -- cgit v1.2.3 From 571ec583d644b718ce52f938f111d4aa98192471 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 8 Feb 2024 21:07:10 +0200 Subject: ; Clarify "ChangeLog entries" in CONTRIBUTE. --- CONTRIBUTE | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/CONTRIBUTE b/CONTRIBUTE index a71cc1b277a..049ca00089e 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -184,8 +184,9 @@ Here is an example commit message (indented): Deactivate the mark. Occasionally, commit messages are collected and prepended to a -ChangeLog file, where they can be corrected. It saves time to get -them right the first time, so here are guidelines for formatting them: +generated ChangeLog file, where they can be corrected. It saves time +to get them right the first time, so here are guidelines for +formatting them: - Start with a single unindented summary line explaining the change; do not end this line with a period. If possible, try to keep the @@ -194,9 +195,10 @@ them right the first time, so here are guidelines for formatting them: contexts. If the summary line starts with a semicolon and a space "; ", the - commit message will be ignored when generating the ChangeLog file. - Use this for minor commits that do not need separate ChangeLog - entries, such as changes in etc/NEWS. + commit message will be skipped and not added to the generated + ChangeLog file. Use this for minor commits that do not need to be + mentioned in the ChangeLog file, such as changes in etc/NEWS, typo + fixes, etc. - After the summary line, there should be an empty line. @@ -211,8 +213,8 @@ them right the first time, so here are guidelines for formatting them: enforced by a commit hook. - If only a single file is changed, the summary line can be the normal - file first line (starting with the asterisk). Then there is no - individual files section. + file first line (starting with the asterisk). Then there will be no + individual ChangeLog entries beyond the one in the summary line. - If the commit has more than one author, the commit message should contain separate lines to mention the other authors, like the @@ -245,10 +247,10 @@ them right the first time, so here are guidelines for formatting them: the rationale for a change; that can be done in the commit message between the summary line and the file entries. -- Emacs generally follows the GNU coding standards for ChangeLogs: see - https://www.gnu.org/prep/standards/html_node/Change-Logs.html - or run 'info "(standards)Change Logs"'. One exception is that - commits still sometimes quote `like-this' (as the standards used to +- Emacs follows the GNU coding standards for ChangeLog entries: see + https://www.gnu.org/prep/standards/html_node/Change-Logs.html or run + 'info "(standards)Change Logs"'. One exception is that commits + still sometimes quote `like-this' (as the standards used to recommend) rather than 'like-this' or ‘like this’ (as they do now), as `...' is so widely used elsewhere in Emacs. @@ -261,9 +263,9 @@ them right the first time, so here are guidelines for formatting them: in Emacs; that includes spelling and leaving 2 blanks between sentences. - They are preserved indefinitely, and have a reasonable chance of - being read in the future, so it's better that they have good - presentation. + The ChangeLog entries are preserved indefinitely, and have a + reasonable chance of being read in the future, so it's better that + they have good presentation. - Use the present tense; describe "what the change does", not "what the change did". -- cgit v1.2.3 From d65499e79083fb764517447d4d40ea3222ea2fa2 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 8 Feb 2024 21:26:36 +0200 Subject: ; Another clarification in CONTRIBUTE. --- CONTRIBUTE | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/CONTRIBUTE b/CONTRIBUTE index 049ca00089e..687aa0888ab 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -213,8 +213,9 @@ formatting them: enforced by a commit hook. - If only a single file is changed, the summary line can be the normal - file first line (starting with the asterisk). Then there will be no - individual ChangeLog entries beyond the one in the summary line. + first line of a ChangeLog entry (starting with the asterisk). Then + there will be no individual ChangeLog entries beyond the one in the + summary line. - If the commit has more than one author, the commit message should contain separate lines to mention the other authors, like the @@ -245,7 +246,7 @@ formatting them: - Explaining the rationale for a design choice is best done in comments in the source code. However, sometimes it is useful to describe just the rationale for a change; that can be done in the commit message - between the summary line and the file entries. + between the summary line and the following ChangeLog entries. - Emacs follows the GNU coding standards for ChangeLog entries: see https://www.gnu.org/prep/standards/html_node/Change-Logs.html or run -- cgit v1.2.3 From 31ca4e5501ffa7c80f114c1145ae0ea55fb76d11 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 8 Feb 2024 22:28:08 +0200 Subject: ; And another fix of CONTRIBUTE. --- CONTRIBUTE | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/CONTRIBUTE b/CONTRIBUTE index 687aa0888ab..69d7a2f114f 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -170,9 +170,9 @@ test 'out-of-tree' builds as well, i.e.: ** Commit messages -Ordinarily, a change you commit should contain a log entry in its -commit message and should not touch the repository's ChangeLog files. -Here is an example commit message (indented): +Ordinarily, a changeset you commit should contain a description of the +changes in its commit message and should not touch the repository's +ChangeLog files. Here is an example commit message (indented): Deactivate shifted region -- cgit v1.2.3 From 09c53b717d4941e2ddd113f3f6817bf65ae196f4 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 8 Feb 2024 22:19:40 +0100 Subject: * admin/notes/kind-communication: New file. --- admin/notes/kind-communication | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) create mode 100644 admin/notes/kind-communication diff --git a/admin/notes/kind-communication b/admin/notes/kind-communication new file mode 100644 index 00000000000..80b2afb27b2 --- /dev/null +++ b/admin/notes/kind-communication @@ -0,0 +1,21 @@ +The GNU Project encourages contributions from anyone who wishes to +advance the development of the GNU system, regardless of gender, race, +ethnic group, physical appearance, religion, cultural background, and +any other demographic characteristics, as well as personal political +views. + +People are sometimes discouraged from participating in GNU development +because of certain patterns of communication that strike them as +unfriendly, unwelcoming, rejecting, or harsh. This discouragement +particularly affects members of disprivileged demographics, but it is +not limited to them. Therefore, we ask all contributors to make a +conscious effort, in GNU Project discussions, to communicate in ways +that avoid that outcome — to avoid practices that will predictably and +unnecessarily risk putting some contributors off. + +The GNU Kind Communications Guidelines suggest specific ways to +accomplish that goal. You can find the latest version at +https://www.gnu.org/philosophy/kind-communication.html + +When sending messages to Emacs mailing lists, we ask you to read and +respect these guidelines. -- cgit v1.2.3 From 8290a1bacb019f5026caa08334a7087802ebc6f9 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 9 Feb 2024 09:53:33 +0800 Subject: Replace a few calls to intern with constant strings * src/fns.c (do_yes_or_no_p, Fyes_or_no_p): Use symbol globals rather than intern. (syms_of_fns) : New symbols. * src/lread.c (readevalloop): Use symbol global. (syms_of_lread) : New symbol. --- src/fns.c | 6 ++++-- src/lread.c | 7 ++++++- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/src/fns.c b/src/fns.c index 7de2616b359..61d87752777 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3211,7 +3211,7 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) Lisp_Object do_yes_or_no_p (Lisp_Object prompt) { - return call1 (intern ("yes-or-no-p"), prompt); + return call1 (Qyes_or_no_p, prompt); } DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0, @@ -3256,7 +3256,7 @@ by a mouse, or by some window-system gesture, or via a menu. */) } if (use_short_answers) - return call1 (intern ("y-or-n-p"), prompt); + return call1 (Qy_or_n_p, prompt); { char *s = SSDATA (prompt); @@ -6618,4 +6618,6 @@ For best results this should end in a space. */); DEFSYM (Qreal_this_command, "real-this-command"); DEFSYM (Qfrom__tty_menu_p, "from--tty-menu-p"); + DEFSYM (Qyes_or_no_p, "yes-or-no-p"); + DEFSYM (Qy_or_n_p, "y-or-n-p"); } diff --git a/src/lread.c b/src/lread.c index b5eeb55bb70..5aa7466cc12 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2443,11 +2443,13 @@ readevalloop (Lisp_Object readcharfun, bool whole_buffer = 0; /* True on the first time around. */ bool first_sexp = 1; - Lisp_Object macroexpand = intern ("internal-macroexpand-for-load"); + Lisp_Object macroexpand; if (!NILP (sourcename)) CHECK_STRING (sourcename); + macroexpand = Qinternal_macroexpand_for_load; + if (NILP (Ffboundp (macroexpand)) || (STRINGP (sourcename) && suffix_p (sourcename, ".elc"))) /* Don't macroexpand before the corresponding function is defined @@ -6016,4 +6018,7 @@ See Info node `(elisp)Shorthands' for more details. */); doc: /* List of variables declared dynamic in the current scope. Only valid during macro-expansion. Internal use only. */); Vmacroexp__dynvars = Qnil; + + DEFSYM (Qinternal_macroexpand_for_load, + "internal-macroexpand-for-load"); } -- cgit v1.2.3 From 5af4e346b0b078d6e8f3dd90bb66899d3ed99810 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 9 Feb 2024 10:43:48 +0800 Subject: Don't lose track of adstyles during face merging * src/xfaces.c (merge_face_vectors): If an adstyle exists in FROM, guarantee that a font spec will exist in TO with the same. --- src/xfaces.c | 35 +++++++++++++++++++++++++++-------- 1 file changed, 27 insertions(+), 8 deletions(-) diff --git a/src/xfaces.c b/src/xfaces.c index b9a78328661..a558e7328c0 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -2245,20 +2245,20 @@ merge_face_heights (Lisp_Object from, Lisp_Object to, Lisp_Object invalid) /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and store the resulting attributes in TO, which must be already be - completely specified and contain only absolute attributes. - Every specified attribute of FROM overrides the corresponding - attribute of TO; relative attributes in FROM are merged with the - absolute value in TO and replace it. NAMED_MERGE_POINTS is used - internally to detect loops in face inheritance/remapping; it should - be 0 when called from other places. If window W is non-NULL, use W - to interpret face specifications. */ + completely specified and contain only absolute attributes. Every + specified attribute of FROM overrides the corresponding attribute of + TO; merge relative attributes in FROM with the absolute value in TO, + which attributes also replace it. Use NAMED_MERGE_POINTS internally + to detect loops in face inheritance/remapping; it should be 0 when + called from other places. If window W is non-NULL, use W to + interpret face specifications. */ static void merge_face_vectors (struct window *w, struct frame *f, const Lisp_Object *from, Lisp_Object *to, struct named_merge_point *named_merge_points) { int i; - Lisp_Object font = Qnil; + Lisp_Object font = Qnil, tospec, adstyle; /* If FROM inherits from some other faces, merge their attributes into TO before merging FROM's direct attributes. Note that an :inherit @@ -2318,6 +2318,25 @@ merge_face_vectors (struct window *w, to[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (font); if (! NILP (AREF (font, FONT_WIDTH_INDEX))) to[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (font); + + if (!NILP (AREF (font, FONT_ADSTYLE_INDEX))) + { + /* If an adstyle is specified in FROM's font spec, create a + font spec for TO if none exists, and transfer the adstyle + there. */ + + tospec = to[LFACE_FONT_INDEX]; + adstyle = AREF (font, FONT_ADSTYLE_INDEX); + + if (!NILP (tospec)) + tospec = copy_font_spec (tospec); + else + tospec = Ffont_spec (0, NULL); + + to[LFACE_FONT_INDEX] = tospec; + ASET (tospec, FONT_ADSTYLE_INDEX, adstyle); + } + ASET (font, FONT_SIZE_INDEX, Qnil); } -- cgit v1.2.3 From b3821357696d44e3f553af14c209a21e69187c32 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 9 Feb 2024 13:15:57 +0800 Subject: Set adstyle within sfnt font objects * src/sfntfont.c (sfntfont_open): Don't incorrectly clear desc->adstyle. --- src/sfntfont.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/sfntfont.c b/src/sfntfont.c index 860fc446184..3be770f650e 100644 --- a/src/sfntfont.c +++ b/src/sfntfont.c @@ -3308,7 +3308,7 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity, ASET (font_object, FONT_TYPE_INDEX, sfnt_vendor_name); ASET (font_object, FONT_FOUNDRY_INDEX, desc->designer); ASET (font_object, FONT_FAMILY_INDEX, Fintern (desc->family, Qnil)); - ASET (font_object, FONT_ADSTYLE_INDEX, Qnil); + ASET (font_object, FONT_ADSTYLE_INDEX, desc->adstyle); ASET (font_object, FONT_REGISTRY_INDEX, sfntfont_registry_for_desc (desc)); @@ -3326,8 +3326,6 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity, FONT_SET_STYLE (font_object, FONT_SLANT_INDEX, make_fixnum (desc->slant)); - ASET (font_object, FONT_ADSTYLE_INDEX, Qnil); - /* Clear various offsets. */ font_info->font.baseline_offset = 0; font_info->font.relative_compose = 0; @@ -3412,7 +3410,7 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity, AREF (tem, 3)); FONT_SET_STYLE (font_object, FONT_SLANT_INDEX, AREF (tem, 4)); - ASET (font_object, FONT_ADSTYLE_INDEX, Qnil); + ASET (font_object, FONT_ADSTYLE_INDEX, AREF (tem, 1)); } } -- cgit v1.2.3 From 4e5068b7b3a06aaba6b93dff759a93b385ab8fd0 Mon Sep 17 00:00:00 2001 From: Dominique Quatravaux Date: Thu, 8 Feb 2024 10:19:10 +0100 Subject: Fix treesit_traverse_get_predicate (bug#68954) Commit d005e685e1df7692085378633348db39a5190374 should have used assq_no_signal, but didn't, this commit fixes that. * src/treesit.c (treesit_traverse_get_predicate): Replace assq_no_quit with assq_no_signal. Copyright-paperwork-exempt: yes --- src/treesit.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/treesit.c b/src/treesit.c index 12915ea9a10..d86ab501187 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -3275,11 +3275,11 @@ treesit_traverse_child_helper (TSTreeCursor *cursor, static Lisp_Object treesit_traverse_get_predicate (Lisp_Object thing, Lisp_Object language) { - Lisp_Object cons = assq_no_quit (language, Vtreesit_thing_settings); + Lisp_Object cons = assq_no_signal (language, Vtreesit_thing_settings); if (NILP (cons)) return Qnil; Lisp_Object definitions = XCDR (cons); - Lisp_Object entry = assq_no_quit (thing, definitions); + Lisp_Object entry = assq_no_signal (thing, definitions); if (NILP (entry)) return Qnil; /* ENTRY looks like (THING PRED). */ -- cgit v1.2.3 From 7d3a144486461869b943f04a45e84c0c3d926732 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 9 Feb 2024 08:49:55 +0200 Subject: ; Mention defface's and their :version tags in CONTRIBUTE. --- CONTRIBUTE | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/CONTRIBUTE b/CONTRIBUTE index 69d7a2f114f..cdb47911d76 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -115,9 +115,10 @@ mode after hiding the body of each entry. Doc-strings should be updated together with the code. -New defcustom's should always have a ':version' tag stating the first -Emacs version in which they will appear. Likewise with defcustom's -whose value is changed -- update their ':version' tag. +New defcustom's and defface's should always have a ':version' tag +stating the first Emacs version in which they will appear. Likewise +with defcustom's or defface's whose value is changed -- update their +':version' tag. Think about whether your change requires updating the manuals. If you know it does not, mark the NEWS entry with "---" before the entry. If -- cgit v1.2.3 From 8d09e1def55e57a8c627ba704289f796c48a085d Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 8 Feb 2024 23:17:04 -0800 Subject: Port to GNU Make 03ecd94488b85adc38746ec3e7c2a297a522598e MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Problem reported by Collin Funk (Bug#68996). * GNUmakefile (.): New macro. (help): Use ‘$.’ instead of ‘$ ’. * cross/verbose.mk.android, src/verbose.mk.in (.): New macro. (AM_V_AR, AM_V_CC, AM_V_CXX, AM_V_CCLD, AM_V_CXXLD, AM_V_GEN): Use ‘$.’ instead of ‘$ ’. * lib-src/Makefile.in (install): Use ‘$.’ instead of ‘$ ’. --- GNUmakefile | 50 +++++++++++++++++++++++++----------------------- cross/verbose.mk.android | 13 +++++++------ lib-src/Makefile.in | 4 ++-- src/verbose.mk.in | 29 ++++++++++++++-------------- 4 files changed, 50 insertions(+), 46 deletions(-) diff --git a/GNUmakefile b/GNUmakefile index 16064672c65..58c0281e895 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -27,6 +27,8 @@ # newly-built Makefile. If the source tree is already configured, # this file defers to the existing Makefile. +. := + # If you want non-default build options, or if you want to build in an # out-of-source tree, you should run 'configure' before running 'make'. # But run 'autogen.sh' first, if the source was checked out directly @@ -36,30 +38,30 @@ ifeq (help,$(filter help,$(MAKECMDGOALS))) help: - $(info $ NOTE: This is a brief summary of some common make targets.) - $(info $ For more detailed information, please read the files INSTALL,) - $(info $ INSTALL.REPO, Makefile or visit this URL:) - $(info $ https://www.gnu.org/prep/standards/html_node/Standard-Targets.html) - $(info $ ) - $(info $ make all -- compile and build Emacs) - $(info $ make install -- install Emacs) - $(info $ make TAGS -- update tags tables) - $(info $ make clean -- delete built files but preserve configuration) - $(info $ make mostlyclean -- like 'make clean', but leave those files that) - $(info $ usually do not need to be recompiled) - $(info $ make distclean -- delete all build and configuration files,) - $(info $ leave only files included in source distribution) - $(info $ make maintainer-clean -- delete almost everything that can be regenerated) - $(info $ make extraclean -- like maintainer-clean, and also delete) - $(info $ backup and autosave files) - $(info $ make bootstrap -- delete all compiled files to force a new bootstrap) - $(info $ from a clean slate, then build in the normal way) - $(info $ make uninstall -- remove files installed by 'make install') - $(info $ make check -- run the Emacs test suite) - $(info $ make docs -- generate Emacs documentation in info format) - $(info $ make html -- generate documentation in html format) - $(info $ make ps -- generate documentation in ps format) - $(info $ make pdf -- generate documentation in pdf format ) + $(info $.NOTE: This is a brief summary of some common make targets.) + $(info $.For more detailed information, please read the files INSTALL,) + $(info $.INSTALL.REPO, Makefile or visit this URL:) + $(info $.https://www.gnu.org/prep/standards/html_node/Standard-Targets.html) + $(info $.) + $(info $.make all -- compile and build Emacs) + $(info $.make install -- install Emacs) + $(info $.make TAGS -- update tags tables) + $(info $.make clean -- delete built files but preserve configuration) + $(info $.make mostlyclean -- like 'make clean', but leave those files that) + $(info $. usually do not need to be recompiled) + $(info $.make distclean -- delete all build and configuration files,) + $(info $. leave only files included in source distribution) + $(info $.make maintainer-clean -- delete almost everything that can be regenerated) + $(info $.make extraclean -- like maintainer-clean, and also delete) + $(info $. backup and autosave files) + $(info $.make bootstrap -- delete all compiled files to force a new bootstrap) + $(info $. from a clean slate, then build in the normal way) + $(info $.make uninstall -- remove files installed by 'make install') + $(info $.make check -- run the Emacs test suite) + $(info $.make docs -- generate Emacs documentation in info format) + $(info $.make html -- generate documentation in html format) + $(info $.make ps -- generate documentation in ps format) + $(info $.make pdf -- generate documentation in pdf format ) @: .PHONY: help diff --git a/cross/verbose.mk.android b/cross/verbose.mk.android index 958cf237c58..7b9af76404b 100644 --- a/cross/verbose.mk.android +++ b/cross/verbose.mk.android @@ -44,12 +44,13 @@ have_working_info = $(filter notintermediate,$(value .FEATURES)) # The workaround is done only for AM_V_ELC and AM_V_ELN, # since the bug is not annoying elsewhere. -AM_V_AR = @$(info $ AR $@) +. := +AM_V_AR = @$(info $. AR $@) AM_V_at = @ -AM_V_CC = @$(info $ CC $@) -AM_V_CXX = @$(info $ CXX $@) -AM_V_CCLD = @$(info $ CCLD $@) -AM_V_CXXLD = @$(info $ CXXLD $@) -AM_V_GEN = @$(info $ GEN $@) +AM_V_CC = @$(info $. CC $@) +AM_V_CXX = @$(info $. CXX $@) +AM_V_CCLD = @$(info $. CCLD $@) +AM_V_CXXLD = @$(info $. CXXLD $@) +AM_V_GEN = @$(info $. GEN $@) AM_V_NO_PD = --no-print-directory endif diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index 7c059640862..3cdf1620781 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -319,7 +319,7 @@ maybe-blessmail: $(BLESSMAIL_TARGET) ## up if chown or chgrp fails, as the package responsible for ## installing Emacs can fix this problem later. $(DESTDIR)${archlibdir}: all - $(info $ ) + $(info $.) $(info Installing utilities run internally by Emacs.) umask 022 && ${MKDIR_P} "$(DESTDIR)${archlibdir}" exp_archlibdir=`cd "$(DESTDIR)${archlibdir}" && pwd -P` && \ @@ -361,7 +361,7 @@ $(DESTDIR)${archlibdir}: all .PHONY: bootstrap-clean check tags install: $(DESTDIR)${archlibdir} - $(info $ ) + $(info $.) $(info Installing utilities for users to run.) umask 022 && ${MKDIR_P} "$(DESTDIR)${bindir}" for file in ${INSTALLABLES} ; do \ diff --git a/src/verbose.mk.in b/src/verbose.mk.in index e72c182f276..6efb6b9416b 100644 --- a/src/verbose.mk.in +++ b/src/verbose.mk.in @@ -53,38 +53,39 @@ have_working_info = $(filter notintermediate,$(value .FEATURES)) # The workaround is done only for AM_V_ELC and AM_V_ELN, # since the bug is not annoying elsewhere. -AM_V_AR = @$(info $ AR $@) +. := +AM_V_AR = @$(info $. AR $@) AM_V_at = @ -AM_V_CC = @$(info $ CC $@) -AM_V_CXX = @$(info $ CXX $@) -AM_V_CCLD = @$(info $ CCLD $@) -AM_V_CXXLD = @$(info $ CXXLD $@) +AM_V_CC = @$(info $. CC $@) +AM_V_CXX = @$(info $. CXX $@) +AM_V_CCLD = @$(info $. CCLD $@) +AM_V_CXXLD = @$(info $. CXXLD $@) ifeq ($(HAVE_NATIVE_COMP)-$(NATIVE_DISABLED)-$(ANCIENT),yes--) ifneq (,$(have_working_info)) -AM_V_ELC = @$(info $ ELC+ELN $@) -AM_V_ELN = @$(info $ ELN $@) +AM_V_ELC = @$(info $. ELC+ELN $@) +AM_V_ELN = @$(info $. ELN $@) else AM_V_ELC = @echo " ELC+ELN " $@; AM_V_ELN = @echo " ELN " $@; endif else ifneq (,$(have_working_info)) -AM_V_ELC = @$(info $ ELC $@) +AM_V_ELC = @$(info $. ELC $@) else AM_V_ELC = @echo " ELC " $@; endif AM_V_ELN = endif -AM_V_GEN = @$(info $ GEN $@) -AM_V_GLOBALS = @$(info $ GEN globals.h) +AM_V_GEN = @$(info $. GEN $@) +AM_V_GLOBALS = @$(info $. GEN globals.h) AM_V_NO_PD = --no-print-directory -AM_V_RC = @$(info $ RC $@) +AM_V_RC = @$(info $. RC $@) # These are used for the Android port. -AM_V_JAVAC = @$(info $ JAVAC $@) -AM_V_D8 = @$(info $ D8 $@) -AM_V_AAPT = @$(info $ AAPT $@) +AM_V_JAVAC = @$(info $. JAVAC $@) +AM_V_D8 = @$(info $. D8 $@) +AM_V_AAPT = @$(info $. AAPT $@) AM_V_SILENT = @ endif -- cgit v1.2.3 From f1e7b5230ad93aab20af1fd7b09931a746a89d5d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 9 Feb 2024 11:05:14 +0100 Subject: Tramp: Handle PIN requests from security keys (don't merge) * doc/misc/tramp.texi (Frequently Asked Questions): Clarify FIDO entry. * lisp/net/tramp-sh.el (tramp-actions-before-shell) (tramp-actions-copy-out-of-band): Use `tramp-security-key-pin-regexp'. * lisp/net/tramp.el (tramp-security-key-pin-regexp): New defcustom. (tramp-action-otp-password, tramp-read-passwd): Trim password prompt. (tramp-action-show-and-confirm-message): Expand for PIN requests. --- doc/misc/tramp.texi | 11 ++++++++--- lisp/net/tramp-sh.el | 2 ++ lisp/net/tramp.el | 33 ++++++++++++++++++++++----------- 3 files changed, 32 insertions(+), 14 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 3be88d1767a..d6031d96d6b 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5070,9 +5070,14 @@ Does @value{tramp} support @acronym{SSH} security keys? Yes. @command{OpenSSH} has added support for @acronym{FIDO} hardware devices via special key types @option{*-sk}. @value{tramp} supports the additional handshaking messages for them. This requires at least -@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} compatible -security key, like yubikey, solokey, nitrokey, or titankey. - +@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} or +@acronym{FIDO2} compatible security key, like yubikey, solokey, +nitrokey, or titankey. +@c @uref{https://docs.fedoraproject.org/en-US/quick-docs/using-yubikeys/} + +@strong{Note} that there are reports on problems of handling yubikey +residential keys by @command{ssh-agent}. As workaround, you might +disable @command{ssh-agent} for such keys. @item @value{tramp} does not connect to Samba or MS Windows hosts running diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 44c0bdc7aea..3e6fb384a8f 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -544,6 +544,7 @@ shell from reading its init file." (tramp-terminal-prompt-regexp tramp-action-terminal) (tramp-antispoof-regexp tramp-action-confirm-message) (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message) + (tramp-security-key-pin-regexp tramp-action-otp-password) (tramp-process-alive-regexp tramp-action-process-alive)) "List of pattern/action pairs. Whenever a pattern matches, the corresponding action is performed. @@ -563,6 +564,7 @@ corresponding PATTERN matches, the ACTION function is called.") (tramp-wrong-passwd-regexp tramp-action-permission-denied) (tramp-copy-failed-regexp tramp-action-permission-denied) (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message) + (tramp-security-key-pin-regexp tramp-action-otp-password) (tramp-process-alive-regexp tramp-action-out-of-band)) "List of pattern/action pairs. This list is used for copying/renaming with out-of-band methods. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index bd556753261..f3da56e7a4f 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -224,7 +224,7 @@ pair of the form (KEY VALUE). The following KEYs are defined: set this to any value other than \"/bin/sh\": Tramp wants to use a shell which groks tilde expansion, but it can search for it. Also note that \"/bin/sh\" exists on all Unixen - except Andtoid, this might not be true for the value that you + except Android, this might not be true for the value that you decide to use. You Have Been Warned. * `tramp-remote-shell-login' @@ -788,6 +788,13 @@ The regexp should match at end of buffer." :version "28.1" :type 'regexp) +(defcustom tramp-security-key-pin-regexp + (rx bol (* "\r") (group "Enter PIN for " (* nonl)) (* (any "\r\n"))) + "Regular expression matching security key PIN prompt. +The regexp should match at end of buffer." + :version "29.3" + :type 'regexp) + (defcustom tramp-operation-not-permitted-regexp (rx (| (: "preserving times" (* nonl)) "set mode") ":" (* blank) "Operation not permitted") @@ -5589,7 +5596,7 @@ of." prompt) (goto-char (point-min)) (tramp-check-for-regexp proc tramp-process-action-regexp) - (setq prompt (concat (match-string 1) " ")) + (setq prompt (concat (string-trim (match-string 1)) " ")) (tramp-message vec 3 "Sending %s" (match-string 1)) ;; We don't call `tramp-send-string' in order to hide the ;; password from the debug buffer and the traces. @@ -5665,14 +5672,17 @@ Wait, until the connection buffer changes." (ignore set-message-function clear-message-function) (tramp-message vec 6 "\n%s" (buffer-string)) (tramp-check-for-regexp proc tramp-process-action-regexp) - (with-temp-message - (replace-regexp-in-string (rx (any "\r\n")) "" (match-string 0)) + (with-temp-message (concat (string-trim (match-string 0)) " ") ;; Hide message in buffer. (narrow-to-region (point-max) (point-max)) ;; Wait for new output. (while (not (tramp-compat-ignore-error file-error (tramp-wait-for-regexp - proc 0.1 tramp-security-key-confirmed-regexp))) + proc 0.1 + (tramp-compat-rx + (| (regexp tramp-security-key-confirmed-regexp) + (regexp tramp-security-key-pin-regexp) + (regexp tramp-security-key-timeout-regexp)))))) (when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp) (throw 'tramp-action 'timeout)) (redisplay 'force))) @@ -6726,12 +6736,13 @@ Consults the auth-source package." (tramp-get-connection-property key "login-as"))) (host (tramp-file-name-host-port vec)) (pw-prompt - (or prompt - (with-current-buffer (process-buffer proc) - (tramp-check-for-regexp proc tramp-password-prompt-regexp) - (if (string-match-p "passphrase" (match-string 1)) - (match-string 0) - (format "%s for %s " (capitalize (match-string 1)) key))))) + (string-trim-left + (or prompt + (with-current-buffer (process-buffer proc) + (tramp-check-for-regexp proc tramp-password-prompt-regexp) + (if (string-match-p "passphrase" (match-string 1)) + (match-string 0) + (format "%s for %s " (capitalize (match-string 1)) key)))))) (auth-source-creation-prompts `((secret . ,pw-prompt))) ;; Use connection-local value. (auth-sources (buffer-local-value 'auth-sources (process-buffer proc))) -- cgit v1.2.3 From 8d6a8e573f9a1e4eb9ebbc0ec244907263e61bb8 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 9 Feb 2024 11:21:05 +0100 Subject: Tramp: Handle PIN requests from security keys * doc/misc/tramp.texi (Frequently Asked Questions): Clarify FIDO entry. * lisp/net/tramp-sh.el (tramp-actions-before-shell) (tramp-actions-copy-out-of-band): Use `tramp-security-key-pin-regexp'. * lisp/net/tramp.el (tramp-security-key-pin-regexp): New defcustom. (tramp-action-otp-password, tramp-read-passwd): Trim password prompt. (tramp-action-show-and-confirm-message): Expand for PIN requests. --- doc/misc/tramp.texi | 11 ++++++++--- lisp/net/tramp-sh.el | 2 ++ lisp/net/tramp.el | 30 ++++++++++++++++++++---------- 3 files changed, 30 insertions(+), 13 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 56945d3071c..90824024c03 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5238,9 +5238,14 @@ Does @value{tramp} support @acronym{SSH} security keys? Yes. @command{OpenSSH} has added support for @acronym{FIDO} hardware devices via special key types @option{*-sk}. @value{tramp} supports the additional handshaking messages for them. This requires at least -@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} compatible -security key, like yubikey, solokey, nitrokey, or titankey. - +@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} or +@acronym{FIDO2} compatible security key, like yubikey, solokey, +nitrokey, or titankey. +@c @uref{https://docs.fedoraproject.org/en-US/quick-docs/using-yubikeys/} + +@strong{Note} that there are reports on problems of handling yubikey +residential keys by @command{ssh-agent}. As workaround, you might +disable @command{ssh-agent} for such keys. @item @value{tramp} does not connect to Samba or MS Windows hosts running diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 68ee541bee6..3557b3a1b64 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -547,6 +547,7 @@ shell from reading its init file." (tramp-terminal-prompt-regexp tramp-action-terminal) (tramp-antispoof-regexp tramp-action-confirm-message) (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message) + (tramp-security-key-pin-regexp tramp-action-otp-password) (tramp-process-alive-regexp tramp-action-process-alive)) "List of pattern/action pairs. Whenever a pattern matches, the corresponding action is performed. @@ -566,6 +567,7 @@ corresponding PATTERN matches, the ACTION function is called.") (tramp-wrong-passwd-regexp tramp-action-permission-denied) (tramp-copy-failed-regexp tramp-action-permission-denied) (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message) + (tramp-security-key-pin-regexp tramp-action-otp-password) (tramp-process-alive-regexp tramp-action-out-of-band)) "List of pattern/action pairs. This list is used for copying/renaming with out-of-band methods. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 8e114912527..ae59915b1e8 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -770,6 +770,13 @@ The regexp should match at end of buffer." :version "28.1" :type 'regexp) +(defcustom tramp-security-key-pin-regexp + (rx bol (* "\r") (group "Enter PIN for " (* nonl)) (* (any "\r\n"))) + "Regular expression matching security key PIN prompt. +The regexp should match at end of buffer." + :version "29.3" + :type 'regexp) + (defcustom tramp-operation-not-permitted-regexp (rx (| (: "preserving times" (* nonl)) "set mode") ":" (* blank) "Operation not permitted") @@ -5435,7 +5442,7 @@ of." prompt) (goto-char (point-min)) (tramp-check-for-regexp proc tramp-process-action-regexp) - (setq prompt (concat (match-string 1) " ")) + (setq prompt (concat (string-trim (match-string 1)) " ")) (tramp-message vec 3 "Sending %s" (match-string 1)) ;; We don't call `tramp-send-string' in order to hide the ;; password from the debug buffer and the traces. @@ -5511,14 +5518,16 @@ Wait, until the connection buffer changes." (ignore set-message-function clear-message-function) (tramp-message vec 6 "\n%s" (buffer-string)) (tramp-check-for-regexp proc tramp-process-action-regexp) - (with-temp-message - (replace-regexp-in-string (rx (any "\r\n")) "" (match-string 0)) + (with-temp-message (concat (string-trim (match-string 0)) " ") ;; Hide message in buffer. (narrow-to-region (point-max) (point-max)) ;; Wait for new output. (while (not (ignore-error file-error (tramp-wait-for-regexp - proc 0.1 tramp-security-key-confirmed-regexp))) + proc 0.1 + (rx (| (regexp tramp-security-key-confirmed-regexp) + (regexp tramp-security-key-pin-regexp) + (regexp tramp-security-key-timeout-regexp)))))) (when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp) (throw 'tramp-action 'timeout)) (redisplay 'force)))))) @@ -6564,12 +6573,13 @@ Consults the auth-source package." (tramp-get-connection-property key "login-as"))) (host (tramp-file-name-host-port vec)) (pw-prompt - (or prompt - (with-current-buffer (process-buffer proc) - (tramp-check-for-regexp proc tramp-password-prompt-regexp) - (if (string-match-p "passphrase" (match-string 1)) - (match-string 0) - (format "%s for %s " (capitalize (match-string 1)) key))))) + (string-trim-left + (or prompt + (with-current-buffer (process-buffer proc) + (tramp-check-for-regexp proc tramp-password-prompt-regexp) + (if (string-match-p "passphrase" (match-string 1)) + (match-string 0) + (format "%s for %s " (capitalize (match-string 1)) key)))))) (auth-source-creation-prompts `((secret . ,pw-prompt))) ;; Use connection-local value. (auth-sources (buffer-local-value 'auth-sources (process-buffer proc))) -- cgit v1.2.3 From c4ec6d0472beac2a0cb4f5c8baec79e39dfc410b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 9 Feb 2024 14:08:51 -0500 Subject: * lisp/subr.el (read-char-from-minibuffer): Fix bug#68995 --- lisp/subr.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index e53ef505522..f41bb34045e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3726,10 +3726,10 @@ There is no need to explicitly add `help-char' to CHARS; (this-command this-command) (result (minibuffer-with-setup-hook (lambda () + (setq-local post-self-insert-hook nil) (add-hook 'post-command-hook (lambda () - ;; FIXME: Should we use `<='? - (if (= (1+ (minibuffer-prompt-end)) + (if (<= (1+ (minibuffer-prompt-end)) (point-max)) (exit-minibuffer))) nil 'local)) -- cgit v1.2.3 From 3c3702b9bbc79f63026606dc0f391da3d795226d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 9 Feb 2024 14:13:29 -0500 Subject: * lisp/subr.el (with-output-to-temp-buffer): Add `indent` rule --- lisp/emacs-lisp/lisp-mode.el | 1 - lisp/subr.el | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index ad0525e24be..3475d944337 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1347,7 +1347,6 @@ Lisp function does not specify a special indentation." (put 'condition-case 'lisp-indent-function 2) (put 'handler-case 'lisp-indent-function 1) ;CL (put 'unwind-protect 'lisp-indent-function 1) -(put 'with-output-to-temp-buffer 'lisp-indent-function 1) (put 'closure 'lisp-indent-function 2) (defun indent-sexp (&optional endpos) diff --git a/lisp/subr.el b/lisp/subr.el index f41bb34045e..c317d558e24 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5019,7 +5019,7 @@ read-only, and scans it for function and variable names to make them into clickable cross-references. See the related form `with-temp-buffer-window'." - (declare (debug t)) + (declare (debug t) (indent 1)) (let ((old-dir (make-symbol "old-dir")) (buf (make-symbol "buf"))) `(let* ((,old-dir default-directory) -- cgit v1.2.3 From efedb8f479f1f2cf4d7ce703c6411dd756d2843d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 9 Feb 2024 14:22:14 -0500 Subject: modula2.el: Avoid font-lock-*-face variables * lisp/progmodes/modula2.el (m3-font-lock-keywords-1) (m3-font-lock-keywords-2): Refer to the font-lock faces directly --- lisp/progmodes/modula2.el | 47 +++++++++++++++++++++++++---------------------- 1 file changed, 25 insertions(+), 22 deletions(-) diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el index 09cb848fd52..2bb31988290 100644 --- a/lisp/progmodes/modula2.el +++ b/lisp/progmodes/modula2.el @@ -325,20 +325,20 @@ followed by the first character of the construct. ;; ;; Module definitions. ("\\<\\(INTERFACE\\|MODULE\\|PROCEDURE\\)\\>[ \t]*\\(\\sw+\\)?" - (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) + (1 'font-lock-keyword-face) (2 'font-lock-function-name-face nil t)) ;; ;; Import directives. ("\\<\\(EXPORTS\\|FROM\\|IMPORT\\)\\>" - (1 font-lock-keyword-face) + (1 'font-lock-keyword-face) (font-lock-match-c-style-declaration-item-and-skip-to-next nil (goto-char (match-end 0)) - (1 font-lock-constant-face))) + (1 'font-lock-constant-face))) ;; ;; Pragmas as warnings. ;; Spencer Allain says do them as comments... ;; ("<\\*.*\\*>" . font-lock-warning-face) ;; ... but instead we fontify the first word. - ("<\\*[ \t]*\\(\\sw+\\)" 1 font-lock-warning-face prepend) + ("<\\*[ \t]*\\(\\sw+\\)" 1 'font-lock-warning-face prepend) ) "Subdued level highlighting for Modula-3 modes.") @@ -366,26 +366,29 @@ followed by the first character of the construct. "LOOPHOLE" "MAX" "MIN" "NARROW" "NEW" "NUMBER" "ORD" "ROUND" "SUBARRAY" "TRUNC" "TYPECODE" "VAL"))) ) - (list - ;; - ;; Keywords except those fontified elsewhere. - (concat "\\<\\(" m3-keywords "\\)\\>") - ;; - ;; Builtins. - (cons (concat "\\<\\(" m3-builtins "\\)\\>") 'font-lock-builtin-face) - ;; - ;; Type names. - (cons (concat "\\<\\(" m3-types "\\)\\>") 'font-lock-type-face) - ;; - ;; Fontify tokens as function names. - '("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*" - (1 font-lock-keyword-face) + `( + ;; + ;; Keywords except those fontified elsewhere. + ,(concat "\\<\\(" m3-keywords "\\)\\>") + ;; + ;; Builtins. + (,(concat "\\<\\(" m3-builtins "\\)\\>") + (0 'font-lock-builtin-face)) + ;; + ;; Type names. + (,(concat "\\<\\(" m3-types "\\)\\>") + (0 'font-lock-type-face)) + ;; + ;; Fontify tokens as function names. + ("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*" + (1 'font-lock-keyword-face) (font-lock-match-c-style-declaration-item-and-skip-to-next nil (goto-char (match-end 0)) - (1 font-lock-function-name-face))) - ;; - ;; Fontify constants as references. - '("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" . font-lock-constant-face) + (1 'font-lock-function-name-face))) + ;; + ;; Fontify constants as references. + ("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" + (0 'font-lock-constant-face)) )))) "Gaudy level highlighting for Modula-3 modes.") -- cgit v1.2.3 From 7a13e705b1aead8f527dfa5407d9f87301b1f252 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Wed, 7 Feb 2024 17:58:31 -0800 Subject: Put the list of built-in Eshell commands in its own manual node * doc/misc/eshell.texi (Built-ins): Fix capitalization of node to be more consistent with the rest of the manual. Fix a cross reference. List child nodes. (List of Built-ins): New section and node. (Defining New Built-ins): Make this a node. Fix capitalization. --- doc/misc/eshell.texi | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 5d3e5c7dbd6..9e5eea6cb61 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -416,7 +416,7 @@ elisp, The Emacs Lisp Reference Manual}). @end table @node Built-ins -@section Built-in commands +@section Built-in Commands Eshell provides a number of built-in commands, many of them implementing common command-line utilities, but enhanced for Eshell. (These built-in commands are just ordinary Lisp functions whose names @@ -477,7 +477,16 @@ default target for the commands @command{cp}, @command{mv}, and @command{ln} is the current directory. A few commands are wrappers for more niche Emacs features, and can be -loaded as part of the eshell-xtra module. @xref{Extension modules}. +loaded as part of the @code{eshell-xtra} module. @xref{Extra built-in +commands}. + +@menu +* List of Built-ins:: +* Defining New Built-ins:: +@end menu + +@node List of Built-ins +@subsection List of Built-in Commands @table @code @@ -1195,7 +1204,8 @@ connection-aware, so for remote directories, it will print the user associated with that connection. @end table -@subsection Defining new built-in commands +@node Defining New Built-ins +@subsection Defining New Built-in Commands While Eshell can run Lisp functions directly as commands, it may be more convenient to provide a special built-in command for Eshell. Built-in commands are just ordinary Lisp functions designed -- cgit v1.2.3 From b5b80de49c5a37778945d7a0234090b09acc104f Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Thu, 8 Feb 2024 11:31:17 -0800 Subject: In Eshell manual, put command index anchors above the item This makes sure that when navigating to the command's documentation from the index, it shows the item heading (which lists the supported arguments). * doc/misc/eshell.texi (List of Built-ins, Tramp extensions) (Extra built-in commands): Adjust placement of '@cmindex'. --- doc/misc/eshell.texi | 134 +++++++++++++++++++++++++-------------------------- 1 file changed, 67 insertions(+), 67 deletions(-) diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 9e5eea6cb61..3ff8e55ed03 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -490,16 +490,16 @@ commands}. @table @code -@item . @var{file} [@var{argument}]@dots{} @cmindex . +@item . @var{file} [@var{argument}]@dots{} Source an Eshell script named @var{file} in the current environment, passing any @var{arguments} to the script (@pxref{Scripts}). This is not to be confused with the command @command{source}, which sources a file in a subshell environment. +@cmindex addpath @item addpath @itemx addpath [-b] @var{directory}@dots{} -@cmindex addpath Adds each specified @var{directory} to the @code{$PATH} environment variable. By default, this adds the directories to the end of @code{$PATH}, in the order they were passed on the command line; by @@ -509,30 +509,30 @@ directories to the beginning. With no directories, print the list of directories currently stored in @code{$PATH}. +@cmindex alias @item alias @itemx alias @var{name} [@var{command}] -@cmindex alias Define an alias named @var{name} and expanding to @var{command}, adding it to the aliases file (@pxref{Aliases}). If @var{command} is omitted, delete the alias named @var{name}. With no arguments at all, list all the currently-defined aliases. -@item basename @var{filename} @cmindex basename +@item basename @var{filename} Return @var{filename} without its directory. -@item cat @var{file}@dots{} @cmindex cat +@item cat @var{file}@dots{} Concatenate the contents of @var{file}s to standard output. If in a pipeline, or if any of the files is not a regular file, directory, or symlink, then this command reverts to the system's definition of @command{cat}. +@cmindex cd @item cd @itemx cd @var{directory} @itemx cd -[@var{n}] @itemx cd =[@var{regexp}] -@cmindex cd Change the current working directory. This command can take several forms: @@ -567,20 +567,20 @@ will report the directory it changes to. If @code{eshell-list-files-after-cd} is non-@code{nil}, then @command{ls} is called with any remaining arguments after changing directories. -@item clear [@var{scrollback}] @cmindex clear +@item clear [@var{scrollback}] Scrolls the contents of the Eshell window out of sight, leaving a blank window. If @var{scrollback} is non-@code{nil}, the scrollback contents are cleared instead, as with @command{clear-scrollback}. -@item clear-scrollback @cmindex clear-scrollback +@item clear-scrollback Clear the scrollback contents of the Eshell window. Unlike the command @command{clear}, this command deletes content in the Eshell buffer. -@item compile [-p | -i] [-m @var{mode-name}] @var{command}@dots{} @cmindex compile +@item compile [-p | -i] [-m @var{mode-name}] @var{command}@dots{} Run an external command, sending its output to a compilation buffer if the command would output to the screen and is not part of a pipeline or subcommand. @@ -598,9 +598,9 @@ you have a grep-like command on your system, you might define an alias for it like so: @samp{alias mygrep 'compile --mode=grep-mode -- mygrep $*'}. +@cmindex cp @item cp [@var{option}@dots{}] @var{source} @var{dest} @item cp [@var{option}@dots{}] @var{source}@dots{} @var{directory} -@cmindex cp Copy the file @var{source} to @var{dest} or @var{source} into @var{directory}. @@ -644,14 +644,14 @@ Print the name of each file before copying it. @end table -@item date [@var{specified-time} [@var{zone}]] @cmindex date +@item date [@var{specified-time} [@var{zone}]] Print the current local time as a human-readable string. This command is an alias to the Emacs Lisp function @code{current-time-string} (@pxref{Time of Day,,, elisp, GNU Emacs Lisp Reference Manual}). -@item diff [@var{option}]@dots{} @var{old} @var{new} @cmindex diff +@item diff [@var{option}]@dots{} @var{old} @var{new} Compare the files @var{old} and @var{new} using Emacs's internal @code{diff} (not to be confused with @code{ediff}). @xref{Comparing Files, , , emacs, The GNU Emacs Manual}. @@ -661,18 +661,18 @@ If @code{eshell-plain-diff-behavior} is non-@code{nil}, then this command does not use Emacs's internal @code{diff}. This is the same as using @samp{alias diff '*diff $@@*'}. -@item dirname @var{filename} @cmindex dirname +@item dirname @var{filename} Return the directory component of @var{filename}. -@item dirs @cmindex dirs +@item dirs Prints the directory stack. Directories can be added or removed from the stack using the commands @command{pushd} and @command{popd}, respectively. -@item du [@var{option}]@dots{} @var{file}@dots{} @cmindex du +@item du [@var{option}]@dots{} @var{file}@dots{} Summarize disk usage for each file, recursing into directories. @command{du} accepts the following options: @@ -720,8 +720,8 @@ Skip any directories that reside on different filesystems. @end table -@item echo [-n | -N] [@var{arg}]@dots{} @cmindex echo +@item echo [-n | -N] [@var{arg}]@dots{} Prints the value of each @var{arg}. By default, this prints in a Lisp-friendly fashion (so that the value is useful to a Lisp command using the result of @command{echo} as an argument). If a single @@ -739,16 +739,16 @@ using @code{-n} to disable the trailing newline (the default behavior) or @code{-N} to enable it (the default when @code{eshell-plain-echo-behavior} is non-@code{nil}). -@item env [@var{var}=@var{value}]@dots{} [@var{command}]@dots{} @cmindex env +@item env [@var{var}=@var{value}]@dots{} [@var{command}]@dots{} With no arguments, print the current environment variables. If you pass arguments to this command, then @command{env} will execute the arguments as a command. If you pass any initial arguments of the form @samp{@var{var}=@var{value}}, @command{env} will first set @var{var} to @var{value} before running the command. -@item eshell-debug [error | form | process]@dots{} @cmindex eshell-debug +@item eshell-debug [error | form | process]@dots{} Toggle debugging information for Eshell itself. You can pass this command one or more of the following arguments: @@ -768,30 +768,30 @@ buffer @code{*eshell last cmd*}; or @end itemize -@item exit @cmindex exit +@item exit @vindex eshell-kill-on-exit Exit Eshell and save the history. By default, this command kills the Eshell buffer, but if @code{eshell-kill-on-exit} is @code{nil}, then the buffer is merely buried instead. -@item export [@var{name}=@var{value}]@dots{} @cmindex export +@item export [@var{name}=@var{value}]@dots{} Set environment variables using input like Bash's @command{export}, as in @samp{export @var{var1}=@var{val1} @var{var2}=@var{val2} @dots{}}. -@item grep [@var{arg}]@dots{} @cmindex grep -@itemx agrep [@var{arg}]@dots{} +@item grep [@var{arg}]@dots{} @cmindex agrep -@itemx egrep [@var{arg}]@dots{} +@itemx agrep [@var{arg}]@dots{} @cmindex egrep -@itemx fgrep [@var{arg}]@dots{} +@itemx egrep [@var{arg}]@dots{} @cmindex fgrep -@itemx rgrep [@var{arg}]@dots{} +@itemx fgrep [@var{arg}]@dots{} @cmindex rgrep -@itemx glimpse [@var{arg}]@dots{} +@itemx rgrep [@var{arg}]@dots{} @cmindex glimpse +@itemx glimpse [@var{arg}]@dots{} The @command{grep} commands are compatible with GNU @command{grep}, but open a compilation buffer in @code{grep-mode} instead. @xref{Grep Searching, , , emacs, The GNU Emacs Manual}. @@ -803,9 +803,9 @@ to Eshell's buffer. This is the same as using @samp{alias grep '*grep $@@*'}, though this setting applies to all of the built-in commands for which you would need to create a separate alias. +@cmindex history @item history [@var{n}] @itemx history [-arw] [@var{filename}] -@cmindex history Prints Eshell's input history. With a numeric argument @var{n}, this command prints the @var{n} most recent items in the history. Alternately, you can specify the following options: @@ -824,8 +824,8 @@ Write the current history list to the history file. @end table -@item info [@var{manual} [@var{item}]@dots{}] @cmindex info +@item info [@var{manual} [@var{item}]@dots{}] Browse the available Info documentation. With no arguments, browse the top-level menu. Otherwise, show the manual for @var{manual}, selecting the menu entry for @var{item}. @@ -834,25 +834,25 @@ This command is the same as the external @command{info} command, but uses Emacs's internal Info reader. @xref{Misc Help, , , emacs, The GNU Emacs Manual}. -@item jobs @cmindex jobs +@item jobs List subprocesses of the Emacs process, if any, using the function @code{list-processes}. -@item kill [-@var{signal}] [@var{pid} | @var{process}] @cmindex kill +@item kill [-@var{signal}] [@var{pid} | @var{process}] Kill processes. Takes a PID or a process object and an optional @var{signal} specifier which can either be a number or a signal name. -@item listify [@var{arg}]@dots{} @cmindex listify +@item listify [@var{arg}]@dots{} Return the arguments as a single list. With a single argument, return it as-is if it's already a list, or otherwise wrap it in a list. With multiple arguments, return a list of all of them. +@cmindex ln @item ln [@var{option}]@dots{} @var{target} [@var{link-name}] @itemx ln [@var{option}]@dots{} @var{target}@dots{} @var{directory} -@cmindex ln Create a link to the specified @var{target} named @var{link-name} or create links to multiple @var{targets} in @var{directory}. @@ -886,8 +886,8 @@ Print the name of each file before linking it. @end table -@item locate @var{arg}@dots{} @cmindex locate +@item locate @var{arg}@dots{} Alias to Emacs's @code{locate} function, which simply runs the external @command{locate} command and parses the results. @xref{Dired and Find, , , emacs, The GNU Emacs Manual}. @@ -897,8 +897,8 @@ If @code{eshell-plain-locate-behavior} is non-@code{nil}, then Emacs's internal @code{locate} is not used. This is the same as using @samp{alias locate '*locate $@@*'}. -@item ls [@var{option}]@dots{} [@var{file}]@dots{} @cmindex ls +@item ls [@var{option}]@dots{} [@var{file}]@dots{} List information about each @var{file}, including the contents of any specified directories. If @var{file} is unspecified, list the contents of the current directory. @@ -999,25 +999,25 @@ List one file per line. @end table -@item make [@var{arg}]@dots{} @cmindex make +@item make [@var{arg}]@dots{} Run @command{make} through @code{compile} when run asynchronously (e.g., @samp{make &}). @xref{Compilation, , , emacs, The GNU Emacs Manual}. Otherwise call the external @command{make} command. -@item man [@var{arg}]@dots{} @cmindex man +@item man [@var{arg}]@dots{} Display Man pages using the Emacs @code{man} command. @xref{Man Page, , , emacs, The GNU Emacs Manual}. -@item mkdir [-p] @var{directory}@dots{} @cmindex mkdir +@item mkdir [-p] @var{directory}@dots{} Make new directories. With @code{-p} or @code{--parents}, automatically make any necessary parent directories as well. +@cmindex mv @item mv [@var{option}]@dots{} @var{source} @var{dest} @itemx mv [@var{option}]@dots{} @var{source}@dots{} @var{directory} -@cmindex mv Rename the file @var{source} to @var{dest} or move @var{source} into @var{directory}. @@ -1048,14 +1048,14 @@ Print the name of each item before moving it. @end table -@item occur @var{regexp} [@var{nlines}] @cmindex occur +@item occur @var{regexp} [@var{nlines}] Alias to Emacs's @code{occur}. @xref{Other Repeating Search, , , emacs, The GNU Emacs Manual}. +@cmindex popd @item popd @item popd +@var{n} -@cmindex popd Pop a directory from the directory stack and switch to a another place in the stack. This command can take the following forms: @@ -1071,14 +1071,14 @@ the @var{nth} directory in the stack (counting from zero). @end table -@item printnl [@var{arg}]@dots{} @cmindex printnl +@item printnl [@var{arg}]@dots{} Print all the @var{arg}s separated by newlines. +@cmindex pushd @item pushd @itemx pushd @var{directory} @itemx pushd +@var{n} -@cmindex pushd Push the current directory onto the directory stack, then change to another directory. This command can take the following forms: @@ -1107,12 +1107,12 @@ non-@code{nil}, then @samp{pushd +@var{n}} will instead pop the @end table -@item pwd @cmindex pwd +@item pwd Prints the current working directory. -@item rm [@var{option}]@dots{} @var{item}@dots{} @cmindex rm +@item rm [@var{option}]@dots{} @var{item}@dots{} Removes files, buffers, processes, or Emacs Lisp symbols, depending on the type of each @var{item}. @@ -1146,59 +1146,59 @@ Print the name of each item before removing it. @end table -@item rmdir @var{directory}@dots{} @cmindex rmdir +@item rmdir @var{directory}@dots{} Removes directories if they are empty. -@item set [@var{var} @var{value}]@dots{} @cmindex set +@item set [@var{var} @var{value}]@dots{} Set variable values, using the function @code{set} like a command (@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}). The value of @var{var} can be a symbol, in which case it refers to a Lisp variable, or a string, referring to an environment variable (@pxref{Arguments}). -@item setq [@var{symbol} @var{value}]@dots{} @cmindex setq +@item setq [@var{symbol} @var{value}]@dots{} Set variable values, using the function @code{setq} like a command (@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}). -@item source @var{file} [@var{argument}]@dots{} @cmindex source +@item source @var{file} [@var{argument}]@dots{} Source an Eshell script named @var{file} in a subshell environment, passing any @var{argument}s to the script (@pxref{Scripts}). This is not to be confused with the command @command{.}, which sources a file in the current environment. -@item time @var{command}@dots{} @cmindex time +@item time @var{command}@dots{} Show the time elapsed during the execution of @var{command}. +@cmindex umask @item umask [-S] @itemx umask @var{mode} -@cmindex umask View the default file permissions for newly created files and directories. If you pass @code{-S} or @code{--symbolic}, view the mode symbolically. With @var{mode}, set the default permissions to this value. -@item unset [@var{var}]@dots{} @cmindex unset +@item unset [@var{var}]@dots{} Unset one or more variables. As with @command{set}, the value of @var{var} can be a symbol, in which case it refers to a Lisp variable, or a string, referring to an environment variable. -@item wait [@var{process}]@dots{} @cmindex wait +@item wait [@var{process}]@dots{} Wait until each specified @var{process} has exited. -@item which @var{command}@dots{} @cmindex which +@item which @var{command}@dots{} For each @var{command}, identify what kind of command it is and its location. -@item whoami @cmindex whoami +@item whoami Print the current user. This Eshell version of @command{whoami} is connection-aware, so for remote directories, it will print the user associated with that connection. @@ -2601,17 +2601,17 @@ external commands. To enable it, add @code{eshell-tramp} to @table @code -@item su [- | -l] [@var{user}] @cmindex su +@item su [- | -l] [@var{user}] Uses TRAMP's @command{su} method (@pxref{Inline methods, , , tramp, The Tramp Manual}) to change the current user to @var{user} (or root if unspecified). With @code{-}, @code{-l}, or @code{--login}, provide a login environment. -@item sudo [-u @var{user}] [-s | @var{command}@dots{}] @cmindex sudo -@itemx doas [-u @var{user}] [-s | @var{command}@dots{}] +@item sudo [-u @var{user}] [-s | @var{command}@dots{}] @cmindex doas +@itemx doas [-u @var{user}] [-s | @var{command}@dots{}] Uses TRAMP's @command{sudo} or @command{doas} method (@pxref{Inline methods, , , tramp, The Tramp Manual}) to run @var{command} as root via @command{sudo} or @command{doas}. When specifying @code{-u @@ -2630,59 +2630,59 @@ add @code{eshell-xtra} to @code{eshell-modules-list}. @table @code -@item count @var{item} @var{seq} [@var{option}]@dots{} @cmindex count +@item count @var{item} @var{seq} [@var{option}]@dots{} A wrapper around the function @code{cl-count} (@pxref{Searching Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item expr @var{str} [@var{separator}] [@var{arg}]@dots{} @cmindex expr +@item expr @var{str} [@var{separator}] [@var{arg}]@dots{} An implementation of @command{expr} using the Calc package. @xref{Top,,, calc, The GNU Emacs Calculator}. -@item ff @var{directory} @var{pattern} @cmindex ff +@item ff @var{directory} @var{pattern} Shorthand for the the function @code{find-name-dired} (@pxref{Dired and Find, , , emacs, The Emacs Editor}). -@item gf @var{directory} @var{regexp} @cmindex gf +@item gf @var{directory} @var{regexp} Shorthand for the the function @code{find-grep-dired} (@pxref{Dired and Find, , , emacs, The Emacs Editor}). -@item intersection @var{list1} @var{list2} [@var{option}]@dots{} @cmindex intersection +@item intersection @var{list1} @var{list2} [@var{option}]@dots{} A wrapper around the function @code{cl-intersection} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item mismatch @var{seq1} @var{seq2} [@var{option}]@dots{} @cmindex mismatch +@item mismatch @var{seq1} @var{seq2} [@var{option}]@dots{} A wrapper around the function @code{cl-mismatch} (@pxref{Searching Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item set-difference @var{list1} @var{list2} [@var{option}]@dots{} @cmindex set-difference +@item set-difference @var{list1} @var{list2} [@var{option}]@dots{} A wrapper around the function @code{cl-set-difference} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item set-exclusive-or @var{list1} @var{list2} [@var{option}]@dots{} @cmindex set-exclusive-or +@item set-exclusive-or @var{list1} @var{list2} [@var{option}]@dots{} A wrapper around the function @code{cl-set-exclusive-or} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item substitute @var{new} @var{old} @var{seq} [@var{option}]@dots{} @cmindex substitute +@item substitute @var{new} @var{old} @var{seq} [@var{option}]@dots{} A wrapper around the function @code{cl-substitute} (@pxref{Sequence Functions,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item union @var{list1} @var{list2} [@var{option}]@dots{} @cmindex union +@item union @var{list1} @var{list2} [@var{option}]@dots{} A wrapper around the function @code{cl-union} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -- cgit v1.2.3 From de5acc3b0d854aeb7dbf104c0977efe2f2266e1a Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Thu, 8 Feb 2024 11:44:05 -0800 Subject: Add concept indices for some Eshell commands * doc/misc/eshell.texi (List of Built-ins): Add indices for some directory- and process-related commands. (Aliases): Change to concept index. --- doc/misc/eshell.texi | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 3ff8e55ed03..30c85da795b 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -3,7 +3,7 @@ @setfilename ../../info/eshell.info @settitle Eshell: The Emacs Shell @include docstyle.texi -@defindex cm +@defcodeindex cm @syncodeindex vr fn @c %**end of header @@ -529,6 +529,7 @@ symlink, then this command reverts to the system's definition of @command{cat}. @cmindex cd +@cindex directories, changing @item cd @itemx cd @var{directory} @itemx cd -[@var{n}] @@ -666,6 +667,7 @@ as using @samp{alias diff '*diff $@@*'}. Return the directory component of @var{filename}. @cmindex dirs +@cindex directory stack, listing @item dirs Prints the directory stack. Directories can be added or removed from the stack using the commands @command{pushd} and @command{popd}, @@ -835,11 +837,13 @@ uses Emacs's internal Info reader. @xref{Misc Help, , , emacs, The GNU Emacs Manual}. @cmindex jobs +@cindex processes, listing @item jobs List subprocesses of the Emacs process, if any, using the function @code{list-processes}. @cmindex kill +@cindex processes, signaling @item kill [-@var{signal}] [@var{pid} | @var{process}] Kill processes. Takes a PID or a process object and an optional @var{signal} specifier which can either be a number or a signal name. @@ -1054,6 +1058,7 @@ Alias to Emacs's @code{occur}. @xref{Other Repeating Search, , , emacs, The GNU Emacs Manual}. @cmindex popd +@cindex directory stack, removing from @item popd @item popd +@var{n} Pop a directory from the directory stack and switch to a another place @@ -1076,6 +1081,7 @@ the @var{nth} directory in the stack (counting from zero). Print all the @var{arg}s separated by newlines. @cmindex pushd +@cindex directory stack, adding to @item pushd @itemx pushd @var{directory} @itemx pushd +@var{n} @@ -1189,6 +1195,7 @@ Unset one or more variables. As with @command{set}, the value of or a string, referring to an environment variable. @cmindex wait +@cindex processes, waiting for @item wait [@var{process}]@dots{} Wait until each specified @var{process} has exited. @@ -1501,7 +1508,7 @@ create and switch to a directory called @samp{foo}. @node Remote Access @section Remote Access -@cmindex remote access +@cindex remote access Since Eshell uses Emacs facilities for most of its functionality, you can access remote hosts transparently. To connect to a remote host, -- cgit v1.2.3 From 6568a9a0099e7745bfd142a0fd16b4d7215c0250 Mon Sep 17 00:00:00 2001 From: Mekeor Melire Date: Wed, 7 Feb 2024 23:00:08 +0100 Subject: Add option gnus-mode-line-logo * lisp/gnus/gnus.el (gnus-mode-line-logo): New option specifying whether and which logo will be displayed in the mode-line. * etc/NEWS: Announce the change. --- etc/NEWS | 5 +++++ lisp/gnus/gnus.el | 29 ++++++++++++++++++++--------- 2 files changed, 25 insertions(+), 9 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 4d3c652aebc..76862bf500d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1102,6 +1102,11 @@ The gmane.org website is, sadly, down since a number of years with no prospect of it coming back. Therefore, it is no longer valid to set the user option 'nnweb-type' to 'gmane'. +*** New user option 'gnus-mode-line-logo'. +This allows the user to either disable the display of any logo or +specify which logo will be displayed as part of the +buffer-identification in the mode-line of Gnus-buffers. + ** Rmail --- diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 99833e4eeca..cf4c3f7841c 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -309,12 +309,30 @@ be set in `.emacs' instead." :group 'gnus-start :type 'boolean) +(defcustom gnus-mode-line-logo + '((:type svg :file "gnus-pointer.svg" :ascent center) + (:type xpm :file "gnus-pointer.xpm" :ascent center) + (:type xbm :file "gnus-pointer.xbm" :ascent center)) + "Gnus logo displayed in mode-line. + +If non-nil, it should be a list of image specifications that will be +given as first argument to `find-image', which see. Then, in case of a +graphical display, the specified Gnus logo will be displayed as part of +the buffer-identification in the mode-line of Gnus-buffers. + +If nil, no logo will be displayed." + :group 'gnus-visual + :type '(choice + (repeat :tag "List of image specifications" (plist)) + (const :tag "No logo" nil))) + (defun gnus-mode-line-buffer-identification (line) (let* ((str (car-safe line)) (str (if (stringp str) (car (propertized-buffer-identification str)) str))) - (if (or (not (fboundp 'find-image)) + (if (or (not gnus-mode-line-logo) + (not (fboundp 'find-image)) (not (display-graphic-p)) (not (stringp str)) (not (string-match "^Gnus:" str))) @@ -325,14 +343,7 @@ be set in `.emacs' instead." (add-text-properties 0 5 (list 'display - (find-image - '((:type svg :file "gnus-pointer.svg" - :ascent center) - (:type xpm :file "gnus-pointer.xpm" - :ascent center) - (:type xbm :file "gnus-pointer.xbm" - :ascent center)) - t) + (find-image gnus-mode-line-logo t) 'help-echo (if gnus-emacs-version (format "This is %s, %s." -- cgit v1.2.3 From e7d1b12878ed83ad8c6995d8443f3367750ff0c9 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 10 Feb 2024 15:02:39 +0800 Subject: Make miscellaneous improvements to the Android port * java/org/gnu/emacs/EmacsActivity.java (onCreate): Deal with omitted calls to onWindowFocusChanged after activity recreation. * java/org/gnu/emacs/EmacsService.java (clearWindow, clearArea): Delete redundant wrapper functions. (getUsefulContentResolver, getContentResolverContext): Delete functions. (openContentUri, checkContentUri): Stop searching for an activity content resolver, as that's actually not necessary. * src/android.c (android_init_emacs_service) (android_init_emacs_window, android_clear_window) (android_clear_area): Adjust to match. --- java/org/gnu/emacs/EmacsActivity.java | 4 +++ java/org/gnu/emacs/EmacsService.java | 67 +---------------------------------- src/android.c | 23 ++++++------ 3 files changed, 16 insertions(+), 78 deletions(-) diff --git a/java/org/gnu/emacs/EmacsActivity.java b/java/org/gnu/emacs/EmacsActivity.java index b821694b18a..66a1e41d84c 100644 --- a/java/org/gnu/emacs/EmacsActivity.java +++ b/java/org/gnu/emacs/EmacsActivity.java @@ -247,6 +247,10 @@ public class EmacsActivity extends Activity } super.onCreate (savedInstanceState); + + /* Call `onWindowFocusChanged' to read the focus state, which fails + to be called after an activity is recreated. */ + onWindowFocusChanged (false); } @Override diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index b65b10b9528..d17ba597d8e 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -449,21 +449,6 @@ public final class EmacsService extends Service EmacsDrawPoint.perform (drawable, gc, x, y); } - public void - clearWindow (EmacsWindow window) - { - checkEmacsThread (); - window.clearWindow (); - } - - public void - clearArea (EmacsWindow window, int x, int y, int width, - int height) - { - checkEmacsThread (); - window.clearArea (x, y, width, height); - } - @SuppressWarnings ("deprecation") public void ringBell (int duration) @@ -926,48 +911,6 @@ public final class EmacsService extends Service /* Content provider functions. */ - /* Return a ContentResolver capable of accessing as many files as - possible, namely the content resolver of the last selected - activity if available: only they posses the rights to access drag - and drop files. */ - - public ContentResolver - getUsefulContentResolver () - { - EmacsActivity activity; - - if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N) - /* Since the system predates drag and drop, return this resolver - to avoid any unforeseen difficulties. */ - return resolver; - - activity = EmacsActivity.lastFocusedActivity; - if (activity == null) - return resolver; - - return activity.getContentResolver (); - } - - /* Return a context whose ContentResolver is granted access to most - files, as in `getUsefulContentResolver'. */ - - public Context - getContentResolverContext () - { - EmacsActivity activity; - - if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N) - /* Since the system predates drag and drop, return this resolver - to avoid any unforeseen difficulties. */ - return this; - - activity = EmacsActivity.lastFocusedActivity; - if (activity == null) - return this; - - return activity; - } - /* Open a content URI described by the bytes BYTES, a non-terminated string; make it writable if WRITABLE, and readable if READABLE. Truncate the file if TRUNCATE. @@ -981,9 +924,6 @@ public final class EmacsService extends Service String name, mode; ParcelFileDescriptor fd; int i; - ContentResolver resolver; - - resolver = getUsefulContentResolver (); /* Figure out the file access mode. */ @@ -1045,12 +985,8 @@ public final class EmacsService extends Service ParcelFileDescriptor fd; Uri uri; int rc, flags; - Context context; - ContentResolver resolver; ParcelFileDescriptor descriptor; - context = getContentResolverContext (); - uri = Uri.parse (name); flags = 0; @@ -1060,7 +996,7 @@ public final class EmacsService extends Service if (writable) flags |= Intent.FLAG_GRANT_WRITE_URI_PERMISSION; - rc = context.checkCallingUriPermission (uri, flags); + rc = checkCallingUriPermission (uri, flags); if (rc == PackageManager.PERMISSION_GRANTED) return true; @@ -1074,7 +1010,6 @@ public final class EmacsService extends Service try { - resolver = context.getContentResolver (); descriptor = resolver.openFileDescriptor (uri, "r"); return true; } diff --git a/src/android.c b/src/android.c index 46f4dcd5546..4d56df1da3f 100644 --- a/src/android.c +++ b/src/android.c @@ -113,6 +113,8 @@ struct android_emacs_window jmethodID define_cursor; jmethodID damage_rect; jmethodID recreate_activity; + jmethodID clear_window; + jmethodID clear_area; }; struct android_emacs_cursor @@ -1605,10 +1607,6 @@ android_init_emacs_service (void) FIND_METHOD (draw_point, "drawPoint", "(Lorg/gnu/emacs/EmacsDrawable;" "Lorg/gnu/emacs/EmacsGC;II)V"); - FIND_METHOD (clear_window, "clearWindow", - "(Lorg/gnu/emacs/EmacsWindow;)V"); - FIND_METHOD (clear_area, "clearArea", - "(Lorg/gnu/emacs/EmacsWindow;IIII)V"); FIND_METHOD (ring_bell, "ringBell", "(I)V"); FIND_METHOD (query_tree, "queryTree", "(Lorg/gnu/emacs/EmacsWindow;)[S"); @@ -1832,6 +1830,8 @@ android_init_emacs_window (void) android_damage_window. */ FIND_METHOD (damage_rect, "damageRect", "(IIII)V"); FIND_METHOD (recreate_activity, "recreateActivity", "()V"); + FIND_METHOD (clear_window, "clearWindow", "()V"); + FIND_METHOD (clear_area, "clearArea", "(IIII)V"); #undef FIND_METHOD } @@ -3431,10 +3431,9 @@ android_clear_window (android_window handle) window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW); (*android_java_env)->CallNonvirtualVoidMethod (android_java_env, - emacs_service, - service_class.class, - service_class.clear_window, - window); + window, + window_class.class, + window_class.clear_window); android_exception_check (); } @@ -4745,10 +4744,10 @@ android_clear_area (android_window handle, int x, int y, window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW); (*android_java_env)->CallNonvirtualVoidMethod (android_java_env, - emacs_service, - service_class.class, - service_class.clear_area, - window, (jint) x, (jint) y, + window, + window_class.class, + window_class.clear_area, + (jint) x, (jint) y, (jint) width, (jint) height); } -- cgit v1.2.3 From 6195a57b8e8ebff4eaaf4ff8d62719cbd55f579f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 09:28:11 +0200 Subject: ; Improve documentation of a recent change in Gnus * lisp/image.el (find-image): Doc fix. * lisp/gnus/gnus.el (gnus-mode-line-logo): Fix doc string and :type texts. Add :version. (Bug#68985) --- etc/NEWS | 1 + lisp/gnus/gnus.el | 15 ++++++++------- lisp/image.el | 26 +++++++++++++++----------- 3 files changed, 24 insertions(+), 18 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 76862bf500d..ca0a5ed8fc8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1102,6 +1102,7 @@ The gmane.org website is, sadly, down since a number of years with no prospect of it coming back. Therefore, it is no longer valid to set the user option 'nnweb-type' to 'gmane'. +--- *** New user option 'gnus-mode-line-logo'. This allows the user to either disable the display of any logo or specify which logo will be displayed as part of the diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index cf4c3f7841c..dab66b60205 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -313,18 +313,19 @@ be set in `.emacs' instead." '((:type svg :file "gnus-pointer.svg" :ascent center) (:type xpm :file "gnus-pointer.xpm" :ascent center) (:type xbm :file "gnus-pointer.xbm" :ascent center)) - "Gnus logo displayed in mode-line. + "Image spec for the Gnus logo to be displayed in mode-line. -If non-nil, it should be a list of image specifications that will be -given as first argument to `find-image', which see. Then, in case of a -graphical display, the specified Gnus logo will be displayed as part of +If non-nil, it should be a list of image specifications to be passed +as the first argument to `find-image', which see. Then, if the display +is capable of showing images, the Gnus logo will be displayed as part of the buffer-identification in the mode-line of Gnus-buffers. -If nil, no logo will be displayed." +If nil, there will be no Gnus logo in the mode-line." :group 'gnus-visual :type '(choice - (repeat :tag "List of image specifications" (plist)) - (const :tag "No logo" nil))) + (repeat :tag "List of Gnus logo image specifications" (plist)) + (const :tag "Don't display Gnus logo" nil)) + :version "30.1") (defun gnus-mode-line-buffer-identification (line) (let* ((str (car-safe line)) diff --git a/lisp/image.el b/lisp/image.el index 73801f88d1e..2ebce59a98c 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -759,21 +759,25 @@ BUFFER nil or omitted means use the current buffer." ;;;###autoload (defun find-image (specs &optional cache) - "Find an image, choosing one of a list of image specifications. + "Find an image that satisfies one of a list of image specifications. SPECS is a list of image specifications. -Each image specification in SPECS is a property list. The contents of -a specification are image type dependent. All specifications must at -least contain either the property `:file FILE' or `:data DATA', -where FILE is the file to load the image from, and DATA is a string -containing the actual image data. If the property `:type TYPE' is -omitted or nil, try to determine the image type from its first few +Each image specification in SPECS is a property list. The +contents of a specification are image type dependent; see the +info node `(elisp)Image Descriptors' for details. All specifications +must at least contain either the property `:file FILE' or `:data DATA', +where FILE is the file from which to load the image, and DATA is a +string containing the actual image data. If the property `:type TYPE' +is omitted or nil, try to determine the image type from its first few bytes of image data. If that doesn't work, and the property `:file -FILE' provide a file name, use its file extension as image type. -If `:type TYPE' is provided, it must match the actual type -determined for FILE or DATA by `create-image'. Return nil if no -specification is satisfied. +FILE' provide a file name, use its file extension as idication of the +image type. If `:type TYPE' is provided, it must match the actual type +determined for FILE or DATA by `create-image'. + +The function returns the image specification for the first specification +in the list whose TYPE is supported and FILE, if specified, exists. It +returns nil if no specification in the list can be satisfied. If CACHE is non-nil, results are cached and returned on subsequent calls. -- cgit v1.2.3 From 4330eb2864181e49ace5736665c45d8683a5ce1d Mon Sep 17 00:00:00 2001 From: john muhl Date: Thu, 25 Jan 2024 21:23:45 -0600 Subject: Fix volume refresh bug in mpc * lisp/mpc.el (mpc-volume-refresh): Only refresh volume when mpd is playing. When stopped or paused, volume is nil. (Bug#68785) --- lisp/mpc.el | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/lisp/mpc.el b/lisp/mpc.el index 9577e0f2f42..768c70c2e3a 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -1867,11 +1867,14 @@ A value of t means the main playlist.") (defvar mpc-volume nil) (put 'mpc-volume 'risky-local-variable t) (defun mpc-volume-refresh () - ;; Maintain the volume. - (setq mpc-volume - (mpc-volume-widget - (string-to-number (cdr (assq 'volume mpc-status))))) - (let ((status-buf (mpc-proc-buffer (mpc-proc) 'status))) + "Maintain the volume." + (let ((status-buf (mpc-proc-buffer (mpc-proc) 'status)) + (status-vol (cdr (assq 'volume mpc-status)))) + ;; If MPD is paused or stopped the volume is nil. + (when status-vol + (setq mpc-volume + (mpc-volume-widget + (string-to-number status-vol)))) (when (buffer-live-p status-buf) (with-current-buffer status-buf (force-mode-line-update))))) -- cgit v1.2.3 From 59b849d1eaffb8babb208f6a39c5e0dbc73e3127 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 10:35:18 +0200 Subject: Run 'read-only-mode-hook' when visiting a file that is not writable * lisp/files.el (after-find-file): Run 'read-only-mode-hook' when the visited file is not writable. (Bug#68648) --- lisp/files.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/files.el b/lisp/files.el index 229771810fb..f67b650cb92 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2747,6 +2747,10 @@ Fifth arg NOMODES non-nil means don't alter the file's modes. Finishes by calling the functions in `find-file-hook' unless NOMODES is non-nil." (setq buffer-read-only (not (file-writable-p buffer-file-name))) + ;; The above is sufficiently like turning on read-only-mode, so run + ;; the mode hook here by hand. + (if buffer-read-only + (run-hooks 'read-only-mode-hook)) (if noninteractive nil (let* (not-serious -- cgit v1.2.3 From 55aea7967604112343ff67597cbe9fc20acd9196 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 10 Feb 2024 09:50:12 +0100 Subject: Fix warning in tramp-register-archive-autoload-file-name-handler * lisp/net/tramp-archive.el (tramp-register-archive-autoload-file-name-handler): Do not use read syntax #' for `tramp-archive-file-name-handler', it isn't autoloaded. --- lisp/net/tramp-archive.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 752462d8fa3..59c4223794c 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -387,9 +387,11 @@ arguments to pass to the OPERATION." ;;;###autoload (progn (defun tramp-register-archive-autoload-file-name-handler () "Add archive file name handler to `file-name-handler-alist'." + ;; Do not use read syntax #' for `tramp-archive-file-name-handler', it + ;; isn't autoloaded. (when (and tramp-archive-enabled (not - (rassq #'tramp-archive-file-name-handler file-name-handler-alist))) + (rassq 'tramp-archive-file-name-handler file-name-handler-alist))) (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) #'tramp-archive-autoload-file-name-handler)) -- cgit v1.2.3 From 20f7a022f817eaed5f6889d9a892c22fc46f0d2f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 11:04:22 +0200 Subject: Avoid errors in winner.el's 'post-command-hook' * lisp/winner.el (winner-save-old-configurations): Don't save configuration of dead frames. (Bug#68977) --- lisp/winner.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/winner.el b/lisp/winner.el index 2aa59a86b25..19641a05bfc 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -178,7 +178,8 @@ You may want to include buffer names such as *Help*, *Apropos*, (setq winner-last-frames nil) (setq winner-last-command this-command)) (dolist (frame winner-modified-list) - (winner-insert-if-new frame)) + (if (frame-live-p frame) + (winner-insert-if-new frame))) (setq winner-modified-list nil) (winner-remember))) -- cgit v1.2.3 From 86c5b7c49c0b61413e41f8a95a2f0c7f09cd1db7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 11:10:08 +0200 Subject: * lisp/bind-key.el (personal-keybindings): Autoload it (bug#68999). --- lisp/bind-key.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/bind-key.el b/lisp/bind-key.el index 94a39f795cd..378ad69b2bc 100644 --- a/lisp/bind-key.el +++ b/lisp/bind-key.el @@ -155,6 +155,7 @@ add keys to that keymap." (add-to-list 'emulation-mode-map-alists `((override-global-mode . ,override-global-map))) +;;;###autoload (defvar personal-keybindings nil "List of bindings performed by `bind-key'. -- cgit v1.2.3 From 13ee21eb48bedc1779985c3f60010aadbbd99630 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 11:20:22 +0200 Subject: Support Info files compressed by 'lzip' * lisp/info.el (Info-suffix-list): Support lzip compression of Info files. (Bug#69004) --- lisp/info.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/info.el b/lisp/info.el index e91cc7b8e54..d4d9085a787 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -499,6 +499,7 @@ or `Info-virtual-nodes'." (".info.bz2" . ("bzip2" "-dc")) (".info.xz" . "unxz") (".info.zst" . ("zstd" "-dc")) + (".info.lz" . ("lzip" "-dc")) (".info" . nil) ("-info.Z" . "uncompress") ("-info.Y" . "unyabba") @@ -507,6 +508,7 @@ or `Info-virtual-nodes'." ("-info.z" . "gunzip") ("-info.xz" . "unxz") ("-info.zst" . ("zstd" "-dc")) + ("-info.lz" . ("lzip" "-dc")) ("-info" . nil) ("/index.Z" . "uncompress") ("/index.Y" . "unyabba") @@ -515,6 +517,7 @@ or `Info-virtual-nodes'." ("/index.bz2" . ("bzip2" "-dc")) ("/index.xz" . "unxz") ("/index.zst" . ("zstd" "-dc")) + ("/index.lz" . ("lzip" "-dc")) ("/index" . nil) (".Z" . "uncompress") (".Y" . "unyabba") @@ -523,6 +526,7 @@ or `Info-virtual-nodes'." (".bz2" . ("bzip2" "-dc")) (".xz" . "unxz") (".zst" . ("zstd" "-dc")) + (".lz" . ("lzip" "-dc")) ("" . nil))) "List of file name suffixes and associated decoding commands. Each entry should be (SUFFIX . STRING); the file is given to -- cgit v1.2.3 From 7f3baf352bad03de50135556a561af0c7fb1bd6a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 11:22:01 +0200 Subject: ; * etc/NEWS: Announce support of 'lzip' compressed Info files (bug#69004). --- etc/NEWS | 3 +++ 1 file changed, 3 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index ca0a5ed8fc8..5ee1509859b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -450,6 +450,9 @@ This user option associates manual names with URLs. It affects the Emacs-included manuals are set. Further associations can be added for arbitrary Info manuals. +*** Emacs can now display Info manuals compressed with 'lzip'. +This requires the 'lzip' program to be installed on your system. + +++ ** New command 'lldb'. Run the LLDB debugger, analogous to the 'gud-gdb' command. -- cgit v1.2.3 From 717d8c4285fa6eecc0bbec9b5910f028f02aab59 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 13:00:51 +0200 Subject: Don't quote 't' in doc strings * lisp/outline.el (outline-minor-mode-use-buttons): Doc fix. Patch by Arash Esbati . (Bug#69012) --- lisp/outline.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/outline.el b/lisp/outline.el index 96e0d0df205..724263ef3d2 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -318,8 +318,8 @@ Using the value `insert' is not recommended in editable buffers because it modifies them. When the value is `in-margins', then clickable buttons are displayed in the margins before the headings. -When the value is `t', clickable buttons are displayed -in the buffer before the headings. The values `t' and +When the value is t, clickable buttons are displayed +in the buffer before the headings. The values t and `in-margins' can be used in editing buffers because they don't modify the buffer." ;; The value `insert' is not intended to be customizable. -- cgit v1.2.3 From 7e8b1863af8c820c2969c1a4666ae4451cbcea92 Mon Sep 17 00:00:00 2001 From: Damien Cassou Date: Wed, 7 Feb 2024 20:41:44 +0100 Subject: Add support for deriving major modes in which-func * lisp/progmodes/which-func.el (which-func-try-to-enable) (which-func-ff-hook): Use `derived-mode-p' to check if the current major mode is within `which-func-modes' or `which-func-non-auto-modes'. (Bug#68981) --- lisp/progmodes/which-func.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index bd68672f905..631cb3b0aef 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -211,7 +211,7 @@ non-nil.") (when which-function-mode (unless (local-variable-p 'which-func-mode) (setq which-func-mode (or (eq which-func-modes t) - (member major-mode which-func-modes))) + (apply #'derived-mode-p which-func-modes))) (setq which-func--use-mode-line (member which-func-display '(mode mode-and-header))) (setq which-func--use-header-line @@ -239,7 +239,7 @@ It creates the Imenu index for the buffer, if necessary." (condition-case err (if (and which-func-mode - (not (member major-mode which-func-non-auto-modes)) + (not (apply #'derived-mode-p which-func-non-auto-modes)) (or (null which-func-maxout) (< buffer-saved-size which-func-maxout) (= which-func-maxout 0))) -- cgit v1.2.3 From 55b4a743b6f3d452d98f135763b00965caba5240 Mon Sep 17 00:00:00 2001 From: Steven Allen Date: Sat, 27 Jan 2024 08:17:08 -0800 Subject: Record dependencies in packages installed via package-vc * lisp/emacs-lisp/package-vc.el (package-vc--unpack-1): Record a package's declared dependencies in the package's metadata file. (Bug#68761) --- lisp/emacs-lisp/package-vc.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index db0cc515e46..fc402716dab 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -532,6 +532,7 @@ documentation and marking the package as installed." (setq deps)))))) (dolist (dep deps) (cl-callf version-to-list (cadr dep))) + (setf (package-desc-reqs pkg-desc) deps) (setf missing (package-vc-install-dependencies (delete-dups deps))) (setf missing (delq (assq (package-desc-name pkg-desc) missing) -- cgit v1.2.3 From 939187fd7a07249a1a76d98e8d91051fa76b8727 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 10 Feb 2024 17:30:27 +0100 Subject: ; Fix 'thing-at-point' edge case involving overlapping matches * lisp/thingatpt.el (thing-at-point-looking-at): When finding a match that ends before point, continue searching from the beginning of that match, not its end, in case the match we're looking is overlapping with this one. * test/lisp/thingatpt-tests.el (thing-at-point-looking-at-overlapping-matches): New test. --- lisp/thingatpt.el | 3 ++- test/lisp/thingatpt-tests.el | 7 +++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index b532bafff82..83ddc640d35 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -621,13 +621,14 @@ Optional argument DISTANCE limits search for REGEXP forward and back from point." (let* ((old (point)) (beg (if distance (max (point-min) (- old distance)) (point-min))) - (end (and distance (min (point-max) (+ old distance)))) + (end (if distance (min (point-max) (+ old distance)))) prev match) (save-excursion (goto-char beg) (while (and (setq prev (point) match (re-search-forward regexp end t)) (< (match-end 0) old)) + (goto-char (match-beginning 0)) ;; Avoid inflooping when `regexp' matches the empty string. (unless (< prev (point)) (forward-char)))) (and match (<= (match-beginning 0) old (match-end 0))))) diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index 56bc4fdc9dc..e50738f1122 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -182,6 +182,13 @@ position to retrieve THING.") (should (thing-at-point-looking-at "2abcd")) (should (equal (match-data) m2))))) +(ert-deftest thing-at-point-looking-at-overlapping-matches () + (with-temp-buffer + (insert "foo.bar.baz") + (goto-char (point-max)) + (should (thing-at-point-looking-at "[a-z]+\\.[a-z]+")) + (should (string= "bar.baz" (match-string 0))))) + (ert-deftest test-symbol-thing-1 () (with-temp-buffer (insert "foo bar zot") -- cgit v1.2.3 From 0a01b998d13027e5672592f9e60919aa683bad9e Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 10 Feb 2024 19:34:23 +0200 Subject: * lisp/menu-bar.el (menu-bar-showhide-menu): Add "Outlines" (bug#68979). The menu item "Outlines" toggles 'outline-minor-mode' when one of outline-search-function/outline-regexp/outline-level is defined in the current buffer. --- lisp/menu-bar.el | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 47c6a8f0613..5b290899ff5 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1353,6 +1353,15 @@ mail status in mode line")) (frame-visible-p (symbol-value 'speedbar-frame)))))) + (bindings--define-key menu [showhide-outline-minor-mode] + '(menu-item "Outlines" outline-minor-mode + :help "Turn outline-minor-mode on/off" + :visible (seq-some #'local-variable-p + '(outline-search-function + outline-regexp outline-level)) + :button (:toggle . (and (boundp 'outline-minor-mode) + outline-minor-mode)))) + (bindings--define-key menu [showhide-tab-line-mode] '(menu-item "Window Tab Line" global-tab-line-mode :help "Turn window-local tab-lines on/off" -- cgit v1.2.3 From 3e5aba883770312536ca7a8f289bf679e55802f5 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 10 Feb 2024 19:56:39 +0200 Subject: * lisp/buff-menu.el: Force other-window commands to use other window. (Buffer-menu-other-window, Buffer-menu-switch-other-window): Let-bind 'display-buffer-overriding-action' to '(nil (inhibit-same-window . t))' that will force the buffer to be displayed in another window in any case (bug#68978). --- lisp/buff-menu.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 10ea99eae9a..e13c3b56b4e 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -592,13 +592,17 @@ If UNMARK is non-nil, unmark them." (defun Buffer-menu-other-window () "Select this line's buffer in other window, leaving buffer menu visible." (interactive nil Buffer-menu-mode) - (switch-to-buffer-other-window (Buffer-menu-buffer t))) + (let ((display-buffer-overriding-action + '(nil (inhibit-same-window . t)))) + (switch-to-buffer-other-window (Buffer-menu-buffer t)))) (defun Buffer-menu-switch-other-window () "Make the other window select this line's buffer. The current window remains selected." (interactive nil Buffer-menu-mode) - (display-buffer (Buffer-menu-buffer t) t)) + (let ((display-buffer-overriding-action + '(nil (inhibit-same-window . t)))) + (display-buffer (Buffer-menu-buffer t) t))) (defun Buffer-menu-2-window () "Select this line's buffer, with previous buffer in second window." -- cgit v1.2.3 From 7a0ee5d65f214102734dd22edb641b164a1b73af Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sat, 10 Feb 2024 10:33:51 -0800 Subject: Fix behavior of gnus-summary-very-wide-reply with prefix arg * lisp/gnus/gnus-msg.el (gnus-summary-very-wide-reply): If a prefix argument has been given, the value of YANK will be a list containing the current article number. This should not be used to retrieve a number of work articles; that should be derived from the value of the current-prefix-arg (or marked articles). * doc/misc/gnus.texi: The interplay of prefix arg and marked articles is complex; attempt to clarify. --- doc/misc/gnus.texi | 9 +++++---- lisp/gnus/gnus-msg.el | 4 ++-- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 08554d0d9b9..2f8f97e5845 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -5832,10 +5832,11 @@ message to the mailing list, and include the original message @kindex S v @r{(Summary)} @findex gnus-summary-very-wide-reply Mail a very wide reply to the author of the current article -(@code{gnus-summary-very-wide-reply}). A @dfn{very wide reply} is a reply -that goes out to all people listed in the @code{To}, @code{From} (or -@code{Reply-To}) and @code{Cc} headers in all the process/prefixed -articles. This command uses the process/prefix convention. +(@code{gnus-summary-very-wide-reply}). A @dfn{very wide reply} is a +reply that goes out to all people listed in the @code{To}, @code{From} +(or @code{Reply-To}) and @code{Cc} headers in all the process/prefixed +articles. This command uses the process/prefix convention. If given a +prefix argument, the body of the current article will also be yanked. @item S V @kindex S V @r{(Summary)} diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index fdf97e1aabd..b18ede58fbf 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1189,12 +1189,12 @@ Uses the process/prefix convention. The reply will include all From/Cc headers from the original messages as the To/Cc headers. -If prefix argument YANK is non-nil, the original article(s) will +If prefix argument YANK is non-nil, the original article will be yanked automatically." (interactive (list (and current-prefix-arg (gnus-summary-work-articles 1))) gnus-summary-mode) - (gnus-summary-reply yank t (gnus-summary-work-articles yank))) + (gnus-summary-reply yank t (gnus-summary-work-articles current-prefix-arg))) (defun gnus-summary-very-wide-reply-with-original (n) "Start composing a very wide reply mail a set of messages. -- cgit v1.2.3 From e67e7185ce81e59c90741f92c2ba3209412f417e Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 11 Feb 2024 10:00:33 +0800 Subject: Fix signed/unsigned promotion errors involving Emacs_Rectangle * src/androidterm.c (android_note_mouse_movement): * src/pgtkterm.c (note_mouse_movement): * src/xdisp.c (get_glyph_string_clip_rects, remember_mouse_glyph) (expose_area, expose_window, gui_intersect_rectangles): Cast width or height fields in Emacs_Rectangles to int before summing with or subtracting them from their coordinate fields, as they are unsigned outside X, and the sign of the coordinates is thus not preserved. --- src/androidterm.c | 4 ++-- src/pgtkterm.c | 4 ++-- src/xdisp.c | 33 +++++++++++++++++---------------- 3 files changed, 21 insertions(+), 20 deletions(-) diff --git a/src/androidterm.c b/src/androidterm.c index d4612bb20fa..2bd2b45743d 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -495,8 +495,8 @@ android_note_mouse_movement (struct frame *frame, /* Has the mouse moved off the glyph it was on at the last sighting? */ r = &dpyinfo->last_mouse_glyph; if (frame != dpyinfo->last_mouse_glyph_frame - || event->x < r->x || event->x >= r->x + r->width - || event->y < r->y || event->y >= r->y + r->height) + || event->x < r->x || event->x >= r->x + (int) r->width + || event->y < r->y || event->y >= r->y + (int) r->height) { frame->mouse_moved = true; note_mouse_highlight (frame, event->x, event->y); diff --git a/src/pgtkterm.c b/src/pgtkterm.c index b731f52983d..1ec6bfcda4e 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -5825,8 +5825,8 @@ note_mouse_movement (struct frame *frame, /* Has the mouse moved off the glyph it was on at the last sighting? */ r = &dpyinfo->last_mouse_glyph; if (frame != dpyinfo->last_mouse_glyph_frame - || event->x < r->x || event->x >= r->x + r->width - || event->y < r->y || event->y >= r->y + r->height) + || event->x < r->x || event->x >= r->x + (int) r->width + || event->y < r->y || event->y >= r->y + (int) r->height) { frame->mouse_moved = true; dpyinfo->last_mouse_scroll_bar = NULL; diff --git a/src/xdisp.c b/src/xdisp.c index 2dcf0d58a14..0b8347214c7 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -2508,7 +2508,7 @@ get_glyph_string_clip_rects (struct glyph_string *s, NativeRectangle *rects, int r.x = s->clip_head->x; } if (s->clip_tail) - if (r.x + r.width > s->clip_tail->x + s->clip_tail->background_width) + if (r.x + (int) r.width > s->clip_tail->x + s->clip_tail->background_width) { if (s->clip_tail->x + s->clip_tail->background_width >= r.x) r.width = s->clip_tail->x + s->clip_tail->background_width - r.x; @@ -2588,7 +2588,7 @@ get_glyph_string_clip_rects (struct glyph_string *s, NativeRectangle *rects, int height = max (FRAME_LINE_HEIGHT (s->f), glyph->ascent + glyph->descent); if (height < r.height) { - max_y = r.y + r.height; + max_y = r.y + (int) r.height; r.y = min (max_y, max (r.y, s->ybase + glyph->descent - height)); r.height = min (max_y - r.y, height); } @@ -2629,7 +2629,7 @@ get_glyph_string_clip_rects (struct glyph_string *s, NativeRectangle *rects, int if (s->for_overlaps & OVERLAPS_PRED) { rs[i] = r; - if (r.y + r.height > row_y) + if (r.y + (int) r.height > row_y) { if (r.y < row_y) rs[i].height = row_y - r.y; @@ -2643,10 +2643,10 @@ get_glyph_string_clip_rects (struct glyph_string *s, NativeRectangle *rects, int rs[i] = r; if (r.y < row_y + s->row->visible_height) { - if (r.y + r.height > row_y + s->row->visible_height) + if (r.y + (int) r.height > row_y + s->row->visible_height) { rs[i].y = row_y + s->row->visible_height; - rs[i].height = r.y + r.height - rs[i].y; + rs[i].height = r.y + (int) r.height - rs[i].y; } else rs[i].height = 0; @@ -2831,7 +2831,7 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect) text_glyph: gr = 0; gy = 0; for (; r <= end_row && r->enabled_p; ++r) - if (r->y + r->height > y) + if (r->y + (int) r->height > y) { gr = r; gy = r->y; break; @@ -2931,7 +2931,7 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect) row_glyph: gr = 0, gy = 0; for (; r <= end_row && r->enabled_p; ++r) - if (r->y + r->height > y) + if (r->y + (int) r->height > y) { gr = r; gy = r->y; break; @@ -36464,7 +36464,7 @@ expose_area (struct window *w, struct glyph_row *row, const Emacs_Rectangle *r, /* Use a signed int intermediate value to avoid catastrophic failures due to comparison between signed and unsigned, when x is negative (can happen for wide images that are hscrolled). */ - int r_end = r->x + r->width; + int r_end = r->x + (int) r->width; while (last < end && x < r_end) { x += last->pixel_width; @@ -36763,7 +36763,7 @@ expose_window (struct window *w, const Emacs_Rectangle *fr) /* Use a signed int intermediate value to avoid catastrophic failures due to comparison between signed and unsigned, when y0 or y1 is negative (can happen for tall images). */ - int r_bottom = r.y + r.height; + int r_bottom = r.y + (int) r.height; /* We must temporarily switch to the window's buffer, in case the fringe face has been remapped in that buffer's @@ -36810,7 +36810,7 @@ expose_window (struct window *w, const Emacs_Rectangle *fr) /* We must redraw a row overlapping the exposed area. */ if (y0 < r.y ? y0 + row->phys_height > r.y - : y0 + row->ascent - row->phys_ascent < r.y +r.height) + : y0 + row->ascent - row->phys_ascent < r.y + (int) r.height) { if (first_overlapping_row == NULL) first_overlapping_row = row; @@ -36989,7 +36989,7 @@ gui_intersect_rectangles (const Emacs_Rectangle *r1, const Emacs_Rectangle *r2, const Emacs_Rectangle *upper, *lower; bool intersection_p = false; - /* Rearrange so that R1 is the left-most rectangle. */ + /* Rearrange so that left is the left-most rectangle. */ if (r1->x < r2->x) left = r1, right = r2; else @@ -36997,13 +36997,14 @@ gui_intersect_rectangles (const Emacs_Rectangle *r1, const Emacs_Rectangle *r2, /* X0 of the intersection is right.x0, if this is inside R1, otherwise there is no intersection. */ - if (right->x <= left->x + left->width) + if (right->x <= left->x + (int) left->width) { result->x = right->x; /* The right end of the intersection is the minimum of the right ends of left and right. */ - result->width = (min (left->x + left->width, right->x + right->width) + result->width = (min (left->x + (int) left->width, + right->x + (int) right->width) - result->x); /* Same game for Y. */ @@ -37014,14 +37015,14 @@ gui_intersect_rectangles (const Emacs_Rectangle *r1, const Emacs_Rectangle *r2, /* The upper end of the intersection is lower.y0, if this is inside of upper. Otherwise, there is no intersection. */ - if (lower->y <= upper->y + upper->height) + if (lower->y <= upper->y + (int) upper->height) { result->y = lower->y; /* The lower end of the intersection is the minimum of the lower ends of upper and lower. */ - result->height = (min (lower->y + lower->height, - upper->y + upper->height) + result->height = (min (lower->y + (int) lower->height, + upper->y + (int) upper->height) - result->y); intersection_p = true; } -- cgit v1.2.3 From 9f9da26e0dcb242327af7cd8414fad7afedbbaa9 Mon Sep 17 00:00:00 2001 From: Loïc Lemaître Date: Sun, 11 Feb 2024 05:00:38 +0200 Subject: Handle typescript ts grammar breaking change for function_expression Starting from version 0.20.4 of the typescript/tsx grammar, "function" becomes "function_expression". The right expression is used depending on the grammar version. * lisp/progmodes/typescript-ts-mode.el (tsx-ts-mode--font-lock-compatibility-function-expression): New function (bug#69024). (typescript-ts-mode--font-lock-settings): Use it. Copyright-paperwork-exempt: yes --- lisp/progmodes/typescript-ts-mode.el | 362 ++++++++++++++++++----------------- 1 file changed, 188 insertions(+), 174 deletions(-) diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 89ca47571eb..7021f012dcd 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -199,183 +199,197 @@ Argument LANGUAGE is either `typescript' or `tsx'." [(nested_identifier (identifier)) (identifier)] @typescript-ts-jsx-tag-face))))) +(defun tsx-ts-mode--font-lock-compatibility-function-expression (language) + "Handle tree-sitter grammar breaking change for `function' expression. + +LANGUAGE can be `typescript' or `tsx'. Starting from version 0.20.4 of the +typescript/tsx grammar, `function' becomes `function_expression'." + (condition-case nil + (progn (treesit-query-capture language '((function_expression) @cap)) + ;; New version of the grammar + 'function_expression) + (treesit-query-error + ;; Old version of the grammar + 'function))) + (defun typescript-ts-mode--font-lock-settings (language) "Tree-sitter font-lock settings. Argument LANGUAGE is either `typescript' or `tsx'." - (treesit-font-lock-rules - :language language - :feature 'comment - `([(comment) (hash_bang_line)] @font-lock-comment-face) - - :language language - :feature 'constant - `(((identifier) @font-lock-constant-face - (:match "\\`[A-Z_][0-9A-Z_]*\\'" @font-lock-constant-face)) - [(true) (false) (null)] @font-lock-constant-face) - - :language language - :feature 'keyword - `([,@typescript-ts-mode--keywords] @font-lock-keyword-face - [(this) (super)] @font-lock-keyword-face) - - :language language - :feature 'string - `((regex pattern: (regex_pattern)) @font-lock-regexp-face - (string) @font-lock-string-face - (template_string) @js--fontify-template-string - (template_substitution ["${" "}"] @font-lock-misc-punctuation-face)) - - :language language - :override t ;; for functions assigned to variables - :feature 'declaration - `((function - name: (identifier) @font-lock-function-name-face) - (function_declaration - name: (identifier) @font-lock-function-name-face) - (function_signature - name: (identifier) @font-lock-function-name-face) - - (method_definition - name: (property_identifier) @font-lock-function-name-face) - (method_signature - name: (property_identifier) @font-lock-function-name-face) - (required_parameter (identifier) @font-lock-variable-name-face) - (optional_parameter (identifier) @font-lock-variable-name-face) - - (variable_declarator - name: (identifier) @font-lock-function-name-face - value: [(function) (arrow_function)]) - - (variable_declarator - name: (identifier) @font-lock-variable-name-face) - - (enum_declaration (identifier) @font-lock-type-face) - - (extends_clause value: (identifier) @font-lock-type-face) - ;; extends React.Component - (extends_clause value: (member_expression - object: (identifier) @font-lock-type-face - property: (property_identifier) @font-lock-type-face)) - - (arrow_function - parameter: (identifier) @font-lock-variable-name-face) - - (variable_declarator - name: (array_pattern - (identifier) - (identifier) @font-lock-function-name-face) - value: (array (number) (function))) - - (catch_clause - parameter: (identifier) @font-lock-variable-name-face) - - ;; full module imports - (import_clause (identifier) @font-lock-variable-name-face) - ;; named imports with aliasing - (import_clause (named_imports (import_specifier - alias: (identifier) @font-lock-variable-name-face))) - ;; named imports without aliasing - (import_clause (named_imports (import_specifier - !alias - name: (identifier) @font-lock-variable-name-face))) - - ;; full namespace import (* as alias) - (import_clause (namespace_import (identifier) @font-lock-variable-name-face))) - - :language language - :feature 'identifier - `((nested_type_identifier - module: (identifier) @font-lock-type-face) - - (type_identifier) @font-lock-type-face - - (predefined_type) @font-lock-type-face - - (new_expression - constructor: (identifier) @font-lock-type-face) - - (enum_body (property_identifier) @font-lock-type-face) - - (enum_assignment name: (property_identifier) @font-lock-type-face) - - (variable_declarator - name: (identifier) @font-lock-variable-name-face) - - (for_in_statement - left: (identifier) @font-lock-variable-name-face) - - (arrow_function - parameters: - [(_ (identifier) @font-lock-variable-name-face) - (_ (_ (identifier) @font-lock-variable-name-face)) - (_ (_ (_ (identifier) @font-lock-variable-name-face)))])) - - :language language - :feature 'property - `((property_signature - name: (property_identifier) @font-lock-property-name-face) - (public_field_definition - name: (property_identifier) @font-lock-property-name-face) - - (pair key: (property_identifier) @font-lock-property-use-face) - - ((shorthand_property_identifier) @font-lock-property-use-face)) - - :language language - :feature 'expression - '((assignment_expression - left: [(identifier) @font-lock-function-name-face - (member_expression - property: (property_identifier) @font-lock-function-name-face)] - right: [(function) (arrow_function)])) - - :language language - :feature 'function - '((call_expression - function: - [(identifier) @font-lock-function-call-face - (member_expression - property: (property_identifier) @font-lock-function-call-face)])) - - :language language - :feature 'pattern - `((pair_pattern - key: (property_identifier) @font-lock-property-use-face - value: [(identifier) @font-lock-variable-name-face - (assignment_pattern left: (identifier) @font-lock-variable-name-face)]) - - (array_pattern (identifier) @font-lock-variable-name-face) - - ((shorthand_property_identifier_pattern) @font-lock-variable-name-face)) - - :language language - :feature 'jsx - (append (tsx-ts-mode--font-lock-compatibility-bb1f97b language) - `((jsx_attribute (property_identifier) @typescript-ts-jsx-attribute-face))) - - :language language - :feature 'number - `((number) @font-lock-number-face - ((identifier) @font-lock-number-face - (:match "\\`\\(?:NaN\\|Infinity\\)\\'" @font-lock-number-face))) - - :language language - :feature 'operator - `([,@typescript-ts-mode--operators] @font-lock-operator-face - (ternary_expression ["?" ":"] @font-lock-operator-face)) - - :language language - :feature 'bracket - '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) - - :language language - :feature 'delimiter - '((["," "." ";" ":"]) @font-lock-delimiter-face) - - :language language - :feature 'escape-sequence - :override t - '((escape_sequence) @font-lock-escape-face))) + (let ((func-exp (tsx-ts-mode--font-lock-compatibility-function-expression language))) + (treesit-font-lock-rules + :language language + :feature 'comment + `([(comment) (hash_bang_line)] @font-lock-comment-face) + + :language language + :feature 'constant + `(((identifier) @font-lock-constant-face + (:match "\\`[A-Z_][0-9A-Z_]*\\'" @font-lock-constant-face)) + [(true) (false) (null)] @font-lock-constant-face) + + :language language + :feature 'keyword + `([,@typescript-ts-mode--keywords] @font-lock-keyword-face + [(this) (super)] @font-lock-keyword-face) + + :language language + :feature 'string + `((regex pattern: (regex_pattern)) @font-lock-regexp-face + (string) @font-lock-string-face + (template_string) @js--fontify-template-string + (template_substitution ["${" "}"] @font-lock-misc-punctuation-face)) + + :language language + :override t ;; for functions assigned to variables + :feature 'declaration + `((,func-exp + name: (identifier) @font-lock-function-name-face) + (function_declaration + name: (identifier) @font-lock-function-name-face) + (function_signature + name: (identifier) @font-lock-function-name-face) + + (method_definition + name: (property_identifier) @font-lock-function-name-face) + (method_signature + name: (property_identifier) @font-lock-function-name-face) + (required_parameter (identifier) @font-lock-variable-name-face) + (optional_parameter (identifier) @font-lock-variable-name-face) + + (variable_declarator + name: (identifier) @font-lock-function-name-face + value: [(,func-exp) (arrow_function)]) + + (variable_declarator + name: (identifier) @font-lock-variable-name-face) + + (enum_declaration (identifier) @font-lock-type-face) + + (extends_clause value: (identifier) @font-lock-type-face) + ;; extends React.Component + (extends_clause value: (member_expression + object: (identifier) @font-lock-type-face + property: (property_identifier) @font-lock-type-face)) + + (arrow_function + parameter: (identifier) @font-lock-variable-name-face) + + (variable_declarator + name: (array_pattern + (identifier) + (identifier) @font-lock-function-name-face) + value: (array (number) (,func-exp))) + + (catch_clause + parameter: (identifier) @font-lock-variable-name-face) + + ;; full module imports + (import_clause (identifier) @font-lock-variable-name-face) + ;; named imports with aliasing + (import_clause (named_imports (import_specifier + alias: (identifier) @font-lock-variable-name-face))) + ;; named imports without aliasing + (import_clause (named_imports (import_specifier + !alias + name: (identifier) @font-lock-variable-name-face))) + + ;; full namespace import (* as alias) + (import_clause (namespace_import (identifier) @font-lock-variable-name-face))) + + :language language + :feature 'identifier + `((nested_type_identifier + module: (identifier) @font-lock-type-face) + + (type_identifier) @font-lock-type-face + + (predefined_type) @font-lock-type-face + + (new_expression + constructor: (identifier) @font-lock-type-face) + + (enum_body (property_identifier) @font-lock-type-face) + + (enum_assignment name: (property_identifier) @font-lock-type-face) + + (variable_declarator + name: (identifier) @font-lock-variable-name-face) + + (for_in_statement + left: (identifier) @font-lock-variable-name-face) + + (arrow_function + parameters: + [(_ (identifier) @font-lock-variable-name-face) + (_ (_ (identifier) @font-lock-variable-name-face)) + (_ (_ (_ (identifier) @font-lock-variable-name-face)))])) + + :language language + :feature 'property + `((property_signature + name: (property_identifier) @font-lock-property-name-face) + (public_field_definition + name: (property_identifier) @font-lock-property-name-face) + + (pair key: (property_identifier) @font-lock-property-use-face) + + ((shorthand_property_identifier) @font-lock-property-use-face)) + + :language language + :feature 'expression + `((assignment_expression + left: [(identifier) @font-lock-function-name-face + (member_expression + property: (property_identifier) @font-lock-function-name-face)] + right: [(,func-exp) (arrow_function)])) + + :language language + :feature 'function + '((call_expression + function: + [(identifier) @font-lock-function-call-face + (member_expression + property: (property_identifier) @font-lock-function-call-face)])) + + :language language + :feature 'pattern + `((pair_pattern + key: (property_identifier) @font-lock-property-use-face + value: [(identifier) @font-lock-variable-name-face + (assignment_pattern left: (identifier) @font-lock-variable-name-face)]) + + (array_pattern (identifier) @font-lock-variable-name-face) + + ((shorthand_property_identifier_pattern) @font-lock-variable-name-face)) + + :language language + :feature 'jsx + (append (tsx-ts-mode--font-lock-compatibility-bb1f97b language) + `((jsx_attribute (property_identifier) @typescript-ts-jsx-attribute-face))) + + :language language + :feature 'number + `((number) @font-lock-number-face + ((identifier) @font-lock-number-face + (:match "\\`\\(?:NaN\\|Infinity\\)\\'" @font-lock-number-face))) + + :language language + :feature 'operator + `([,@typescript-ts-mode--operators] @font-lock-operator-face + (ternary_expression ["?" ":"] @font-lock-operator-face)) + + :language language + :feature 'bracket + '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) + + :language language + :feature 'delimiter + '((["," "." ";" ":"]) @font-lock-delimiter-face) + + :language language + :feature 'escape-sequence + :override t + '((escape_sequence) @font-lock-escape-face)))) ;;;###autoload (define-derived-mode typescript-ts-base-mode prog-mode "TypeScript" -- cgit v1.2.3 From 30b4d902326546ca2b383d56caadbe0adaf0fe89 Mon Sep 17 00:00:00 2001 From: Mekeor Melire Date: Fri, 9 Feb 2024 23:30:52 +0100 Subject: In Info-url-alist, add .html extension to %e format-sequence * lisp/info.el (Info-url-for-node): Implement the change. (Bug#68970) (Info-url-alist): Document the change. * test/lisp/info-tests.el (test-info-urls): Adjust tests to account for the change and add a test for the "Top" node. --- lisp/info.el | 31 +++++++++++++++++-------------- test/lisp/info-tests.el | 16 +++++++++------- 2 files changed, 26 insertions(+), 21 deletions(-) diff --git a/lisp/info.el b/lisp/info.el index d4d9085a787..176bc9c0033 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -231,8 +231,9 @@ Each element of this list has the form (MANUALs . URL-SPEC). MANUALs represents the name of one or more manuals. It can either be a string or a list of strings. URL-SPEC can be a string in which the substring \"%m\" will be expanded to the -manual-name, \"%n\" to the node-name, and \"%e\" to the -URL-encoded node-name (without a `.html' suffix). (The +manual-name and \"%n\" to the node-name. \"%e\" will expand to +the URL-encoded node-name, including the `.html' extension; in +case of the Top node, it will expand to the empty string. (The URL-encoding of the node-name mimics GNU Texinfo, as documented at Info node `(texinfo)HTML Xref Node Name Expansion'.) Alternatively, URL-SPEC can be a function which is given @@ -1928,18 +1929,20 @@ NODE should be a string of the form \"(manual)Node\"." ;; (info "(texinfo) HTML Xref Node Name Expansion") (if (equal node "Top") "" - (url-hexify-string - (string-replace " " "-" - (mapconcat - (lambda (ch) - (if (or (< ch 32) ; ^@^A-^Z^[^\^]^^^- - (<= 33 ch 47) ; !"#$%&'()*+,-./ - (<= 58 ch 64) ; :;<=>?@ - (<= 91 ch 96) ; [\]_` - (<= 123 ch 127)) ; {|}~ DEL - (format "_00%x" ch) - (char-to-string ch))) - node "")))))) + (concat + (url-hexify-string + (string-replace " " "-" + (mapconcat + (lambda (ch) + (if (or (< ch 32) ; ^@^A-^Z^[^\^]^^^- + (<= 33 ch 47) ; !"#$%&'()*+,-./ + (<= 58 ch 64) ; :;<=>?@ + (<= 91 ch 96) ; [\]_` + (<= 123 ch 127)) ; {|}~ DEL + (format "_00%x" ch) + (char-to-string ch))) + node ""))) + ".html")))) (cond ((stringp url-spec) (format-spec url-spec diff --git a/test/lisp/info-tests.el b/test/lisp/info-tests.el index 0dfdbf417e8..8020a7419cf 100644 --- a/test/lisp/info-tests.el +++ b/test/lisp/info-tests.el @@ -28,18 +28,20 @@ (require 'ert-x) (ert-deftest test-info-urls () + (should (equal (Info-url-for-node "(tramp)Top") + "https://www.gnu.org/software/emacs/manual/html_node/tramp/")) (should (equal (Info-url-for-node "(emacs)Minibuffer") - "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer")) + "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer.html")) (should (equal (Info-url-for-node "(emacs)Minibuffer File") - "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer-File")) + "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer-File.html")) (should (equal (Info-url-for-node "(elisp)Backups and Auto-Saving") - "https://www.gnu.org/software/emacs/manual/html_node/elisp/Backups-and-Auto_002dSaving")) + "https://www.gnu.org/software/emacs/manual/html_node/elisp/Backups-and-Auto_002dSaving.html")) (should (equal (Info-url-for-node "(eintr)car & cdr") - "https://www.gnu.org/software/emacs/manual/html_node/eintr/car-_0026-cdr")) + "https://www.gnu.org/software/emacs/manual/html_node/eintr/car-_0026-cdr.html")) (should (equal (Info-url-for-node "(emacs-mime)\tIndex") - "https://www.gnu.org/software/emacs/manual/html_node/emacs-mime/Index")) - (should (equal (Info-url-for-node "(gnus) Don't Panic") - "https://www.gnu.org/software/emacs/manual/html_node/gnus/Don_0027t-Panic")) + "https://www.gnu.org/software/emacs/manual/html_node/emacs-mime/Index.html")) + (should (equal (Info-url-for-node "(gnus) Don't Panic") + "https://www.gnu.org/software/emacs/manual/html_node/gnus/Don_0027t-Panic.html")) (should-error (Info-url-for-node "(nonexistent)Example"))) ;;; info-tests.el ends here -- cgit v1.2.3 From 614b244a7fa03fcb27d76757e14ef0fa895d6f23 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 11 Feb 2024 10:43:57 +0100 Subject: * Improve reproducibility of inferred values by native comp * lisp/emacs-lisp/comp-cstr.el (comp-normalize-valset): Do not try to reorder conses using 'sxhash-equal' as its behavior is not reproducible over different sessions. --- lisp/emacs-lisp/comp-cstr.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 812a79f070d..ecbe6e38a1d 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -203,6 +203,8 @@ Return them as multiple value." t) ((and (not (symbolp x)) (symbolp y)) nil) + ((or (consp x) (consp y) + nil)) (t (< (sxhash-equal x) (sxhash-equal y))))))) -- cgit v1.2.3 From 67486ab4158655dd8bfe0ddf7dabadc6dd21a3c1 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 11 Feb 2024 15:21:14 +0200 Subject: Fix 'min-width' display property in 'buffer-text-pixel-size' * src/xdisp.c (display_min_width): Don't return without doing anything when called from the move_it_* functions. This is needed to have functions that simulate display layout handle the min-width display property correctly. (Bug#68374) --- src/xdisp.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 0b8347214c7..6087a25afcc 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -5612,9 +5612,6 @@ display_min_width (struct it *it, ptrdiff_t bufpos, if (!NILP (it->min_width_property) && !EQ (width_spec, it->min_width_property)) { - if (!it->glyph_row) - return; - /* When called from display_string (i.e., the mode line), we're being called with a string as the object, and we may be called with many sub-strings belonging to the same -- cgit v1.2.3 From faa46eb8667c11a0725500a50e957eb78021c99f Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 11 Feb 2024 12:31:13 +0100 Subject: Rename a number of native compiler functions * lisp/emacs-lisp/comp.el (comp-passes): Update. (comp-mvar): Update constructor name. (comp--loop-insn-in-block, comp--lex-byte-func-p) (comp--spill-decl-spec, comp--spill-speed) (comp--decrypt-arg-list, comp--byte-frame-size) (comp--add-func-to-ctxt, comp--spill-lap-function) (comp--intern-func-in-ctxt, comp--spill-lap-function) (comp--spill-lap, comp--lap-eob-p, comp--lap-fall-through-p) (comp--sp, comp--with-sp, comp--slot-n, comp--slot, comp-slot+1) (comp--label-to-addr, comp--mark-curr-bb-closed) (comp--bb-maybe-add, comp--call, comp--callref, make-comp-mvar) (comp--new-frame, comp--emit, comp--emit-set-call) (comp--copy-slot, comp--emit-annotation, comp--emit-setimm) (comp--make-curr-block, comp--latch-make-fill) (comp--emit-uncond-jump, comp--emit-cond-jump) (comp--emit-handler, comp--limplify-listn, comp--new-block-sym) (comp--fill-label-h, comp--jump-table-optimizable) (comp--emit-switch, comp--emit-set-call-subr, comp--op-to-fun) (comp--body-eff, comp--op-case, comp--limplify-lap-inst) (comp--emit-narg-prologue, comp--limplify-finalize-function) (comp--prepare-args-for-top-level, comp--emit-for-top-level) (comp--emit-lambda-for-top-level, comp--limplify-top-level) (comp--addr-to-bb-name, comp--limplify-block) (comp--limplify-function, comp--limplify, comp--mvar-used-p) (comp--collect-mvars, comp--collect-rhs) (comp--negate-arithm-cmp-fun, comp--reverse-arithm-fun) (comp--emit-assume, comp--maybe-add-vmvar) (comp--add-new-block-between, comp--cond-cstrs-target-mvar) (comp--add-cond-cstrs-target-block, comp--add-cond-cstrs-simple) (comp--add-cond-cstrs, comp--insert-insn, comp--emit-call-cstr) (comp--lambda-list-gen, comp--add-call-cstr, comp--add-cstrs) (comp--collect-calls, comp--pure-infer-func, comp--ipa-pure) (make--comp--ssa-mvar, comp--clean-ssa, comp--compute-edges) (comp--collect-rev-post-order, comp--compute-dominator-tree) (comp--compute-dominator-frontiers, comp--log-block-info) (comp--place-phis, comp--dom-tree-walker, comp--ssa) (comp--ssa-rename-insn, comp--ssa-rename, comp--finalize-phis) (comp--remove-unreachable-blocks, comp--ssa) (comp--fwprop-max-insns-scan, comp--copy-insn) (comp--apply-in-env, comp--fwprop-prologue) (comp--function-foldable-p, comp--function-call-maybe-fold) (comp--fwprop-call, comp--fwprop-insn, comp--fwprop*) (comp--rewrite-non-locals, comp--fwprop, comp--func-in-unit) (comp--call-optim-form-call, comp--call-optim-func) (comp--call-optim, comp--collect-mvar-ids) (comp--dead-assignments-func, comp--dead-code) (comp--form-tco-call-seq, comp--tco-func, comp--tco) (comp--remove-type-hints-func, comp--remove-type-hints) (comp--args-to-lambda-list, comp--compute-function-type) (comp--finalize-container, comp--finalize-relocs) (comp--compile-ctxt-to-file, comp--final1, comp--final) (comp--make-lambda-list-from-subr, comp-trampoline-compile) (comp--write-bytecode-file): Rename and/or update due to renaming. * test/src/comp-resources/comp-test-funcs.el (comp-test-copy-insn-f): Update. * src/comp.c (Fcomp__compile_ctxt_to_file0): Rename. (syms_of_comp): Update. --- lisp/emacs-lisp/comp.el | 974 +++++++++++++++-------------- src/comp.c | 6 +- test/src/comp-resources/comp-test-funcs.el | 4 +- 3 files changed, 493 insertions(+), 491 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index dcdc973e6c5..6879e6aeeb9 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -43,7 +43,7 @@ (defvar native-comp-eln-load-path) (defvar native-comp-enable-subr-trampolines) -(declare-function comp--compile-ctxt-to-file "comp.c") +(declare-function comp--compile-ctxt-to-file0 "comp.c") (declare-function comp--init-ctxt "comp.c") (declare-function comp--release-ctxt "comp.c") (declare-function comp-el-to-eln-filename "comp.c") @@ -155,17 +155,17 @@ native compilation runs.") "Current allocation class. Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.") -(defconst comp-passes '(comp-spill-lap - comp-limplify - comp-fwprop - comp-call-optim - comp-ipa-pure - comp-add-cstrs - comp-fwprop - comp-tco - comp-fwprop - comp-remove-type-hints - comp-final) +(defconst comp-passes '(comp--spill-lap + comp--limplify + comp--fwprop + comp--call-optim + comp--ipa-pure + comp--add-cstrs + comp--fwprop + comp--tco + comp--fwprop + comp--remove-type-hints + comp--final) "Passes to be executed in order.") (defvar comp-disabled-passes '() @@ -388,7 +388,7 @@ This is typically for top-level forms other than defun.") (closed nil :type boolean :documentation "t if closed.") ;; All the following are for SSA and CGF analysis. - ;; Keep in sync with `comp-clean-ssa'!! + ;; Keep in sync with `comp--clean-ssa'!! (in-edges () :type list :documentation "List of incoming edges.") (out-edges () :type list @@ -416,7 +416,7 @@ into it.") :documentation "Start block LAP address.") (non-ret-insn nil :type list :documentation "Insn known to perform a non local exit. -`comp-fwprop' may identify and store here basic blocks performing +`comp--fwprop' may identify and store here basic blocks performing non local exits and mark it rewrite it later.") (no-ret nil :type boolean :documentation "t when the block is known to perform a @@ -507,7 +507,7 @@ CFG is mutated by a pass.") (lambda-list nil :type list :documentation "Original lambda-list.")) -(cl-defstruct (comp-mvar (:constructor make--comp-mvar) +(cl-defstruct (comp-mvar (:constructor make--comp-mvar0) (:include comp-cstr)) "A meta-variable being a slot in the meta-stack." (id nil :type (or null number) @@ -516,6 +516,7 @@ CFG is mutated by a pass.") :documentation "Slot number in the array if a number or `scratch' for scratch slot.")) +;; In use by comp.c. (defun comp-mvar-type-hint-match-p (mvar type-hint) "Match MVAR against TYPE-HINT. In use by the back-end." @@ -636,7 +637,7 @@ VERBOSITY is a number between 0 and 3." -(defmacro comp-loop-insn-in-block (basic-block &rest body) +(defmacro comp--loop-insn-in-block (basic-block &rest body) "Loop over all insns in BASIC-BLOCK executing BODY. Inside BODY, `insn' and `insn-cell'can be used to read or set the current instruction or its cell." @@ -650,19 +651,19 @@ current instruction or its cell." ;;; spill-lap pass specific code. -(defun comp-lex-byte-func-p (f) +(defun comp--lex-byte-func-p (f) "Return t if F is a lexically-scoped byte compiled function." (and (byte-code-function-p f) (fixnump (aref f 0)))) -(defun comp-spill-decl-spec (function-name spec) +(defun comp--spill-decl-spec (function-name spec) "Return the declared specifier SPEC for FUNCTION-NAME." (plist-get (cdr (assq function-name byte-to-native-plist-environment)) spec)) -(defun comp-spill-speed (function-name) +(defun comp--spill-speed (function-name) "Return the speed for FUNCTION-NAME." - (or (comp-spill-decl-spec function-name 'speed) + (or (comp--spill-decl-spec function-name 'speed) (comp-ctxt-speed comp-ctxt))) ;; Autoloaded as might be used by `disassemble-internal'. @@ -701,7 +702,7 @@ clashes." ;; pick the first one. (concat prefix crypted "_" human-readable "_0")))) -(defun comp-decrypt-arg-list (x function-name) +(defun comp--decrypt-arg-list (x function-name) "Decrypt argument list X for FUNCTION-NAME." (unless (fixnump x) (signal 'native-compiler-error-dyn-func (list function-name))) @@ -716,21 +717,21 @@ clashes." :nonrest nonrest :rest rest)))) -(defsubst comp-byte-frame-size (byte-compiled-func) +(defsubst comp--byte-frame-size (byte-compiled-func) "Return the frame size to be allocated for BYTE-COMPILED-FUNC." (aref byte-compiled-func 3)) -(defun comp-add-func-to-ctxt (func) +(defun comp--add-func-to-ctxt (func) "Add FUNC to the current compiler context." (let ((name (comp-func-name func)) (c-name (comp-func-c-name func))) (puthash name c-name (comp-ctxt-sym-to-c-name-h comp-ctxt)) (puthash c-name func (comp-ctxt-funcs-h comp-ctxt)))) -(cl-defgeneric comp-spill-lap-function (input) +(cl-defgeneric comp--spill-lap-function (input) "Byte-compile INPUT and spill lap for further stages.") -(cl-defmethod comp-spill-lap-function ((function-name symbol)) +(cl-defmethod comp--spill-lap-function ((function-name symbol)) "Byte-compile FUNCTION-NAME, spilling data from the byte compiler." (unless (comp-ctxt-output comp-ctxt) (setf (comp-ctxt-output comp-ctxt) @@ -746,9 +747,9 @@ clashes." (list (make-byte-to-native-func-def :name function-name :c-name c-name :byte-func byte-code))) - (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h))) + (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h))) -(cl-defmethod comp-spill-lap-function ((form list)) +(cl-defmethod comp--spill-lap-function ((form list)) "Byte-compile FORM, spilling data from the byte compiler." (unless (memq (car-safe form) '(lambda closure)) (signal 'native-compiler-error @@ -762,9 +763,9 @@ clashes." (list (make-byte-to-native-func-def :name '--anonymous-lambda :c-name c-name :byte-func byte-code))) - (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h))) + (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h))) -(defun comp-intern-func-in-ctxt (_ obj) +(defun comp--intern-func-in-ctxt (_ obj) "Given OBJ of type `byte-to-native-lambda', create a function in `comp-ctxt'." (when-let ((byte-func (byte-to-native-lambda-byte-func obj))) (let* ((lap (byte-to-native-lambda-lap obj)) @@ -777,9 +778,9 @@ clashes." (name (when top-l-form (byte-to-native-func-def-name top-l-form))) (c-name (comp-c-func-name (or name "anonymous-lambda") "F")) - (func (if (comp-lex-byte-func-p byte-func) + (func (if (comp--lex-byte-func-p byte-func) (make-comp-func-l - :args (comp-decrypt-arg-list (aref byte-func 0) + :args (comp--decrypt-arg-list (aref byte-func 0) name)) (make-comp-func-d :lambda-list (aref byte-func 0))))) (setf (comp-func-name func) name @@ -789,9 +790,9 @@ clashes." (comp-func-command-modes func) (command-modes byte-func) (comp-func-c-name func) c-name (comp-func-lap func) lap - (comp-func-frame-size func) (comp-byte-frame-size byte-func) - (comp-func-speed func) (comp-spill-speed name) - (comp-func-pure func) (comp-spill-decl-spec name 'pure)) + (comp-func-frame-size func) (comp--byte-frame-size byte-func) + (comp-func-speed func) (comp--spill-speed name) + (comp-func-pure func) (comp--spill-decl-spec name 'pure)) ;; Store the c-name to have it retrievable from ;; `comp-ctxt-top-level-forms'. @@ -799,11 +800,11 @@ clashes." (setf (byte-to-native-func-def-c-name top-l-form) c-name)) (unless name (puthash byte-func func (comp-ctxt-byte-func-to-func-h comp-ctxt))) - (comp-add-func-to-ctxt func) + (comp--add-func-to-ctxt func) (comp-log (format "Function %s:\n" name) 1) (comp-log lap 1 t)))) -(cl-defmethod comp-spill-lap-function ((filename string)) +(cl-defmethod comp--spill-lap-function ((filename string)) "Byte-compile FILENAME, spilling data from the byte compiler." (byte-compile-file filename) (when (or (null byte-native-qualities) @@ -828,7 +829,7 @@ clashes." collect (if (and (byte-to-native-func-def-p form) (eq -1 - (comp-spill-speed (byte-to-native-func-def-name form)))) + (comp--spill-speed (byte-to-native-func-def-name form)))) (let ((byte-code (byte-to-native-func-def-byte-func form))) (remhash byte-code byte-to-native-lambdas-h) (make-byte-to-native-top-level @@ -836,11 +837,11 @@ clashes." ',(byte-to-native-func-def-name form) ,byte-code nil) - :lexical (comp-lex-byte-func-p byte-code))) + :lexical (comp--lex-byte-func-p byte-code))) form))) - (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h)) + (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h)) -(defun comp-spill-lap (input) +(defun comp--spill-lap (input) "Byte-compile and spill the LAP representation for INPUT. If INPUT is a symbol, it is the function-name to be compiled. If INPUT is a string, it is the filename to be compiled." @@ -848,7 +849,7 @@ If INPUT is a string, it is the filename to be compiled." (byte-to-native-lambdas-h (make-hash-table :test #'eq)) (byte-to-native-top-level-forms ()) (byte-to-native-plist-environment ()) - (res (comp-spill-lap-function input))) + (res (comp--spill-lap-function input))) (comp-cstr-ctxt-update-type-slots comp-ctxt) res)) @@ -877,55 +878,55 @@ Points to the next slot to be filled.") byte-switch byte-pushconditioncase) "LAP end of basic blocks op codes.") -(defun comp-lap-eob-p (inst) +(defun comp--lap-eob-p (inst) "Return t if INST closes the current basic blocks, nil otherwise." (when (memq (car inst) comp-lap-eob-ops) t)) -(defun comp-lap-fall-through-p (inst) +(defun comp--lap-fall-through-p (inst) "Return t if INST falls through, nil otherwise." (when (not (memq (car inst) '(byte-goto byte-return))) t)) -(defsubst comp-sp () +(defsubst comp--sp () "Current stack pointer." (declare (gv-setter (lambda (val) `(setf (comp-limplify-sp comp-pass) ,val)))) (comp-limplify-sp comp-pass)) -(defmacro comp-with-sp (sp &rest body) +(defmacro comp--with-sp (sp &rest body) "Execute BODY setting the stack pointer to SP. Restore the original value afterwards." (declare (debug (form body)) (indent defun)) (let ((sym (gensym))) - `(let ((,sym (comp-sp))) - (setf (comp-sp) ,sp) + `(let ((,sym (comp--sp))) + (setf (comp--sp) ,sp) (progn ,@body) - (setf (comp-sp) ,sym)))) + (setf (comp--sp) ,sym)))) -(defsubst comp-slot-n (n) +(defsubst comp--slot-n (n) "Slot N into the meta-stack." (comp-vec-aref (comp-limplify-frame comp-pass) n)) -(defsubst comp-slot () +(defsubst comp--slot () "Current slot into the meta-stack pointed by sp." - (comp-slot-n (comp-sp))) + (comp--slot-n (comp--sp))) -(defsubst comp-slot+1 () +(defsubst comp--slot+1 () "Slot into the meta-stack pointed by sp + 1." - (comp-slot-n (1+ (comp-sp)))) + (comp--slot-n (1+ (comp--sp)))) -(defsubst comp-label-to-addr (label) +(defsubst comp--label-to-addr (label) "Find the address of LABEL." (or (gethash label (comp-limplify-label-to-addr comp-pass)) (signal 'native-ice (list "label not found" label)))) -(defsubst comp-mark-curr-bb-closed () +(defsubst comp--mark-curr-bb-closed () "Mark the current basic block as closed." (setf (comp-block-closed (comp-limplify-curr-block comp-pass)) t)) -(defun comp-bb-maybe-add (lap-addr &optional sp) +(defun comp--bb-maybe-add (lap-addr &optional sp) "If necessary create a pending basic block for LAP-ADDR with stack depth SP. The basic block is returned regardless it was already declared or not." (let ((bb (or (cl-loop ; See if the block was already limplified. @@ -943,24 +944,24 @@ The basic block is returned regardless it was already declared or not." (signal 'native-ice (list "incoherent stack pointers" sp (comp-block-lap-sp bb)))) bb) - (car (push (make--comp-block-lap lap-addr sp (comp-new-block-sym)) + (car (push (make--comp-block-lap lap-addr sp (comp--new-block-sym)) (comp-limplify-pending-blocks comp-pass)))))) -(defsubst comp-call (func &rest args) +(defsubst comp--call (func &rest args) "Emit a call for function FUNC with ARGS." `(call ,func ,@args)) -(defun comp-callref (func nargs stack-off) +(defun comp--callref (func nargs stack-off) "Emit a call using narg abi for FUNC. NARGS is the number of arguments. STACK-OFF is the index of the first slot frame involved." `(callref ,func ,@(cl-loop repeat nargs for sp from stack-off - collect (comp-slot-n sp)))) + collect (comp--slot-n sp)))) -(cl-defun make-comp-mvar (&key slot (constant nil const-vld) type neg) +(cl-defun make--comp-mvar (&key slot (constant nil const-vld) type neg) "`comp-mvar' initializer." - (let ((mvar (make--comp-mvar :slot slot))) + (let ((mvar (make--comp-mvar0 :slot slot))) (when const-vld (comp--add-const-to-relocs constant) (setf (comp-cstr-imm mvar) constant)) @@ -970,49 +971,49 @@ STACK-OFF is the index of the first slot frame involved." (setf (comp-mvar-neg mvar) t)) mvar)) -(defun comp-new-frame (size vsize &optional ssa) +(defun comp--new-frame (size vsize &optional ssa) "Return a clean frame of meta variables of size SIZE and VSIZE. If SSA is non-nil, populate it with m-var in ssa form." (cl-loop with v = (make-comp-vec :beg (- vsize) :end size) for i from (- vsize) below size for mvar = (if ssa - (make-comp-ssa-mvar :slot i) - (make-comp-mvar :slot i)) + (make--comp--ssa-mvar :slot i) + (make--comp-mvar :slot i)) do (setf (comp-vec-aref v i) mvar) finally return v)) -(defun comp-emit (insn) +(defun comp--emit (insn) "Emit INSN into basic block BB." (let ((bb (comp-limplify-curr-block comp-pass))) (cl-assert (not (comp-block-closed bb))) (push insn (comp-block-insns bb)))) -(defun comp-emit-set-call (call) +(defun comp--emit-set-call (call) "Emit CALL assigning the result to the current slot frame. If the callee function is known to have a return type, propagate it." (cl-assert call) - (comp-emit (list 'set (comp-slot) call))) + (comp--emit (list 'set (comp--slot) call))) -(defun comp-copy-slot (src-n &optional dst-n) +(defun comp--copy-slot (src-n &optional dst-n) "Set slot number DST-N to slot number SRC-N as source. If DST-N is specified, use it; otherwise assume it to be the current slot." - (comp-with-sp (or dst-n (comp-sp)) - (let ((src-slot (comp-slot-n src-n))) + (comp--with-sp (or dst-n (comp--sp)) + (let ((src-slot (comp--slot-n src-n))) (cl-assert src-slot) - (comp-emit `(set ,(comp-slot) ,src-slot))))) + (comp--emit `(set ,(comp--slot) ,src-slot))))) -(defsubst comp-emit-annotation (str) +(defsubst comp--emit-annotation (str) "Emit annotation STR." - (comp-emit `(comment ,str))) + (comp--emit `(comment ,str))) -(defsubst comp-emit-setimm (val) +(defsubst comp--emit-setimm (val) "Set constant VAL to current slot." (comp--add-const-to-relocs val) ;; Leave relocation index nil on purpose, will be fixed-up in final ;; by `comp-finalize-relocs'. - (comp-emit `(setimm ,(comp-slot) ,val))) + (comp--emit `(setimm ,(comp--slot) ,val))) -(defun comp-make-curr-block (block-name entry-sp &optional addr) +(defun comp--make-curr-block (block-name entry-sp &optional addr) "Create a basic block with BLOCK-NAME and set it as current block. ENTRY-SP is the sp value when entering. Add block to the current function and return it." @@ -1024,104 +1025,104 @@ Add block to the current function and return it." (puthash (comp-block-name bb) bb (comp-func-blocks comp-func)) bb)) -(defun comp-latch-make-fill (target) +(defun comp--latch-make-fill (target) "Create a latch pointing to TARGET and fill it. Return the created latch." - (let ((latch (make-comp-latch :name (comp-new-block-sym "latch"))) + (let ((latch (make-comp-latch :name (comp--new-block-sym "latch"))) (curr-bb (comp-limplify-curr-block comp-pass))) - ;; See `comp-make-curr-block'. + ;; See `comp--make-curr-block'. (setf (comp-limplify-curr-block comp-pass) latch) (when (< (comp-func-speed comp-func) 3) ;; At speed 3 the programmer is responsible to manually ;; place `comp-maybe-gc-or-quit'. - (comp-emit '(call comp-maybe-gc-or-quit))) - ;; See `comp-emit-uncond-jump'. - (comp-emit `(jump ,(comp-block-name target))) - (comp-mark-curr-bb-closed) + (comp--emit '(call comp-maybe-gc-or-quit))) + ;; See `comp--emit-uncond-jump'. + (comp--emit `(jump ,(comp-block-name target))) + (comp--mark-curr-bb-closed) (puthash (comp-block-name latch) latch (comp-func-blocks comp-func)) (setf (comp-limplify-curr-block comp-pass) curr-bb) latch)) -(defun comp-emit-uncond-jump (lap-label) +(defun comp--emit-uncond-jump (lap-label) "Emit an unconditional branch to LAP-LABEL." (cl-destructuring-bind (label-num . stack-depth) lap-label (when stack-depth - (cl-assert (= (1- stack-depth) (comp-sp)))) - (let* ((target-addr (comp-label-to-addr label-num)) - (target (comp-bb-maybe-add target-addr - (comp-sp))) + (cl-assert (= (1- stack-depth) (comp--sp)))) + (let* ((target-addr (comp--label-to-addr label-num)) + (target (comp--bb-maybe-add target-addr + (comp--sp))) (latch (when (< target-addr (comp-limplify-pc comp-pass)) - (comp-latch-make-fill target))) + (comp--latch-make-fill target))) (eff-target-name (comp-block-name (or latch target)))) - (comp-emit `(jump ,eff-target-name)) - (comp-mark-curr-bb-closed)))) + (comp--emit `(jump ,eff-target-name)) + (comp--mark-curr-bb-closed)))) -(defun comp-emit-cond-jump (a b target-offset lap-label negated) +(defun comp--emit-cond-jump (a b target-offset lap-label negated) "Emit a conditional jump to LAP-LABEL when A and B satisfy EQ. TARGET-OFFSET is the positive offset on the SP when branching to the target block. If NEGATED is non null, negate the tested condition. Return value is the fall-through block name." (cl-destructuring-bind (label-num . label-sp) lap-label - (let* ((bb (comp-block-name (comp-bb-maybe-add + (let* ((bb (comp-block-name (comp--bb-maybe-add (1+ (comp-limplify-pc comp-pass)) - (comp-sp)))) ; Fall through block. - (target-sp (+ target-offset (comp-sp))) - (target-addr (comp-label-to-addr label-num)) - (target (comp-bb-maybe-add target-addr target-sp)) + (comp--sp)))) ; Fall through block. + (target-sp (+ target-offset (comp--sp))) + (target-addr (comp--label-to-addr label-num)) + (target (comp--bb-maybe-add target-addr target-sp)) (latch (when (< target-addr (comp-limplify-pc comp-pass)) - (comp-latch-make-fill target))) + (comp--latch-make-fill target))) (eff-target-name (comp-block-name (or latch target)))) (when label-sp - (cl-assert (= (1- label-sp) (+ target-offset (comp-sp))))) - (comp-emit (if negated + (cl-assert (= (1- label-sp) (+ target-offset (comp--sp))))) + (comp--emit (if negated (list 'cond-jump a b bb eff-target-name) (list 'cond-jump a b eff-target-name bb))) - (comp-mark-curr-bb-closed) + (comp--mark-curr-bb-closed) bb))) -(defun comp-emit-handler (lap-label handler-type) +(defun comp--emit-handler (lap-label handler-type) "Emit a nonlocal-exit handler to LAP-LABEL of type HANDLER-TYPE." (cl-destructuring-bind (label-num . label-sp) lap-label - (cl-assert (= (- label-sp 2) (comp-sp))) + (cl-assert (= (- label-sp 2) (comp--sp))) (setf (comp-func-has-non-local comp-func) t) - (let* ((guarded-bb (comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass)) - (comp-sp))) - (handler-bb (comp-bb-maybe-add (comp-label-to-addr label-num) - (1+ (comp-sp)))) - (pop-bb (make--comp-block-lap nil (comp-sp) (comp-new-block-sym)))) - (comp-emit (list 'push-handler + (let* ((guarded-bb (comp--bb-maybe-add (1+ (comp-limplify-pc comp-pass)) + (comp--sp))) + (handler-bb (comp--bb-maybe-add (comp--label-to-addr label-num) + (1+ (comp--sp)))) + (pop-bb (make--comp-block-lap nil (comp--sp) (comp--new-block-sym)))) + (comp--emit (list 'push-handler handler-type - (comp-slot+1) + (comp--slot+1) (comp-block-name pop-bb) (comp-block-name guarded-bb))) - (comp-mark-curr-bb-closed) + (comp--mark-curr-bb-closed) ;; Emit the basic block to pop the handler if we got the non local. (puthash (comp-block-name pop-bb) pop-bb (comp-func-blocks comp-func)) (setf (comp-limplify-curr-block comp-pass) pop-bb) - (comp-emit `(fetch-handler ,(comp-slot+1))) - (comp-emit `(jump ,(comp-block-name handler-bb))) - (comp-mark-curr-bb-closed)))) + (comp--emit `(fetch-handler ,(comp--slot+1))) + (comp--emit `(jump ,(comp-block-name handler-bb))) + (comp--mark-curr-bb-closed)))) -(defun comp-limplify-listn (n) +(defun comp--limplify-listn (n) "Limplify list N." - (comp-with-sp (+ (comp-sp) n -1) - (comp-emit-set-call (comp-call 'cons - (comp-slot) - (make-comp-mvar :constant nil)))) - (cl-loop for sp from (+ (comp-sp) n -2) downto (comp-sp) - do (comp-with-sp sp - (comp-emit-set-call (comp-call 'cons - (comp-slot) - (comp-slot+1)))))) - -(defun comp-new-block-sym (&optional postfix) + (comp--with-sp (+ (comp--sp) n -1) + (comp--emit-set-call (comp--call 'cons + (comp--slot) + (make--comp-mvar :constant nil)))) + (cl-loop for sp from (+ (comp--sp) n -2) downto (comp--sp) + do (comp--with-sp sp + (comp--emit-set-call (comp--call 'cons + (comp--slot) + (comp--slot+1)))))) + +(defun comp--new-block-sym (&optional postfix) "Return a unique symbol postfixing POSTFIX naming the next new basic block." (intern (format (if postfix "bb_%s_%s" "bb_%s") (funcall (comp-func-block-cnt-gen comp-func)) postfix))) -(defun comp-fill-label-h () +(defun comp--fill-label-h () "Fill label-to-addr hash table for the current function." (setf (comp-limplify-label-to-addr comp-pass) (make-hash-table :test 'eql)) (cl-loop for insn in (comp-func-lap comp-func) @@ -1130,7 +1131,7 @@ Return value is the fall-through block name." (`(TAG ,label . ,_) (puthash label addr (comp-limplify-label-to-addr comp-pass)))))) -(defun comp-jump-table-optimizable (jmp-table) +(defun comp--jump-table-optimizable (jmp-table) "Return t if JMP-TABLE can be optimized out." ;; Identify LAP sequences like: ;; (byte-constant #s(hash-table test eq purecopy t data (created 126 deleted 126 changed 126)) . 24) @@ -1142,13 +1143,13 @@ Return value is the fall-through block name." (`(TAG ,target . ,_label-sp) (= target (car targets))))))) -(defun comp-emit-switch (var last-insn) +(defun comp--emit-switch (var last-insn) "Emit a Limple for a lap jump table given VAR and LAST-INSN." ;; FIXME this not efficient for big jump tables. We should have a second ;; strategy for this case. (pcase last-insn (`(setimm ,_ ,jmp-table) - (unless (comp-jump-table-optimizable jmp-table) + (unless (comp--jump-table-optimizable jmp-table) (cl-loop for test being each hash-keys of jmp-table using (hash-value target-label) @@ -1156,27 +1157,27 @@ Return value is the fall-through block name." with test-func = (hash-table-test jmp-table) for n from 1 for last = (= n len) - for m-test = (make-comp-mvar :constant test) - for target-name = (comp-block-name (comp-bb-maybe-add - (comp-label-to-addr target-label) - (comp-sp))) + for m-test = (make--comp-mvar :constant test) + for target-name = (comp-block-name (comp--bb-maybe-add + (comp--label-to-addr target-label) + (comp--sp))) for ff-bb = (if last - (comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass)) - (comp-sp)) + (comp--bb-maybe-add (1+ (comp-limplify-pc comp-pass)) + (comp--sp)) (make--comp-block-lap nil - (comp-sp) - (comp-new-block-sym))) + (comp--sp) + (comp--new-block-sym))) for ff-bb-name = (comp-block-name ff-bb) if (eq test-func 'eq) - do (comp-emit (list 'cond-jump var m-test target-name ff-bb-name)) + do (comp--emit (list 'cond-jump var m-test target-name ff-bb-name)) else ;; Store the result of the comparison into the scratch slot before ;; emitting the conditional jump. - do (comp-emit (list 'set (make-comp-mvar :slot 'scratch) - (comp-call test-func var m-test))) - (comp-emit (list 'cond-jump - (make-comp-mvar :slot 'scratch) - (make-comp-mvar :constant nil) + do (comp--emit (list 'set (make--comp-mvar :slot 'scratch) + (comp--call test-func var m-test))) + (comp--emit (list 'cond-jump + (make--comp-mvar :slot 'scratch) + (make--comp-mvar :constant nil) ff-bb-name target-name)) unless last ;; All fall through are artificially created here except the last one. @@ -1191,7 +1192,7 @@ SUBR-NAME is the name of function." (or (gethash subr-name comp-subr-arities-h) (func-arity subr-name))) -(defun comp-emit-set-call-subr (subr-name sp-delta) +(defun comp--emit-set-call-subr (subr-name sp-delta) "Emit a call for SUBR-NAME. SP-DELTA is the stack adjustment." (let* ((nargs (1+ (- sp-delta))) @@ -1202,39 +1203,39 @@ SP-DELTA is the stack adjustment." (signal 'native-ice (list "subr contains unevalled args" subr-name))) (if (eq maxarg 'many) ;; callref case. - (comp-emit-set-call (comp-callref subr-name nargs (comp-sp))) + (comp--emit-set-call (comp--callref subr-name nargs (comp--sp))) ;; Normal call. (unless (and (>= maxarg nargs) (<= minarg nargs)) (signal 'native-ice (list "incoherent stack adjustment" nargs maxarg minarg))) (let* ((subr-name subr-name) (slots (cl-loop for i from 0 below maxarg - collect (comp-slot-n (+ i (comp-sp)))))) - (comp-emit-set-call (apply #'comp-call (cons subr-name slots))))))) + collect (comp--slot-n (+ i (comp--sp)))))) + (comp--emit-set-call (apply #'comp--call (cons subr-name slots))))))) (eval-when-compile - (defun comp-op-to-fun (x) + (defun comp--op-to-fun (x) "Given the LAP op strip \"byte-\" to have the subr name." (intern (string-replace "byte-" "" x))) - (defun comp-body-eff (body op-name sp-delta) + (defun comp--body-eff (body op-name sp-delta) "Given the original BODY, compute the effective one. When BODY is `auto', guess function name from the LAP byte-code name. Otherwise expect lname fnname." (pcase (car body) ('auto - `((comp-emit-set-call-subr ',(comp-op-to-fun op-name) ,sp-delta))) + `((comp--emit-set-call-subr ',(comp--op-to-fun op-name) ,sp-delta))) ((pred symbolp) - `((comp-emit-set-call-subr ',(car body) ,sp-delta))) + `((comp--emit-set-call-subr ',(car body) ,sp-delta))) (_ body)))) -(defmacro comp-op-case (&rest cases) +(defmacro comp--op-case (&rest cases) "Expand CASES into the corresponding `pcase' expansion. This is responsible for generating the proper stack adjustment, when known, and the annotation emission." (declare (debug (body)) (indent defun)) - (declare-function comp-body-eff nil (body op-name sp-delta)) + (declare-function comp--body-eff nil (body op-name sp-delta)) `(pcase op ,@(cl-loop for (op . body) in cases for sp-delta = (gethash op comp-op-stack-info) @@ -1243,55 +1244,55 @@ and the annotation emission." collect `(',op ;; Log all LAP ops except the TAG one. ;; ,(unless (eq op 'TAG) - ;; `(comp-emit-annotation + ;; `(comp--emit-annotation ;; ,(concat "LAP op " op-name))) ;; Emit the stack adjustment if present. ,(when (and sp-delta (not (eq 0 sp-delta))) - `(cl-incf (comp-sp) ,sp-delta)) - ,@(comp-body-eff body op-name sp-delta)) + `(cl-incf (comp--sp) ,sp-delta)) + ,@(comp--body-eff body op-name sp-delta)) else collect `(',op (signal 'native-ice (list "unsupported LAP op" ',op-name)))) (_ (signal 'native-ice (list "unexpected LAP op" (symbol-name op)))))) -(defun comp-limplify-lap-inst (insn) +(defun comp--limplify-lap-inst (insn) "Limplify LAP instruction INSN pushing it in the proper basic block." (let ((op (car insn)) (arg (if (consp (cdr insn)) (cadr insn) (cdr insn)))) - (comp-op-case + (comp--op-case (TAG (cl-destructuring-bind (_TAG label-num . label-sp) insn ;; Paranoid? (when label-sp (cl-assert (= (1- label-sp) (comp-limplify-sp comp-pass)))) - (comp-emit-annotation (format "LAP TAG %d" label-num)))) + (comp--emit-annotation (format "LAP TAG %d" label-num)))) (byte-stack-ref - (comp-copy-slot (- (comp-sp) arg 1))) + (comp--copy-slot (- (comp--sp) arg 1))) (byte-varref - (comp-emit-set-call (comp-call 'symbol-value (make-comp-mvar + (comp--emit-set-call (comp--call 'symbol-value (make--comp-mvar :constant arg)))) (byte-varset - (comp-emit (comp-call 'set_internal - (make-comp-mvar :constant arg) - (comp-slot+1)))) + (comp--emit (comp--call 'set_internal + (make--comp-mvar :constant arg) + (comp--slot+1)))) (byte-varbind ;; Verify - (comp-emit (comp-call 'specbind - (make-comp-mvar :constant arg) - (comp-slot+1)))) + (comp--emit (comp--call 'specbind + (make--comp-mvar :constant arg) + (comp--slot+1)))) (byte-call - (cl-incf (comp-sp) (- arg)) - (comp-emit-set-call (comp-callref 'funcall (1+ arg) (comp-sp)))) + (cl-incf (comp--sp) (- arg)) + (comp--emit-set-call (comp--callref 'funcall (1+ arg) (comp--sp)))) (byte-unbind - (comp-emit (comp-call 'helper_unbind_n - (make-comp-mvar :constant arg)))) + (comp--emit (comp--call 'helper_unbind_n + (make--comp-mvar :constant arg)))) (byte-pophandler - (comp-emit '(pop-handler))) + (comp--emit '(pop-handler))) (byte-pushconditioncase - (comp-emit-handler (cddr insn) 'condition-case)) + (comp--emit-handler (cddr insn) 'condition-case)) (byte-pushcatch - (comp-emit-handler (cddr insn) 'catcher)) + (comp--emit-handler (cddr insn) 'catcher)) (byte-nth auto) (byte-symbolp auto) (byte-consp auto) @@ -1300,19 +1301,19 @@ and the annotation emission." (byte-eq auto) (byte-memq auto) (byte-not - (comp-emit-set-call (comp-call 'eq (comp-slot-n (comp-sp)) - (make-comp-mvar :constant nil)))) + (comp--emit-set-call (comp--call 'eq (comp--slot-n (comp--sp)) + (make--comp-mvar :constant nil)))) (byte-car auto) (byte-cdr auto) (byte-cons auto) (byte-list1 - (comp-limplify-listn 1)) + (comp--limplify-listn 1)) (byte-list2 - (comp-limplify-listn 2)) + (comp--limplify-listn 2)) (byte-list3 - (comp-limplify-listn 3)) + (comp--limplify-listn 3)) (byte-list4 - (comp-limplify-listn 4)) + (comp--limplify-listn 4)) (byte-length auto) (byte-aref auto) (byte-aset auto) @@ -1323,11 +1324,11 @@ and the annotation emission." (byte-get auto) (byte-substring auto) (byte-concat2 - (comp-emit-set-call (comp-callref 'concat 2 (comp-sp)))) + (comp--emit-set-call (comp--callref 'concat 2 (comp--sp)))) (byte-concat3 - (comp-emit-set-call (comp-callref 'concat 3 (comp-sp)))) + (comp--emit-set-call (comp--callref 'concat 3 (comp--sp)))) (byte-concat4 - (comp-emit-set-call (comp-callref 'concat 4 (comp-sp)))) + (comp--emit-set-call (comp--callref 'concat 4 (comp--sp)))) (byte-sub1 1-) (byte-add1 1+) (byte-eqlsign =) @@ -1337,7 +1338,7 @@ and the annotation emission." (byte-geq >=) (byte-diff -) (byte-negate - (comp-emit-set-call (comp-call 'negate (comp-slot)))) + (comp--emit-set-call (comp--call 'negate (comp--slot)))) (byte-plus +) (byte-max auto) (byte-min auto) @@ -1352,9 +1353,9 @@ and the annotation emission." (byte-preceding-char preceding-char) (byte-current-column auto) (byte-indent-to - (comp-emit-set-call (comp-call 'indent-to - (comp-slot) - (make-comp-mvar :constant nil)))) + (comp--emit-set-call (comp--call 'indent-to + (comp--slot) + (make--comp-mvar :constant nil)))) (byte-scan-buffer-OBSOLETE) (byte-eolp auto) (byte-eobp auto) @@ -1363,7 +1364,7 @@ and the annotation emission." (byte-current-buffer auto) (byte-set-buffer auto) (byte-save-current-buffer - (comp-emit (comp-call 'record_unwind_current_buffer))) + (comp--emit (comp--call 'record_unwind_current_buffer))) (byte-set-mark-OBSOLETE) (byte-interactive-p-OBSOLETE) (byte-forward-char auto) @@ -1375,41 +1376,41 @@ and the annotation emission." (byte-buffer-substring auto) (byte-delete-region auto) (byte-narrow-to-region - (comp-emit-set-call (comp-call 'narrow-to-region - (comp-slot) - (comp-slot+1)))) + (comp--emit-set-call (comp--call 'narrow-to-region + (comp--slot) + (comp--slot+1)))) (byte-widen - (comp-emit-set-call (comp-call 'widen))) + (comp--emit-set-call (comp--call 'widen))) (byte-end-of-line auto) (byte-constant2) ; TODO ;; Branches. (byte-goto - (comp-emit-uncond-jump (cddr insn))) + (comp--emit-uncond-jump (cddr insn))) (byte-goto-if-nil - (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 0 + (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 0 (cddr insn) nil)) (byte-goto-if-not-nil - (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 0 + (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 0 (cddr insn) t)) (byte-goto-if-nil-else-pop - (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 1 + (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 1 (cddr insn) nil)) (byte-goto-if-not-nil-else-pop - (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 1 + (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 1 (cddr insn) t)) (byte-return - (comp-emit `(return ,(comp-slot+1)))) + (comp--emit `(return ,(comp--slot+1)))) (byte-discard 'pass) (byte-dup - (comp-copy-slot (1- (comp-sp)))) + (comp--copy-slot (1- (comp--sp)))) (byte-save-excursion - (comp-emit (comp-call 'record_unwind_protect_excursion))) + (comp--emit (comp--call 'record_unwind_protect_excursion))) (byte-save-window-excursion-OBSOLETE) (byte-save-restriction - (comp-emit (comp-call 'helper_save_restriction))) + (comp--emit (comp--call 'helper_save_restriction))) (byte-catch) ;; Obsolete (byte-unwind-protect - (comp-emit (comp-call 'helper_unwind_protect (comp-slot+1)))) + (comp--emit (comp--call 'helper_unwind_protect (comp--slot+1)))) (byte-condition-case) ;; Obsolete (byte-temp-output-buffer-setup-OBSOLETE) (byte-temp-output-buffer-show-OBSOLETE) @@ -1436,61 +1437,61 @@ and the annotation emission." (byte-numberp auto) (byte-integerp auto) (byte-listN - (cl-incf (comp-sp) (- 1 arg)) - (comp-emit-set-call (comp-callref 'list arg (comp-sp)))) + (cl-incf (comp--sp) (- 1 arg)) + (comp--emit-set-call (comp--callref 'list arg (comp--sp)))) (byte-concatN - (cl-incf (comp-sp) (- 1 arg)) - (comp-emit-set-call (comp-callref 'concat arg (comp-sp)))) + (cl-incf (comp--sp) (- 1 arg)) + (comp--emit-set-call (comp--callref 'concat arg (comp--sp)))) (byte-insertN - (cl-incf (comp-sp) (- 1 arg)) - (comp-emit-set-call (comp-callref 'insert arg (comp-sp)))) + (cl-incf (comp--sp) (- 1 arg)) + (comp--emit-set-call (comp--callref 'insert arg (comp--sp)))) (byte-stack-set - (comp-copy-slot (1+ (comp-sp)) (- (comp-sp) arg -1))) + (comp--copy-slot (1+ (comp--sp)) (- (comp--sp) arg -1))) (byte-stack-set2 (cl-assert nil)) ;; TODO (byte-discardN - (cl-incf (comp-sp) (- arg))) + (cl-incf (comp--sp) (- arg))) (byte-switch ;; Assume to follow the emission of a setimm. - ;; This is checked into comp-emit-switch. - (comp-emit-switch (comp-slot+1) + ;; This is checked into comp--emit-switch. + (comp--emit-switch (comp--slot+1) (cl-first (comp-block-insns (comp-limplify-curr-block comp-pass))))) (byte-constant - (comp-emit-setimm arg)) + (comp--emit-setimm arg)) (byte-discardN-preserve-tos - (cl-incf (comp-sp) (- arg)) - (comp-copy-slot (+ arg (comp-sp))))))) + (cl-incf (comp--sp) (- arg)) + (comp--copy-slot (+ arg (comp--sp))))))) -(defun comp-emit-narg-prologue (minarg nonrest rest) +(defun comp--emit-narg-prologue (minarg nonrest rest) "Emit the prologue for a narg function." (cl-loop for i below minarg - do (comp-emit `(set-args-to-local ,(comp-slot-n i))) - (comp-emit '(inc-args))) + do (comp--emit `(set-args-to-local ,(comp--slot-n i))) + (comp--emit '(inc-args))) (cl-loop for i from minarg below nonrest for bb = (intern (format "entry_%s" i)) for fallback = (intern (format "entry_fallback_%s" i)) - do (comp-emit `(cond-jump-narg-leq ,i ,fallback ,bb)) - (comp-make-curr-block bb (comp-sp)) - (comp-emit `(set-args-to-local ,(comp-slot-n i))) - (comp-emit '(inc-args)) - finally (comp-emit '(jump entry_rest_args))) + do (comp--emit `(cond-jump-narg-leq ,i ,fallback ,bb)) + (comp--make-curr-block bb (comp--sp)) + (comp--emit `(set-args-to-local ,(comp--slot-n i))) + (comp--emit '(inc-args)) + finally (comp--emit '(jump entry_rest_args))) (when (/= minarg nonrest) (cl-loop for i from minarg below nonrest for bb = (intern (format "entry_fallback_%s" i)) for next-bb = (if (= (1+ i) nonrest) 'entry_rest_args (intern (format "entry_fallback_%s" (1+ i)))) - do (comp-with-sp i - (comp-make-curr-block bb (comp-sp)) - (comp-emit-setimm nil) - (comp-emit `(jump ,next-bb))))) - (comp-make-curr-block 'entry_rest_args (comp-sp)) - (comp-emit `(set-rest-args-to-local ,(comp-slot-n nonrest))) - (setf (comp-sp) nonrest) + do (comp--with-sp i + (comp--make-curr-block bb (comp--sp)) + (comp--emit-setimm nil) + (comp--emit `(jump ,next-bb))))) + (comp--make-curr-block 'entry_rest_args (comp--sp)) + (comp--emit `(set-rest-args-to-local ,(comp--slot-n nonrest))) + (setf (comp--sp) nonrest) (when (and (> nonrest 8) (null rest)) - (cl-decf (comp-sp)))) + (cl-decf (comp--sp)))) -(defun comp-limplify-finalize-function (func) +(defun comp--limplify-finalize-function (func) "Reverse insns into all basic blocks of FUNC." (cl-loop for bb being the hash-value in (comp-func-blocks func) do (setf (comp-block-insns bb) @@ -1498,49 +1499,49 @@ and the annotation emission." (comp--log-func func 2) func) -(cl-defgeneric comp-prepare-args-for-top-level (function) +(cl-defgeneric comp--prepare-args-for-top-level (function) "Given FUNCTION, return the two arguments for comp--register-...") -(cl-defmethod comp-prepare-args-for-top-level ((function comp-func-l)) +(cl-defmethod comp--prepare-args-for-top-level ((function comp-func-l)) "Lexically-scoped FUNCTION." (let ((args (comp-func-l-args function))) - (cons (make-comp-mvar :constant (comp-args-base-min args)) - (make-comp-mvar :constant (cond + (cons (make--comp-mvar :constant (comp-args-base-min args)) + (make--comp-mvar :constant (cond ((comp-args-p args) (comp-args-max args)) ((comp-nargs-rest args) 'many) (t (comp-nargs-nonrest args))))))) -(cl-defmethod comp-prepare-args-for-top-level ((function comp-func-d)) +(cl-defmethod comp--prepare-args-for-top-level ((function comp-func-d)) "Dynamically scoped FUNCTION." - (cons (make-comp-mvar :constant (func-arity (comp-func-byte-func function))) + (cons (make--comp-mvar :constant (func-arity (comp-func-byte-func function))) (let ((comp-curr-allocation-class 'd-default)) ;; Lambda-lists must stay in the same relocation class of ;; the object referenced by code to respect uninterned ;; symbols. - (make-comp-mvar :constant (comp-func-d-lambda-list function))))) + (make--comp-mvar :constant (comp-func-d-lambda-list function))))) -(cl-defgeneric comp-emit-for-top-level (form for-late-load) +(cl-defgeneric comp--emit-for-top-level (form for-late-load) "Emit the Limple code for top level FORM.") -(cl-defmethod comp-emit-for-top-level ((form byte-to-native-func-def) +(cl-defmethod comp--emit-for-top-level ((form byte-to-native-func-def) for-late-load) (let* ((name (byte-to-native-func-def-name form)) (c-name (byte-to-native-func-def-c-name form)) (f (gethash c-name (comp-ctxt-funcs-h comp-ctxt))) - (args (comp-prepare-args-for-top-level f))) + (args (comp--prepare-args-for-top-level f))) (cl-assert (and name f)) - (comp-emit - `(set ,(make-comp-mvar :slot 1) - ,(comp-call (if for-late-load + (comp--emit + `(set ,(make--comp-mvar :slot 1) + ,(comp--call (if for-late-load 'comp--late-register-subr 'comp--register-subr) - (make-comp-mvar :constant name) - (make-comp-mvar :constant c-name) + (make--comp-mvar :constant name) + (make--comp-mvar :constant c-name) (car args) (cdr args) (setf (comp-func-type f) - (make-comp-mvar :constant nil)) - (make-comp-mvar + (make--comp-mvar :constant nil)) + (make--comp-mvar :constant (list (let* ((h (comp-ctxt-function-docs comp-ctxt)) @@ -1551,40 +1552,40 @@ and the annotation emission." (comp-func-command-modes f))) ;; This is the compilation unit it-self passed as ;; parameter. - (make-comp-mvar :slot 0)))))) + (make--comp-mvar :slot 0)))))) -(cl-defmethod comp-emit-for-top-level ((form byte-to-native-top-level) +(cl-defmethod comp--emit-for-top-level ((form byte-to-native-top-level) for-late-load) (unless for-late-load - (comp-emit - (comp-call 'eval + (comp--emit + (comp--call 'eval (let ((comp-curr-allocation-class 'd-impure)) - (make-comp-mvar :constant + (make--comp-mvar :constant (byte-to-native-top-level-form form))) - (make-comp-mvar :constant + (make--comp-mvar :constant (byte-to-native-top-level-lexical form)))))) -(defun comp-emit-lambda-for-top-level (func) +(defun comp--emit-lambda-for-top-level (func) "Emit the creation of subrs for lambda FUNC. These are stored in the reloc data array." - (let ((args (comp-prepare-args-for-top-level func))) + (let ((args (comp--prepare-args-for-top-level func))) (let ((comp-curr-allocation-class 'd-impure)) (comp--add-const-to-relocs (comp-func-byte-func func))) - (comp-emit - (comp-call 'comp--register-lambda + (comp--emit + (comp--call 'comp--register-lambda ;; mvar to be fixed-up when containers are ;; finalized. (or (gethash (comp-func-byte-func func) (comp-ctxt-lambda-fixups-h comp-ctxt)) (puthash (comp-func-byte-func func) - (make-comp-mvar :constant nil) + (make--comp-mvar :constant nil) (comp-ctxt-lambda-fixups-h comp-ctxt))) - (make-comp-mvar :constant (comp-func-c-name func)) + (make--comp-mvar :constant (comp-func-c-name func)) (car args) (cdr args) (setf (comp-func-type func) - (make-comp-mvar :constant nil)) - (make-comp-mvar + (make--comp-mvar :constant nil)) + (make--comp-mvar :constant (list (let* ((h (comp-ctxt-function-docs comp-ctxt)) @@ -1595,9 +1596,9 @@ These are stored in the reloc data array." (comp-func-command-modes func))) ;; This is the compilation unit it-self passed as ;; parameter. - (make-comp-mvar :slot 0))))) + (make--comp-mvar :slot 0))))) -(defun comp-limplify-top-level (for-late-load) +(defun comp--limplify-top-level (for-late-load) "Create a Limple function to modify the global environment at load. When FOR-LATE-LOAD is non-nil, the emitted function modifies only function definition. @@ -1627,22 +1628,22 @@ into the C code forwarding the compilation unit." (comp-func func) (comp-pass (make-comp-limplify :curr-block (make--comp-block-lap -1 0 'top-level) - :frame (comp-new-frame 1 0)))) - (comp-make-curr-block 'entry (comp-sp)) - (comp-emit-annotation (if for-late-load + :frame (comp--new-frame 1 0)))) + (comp--make-curr-block 'entry (comp--sp)) + (comp--emit-annotation (if for-late-load "Late top level" "Top level")) ;; Assign the compilation unit incoming as parameter to the slot frame 0. - (comp-emit `(set-par-to-local ,(comp-slot-n 0) 0)) + (comp--emit `(set-par-to-local ,(comp--slot-n 0) 0)) (maphash (lambda (_ func) - (comp-emit-lambda-for-top-level func)) + (comp--emit-lambda-for-top-level func)) (comp-ctxt-byte-func-to-func-h comp-ctxt)) - (mapc (lambda (x) (comp-emit-for-top-level x for-late-load)) + (mapc (lambda (x) (comp--emit-for-top-level x for-late-load)) (comp-ctxt-top-level-forms comp-ctxt)) - (comp-emit `(return ,(make-comp-mvar :slot 1))) - (comp-limplify-finalize-function func))) + (comp--emit `(return ,(make--comp-mvar :slot 1))) + (comp--limplify-finalize-function func))) -(defun comp-addr-to-bb-name (addr) +(defun comp--addr-to-bb-name (addr) "Search for a block starting at ADDR into pending or limplified blocks." ;; FIXME Actually we could have another hash for this. (cl-flet ((pred (bb) @@ -1654,7 +1655,7 @@ into the C code forwarding the compilation unit." when (pred bb) return (comp-block-name bb))))) -(defun comp-limplify-block (bb) +(defun comp--limplify-block (bb) "Limplify basic-block BB and add it to the current function." (setf (comp-limplify-curr-block comp-pass) bb (comp-limplify-sp comp-pass) (comp-block-lap-sp bb) @@ -1665,51 +1666,51 @@ into the C code forwarding the compilation unit." (comp-func-lap comp-func)) for inst = (car inst-cell) for next-inst = (car-safe (cdr inst-cell)) - do (comp-limplify-lap-inst inst) + do (comp--limplify-lap-inst inst) (cl-incf (comp-limplify-pc comp-pass)) - when (comp-lap-fall-through-p inst) + when (comp--lap-fall-through-p inst) do (pcase next-inst (`(TAG ,_label . ,label-sp) (when label-sp - (cl-assert (= (1- label-sp) (comp-sp)))) + (cl-assert (= (1- label-sp) (comp--sp)))) (let* ((stack-depth (if label-sp (1- label-sp) - (comp-sp))) - (next-bb (comp-block-name (comp-bb-maybe-add + (comp--sp))) + (next-bb (comp-block-name (comp--bb-maybe-add (comp-limplify-pc comp-pass) stack-depth)))) (unless (comp-block-closed bb) - (comp-emit `(jump ,next-bb)))) + (comp--emit `(jump ,next-bb)))) (cl-return))) - until (comp-lap-eob-p inst))) + until (comp--lap-eob-p inst))) -(defun comp-limplify-function (func) +(defun comp--limplify-function (func) "Limplify a single function FUNC." (let* ((frame-size (comp-func-frame-size func)) (comp-func func) (comp-pass (make-comp-limplify - :frame (comp-new-frame frame-size 0)))) - (comp-fill-label-h) + :frame (comp--new-frame frame-size 0)))) + (comp--fill-label-h) ;; Prologue - (comp-make-curr-block 'entry (comp-sp)) - (comp-emit-annotation (concat "Lisp function: " + (comp--make-curr-block 'entry (comp--sp)) + (comp--emit-annotation (concat "Lisp function: " (symbol-name (comp-func-name func)))) ;; Dynamic functions have parameters bound by the trampoline. (when (comp-func-l-p func) (let ((args (comp-func-l-args func))) (if (comp-args-p args) (cl-loop for i below (comp-args-max args) - do (cl-incf (comp-sp)) - (comp-emit `(set-par-to-local ,(comp-slot) ,i))) - (comp-emit-narg-prologue (comp-args-base-min args) + do (cl-incf (comp--sp)) + (comp--emit `(set-par-to-local ,(comp--slot) ,i))) + (comp--emit-narg-prologue (comp-args-base-min args) (comp-nargs-nonrest args) (comp-nargs-rest args))))) - (comp-emit '(jump bb_0)) + (comp--emit '(jump bb_0)) ;; Body - (comp-bb-maybe-add 0 (comp-sp)) + (comp--bb-maybe-add 0 (comp--sp)) (cl-loop for next-bb = (pop (comp-limplify-pending-blocks comp-pass)) while next-bb - do (comp-limplify-block next-bb)) + do (comp--limplify-block next-bb)) ;; Sanity check against block duplication. (cl-loop with addr-h = (make-hash-table) for bb being the hash-value in (comp-func-blocks func) @@ -1718,15 +1719,15 @@ into the C code forwarding the compilation unit." when addr do (cl-assert (null (gethash addr addr-h))) (puthash addr t addr-h)) - (comp-limplify-finalize-function func))) + (comp--limplify-finalize-function func))) -(defun comp-limplify (_) +(defun comp--limplify (_) "Compute LIMPLE IR for forms in `comp-ctxt'." - (maphash (lambda (_ f) (comp-limplify-function f)) + (maphash (lambda (_ f) (comp--limplify-function f)) (comp-ctxt-funcs-h comp-ctxt)) - (comp-add-func-to-ctxt (comp-limplify-top-level nil)) + (comp--add-func-to-ctxt (comp--limplify-top-level nil)) (when (comp-ctxt-with-late-load comp-ctxt) - (comp-add-func-to-ctxt (comp-limplify-top-level t)))) + (comp--add-func-to-ctxt (comp--limplify-top-level t)))) ;;; add-cstrs pass specific code. @@ -1750,22 +1751,22 @@ into the C code forwarding the compilation unit." ;; type specifier. -(defsubst comp-mvar-used-p (mvar) +(defsubst comp--mvar-used-p (mvar) "Non-nil when MVAR is used as lhs in the current function." (declare (gv-setter (lambda (val) `(puthash ,mvar ,val comp-pass)))) (gethash mvar comp-pass)) -(defun comp-collect-mvars (form) +(defun comp--collect-mvars (form) "Add rhs m-var present in FORM into `comp-pass'." (cl-loop for x in form if (consp x) - do (comp-collect-mvars x) + do (comp--collect-mvars x) else when (comp-mvar-p x) - do (setf (comp-mvar-used-p x) t))) + do (setf (comp--mvar-used-p x) t))) -(defun comp-collect-rhs () +(defun comp--collect-rhs () "Collect all lhs mvars into `comp-pass'." (cl-loop for b being each hash-value of (comp-func-blocks comp-func) @@ -1773,11 +1774,11 @@ into the C code forwarding the compilation unit." for insn in (comp-block-insns b) for (op . args) = insn if (comp--assign-op-p op) - do (comp-collect-mvars (cdr args)) + do (comp--collect-mvars (cdr args)) else - do (comp-collect-mvars args)))) + do (comp--collect-mvars args)))) -(defun comp-negate-arithm-cmp-fun (function) +(defun comp--negate-arithm-cmp-fun (function) "Negate FUNCTION. Return nil if we don't want to emit constraints for its negation." (cl-ecase function @@ -1787,7 +1788,7 @@ Return nil if we don't want to emit constraints for its negation." (>= '<) (<= '>))) -(defun comp-reverse-arithm-fun (function) +(defun comp--reverse-arithm-fun (function) "Reverse FUNCTION." (cl-case function (= '=) @@ -1797,7 +1798,7 @@ Return nil if we don't want to emit constraints for its negation." (<= '>=) (t function))) -(defun comp-emit-assume (kind lhs rhs bb negated) +(defun comp--emit-assume (kind lhs rhs bb negated) "Emit an assume of kind KIND for mvar LHS being RHS. When NEGATED is non-nil, the assumption is negated. The assume is emitted at the beginning of the block BB." @@ -1807,41 +1808,41 @@ The assume is emitted at the beginning of the block BB." ((or 'and 'and-nhc) (if (comp-mvar-p rhs) (let ((tmp-mvar (if negated - (make-comp-mvar :slot (comp-mvar-slot rhs)) + (make--comp-mvar :slot (comp-mvar-slot rhs)) rhs))) - (push `(assume ,(make-comp-mvar :slot lhs-slot) + (push `(assume ,(make--comp-mvar :slot lhs-slot) (,kind ,lhs ,tmp-mvar)) (comp-block-insns bb)) (if negated (push `(assume ,tmp-mvar (not ,rhs)) (comp-block-insns bb)))) ;; If is only a constraint we can negate it directly. - (push `(assume ,(make-comp-mvar :slot lhs-slot) + (push `(assume ,(make--comp-mvar :slot lhs-slot) (,kind ,lhs ,(if negated (comp-cstr-negation-make rhs) rhs))) (comp-block-insns bb)))) ((pred comp--arithm-cmp-fun-p) (when-let ((kind (if negated - (comp-negate-arithm-cmp-fun kind) + (comp--negate-arithm-cmp-fun kind) kind))) - (push `(assume ,(make-comp-mvar :slot lhs-slot) + (push `(assume ,(make--comp-mvar :slot lhs-slot) (,kind ,lhs ,(if-let* ((vld (comp-cstr-imm-vld-p rhs)) (val (comp-cstr-imm rhs)) (ok (and (integerp val) (not (memq kind '(= !=)))))) val - (make-comp-mvar :slot (comp-mvar-slot rhs))))) + (make--comp-mvar :slot (comp-mvar-slot rhs))))) (comp-block-insns bb)))) (_ (cl-assert nil))) (setf (comp-func-ssa-status comp-func) 'dirty))) -(defun comp-maybe-add-vmvar (op cmp-res insns-seq) +(defun comp--maybe-add-vmvar (op cmp-res insns-seq) "If CMP-RES is clobbering OP emit a new constrained mvar and return it. Return OP otherwise." (if-let ((match (eql (comp-mvar-slot op) (comp-mvar-slot cmp-res))) - (new-mvar (make-comp-mvar + (new-mvar (make--comp-mvar :slot (- (cl-incf (comp-func-vframe-size comp-func)))))) (progn @@ -1849,7 +1850,7 @@ Return OP otherwise." new-mvar) op)) -(defun comp-add-new-block-between (bb-symbol bb-a bb-b) +(defun comp--add-new-block-between (bb-symbol bb-a bb-b) "Create a new basic-block named BB-SYMBOL and add it between BB-A and BB-B." (cl-loop with new-bb = (make-comp-block-cstr :name bb-symbol @@ -1872,7 +1873,7 @@ Return OP otherwise." finally (cl-assert nil))) ;; Cheap substitute to a copy propagation pass... -(defun comp-cond-cstrs-target-mvar (mvar exit-insn bb) +(defun comp--cond-cstrs-target-mvar (mvar exit-insn bb) "Given MVAR, search in BB the original mvar MVAR got assigned from. Keep on searching till EXIT-INSN is encountered." (cl-flet ((targetp (x) @@ -1889,7 +1890,7 @@ Keep on searching till EXIT-INSN is encountered." (setf res rhs))) finally (cl-assert nil)))) -(defun comp-add-cond-cstrs-target-block (curr-bb target-bb-sym) +(defun comp--add-cond-cstrs-target-block (curr-bb target-bb-sym) "Return the appropriate basic block to add constraint assumptions into. CURR-BB is the current basic block. TARGET-BB-SYM is the symbol name of the target block." @@ -1909,10 +1910,10 @@ TARGET-BB-SYM is the symbol name of the target block." until (null (gethash new-name (comp-func-blocks comp-func))) finally ;; Add it. - (cl-return (comp-add-new-block-between new-name curr-bb target-bb)))))) + (cl-return (comp--add-new-block-between new-name curr-bb target-bb)))))) -(defun comp-add-cond-cstrs-simple () - "`comp-add-cstrs' worker function for each selected function." +(defun comp--add-cond-cstrs-simple () + "`comp--add-cstrs' worker function for each selected function." (cl-loop for b being each hash-value of (comp-func-blocks comp-func) do @@ -1928,26 +1929,26 @@ TARGET-BB-SYM is the symbol name of the target block." for branch-target-cell on blocks for branch-target = (car branch-target-cell) for negated in '(nil t) - when (comp-mvar-used-p tmp-mvar) + when (comp--mvar-used-p tmp-mvar) do - (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) + (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) - (comp-emit-assume 'and tmp-mvar obj2 block-target negated)) + (comp--emit-assume 'and tmp-mvar obj2 block-target negated)) finally (cl-return-from in-the-basic-block))) (`((cond-jump ,obj1 ,obj2 . ,blocks)) (cl-loop for branch-target-cell on blocks for branch-target = (car branch-target-cell) for negated in '(nil t) - when (comp-mvar-used-p obj1) + when (comp--mvar-used-p obj1) do - (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) + (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) - (comp-emit-assume 'and obj1 obj2 block-target negated)) + (comp--emit-assume 'and obj1 obj2 block-target negated)) finally (cl-return-from in-the-basic-block))))))) -(defun comp-add-cond-cstrs () - "`comp-add-cstrs' worker function for each selected function." +(defun comp--add-cond-cstrs () + "`comp--add-cstrs' worker function for each selected function." (cl-loop for b being each hash-value of (comp-func-blocks comp-func) do @@ -1966,13 +1967,13 @@ TARGET-BB-SYM is the symbol name of the target block." (set ,(and (pred comp-mvar-p) mvar-3) (call memq ,(and (pred comp-mvar-p) mvar-1) ,(and (pred comp-mvar-p) mvar-2))) (cond-jump ,(and (pred comp-mvar-p) mvar-3) ,(pred comp-mvar-p) ,bb1 ,bb2)) - (comp-emit-assume 'and mvar-tested - (make-comp-mvar :type (comp-cstr-cl-tag mvar-tag)) - (comp-add-cond-cstrs-target-block b bb2) + (comp--emit-assume 'and mvar-tested + (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag)) + (comp--add-cond-cstrs-target-block b bb2) nil) - (comp-emit-assume 'and mvar-tested - (make-comp-mvar :type (comp-cstr-cl-tag mvar-tag)) - (comp-add-cond-cstrs-target-block b bb1) + (comp--emit-assume 'and mvar-tested + (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag)) + (comp--add-cond-cstrs-target-block b bb1) t)) (`((set ,(and (pred comp-mvar-p) cmp-res) (,(pred comp--call-op-p) @@ -1983,8 +1984,8 @@ TARGET-BB-SYM is the symbol name of the target block." ;; (comment ,_comment-str) (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks)) (cl-loop - with target-mvar1 = (comp-cond-cstrs-target-mvar op1 (car insns-seq) b) - with target-mvar2 = (comp-cond-cstrs-target-mvar op2 (car insns-seq) b) + with target-mvar1 = (comp--cond-cstrs-target-mvar op1 (car insns-seq) b) + with target-mvar2 = (comp--cond-cstrs-target-mvar op2 (car insns-seq) b) for branch-target-cell on blocks for branch-target = (car branch-target-cell) for negated in '(t nil) @@ -1993,19 +1994,19 @@ TARGET-BB-SYM is the symbol name of the target block." (eql 'and-nhc) (eq 'and) (t fun)) - when (or (comp-mvar-used-p target-mvar1) - (comp-mvar-used-p target-mvar2)) + when (or (comp--mvar-used-p target-mvar1) + (comp--mvar-used-p target-mvar2)) do - (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) + (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) - (when (comp-mvar-used-p target-mvar1) - (comp-emit-assume kind target-mvar1 - (comp-maybe-add-vmvar op2 cmp-res prev-insns-seq) + (when (comp--mvar-used-p target-mvar1) + (comp--emit-assume kind target-mvar1 + (comp--maybe-add-vmvar op2 cmp-res prev-insns-seq) block-target negated)) - (when (comp-mvar-used-p target-mvar2) - (comp-emit-assume (comp-reverse-arithm-fun kind) + (when (comp--mvar-used-p target-mvar2) + (comp--emit-assume (comp--reverse-arithm-fun kind) target-mvar2 - (comp-maybe-add-vmvar op1 cmp-res prev-insns-seq) + (comp--maybe-add-vmvar op1 cmp-res prev-insns-seq) block-target negated))) finally (cl-return-from in-the-basic-block))) (`((set ,(and (pred comp-mvar-p) cmp-res) @@ -2015,16 +2016,16 @@ TARGET-BB-SYM is the symbol name of the target block." ;; (comment ,_comment-str) (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks)) (cl-loop - with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b) + with target-mvar = (comp--cond-cstrs-target-mvar op (car insns-seq) b) with cstr = (comp--pred-to-cstr fun) for branch-target-cell on blocks for branch-target = (car branch-target-cell) for negated in '(t nil) - when (comp-mvar-used-p target-mvar) + when (comp--mvar-used-p target-mvar) do - (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) + (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) - (comp-emit-assume 'and target-mvar cstr block-target negated)) + (comp--emit-assume 'and target-mvar cstr block-target negated)) finally (cl-return-from in-the-basic-block))) ;; Match predicate on the negated branch (unless). (`((set ,(and (pred comp-mvar-p) cmp-res) @@ -2034,20 +2035,20 @@ TARGET-BB-SYM is the symbol name of the target block." (set ,neg-cmp-res (call eq ,cmp-res ,(pred comp-cstr-null-p))) (cond-jump ,neg-cmp-res ,(pred comp-mvar-p) . ,blocks)) (cl-loop - with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b) + with target-mvar = (comp--cond-cstrs-target-mvar op (car insns-seq) b) with cstr = (comp--pred-to-cstr fun) for branch-target-cell on blocks for branch-target = (car branch-target-cell) for negated in '(nil t) - when (comp-mvar-used-p target-mvar) + when (comp--mvar-used-p target-mvar) do - (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) + (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) - (comp-emit-assume 'and target-mvar cstr block-target negated)) + (comp--emit-assume 'and target-mvar cstr block-target negated)) finally (cl-return-from in-the-basic-block)))) (setf prev-insns-seq insns-seq)))) -(defsubst comp-insert-insn (insn insn-cell) +(defsubst comp--insert-insn (insn insn-cell) "Insert INSN as second insn of INSN-CELL." (let ((next-cell (cdr insn-cell)) (new-cell `(,insn))) @@ -2055,15 +2056,15 @@ TARGET-BB-SYM is the symbol name of the target block." (cdr new-cell) next-cell (comp-func-ssa-status comp-func) 'dirty))) -(defun comp-emit-call-cstr (mvar call-cell cstr) +(defun comp--emit-call-cstr (mvar call-cell cstr) "Emit a constraint CSTR for MVAR after CALL-CELL." - (let* ((new-mvar (make-comp-mvar :slot (comp-mvar-slot mvar))) + (let* ((new-mvar (make--comp-mvar :slot (comp-mvar-slot mvar))) ;; Have new-mvar as LHS *and* RHS to ensure monotonicity and ;; fwprop convergence!! (insn `(assume ,new-mvar (and ,new-mvar ,mvar ,cstr)))) - (comp-insert-insn insn call-cell))) + (comp--insert-insn insn call-cell))) -(defun comp-lambda-list-gen (lambda-list) +(defun comp--lambda-list-gen (lambda-list) "Return a generator to iterate over LAMBDA-LIST." (lambda () (cl-case (car lambda-list) @@ -2079,12 +2080,12 @@ TARGET-BB-SYM is the symbol name of the target block." (car lambda-list) (setf lambda-list (cdr lambda-list))))))) -(defun comp-add-call-cstr () +(defun comp--add-call-cstr () "Add args assumptions for each function of which the type specifier is known." (cl-loop for bb being each hash-value of (comp-func-blocks comp-func) do - (comp-loop-insn-in-block bb + (comp--loop-insn-in-block bb (when-let ((match (pcase insn (`(set ,lhs (,(pred comp--call-op-p) ,f . ,args)) @@ -2095,10 +2096,10 @@ TARGET-BB-SYM is the symbol name of the target block." (cl-values f cstr-f nil args)))))) (cl-multiple-value-bind (f cstr-f lhs args) match (cl-loop - with gen = (comp-lambda-list-gen (comp-cstr-f-args cstr-f)) + with gen = (comp--lambda-list-gen (comp-cstr-f-args cstr-f)) for arg in args for cstr = (funcall gen) - for target = (comp-cond-cstrs-target-mvar arg insn bb) + for target = (comp--cond-cstrs-target-mvar arg insn bb) unless (comp-cstr-p cstr) do (signal 'native-ice (list "Incoherent type specifier for function" f)) @@ -2109,9 +2110,9 @@ TARGET-BB-SYM is the symbol name of the target block." (or (null lhs) (not (eql (comp-mvar-slot lhs) (comp-mvar-slot target))))) - do (comp-emit-call-cstr target insn-cell cstr))))))) + do (comp--emit-call-cstr target insn-cell cstr))))))) -(defun comp-add-cstrs (_) +(defun comp--add-cstrs (_) "Rewrite conditional branches adding appropriate `assume' insns. This is introducing and placing `assume' insns in use by fwprop to propagate conditional branch test information on target basic @@ -2125,10 +2126,10 @@ blocks." (not (comp-func-has-non-local f))) (let ((comp-func f) (comp-pass (make-hash-table :test #'eq))) - (comp-collect-rhs) - (comp-add-cond-cstrs-simple) - (comp-add-cond-cstrs) - (comp-add-call-cstr) + (comp--collect-rhs) + (comp--add-cond-cstrs-simple) + (comp--add-cond-cstrs) + (comp--add-call-cstr) (comp--log-func comp-func 3)))) (comp-ctxt-funcs-h comp-ctxt))) @@ -2140,7 +2141,7 @@ blocks." ;; avoid optimizing-out functions and preventing their redefinition ;; being effective. -(defun comp-collect-calls (f) +(defun comp--collect-calls (f) "Return a list with all the functions called by F." (cl-loop with h = (make-hash-table :test #'eq) @@ -2160,17 +2161,17 @@ blocks." (comp-ctxt-funcs-h comp-ctxt))) f)))) -(defun comp-pure-infer-func (f) +(defun comp--pure-infer-func (f) "If all functions called by F are pure then F is pure too." (when (and (cl-every (lambda (x) (or (comp--function-pure-p x) (eq x (comp-func-name f)))) - (comp-collect-calls f)) + (comp--collect-calls f)) (not (eq (comp-func-pure f) t))) (comp-log (format "%s inferred to be pure" (comp-func-name f))) (setf (comp-func-pure f) t))) -(defun comp-ipa-pure (_) +(defun comp--ipa-pure (_) "Infer function purity." (cl-loop with pure-n = 0 @@ -2183,7 +2184,7 @@ blocks." when (and (>= (comp-func-speed f) 3) (comp-func-l-p f) (not (comp-func-pure f))) - do (comp-pure-infer-func f) + do (comp--pure-infer-func f) count (comp-func-pure f)))) finally (comp-log (format "ipa-pure iterated %d times" n)))) @@ -2197,13 +2198,13 @@ blocks." ;; this form is called 'minimal SSA form'. ;; This pass should be run every time basic blocks or m-var are shuffled. -(cl-defun make-comp-ssa-mvar (&rest rest &key _slot _constant _type) - "Same as `make-comp-mvar' but set the `id' slot." - (let ((mvar (apply #'make-comp-mvar rest))) +(cl-defun make--comp--ssa-mvar (&rest rest &key _slot _constant _type) + "Same as `make--comp-mvar' but set the `id' slot." + (let ((mvar (apply #'make--comp-mvar rest))) (setf (comp-mvar-id mvar) (sxhash-eq mvar)) mvar)) -(defun comp-clean-ssa (f) +(defun comp--clean-ssa (f) "Clean-up SSA for function F." (setf (comp-func-edges-h f) (make-hash-table)) (cl-loop @@ -2219,7 +2220,7 @@ blocks." unless (eq 'phi (car insn)) collect insn)))) -(defun comp-compute-edges () +(defun comp--compute-edges () "Compute the basic block edges for the current function." (cl-loop with blocks = (comp-func-blocks comp-func) for bb being each hash-value of blocks @@ -2255,7 +2256,7 @@ blocks." (comp-block-in-edges (comp-edge-dst edge)))) (comp--log-edges comp-func))) -(defun comp-collect-rev-post-order (basic-block) +(defun comp--collect-rev-post-order (basic-block) "Walk BASIC-BLOCK children and return their name in reversed post-order." (let ((visited (make-hash-table)) (acc ())) @@ -2270,7 +2271,7 @@ blocks." (collect-rec basic-block) acc))) -(defun comp-compute-dominator-tree () +(defun comp--compute-dominator-tree () "Compute immediate dominators for each basic block in current function." ;; Originally based on: "A Simple, Fast Dominance Algorithm" ;; Cooper, Keith D.; Harvey, Timothy J.; Kennedy, Ken (2001). @@ -2295,7 +2296,7 @@ blocks." ;; No point to go on if the only bb is 'entry'. (bb0 (gethash 'bb_0 blocks))) (cl-loop - with rev-bb-list = (comp-collect-rev-post-order entry) + with rev-bb-list = (comp--collect-rev-post-order entry) with changed = t while changed initially (progn @@ -2322,7 +2323,7 @@ blocks." new-idom) changed t)))))) -(defun comp-compute-dominator-frontiers () +(defun comp--compute-dominator-frontiers () "Compute the dominator frontier for each basic block in `comp-func'." ;; Originally based on: "A Simple, Fast Dominance Algorithm" ;; Cooper, Keith D.; Harvey, Timothy J.; Kennedy, Ken (2001). @@ -2337,7 +2338,7 @@ blocks." (puthash b-name b (comp-block-df runner)) (setf runner (comp-block-idom runner)))))) -(defun comp-log-block-info () +(defun comp--log-block-info () "Log basic blocks info for the current function." (maphash (lambda (name bb) (let ((dom (comp-block-idom bb)) @@ -2350,7 +2351,7 @@ blocks." 3))) (comp-func-blocks comp-func))) -(defun comp-place-phis () +(defun comp--place-phis () "Place phi insns into the current function." ;; Originally based on: Static Single Assignment Book ;; Algorithm 3.1: Standard algorithm for inserting phi-functions @@ -2391,7 +2392,7 @@ blocks." (unless (cl-find y defs-v) (push y w)))))))) -(defun comp-dom-tree-walker (bb pre-lambda post-lambda) +(defun comp--dom-tree-walker (bb pre-lambda post-lambda) "Dominator tree walker function starting from basic block BB. PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." (when pre-lambda @@ -2401,18 +2402,18 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." for child = (comp-edge-dst ed) when (eq bb (comp-block-idom child)) ;; Current block is the immediate dominator then recur. - do (comp-dom-tree-walker child pre-lambda post-lambda))) + do (comp--dom-tree-walker child pre-lambda post-lambda))) (when post-lambda (funcall post-lambda bb))) -(cl-defstruct (comp-ssa (:copier nil)) +(cl-defstruct (comp--ssa (:copier nil)) "Support structure used while SSA renaming." - (frame (comp-new-frame (comp-func-frame-size comp-func) + (frame (comp--new-frame (comp-func-frame-size comp-func) (comp-func-vframe-size comp-func) t) :type comp-vec :documentation "`comp-vec' of m-vars.")) -(defun comp-ssa-rename-insn (insn frame) +(defun comp--ssa-rename-insn (insn frame) (cl-loop for slot-n from (- (comp-func-vframe-size comp-func)) below (comp-func-frame-size comp-func) @@ -2423,7 +2424,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." (eql slot-n (comp-mvar-slot x)))) (new-lvalue () ;; If is an assignment make a new mvar and put it as l-value. - (let ((mvar (make-comp-ssa-mvar :slot slot-n))) + (let ((mvar (make--comp--ssa-mvar :slot slot-n))) (setf (comp-vec-aref frame slot-n) mvar (cadr insn) mvar)))) (pcase insn @@ -2433,7 +2434,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." (new-lvalue)) (`(fetch-handler . ,_) ;; Clobber all no matter what! - (setf (comp-vec-aref frame slot-n) (make-comp-ssa-mvar :slot slot-n))) + (setf (comp-vec-aref frame slot-n) (make--comp--ssa-mvar :slot slot-n))) (`(phi ,n) (when (equal n slot-n) (new-lvalue))) @@ -2441,7 +2442,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." (let ((mvar (comp-vec-aref frame slot-n))) (setcdr insn (cl-nsubst-if mvar #'targetp (cdr insn))))))))) -(defun comp-ssa-rename () +(defun comp--ssa-rename () "Entry point to rename into SSA within the current function." (comp-log "Renaming\n" 2) (let ((visited (make-hash-table))) @@ -2449,7 +2450,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." (unless (gethash bb visited) (puthash bb t visited) (cl-loop for insn in (comp-block-insns bb) - do (comp-ssa-rename-insn insn in-frame)) + do (comp--ssa-rename-insn insn in-frame)) (setf (comp-block-final-frame bb) (copy-sequence in-frame)) (when-let ((out-edges (comp-block-out-edges bb))) @@ -2460,11 +2461,11 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." do (ssa-rename-rec child (comp-vec-copy in-frame))))))) (ssa-rename-rec (gethash 'entry (comp-func-blocks comp-func)) - (comp-new-frame (comp-func-frame-size comp-func) + (comp--new-frame (comp-func-frame-size comp-func) (comp-func-vframe-size comp-func) t))))) -(defun comp-finalize-phis () +(defun comp--finalize-phis () "Fixup r-values into phis in all basic blocks." (cl-flet ((finalize-phi (args b) ;; Concatenate into args all incoming m-vars for this phi. @@ -2481,7 +2482,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." when (eq op 'phi) do (finalize-phi args b))))) -(defun comp-remove-unreachable-blocks () +(defun comp--remove-unreachable-blocks () "Remove unreachable basic blocks. Return t when one or more block was removed, nil otherwise." (cl-loop @@ -2497,7 +2498,7 @@ Return t when one or more block was removed, nil otherwise." ret t) finally return ret)) -(defun comp-ssa () +(defun comp--ssa () "Port all functions into minimal SSA form." (maphash (lambda (_ f) (let* ((comp-func f) @@ -2505,15 +2506,15 @@ Return t when one or more block was removed, nil otherwise." (unless (eq ssa-status t) (cl-loop when (eq ssa-status 'dirty) - do (comp-clean-ssa f) - do (comp-compute-edges) - (comp-compute-dominator-tree) - until (null (comp-remove-unreachable-blocks))) - (comp-compute-dominator-frontiers) - (comp-log-block-info) - (comp-place-phis) - (comp-ssa-rename) - (comp-finalize-phis) + do (comp--clean-ssa f) + do (comp--compute-edges) + (comp--compute-dominator-tree) + until (null (comp--remove-unreachable-blocks))) + (comp--compute-dominator-frontiers) + (comp--log-block-info) + (comp--place-phis) + (comp--ssa-rename) + (comp--finalize-phis) (comp--log-func comp-func 3) (setf (comp-func-ssa-status f) t)))) (comp-ctxt-funcs-h comp-ctxt))) @@ -2525,12 +2526,12 @@ Return t when one or more block was removed, nil otherwise." ;; This is also responsible for removing function calls to pure functions if ;; possible. -(defconst comp-fwprop-max-insns-scan 4500 +(defconst comp--fwprop-max-insns-scan 4500 ;; Chosen as ~ the greatest required value for full convergence ;; native compiling all Emacs code-base. "Max number of scanned insn before giving-up.") -(defun comp-copy-insn (insn) +(defun comp--copy-insn (insn) "Deep copy INSN." ;; Adapted from `copy-tree'. (if (consp insn) @@ -2538,16 +2539,16 @@ Return t when one or more block was removed, nil otherwise." (while (consp insn) (let ((newcar (car insn))) (if (or (consp (car insn)) (comp-mvar-p (car insn))) - (setf newcar (comp-copy-insn (car insn)))) + (setf newcar (comp--copy-insn (car insn)))) (push newcar result)) (setf insn (cdr insn))) (nconc (nreverse result) - (if (comp-mvar-p insn) (comp-copy-insn insn) insn))) + (if (comp-mvar-p insn) (comp--copy-insn insn) insn))) (if (comp-mvar-p insn) (copy-comp-mvar insn) insn))) -(defmacro comp-apply-in-env (func &rest args) +(defmacro comp--apply-in-env (func &rest args) "Apply FUNC to ARGS in the current compilation environment." `(let ((env (cl-loop for f being the hash-value in (comp-ctxt-funcs-h comp-ctxt) @@ -2563,7 +2564,7 @@ Return t when one or more block was removed, nil otherwise." for (func-name . def) in env do (setf (symbol-function func-name) def))))) -(defun comp-fwprop-prologue () +(defun comp--fwprop-prologue () "Prologue for the propagate pass. Here goes everything that can be done not iteratively (read once). Forward propagate immediate involed in assignments." ; FIXME: Typo. Involved or invoked? @@ -2575,16 +2576,16 @@ Forward propagate immediate involed in assignments." ; FIXME: Typo. Involved or (`(setimm ,lval ,v) (setf (comp-cstr-imm lval) v)))))) -(defun comp-function-foldable-p (f args) +(defun comp--function-foldable-p (f args) "Given function F called with ARGS, return non-nil when optimizable." (and (comp--function-pure-p f) (cl-every #'comp-cstr-imm-vld-p args))) -(defun comp-function-call-maybe-fold (insn f args) +(defun comp--function-call-maybe-fold (insn f args) "Given INSN, when F is pure if all ARGS are known, remove the function call. Return non-nil if the function is folded successfully." (cl-flet ((rewrite-insn-as-setimm (insn value) - ;; See `comp-emit-setimm'. + ;; See `comp--emit-setimm'. (comp--add-const-to-relocs value) (setf (car insn) 'setimm (cddr insn) `(,value)))) @@ -2596,7 +2597,7 @@ Return non-nil if the function is folded successfully." comp-symbol-values-optimizable))) (rewrite-insn-as-setimm insn (symbol-value (comp-cstr-imm (car args)))))) - ((comp-function-foldable-p f args) + ((comp--function-foldable-p f args) (ignore-errors ;; No point to complain here in case of error because we ;; should do basic block pruning in order to be sure that this @@ -2607,14 +2608,14 @@ Return non-nil if the function is folded successfully." ;; and know to be pure. (comp-func-byte-func f-in-ctxt) f)) - (value (comp-apply-in-env f (mapcar #'comp-cstr-imm args)))) + (value (comp--apply-in-env f (mapcar #'comp-cstr-imm args)))) (rewrite-insn-as-setimm insn value))))))) -(defun comp-fwprop-call (insn lval f args) +(defun comp--fwprop-call (insn lval f args) "Propagate on a call INSN into LVAL. F is the function being called with arguments ARGS. Fold the call in case." - (unless (comp-function-call-maybe-fold insn f args) + (unless (comp--function-call-maybe-fold insn f args) (when (and (eq 'funcall f) (comp-cstr-imm-vld-p (car args))) (setf f (comp-cstr-imm (car args)) @@ -2635,16 +2636,16 @@ Fold the call in case." (comp-type-spec-to-cstr (comp-cstr-imm (car args))))))))) -(defun comp-fwprop-insn (insn) +(defun comp--fwprop-insn (insn) "Propagate within INSN." (pcase insn (`(set ,lval ,rval) (pcase rval (`(,(or 'call 'callref) ,f . ,args) - (comp-fwprop-call insn lval f args)) + (comp--fwprop-call insn lval f args)) (`(,(or 'direct-call 'direct-callref) ,f . ,args) (let ((f (comp-func-name (gethash f (comp-ctxt-funcs-h comp-ctxt))))) - (comp-fwprop-call insn lval f args))) + (comp--fwprop-call insn lval f args))) (_ (comp-cstr-shallow-copy lval rval)))) (`(assume ,lval ,(and (pred comp-mvar-p) rval)) @@ -2689,7 +2690,7 @@ Fold the call in case." (rvals (mapcar #'car rest))) (apply prop-fn lval rvals))))) -(defun comp-fwprop* () +(defun comp--fwprop* () "Propagate for set* and phi operands. Return t if something was changed." (cl-loop named outer @@ -2701,17 +2702,17 @@ Return t if something was changed." for insn in (comp-block-insns b) for orig-insn = (unless modified ;; Save consing after 1st change. - (comp-copy-insn insn)) + (comp--copy-insn insn)) do - (comp-fwprop-insn insn) + (comp--fwprop-insn insn) (cl-incf i) when (and (null modified) (not (equal insn orig-insn))) do (setf modified t)) - when (> i comp-fwprop-max-insns-scan) + when (> i comp--fwprop-max-insns-scan) do (cl-return-from outer nil) finally return modified)) -(defun comp-rewrite-non-locals () +(defun comp--rewrite-non-locals () "Make explicit in LIMPLE non-local exits if identified." (cl-loop for bb being each hash-value of (comp-func-blocks comp-func) @@ -2728,26 +2729,26 @@ Return t if something was changed." (cdr insn-seq) '((unreachable)) (comp-func-ssa-status comp-func) 'dirty)))) -(defun comp-fwprop (_) +(defun comp--fwprop (_) "Forward propagate types and consts within the lattice." - (comp-ssa) - (comp-dead-code) + (comp--ssa) + (comp--dead-code) (maphash (lambda (_ f) (when (and (>= (comp-func-speed f) 2) ;; FIXME remove the following condition when tested. (not (comp-func-has-non-local f))) (let ((comp-func f)) - (comp-fwprop-prologue) + (comp--fwprop-prologue) (cl-loop for i from 1 to 100 - while (comp-fwprop*) + while (comp--fwprop*) finally (when (= i 100) (display-warning 'comp (format "fwprop pass jammed into %s?" (comp-func-name f)))) (comp-log (format "Propagation run %d times\n" i) 2)) - (comp-rewrite-non-locals) + (comp--rewrite-non-locals) (comp--log-func comp-func 3)))) (comp-ctxt-funcs-h comp-ctxt))) @@ -2767,7 +2768,7 @@ Return t if something was changed." ;; the full compilation unit. ;; For this reason this is triggered only at native-comp-speed == 3. -(defun comp-func-in-unit (func) +(defun comp--func-in-unit (func) "Given FUNC return the `comp-fun' definition in the current context. FUNCTION can be a function-name or byte compiled function." (if (symbolp func) @@ -2775,11 +2776,11 @@ FUNCTION can be a function-name or byte compiled function." (cl-assert (byte-code-function-p func)) (gethash func (comp-ctxt-byte-func-to-func-h comp-ctxt)))) -(defun comp-call-optim-form-call (callee args) +(defun comp--call-optim-form-call (callee args) (cl-flet ((fill-args (args total) ;; Fill missing args to reach TOTAL (append args (cl-loop repeat (- total (length args)) - collect (make-comp-mvar :constant nil))))) + collect (make--comp-mvar :constant nil))))) (when (and callee (or (symbolp callee) (gethash callee (comp-ctxt-byte-func-to-func-h comp-ctxt))) @@ -2797,7 +2798,7 @@ FUNCTION can be a function-name or byte compiled function." ;; actually cheaper since it avoids the call to the ;; intermediate native trampoline (bug#67005). (subrp (subrp f)) - (comp-func-callee (comp-func-in-unit callee))) + (comp-func-callee (comp--func-in-unit callee))) (cond ((and subrp (not (subr-native-elisp-p f))) ;; Trampoline removal. @@ -2832,30 +2833,30 @@ FUNCTION can be a function-name or byte compiled function." ((comp--type-hint-p callee) `(call ,callee ,@args))))))) -(defun comp-call-optim-func () +(defun comp--call-optim-func () "Perform the trampoline call optimization for the current function." (cl-loop for b being each hash-value of (comp-func-blocks comp-func) - do (comp-loop-insn-in-block b + do (comp--loop-insn-in-block b (pcase insn (`(set ,lval (callref funcall ,f . ,rest)) (when-let ((ok (comp-cstr-imm-vld-p f)) - (new-form (comp-call-optim-form-call + (new-form (comp--call-optim-form-call (comp-cstr-imm f) rest))) (setf insn `(set ,lval ,new-form)))) (`(callref funcall ,f . ,rest) (when-let ((ok (comp-cstr-imm-vld-p f)) - (new-form (comp-call-optim-form-call + (new-form (comp--call-optim-form-call (comp-cstr-imm f) rest))) (setf insn new-form))))))) -(defun comp-call-optim (_) +(defun comp--call-optim (_) "Try to optimize out funcall trampoline usage when possible." (maphash (lambda (_ f) (when (and (>= (comp-func-speed f) 2) (comp-func-l-p f)) (let ((comp-func f)) - (comp-call-optim-func)))) + (comp--call-optim-func)))) (comp-ctxt-funcs-h comp-ctxt))) @@ -2866,16 +2867,16 @@ FUNCTION can be a function-name or byte compiled function." ;; ;; This pass can be run as last optim. -(defun comp-collect-mvar-ids (insn) +(defun comp--collect-mvar-ids (insn) "Collect the m-var unique identifiers into INSN." (cl-loop for x in insn if (consp x) - append (comp-collect-mvar-ids x) + append (comp--collect-mvar-ids x) else when (comp-mvar-p x) collect (comp-mvar-id x))) -(defun comp-dead-assignments-func () +(defun comp--dead-assignments-func () "Clean-up dead assignments into current function. Return the list of m-var ids nuked." (let ((l-vals ()) @@ -2888,9 +2889,9 @@ Return the list of m-var ids nuked." for (op arg0 . rest) = insn if (comp--assign-op-p op) do (push (comp-mvar-id arg0) l-vals) - (setf r-vals (nconc (comp-collect-mvar-ids rest) r-vals)) + (setf r-vals (nconc (comp--collect-mvar-ids rest) r-vals)) else - do (setf r-vals (nconc (comp-collect-mvar-ids insn) r-vals)))) + do (setf r-vals (nconc (comp--collect-mvar-ids insn) r-vals)))) ;; Every l-value appearing that does not appear as r-value has no right to ;; exist and gets nuked. (let ((nuke-list (cl-set-difference l-vals r-vals))) @@ -2902,7 +2903,7 @@ Return the list of m-var ids nuked." 3) (cl-loop for b being each hash-value of (comp-func-blocks comp-func) - do (comp-loop-insn-in-block b + do (comp--loop-insn-in-block b (cl-destructuring-bind (op &optional arg0 arg1 &rest rest) insn (when (and (comp--assign-op-p op) (memq (comp-mvar-id arg0) nuke-list)) @@ -2913,7 +2914,7 @@ Return the list of m-var ids nuked." insn)))))))) nuke-list))) -(defun comp-dead-code () +(defun comp--dead-code () "Dead code elimination." (maphash (lambda (_ f) (when (and (>= (comp-func-speed f) 2) @@ -2922,7 +2923,7 @@ Return the list of m-var ids nuked." (cl-loop for comp-func = f for i from 1 - while (comp-dead-assignments-func) + while (comp--dead-assignments-func) finally (comp-log (format "dead code rm run %d times\n" i) 2) (comp--log-func comp-func 3)))) (comp-ctxt-funcs-h comp-ctxt))) @@ -2930,14 +2931,14 @@ Return the list of m-var ids nuked." ;;; Tail Call Optimization pass specific code. -(defun comp-form-tco-call-seq (args) +(defun comp--form-tco-call-seq (args) "Generate a TCO sequence for ARGS." `(,@(cl-loop for arg in args for i from 0 - collect `(set ,(make-comp-mvar :slot i) ,arg)) + collect `(set ,(make--comp-mvar :slot i) ,arg)) (jump bb_0))) -(defun comp-tco-func () +(defun comp--tco-func () "Try to pattern match and perform TCO within the current function." (cl-loop for b being each hash-value of (comp-func-blocks comp-func) @@ -2950,20 +2951,20 @@ Return the list of m-var ids nuked." (return ,ret-val)) (when (and (string= func (comp-func-c-name comp-func)) (eq l-val ret-val)) - (let ((tco-seq (comp-form-tco-call-seq args))) + (let ((tco-seq (comp--form-tco-call-seq args))) (setf (car insns-seq) (car tco-seq) (cdr insns-seq) (cdr tco-seq) (comp-func-ssa-status comp-func) 'dirty) (cl-return-from in-the-basic-block)))))))) -(defun comp-tco (_) +(defun comp--tco (_) "Simple peephole pass performing self TCO." (maphash (lambda (_ f) (when (and (>= (comp-func-speed f) 3) (comp-func-l-p f) (not (comp-func-has-non-local f))) (let ((comp-func f)) - (comp-tco-func) + (comp--tco-func) (comp--log-func comp-func 3)))) (comp-ctxt-funcs-h comp-ctxt))) @@ -2973,29 +2974,29 @@ Return the list of m-var ids nuked." ;; This must run after all SSA prop not to have the type hint ;; information overwritten. -(defun comp-remove-type-hints-func () +(defun comp--remove-type-hints-func () "Remove type hints from the current function. These are substituted with a normal `set' op." (cl-loop for b being each hash-value of (comp-func-blocks comp-func) - do (comp-loop-insn-in-block b + do (comp--loop-insn-in-block b (pcase insn (`(set ,l-val (call ,(pred comp--type-hint-p) ,r-val)) (setf insn `(set ,l-val ,r-val))))))) -(defun comp-remove-type-hints (_) +(defun comp--remove-type-hints (_) "Dead code elimination." (maphash (lambda (_ f) (when (>= (comp-func-speed f) 2) (let ((comp-func f)) - (comp-remove-type-hints-func) + (comp--remove-type-hints-func) (comp--log-func comp-func 3)))) (comp-ctxt-funcs-h comp-ctxt))) ;;; Final pass specific code. -(defun comp-args-to-lambda-list (args) +(defun comp--args-to-lambda-list (args) "Return a lambda list for ARGS." (cl-loop with res @@ -3020,7 +3021,7 @@ These are substituted with a normal `set' op." (push 't res)))) (cl-return (reverse res)))) -(defun comp-compute-function-type (_ func) +(defun comp--compute-function-type (_ func) "Compute type specifier for `comp-func' FUNC. Set it into the `type' slot." (when (and (comp-func-l-p func) @@ -3040,13 +3041,13 @@ Set it into the `type' slot." (`(return ,mvar) (push mvar res)))) finally return res))) - (type `(function ,(comp-args-to-lambda-list (comp-func-l-args func)) + (type `(function ,(comp--args-to-lambda-list (comp-func-l-args func)) ,(comp-cstr-to-type-spec res-mvar)))) (comp--add-const-to-relocs type) ;; Fix it up. (setf (comp-cstr-imm (comp-func-type func)) type)))) -(defun comp-finalize-container (cont) +(defun comp--finalize-container (cont) "Finalize data container CONT." (setf (comp-data-container-l cont) (cl-loop with h = (comp-data-container-idx cont) @@ -3064,7 +3065,7 @@ Set it into the `type' slot." 'lambda-fixup obj)))) -(defun comp-finalize-relocs () +(defun comp--finalize-relocs () "Finalize data containers for each relocation class. Remove immediate duplicates within relocation classes. Update all insn accordingly." @@ -3080,7 +3081,7 @@ Update all insn accordingly." (d-ephemeral (comp-ctxt-d-ephemeral comp-ctxt)) (d-ephemeral-idx (comp-data-container-idx d-ephemeral))) ;; We never want compiled lambdas ending up in pure space. A copy must - ;; be already present in impure (see `comp-emit-lambda-for-top-level'). + ;; be already present in impure (see `comp--emit-lambda-for-top-level'). (cl-loop for obj being each hash-keys of d-default-idx when (gethash obj (comp-ctxt-lambda-fixups-h comp-ctxt)) do (cl-assert (gethash obj d-impure-idx)) @@ -3096,7 +3097,7 @@ Update all insn accordingly." do (remhash obj d-ephemeral-idx)) ;; Fix-up indexes in each relocation class and fill corresponding ;; reloc lists. - (mapc #'comp-finalize-container (list d-default d-impure d-ephemeral)) + (mapc #'comp--finalize-container (list d-default d-impure d-ephemeral)) ;; Make a vector from the function documentation hash table. (cl-loop with h = (comp-ctxt-function-docs comp-ctxt) with v = (make-vector (hash-table-count h) nil) @@ -3120,11 +3121,11 @@ Update all insn accordingly." (comp-mvar-range mvar) (list (cons idx idx))) (puthash idx t reverse-h)))) -(defun comp-compile-ctxt-to-file (name) +(defun comp--compile-ctxt-to-file (name) "Compile as native code the current context naming it NAME. Prepare every function for final compilation and drive the C back-end." (let ((dir (file-name-directory name))) - (comp-finalize-relocs) + (comp--finalize-relocs) (maphash (lambda (_ f) (comp--log-func f 1)) (comp-ctxt-funcs-h comp-ctxt)) @@ -3132,12 +3133,12 @@ Prepare every function for final compilation and drive the C back-end." ;; In case it's created in the meanwhile. (ignore-error file-already-exists (make-directory dir t))) - (comp--compile-ctxt-to-file name))) + (comp--compile-ctxt-to-file0 name))) -(defun comp-final1 () +(defun comp--final1 () (comp--init-ctxt) (unwind-protect - (comp-compile-ctxt-to-file (comp-ctxt-output comp-ctxt)) + (comp--compile-ctxt-to-file (comp-ctxt-output comp-ctxt)) (comp--release-ctxt))) (defvar comp-async-compilation nil @@ -3146,17 +3147,17 @@ Prepare every function for final compilation and drive the C back-end." (defvar comp-running-batch-compilation nil "Non-nil when compilation is driven by any `batch-*-compile' function.") -(defun comp-final (_) +(defun comp--final (_) "Final pass driving the C back-end for code emission." - (maphash #'comp-compute-function-type (comp-ctxt-funcs-h comp-ctxt)) + (maphash #'comp--compute-function-type (comp-ctxt-funcs-h comp-ctxt)) (unless comp-dry-run ;; Always run the C side of the compilation as a sub-process ;; unless during bootstrap or async compilation (bug#45056). GCC ;; leaks memory but also interfere with the ability of Emacs to ;; detect when a sub-process completes (TODO understand why). (if (or comp-running-batch-compilation comp-async-compilation) - (comp-final1) - ;; Call comp-final1 in a child process. + (comp--final1) + ;; Call comp--final1 in a child process. (let* ((output (comp-ctxt-output comp-ctxt)) (print-escape-newlines t) (print-length nil) @@ -3178,7 +3179,7 @@ Prepare every function for final compilation and drive the C back-end." load-path ',load-path) ,native-comp-async-env-modifier-form (message "Compiling %s..." ',output) - (comp-final1))) + (comp--final1))) (temp-file (make-temp-file (concat "emacs-int-comp-" (file-name-base output) "-") @@ -3222,7 +3223,7 @@ Prepare every function for final compilation and drive the C back-end." ;; Primitive function advice machinery -(defun comp-make-lambda-list-from-subr (subr) +(defun comp--make-lambda-list-from-subr (subr) "Given SUBR return the equivalent lambda-list." (pcase-let ((`(,min . ,max) (subr-arity subr)) (lambda-list '())) @@ -3266,7 +3267,7 @@ Prepare every function for final compilation and drive the C back-end." ;;;###autoload (defun comp-trampoline-compile (subr-name) "Synthesize compile and return a trampoline for SUBR-NAME." - (let* ((lambda-list (comp-make-lambda-list-from-subr + (let* ((lambda-list (comp--make-lambda-list-from-subr (symbol-function subr-name))) ;; The synthesized trampoline must expose the exact same ABI of ;; the primitive we are replacing in the function reloc table. @@ -3310,6 +3311,7 @@ filename (including FILE)." do (ignore-error file-error (comp-delete-or-replace-file f)))))) +;; In use by comp.c. (defun comp-delete-or-replace-file (oldfile &optional newfile) "Replace OLDFILE with NEWFILE. When NEWFILE is nil just delete OLDFILE. @@ -3493,7 +3495,7 @@ last directory in `native-comp-eln-load-path')." else collect (byte-compile-file file)))) -(defun comp-write-bytecode-file (eln-file) +(defun comp--write-bytecode-file (eln-file) "After native compilation write the bytecode file for ELN-FILE. Make sure that eln file is younger than byte-compiled one and return the filename of this last. @@ -3530,7 +3532,7 @@ variable \"NATIVE_DISABLED\" is set, only byte compile." (car (last native-comp-eln-load-path))) (byte-to-native-output-buffer-file nil) (eln-file (car (batch-native-compile)))) - (comp-write-bytecode-file eln-file) + (comp--write-bytecode-file eln-file) (setq command-line-args-left (cdr command-line-args-left))))) (defun native-compile-prune-cache () diff --git a/src/comp.c b/src/comp.c index 853757f6162..3f989c722d4 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4859,8 +4859,8 @@ add_compiler_options (void) #endif } -DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, - Scomp__compile_ctxt_to_file, +DEFUN ("comp--compile-ctxt-to-file0", Fcomp__compile_ctxt_to_file0, + Scomp__compile_ctxt_to_file0, 1, 1, 0, doc: /* Compile the current context as native code to file FILENAME. */) (Lisp_Object filename) @@ -5789,7 +5789,7 @@ natively-compiled one. */); defsubr (&Scomp__install_trampoline); defsubr (&Scomp__init_ctxt); defsubr (&Scomp__release_ctxt); - defsubr (&Scomp__compile_ctxt_to_file); + defsubr (&Scomp__compile_ctxt_to_file0); defsubr (&Scomp_libgccjit_version); defsubr (&Scomp__register_lambda); defsubr (&Scomp__register_subr); diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el index 4cee084e211..dc4abf50767 100644 --- a/test/src/comp-resources/comp-test-funcs.el +++ b/test/src/comp-resources/comp-test-funcs.el @@ -367,11 +367,11 @@ (while (consp insn) (let ((newcar (car insn))) (if (or (consp (car insn)) (comp-mvar-p (car insn))) - (setf newcar (comp-copy-insn (car insn)))) + (setf newcar (comp--copy-insn (car insn)))) (push newcar result)) (setf insn (cdr insn))) (nconc (nreverse result) - (if (comp-mvar-p insn) (comp-copy-insn insn) insn))) + (if (comp-mvar-p insn) (comp--copy-insn insn) insn))) (if (comp-mvar-p insn) (copy-comp-mvar insn) insn))) -- cgit v1.2.3 From c0f656617d6848b94413b79b390788565d338fcd Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sun, 11 Feb 2024 22:32:44 +0200 Subject: Make sure the binding shown by echo-keystrokes-help is not shadowed And choose just one binding to display rather than two together. (https://lists.gnu.org/archive/html/emacs-devel/2024-02/msg00311.html) * lisp/help.el (help--append-keystrokes-help): New function. * src/keyboard.c (syms_of_keyboard): Add a symbol for it. (echo_dash): Use them here. --- lisp/help.el | 21 +++++++++++++++++++++ src/keyboard.c | 13 +++++-------- 2 files changed, 26 insertions(+), 8 deletions(-) diff --git a/lisp/help.el b/lisp/help.el index 72a4f8a800d..07eed2861c2 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -2253,6 +2253,27 @@ The `temp-buffer-window-setup-hook' hook is called." (with-output-to-temp-buffer " *Char Help*" (princ msg))))) +(defun help--append-keystrokes-help (str) + (let* ((keys (this-single-command-keys)) + (bindings (delete nil + (mapcar (lambda (map) (lookup-key map keys t)) + (current-active-maps t))))) + (catch 'res + (dolist (val help-event-list) + (let ((key (vector (if (eql val 'help) + help-char + val)))) + (unless (seq-find (lambda (map) (and (keymapp map) (lookup-key map key))) + bindings) + (throw 'res + (concat + str + (substitute-command-keys + (format + " (\\`%s' for help)" + (key-description key)))))))) + str))) + (defun help--docstring-quote (string) "Return a doc string that represents STRING. diff --git a/src/keyboard.c b/src/keyboard.c index 10cdef67348..4b5e20fb24c 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -594,14 +594,9 @@ echo_dash (void) concat2 (KVAR (current_kboard, echo_string), dash)); if (echo_keystrokes_help) - { - Lisp_Object help; - - help = build_string (" (\\`C-h' or \\`' for help)"); - kset_echo_string (current_kboard, - concat2 (KVAR (current_kboard, echo_string), - calln (Qsubstitute_command_keys, help))); - } + kset_echo_string (current_kboard, + calln (Qhelp__append_keystrokes_help, + KVAR (current_kboard, echo_string))); echo_now (); } @@ -12962,6 +12957,8 @@ syms_of_keyboard (void) DEFSYM (Qhelp_key_binding, "help-key-binding"); + DEFSYM (Qhelp__append_keystrokes_help, "help--append-keystrokes-help"); + DEFSYM (Qecho_keystrokes, "echo-keystrokes"); Fset (Qinput_method_exit_on_first_char, Qnil); -- cgit v1.2.3 From db195116a4279521e9cf03c52b7026032461e3e1 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 13 Sep 2023 12:26:22 +0200 Subject: Add the public API of Compat to the core * lisp/emacs-lisp/compat.el: Add stub file with minimal definitions, so that core packages, that haven't been installed from ELPA, can make use of the public API and use more recent function signatures. * lisp/progmodes/python.el (compat): Remove 'noerror flag, because Compat can now be required without the real package being available. * doc/lispref/package.texi (Forwards-Compatibility): Mention Compat and link to the manual. * etc/NEWS: Document change. (Bug#66554) --- doc/lispref/package.texi | 48 +++++++++++++++++++++++++ etc/NEWS | 7 ++++ lisp/emacs-lisp/compat.el | 92 +++++++++++++++++++++++++++++++++++++++++++++++ lisp/progmodes/python.el | 2 +- 4 files changed, 148 insertions(+), 1 deletion(-) create mode 100644 lisp/emacs-lisp/compat.el diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi index f75023d4039..421e64dd5d1 100644 --- a/doc/lispref/package.texi +++ b/doc/lispref/package.texi @@ -28,6 +28,7 @@ these archives). * Multi-file Packages:: How to package multiple files. * Package Archives:: Maintaining package archives. * Archive Web Server:: Interfacing to an archive web server. +* Forwards-Compatibility:: Supporting older versions of Emacs. @end menu @node Packaging Basics @@ -399,3 +400,50 @@ Return the file. This will be the tarball for a multi-file package, or the single file for a simple package. @end table + +@node Forwards-Compatibility +@section Supporting older versions of Emacs +@cindex compatibility compat + +Packages that wish to support older releases of Emacs, without giving +up on newer functionality from recent Emacs releases, one can make use +of the Compat package on GNU ELPA. By depending on the package, Emacs +can provide compatibility definitions for missing functionality. + +The versioning of Compat follows that of Emacs, so next to the oldest +version that a package relies on (via the @code{emacs}-package), one +can also indicate what the newest version of Emacs is, that a package +wishes to use definitions from: + +@example +;; Package-Requires: ((emacs "27.2") (compat "29.1")) +@end example + +Note that Compat provides replacement functions with extended +functionality for functions that are already defined (@code{sort}, +@code{assoc}, @dots{}). These functions may have changed their +calling convention (additional optional arguments) or may have changed +their behavior. These functions must be looked up explicitly with +@code{compat-function} or called explicitly with @code{compat-call}. +We call them @dfn{Extended Definitions}. In contrast, newly @dfn{Added +Definitions} can be called as usual. + +@defmac compat-call fun &rest args +This macro calls the compatibility function @var{fun} with @var{args}. +Many functions provided by Compat can be called directly without this +macro. However in the case where Compat provides an alternative +version of an existing function, the function call has to go through +@code{compat-call}. +@end defmac + +@defmac compat-function fun +This macro returns the compatibility function symbol for @var{fun}. +See @code{compat-call} for a more convenient macro to directly call +compatibility functions. +@end defmac + +For further details on how to make use of the package, see +@ref{Usage,, Usage, compat, "Compat" Manual}. In case you don't have +the manual installed, you can also read the +@url{https://elpa.gnu.org/packages/doc/compat.html#Usage, Online +Compat manual}. diff --git a/etc/NEWS b/etc/NEWS index 5ee1509859b..de1f2fd9d2a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1396,6 +1396,13 @@ This minor mode generates the tags table automatically based on the current project configuration, and later updates it as you edit the files and save the changes. ++++ +** New package Compat +Emacs now comes with a stub implementation of the +forwards-compatibility Compat package from GNU ELPA. This allows +built-in packages to use the library more effectively, and helps +preventing the installation of Compat if unnecessary. + * Incompatible Lisp Changes in Emacs 30.1 diff --git a/lisp/emacs-lisp/compat.el b/lisp/emacs-lisp/compat.el new file mode 100644 index 00000000000..f7037dc4101 --- /dev/null +++ b/lisp/emacs-lisp/compat.el @@ -0,0 +1,92 @@ +;;; compat.el --- Stub of the Compatibility Library -*- lexical-binding: t; -*- + +;; Copyright (C) 2021-2024 Free Software Foundation, Inc. + +;; Author: \ +;; Philip Kaludercic , \ +;; Daniel Mendler +;; Maintainer: \ +;; Daniel Mendler , \ +;; Compat Development <~pkal/compat-devel@lists.sr.ht>, +;; emacs-devel@gnu.org +;; URL: https://github.com/emacs-compat/compat +;; Keywords: lisp, maint + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The Compat package on ELPA provides forward-compatibility +;; definitions for other packages. While mostly transparent, a +;; minimal API is necessary whenever core definitions change calling +;; conventions (e.g. `plist-get' can be invoked with a predicate from +;; Emacs 29.1 onward). For core packages on ELPA to be able to take +;; advantage of this functionality, the macros `compat-function' and +;; `compat-call' have to be available in the core, usable even if +;; users do not have the Compat package installed, which this file +;; ensures. + +;; A basic introduction to Compat is given in the Info node `(elisp) +;; Forwards Compatibility'. Further details on Compat are documented +;; in the Info node `(compat) Top' (installed along with the Compat +;; package) or read the same manual online: +;; https://elpa.gnu.org/packages/doc/compat.html. + +;;; Code: + +(defmacro compat-function (fun) + "Return compatibility function symbol for FUN. +This is a pseudo-compatibility stub for core packages on ELPA, +that depend on the Compat package, whenever the user doesn't have +the package installed on their current system." + `#',fun) + +(defmacro compat-call (fun &rest args) + "Call compatibility function or macro FUN with ARGS. +This is a pseudo-compatibility stub for core packages on ELPA, +that depend on the Compat package, whenever the user doesn't have +the package installed on their current system." + (cons fun args)) + +;;;; Clever trick to avoid installing Compat if not necessary + +;; The versioning scheme of the Compat package follows that of Emacs, +;; to indicate the version of Emacs, that functionality is being +;; provided for. For example, the Compat version number 29.2.3.9 +;; would attempt to provide compatibility definitions up to Emacs +;; 29.2, while also designating that this is the third major release +;; and ninth minor release of Compat, for the specific Emacs release. + +;; The package version of this file is specified programmatically, +;; instead of giving a fixed version in the header of this file. This +;; is done to ensure that the version of compat.el provided by Emacs +;; always corresponds to the current version of Emacs. In addition to +;; the major-minor version, a large "major release" makes sure that +;; the built-in version of Compat is always preferred over an external +;; installation. This means that if a package specifies a dependency +;; on Compat which matches the current or an older version of Emacs +;; that is being used, no additional dependencies have to be +;; downloaded. +;; +;; Further details and background on this file can be found in the +;; bug#66554 discussion. + +;;;###autoload (push (list 'compat +;;;###autoload emacs-major-version +;;;###autoload emacs-minor-version +;;;###autoload 9999) +;;;###autoload package--builtin-versions) + +(provide 'compat) +;;; compat.el ends here diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index b1654b6a5aa..b7e43f3fc68 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -273,7 +273,7 @@ (eval-when-compile (require 'subr-x)) ;For `string-empty-p' and `string-join'. (require 'treesit) (require 'pcase) -(require 'compat nil 'noerror) +(require 'compat) (require 'project nil 'noerror) (require 'seq) -- cgit v1.2.3 From 998f9d98c3b0611b472f4be963d24a96c0a9e197 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 6 Feb 2024 20:12:15 +0100 Subject: Tolerate errors while recompiling all packages * lisp/emacs-lisp/package.el (package-recompile-all): Demote errors raised by 'package-recompile'. (Bug#68678) --- lisp/emacs-lisp/package.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 868373f46c2..fe7b10f569a 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2610,7 +2610,8 @@ This is meant to be used only in the case the byte-compiled files are invalid due to changed byte-code, macros or the like." (interactive) (pcase-dolist (`(_ ,pkg-desc) package-alist) - (package-recompile pkg-desc))) + (with-demoted-errors "Error while recompiling: %S" + (package-recompile pkg-desc)))) ;;;###autoload (defun package-autoremove () -- cgit v1.2.3 From 052c2ce0284c5193c9d6768a45a9b3508af51230 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Feb 2024 17:43:37 -0500 Subject: (pcase): Add buttons to the macros' defs in the docstring of `pcase` * lisp/emacs-lisp/pcase.el (pcase--find-macro-def-regexp): New var. (find-function-regexp-alist): Add entry for `pcase-macro`s. (help-fns--signature): Move declaration to where we know it is valid. (pcase--make-docstring): Add buttons to jump to the definition of Pcase macros. --- lisp/emacs-lisp/pcase.el | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 4754d4e720d..880a1829265 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -163,8 +163,12 @@ Emacs Lisp manual for more information and examples." ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2) expansion)))) -(declare-function help-fns--signature "help-fns" - (function doc real-def real-function buffer)) +(defconst pcase--find-macro-def-regexp "(pcase-defmacro[\s\t\n]+%s[\s\t\n]*(") + +(with-eval-after-load 'find-func + (defvar find-function-regexp-alist) + (add-to-list 'find-function-regexp-alist + `(pcase-macro . pcase--find-macro-def-regexp))) ;; FIXME: Obviously, this will collide with nadvice's use of ;; function-documentation if we happen to advise `pcase'. @@ -174,9 +178,10 @@ Emacs Lisp manual for more information and examples." (defun pcase--make-docstring () (let* ((main (documentation (symbol-function 'pcase) 'raw)) (ud (help-split-fundoc main 'pcase))) - ;; So that eg emacs -Q -l cl-lib --eval "(documentation 'pcase)" works, - ;; where cl-lib is anything using pcase-defmacro. (require 'help-fns) + (declare-function help-fns-short-filename "help-fns" (filename)) + (declare-function help-fns--signature "help-fns" + (function doc real-def real-function buffer)) (with-temp-buffer (insert (or (cdr ud) main)) ;; Presentation Note: For conceptual continuity, we guarantee @@ -197,11 +202,20 @@ Emacs Lisp manual for more information and examples." (let* ((pair (pop more)) (symbol (car pair)) (me (cdr pair)) - (doc (documentation me 'raw))) + (doc (documentation me 'raw)) + (filename (find-lisp-object-file-name me 'defun))) (insert "\n\n-- ") (setq doc (help-fns--signature symbol doc me (indirect-function me) nil)) + (when filename + (save-excursion + (forward-char -1) + (insert (format-message " in `")) + (help-insert-xref-button (help-fns-short-filename filename) + 'help-function-def symbol filename + 'pcase-macro) + (insert (format-message "'.")))) (insert "\n" (or doc "Not documented."))))) (let ((combined-doc (buffer-string))) (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc))))) -- cgit v1.2.3 From 9a1522197fb16986c2f641f777d6bef41c348567 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Feb 2024 18:13:27 -0500 Subject: (cl--generic-describe): Fix regression introduced by fix to bug#54628 Since that fix, we made other changes (put arg names in allcaps) which also happen to fix bug#54628, so we can remove the original fix which was suboptimal when the type includes quotes. * lisp/emacs-lisp/cl-generic.el (cl--generic-describe): Don't rebind `print-quoted` to nil. * test/lisp/emacs-lisp/cl-generic-tests.el (cl-generic-tests--print-quoted): New test. --- lisp/emacs-lisp/cl-generic.el | 5 ++--- test/lisp/emacs-lisp/cl-generic-tests.el | 14 ++++++++++++++ 2 files changed, 16 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index bdccdcc48ce..d1bd45120f1 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1145,7 +1145,7 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." (declare-function help-fns-short-filename "help-fns" (filename)) (let ((generic (if (symbolp function) (cl--generic function)))) (when generic - (require 'help-mode) ;Needed for `help-function-def' button! + (require 'help-mode) ;Needed for `help-function-def' button! (save-excursion ;; Ensure that we have two blank lines (but not more). (unless (looking-back "\n\n" (- (point) 2)) @@ -1157,8 +1157,7 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." (pcase-let* ((`(,qualifiers ,args ,doc) (cl--generic-method-info method))) ;; FIXME: Add hyperlinks for the types as well. - (let ((print-quoted nil) - (quals (if (length> qualifiers 0) + (let ((quals (if (length> qualifiers 0) (concat (substring qualifiers 0 (string-match " *\\'" qualifiers)) diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index 086ac399352..990fa580c54 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el @@ -319,5 +319,19 @@ Edebug symbols (Bug#42672)." (and (eq 'error (car err)) (string-match "Stray.*declare" (cadr err))))))) +(cl-defmethod cl-generic-tests--print-quoted-method ((function (eql '4))) + (+ function 1)) + +(ert-deftest cl-generic-tests--print-quoted () + (with-temp-buffer + (cl--generic-describe 'cl-generic-tests--print-quoted-method) + (goto-char (point-min)) + ;; Bug#54628: We don't want (function (eql '4)) to turn into #'(eql '4) + (should-not (re-search-forward "#'" nil t)) + (goto-char (point-min)) + ;; But we don't want (eql '4) to turn into (eql (quote 4)) either. + (should (re-search-forward "(eql '4)" nil t)))) + + (provide 'cl-generic-tests) ;;; cl-generic-tests.el ends here -- cgit v1.2.3 From 9ebc91795f22ca52ea019b8ce7fb1f6e4c8df826 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 12 Feb 2024 02:38:30 +0100 Subject: Remove redundant `apply` with `derived-mode-p` * lisp/cedet/mode-local.el (mode-local-map-mode-buffers): * lisp/progmodes/which-func.el (which-func-try-to-enable): (which-func-ff-hook): Remove redundant 'apply' with 'derived-mode-p'. Suggested by Philip Kaludercic . --- lisp/cedet/mode-local.el | 4 ++-- lisp/progmodes/which-func.el | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el index 28f14232704..9f11b9707bd 100644 --- a/lisp/cedet/mode-local.el +++ b/lisp/cedet/mode-local.el @@ -1,6 +1,6 @@ ;;; mode-local.el --- Support for mode local facilities -*- lexical-binding:t -*- ;; -;; Copyright (C) 2004-2005, 2007-2024 Free Software Foundation, Inc. +;; Copyright (C) 2004-2024 Free Software Foundation, Inc. ;; ;; Author: David Ponce ;; Created: 27 Apr 2004 @@ -84,7 +84,7 @@ MODES can be a symbol or a list of symbols. FUNCTION does not have arguments." (setq modes (ensure-list modes)) (mode-local-map-file-buffers - function (lambda () (apply #'derived-mode-p modes)))) + function (lambda () (derived-mode-p modes)))) ;;; Hook machinery ;; diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 631cb3b0aef..b36e13104e3 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -211,7 +211,7 @@ non-nil.") (when which-function-mode (unless (local-variable-p 'which-func-mode) (setq which-func-mode (or (eq which-func-modes t) - (apply #'derived-mode-p which-func-modes))) + (derived-mode-p which-func-modes))) (setq which-func--use-mode-line (member which-func-display '(mode mode-and-header))) (setq which-func--use-header-line @@ -239,7 +239,7 @@ It creates the Imenu index for the buffer, if necessary." (condition-case err (if (and which-func-mode - (not (apply #'derived-mode-p which-func-non-auto-modes)) + (not (derived-mode-p which-func-non-auto-modes)) (or (null which-func-maxout) (< buffer-saved-size which-func-maxout) (= which-func-maxout 0))) -- cgit v1.2.3 From 806759dc0a6a3b049ce35d0497011464e5fc4dcb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Feb 2024 22:00:44 -0500 Subject: (pcase): New `_` syntax in pred/app functions The current syntax for functions in `app` and `pred` patterns allows a shorthand (F ARGS) where the object being matched is added as an extra last argument. This is nice for things like (pred (< 5)) but sometimes the object needs to be at another position. Until now you had to use (pred (lambda (x) (memq x my-list))) or (pred (pcase--flip memq my-list)) in those cases. So, introduce a new shorthand where `_` can be used to indicate where the object should be passed: (pred (memq _ my-list)) * lisp/emacs-lisp/pcase.el (pcase--split-pred): Document new syntax for pred/app functions. (pcase--funcall): Support new syntax. (pcase--flip): Declare obsolete. (pcase--u1, \`): Use `_` instead. (pcase--split-pred): Adjust accordingly. * doc/lispref/control.texi (pcase Macro): Document new syntax for pred/app functions. * lisp/progmodes/opascal.el (pcase-defmacro): * lisp/emacs-lisp/seq.el (seq--make-pcase-bindings): * lisp/emacs-lisp/eieio.el (eieio): * lisp/emacs-lisp/cl-macs.el (cl-struct, cl-type): Use _ instead of `pcase--flip`. (cl--pcase-mutually-exclusive-p): Adjust accordingly. * lisp/emacs-lisp/map.el (map--pcase-map-elt): Declare obsolete. (map--make-pcase-bindings): Use `_` instead. --- doc/lispref/control.texi | 10 ++++++++++ etc/NEWS | 4 ++++ lisp/emacs-lisp/cl-macs.el | 15 ++++++++------- lisp/emacs-lisp/eieio.el | 4 ++-- lisp/emacs-lisp/map.el | 7 ++++--- lisp/emacs-lisp/pcase.el | 25 ++++++++++++++++--------- lisp/emacs-lisp/seq.el | 4 ++-- lisp/progmodes/opascal.el | 2 +- 8 files changed, 47 insertions(+), 24 deletions(-) diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 0c6895332a0..78ad5b68a51 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -638,6 +638,16 @@ with @var{n} arguments (the other elements) and an additional Example: @code{(= 42)}@* In this example, the function is @code{=}, @var{n} is one, and the actual function call becomes: @w{@code{(= 42 @var{expval})}}. + +@item function call with an @code{_} arg +Call the function (the first element of the function call) +with the specified arguments (the other elements) and replacing +@code{_} with @var{expval}. + +Example: @code{(gethash _ memo-table)} +In this example, the function is @code{gethash}, and +the actual function call becomes: @w{@code{(gethash @var{expval} +memo-table)}}. @end table @item (app @var{function} @var{pattern}) diff --git a/etc/NEWS b/etc/NEWS index de1f2fd9d2a..afc2c22e68b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1526,6 +1526,10 @@ values. * Lisp Changes in Emacs 30.1 ++++ +** Pcase's functions (in 'pred' and 'app') can specify the argument position. +For example, instead of (pred (< 5)) you can write (pred (> _ 5)). + +++ ** 'define-advice' now sets the new advice's 'name' property to NAME. Named advices defined with 'define-advice' can now be removed with diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 88447203a64..06a09885c88 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3344,14 +3344,14 @@ Elements of FIELDS can be of the form (NAME PAT) in which case the contents of field NAME is matched against PAT, or they can be of the form NAME which is a shorthand for (NAME NAME)." (declare (debug (sexp &rest [&or (sexp pcase-PAT) sexp]))) - `(and (pred (pcase--flip cl-typep ',type)) + `(and (pred (cl-typep _ ',type)) ,@(mapcar (lambda (field) (let* ((name (if (consp field) (car field) field)) (pat (if (consp field) (cadr field) field))) `(app ,(if (eq (cl-struct-sequence-type type) 'list) `(nth ,(cl-struct-slot-offset type name)) - `(pcase--flip aref ,(cl-struct-slot-offset type name))) + `(aref _ ,(cl-struct-slot-offset type name))) ,pat))) fields))) @@ -3368,13 +3368,13 @@ the form NAME which is a shorthand for (NAME NAME)." "Extra special cases for `cl-typep' predicates." (let* ((x1 pred1) (x2 pred2) (t1 - (and (eq 'pcase--flip (car-safe x1)) (setq x1 (cdr x1)) - (eq 'cl-typep (car-safe x1)) (setq x1 (cdr x1)) + (and (eq 'cl-typep (car-safe x1)) (setq x1 (cdr x1)) + (eq '_ (car-safe x1)) (setq x1 (cdr x1)) (null (cdr-safe x1)) (setq x1 (car x1)) (eq 'quote (car-safe x1)) (cadr x1))) (t2 - (and (eq 'pcase--flip (car-safe x2)) (setq x2 (cdr x2)) - (eq 'cl-typep (car-safe x2)) (setq x2 (cdr x2)) + (and (eq 'cl-typep (car-safe x2)) (setq x2 (cdr x2)) + (eq '_ (car-safe x2)) (setq x2 (cdr x2)) (null (cdr-safe x2)) (setq x2 (car x2)) (eq 'quote (car-safe x2)) (cadr x2)))) (or @@ -3818,7 +3818,8 @@ STRUCT-TYPE and SLOT-NAME are symbols. INST is a structure instance." (pcase-defmacro cl-type (type) "Pcase pattern that matches objects of TYPE. TYPE is a type descriptor as accepted by `cl-typep', which see." - `(pred (pcase--flip cl-typep ',type))) + `(pred (cl-typep _ ',type))) + ;; Local variables: ;; generated-autoload-file: "cl-loaddefs.el" diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index df85a64baf3..fba69a36a97 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -387,9 +387,9 @@ contents of field NAME is matched against PAT, or they can be of ,@(mapcar (lambda (field) (pcase-exhaustive field (`(,name ,pat) - `(app (pcase--flip eieio-oref ',name) ,pat)) + `(app (eieio-oref _ ',name) ,pat)) ((pred symbolp) - `(app (pcase--flip eieio-oref ',field) ,field)))) + `(app (eieio-oref _ ',field) ,field)))) fields))) ;;; Simple generators, and query functions. None of these would do diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index ffbb29615da..95a25978d1c 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -608,18 +608,19 @@ This allows using default values for `map-elt', which can't be done using `pcase--flip'. KEY is the key sought in the map. DEFAULT is the default value." + (declare (obsolete _ "30.1")) `(map-elt ,map ,key ,default)) (defun map--make-pcase-bindings (args) "Return a list of pcase bindings from ARGS to the elements of a map." (mapcar (lambda (elt) (cond ((consp elt) - `(app (map--pcase-map-elt ,(car elt) ,(caddr elt)) + `(app (map-elt _ ,(car elt) ,(caddr elt)) ,(cadr elt))) ((keywordp elt) (let ((var (intern (substring (symbol-name elt) 1)))) - `(app (pcase--flip map-elt ,elt) ,var))) - (t `(app (pcase--flip map-elt ',elt) ,elt)))) + `(app (map-elt _ ,elt) ,var))) + (t `(app (map-elt _ ',elt) ,elt)))) args)) (defun map--make-pcase-patterns (args) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 880a1829265..ae9bd87997c 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -131,6 +131,8 @@ FUN in `pred' and `app' can take one of the forms: call it with one argument (F ARG1 .. ARGn) call F with ARG1..ARGn and EXPVAL as n+1'th argument + (F ARG1 .. _ .. ARGn) + call F, passing EXPVAL at the _ position. FUN, BOOLEXP, and subsequent PAT can refer to variables bound earlier in the pattern by a SYMBOL pattern. @@ -814,10 +816,10 @@ A and B can be one of: #'compiled-function-p)))) (pcase--mutually-exclusive-p (cadr upat) otherpred)) '(:pcase--fail . nil)) - ;; Since we turn (or 'a 'b 'c) into (pred (pcase--flip (memq '(a b c)))) + ;; Since we turn (or 'a 'b 'c) into (pred (memq _ '(a b c))) ;; try and preserve the info we get from that memq test. - ((and (eq 'pcase--flip (car-safe (cadr upat))) - (memq (cadr (cadr upat)) '(memq member memql)) + ((and (memq (car-safe (cadr upat)) '(memq member memql)) + (eq (cadr (cadr upat)) '_) (eq 'quote (car-safe (nth 2 (cadr upat)))) (eq 'quote (car-safe pat))) (let ((set (cadr (nth 2 (cadr upat))))) @@ -865,7 +867,7 @@ A and B can be one of: (defmacro pcase--flip (fun arg1 arg2) "Helper function, used internally to avoid (funcall (lambda ...) ...)." - (declare (debug (sexp body))) + (declare (debug (sexp body)) (obsolete _ "30.1")) `(,fun ,arg2 ,arg1)) (defun pcase--funcall (fun arg vars) @@ -886,9 +888,13 @@ A and B can be one of: (let ((newsym (gensym "x"))) (push (list newsym arg) env) (setq arg newsym))) - (if (or (functionp fun) (not (consp fun))) - `(funcall #',fun ,arg) - `(,@fun ,arg))))) + (cond + ((or (functionp fun) (not (consp fun))) + `(funcall #',fun ,arg)) + ((memq '_ fun) + (mapcar (lambda (x) (if (eq '_ x) arg x)) fun)) + (t + `(,@fun ,arg)))))) (if (null env) call ;; Let's not replace `vars' in `fun' since it's @@ -949,7 +955,7 @@ Otherwise, it defers to REST which is a list of branches of the form ;; Yes, we can use `memql' (or `member')! ((> (length simples) 1) (pcase--u1 (cons `(match ,var - . (pred (pcase--flip ,mem-fun ',simples))) + . (pred (,mem-fun _ ',simples))) (cdr matches)) code vars (if (null others) rest @@ -1096,12 +1102,13 @@ The predicate is the logical-AND of: (declare (debug (pcase-QPAT))) (cond ((eq (car-safe qpat) '\,) (cadr qpat)) + ((eq (car-safe qpat) '\,@) (error "Unsupported QPAT: %S" qpat)) ((vectorp qpat) `(and (pred vectorp) (app length ,(length qpat)) ,@(let ((upats nil)) (dotimes (i (length qpat)) - (push `(app (pcase--flip aref ,i) ,(list '\` (aref qpat i))) + (push `(app (aref _ ,i) ,(list '\` (aref qpat i))) upats)) (nreverse upats)))) ((consp qpat) diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 4c6553972c2..20077db9e60 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -619,12 +619,12 @@ SEQUENCE must be a sequence of numbers or markers." (unless rest-marker (pcase name (`&rest - (progn (push `(app (pcase--flip seq-drop ,index) + (progn (push `(app (seq-drop _ ,index) ,(seq--elt-safe args (1+ index))) bindings) (setq rest-marker t))) (_ - (push `(app (pcase--flip seq--elt-safe ,index) ,name) bindings)))) + (push `(app (seq--elt-safe _ ,index) ,name) bindings)))) (setq index (1+ index))) bindings)) diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el index 5e8263cb646..a80e12b8129 100644 --- a/lisp/progmodes/opascal.el +++ b/lisp/progmodes/opascal.el @@ -281,7 +281,7 @@ nested routine.") (eval-when-compile (pcase-defmacro opascal--in (set) - `(pred (pcase--flip memq ,set)))) + `(pred (memq _ ,set)))) (defun opascal-string-of (start end) ;; Returns the buffer string from start to end. -- cgit v1.2.3 From 57544fa2a2e1f2d04aa6b6bdf49bde71141b945d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Feb 2024 22:19:49 -0500 Subject: loaddefs-gen.el: Generate an autoload for `pcase-defmacro` Autoload cookies on uses of `pcase-defmacro` used to copy the definition wholesale instead of generating the expected autoload. * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--make-autoload): Look inside `eval-and-compile` as well. --- lisp/emacs-lisp/loaddefs-gen.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 1e91e84157d..238ec9d179b 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -183,7 +183,9 @@ expression, in which case we want to handle forms differently." (loaddefs-generate--shorten-autoload `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type)))) - ((and expansion (memq car '(progn prog1))) + ;; Look inside `progn', and `eval-and-compile', since these + ;; are often used in the expansion of things like `pcase-defmacro'. + ((and expansion (memq car '(progn prog1 eval-and-compile))) (let ((end (memq :autoload-end form))) (when end ;Cut-off anything after the :autoload-end marker. (setq form (copy-sequence form)) -- cgit v1.2.3 From bc6c55c5cf3fc5bd248232c6332ea7cca19ffe91 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 12 Feb 2024 11:16:47 +0800 Subject: Disable exec loader when Emacs is running under an existing instance * src/androidfns.c (syms_of_androidfns_for_pdumper): Check if Emacs is running under process tracing, and if so, disable android_use_exec_loader. --- src/androidfns.c | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/src/androidfns.c b/src/androidfns.c index 48c3f3046d6..ea3d5f71c7c 100644 --- a/src/androidfns.c +++ b/src/androidfns.c @@ -3216,6 +3216,10 @@ syms_of_androidfns_for_pdumper (void) jstring string; Lisp_Object language, country, script, variant; const char *data; + FILE *fd; + char *line; + size_t size; + long pid; /* Find the Locale class. */ @@ -3386,6 +3390,35 @@ syms_of_androidfns_for_pdumper (void) /* Set Vandroid_os_language. */ Vandroid_os_language = list4 (language, country, script, variant); + + /* Detect whether Emacs is running under libloader.so or another + process tracing mechanism, and disable `android_use_exec_loader' if + so, leaving subprocesses started by Emacs to the care of that + loader instance. */ + + if (android_get_current_api_level () >= 29) /* Q */ + { + fd = fopen ("/proc/self/status", "r"); + if (!fd) + return; + + line = NULL; + while (getline (&line, &size, fd) != -1) + { + if (strncmp (line, "TracerPid:", sizeof "TracerPid:" - 1)) + continue; + + pid = atol (line + sizeof "TracerPid:" - 1); + + if (pid) + android_use_exec_loader = false; + + break; + } + + free (line); + fclose (fd); + } } #endif /* ANDROID_STUBIFY */ -- cgit v1.2.3 From 2f7d662dd4636a84e157a2af8f843c0589bc5dda Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Mon, 12 Feb 2024 12:07:37 +0100 Subject: ; Update Lisp_Hash_Table hash for CHECK_STRUCTS This follows commit 05e3183ede of 2024-02-06 "Rearrange and pack hash table fields to reduce space". --- src/pdumper.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/pdumper.c b/src/pdumper.c index b8006b035ea..5c488d8e90f 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2719,7 +2719,7 @@ dump_hash_table_contents (struct dump_context *ctx, struct Lisp_Hash_Table *h) static dump_off dump_hash_table (struct dump_context *ctx, Lisp_Object object) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_313A489F0A +#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_0360833954 # error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object); -- cgit v1.2.3 From 17a395e04c62d6c6c3f3ff4c4889f03e427e00d3 Mon Sep 17 00:00:00 2001 From: Daniel Martín Date: Mon, 12 Feb 2024 13:21:08 +0100 Subject: ;; Fix typo in the Tramp documentation --- doc/misc/tramp.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index d6031d96d6b..db9cefbf966 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -522,7 +522,7 @@ is used as the group to change to. The default host name is the same. @cindex @option{doas} method If the @option{su}, @option{sudo} or @option{doas} option should be -performed on another host, it can be comnbined with a leading +performed on another host, it can be combined with a leading @option{ssh} or @option{plink} option. That means that @value{tramp} connects first to the other host with non-administrative credentials, and changes to administrative credentials on that host afterwards. In -- cgit v1.2.3 From 6aeeae68885e09a7253a0076d0f81cc46b37f20d Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Mon, 12 Feb 2024 17:37:16 +0100 Subject: Allow using 'vc-prepare-patch' in non-VC buffers * lisp/vc/vc.el (vc-prepare-patch): Remove 'vc-ensure-vc-buffer', as it is not necessary to verify this for the command to work. --- lisp/vc/vc.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index f612daaa569..ca6efeabac2 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3639,7 +3639,6 @@ marked revisions, use those." (read-string "Subject: " "[PATCH] " nil nil t)) revs))) (save-current-buffer - (vc-ensure-vc-buffer) (let ((patches (mapcar (lambda (rev) (vc-call-backend (vc-responsible-backend default-directory) -- cgit v1.2.3 From 79cfc1eaa0b93f49559d74b6f7a76bf97e70ad2a Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Wed, 7 Feb 2024 21:50:03 +0100 Subject: Internal function for obarray performance analysis (bug#68244) * src/lread.c (Finternal__obarray_buckets): New function. --- src/lread.c | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/src/lread.c b/src/lread.c index 5aa7466cc12..8f355547268 100644 --- a/src/lread.c +++ b/src/lread.c @@ -5296,6 +5296,32 @@ OBARRAY defaults to the value of `obarray'. */) return Qnil; } +DEFUN ("internal--obarray-buckets", + Finternal__obarray_buckets, Sinternal__obarray_buckets, 1, 1, 0, + doc: /* Symbols in each bucket of OBARRAY. Internal use only. */) + (Lisp_Object obarray) +{ + obarray = check_obarray (obarray); + ptrdiff_t size = ASIZE (obarray); + Lisp_Object ret = Qnil; + for (ptrdiff_t i = 0; i < size; i++) + { + Lisp_Object bucket = Qnil; + Lisp_Object sym = AREF (obarray, i); + if (BARE_SYMBOL_P (sym)) + while (1) + { + bucket = Fcons (sym, bucket); + struct Lisp_Symbol *s = XBARE_SYMBOL(sym)->u.s.next; + if (!s) + break; + sym = make_lisp_symbol (s); + } + ret = Fcons (Fnreverse (bucket), ret); + } + return Fnreverse (ret); +} + #define OBARRAY_SIZE 15121 void @@ -5693,6 +5719,7 @@ syms_of_lread (void) defsubr (&Sget_file_char); defsubr (&Smapatoms); defsubr (&Slocate_file_internal); + defsubr (&Sinternal__obarray_buckets); DEFVAR_LISP ("obarray", Vobarray, doc: /* Symbol table for use by `intern' and `read'. -- cgit v1.2.3 From bb77944306d3fbbbdf61ba4f3c9ef1bcb9b4b989 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 8 Feb 2024 19:04:23 +0100 Subject: Make minibuf-tests independent of obarray hash order * test/src/minibuf-tests.el (minibuf-tests--set-equal): New. (minibuf-tests--all-completions) (minibuf-tests--all-completions-pred) (minibuf-tests--all-completions-regexp): Use it. --- test/src/minibuf-tests.el | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el index 14d160df25c..cb305ca0e55 100644 --- a/test/src/minibuf-tests.el +++ b/test/src/minibuf-tests.el @@ -61,6 +61,9 @@ ;;; Testing functions that are agnostic to type of COLLECTION. +(defun minibuf-tests--set-equal (a b) + (null (cl-set-exclusive-or a b :test #'equal))) + (defun minibuf-tests--try-completion (xform-collection) (let* ((abcdef (funcall xform-collection '("abc" "def"))) (+abba (funcall xform-collection '("abc" "abba" "def")))) @@ -101,7 +104,8 @@ (let* ((abcdef (funcall xform-collection '("abc" "def"))) (+abba (funcall xform-collection '("abc" "abba" "def")))) (should (equal (all-completions "a" abcdef) '("abc"))) - (should (equal (all-completions "a" +abba) '("abc" "abba"))) + (should (minibuf-tests--set-equal (all-completions "a" +abba) + '("abc" "abba"))) (should (equal (all-completions "abc" +abba) '("abc"))) (should (equal (all-completions "abcd" +abba) nil)))) @@ -111,7 +115,8 @@ (+abba (funcall xform-collection '("abc" "abba" "def"))) (+abba-member (funcall collection-member +abba))) (should (equal (all-completions "a" abcdef abcdef-member) '("abc"))) - (should (equal (all-completions "a" +abba +abba-member) '("abc" "abba"))) + (should (minibuf-tests--set-equal (all-completions "a" +abba +abba-member) + '("abc" "abba"))) (should (equal (all-completions "abc" +abba +abba-member) '("abc"))) (should (equal (all-completions "abcd" +abba +abba-member) nil)) (should-not (all-completions "a" abcdef #'ignore)) @@ -124,7 +129,8 @@ (+abba (funcall xform-collection '("abc" "abba" "def")))) (let ((completion-regexp-list '("."))) (should (equal (all-completions "a" abcdef) '("abc"))) - (should (equal (all-completions "a" +abba) '("abc" "abba"))) + (should (minibuf-tests--set-equal (all-completions "a" +abba) + '("abc" "abba"))) (should (equal (all-completions "abc" +abba) '("abc"))) (should (equal (all-completions "abcd" +abba) nil))) (let ((completion-regexp-list '("X"))) -- cgit v1.2.3 From 39cce137ba83713c960c201d8c3d8cf5079eee3b Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 8 Feb 2024 14:11:02 +0100 Subject: lread.c: Use bare symbol operations * src/lread.c (read0, intern_sym, intern_driver, intern_1) (intern_c_string_1, Fintern, Fintern_soft, Funintern, oblookup) (map_obarray, init_obarray_once, defvar_int, defvar_bool) (defvar_lisp_nopro, defvar_kboard, syms_of_lread): Use the faster bare-symbol operations where provably correct to do so. --- src/lread.c | 124 +++++++++++++++++++++++++++++------------------------------- 1 file changed, 59 insertions(+), 65 deletions(-) diff --git a/src/lread.c b/src/lread.c index 8f355547268..db8c4813426 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4480,7 +4480,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) &longhand_chars, &longhand_bytes); - if (SYMBOLP (found)) + if (BARE_SYMBOL_P (found)) result = found; else if (longhand) { @@ -4910,24 +4910,23 @@ check_obarray (Lisp_Object obarray) static Lisp_Object intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) { - Lisp_Object *ptr; + struct Lisp_Symbol *s = XBARE_SYMBOL (sym); + s->u.s.interned = (BASE_EQ (obarray, initial_obarray) + ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY + : SYMBOL_INTERNED); - XSYMBOL (sym)->u.s.interned = (EQ (obarray, initial_obarray) - ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY - : SYMBOL_INTERNED); - - if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray)) + if (SREF (s->u.s.name, 0) == ':' && BASE_EQ (obarray, initial_obarray)) { - make_symbol_constant (sym); - XSYMBOL (sym)->u.s.redirect = SYMBOL_PLAINVAL; + s->u.s.trapped_write = SYMBOL_NOWRITE; + s->u.s.redirect = SYMBOL_PLAINVAL; /* Mark keywords as special. This makes (let ((:key 'foo)) ...) in lexically bound elisp signal an error, as documented. */ - XSYMBOL (sym)->u.s.declared_special = true; - SET_SYMBOL_VAL (XSYMBOL (sym), sym); + s->u.s.declared_special = true; + SET_SYMBOL_VAL (s, sym); } - ptr = aref_addr (obarray, XFIXNUM (index)); - set_symbol_next (sym, SYMBOLP (*ptr) ? XSYMBOL (*ptr) : NULL); + Lisp_Object *ptr = aref_addr (obarray, XFIXNUM (index)); + s->u.s.next = BARE_SYMBOL_P (*ptr) ? XBARE_SYMBOL (*ptr) : NULL; *ptr = sym; return sym; } @@ -4937,7 +4936,7 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) Lisp_Object intern_driver (Lisp_Object string, Lisp_Object obarray, Lisp_Object index) { - SET_SYMBOL_VAL (XSYMBOL (Qobarray_cache), Qnil); + SET_SYMBOL_VAL (XBARE_SYMBOL (Qobarray_cache), Qnil); return intern_sym (Fmake_symbol (string), obarray, index); } @@ -4950,7 +4949,7 @@ intern_1 (const char *str, ptrdiff_t len) Lisp_Object obarray = check_obarray (Vobarray); Lisp_Object tem = oblookup (obarray, str, len, len); - return (SYMBOLP (tem) ? tem + return (BARE_SYMBOL_P (tem) ? tem /* The above `oblookup' was done on the basis of nchars==nbytes, so the string has to be unibyte. */ : intern_driver (make_unibyte_string (str, len), @@ -4963,7 +4962,7 @@ intern_c_string_1 (const char *str, ptrdiff_t len) Lisp_Object obarray = check_obarray (Vobarray); Lisp_Object tem = oblookup (obarray, str, len, len); - if (!SYMBOLP (tem)) + if (!BARE_SYMBOL_P (tem)) { Lisp_Object string; @@ -5015,7 +5014,7 @@ it defaults to the value of `obarray'. */) &longhand, &longhand_chars, &longhand_bytes); - if (!SYMBOLP (tem)) + if (!BARE_SYMBOL_P (tem)) { if (longhand) { @@ -5064,10 +5063,10 @@ it defaults to the value of `obarray'. */) { /* If already a symbol, we don't do shorthand-longhand translation, as promised in the docstring. */ - string = SYMBOL_NAME (name); + string = XSYMBOL (name)->u.s.name; tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); - return EQ (name, tem) ? name : Qnil; + return BASE2_EQ (name, tem) ? name : Qnil; } } @@ -5088,7 +5087,11 @@ usage: (unintern NAME OBARRAY) */) obarray = check_obarray (obarray); if (SYMBOLP (name)) - string = SYMBOL_NAME (name); + { + if (!BARE_SYMBOL_P (name)) + name = XSYMBOL_WITH_POS (name)->sym; + string = SYMBOL_NAME (name); + } else { CHECK_STRING (name); @@ -5108,7 +5111,7 @@ usage: (unintern NAME OBARRAY) */) if (FIXNUMP (tem)) return Qnil; /* If arg was a symbol, don't delete anything but that symbol itself. */ - if (SYMBOLP (name) && !EQ (name, tem)) + if (BARE_SYMBOL_P (name) && !BASE_EQ (name, tem)) return Qnil; /* There are plenty of other symbols which will screw up the Emacs @@ -5118,16 +5121,16 @@ usage: (unintern NAME OBARRAY) */) /* if (NILP (tem) || EQ (tem, Qt)) error ("Attempt to unintern t or nil"); */ - XSYMBOL (tem)->u.s.interned = SYMBOL_UNINTERNED; + XBARE_SYMBOL (tem)->u.s.interned = SYMBOL_UNINTERNED; hash = oblookup_last_bucket_number; - if (EQ (AREF (obarray, hash), tem)) + if (BASE_EQ (AREF (obarray, hash), tem)) { - if (XSYMBOL (tem)->u.s.next) + if (XBARE_SYMBOL (tem)->u.s.next) { Lisp_Object sym; - XSETSYMBOL (sym, XSYMBOL (tem)->u.s.next); + XSETSYMBOL (sym, XBARE_SYMBOL (tem)->u.s.next); ASET (obarray, hash, sym); } else @@ -5138,13 +5141,13 @@ usage: (unintern NAME OBARRAY) */) Lisp_Object tail, following; for (tail = AREF (obarray, hash); - XSYMBOL (tail)->u.s.next; + XBARE_SYMBOL (tail)->u.s.next; tail = following) { - XSETSYMBOL (following, XSYMBOL (tail)->u.s.next); - if (EQ (following, tem)) + XSETSYMBOL (following, XBARE_SYMBOL (tail)->u.s.next); + if (BASE_EQ (following, tem)) { - set_symbol_next (tail, XSYMBOL (following)->u.s.next); + set_symbol_next (tail, XBARE_SYMBOL (following)->u.s.next); break; } } @@ -5176,18 +5179,19 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff oblookup_last_bucket_number = hash; if (BASE_EQ (bucket, make_fixnum (0))) ; - else if (!SYMBOLP (bucket)) + else if (!BARE_SYMBOL_P (bucket)) /* Like CADR error message. */ xsignal2 (Qwrong_type_argument, Qobarrayp, build_string ("Bad data in guts of obarray")); else - for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next)) + for (tail = bucket; ; XSETSYMBOL (tail, XBARE_SYMBOL (tail)->u.s.next)) { - if (SBYTES (SYMBOL_NAME (tail)) == size_byte - && SCHARS (SYMBOL_NAME (tail)) == size - && !memcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte)) + Lisp_Object name = XBARE_SYMBOL (tail)->u.s.name; + if (SBYTES (name) == size_byte + && SCHARS (name) == size + && !memcmp (SDATA (name), ptr, size_byte)) return tail; - else if (XSYMBOL (tail)->u.s.next == 0) + else if (XBARE_SYMBOL (tail)->u.s.next == 0) break; } XSETINT (tem, hash); @@ -5267,13 +5271,13 @@ map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Ob for (i = ASIZE (obarray) - 1; i >= 0; i--) { tail = AREF (obarray, i); - if (SYMBOLP (tail)) + if (BARE_SYMBOL_P (tail)) while (1) { (*fn) (tail, arg); - if (XSYMBOL (tail)->u.s.next == 0) + if (XBARE_SYMBOL (tail)->u.s.next == 0) break; - XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next); + XSETSYMBOL (tail, XBARE_SYMBOL (tail)->u.s.next); } } } @@ -5337,14 +5341,14 @@ init_obarray_once (void) DEFSYM (Qunbound, "unbound"); DEFSYM (Qnil, "nil"); - SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); + SET_SYMBOL_VAL (XBARE_SYMBOL (Qnil), Qnil); make_symbol_constant (Qnil); - XSYMBOL (Qnil)->u.s.declared_special = true; + XBARE_SYMBOL (Qnil)->u.s.declared_special = true; DEFSYM (Qt, "t"); - SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); + SET_SYMBOL_VAL (XBARE_SYMBOL (Qt), Qt); make_symbol_constant (Qt); - XSYMBOL (Qt)->u.s.declared_special = true; + XBARE_SYMBOL (Qt)->u.s.declared_special = true; /* Qt is correct even if not dumping. loadup.el will set to nil at end. */ Vpurify_flag = Qt; @@ -5368,16 +5372,6 @@ defsubr (union Aligned_Lisp_Subr *aname) #endif } -#ifdef NOTDEF /* Use fset in subr.el now! */ -void -defalias (struct Lisp_Subr *sname, char *string) -{ - Lisp_Object sym; - sym = intern (string); - XSETSUBR (XSYMBOL (sym)->u.s.function, sname); -} -#endif /* NOTDEF */ - /* Define an "integer variable"; a symbol whose value is forwarded to a C variable of type intmax_t. Sample call (with "xx" to fool make-docfile): DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */ @@ -5385,9 +5379,9 @@ void defvar_int (struct Lisp_Intfwd const *i_fwd, char const *namestring) { Lisp_Object sym = intern_c_string (namestring); - XSYMBOL (sym)->u.s.declared_special = true; - XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; - SET_SYMBOL_FWD (XSYMBOL (sym), i_fwd); + XBARE_SYMBOL (sym)->u.s.declared_special = true; + XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; + SET_SYMBOL_FWD (XBARE_SYMBOL (sym), i_fwd); } /* Similar but define a variable whose value is t if 1, nil if 0. */ @@ -5395,9 +5389,9 @@ void defvar_bool (struct Lisp_Boolfwd const *b_fwd, char const *namestring) { Lisp_Object sym = intern_c_string (namestring); - XSYMBOL (sym)->u.s.declared_special = true; - XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; - SET_SYMBOL_FWD (XSYMBOL (sym), b_fwd); + XBARE_SYMBOL (sym)->u.s.declared_special = true; + XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; + SET_SYMBOL_FWD (XBARE_SYMBOL (sym), b_fwd); Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars); } @@ -5410,9 +5404,9 @@ void defvar_lisp_nopro (struct Lisp_Objfwd const *o_fwd, char const *namestring) { Lisp_Object sym = intern_c_string (namestring); - XSYMBOL (sym)->u.s.declared_special = true; - XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; - SET_SYMBOL_FWD (XSYMBOL (sym), o_fwd); + XBARE_SYMBOL (sym)->u.s.declared_special = true; + XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; + SET_SYMBOL_FWD (XBARE_SYMBOL (sym), o_fwd); } void @@ -5429,9 +5423,9 @@ void defvar_kboard (struct Lisp_Kboard_Objfwd const *ko_fwd, char const *namestring) { Lisp_Object sym = intern_c_string (namestring); - XSYMBOL (sym)->u.s.declared_special = true; - XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; - SET_SYMBOL_FWD (XSYMBOL (sym), ko_fwd); + XBARE_SYMBOL (sym)->u.s.declared_special = true; + XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; + SET_SYMBOL_FWD (XBARE_SYMBOL (sym), ko_fwd); } /* Check that the elements of lpath exist. */ @@ -5731,7 +5725,7 @@ to find all the symbols in an obarray, use `mapatoms'. */); doc: /* List of values of all expressions which were read, evaluated and printed. Order is reverse chronological. This variable is obsolete as of Emacs 28.1 and should not be used. */); - XSYMBOL (intern ("values"))->u.s.declared_special = false; + XBARE_SYMBOL (intern ("values"))->u.s.declared_special = false; DEFVAR_LISP ("standard-input", Vstandard_input, doc: /* Stream for read to get input from. -- cgit v1.2.3 From 3b90e5052ce1eea47430c85c0c35741e25269ce2 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 12 Feb 2024 20:16:35 +0200 Subject: Tree-sitter support for outline-minor-mode (bug#68824) * doc/emacs/text.texi (Outline Format): Add 'outline-search-function'. * doc/lispref/elisp.texi (Top): Add new menu item "Outline Minor Mode" after "Imenu". * doc/lispref/modes.texi (Modes): Add new menu item "Outline Minor Mode" after "Imenu". (Major Mode Conventions): Mention "Outline Minor Mode" with @pxref. (Outline Minor Mode): New node. * doc/lispref/parsing.texi (Tree-sitter Major Modes): Mention 'treesit-outline-predicate' with @pxref. * lisp/treesit.el (treesit-outline-predicate): New buffer-local variable. (treesit-outline-predicate--from-imenu): New internal function. (treesit-outline-search, treesit-outline-level): New functions. (treesit-major-mode-setup): Set up treesit-outline-predicate, outline-search-function and outline-level. * lisp/progmodes/c-ts-mode.el (c-ts-mode--outline-predicate): New internal function. (c-ts-base-mode): Set 'treesit-outline-predicate' to 'c-ts-mode--outline-predicate'. * lisp/progmodes/heex-ts-mode.el (heex-ts-mode): Kill inherited local variables 'outline-heading-end-regexp', 'outline-regexp', 'outline-level'. * lisp/progmodes/lua-ts-mode.el (lua-ts-mode): Remove 'outline-regexp'. Suggested by john muhl . * lisp/textmodes/html-ts-mode.el (html-ts-mode): Kill inherited local variables 'outline-heading-end-regexp', 'outline-regexp', 'outline-level'. --- doc/emacs/text.texi | 6 ++++ doc/lispref/elisp.texi | 1 + doc/lispref/modes.texi | 62 ++++++++++++++++++++++++++++++++++ doc/lispref/parsing.texi | 4 +++ etc/NEWS | 7 ++++ lisp/progmodes/c-ts-mode.el | 15 +++++++++ lisp/progmodes/heex-ts-mode.el | 10 ++++++ lisp/progmodes/lua-ts-mode.el | 12 +------ lisp/textmodes/html-ts-mode.el | 11 ++++++ lisp/treesit.el | 76 ++++++++++++++++++++++++++++++++++++++++++ 10 files changed, 193 insertions(+), 11 deletions(-) diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index 338bf014208..cb347d59948 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -1097,6 +1097,12 @@ so that Outline mode will know that sections are contained in chapters. This works as long as no other command starts with @samp{@@chap}. +@vindex outline-search-function + Instead of setting the variable @code{outline-regexp}, you can set +the variable @code{outline-search-function} to a function that +matches the current heading and searches for the next one +(@pxref{Outline Minor Mode,,,elisp, the Emacs Lisp Reference Manual}). + @vindex outline-level You can explicitly specify a rule for calculating the level of a heading line by setting the variable @code{outline-level}. The value diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index cab1622337e..ed254795d90 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -883,6 +883,7 @@ Major and Minor Modes * Minor Modes:: Defining minor modes. * Mode Line Format:: Customizing the text that appears in the mode line. * Imenu:: Providing a menu of definitions made in a buffer. +* Outline Minor Mode:: Outline mode to use with other major modes. * Font Lock Mode:: How modes can highlight text according to syntax. * Auto-Indentation:: How to teach Emacs to indent for a major mode. * Desktop Save Mode:: How modes can have buffer state saved between diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 1d961249633..70d1a40f836 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -25,6 +25,7 @@ user. For related topics such as keymaps and syntax tables, see * Minor Modes:: Defining minor modes. * Mode Line Format:: Customizing the text that appears in the mode line. * Imenu:: Providing a menu of definitions made in a buffer. +* Outline Minor Mode:: Outline mode to use with other major modes. * Font Lock Mode:: How modes can highlight text according to syntax. * Auto-Indentation:: How to teach Emacs to indent for a major mode. * Desktop Save Mode:: How modes can have buffer state saved between @@ -507,6 +508,12 @@ variable @code{imenu-generic-expression}, for the two variables @code{imenu-extract-index-name-function}, or for the variable @code{imenu-create-index-function} (@pxref{Imenu}). +@item +The mode should specify how Outline minor mode should find the +heading lines, by setting up a buffer-local value for the variables +@code{outline-regexp} or @code{outline-search-function}, and also +for the variable @code{outline-level} (@pxref{Outline Minor Mode}). + @item The mode can tell ElDoc mode how to retrieve different types of documentation for whatever is at point, by adding one or more @@ -2994,6 +3001,61 @@ instead. automatically sets up Imenu if this variable is non-@code{nil}. @end defvar +@node Outline Minor Mode +@section Outline Minor Mode + +@cindex Outline minor mode + @dfn{Outline minor mode} is a buffer-local minor mode that hides +parts of the buffer and leaves only heading lines visible. +This minor mode can be used in conjunction with other major modes +(@pxref{Outline Minor Mode,, Outline Minor Mode, emacs, the Emacs Manual}). + + There are two ways to define which lines are headings: with the +variable @code{outline-regexp} or @code{outline-search-function}. + +@defvar outline-regexp +This variable is a regular expression. +Any line whose beginning has a match for this regexp is considered a +heading line. Matches that start within a line (not at the left +margin) do not count. +@end defvar + +@defvar outline-search-function +Alternatively, when it's impossible to create a regexp that +matches heading lines, you can define a function that helps +Outline minor mode to find heading lines. + +The variable @code{outline-search-function} specifies the function with +four arguments: @var{bound}, @var{move}, @var{backward}, and +@var{looking-at}. The function completes two tasks: to match the +current heading line, and to find the next or the previous heading line. +If the argument @var{looking-at} is non-@code{nil}, it should return +non-@code{nil} when point is at the beginning of the outline header line. +If the argument @var{looking-at} is @code{nil}, the first three arguments +are used. The argument @var{bound} is a buffer position that bounds +the search. The match found must not end after that position. A +value of nil means search to the end of the accessible portion of +the buffer. If the argument @var{move} is non-@code{nil}, the +failed search should move to the limit of search and return nil. +If the argument @var{backward} is non-@code{nil}, this function +should search for the previous heading backward. +@end defvar + +@defvar outline-level +This variable is a function that takes no arguments +and should return the level of the current heading. +It's required in both cases: whether you define +@code{outline-regexp} or @code{outline-search-function}. +@end defvar + +If built with tree-sitter, Emacs can automatically use +Outline minor mode if the major mode sets the following variable. + +@defvar treesit-outline-predicate +This variable instructs Emacs how to find lines with outline headings. +It should be a predicate that matches the node on the heading line. +@end defvar + @node Font Lock Mode @section Font Lock Mode @cindex Font Lock mode diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index d685b7f32dc..3d2192ace64 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -1897,6 +1897,10 @@ add-log functions used by @code{add-log-current-defun}. @item If @code{treesit-simple-imenu-settings} (@pxref{Imenu}) is non-@code{nil}, it sets up Imenu. + +@item +If @code{treesit-outline-predicate} (@pxref{Outline Minor Mode}) is +non-@code{nil}, it sets up Outline minor mode. @end itemize @c TODO: Add treesit-thing-settings stuff once we finalize it. diff --git a/etc/NEWS b/etc/NEWS index afc2c22e68b..f89c8ce1d8d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -130,6 +130,13 @@ the signature) the automatically inferred function type as well. This user option controls outline visibility in the output buffer of 'describe-bindings' when 'describe-bindings-outline' is non-nil. +** Outline Mode + ++++ +*** 'outline-minor-mode' is supported in tree-sitter major modes. +It can be used in all tree-sitter major modes that set either the +variable 'treesit-simple-imenu-settings' or 'treesit-outline-predicate'. + ** X selection requests are now handled much faster and asynchronously. This means it should be less necessary to disable the likes of 'select-active-regions' when Emacs is running over a slow network diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index e5835bdb62d..c4b48f03d12 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -922,6 +922,17 @@ Return nil if NODE is not a defun node or doesn't have a name." name))) t)) +;;; Outline minor mode + +(defun c-ts-mode--outline-predicate (node) + "Match outlines on lines with function names." + (and (treesit-node-match-p + node "\\`function_declarator\\'" t) + (when-let ((parent (treesit-node-parent node))) + (treesit-node-match-p + parent + "\\`function_definition\\'" t)))) + ;;; Defun navigation (defun c-ts-mode--defun-valid-p (node) @@ -1259,6 +1270,10 @@ BEG and END are described in `treesit-range-rules'." eos) c-ts-mode--defun-for-class-in-imenu-p nil)))) + ;; Outline minor mode + (setq-local treesit-outline-predicate + #'c-ts-mode--outline-predicate) + (setq-local treesit-font-lock-feature-list c-ts-mode--feature-list)) diff --git a/lisp/progmodes/heex-ts-mode.el b/lisp/progmodes/heex-ts-mode.el index 7b53a44deb2..22e8956661d 100644 --- a/lisp/progmodes/heex-ts-mode.el +++ b/lisp/progmodes/heex-ts-mode.el @@ -166,6 +166,16 @@ With ARG, do it many times. Negative ARG means move backward." ("Slot" "\\`slot\\'" nil nil) ("Tag" "\\`tag\\'" nil nil))) + ;; Outline minor mode + ;; `heex-ts-mode' inherits from `html-mode' that sets + ;; regexp-based outline variables. So need to restore + ;; the default values of outline variables to be able + ;; to use `treesit-outline-predicate' derived + ;; from `treesit-simple-imenu-settings' above. + (kill-local-variable 'outline-heading-end-regexp) + (kill-local-variable 'outline-regexp) + (kill-local-variable 'outline-level) + (setq-local treesit-font-lock-settings heex-ts--font-lock-settings) (setq-local treesit-simple-indent-rules heex-ts--indent-rules) diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 05a3ff6d7c6..dc2a8fcec1e 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -774,7 +774,7 @@ Calls REPORT-FN directly." "vararg_expression")))) (text "comment")))) - ;; Imenu. + ;; Imenu/Outline. (setq-local treesit-simple-imenu-settings `(("Requires" "\\`function_call\\'" @@ -789,16 +789,6 @@ Calls REPORT-FN directly." ;; Which-function. (setq-local which-func-functions (treesit-defun-at-point)) - ;; Outline. - (setq-local outline-regexp - (rx (seq (0+ space) - (or (seq "--[[" (0+ space) eol) - (seq symbol-start - (or "do" "for" "if" "repeat" "while" - (seq (? (seq "local" (1+ space))) - "function")) - symbol-end))))) - ;; Align. (setq-local align-indent-before-aligning t) diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el index 301f3e8791c..9af2aa6748f 100644 --- a/lisp/textmodes/html-ts-mode.el +++ b/lisp/textmodes/html-ts-mode.el @@ -121,6 +121,17 @@ Return nil if there is no name or if NODE is not a defun node." ;; Imenu. (setq-local treesit-simple-imenu-settings '(("Element" "\\`tag_name\\'" nil nil))) + + ;; Outline minor mode. + (setq-local treesit-outline-predicate "\\`element\\'") + ;; `html-ts-mode' inherits from `html-mode' that sets + ;; regexp-based outline variables. So need to restore + ;; the default values of outline variables to be able + ;; to use `treesit-outline-predicate' above. + (kill-local-variable 'outline-regexp) + (kill-local-variable 'outline-heading-end-regexp) + (kill-local-variable 'outline-level) + (treesit-major-mode-setup)) (if (treesit-ready-p 'html) diff --git a/lisp/treesit.el b/lisp/treesit.el index 6a485ae591a..25ac582276b 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2860,6 +2860,71 @@ ENTRY. MARKER marks the start of each tree-sitter node." index)))) treesit-simple-imenu-settings))) +;;; Outline minor mode + +(defvar-local treesit-outline-predicate nil + "Predicate used to find outline headings in the syntax tree. +The predicate can be a function, a regexp matching node type, +and more; see docstring of `treesit-thing-settings'. +It matches the nodes located on lines with outline headings. +Intended to be set by a major mode. When nil, the predicate +is constructed from the value of `treesit-simple-imenu-settings' +when a major mode sets it.") + +(defun treesit-outline-predicate--from-imenu (node) + ;; Return an outline searching predicate created from Imenu. + ;; Return the value suitable to set `treesit-outline-predicate'. + ;; Create this predicate from the value `treesit-simple-imenu-settings' + ;; that major modes set to find Imenu entries. The assumption here + ;; is that the positions of Imenu entries most of the time coincide + ;; with the lines of outline headings. When this assumption fails, + ;; you can directly set a proper value to `treesit-outline-predicate'. + (seq-some + (lambda (setting) + (and (string-match-p (nth 1 setting) (treesit-node-type node)) + (or (null (nth 2 setting)) + (funcall (nth 2 setting) node)))) + treesit-simple-imenu-settings)) + +(defun treesit-outline-search (&optional bound move backward looking-at) + "Search for the next outline heading in the syntax tree. +See the descriptions of arguments in `outline-search-function'." + (if looking-at + (when-let* ((node (or (treesit--thing-at (pos-eol) treesit-outline-predicate) + (treesit--thing-at (pos-bol) treesit-outline-predicate))) + (start (treesit-node-start node))) + (eq (pos-bol) (save-excursion (goto-char start) (pos-bol)))) + + (let* ((pos + ;; When function wants to find the current outline, point + ;; is at the beginning of the current line. When it wants + ;; to find the next outline, point is at the second column. + (if (eq (point) (pos-bol)) + (if (bobp) (point) (1- (point))) + (pos-eol))) + (found (treesit--navigate-thing pos (if backward -1 1) 'beg + treesit-outline-predicate))) + (if found + (if (or (not bound) (if backward (>= found bound) (<= found bound))) + (progn + (goto-char found) + (goto-char (pos-bol)) + (set-match-data (list (point) (pos-eol))) + t) + (when move (goto-char bound)) + nil) + (when move (goto-char (or bound (if backward (point-min) (point-max))))) + nil)))) + +(defun treesit-outline-level () + "Return the depth of the current outline heading." + (let* ((node (treesit-node-at (point))) + (level (if (treesit-node-match-p node treesit-outline-predicate t) + 1 0))) + (while (setq node (treesit-parent-until node treesit-outline-predicate)) + (setq level (1+ level))) + (if (zerop level) 1 level))) + ;;; Activating tree-sitter (defun treesit-ready-p (language &optional quiet) @@ -2990,6 +3055,17 @@ before calling this function." (setq-local imenu-create-index-function #'treesit-simple-imenu)) + ;; Outline minor mode. + (when (and (or treesit-outline-predicate treesit-simple-imenu-settings) + (not (seq-some #'local-variable-p + '(outline-search-function + outline-regexp outline-level)))) + (unless treesit-outline-predicate + (setq treesit-outline-predicate + #'treesit-outline-predicate--from-imenu)) + (setq-local outline-search-function #'treesit-outline-search + outline-level #'treesit-outline-level)) + ;; Remove existing local parsers. (dolist (ov (overlays-in (point-min) (point-max))) (when-let ((parser (overlay-get ov 'treesit-parser))) -- cgit v1.2.3 From 40994d2bafafa53464d3678b06f391fd13c884ec Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 12 Feb 2024 17:42:28 -0500 Subject: (cl--generic-describe): Refactor to ease reuse * lisp/emacs-lisp/cl-generic.el (cl--map-methods-documentation): New function, extrated from `cl--generic-describe`. (cl--generic-describe): Use it. --- lisp/emacs-lisp/cl-generic.el | 73 +++++++++++++++++++++++++------------------ 1 file changed, 43 insertions(+), 30 deletions(-) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index d1bd45120f1..f439a97f88c 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1140,12 +1140,8 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." (add-hook 'help-fns-describe-function-functions #'cl--generic-describe) (defun cl--generic-describe (function) - ;; Supposedly this is called from help-fns, so help-fns should be loaded at - ;; this point. - (declare-function help-fns-short-filename "help-fns" (filename)) (let ((generic (if (symbolp function) (cl--generic function)))) (when generic - (require 'help-mode) ;Needed for `help-function-def' button! (save-excursion ;; Ensure that we have two blank lines (but not more). (unless (looking-back "\n\n" (- (point) 2)) @@ -1153,32 +1149,49 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." (insert "This is a generic function.\n\n") (insert (propertize "Implementations:\n\n" 'face 'bold)) ;; Loop over fanciful generics - (dolist (method (cl--generic-method-table generic)) - (pcase-let* - ((`(,qualifiers ,args ,doc) (cl--generic-method-info method))) - ;; FIXME: Add hyperlinks for the types as well. - (let ((quals (if (length> qualifiers 0) - (concat (substring qualifiers - 0 (string-match " *\\'" - qualifiers)) - "\n") - ""))) - (insert (format "%s%S" - quals - (cons function - (cl--generic-upcase-formal-args args))))) - (let* ((met-name (cl--generic-load-hist-format - function - (cl--generic-method-qualifiers method) - (cl--generic-method-specializers method))) - (file (find-lisp-object-file-name met-name 'cl-defmethod))) - (when file - (insert (substitute-command-keys " in `")) - (help-insert-xref-button (help-fns-short-filename file) - 'help-function-def met-name file - 'cl-defmethod) - (insert (substitute-command-keys "'.\n")))) - (insert "\n" (or doc "Undocumented") "\n\n"))))))) + (cl--map-methods-documentation + function + (lambda (quals signature file doc) + (insert (format "%s%S%s\n\n%s\n\n" + quals signature + (if file (format-message " in `%s'." file) "") + (or doc "Undocumented"))))))))) + +(defun cl--map-methods-documentation (funname metname-printer) + "Iterate on FUNNAME's methods documentation at point." + ;; Supposedly this is called from help-fns, so help-fns should be loaded at + ;; this point. + (require 'help-fns) + (declare-function help-fns-short-filename "help-fns" (filename)) + (let ((generic (if (symbolp funname) (cl--generic funname)))) + (when generic + (require 'help-mode) ;Needed for `help-function-def' button! + ;; Loop over fanciful generics + (dolist (method (cl--generic-method-table generic)) + (pcase-let* + ((`(,qualifiers ,args ,doc) (cl--generic-method-info method)) + ;; FIXME: Add hyperlinks for the types as well. + (quals (if (length> qualifiers 0) + (concat (substring qualifiers + 0 (string-match " *\\'" + qualifiers)) + "\n") + "")) + (met-name (cl--generic-load-hist-format + funname + (cl--generic-method-qualifiers method) + (cl--generic-method-specializers method))) + (file (find-lisp-object-file-name met-name 'cl-defmethod))) + (funcall metname-printer + quals + (cons funname + (cl--generic-upcase-formal-args args)) + (when file + (make-text-button (help-fns-short-filename file) nil + 'type 'help-function-def + 'help-args + (list met-name file 'cl-defmethod))) + doc)))))) (defun cl--generic-specializers-apply-to-type-p (specializers type) "Return non-nil if a method with SPECIALIZERS applies to TYPE." -- cgit v1.2.3 From 6a18da80c2a3ff4bdede91bd3c28ecd41703ff98 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 13 Feb 2024 09:47:24 +0800 Subject: ; * src/lread.c (Finternal__obarray_buckets): Fix coding style. --- src/lread.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lread.c b/src/lread.c index db8c4813426..d339b2f15ae 100644 --- a/src/lread.c +++ b/src/lread.c @@ -5316,7 +5316,7 @@ DEFUN ("internal--obarray-buckets", while (1) { bucket = Fcons (sym, bucket); - struct Lisp_Symbol *s = XBARE_SYMBOL(sym)->u.s.next; + struct Lisp_Symbol *s = XBARE_SYMBOL (sym)->u.s.next; if (!s) break; sym = make_lisp_symbol (s); -- cgit v1.2.3 From d570864bebf9f038f696768f2da571ed272f0058 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Thu, 1 Feb 2024 13:58:20 -0800 Subject: Make outline.el ignore field properties in text * lisp/outline.el (outline-back-to-heading, outline-on-heading-p) (outline-next-visible-heading, outline-mark-subtree) (outline-hide-sublevels, outline--insert-button) (outline--fix-up-all-buttons): Inhibit field text motion (bug#68881). --- lisp/outline.el | 24 +++++++++++------------- 1 file changed, 11 insertions(+), 13 deletions(-) diff --git a/lisp/outline.el b/lisp/outline.el index b50708c1a7b..5ac0f0707f1 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -686,7 +686,7 @@ If POS is nil, use `point' instead." (defun outline-back-to-heading (&optional invisible-ok) "Move to previous heading line, or beg of this line if it's a heading. Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." - (beginning-of-line) + (forward-line 0) (or (outline-on-heading-p invisible-ok) (let (found) (save-excursion @@ -705,7 +705,7 @@ Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." "Return t if point is on a (visible) heading line. If INVISIBLE-OK is non-nil, an invisible heading line is ok too." (save-excursion - (beginning-of-line) + (forward-line 0) (and (bolp) (or invisible-ok (not (outline-invisible-p))) (if outline-search-function (funcall outline-search-function nil nil nil t) @@ -725,7 +725,7 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok too." (not (string-match (concat "\\`\\(?:" outline-regexp "\\)") (concat head " ")))) (setq head (concat head " "))) - (unless (bolp) (end-of-line) (newline)) + (unless (bolp) (goto-char (pos-eol)) (newline)) (insert head) (unless (eolp) (save-excursion (newline-and-indent))) @@ -941,9 +941,7 @@ With ARG, repeats or can move backward if negative. A heading line is one that starts with a `*' (or that `outline-regexp' matches)." (interactive "p") - (if (< arg 0) - (beginning-of-line) - (end-of-line)) + (goto-char (if (< arg 0) (pos-bol) (pos-eol))) (let ((regexp (unless outline-search-function (concat "^\\(?:" outline-regexp "\\)"))) found-heading-p) @@ -963,7 +961,7 @@ A heading line is one that starts with a `*' (or that (re-search-forward regexp nil 'move))) (outline-invisible-p (match-beginning 0)))) (setq arg (1- arg))) - (if found-heading-p (beginning-of-line)))) + (if found-heading-p (forward-line 0)))) (defun outline-previous-visible-heading (arg) "Move to the previous heading line. @@ -980,7 +978,7 @@ This puts point at the start of the current subtree, and mark at the end." (let ((beg)) (if (outline-on-heading-p) ;; we are already looking at a heading - (beginning-of-line) + (forward-line 0) ;; else go back to previous heading (outline-previous-visible-heading 1)) (setq beg (point)) @@ -1183,7 +1181,7 @@ of the current heading, or to 1 if the current line is not a heading." (cond (current-prefix-arg (prefix-numeric-value current-prefix-arg)) ((save-excursion - (beginning-of-line) + (forward-line 0) (if outline-search-function (funcall outline-search-function nil nil nil t) (looking-at outline-regexp))) @@ -1243,7 +1241,7 @@ This also unhides the top heading-less body, if any." (interactive) (save-excursion (outline-back-to-heading) - (if (not (outline-invisible-p (line-end-position))) + (if (not (outline-invisible-p (pos-eol))) (outline-hide-subtree) (outline-show-children) (outline-show-entry)))) @@ -1834,7 +1832,7 @@ With a prefix argument, show headings up to that LEVEL." (defun outline--insert-button (type) (with-silent-modifications (save-excursion - (beginning-of-line) + (forward-line 0) (let ((icon (nth (if (eq type 'close) 1 0) outline--button-icons)) (o (seq-find (lambda (o) (overlay-get o 'outline-button)) (overlays-at (point))))) @@ -1842,7 +1840,7 @@ With a prefix argument, show headings up to that LEVEL." (when (eq outline-minor-mode-use-buttons 'insert) (let ((inhibit-read-only t)) (insert (apply #'propertize " " (text-properties-at (point)))) - (beginning-of-line))) + (forward-line 0))) (setq o (make-overlay (point) (1+ (point)))) (overlay-put o 'outline-button t) (overlay-put o 'evaporate t)) @@ -1866,7 +1864,7 @@ With a prefix argument, show headings up to that LEVEL." (when from (save-excursion (goto-char from) - (setq from (line-beginning-position)))) + (setq from (pos-bol)))) (outline-map-region (lambda () (let ((close-p (save-excursion -- cgit v1.2.3 From acc6732ca1d39352f1aae3074ad04564178c0954 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 13 Feb 2024 11:18:16 +0100 Subject: Reuse commit message when preparing a single patch * lisp/vc/vc.el (vc-prepare-patch): Check commit message if only a single revision was selected. --- lisp/vc/vc.el | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index ca6efeabac2..619b469bebb 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3623,7 +3623,15 @@ revisions. When invoked interactively in a Log View buffer with marked revisions, use those." (interactive - (let ((revs (vc-prepare-patch-prompt-revisions)) to) + (let* ((revs (vc-prepare-patch-prompt-revisions)) + (subject + (and (length= revs 1) + (plist-get + (vc-call-backend + (vc-responsible-backend default-directory) + 'prepare-patch (car revs)) + :subject))) + to) (require 'message) (while (null (setq to (completing-read-multiple (format-prompt @@ -3636,7 +3644,7 @@ marked revisions, use those." (sit-for blink-matching-delay)) (list (string-join to ", ") (and (not vc-prepare-patches-separately) - (read-string "Subject: " "[PATCH] " nil nil t)) + (read-string "Subject: " (or subject "[PATCH] ") nil nil t)) revs))) (save-current-buffer (let ((patches (mapcar (lambda (rev) -- cgit v1.2.3 From 6ef8d29f221e010705184092600ac124bd0a14fd Mon Sep 17 00:00:00 2001 From: Jörg Bornemann Date: Mon, 12 Feb 2024 21:56:42 +0100 Subject: ; Resolve a FIXME in rst.el * lisp/textmodes/rst.el (rst-define-key): Use :documentation for the dynamically created docstrings of deprecated bindings. (Bug#69087) Copyright-paperwork-exempt: yes --- lisp/textmodes/rst.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 2cd78943883..5fbff4ba888 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -1147,14 +1147,14 @@ as well but give an additional message." (unless (fboundp forwarder-function) (defalias forwarder-function (lambda () + (:documentation + (format "Deprecated binding for %s, use \\[%s] instead." + def def)) (interactive) (call-interactively def) (message "[Deprecated use of key %s; use key %s instead]" (key-description (this-command-keys)) - (key-description key))) - ;; FIXME: In Emacs-25 we could use (:documentation ...) instead. - (format "Deprecated binding for %s, use \\[%s] instead." - def def))) + (key-description key))))) (dolist (dep-key deprecated) (define-key keymap dep-key forwarder-function))))) -- cgit v1.2.3 From 07bd7a0150eab1084a41f230cf59e620811e1778 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 13 Feb 2024 17:12:34 +0100 Subject: Add docstring for Tramp test macros * test/lisp/net/tramp-tests.el (tramp--test-set-ert-test-documentation): New defun. (tramp--test-deftest-with-stat, tramp--test-deftest-with-perl) (tramp--test-deftest-with-ls): Use it to define docstring. --- test/lisp/net/tramp-tests.el | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 4a964f0daf0..623e0860a01 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3815,15 +3815,24 @@ This tests also `access-file', `file-readable-p', (ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-file tmp-name2)))))) +(defun tramp--test-set-ert-test-documentation (test command) + "Set the documentation string for a derived test. +The test is derived from TEST and COMMAND." + (let ((test-doc + (string-split (ert-test-documentation (get test 'ert--test)) "\n"))) + ;; The first line must be extended. + (setcar + test-doc (format "%s Use the \"%s\" command." (car test-doc) command)) + (setf (ert-test-documentation + (get (intern (format "%s-with-%s" test command)) 'ert--test)) + (string-join test-doc "\n")))) + (defmacro tramp--test-deftest-with-stat (test) "Define ert `TEST-with-stat'." (declare (indent 1)) `(ert-deftest ,(intern (concat (symbol-name test) "-with-stat")) () - ;; This is the docstring. However, it must be expanded to a - ;; string inside the macro. No idea. - ;; (concat (ert-test-documentation (get ',test 'ert--test)) - ;; "\nUse the \"stat\" command.") :tags '(:expensive-test) + (tramp--test-set-ert-test-documentation ',test "stat") (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (tramp-get-remote-stat tramp-test-vec)) @@ -3842,11 +3851,8 @@ This tests also `access-file', `file-readable-p', "Define ert `TEST-with-perl'." (declare (indent 1)) `(ert-deftest ,(intern (concat (symbol-name test) "-with-perl")) () - ;; This is the docstring. However, it must be expanded to a - ;; string inside the macro. No idea. - ;; (concat (ert-test-documentation (get ',test 'ert--test)) - ;; "\nUse the \"perl\" command.") :tags '(:expensive-test) + (tramp--test-set-ert-test-documentation ',test "perl") (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (tramp-get-remote-perl tramp-test-vec)) @@ -3870,11 +3876,8 @@ This tests also `access-file', `file-readable-p', "Define ert `TEST-with-ls'." (declare (indent 1)) `(ert-deftest ,(intern (concat (symbol-name test) "-with-ls")) () - ;; This is the docstring. However, it must be expanded to a - ;; string inside the macro. No idea. - ;; (concat (ert-test-documentation (get ',test 'ert--test)) - ;; "\nUse the \"ls\" command.") :tags '(:expensive-test) + (tramp--test-set-ert-test-documentation ',test "ls") (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (if-let ((default-directory ert-remote-temporary-file-directory) -- cgit v1.2.3 From d61145cc8cfb31ca170cd1b5deab59f0a5cbea63 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 13 Feb 2024 19:02:21 +0200 Subject: More changes for treesitter support of outline-minor-mode (bug#68824) * lisp/treesit.el (treesit-outline-level): Set NAMED arg of 'treesit-node-at' to t. Don't set IGNORE-MISSING arg of 'treesit-node-match-p' to t. * lisp/progmodes/ruby-ts-mode.el (ruby-ts-mode): Add "singleton_method" to 'treesit-thing-settings'. Set 'treesit-outline-predicate'. Kill local variables 'outline-regexp' and 'outline-level'. --- lisp/progmodes/ruby-ts-mode.el | 14 ++++++++++++++ lisp/treesit.el | 4 ++-- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 598eaa461ff..426ae248cac 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -1133,6 +1133,7 @@ leading double colon is not added." "singleton_class" "module" "method" + "singleton_method" "array" "hash" "parenthesized_statements" @@ -1178,6 +1179,19 @@ leading double colon is not added." ;; Imenu. (setq-local imenu-create-index-function #'ruby-ts--imenu) + ;; Outline minor mode. + (setq-local treesit-outline-predicate + (rx bos (or "singleton_method" + "method" + "alias" + "class" + "module") + eos)) + ;; Restore default values of outline variables + ;; to use `treesit-outline-predicate'. + (kill-local-variable 'outline-regexp) + (kill-local-variable 'outline-level) + (setq-local treesit-simple-indent-rules (ruby-ts--indent-rules)) ;; Font-lock. diff --git a/lisp/treesit.el b/lisp/treesit.el index 25ac582276b..f811b8090bc 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2918,8 +2918,8 @@ See the descriptions of arguments in `outline-search-function'." (defun treesit-outline-level () "Return the depth of the current outline heading." - (let* ((node (treesit-node-at (point))) - (level (if (treesit-node-match-p node treesit-outline-predicate t) + (let* ((node (treesit-node-at (point) nil t)) + (level (if (treesit-node-match-p node treesit-outline-predicate) 1 0))) (while (setq node (treesit-parent-until node treesit-outline-predicate)) (setq level (1+ level))) -- cgit v1.2.3 From d2a5d7534c7dcdc4432bf5456cb8a76680f7aa14 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 13 Feb 2024 09:54:50 -0800 Subject: Simplify and speed up EQ * src/lisp.h (lisp_h_BASE2_EQ, lisp_h_EQ): Simplify by testing symbols_with_pos_enabled first. On x86-64 with GCC 13.2 this shrinks temacs text by 1.5% and after removing all *.elc files speeds up 'make' by 1.2%. --- src/lisp.h | 26 +++++++++----------------- 1 file changed, 9 insertions(+), 17 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index 5326824bf38..f6133669ac1 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -384,27 +384,19 @@ typedef EMACS_INT Lisp_Word; ((ok) ? (void) 0 : wrong_type_argument (predicate, x)) #define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons) #define lisp_h_BASE_EQ(x, y) (XLI (x) == XLI (y)) -#define lisp_h_BASE2_EQ(x, y) \ - (BASE_EQ (x, y) \ - || (symbols_with_pos_enabled \ - && SYMBOL_WITH_POS_P (x) \ - && BASE_EQ (XSYMBOL_WITH_POS (x)->sym, y))) +#define lisp_h_BASE2_EQ(x, y) \ + (symbols_with_pos_enabled \ + ? BASE_EQ (SYMBOL_WITH_POS_P (x) ? XSYMBOL_WITH_POS (x)->sym : (x), y) \ + : BASE_EQ (x, y)) /* FIXME: Do we really need to inline the whole thing? * What about keeping the part after `symbols_with_pos_enabled` in * a separate function? */ -#define lisp_h_EQ(x, y) \ - (XLI (x) == XLI (y) \ - || (symbols_with_pos_enabled \ - && (SYMBOL_WITH_POS_P (x) \ - ? (BARE_SYMBOL_P (y) \ - ? XLI (XSYMBOL_WITH_POS (x)->sym) == XLI (y) \ - : (SYMBOL_WITH_POS_P (y) \ - && (XLI (XSYMBOL_WITH_POS (x)->sym) \ - == XLI (XSYMBOL_WITH_POS (y)->sym)))) \ - : (SYMBOL_WITH_POS_P (y) \ - && BARE_SYMBOL_P (x) \ - && (XLI (x) == XLI (XSYMBOL_WITH_POS (y)->sym)))))) +#define lisp_h_EQ(x, y) \ + (symbols_with_pos_enabled \ + ? BASE_EQ (SYMBOL_WITH_POS_P (x) ? XSYMBOL_WITH_POS (x)->sym : (x), \ + SYMBOL_WITH_POS_P (y) ? XSYMBOL_WITH_POS (y)->sym : (y)) \ + : BASE_EQ (x, y)) #define lisp_h_FIXNUMP(x) \ (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \ -- cgit v1.2.3 From 08c1863257469b4cb85e97a276ba635d44b22666 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 13 Feb 2024 09:54:51 -0800 Subject: Simplify and speed up EQ again * src/lisp.h (lisp_h_BASE2_EQ, lisp_h_EQ): Simplify and refactor. On x86-64 with GCC 3.2 this shrinks temacs text by 0.055% and after removing all *.elc files speeds up 'make' by 1.0%. --- src/lisp.h | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index f6133669ac1..b609bef990c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -385,18 +385,13 @@ typedef EMACS_INT Lisp_Word; #define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons) #define lisp_h_BASE_EQ(x, y) (XLI (x) == XLI (y)) #define lisp_h_BASE2_EQ(x, y) \ - (symbols_with_pos_enabled \ - ? BASE_EQ (SYMBOL_WITH_POS_P (x) ? XSYMBOL_WITH_POS (x)->sym : (x), y) \ - : BASE_EQ (x, y)) - -/* FIXME: Do we really need to inline the whole thing? - * What about keeping the part after `symbols_with_pos_enabled` in - * a separate function? */ + BASE_EQ ((symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x) \ + ? XSYMBOL_WITH_POS (x)->sym : (x)), \ + y) #define lisp_h_EQ(x, y) \ - (symbols_with_pos_enabled \ - ? BASE_EQ (SYMBOL_WITH_POS_P (x) ? XSYMBOL_WITH_POS (x)->sym : (x), \ - SYMBOL_WITH_POS_P (y) ? XSYMBOL_WITH_POS (y)->sym : (y)) \ - : BASE_EQ (x, y)) + BASE2_EQ (x, \ + (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (y) \ + ? XSYMBOL_WITH_POS (y)->sym : (y))) #define lisp_h_FIXNUMP(x) \ (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \ -- cgit v1.2.3 From efdcd7b8f78ef22c0213ea770a552fb69b789381 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 13 Feb 2024 09:54:51 -0800 Subject: Remove BASE2_EQ MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/lisp.h (lisp_h_BASE2_EQ, BASE2_EQ): Remove. All uses removed. BASE2_EQ was present only for minor optimization and with current gcc -O2, BASE2_EQ does not affect performance, so it’s not worth the hassle. --- src/lisp.h | 18 +++--------------- src/lread.c | 4 +++- src/timefns.c | 6 +++--- 3 files changed, 9 insertions(+), 19 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index b609bef990c..0b676a027eb 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -384,14 +384,11 @@ typedef EMACS_INT Lisp_Word; ((ok) ? (void) 0 : wrong_type_argument (predicate, x)) #define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons) #define lisp_h_BASE_EQ(x, y) (XLI (x) == XLI (y)) -#define lisp_h_BASE2_EQ(x, y) \ +#define lisp_h_EQ(x, y) \ BASE_EQ ((symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x) \ ? XSYMBOL_WITH_POS (x)->sym : (x)), \ - y) -#define lisp_h_EQ(x, y) \ - BASE2_EQ (x, \ - (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (y) \ - ? XSYMBOL_WITH_POS (y)->sym : (y))) + (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (y) \ + ? XSYMBOL_WITH_POS (y)->sym : (y))) #define lisp_h_FIXNUMP(x) \ (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \ @@ -461,7 +458,6 @@ typedef EMACS_INT Lisp_Word; # define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x) # define CONSP(x) lisp_h_CONSP (x) # define BASE_EQ(x, y) lisp_h_BASE_EQ (x, y) -# define BASE2_EQ(x, y) lisp_h_BASE2_EQ (x, y) # define FLOATP(x) lisp_h_FLOATP (x) # define FIXNUMP(x) lisp_h_FIXNUMP (x) # define NILP(x) lisp_h_NILP (x) @@ -1339,14 +1335,6 @@ INLINE bool return lisp_h_BASE_EQ (x, y); } -/* Return true if X and Y are the same object, reckoning X to be the - same as a bare symbol Y if X is Y with position. */ -INLINE bool -(BASE2_EQ) (Lisp_Object x, Lisp_Object y) -{ - return lisp_h_BASE2_EQ (x, y); -} - /* Return true if X and Y are the same object, reckoning a symbol with position as being the same as the bare symbol. */ INLINE bool diff --git a/src/lread.c b/src/lread.c index d339b2f15ae..551bfd735a2 100644 --- a/src/lread.c +++ b/src/lread.c @@ -5063,10 +5063,12 @@ it defaults to the value of `obarray'. */) { /* If already a symbol, we don't do shorthand-longhand translation, as promised in the docstring. */ + Lisp_Object sym = (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (name) + ? XSYMBOL_WITH_POS (name)->sym : name); string = XSYMBOL (name)->u.s.name; tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); - return BASE2_EQ (name, tem) ? name : Qnil; + return BASE_EQ (sym, tem) ? name : Qnil; } } diff --git a/src/timefns.c b/src/timefns.c index 1541583b485..fc1edf136cb 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -225,7 +225,7 @@ tzlookup (Lisp_Object zone, bool settz) if (NILP (zone)) return local_tz; - else if (BASE_EQ (zone, make_fixnum (0)) || BASE2_EQ (zone, Qt)) + else if (BASE_EQ (zone, make_fixnum (0)) || EQ (zone, Qt)) { zone_string = "UTC0"; new_tz = utc_tz; @@ -234,7 +234,7 @@ tzlookup (Lisp_Object zone, bool settz) { bool plain_integer = FIXNUMP (zone); - if (BASE2_EQ (zone, Qwall)) + if (EQ (zone, Qwall)) zone_string = 0; else if (STRINGP (zone)) zone_string = SSDATA (ENCODE_SYSTEM (zone)); @@ -1548,7 +1548,7 @@ usage: (decode-time &optional TIME ZONE FORM) */) /* Compute SEC from LOCAL_TM.tm_sec and HZ. */ Lisp_Object hz = lt.hz, sec; - if (BASE_EQ (hz, make_fixnum (1)) || !BASE2_EQ (form, Qt)) + if (BASE_EQ (hz, make_fixnum (1)) || !EQ (form, Qt)) sec = make_fixnum (local_tm.tm_sec); else { -- cgit v1.2.3 From 231af322b07447d87b4c250aa601219a4005d9a5 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 13 Feb 2024 09:54:51 -0800 Subject: Remove lisp_h_PSEUDOVECTORP etc MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/lisp.h (lisp_h_PSEUDOVECTORP, lisp_h_EQ, lisp_h_SYMBOLP): Refactor by removing these macros, moving each definiens to its only use. Now that we have symbols with position so that there is no longer a non-lisp_h_* macro counterpart if DEFINE_KEY_OPS_AS_MACROS, there’s no need to separate these definiens from their inline function bodies. --- src/lisp.h | 31 ++++++++++++------------------- 1 file changed, 12 insertions(+), 19 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index 0b676a027eb..d1dcddcfb89 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -372,23 +372,12 @@ typedef EMACS_INT Lisp_Word; # define lisp_h_Qnil {0} #endif -#define lisp_h_PSEUDOVECTORP(a,code) \ - (lisp_h_VECTORLIKEP (a) \ - && ((XUNTAG (a, Lisp_Vectorlike, union vectorlike_header)->size \ - & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \ - == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS)))) - #define lisp_h_CHECK_FIXNUM(x) CHECK_TYPE (FIXNUMP (x), Qfixnump, x) #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) #define lisp_h_CHECK_TYPE(ok, predicate, x) \ ((ok) ? (void) 0 : wrong_type_argument (predicate, x)) #define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons) #define lisp_h_BASE_EQ(x, y) (XLI (x) == XLI (y)) -#define lisp_h_EQ(x, y) \ - BASE_EQ ((symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x) \ - ? XSYMBOL_WITH_POS (x)->sym : (x)), \ - (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (y) \ - ? XSYMBOL_WITH_POS (y)->sym : (y))) #define lisp_h_FIXNUMP(x) \ (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \ @@ -406,8 +395,6 @@ typedef EMACS_INT Lisp_Word; (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value) #define lisp_h_SYMBOL_WITH_POS_P(x) PSEUDOVECTORP (x, PVEC_SYMBOL_WITH_POS) #define lisp_h_BARE_SYMBOL_P(x) TAGGEDP (x, Lisp_Symbol) -#define lisp_h_SYMBOLP(x) \ - (BARE_SYMBOL_P (x) || (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x))) #define lisp_h_TAGGEDP(a, tag) \ (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \ - (unsigned) (tag)) \ @@ -465,7 +452,6 @@ typedef EMACS_INT Lisp_Word; # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) # define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym) # define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym) -/* # define SYMBOLP(x) lisp_h_SYMBOLP (x) */ /* X is accessed more than once. */ # define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag) # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x) # define XCAR(c) lisp_h_XCAR (c) @@ -1104,7 +1090,10 @@ enum More_Lisp_Bits INLINE bool PSEUDOVECTORP (Lisp_Object a, int code) { - return lisp_h_PSEUDOVECTORP (a, code); + return (lisp_h_VECTORLIKEP (a) + && ((XUNTAG (a, Lisp_Vectorlike, union vectorlike_header)->size + & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) + == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS)))); } INLINE bool @@ -1120,9 +1109,10 @@ INLINE bool } INLINE bool -(SYMBOLP) (Lisp_Object x) +SYMBOLP (Lisp_Object x) { - return lisp_h_SYMBOLP (x); + return (BARE_SYMBOL_P (x) + || (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x))); } INLINE struct Lisp_Symbol_With_Pos * @@ -1338,9 +1328,12 @@ INLINE bool /* Return true if X and Y are the same object, reckoning a symbol with position as being the same as the bare symbol. */ INLINE bool -(EQ) (Lisp_Object x, Lisp_Object y) +EQ (Lisp_Object x, Lisp_Object y) { - return lisp_h_EQ (x, y); + return BASE_EQ ((symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x) + ? XSYMBOL_WITH_POS (x)->sym : x), + (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (y) + ? XSYMBOL_WITH_POS (y)->sym : y)); } INLINE intmax_t -- cgit v1.2.3 From 473dac880105cf6055a185eb3b9764243f27697c Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 13 Feb 2024 09:54:51 -0800 Subject: Remove lisp_h_XCONS etc MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit When configured with --enable-checking and compiled with gcc -O0, these macros evaluated arguments multiple times, which made it too easy to mistakenly write code that behaves differently when debugging. This patch does not affect performance in normal builds. In --enable-checking builds with gcc -O0 it slows down my usual benchmark (remove all '*.elc’ files and then 'make') by 4.4%. I hope that’s good enough; if not I can complicate the macros to tune better for debugging builds. * src/lisp.h (lisp_h_SET_SYMBOL_VAL, lisp_h_SYMBOL_VAL) (lisp_h_XCONS): Remove, moving each definiens to the corresponding inline function. All uses removed. --- src/lisp.h | 28 +++++++++++----------------- 1 file changed, 11 insertions(+), 17 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index d1dcddcfb89..796c7867b4c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -330,7 +330,8 @@ typedef EMACS_INT Lisp_Word; without worrying about the implementations diverging, since lisp_h_OP defines the actual implementation. The lisp_h_OP macros are intended to be private to this include file, and should not be - used elsewhere. + used elsewhere. They should evaluate each argument exactly once, + so that they behave like their functional counterparts. FIXME: Remove the lisp_h_OP macros, and define just the inline OP functions, once "gcc -Og" (new to GCC 4.8) or equivalent works well @@ -385,14 +386,9 @@ typedef EMACS_INT Lisp_Word; & ((1 << INTTYPEBITS) - 1))) #define lisp_h_FLOATP(x) TAGGEDP (x, Lisp_Float) #define lisp_h_NILP(x) BASE_EQ (x, Qnil) -#define lisp_h_SET_SYMBOL_VAL(sym, v) \ - (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \ - (sym)->u.s.val.value = (v)) #define lisp_h_SYMBOL_CONSTANT_P(sym) \ (XSYMBOL (sym)->u.s.trapped_write == SYMBOL_NOWRITE) #define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write) -#define lisp_h_SYMBOL_VAL(sym) \ - (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value) #define lisp_h_SYMBOL_WITH_POS_P(x) PSEUDOVECTORP (x, PVEC_SYMBOL_WITH_POS) #define lisp_h_BARE_SYMBOL_P(x) TAGGEDP (x, Lisp_Symbol) #define lisp_h_TAGGEDP(a, tag) \ @@ -402,8 +398,6 @@ typedef EMACS_INT Lisp_Word; #define lisp_h_VECTORLIKEP(x) TAGGEDP (x, Lisp_Vectorlike) #define lisp_h_XCAR(c) XCONS (c)->u.s.car #define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr -#define lisp_h_XCONS(a) \ - (eassert (CONSP (a)), XUNTAG (a, Lisp_Cons, struct Lisp_Cons)) #define lisp_h_XHASH(a) XUFIXNUM_RAW (a) #if USE_LSB_TAG # define lisp_h_make_fixnum_wrap(n) \ @@ -448,15 +442,12 @@ typedef EMACS_INT Lisp_Word; # define FLOATP(x) lisp_h_FLOATP (x) # define FIXNUMP(x) lisp_h_FIXNUMP (x) # define NILP(x) lisp_h_NILP (x) -# define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v) # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) # define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym) -# define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym) # define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag) # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x) # define XCAR(c) lisp_h_XCAR (c) # define XCDR(c) lisp_h_XCDR (c) -# define XCONS(a) lisp_h_XCONS (a) # define XHASH(a) lisp_h_XHASH (a) # if USE_LSB_TAG # define make_fixnum(n) lisp_h_make_fixnum (n) @@ -1478,9 +1469,10 @@ CHECK_CONS (Lisp_Object x) } INLINE struct Lisp_Cons * -(XCONS) (Lisp_Object a) +XCONS (Lisp_Object a) { - return lisp_h_XCONS (a); + eassert (CONSP (a)); + return XUNTAG (a, Lisp_Cons, struct Lisp_Cons); } /* Take the car or cdr of something known to be a cons cell. */ @@ -2265,9 +2257,10 @@ typedef jmp_buf sys_jmp_buf; /* Value is name of symbol. */ INLINE Lisp_Object -(SYMBOL_VAL) (struct Lisp_Symbol *sym) +SYMBOL_VAL (struct Lisp_Symbol *sym) { - return lisp_h_SYMBOL_VAL (sym); + eassert (sym->u.s.redirect == SYMBOL_PLAINVAL); + return sym->u.s.val.value; } INLINE struct Lisp_Symbol * @@ -2290,9 +2283,10 @@ SYMBOL_FWD (struct Lisp_Symbol *sym) } INLINE void -(SET_SYMBOL_VAL) (struct Lisp_Symbol *sym, Lisp_Object v) +SET_SYMBOL_VAL (struct Lisp_Symbol *sym, Lisp_Object v) { - lisp_h_SET_SYMBOL_VAL (sym, v); + eassert (sym->u.s.redirect == SYMBOL_PLAINVAL); + sym->u.s.val.value = v; } INLINE void -- cgit v1.2.3 From 10c6aea4434b1c9ccea30a1f87f301ab2c9bade6 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 13 Feb 2024 09:54:51 -0800 Subject: Remove SYMBOL_WITH_POS_{POS,SYM} * src/fns.c (internal_equal): Turn comment into eassert that !symbols_with_pos_enabled. (sxhash_obj): Simplify case of symbol with pos (when enabled). * src/lisp.h (XSYMBOL_WITH_POS_SYM, XSYMBOL_WITH_POS_POS) (maybe_remove_pos_from_symbol): New inline functions. (SYMBOL_WITH_POS_SYM, SYMBOL_WITH_POS_POS): Remove. All uses replaced by the new functions. This avoids some double-checking in the source code, simplifies the code overall, and avoids the need for "Type checking is done in the following macro" comments to explain unusual code. --- src/data.c | 16 +++++++--------- src/fns.c | 44 +++++++++++++++++++++----------------------- src/lisp.h | 43 ++++++++++++++++++++++++------------------- src/lread.c | 3 +-- src/timefns.c | 6 ++---- 5 files changed, 55 insertions(+), 57 deletions(-) diff --git a/src/data.c b/src/data.c index 0c47750cb75..530bb774171 100644 --- a/src/data.c +++ b/src/data.c @@ -791,18 +791,16 @@ DEFUN ("bare-symbol", Fbare_symbol, Sbare_symbol, 1, 1, 0, doc: /* Extract, if need be, the bare symbol from SYM, a symbol. */) (register Lisp_Object sym) { - if (BARE_SYMBOL_P (sym)) - return sym; - /* Type checking is done in the following macro. */ - return SYMBOL_WITH_POS_SYM (sym); + CHECK_SYMBOL (sym); + return BARE_SYMBOL_P (sym) ? sym : XSYMBOL_WITH_POS_SYM (sym); } DEFUN ("symbol-with-pos-pos", Fsymbol_with_pos_pos, Ssymbol_with_pos_pos, 1, 1, 0, doc: /* Extract the position from a symbol with position. */) (register Lisp_Object ls) { - /* Type checking is done in the following macro. */ - return SYMBOL_WITH_POS_POS (ls); + CHECK_TYPE (SYMBOL_WITH_POS_P (ls), Qsymbol_with_pos_p, ls); + return XSYMBOL_WITH_POS_POS (ls); } DEFUN ("remove-pos-from-symbol", Fremove_pos_from_symbol, @@ -812,7 +810,7 @@ Otherwise, return ARG unchanged. Compare with `bare-symbol'. */) (register Lisp_Object arg) { if (SYMBOL_WITH_POS_P (arg)) - return (SYMBOL_WITH_POS_SYM (arg)); + return XSYMBOL_WITH_POS_SYM (arg); return arg; } @@ -829,14 +827,14 @@ the position will be taken. */) if (BARE_SYMBOL_P (sym)) bare = sym; else if (SYMBOL_WITH_POS_P (sym)) - bare = XSYMBOL_WITH_POS (sym)->sym; + bare = XSYMBOL_WITH_POS_SYM (sym); else wrong_type_argument (Qsymbolp, sym); if (FIXNUMP (pos)) position = pos; else if (SYMBOL_WITH_POS_P (pos)) - position = XSYMBOL_WITH_POS (pos)->pos; + position = XSYMBOL_WITH_POS_POS (pos); else wrong_type_argument (Qfixnum_or_symbol_with_pos_p, pos); diff --git a/src/fns.c b/src/fns.c index 61d87752777..918ba0370e8 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2782,13 +2782,8 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, /* A symbol with position compares the contained symbol, and is `equal' to the corresponding ordinary symbol. */ - if (symbols_with_pos_enabled) - { - if (SYMBOL_WITH_POS_P (o1)) - o1 = SYMBOL_WITH_POS_SYM (o1); - if (SYMBOL_WITH_POS_P (o2)) - o2 = SYMBOL_WITH_POS_SYM (o2); - } + o1 = maybe_remove_pos_from_symbol (o1); + o2 = maybe_remove_pos_from_symbol (o2); if (BASE_EQ (o1, o2)) return true; @@ -2869,11 +2864,14 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, if (TS_NODEP (o1)) return treesit_node_eq (o1, o2); #endif - if (SYMBOL_WITH_POS_P(o1)) /* symbols_with_pos_enabled is false. */ - return (BASE_EQ (XSYMBOL_WITH_POS (o1)->sym, - XSYMBOL_WITH_POS (o2)->sym) - && BASE_EQ (XSYMBOL_WITH_POS (o1)->pos, - XSYMBOL_WITH_POS (o2)->pos)); + if (SYMBOL_WITH_POS_P (o1)) + { + eassert (!symbols_with_pos_enabled); + return (BASE_EQ (XSYMBOL_WITH_POS_SYM (o1), + XSYMBOL_WITH_POS_SYM (o2)) + && BASE_EQ (XSYMBOL_WITH_POS_POS (o1), + XSYMBOL_WITH_POS_POS (o2))); + } /* Aside from them, only true vectors, char-tables, compiled functions, and fonts (font-spec, font-entity, font-object) @@ -4465,9 +4463,8 @@ reduce_emacs_uint_to_hash_hash (EMACS_UINT x) static EMACS_INT sxhash_eq (Lisp_Object key) { - if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (key)) - key = SYMBOL_WITH_POS_SYM (key); - return XHASH (key) ^ XTYPE (key); + Lisp_Object k = maybe_remove_pos_from_symbol (key); + return XHASH (k) ^ XTYPE (k); } static EMACS_INT @@ -5247,12 +5244,15 @@ sxhash_obj (Lisp_Object obj, int depth) hash = sxhash_combine (hash, sxhash_obj (XOVERLAY (obj)->plist, depth)); return hash; } - else if (symbols_with_pos_enabled && pvec_type == PVEC_SYMBOL_WITH_POS) - return sxhash_obj (XSYMBOL_WITH_POS (obj)->sym, depth + 1); else - /* Others are 'equal' if they are 'eq', so take their - address as hash. */ - return XHASH (obj); + { + if (symbols_with_pos_enabled && pvec_type == PVEC_SYMBOL_WITH_POS) + obj = XSYMBOL_WITH_POS_SYM (obj); + + /* Others are 'equal' if they are 'eq', so take their + address as hash. */ + return XHASH (obj); + } } case Lisp_Cons: @@ -5447,9 +5447,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) /* See if there's a `:test TEST' among the arguments. */ ptrdiff_t i = get_key_arg (QCtest, nargs, args, used); - Lisp_Object test = i ? args[i] : Qeql; - if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (test)) - test = SYMBOL_WITH_POS_SYM (test); + Lisp_Object test = i ? maybe_remove_pos_from_symbol (args[i]) : Qeql; const struct hash_table_test *testdesc; if (BASE_EQ (test, Qeq)) testdesc = &hashtest_eq; diff --git a/src/lisp.h b/src/lisp.h index 796c7867b4c..e9b0bd522af 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1113,6 +1113,27 @@ XSYMBOL_WITH_POS (Lisp_Object a) return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos); } +INLINE Lisp_Object +XSYMBOL_WITH_POS_SYM (Lisp_Object a) +{ + Lisp_Object sym = XSYMBOL_WITH_POS (a)->sym; + eassert (BARE_SYMBOL_P (sym)); + return sym; +} + +INLINE Lisp_Object +XSYMBOL_WITH_POS_POS (Lisp_Object a) +{ + return XSYMBOL_WITH_POS (a)->pos; +} + +INLINE Lisp_Object +maybe_remove_pos_from_symbol (Lisp_Object x) +{ + return (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x) + ? XSYMBOL_WITH_POS_SYM (x) : x); +} + INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED XBARE_SYMBOL (Lisp_Object a) { @@ -1128,7 +1149,7 @@ XSYMBOL (Lisp_Object a) if (!BARE_SYMBOL_P (a)) { eassert (symbols_with_pos_enabled); - a = XSYMBOL_WITH_POS (a)->sym; + a = XSYMBOL_WITH_POS_SYM (a); } return XBARE_SYMBOL (a); } @@ -1322,9 +1343,9 @@ INLINE bool EQ (Lisp_Object x, Lisp_Object y) { return BASE_EQ ((symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x) - ? XSYMBOL_WITH_POS (x)->sym : x), + ? XSYMBOL_WITH_POS_SYM (x) : x), (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (y) - ? XSYMBOL_WITH_POS (y)->sym : y)); + ? XSYMBOL_WITH_POS_SYM (y) : y)); } INLINE intmax_t @@ -2809,22 +2830,6 @@ XOVERLAY (Lisp_Object a) return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Overlay); } -INLINE Lisp_Object -SYMBOL_WITH_POS_SYM (Lisp_Object a) -{ - if (!SYMBOL_WITH_POS_P (a)) - wrong_type_argument (Qsymbol_with_pos_p, a); - return XSYMBOL_WITH_POS (a)->sym; -} - -INLINE Lisp_Object -SYMBOL_WITH_POS_POS (Lisp_Object a) -{ - if (!SYMBOL_WITH_POS_P (a)) - wrong_type_argument (Qsymbol_with_pos_p, a); - return XSYMBOL_WITH_POS (a)->pos; -} - INLINE bool USER_PTRP (Lisp_Object x) { diff --git a/src/lread.c b/src/lread.c index 551bfd735a2..c11c641440d 100644 --- a/src/lread.c +++ b/src/lread.c @@ -5063,8 +5063,7 @@ it defaults to the value of `obarray'. */) { /* If already a symbol, we don't do shorthand-longhand translation, as promised in the docstring. */ - Lisp_Object sym = (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (name) - ? XSYMBOL_WITH_POS (name)->sym : name); + Lisp_Object sym = maybe_remove_pos_from_symbol (name); string = XSYMBOL (name)->u.s.name; tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); diff --git a/src/timefns.c b/src/timefns.c index fc1edf136cb..0ecbb6e6793 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -1765,10 +1765,8 @@ but new code should not rely on it. */) well, since we accept it as input? */ struct lisp_time t; enum timeform input_form = decode_lisp_time (time, false, &t, 0); - if (NILP (form)) - form = current_time_list ? Qlist : Qt; - if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (form)) - form = SYMBOL_WITH_POS_SYM (form); + form = (!NILP (form) ? maybe_remove_pos_from_symbol (form) + : current_time_list ? Qlist : Qt); if (BASE_EQ (form, Qlist)) return ticks_hz_list4 (t.ticks, t.hz); if (BASE_EQ (form, Qinteger)) -- cgit v1.2.3 From d202f1b9e74107c0e51c5d2fdbe094cbe1baaadb Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 13 Feb 2024 09:54:51 -0800 Subject: XSYMBOL eassume speedups MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/lisp.h (XSYMBOL_WITH_POS_SYM, XSYMBOL): Help the compiler by using eassume instead of eassert for XSYMBOL postconditions likely to be useful for optimization later. With gcc 13.2 -O2 x86-64 this improved speed on my usual “compile all .el files” benchmark by 0.7% and shrank the text size of Emacs by 0.09%. --- src/lisp.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index e9b0bd522af..bf96bfd39f7 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1117,7 +1117,7 @@ INLINE Lisp_Object XSYMBOL_WITH_POS_SYM (Lisp_Object a) { Lisp_Object sym = XSYMBOL_WITH_POS (a)->sym; - eassert (BARE_SYMBOL_P (sym)); + eassume (BARE_SYMBOL_P (sym)); return sym; } @@ -1148,7 +1148,7 @@ XSYMBOL (Lisp_Object a) { if (!BARE_SYMBOL_P (a)) { - eassert (symbols_with_pos_enabled); + eassume (symbols_with_pos_enabled); a = XSYMBOL_WITH_POS_SYM (a); } return XBARE_SYMBOL (a); -- cgit v1.2.3 From a4a99405d00b98aeb86040117402ed0e1f954833 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 13 Feb 2024 09:54:51 -0800 Subject: Simplify position-symbol * src/data.c (Fposition_symbol): Simplify by calling Fbare_symbol rather than open-coding it. --- src/data.c | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/src/data.c b/src/data.c index 530bb774171..f2f35fb355a 100644 --- a/src/data.c +++ b/src/data.c @@ -821,16 +821,9 @@ POS, the position, is either a fixnum or a symbol with position from which the position will be taken. */) (register Lisp_Object sym, register Lisp_Object pos) { - Lisp_Object bare; + Lisp_Object bare = Fbare_symbol (sym); Lisp_Object position; - if (BARE_SYMBOL_P (sym)) - bare = sym; - else if (SYMBOL_WITH_POS_P (sym)) - bare = XSYMBOL_WITH_POS_SYM (sym); - else - wrong_type_argument (Qsymbolp, sym); - if (FIXNUMP (pos)) position = pos; else if (SYMBOL_WITH_POS_P (pos)) -- cgit v1.2.3 From 10bf810e845061a83d466cd7367ab7d220653296 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 13 Feb 2024 21:59:03 +0200 Subject: Fix left-over from renaming 'comp-*' functions * lisp/progmodes/elisp-mode.el (comp--write-bytecode-file): Call this instead of 'comp-write-bytecode-file', its old name. Reported by Arthur Miller . --- lisp/progmodes/elisp-mode.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index da0cb96e1cf..4e0e7552f8e 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -221,7 +221,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map." (load (byte-compile-dest-file buffer-file-name))) (declare-function native-compile "comp") -(declare-function comp-write-bytecode-file "comp") +(declare-function comp--write-bytecode-file "comp") (defun emacs-lisp-native-compile () "Native-compile the current buffer's file (if it has changed). @@ -233,7 +233,7 @@ visited by the current buffer." (byte-to-native-output-buffer-file nil) (eln (native-compile buffer-file-name))) (when eln - (comp-write-bytecode-file eln)))) + (comp-write--bytecode-file eln)))) (defun emacs-lisp-native-compile-and-load () "Native-compile the current buffer's file (if it has changed), then load it. -- cgit v1.2.3 From 371ccf09fea26892a2fada028d27fb4b596636df Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Mon, 12 Feb 2024 18:29:50 +0100 Subject: Add 'custom-variable' command * lisp/cus-edit.el (customize-toggle-option): Add command. (toggle-option): Add shorter alias for 'customize-toggle-option'. * etc/NEWS: Document it. (Bug#69079) --- etc/NEWS | 4 ++++ lisp/cus-edit.el | 35 +++++++++++++++++++++++++++++++++++ 2 files changed, 39 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index f89c8ce1d8d..e6b1d424499 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1336,6 +1336,10 @@ in Buffer menu mode. *** New command 'customize-dirlocals'. This command pops up a buffer to edit the settings in ".dir-locals.el". +--- +** New command 'customize-toggle-option'. +This command can toggle boolean options for the duration of a session. + ** Calc +++ diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 38b6ec984ab..8fad51dc116 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1227,6 +1227,41 @@ If OTHER-WINDOW is non-nil, display in another window." (unless (eq symbol basevar) (message "`%s' is an alias for `%s'" symbol basevar)))) +;;;###autoload +(defun customize-toggle-option (symbol) + "Toggle the value of boolean option SYMBOL for this session." + (interactive (let ((prompt "Toggle boolean option: ") opts) + (mapatoms + (lambda (sym) + (when (eq (get sym 'custom-type) 'boolean) + (push sym opts)))) + (list (intern (completing-read prompt opts nil nil nil nil + (symbol-at-point)))))) + (let* ((setter (or (get symbol 'custom-set) #'set-default)) + (getter (or (get symbol 'custom-get) #'symbol-value)) + (value (condition-case nil + (funcall getter symbol) + (void-variable (error "`%s' is not bound" symbol)))) + (type (get symbol 'custom-type))) + (cond + ((eq type 'boolean)) + ((and (null type) + (yes-or-no-p + (format "`%s' doesn't have a type, and has the value %S. \ +Proceed to toggle?" symbol value)))) + ((yes-or-no-p + (format "`%s' is of type %s, and has the value %S. \ +Proceed to toggle?" + symbol type value))) + ((error "Abort toggling of option `%s'" symbol))) + (message "%s user options `%s'." + (if (funcall setter symbol (not value)) + "Enabled" "Disabled") + symbol))) + +;;;###autoload +(defalias 'toggle-option #'customize-toggle-option) + ;;;###autoload (defalias 'customize-variable-other-window 'customize-option-other-window) -- cgit v1.2.3 From 160165e8a97cfa3f3ffd803be373a3b34ed87597 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Tue, 13 Feb 2024 12:27:38 -0800 Subject: ; Compute the list of symbols for 'eshell-eval-using-options' once * lisp/eshell/esh-opt.el (eshell--get-option-symbols): New function... (eshell-eval-using-options): ... use it. (eshell--do-opts, eshell--process-args): Take OPTION-SYMS. * test/lisp/eshell/esh-opt-tests.el (esh-opt-test/process-args): (esh-opt-test/process-args-parse-leading-options-only): (esh-opt-test/process-args-external): Pass OPTION-SYMS in. --- lisp/eshell/esh-opt.el | 62 +++++++++++++++++++++------------------ test/lisp/eshell/esh-opt-tests.el | 24 ++++++++++----- 2 files changed, 50 insertions(+), 36 deletions(-) diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index d01e3569d57..e6f5fc9629a 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -100,29 +100,37 @@ the new process for its value. Lastly, any remaining arguments will be available in the locally let-bound variable `args'." (declare (debug (form form sexp body))) - `(let* ((temp-args - ,(if (memq ':preserve-args (cadr options)) - (list 'copy-tree macro-args) - (list 'eshell-stringify-list - (list 'flatten-tree macro-args)))) - (processed-args (eshell--do-opts ,name ,options temp-args ,macro-args)) - ,@(delete-dups - (delq nil (mapcar (lambda (opt) - (and (listp opt) (nth 3 opt) - `(,(nth 3 opt) (pop processed-args)))) - ;; `options' is of the form (quote OPTS). - (cadr options)))) - (args processed-args)) - ;; Silence unused lexical variable warning if body does not use `args'. - (ignore args) - ,@body-forms)) + (let ((option-syms (eshell--get-option-symbols + ;; `options' is of the form (quote OPTS). + (cadr options)))) + `(let* ((temp-args + ,(if (memq ':preserve-args (cadr options)) + (list 'copy-tree macro-args) + (list 'eshell-stringify-list + (list 'flatten-tree macro-args)))) + (args (eshell--do-opts ,name temp-args ,macro-args + ,options ',option-syms)) + ;; Bind all the option variables. When done, `args' will + ;; contain any remaining positional arguments. + ,@(mapcar (lambda (sym) `(,sym (pop args))) option-syms)) + ;; Silence unused lexical variable warning if body does not use `args'. + (ignore args) + ,@body-forms))) ;;; Internal Functions: ;; Documented part of the interface; see eshell-eval-using-options. (defvar eshell--args) -(defun eshell--do-opts (name options args orig-args) +(defun eshell--get-option-symbols (options) + "Get a list of symbols for the specified OPTIONS. +OPTIONS is a list of command-line options from +`eshell-eval-using-options' (which see)." + (delete-dups + (delq nil (mapcar (lambda (opt) (and (listp opt) (nth 3 opt))) + options)))) + +(defun eshell--do-opts (name args orig-args options option-syms) "Helper function for `eshell-eval-using-options'. This code doesn't really need to be macro expanded everywhere." (require 'esh-ext) @@ -134,7 +142,8 @@ This code doesn't really need to be macro expanded everywhere." (if (and (= (length args) 0) (memq ':show-usage options)) (eshell-show-usage name options) - (setq args (eshell--process-args name args options)) + (setq args (eshell--process-args name args options + option-syms)) nil)))) (when usage-msg (user-error "%s" usage-msg)))))) @@ -269,16 +278,13 @@ triggered to say that the switch is unrecognized." "%s: unrecognized option --%s") name (car switch))))))) -(defun eshell--process-args (name args options) - "Process the given ARGS using OPTIONS." - (let* ((seen ()) - (opt-vals (delq nil (mapcar (lambda (opt) - (when (listp opt) - (let ((sym (nth 3 opt))) - (when (and sym (not (memq sym seen))) - (push sym seen) - (list sym))))) - options))) +(defun eshell--process-args (name args options option-syms) + "Process the given ARGS for the command NAME using OPTIONS. +OPTION-SYMS is a list of symbols that will hold the processed arguments. + +Return a list of values corresponding to each element in OPTION-SYMS, +followed by any additional positional arguments." + (let* ((opt-vals (mapcar #'list option-syms)) (ai 0) arg (eshell--args args) (pos-argument-found nil)) diff --git a/test/lisp/eshell/esh-opt-tests.el b/test/lisp/eshell/esh-opt-tests.el index 8d6e0c1e426..4e5373e53cd 100644 --- a/test/lisp/eshell/esh-opt-tests.el +++ b/test/lisp/eshell/esh-opt-tests.el @@ -29,13 +29,15 @@ (eshell--process-args "sudo" '("-a") '((?a "all" nil show-all - "do not ignore entries starting with ."))))) + "do not ignore entries starting with .")) + '(show-all)))) (should (equal '("root" "world") (eshell--process-args "sudo" '("-u" "root" "world") '((?u "user" t user - "execute a command as another USER")))))) + "execute a command as another USER")) + '(user))))) (ert-deftest esh-opt-test/process-args-parse-leading-options-only () "Test behavior of :parse-leading-options-only in `eshell--process-args'." @@ -45,20 +47,23 @@ "sudo" '("emerge" "-uDN" "world") '((?u "user" t user "execute a command as another USER") - :parse-leading-options-only)))) + :parse-leading-options-only) + '(user)))) (should (equal '("root" "emerge" "-uDN" "world") (eshell--process-args "sudo" '("-u" "root" "emerge" "-uDN" "world") '((?u "user" t user "execute a command as another USER") - :parse-leading-options-only)))) + :parse-leading-options-only) + '(user)))) (should (equal '("DN" "emerge" "world") (eshell--process-args "sudo" '("-u" "root" "emerge" "-uDN" "world") '((?u "user" t user - "execute a command as another USER")))))) + "execute a command as another USER")) + '(user))))) (ert-deftest esh-opt-test/process-args-external () "Test behavior of :external in `eshell--process-args'." @@ -69,7 +74,8 @@ "ls" '("/some/path") '((?a "all" nil show-all "do not ignore entries starting with .") - :external "ls"))))) + :external "ls") + '(show-all))))) (cl-letf (((symbol-function 'eshell-search-path) #'identity)) (should (equal '(no-catch eshell-ext-command "ls") @@ -78,7 +84,8 @@ "ls" '("-u" "/some/path") '((?a "all" nil show-all "do not ignore entries starting with .") - :external "ls")) + :external "ls") + '(show-all)) :type 'no-catch)))) (cl-letf (((symbol-function 'eshell-search-path) #'ignore)) (should-error @@ -86,7 +93,8 @@ "ls" '("-u" "/some/path") '((?a "all" nil show-all "do not ignore entries starting with .") - :external "ls")) + :external "ls") + '(show-all)) :type 'error))) (ert-deftest esh-opt-test/eval-using-options-short () -- cgit v1.2.3 From 7c23234b4ea43a033e06eb466008e0dc8485920b Mon Sep 17 00:00:00 2001 From: Steven Allen Date: Sat, 10 Feb 2024 10:05:11 -0800 Subject: Respect :lisp-dir whilst scanning for VC package dependencies * lisp/emacs-lisp/package-vc.el (package-vc--unpack-1): Scan 'lisp-dir', if set, for lisp files instead of scanning the root package directory. (Bug#69019) --- lisp/emacs-lisp/package-vc.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index fc402716dab..37980c28b02 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -501,8 +501,10 @@ This includes downloading missing dependencies, generating autoloads, generating a package description file (used to identify a package as a VC package later on), building documentation and marking the package as installed." - (let ((pkg-spec (package-vc--desc->spec pkg-desc)) - missing) + (let* ((pkg-spec (package-vc--desc->spec pkg-desc)) + (lisp-dir (plist-get pkg-spec :lisp-dir)) + (lisp-path (file-name-concat pkg-dir lisp-dir)) + missing) ;; In case the package was installed directly from source, the ;; dependency list wasn't know beforehand, and they might have @@ -519,7 +521,7 @@ documentation and marking the package as installed." "\\|") regexp-unmatchable)) (deps '())) - (dolist (file (directory-files pkg-dir t "\\.el\\'" t)) + (dolist (file (directory-files lisp-path t "\\.el\\'" t)) (unless (string-match-p ignored-files file) (with-temp-buffer (insert-file-contents file) @@ -542,10 +544,8 @@ documentation and marking the package as installed." (pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir))) ;; Generate autoloads (let* ((name (package-desc-name pkg-desc)) - (auto-name (format "%s-autoloads.el" name)) - (lisp-dir (plist-get pkg-spec :lisp-dir))) - (package-generate-autoloads - name (file-name-concat pkg-dir lisp-dir)) + (auto-name (format "%s-autoloads.el" name))) + (package-generate-autoloads name lisp-path) (when lisp-dir (write-region (with-temp-buffer -- cgit v1.2.3 From 70d6f6c41c9b1985e0ec70b45aeeac6982a050bb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 13 Feb 2024 20:35:05 -0500 Subject: hideif.el: Minor cleanup * lisp/progmodes/hideif.el: Prefer #' to quote function names. (hif-eval): Use `lexical-binding`. (hif-ifx-regexp): Don't use `defconst` since `bovine/c.el` let-binds it. (hif--intern-safe): Rename from `intern-safe` to fix this namespace violation. (hif-strtok): Adjust accordingly. --- lisp/progmodes/hideif.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 71f55379d96..98e567299a1 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -390,7 +390,7 @@ If there is a marked region from START to END it only shows the symbols within." (defun hif-after-revert-function () (and hide-ifdef-mode hide-ifdef-hiding (hide-ifdefs nil nil t))) -(add-hook 'after-revert-hook 'hif-after-revert-function) +(add-hook 'after-revert-hook #'hif-after-revert-function) (defun hif-end-of-line () "Find the end-point of line concatenation." @@ -474,7 +474,7 @@ Everything including these lines is made invisible." (defun hif-eval (form) "Evaluate hideif internal representation." - (let ((val (eval form))) + (let ((val (eval form t))) (if (stringp val) (or (get-text-property 0 'hif-value val) val) @@ -542,7 +542,7 @@ that form should be displayed.") (defconst hif-cpp-prefix "\\(^\\|\r\\)?[ \t]*#[ \t]*") (defconst hif-ifxdef-regexp (concat hif-cpp-prefix "if\\(n\\)?def")) (defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef")) -(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\((\\|\\(n?def\\)?[ \t]+\\)")) +(defvar hif-ifx-regexp (concat hif-cpp-prefix "if\\((\\|\\(n?def\\)?[ \t]+\\)")) (defconst hif-elif-regexp (concat hif-cpp-prefix "elif")) (defconst hif-else-regexp (concat hif-cpp-prefix "else")) (defconst hif-endif-regexp (concat hif-cpp-prefix "endif")) @@ -679,7 +679,7 @@ that form should be displayed.") ("..." . hif-etc) ("defined" . hif-defined))) -(defconst hif-valid-token-list (mapcar 'cdr hif-token-alist)) +(defconst hif-valid-token-list (mapcar #'cdr hif-token-alist)) (defconst hif-token-regexp ;; The ordering of regexp grouping is crucial to `hif-strtok' @@ -690,7 +690,7 @@ that form should be displayed.") ;; decimal/octal: "\\|\\(\\([+-]?[0-9']+\\(\\.[0-9']*\\)?\\)\\([eE][+-]?[0-9]+\\)?" hif-numtype-suffix-regexp "?\\)" - "\\|" (regexp-opt (mapcar 'car hif-token-alist) t) + "\\|" (regexp-opt (mapcar #'car hif-token-alist) t) "\\|\\(\\w+\\)")) ;; C++11 Unicode string literals (L"" u8"" u"" U"" R"" LR"" u8R"" uR"") @@ -867,7 +867,7 @@ Assuming we've just performed a `hif-token-regexp' lookup." (t (setq hif-simple-token-only nil) - (intern-safe string))))) + (hif--intern-safe string))))) (defun hif-backward-comment (&optional start end) "If we're currently within a C(++) comment, skip them backwards." @@ -1448,7 +1448,7 @@ This macro cannot be evaluated alone without parameters input." (t (error "Invalid token to stringify")))) -(defun intern-safe (str) +(defun hif--intern-safe (str) (if (stringp str) (intern str))) -- cgit v1.2.3 From b54db9c9ac7599fc84f108eb6f469e2af4834bed Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 14 Feb 2024 05:24:36 +0200 Subject: ; * lisp/progmodes/elisp-mode.el (emacs-lisp-native-compile): Fix typo. --- lisp/progmodes/elisp-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 4e0e7552f8e..e0c18214ef7 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -233,7 +233,7 @@ visited by the current buffer." (byte-to-native-output-buffer-file nil) (eln (native-compile buffer-file-name))) (when eln - (comp-write--bytecode-file eln)))) + (comp--write-bytecode-file eln)))) (defun emacs-lisp-native-compile-and-load () "Native-compile the current buffer's file (if it has changed), then load it. -- cgit v1.2.3 From fa74c7f88a8f3216665ea386c5b6355e3660fb79 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 14 Feb 2024 09:20:48 +0200 Subject: Detect DEFUNs as outline-minor-mode headings in Emacs sources in c-ts-mode. * lisp/progmodes/c-ts-mode.el (c-ts-mode--outline-predicate): When c-ts-mode-emacs-sources-support is t, use c-ts-mode--emacs-defun-p (bug#68824). --- lisp/progmodes/c-ts-mode.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index c4b48f03d12..4ef17daf876 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -926,12 +926,12 @@ Return nil if NODE is not a defun node or doesn't have a name." (defun c-ts-mode--outline-predicate (node) "Match outlines on lines with function names." - (and (treesit-node-match-p - node "\\`function_declarator\\'" t) - (when-let ((parent (treesit-node-parent node))) - (treesit-node-match-p - parent - "\\`function_definition\\'" t)))) + (or (and (equal (treesit-node-type node) "function_declarator") + (equal (treesit-node-type (treesit-node-parent node)) + "function_definition")) + ;; DEFUNs in Emacs sources. + (and c-ts-mode-emacs-sources-support + (c-ts-mode--emacs-defun-p node)))) ;;; Defun navigation -- cgit v1.2.3 From decfdd4f1a1e3b1539eafdaaf11191e8477f0636 Mon Sep 17 00:00:00 2001 From: Gerd Möllmann Date: Wed, 14 Feb 2024 08:54:04 +0100 Subject: Take file-local variables into account in elint-file (bug#69076) * lisp/emacs-lisp/elint.el (elint-file): Use hack-local-variables. --- lisp/emacs-lisp/elint.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index a8bc4bdd1e0..27c169cc657 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el @@ -266,6 +266,7 @@ This environment can be passed to `macroexpand'." (insert-file-contents file) (let ((buffer-file-name file) (max-lisp-eval-depth (max 1000 max-lisp-eval-depth))) + (hack-local-variables) (with-syntax-table emacs-lisp-mode-syntax-table (mapc 'elint-top-form (elint-update-env))))) (elint-set-mode-line) -- cgit v1.2.3 From 3a93e301ddc913758abe05c876aa3016e8b23af8 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Tue, 13 Feb 2024 14:52:39 +0100 Subject: String hashing improvements (spread and performance) Fix gaps in hashing coverage in the middle and end of even fairly short strings. E.g., `outline-1`, `outline-2` etc all hashed to the exact same value but with the patch, there are no collisions among the ~160000 symbols in the Emacs tree. This change also improves average hashing speed by using fewer mixing operations. * src/fns.c (hash_string): Use unit stride for fairly short strings, while retaining the cap of 8 samples for long ones. Always hash the last word to ensure that the end of the string is covered. For strings shorter than a word, use fewer loads and a single reduction step. --- src/fns.c | 49 +++++++++++++++++++++++++++++++++++++------------ 1 file changed, 37 insertions(+), 12 deletions(-) diff --git a/src/fns.c b/src/fns.c index 918ba0370e8..f94e8519957 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5069,24 +5069,49 @@ hash_string (char const *ptr, ptrdiff_t len) EMACS_UINT hash = len; /* At most 8 steps. We could reuse SXHASH_MAX_LEN, of course, * but dividing by 8 is cheaper. */ - ptrdiff_t step = sizeof hash + ((end - p) >> 3); + ptrdiff_t step = max (sizeof hash, ((end - p) >> 3)); - while (p + sizeof hash <= end) + if (p + sizeof hash <= end) { + do + { + EMACS_UINT c; + /* We presume that the compiler will replace this `memcpy` with + a single load/move instruction when applicable. */ + memcpy (&c, p, sizeof hash); + p += step; + hash = sxhash_combine (hash, c); + } + while (p + sizeof hash <= end); + /* Hash the last wordful of bytes in the string, because that is + is often the part where strings differ. This may cause some + bytes to be hashed twice but we assume that's not a big problem. */ EMACS_UINT c; - /* We presume that the compiler will replace this `memcpy` with - a single load/move instruction when applicable. */ - memcpy (&c, p, sizeof hash); - p += step; + memcpy (&c, end - sizeof c, sizeof c); hash = sxhash_combine (hash, c); } - /* A few last bytes may remain (smaller than an EMACS_UINT). */ - /* FIXME: We could do this without a loop, but it'd require - endian-dependent code :-( */ - while (p < end) + else { - unsigned char c = *p++; - hash = sxhash_combine (hash, c); + /* String is shorter than an EMACS_UINT. Use smaller loads. */ + eassume (p <= end && end - p < sizeof (EMACS_UINT)); + EMACS_UINT tail = 0; + if (end - p >= 4) + { + uint32_t c; + memcpy (&c, p, sizeof c); + tail = (tail << (8 * sizeof c)) + c; + p += sizeof c; + } + if (end - p >= 2) + { + uint16_t c; + memcpy (&c, p, sizeof c); + tail = (tail << (8 * sizeof c)) + c; + p += sizeof c; + } + if (p < end) + tail = (tail << 8) + (unsigned char)*p; + hash = sxhash_combine (hash, tail); } return hash; -- cgit v1.2.3 From 0c7c8210cb6a87a06b61451d19f3601975569946 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 14 Feb 2024 17:27:43 +0100 Subject: Minor Tramp doc adaption * doc/misc/tramp.texi (Frequently Asked Questions): Be more precise with FIDO2 keys. * lisp/net/tramp.el: Adapt comments. --- doc/misc/tramp.texi | 4 ++-- lisp/net/tramp.el | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index db9cefbf966..0bed7dbe215 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5075,8 +5075,8 @@ the additional handshaking messages for them. This requires at least nitrokey, or titankey. @c @uref{https://docs.fedoraproject.org/en-US/quick-docs/using-yubikeys/} -@strong{Note} that there are reports on problems of handling yubikey -residential keys by @command{ssh-agent}. As workaround, you might +@strong{Note} that there are reports on problems of handling FIDO2 +(residential) keys by @command{ssh-agent}. As workaround, you might disable @command{ssh-agent} for such keys. @item diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index f3da56e7a4f..9d883c96252 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -763,9 +763,8 @@ The regexp should match at end of buffer." ;; A security key requires the user physically to touch the device ;; with their finger. We must tell it to the user. -;; Added in OpenSSH 8.2. I've tested it with yubikey. Nitrokey and -;; Titankey, which have also passed the tests, do not show such a -;; message. +;; Added in OpenSSH 8.2. I've tested it with Nitrokey, Titankey, and +;; Yubikey. (defcustom tramp-security-key-confirm-regexp (rx bol (* "\r") "Confirm user presence for key " (* nonl) (* (any "\r\n"))) "Regular expression matching security key confirmation message. @@ -788,6 +787,7 @@ The regexp should match at end of buffer." :version "28.1" :type 'regexp) +;; Needed only for FIDO2 (residential) keys. Tested with Nitrokey and Yubikey. (defcustom tramp-security-key-pin-regexp (rx bol (* "\r") (group "Enter PIN for " (* nonl)) (* (any "\r\n"))) "Regular expression matching security key PIN prompt. -- cgit v1.2.3 From 61a145076275a9da79d0372d50def4aaf5117587 Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Tue, 30 Jan 2024 00:52:39 -0800 Subject: Improve directory prompt used by package-vc-checkout * lisp/emacs-lisp/package-vc.el (package-vc--read-package-name): Use read-directory-name instead of read-file-name. (Bug#66114) --- lisp/emacs-lisp/package-vc.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index e89ead89d4b..5c5486de290 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -825,8 +825,8 @@ for the last released version of the package." (interactive (let* ((name (package-vc--read-package-name "Fetch package source: "))) (list (cadr (assoc name package-archive-contents #'string=)) - (read-file-name "Clone into new or empty directory: " nil nil t nil - (lambda (dir) (or (not (file-exists-p dir)) + (read-directory-name "Clone into new or empty directory: " nil nil + (lambda (dir) (or (not (file-exists-p dir)) (directory-empty-p dir)))) (and current-prefix-arg :last-release)))) (setf directory (expand-file-name directory)) -- cgit v1.2.3 From fbef8ff2a4106ff7f0f3d026071fb8096280cc61 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 14 Feb 2024 17:18:50 -0500 Subject: titdic-cnv.el: Bring all definitions under the `tit-` namespace Add a `tit-` or `tit--` prefix where necessary. Adjust all callers. I kept the old names via obsolete aliases for now, although it's probably not worth the trouble. * lisp/international/titdic-cnv.el: Bring all definitions under the `tit-` namespace. (tit-quail-cxterm-package-ext-info): Rename var from `quail-cxterm-package-ext-info`. Adjust value to new names. (tit-dic-convert): Rename from `titdic-convert`. (batch-tit-dic-convert): Rename from `batch-titdic-convert`. (tit-quail-misc-package-ext-info): Rename var from `quail-misc-package-ext-info`. Adjust value to new names. (tit--tsang-quick-converter): Rename from `tsang-quick-converter`. (tit--tsang-b5-converter): Rename from `tsang-b5-converter`. (tit--quick-b5-converter): Rename from `quick-b5-converter`. (tit--tsang-cns-converter): Rename from `tsang-cns-converter`. (tit--quick-cns-converter): Rename from `quick-cns-converter`. (tit--py-converter): Rename from `py-converter`. (tit--ziranma-converter): Rename from `ziranma-converter`. (tit--ctlau-converter): Rename from `ctlau-converter`. (tit--ctlau-gb-converter): Rename from `ctlau-gb-converter`. (tit--ctlau-b5-converter): Rename from `ctlau-b5-converter`. (tit-miscdic-convert): Rename from `miscdic-convert`. (batch-tit-miscdic-convert): Rename from `batch-miscdic-convert`. (tit-pinyin-convert): Rename from `pinyin-convert`. * leim/Makefile.in (${leimdir}/quail/%.el, misc_convert) (${srcdir}/../lisp/language/pinyin.el): Use the new names. --- etc/NEWS | 5 ++ leim/Makefile.in | 6 +- lisp/international/titdic-cnv.el | 119 +++++++++++++++++++++++---------------- 3 files changed, 79 insertions(+), 51 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index e6b1d424499..dc24d775bb1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -430,6 +430,11 @@ respectively, in addition to the existing translations 'C-x 8 / e' and * Changes in Specialized Modes and Packages in Emacs 30.1 +--- +** Titdic-cnv +Most of the variables and functions in the file have been renamed to +make sure they all use a 'tit-' namespace prefix. + --- ** Trace In batch mode, tracing now sends the trace to stdout. diff --git a/leim/Makefile.in b/leim/Makefile.in index f7a23178919..bc1eeb5e634 100644 --- a/leim/Makefile.in +++ b/leim/Makefile.in @@ -101,11 +101,11 @@ ${leimdir}/quail ${leimdir}/ja-dic: ## All of TIT_GB and TIT_BIG5. ${leimdir}/quail/%.el: ${srcdir}/CXTERM-DIC/%.tit $(AM_V_GEN)${RUN_EMACS} -l titdic-cnv \ - -f batch-titdic-convert -dir ${leimdir}/quail $< + -f batch-tit-dic-convert -dir ${leimdir}/quail $< misc_convert = $(AM_V_GEN)${RUN_EMACS} \ - -l titdic-cnv -f batch-miscdic-convert -dir ${leimdir}/quail + -l titdic-cnv -f batch-tit-miscdic-convert -dir ${leimdir}/quail ## CTLau.el, CTLau-b5.el. ${leimdir}/quail/CT%.el: ${srcdir}/MISC-DIC/CT%.html @@ -148,7 +148,7 @@ ${leimdir}/ja-dic/ja-dic.el: $(srcdir)/SKK-DIC/SKK-JISYO.L small-ja-dic-option -f batch-skkdic-convert -dir "$(leimdir)/ja-dic" $(JA_DIC_NO_REDUCTION_OPTION) "$<" ${srcdir}/../lisp/language/pinyin.el: ${srcdir}/MISC-DIC/pinyin.map - $(AM_V_GEN)${RUN_EMACS} -l titdic-cnv -f pinyin-convert $< $@ + $(AM_V_GEN)${RUN_EMACS} -l titdic-cnv -f tit-pinyin-convert $< $@ .PHONY: bootstrap-clean distclean maintainer-clean gen-clean diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el index c4706e061e3..42584f6548c 100644 --- a/lisp/international/titdic-cnv.el +++ b/lisp/international/titdic-cnv.el @@ -31,12 +31,12 @@ ;; Convert cxterm dictionary (of TIT format) to quail-package. ;; ;; Usage (within Emacs): -;; M-x titdic-convertCXTERM-DICTIONARY-NAME +;; M-x tit-dic-convertCXTERM-DICTIONARY-NAME ;; Usage (from shell): -;; % emacs -batch -l titdic-cnv -f batch-titdic-convert\ +;; % emacs -batch -l titdic-cnv -f batch-tit-dic-convert\ ;; [-dir DIR] [DIR | FILE] ... ;; -;; When you run titdic-convert within Emacs, you have a chance to +;; When you run `tit-dic-convert' within Emacs, you have a chance to ;; modify arguments of `quail-define-package' before saving the ;; converted file. For instance, you are likely to modify TITLE, ;; DOCSTRING, and KEY-BINDINGS. @@ -90,7 +90,8 @@ ;; \ is replaced by a description about ;; how to select a translation from a list of candidates. -(defvar quail-cxterm-package-ext-info +(define-obsolete-variable-alias 'quail-cxterm-package-ext-info 'tit-quail-cxterm-package-ext-info "30.1") +(defvar tit-quail-cxterm-package-ext-info '(("chinese-4corner" "四角") ("chinese-array30" "３０") ("chinese-ccdospy" "缩拼" @@ -277,7 +278,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, (tit-moveleft ",<") (tit-keyprompt nil)) - (generate-lisp-file-heading filename 'titdic-convert :code nil) + (generate-lisp-file-heading filename 'tit-dic-convert :code nil) (princ ";; Quail package `") (princ package) (princ "\n") @@ -354,7 +355,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, (princ "(quail-define-package ") ;; Args NAME, LANGUAGE, TITLE - (let ((title (nth 1 (assoc package quail-cxterm-package-ext-info)))) + (let ((title (nth 1 (assoc package tit-quail-cxterm-package-ext-info)))) (princ "\"") (princ package) (princ "\" \"") @@ -383,7 +384,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, (let ((doc (concat tit-prompt "\n")) (comments (if tit-comments (mapconcat #'identity (nreverse tit-comments) "\n"))) - (doc-ext (nth 2 (assoc package quail-cxterm-package-ext-info)))) + (doc-ext (nth 2 (assoc package tit-quail-cxterm-package-ext-info)))) (if comments (setq doc (concat doc "\n" comments "\n"))) (if doc-ext @@ -476,6 +477,9 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, ;;;###autoload (defun titdic-convert (filename &optional dirname) + (declare (obsolete tit-dic-convert "30.1")) + (tit-dic-convert filename dirname)) +(defun tit-dic-convert (filename &optional dirname) "Convert a TIT dictionary of FILENAME into a Quail package. Optional argument DIRNAME if specified is the directory name under which the generated Quail package is saved." @@ -531,21 +535,24 @@ the generated Quail package is saved." ;;;###autoload (defun batch-titdic-convert (&optional force) - "Run `titdic-convert' on the files remaining on the command line. + (declare (obsolete batch-tit-dic-convert "30.1")) + (batch-tit-dic-convert force)) +(defun batch-tit-dic-convert (&optional force) + "Run `tit-dic-convert' on the files remaining on the command line. Use this from the command line, with `-batch'; it won't work in an interactive Emacs. -For example, invoke \"emacs -batch -f batch-titdic-convert XXX.tit\" to +For example, invoke \"emacs -batch -f batch-tit-dic-convert XXX.tit\" to generate Quail package file \"xxx.el\" from TIT dictionary file \"XXX.tit\". -To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." +To get complete usage, invoke \"emacs -batch -f batch-tit-dic-convert -h\"." (defvar command-line-args-left) ; Avoid compiler warning. (if (not noninteractive) - (error "`batch-titdic-convert' should be used only with -batch")) + (error "`batch-tit-dic-convert' should be used only with -batch")) (if (string= (car command-line-args-left) "-h") (progn (message "To convert XXX.tit and YYY.tit into xxx.el and yyy.el:") - (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert XXX.tit YYY.tit") + (message " %% emacs -batch -l titdic-cnv -f batch-tit-dic-convert XXX.tit YYY.tit") (message "To convert XXX.tit into DIR/xxx.el:") - (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert -dir DIR XXX.tit")) + (message " %% emacs -batch -l titdic-cnv -f batch-tit-dic-convert -dir DIR XXX.tit")) (let (targetdir filename files file) (if (string= (car command-line-args-left) "-dir") (progn @@ -564,7 +571,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." (when (or force (file-newer-than-file-p file (tit-make-quail-package-file-name file targetdir))) - (titdic-convert file targetdir)) + (tit-dic-convert file targetdir)) (setq files (cdr files))) (setq command-line-args-left (cdr command-line-args-left))))) (kill-emacs 0)) @@ -583,10 +590,11 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ;; COPYRIGHT-NOTICE ;; Copyright notice of the source dictionary. ;; ) -(defvar quail-misc-package-ext-info +(define-obsolete-variable-alias 'quail-misc-package-ext-info 'tit-quail-misc-package-ext-info "30.1") +(defvar tit-quail-misc-package-ext-info '(("chinese-b5-tsangchi" "倉B" "cangjie-table.b5" big5 "tsang-b5.el" - tsang-b5-converter + tit--tsang-b5-converter "\ ;; # Copyright 2001 Christian Wittern ;; # @@ -596,7 +604,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-b5-quick" "簡B" "cangjie-table.b5" big5 "quick-b5.el" - quick-b5-converter + tit--quick-b5-converter "\ ;; # Copyright 2001 Christian Wittern ;; # @@ -606,7 +614,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-cns-tsangchi" "倉C" "cangjie-table.cns" iso-2022-cn-ext "tsang-cns.el" - tsang-cns-converter + tit--tsang-cns-converter "\ ;; # Copyright 2001 Christian Wittern ;; # @@ -616,7 +624,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-cns-quick" "簡C" "cangjie-table.cns" iso-2022-cn-ext "quick-cns.el" - quick-cns-converter + tit--quick-cns-converter "\ ;; # Copyright 2001 Christian Wittern ;; # @@ -626,7 +634,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-py" "拼G" "pinyin.map" cn-gb-2312 "PY.el" - py-converter + tit--py-converter "\ ;; \"pinyin.map\" is included in a free package called CCE. It is ;; available at: [link needs updating -- SK 2021-09-27] @@ -654,7 +662,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-ziranma" "自然" "ziranma.cin" cn-gb-2312 "ZIRANMA.el" - ziranma-converter + tit--ziranma-converter "\ ;; \"ziranma.cin\" is included in a free package called CCE. It is ;; available at: [link needs updating -- SK 2021-09-27] @@ -682,7 +690,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-ctlau" "刘粤" "CTLau.html" cn-gb-2312 "CTLau.el" - ctlau-gb-converter + tit--ctlau-gb-converter "\ ;; \"CTLau.html\" is available at: ;; @@ -707,7 +715,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-ctlaub" "劉粵" "CTLau-b5.html" big5 "CTLau-b5.el" - ctlau-b5-converter + tit--ctlau-b5-converter "\ ;; \"CTLau-b5.html\" is available at: ;; @@ -740,7 +748,8 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ;; input method is for inputting Big5 characters. Otherwise the input ;; method is for inputting CNS characters. -(defun tsang-quick-converter (dicbuf tsang-p big5-p) +(define-obsolete-function-alias 'tsang-quick-converter #'tit--tsang-quick-converter "30.1") +(defun tit--tsang-quick-converter (dicbuf tsang-p big5-p) (let ((fulltitle (if tsang-p "倉頡" "簡易")) dic) (goto-char (point-max)) @@ -822,23 +831,28 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." (if big5-p (nth 1 elt) (nth 2 elt)))))) (insert ")\n"))) -(defun tsang-b5-converter (dicbuf) - (tsang-quick-converter dicbuf t t)) +(define-obsolete-function-alias 'tsang-b5-converter #'tit--tsang-b5-converter "30.1") +(defun tit--tsang-b5-converter (dicbuf) + (tit--tsang-quick-converter dicbuf t t)) -(defun quick-b5-converter (dicbuf) - (tsang-quick-converter dicbuf nil t)) +(define-obsolete-function-alias 'quick-b5-converter #'tit--quick-b5-converter "30.1") +(defun tit--quick-b5-converter (dicbuf) + (tit--tsang-quick-converter dicbuf nil t)) -(defun tsang-cns-converter (dicbuf) - (tsang-quick-converter dicbuf t nil)) +(define-obsolete-function-alias 'tsang-cns-converter #'tit--tsang-cns-converter "30.1") +(defun tit--tsang-cns-converter (dicbuf) + (tit--tsang-quick-converter dicbuf t nil)) -(defun quick-cns-converter (dicbuf) - (tsang-quick-converter dicbuf nil nil)) +(define-obsolete-function-alias 'quick-cns-converter #'tit--quick-cns-converter "30.1") +(defun tit--quick-cns-converter (dicbuf) + (tit--tsang-quick-converter dicbuf nil nil)) ;; Generate a code of a Quail package in the current buffer from ;; Pinyin dictionary in the buffer DICBUF. The input method name of ;; the Quail package is NAME, and the title string is TITLE. -(defun py-converter (dicbuf) +(define-obsolete-function-alias 'py-converter #'tit--py-converter "30.1") +(defun tit--py-converter (dicbuf) (goto-char (point-max)) (insert (format "%S\n" "汉字输入∷拼音∷ @@ -913,7 +927,8 @@ method `chinese-tonepy' with which you must specify tones by digits ;; Ziranma dictionary in the buffer DICBUF. The input method name of ;; the Quail package is NAME, and the title string is TITLE. -(defun ziranma-converter (dicbuf) +(define-obsolete-function-alias 'ziranma-converter #'tit--ziranma-converter "30.1") +(defun tit--ziranma-converter (dicbuf) (let (dic) (with-current-buffer dicbuf (goto-char (point-min)) @@ -1022,7 +1037,8 @@ To input symbols and punctuation, type `/' followed by one of `a' to ;; method name of the Quail package is NAME, and the title string is ;; TITLE. DESCRIPTION is the string shown by describe-input-method. -(defun ctlau-converter (dicbuf description) +(define-obsolete-function-alias 'ctlau-converter #'tit--ctlau-converter "30.1") +(defun tit--ctlau-converter (dicbuf description) (goto-char (point-max)) (insert (format "%S\n" description)) (insert " '((\"\C-?\" . quail-delete-last-char) @@ -1071,8 +1087,9 @@ To input symbols and punctuation, type `/' followed by one of `a' to (forward-line 1))) (insert ")\n")) -(defun ctlau-gb-converter (dicbuf) - (ctlau-converter dicbuf +(define-obsolete-function-alias 'ctlau-gb-converter #'tit--ctlau-gb-converter "30.1") +(defun tit--ctlau-gb-converter (dicbuf) + (tit--ctlau-converter dicbuf "汉字输入∷刘锡祥式粤音∷ 刘锡祥式粤语注音方案 @@ -1085,8 +1102,9 @@ To input symbols and punctuation, type `/' followed by one of `a' to Some infrequent GB characters are accessed by typing \\, followed by the Cantonese romanization of the respective radical (部首).")) -(defun ctlau-b5-converter (dicbuf) - (ctlau-converter dicbuf +(define-obsolete-function-alias 'ctlau-b5-converter #'tit--ctlau-b5-converter "30.1") +(defun tit--ctlau-b5-converter (dicbuf) + (tit--ctlau-converter dicbuf "漢字輸入：劉錫祥式粵音： 劉錫祥式粵語注音方案 @@ -1101,14 +1119,15 @@ To input symbols and punctuation, type `/' followed by one of `a' to (declare-function dos-8+3-filename "dos-fns.el" (filename)) -(defun miscdic-convert (filename &optional dirname) +(define-obsolete-function-alias 'miscdic-convert #'tit-miscdic-convert "30.1") +(defun tit-miscdic-convert (filename &optional dirname) "Convert a dictionary file FILENAME into a Quail package. Optional argument DIRNAME if specified is the directory name under which the generated Quail package is saved." (interactive "FInput method dictionary file: ") (or (file-readable-p filename) (error "%s does not exist" filename)) - (let ((tail quail-misc-package-ext-info) + (let ((tail tit-quail-misc-package-ext-info) coding-system-for-write slot name title dicfile coding quailfile converter copyright) @@ -1137,7 +1156,7 @@ the generated Quail package is saved." ;; Explicitly set eol format to `unix'. (setq coding-system-for-write 'utf-8-unix) (with-temp-file (expand-file-name quailfile dirname) - (generate-lisp-file-heading quailfile 'miscdic-convert) + (generate-lisp-file-heading quailfile 'tit-miscdic-convert) (insert (format-message ";; Quail package `%s'\n" name)) (insert ";; Source dictionary file: " dicfile "\n") (insert ";; Copyright notice of the source file\n") @@ -1164,15 +1183,17 @@ the generated Quail package is saved." quailfile :inhibit-provide t :compile t :coding nil))) (setq tail (cdr tail))))) -(defun batch-miscdic-convert () - "Run `miscdic-convert' on the files remaining on the command line. +;; Used in `Makefile.in'. +(define-obsolete-function-alias 'batch-miscdic-convert #'batch-tit-miscdic-convert "30.1") +(defun batch-tit-miscdic-convert () + "Run `tit-miscdic-convert' on the files remaining on the command line. Use this from the command line, with `-batch'; it won't work in an interactive Emacs. If there's an argument \"-dir\", the next argument specifies a directory to store generated Quail packages." (defvar command-line-args-left) ; Avoid compiler warning. (if (not noninteractive) - (error "`batch-miscdic-convert' should be used only with -batch")) + (error "`batch-tit-miscdic-convert' should be used only with -batch")) (let ((dir default-directory) filename) (while command-line-args-left @@ -1186,11 +1207,13 @@ to store generated Quail packages." (if (file-directory-p filename) (dolist (file (directory-files filename t nil t)) (or (file-directory-p file) - (miscdic-convert file dir))) - (miscdic-convert filename dir)))) + (tit-miscdic-convert file dir))) + (tit-miscdic-convert filename dir)))) (kill-emacs 0)) -(defun pinyin-convert () +;; Used in `Makefile.in'. +(define-obsolete-function-alias 'pinyin-convert #'tit-pinyin-convert "30.1") +(defun tit-pinyin-convert () "Convert text file pinyin.map into an elisp library. The library is named pinyin.el, and contains the constant `pinyin-character-map'." -- cgit v1.2.3 From 1035669b38b5aa2aa277e7423837c80534332c19 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 15 Feb 2024 00:39:00 +0100 Subject: Add cross-reference to ELisp manual Caveats * doc/lispref/intro.texi (Caveats): Add cross-reference to Emacs manual. Talking about "contributing code" makes little sense in a section about reporting mistakes in the ELisp manual, so skip that part. --- doc/lispref/intro.texi | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi index 2062ae64866..486125acb0d 100644 --- a/doc/lispref/intro.texi +++ b/doc/lispref/intro.texi @@ -89,9 +89,9 @@ you are criticizing. @cindex bugs @cindex suggestions -Please send comments and corrections using @kbd{M-x -report-emacs-bug}. If you wish to contribute new code (or send a -patch to fix a problem), use @kbd{M-x submit-emacs-patch}. +Please send comments and corrections using @kbd{M-x report-emacs-bug}. +For more details, @xref{Bugs,, Reporting Bugs, emacs, The GNU Emacs +Manual}. @node Lisp History @section Lisp History -- cgit v1.2.3 From 7256690a3ca4840e0f682a552d45321a1b710398 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 15 Feb 2024 00:51:05 +0100 Subject: * BUGS: Note how to report critical security issues. --- BUGS | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/BUGS b/BUGS index ee473213c89..f23faa7c756 100644 --- a/BUGS +++ b/BUGS @@ -21,6 +21,10 @@ If necessary, you can read the manual without an info program: cat info/emacs* | more "+/^File: emacs.*, Node: Bugs," +If you think you may have found a critical security issue that needs +to be communicated privately, please contact the GNU Emacs maintainers +directly. See admin/MAINTAINERS for their contact details. + Please first check the file etc/PROBLEMS (e.g. with C-h C-p in Emacs) to make sure it isn't a known issue. -- cgit v1.2.3 From 7c32f3bcd6d390510d9463b3100255cecab41e1c Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 14 Feb 2024 21:18:25 -0800 Subject: Adjust to recent Gnulib nstrftime changes * admin/merge-gnulib (AVOIDED_MODULES): Add localename. * configure.ac (REQUIRE_GNUISH_STRFTIME_AM_PM): Define. --- admin/merge-gnulib | 2 +- configure.ac | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 5246fb14e1e..35966852e27 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -53,7 +53,7 @@ GNULIB_MODULES=' AVOIDED_MODULES=' access btowc chmod close crypto/af_alg dup fchdir fstat - iswblank iswctype iswdigit iswxdigit langinfo lock + iswblank iswctype iswdigit iswxdigit langinfo localename lock mbrtowc mbsinit memchr mkdir msvc-inval msvc-nothrow nl_langinfo openat-die opendir pthread-h raise save-cwd select setenv sigprocmask stat stdarg diff --git a/configure.ac b/configure.ac index 847fdbd54d2..c162f880e48 100644 --- a/configure.ac +++ b/configure.ac @@ -1566,6 +1566,8 @@ AC_DEFUN([gt_TYPE_WINT_T], AC_DEFUN_ONCE([gl_STDLIB_H], [AC_REQUIRE([gl_STDLIB_H_DEFAULTS]) gl_NEXT_HEADERS([stdlib.h])]) +AC_DEFINE([REQUIRE_GNUISH_STRFTIME_AM_PM], [false], + [Emacs does not need glibc strftime behavior for AM and PM indicators.]) # Initialize gnulib right after choosing the compiler. dnl Amongst other things, this sets AR and ARFLAGS. -- cgit v1.2.3 From 377e4212e9df293ba2021238bae2bdccf5c8b8d3 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 14 Feb 2024 21:18:25 -0800 Subject: Update from Gnulib by running admin/merge-gnulib * lib/strftime.c: New file, copied from Gnulib. --- doc/misc/texinfo.tex | 37 +- lib/gnulib.mk.in | 5 +- lib/limits.in.h | 2 +- lib/nstrftime.c | 1501 +---------------------------------- lib/strftime.c | 2051 ++++++++++++++++++++++++++++++++++++++++++++++++ lib/strftime.h | 73 +- lib/time.in.h | 6 +- lib/time_r.c | 5 + lib/warn-on-use.h | 4 + lib/xalloc-oversized.h | 3 +- m4/gnulib-common.m4 | 76 +- m4/gnulib-comp.m4 | 3 +- m4/nanosleep.m4 | 6 +- m4/nstrftime.m4 | 5 +- m4/utimens.m4 | 15 +- m4/utimensat.m4 | 5 +- 16 files changed, 2211 insertions(+), 1586 deletions(-) create mode 100644 lib/strftime.c diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index e8c382f5967..93d592193a0 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,9 +3,9 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2023-09-19.19} +\def\texinfoversion{2024-02-10.22} % -% Copyright 1985, 1986, 1988, 1990-2023 Free Software Foundation, Inc. +% Copyright 1985, 1986, 1988, 1990-2024 Free Software Foundation, Inc. % % This texinfo.tex file is free software: you can redistribute it and/or % modify it under the terms of the GNU General Public License as @@ -5238,14 +5238,14 @@ $$% % the current value of \escapechar. \def\escapeisbackslash{\escapechar=`\\} -% Use \ in index files by default. texi2dvi didn't support @ as the escape -% character (as it checked for "\entry" in the files, and not "@entry"). When -% the new version of texi2dvi has had a chance to become more prevalent, then -% the escape character can change back to @ again. This should be an easy -% change to make now because both @ and \ are only used as escape characters in -% index files, never standing for themselves. +% Uncomment to use \ in index files by default. Old texi2dvi (before 2019) +% didn't support @ as the escape character (as it checked for "\entry" in +% the files, and not "@entry"). +% In the future we can remove this flag and simplify the code for +% index files and backslashes, once the support is no longer likely to be +% useful. % -\set txiindexescapeisbackslash +% \set txiindexescapeisbackslash % Write the entry in \indextext to the index file. % @@ -6137,8 +6137,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% % normally unnmhead0 calls unnumberedzzz: \outer\parseargdef\unnumbered{\unnmhead0{#1}} \def\unnumberedzzz#1{% - \global\secno=0 \global\subsecno=0 \global\subsubsecno=0 - \global\advance\unnumberedno by 1 + \global\advance\unnumberedno by 1 % % Since an unnumbered has no number, no prefix for figures. \global\let\chaplevelprefix = \empty @@ -6194,8 +6193,8 @@ might help (with 'rm \jobname.?? \jobname.??s')% % normally calls unnumberedseczzz: \outer\parseargdef\unnumberedsec{\unnmhead1{#1}} \def\unnumberedseczzz#1{% - \global\subsecno=0 \global\subsubsecno=0 \global\advance\secno by 1 - \sectionheading{#1}{sec}{Ynothing}{\the\unnumberedno.\the\secno}% + \global\advance\unnumberedno by 1 + \sectionheading{#1}{sec}{Ynothing}{\the\unnumberedno}% } % Subsections. @@ -6218,9 +6217,8 @@ might help (with 'rm \jobname.?? \jobname.??s')% % normally calls unnumberedsubseczzz: \outer\parseargdef\unnumberedsubsec{\unnmhead2{#1}} \def\unnumberedsubseczzz#1{% - \global\subsubsecno=0 \global\advance\subsecno by 1 - \sectionheading{#1}{subsec}{Ynothing}% - {\the\unnumberedno.\the\secno.\the\subsecno}% + \global\advance\unnumberedno by 1 + \sectionheading{#1}{subsec}{Ynothing}{\the\unnumberedno}% } % Subsubsections. @@ -6244,9 +6242,8 @@ might help (with 'rm \jobname.?? \jobname.??s')% % normally unnumberedsubsubseczzz: \outer\parseargdef\unnumberedsubsubsec{\unnmhead3{#1}} \def\unnumberedsubsubseczzz#1{% - \global\advance\subsubsecno by 1 - \sectionheading{#1}{subsubsec}{Ynothing}% - {\the\unnumberedno.\the\secno.\the\subsecno.\the\subsubsecno}% + \global\advance\unnumberedno by 1 + \sectionheading{#1}{subsubsec}{Ynothing}{\the\unnumberedno}% } % These macros control what the section commands do, according @@ -8205,8 +8202,6 @@ might help (with 'rm \jobname.?? \jobname.??s')% \let\commondummyword\unmacrodo \xdef\macrolist{\macrolist}% \endgroup - \else - \errmessage{Macro #1 not defined}% \fi } diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index e10aab5fc8d..9970f7810e2 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -47,6 +47,7 @@ # --avoid=iswdigit \ # --avoid=iswxdigit \ # --avoid=langinfo \ +# --avoid=localename \ # --avoid=lock \ # --avoid=mbrtowc \ # --avoid=mbsinit \ @@ -2745,7 +2746,9 @@ ifeq (,$(OMIT_GNULIB_MODULE_nstrftime)) libgnu_a_SOURCES += nstrftime.c -EXTRA_DIST += strftime.h +EXTRA_DIST += strftime.c strftime.h + +EXTRA_libgnu_a_SOURCES += strftime.c endif ## end gnulib module nstrftime diff --git a/lib/limits.in.h b/lib/limits.in.h index 236fc58e525..c65eb4c1cfe 100644 --- a/lib/limits.in.h +++ b/lib/limits.in.h @@ -130,7 +130,7 @@ # define BOOL_WIDTH 1 # define BOOL_MAX 1 # elif ! defined BOOL_MAX -# define BOOL_MAX ((((1U << (BOOL_WIDTH - 1)) - 1) << 1) + 1) +# define BOOL_MAX 1 # endif #endif diff --git a/lib/nstrftime.c b/lib/nstrftime.c index 69e4164dc0c..88490064297 100644 --- a/lib/nstrftime.c +++ b/lib/nstrftime.c @@ -1,5 +1,6 @@ -/* Copyright (C) 1991-2024 Free Software Foundation, Inc. - This file is part of the GNU C Library. +/* Generate time strings. + + Copyright (C) 2024 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as @@ -14,1497 +15,5 @@ You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . */ -#ifdef _LIBC -# define USE_IN_EXTENDED_LOCALE_MODEL 1 -# define HAVE_STRUCT_ERA_ENTRY 1 -# define HAVE_TM_GMTOFF 1 -# define HAVE_STRUCT_TM_TM_ZONE 1 -# define HAVE_TZNAME 1 -# include "../locale/localeinfo.h" -#else -# include -# if FPRINTFTIME -# include "fprintftime.h" -# else -# include "strftime.h" -# endif -# include "time-internal.h" -#endif - -#include -#include -#include - -#if HAVE_TZNAME && !HAVE_DECL_TZNAME -extern char *tzname[]; -#endif - -/* Do multibyte processing if multibyte encodings are supported, unless - multibyte sequences are safe in formats. Multibyte sequences are - safe if they cannot contain byte sequences that look like format - conversion specifications. The multibyte encodings used by the - C library on the various platforms (UTF-8, GB2312, GBK, CP936, - GB18030, EUC-TW, BIG5, BIG5-HKSCS, CP950, EUC-JP, EUC-KR, CP949, - SHIFT_JIS, CP932, JOHAB) are safe for formats, because the byte '%' - cannot occur in a multibyte character except in the first byte. - - The DEC-HANYU encoding used on OSF/1 is not safe for formats, but - this encoding has never been seen in real-life use, so we ignore - it. */ -#if !(defined __osf__ && 0) -# define MULTIBYTE_IS_FORMAT_SAFE 1 -#endif -#define DO_MULTIBYTE (! MULTIBYTE_IS_FORMAT_SAFE) - -#if DO_MULTIBYTE -# include - static const mbstate_t mbstate_zero; -#endif - -#include -#include -#include -#include -#include - -#include "attribute.h" -#include - -#ifdef COMPILE_WIDE -# include -# define CHAR_T wchar_t -# define UCHAR_T unsigned int -# define L_(Str) L##Str -# define NLW(Sym) _NL_W##Sym - -# define MEMCPY(d, s, n) __wmemcpy (d, s, n) -# define STRLEN(s) __wcslen (s) - -#else -# define CHAR_T char -# define UCHAR_T unsigned char -# define L_(Str) Str -# define NLW(Sym) Sym -# define ABALTMON_1 _NL_ABALTMON_1 - -# define MEMCPY(d, s, n) memcpy (d, s, n) -# define STRLEN(s) strlen (s) - -#endif - -/* Shift A right by B bits portably, by dividing A by 2**B and - truncating towards minus infinity. A and B should be free of side - effects, and B should be in the range 0 <= B <= INT_BITS - 2, where - INT_BITS is the number of useful bits in an int. GNU code can - assume that INT_BITS is at least 32. - - ISO C99 says that A >> B is implementation-defined if A < 0. Some - implementations (e.g., UNICOS 9.0 on a Cray Y-MP EL) don't shift - right in the usual way when A < 0, so SHR falls back on division if - ordinary A >> B doesn't seem to be the usual signed shift. */ -#define SHR(a, b) \ - (-1 >> 1 == -1 \ - ? (a) >> (b) \ - : ((a) + ((a) < 0)) / (1 << (b)) - ((a) < 0)) - -#define TM_YEAR_BASE 1900 - -#ifndef __isleap -/* Nonzero if YEAR is a leap year (every 4 years, - except every 100th isn't, and every 400th is). */ -# define __isleap(year) \ - ((year) % 4 == 0 && ((year) % 100 != 0 || (year) % 400 == 0)) -#endif - - -#ifdef _LIBC -# define mktime_z(tz, tm) mktime (tm) -# define tzname __tzname -# define tzset __tzset -#endif - -#ifndef FPRINTFTIME -# define FPRINTFTIME 0 -#endif - -#if FPRINTFTIME -# define STREAM_OR_CHAR_T FILE -# define STRFTIME_ARG(x) /* empty */ -#else -# define STREAM_OR_CHAR_T CHAR_T -# define STRFTIME_ARG(x) x, -#endif - -#if FPRINTFTIME -# define memset_byte(P, Len, Byte) \ - do { size_t _i; for (_i = 0; _i < Len; _i++) fputc (Byte, P); } while (0) -# define memset_space(P, Len) memset_byte (P, Len, ' ') -# define memset_zero(P, Len) memset_byte (P, Len, '0') -#elif defined COMPILE_WIDE -# define memset_space(P, Len) (wmemset (P, L' ', Len), (P) += (Len)) -# define memset_zero(P, Len) (wmemset (P, L'0', Len), (P) += (Len)) -#else -# define memset_space(P, Len) (memset (P, ' ', Len), (P) += (Len)) -# define memset_zero(P, Len) (memset (P, '0', Len), (P) += (Len)) -#endif - -#if FPRINTFTIME -# define advance(P, N) -#else -# define advance(P, N) ((P) += (N)) -#endif - -#define add(n, f) width_add (width, n, f) -#define width_add(width, n, f) \ - do \ - { \ - size_t _n = (n); \ - size_t _w = pad == L_('-') || width < 0 ? 0 : width; \ - size_t _incr = _n < _w ? _w : _n; \ - if (_incr >= maxsize - i) \ - { \ - errno = ERANGE; \ - return 0; \ - } \ - if (p) \ - { \ - if (_n < _w) \ - { \ - size_t _delta = _w - _n; \ - if (pad == L_('0') || pad == L_('+')) \ - memset_zero (p, _delta); \ - else \ - memset_space (p, _delta); \ - } \ - f; \ - advance (p, _n); \ - } \ - i += _incr; \ - } while (0) - -#define add1(c) width_add1 (width, c) -#if FPRINTFTIME -# define width_add1(width, c) width_add (width, 1, fputc (c, p)) -#else -# define width_add1(width, c) width_add (width, 1, *p = c) -#endif - -#define cpy(n, s) width_cpy (width, n, s) -#if FPRINTFTIME -# define width_cpy(width, n, s) \ - width_add (width, n, \ - do \ - { \ - if (to_lowcase) \ - fwrite_lowcase (p, (s), _n); \ - else if (to_uppcase) \ - fwrite_uppcase (p, (s), _n); \ - else \ - { \ - /* Ignore the value of fwrite. The caller can determine whether \ - an error occurred by inspecting ferror (P). All known fwrite \ - implementations set the stream's error indicator when they \ - fail due to ENOMEM etc., even though C11 and POSIX.1-2008 do \ - not require this. */ \ - fwrite (s, _n, 1, p); \ - } \ - } \ - while (0) \ - ) -#else -# define width_cpy(width, n, s) \ - width_add (width, n, \ - if (to_lowcase) \ - memcpy_lowcase (p, (s), _n LOCALE_ARG); \ - else if (to_uppcase) \ - memcpy_uppcase (p, (s), _n LOCALE_ARG); \ - else \ - MEMCPY ((void *) p, (void const *) (s), _n)) -#endif - -#ifdef COMPILE_WIDE -# ifndef USE_IN_EXTENDED_LOCALE_MODEL -# undef __mbsrtowcs_l -# define __mbsrtowcs_l(d, s, l, st, loc) __mbsrtowcs (d, s, l, st) -# endif -#endif - - -#if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL -/* We use this code also for the extended locale handling where the - function gets as an additional argument the locale which has to be - used. To access the values we have to redefine the _NL_CURRENT - macro. */ -# define strftime __strftime_l -# define wcsftime __wcsftime_l -# undef _NL_CURRENT -# define _NL_CURRENT(category, item) \ - (current->values[_NL_ITEM_INDEX (item)].string) -# define LOCALE_PARAM , locale_t loc -# define LOCALE_ARG , loc -# define HELPER_LOCALE_ARG , current -#else -# define LOCALE_PARAM -# define LOCALE_ARG -# ifdef _LIBC -# define HELPER_LOCALE_ARG , _NL_CURRENT_DATA (LC_TIME) -# else -# define HELPER_LOCALE_ARG -# endif -#endif - -#ifdef COMPILE_WIDE -# ifdef USE_IN_EXTENDED_LOCALE_MODEL -# define TOUPPER(Ch, L) __towupper_l (Ch, L) -# define TOLOWER(Ch, L) __towlower_l (Ch, L) -# else -# define TOUPPER(Ch, L) towupper (Ch) -# define TOLOWER(Ch, L) towlower (Ch) -# endif -#else -# ifdef USE_IN_EXTENDED_LOCALE_MODEL -# define TOUPPER(Ch, L) __toupper_l (Ch, L) -# define TOLOWER(Ch, L) __tolower_l (Ch, L) -# else -# define TOUPPER(Ch, L) toupper (Ch) -# define TOLOWER(Ch, L) tolower (Ch) -# endif -#endif -/* We don't use 'isdigit' here since the locale dependent - interpretation is not what we want here. We only need to accept - the arabic digits in the ASCII range. One day there is perhaps a - more reliable way to accept other sets of digits. */ -#define ISDIGIT(Ch) ((unsigned int) (Ch) - L_('0') <= 9) - -/* Avoid false GCC warning "'memset' specified size 18446744073709551615 exceeds - maximum object size 9223372036854775807", caused by insufficient data flow - analysis and value propagation of the 'width_add' expansion when GCC is not - optimizing. Cf. . */ -#if __GNUC__ >= 7 && !__OPTIMIZE__ -# pragma GCC diagnostic ignored "-Wstringop-overflow" -#endif - -#if FPRINTFTIME -static void -fwrite_lowcase (FILE *fp, const CHAR_T *src, size_t len) -{ - while (len-- > 0) - { - fputc (TOLOWER ((UCHAR_T) *src, loc), fp); - ++src; - } -} - -static void -fwrite_uppcase (FILE *fp, const CHAR_T *src, size_t len) -{ - while (len-- > 0) - { - fputc (TOUPPER ((UCHAR_T) *src, loc), fp); - ++src; - } -} -#else -static CHAR_T *memcpy_lowcase (CHAR_T *dest, const CHAR_T *src, - size_t len LOCALE_PARAM); - -static CHAR_T * -memcpy_lowcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM) -{ - while (len-- > 0) - dest[len] = TOLOWER ((UCHAR_T) src[len], loc); - return dest; -} - -static CHAR_T *memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, - size_t len LOCALE_PARAM); - -static CHAR_T * -memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM) -{ - while (len-- > 0) - dest[len] = TOUPPER ((UCHAR_T) src[len], loc); - return dest; -} -#endif - - -#if ! HAVE_TM_GMTOFF -/* Yield the difference between *A and *B, - measured in seconds, ignoring leap seconds. */ -# define tm_diff ftime_tm_diff -static int tm_diff (const struct tm *, const struct tm *); -static int -tm_diff (const struct tm *a, const struct tm *b) -{ - /* Compute intervening leap days correctly even if year is negative. - Take care to avoid int overflow in leap day calculations, - but it's OK to assume that A and B are close to each other. */ - int a4 = SHR (a->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (a->tm_year & 3); - int b4 = SHR (b->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (b->tm_year & 3); - int a100 = (a4 + (a4 < 0)) / 25 - (a4 < 0); - int b100 = (b4 + (b4 < 0)) / 25 - (b4 < 0); - int a400 = SHR (a100, 2); - int b400 = SHR (b100, 2); - int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400); - int years = a->tm_year - b->tm_year; - int days = (365 * years + intervening_leap_days - + (a->tm_yday - b->tm_yday)); - return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour)) - + (a->tm_min - b->tm_min)) - + (a->tm_sec - b->tm_sec)); -} -#endif /* ! HAVE_TM_GMTOFF */ - - - -/* The number of days from the first day of the first ISO week of this - year to the year day YDAY with week day WDAY. ISO weeks start on - Monday; the first ISO week has the year's first Thursday. YDAY may - be as small as YDAY_MINIMUM. */ -#define ISO_WEEK_START_WDAY 1 /* Monday */ -#define ISO_WEEK1_WDAY 4 /* Thursday */ -#define YDAY_MINIMUM (-366) -static int iso_week_days (int, int); -static __inline int -iso_week_days (int yday, int wday) -{ - /* Add enough to the first operand of % to make it nonnegative. */ - int big_enough_multiple_of_7 = (-YDAY_MINIMUM / 7 + 2) * 7; - return (yday - - (yday - wday + ISO_WEEK1_WDAY + big_enough_multiple_of_7) % 7 - + ISO_WEEK1_WDAY - ISO_WEEK_START_WDAY); -} - - -/* When compiling this file, GNU applications can #define my_strftime - to a symbol (typically nstrftime) to get an extended strftime with - extra arguments TZ and NS. */ - -#if FPRINTFTIME -# undef my_strftime -# define my_strftime fprintftime -#endif - -#ifdef my_strftime -# define extra_args , tz, ns -# define extra_args_spec , timezone_t tz, int ns -#else -# if defined COMPILE_WIDE -# define my_strftime wcsftime -# define nl_get_alt_digit _nl_get_walt_digit -# else -# define my_strftime strftime -# define nl_get_alt_digit _nl_get_alt_digit -# endif -# define extra_args -# define extra_args_spec -/* We don't have this information in general. */ -# define tz 1 -# define ns 0 -#endif - -static size_t __strftime_internal (STREAM_OR_CHAR_T *, STRFTIME_ARG (size_t) - const CHAR_T *, const struct tm *, - bool, int, int, bool * - extra_args_spec LOCALE_PARAM); - -/* Write information from TP into S according to the format - string FORMAT, writing no more that MAXSIZE characters - (including the terminating '\0') and returning number of - characters written. If S is NULL, nothing will be written - anywhere, so to determine how many characters would be - written, use NULL for S and (size_t) -1 for MAXSIZE. */ -size_t -my_strftime (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) - const CHAR_T *format, - const struct tm *tp extra_args_spec LOCALE_PARAM) -{ - bool tzset_called = false; - return __strftime_internal (s, STRFTIME_ARG (maxsize) format, tp, false, - 0, -1, &tzset_called extra_args LOCALE_ARG); -} -libc_hidden_def (my_strftime) - -/* Just like my_strftime, above, but with more parameters. - UPCASE indicates that the result should be converted to upper case. - YR_SPEC and WIDTH specify the padding and width for the year. - *TZSET_CALLED indicates whether tzset has been called here. */ -static size_t -__strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) - const CHAR_T *format, - const struct tm *tp, bool upcase, - int yr_spec, int width, bool *tzset_called - extra_args_spec LOCALE_PARAM) -{ -#if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL - struct __locale_data *const current = loc->__locales[LC_TIME]; -#endif -#if FPRINTFTIME - size_t maxsize = (size_t) -1; -#endif - - int saved_errno = errno; - int hour12 = tp->tm_hour; -#ifdef _NL_CURRENT - /* We cannot make the following values variables since we must delay - the evaluation of these values until really needed since some - expressions might not be valid in every situation. The 'struct tm' - might be generated by a strptime() call that initialized - only a few elements. Dereference the pointers only if the format - requires this. Then it is ok to fail if the pointers are invalid. */ -# define a_wkday \ - ((const CHAR_T *) (tp->tm_wday < 0 || tp->tm_wday > 6 \ - ? "?" : _NL_CURRENT (LC_TIME, NLW(ABDAY_1) + tp->tm_wday))) -# define f_wkday \ - ((const CHAR_T *) (tp->tm_wday < 0 || tp->tm_wday > 6 \ - ? "?" : _NL_CURRENT (LC_TIME, NLW(DAY_1) + tp->tm_wday))) -# define a_month \ - ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ - ? "?" : _NL_CURRENT (LC_TIME, NLW(ABMON_1) + tp->tm_mon))) -# define f_month \ - ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ - ? "?" : _NL_CURRENT (LC_TIME, NLW(MON_1) + tp->tm_mon))) -# define a_altmonth \ - ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ - ? "?" : _NL_CURRENT (LC_TIME, NLW(ABALTMON_1) + tp->tm_mon))) -# define f_altmonth \ - ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ - ? "?" : _NL_CURRENT (LC_TIME, NLW(ALTMON_1) + tp->tm_mon))) -# define ampm \ - ((const CHAR_T *) _NL_CURRENT (LC_TIME, tp->tm_hour > 11 \ - ? NLW(PM_STR) : NLW(AM_STR))) - -# define aw_len STRLEN (a_wkday) -# define am_len STRLEN (a_month) -# define aam_len STRLEN (a_altmonth) -# define ap_len STRLEN (ampm) -#endif -#if HAVE_TZNAME - char **tzname_vec = tzname; -#endif - const char *zone; - size_t i = 0; - STREAM_OR_CHAR_T *p = s; - const CHAR_T *f; -#if DO_MULTIBYTE && !defined COMPILE_WIDE - const char *format_end = NULL; -#endif - - zone = NULL; -#if HAVE_STRUCT_TM_TM_ZONE - /* The POSIX test suite assumes that setting - the environment variable TZ to a new value before calling strftime() - will influence the result (the %Z format) even if the information in - TP is computed with a totally different time zone. - This is bogus: though POSIX allows bad behavior like this, - POSIX does not require it. Do the right thing instead. */ - zone = (const char *) tp->tm_zone; -#endif -#if HAVE_TZNAME - if (!tz) - { - if (! (zone && *zone)) - zone = "GMT"; - } - else - { -# if !HAVE_STRUCT_TM_TM_ZONE - /* Infer the zone name from *TZ instead of from TZNAME. */ - tzname_vec = tz->tzname_copy; -# endif - } - /* The tzset() call might have changed the value. */ - if (!(zone && *zone) && tp->tm_isdst >= 0) - { - /* POSIX.1 requires that local time zone information be used as - though strftime called tzset. */ -# ifndef my_strftime - if (!*tzset_called) - { - tzset (); - *tzset_called = true; - } -# endif - zone = tzname_vec[tp->tm_isdst != 0]; - } -#endif - if (! zone) - zone = ""; - - if (hour12 > 12) - hour12 -= 12; - else - if (hour12 == 0) - hour12 = 12; - - for (f = format; *f != '\0'; width = -1, f++) - { - int pad = 0; /* Padding for number ('_', '-', '+', '0', or 0). */ - int modifier; /* Field modifier ('E', 'O', or 0). */ - int digits = 0; /* Max digits for numeric format. */ - int number_value; /* Numeric value to be printed. */ - unsigned int u_number_value; /* (unsigned int) number_value. */ - bool negative_number; /* The number is negative. */ - bool always_output_a_sign; /* +/- should always be output. */ - int tz_colon_mask; /* Bitmask of where ':' should appear. */ - const CHAR_T *subfmt; - CHAR_T *bufp; - CHAR_T buf[1 - + 2 /* for the two colons in a %::z or %:::z time zone */ - + (sizeof (int) < sizeof (time_t) - ? INT_STRLEN_BOUND (time_t) - : INT_STRLEN_BOUND (int))]; - bool to_lowcase = false; - bool to_uppcase = upcase; - size_t colons; - bool change_case = false; - int format_char; - int subwidth; - -#if DO_MULTIBYTE && !defined COMPILE_WIDE - switch (*f) - { - case L_('%'): - break; - - case L_('\b'): case L_('\t'): case L_('\n'): - case L_('\v'): case L_('\f'): case L_('\r'): - case L_(' '): case L_('!'): case L_('"'): case L_('#'): case L_('&'): - case L_('\''): case L_('('): case L_(')'): case L_('*'): case L_('+'): - case L_(','): case L_('-'): case L_('.'): case L_('/'): case L_('0'): - case L_('1'): case L_('2'): case L_('3'): case L_('4'): case L_('5'): - case L_('6'): case L_('7'): case L_('8'): case L_('9'): case L_(':'): - case L_(';'): case L_('<'): case L_('='): case L_('>'): case L_('?'): - case L_('A'): case L_('B'): case L_('C'): case L_('D'): case L_('E'): - case L_('F'): case L_('G'): case L_('H'): case L_('I'): case L_('J'): - case L_('K'): case L_('L'): case L_('M'): case L_('N'): case L_('O'): - case L_('P'): case L_('Q'): case L_('R'): case L_('S'): case L_('T'): - case L_('U'): case L_('V'): case L_('W'): case L_('X'): case L_('Y'): - case L_('Z'): case L_('['): case L_('\\'): case L_(']'): case L_('^'): - case L_('_'): case L_('a'): case L_('b'): case L_('c'): case L_('d'): - case L_('e'): case L_('f'): case L_('g'): case L_('h'): case L_('i'): - case L_('j'): case L_('k'): case L_('l'): case L_('m'): case L_('n'): - case L_('o'): case L_('p'): case L_('q'): case L_('r'): case L_('s'): - case L_('t'): case L_('u'): case L_('v'): case L_('w'): case L_('x'): - case L_('y'): case L_('z'): case L_('{'): case L_('|'): case L_('}'): - case L_('~'): - /* The C Standard requires these 98 characters (plus '%') to - be in the basic execution character set. None of these - characters can start a multibyte sequence, so they need - not be analyzed further. */ - add1 (*f); - continue; - - default: - /* Copy this multibyte sequence until we reach its end, find - an error, or come back to the initial shift state. */ - { - mbstate_t mbstate = mbstate_zero; - size_t len = 0; - size_t fsize; - - if (! format_end) - format_end = f + strlen (f) + 1; - fsize = format_end - f; - - do - { - size_t bytes = mbrlen (f + len, fsize - len, &mbstate); - - if (bytes == 0) - break; - - if (bytes == (size_t) -2) - { - len += strlen (f + len); - break; - } - - if (bytes == (size_t) -1) - { - len++; - break; - } - - len += bytes; - } - while (! mbsinit (&mbstate)); - - cpy (len, f); - f += len - 1; - continue; - } - } - -#else /* ! DO_MULTIBYTE */ - - /* Either multibyte encodings are not supported, they are - safe for formats, so any non-'%' byte can be copied through, - or this is the wide character version. */ - if (*f != L_('%')) - { - add1 (*f); - continue; - } - -#endif /* ! DO_MULTIBYTE */ - - char const *percent = f; - - /* Check for flags that can modify a format. */ - while (1) - { - switch (*++f) - { - /* This influences the number formats. */ - case L_('_'): - case L_('-'): - case L_('+'): - case L_('0'): - pad = *f; - continue; - - /* This changes textual output. */ - case L_('^'): - to_uppcase = true; - continue; - case L_('#'): - change_case = true; - continue; - - default: - break; - } - break; - } - - if (ISDIGIT (*f)) - { - width = 0; - do - { - if (ckd_mul (&width, width, 10) - || ckd_add (&width, width, *f - L_('0'))) - width = INT_MAX; - ++f; - } - while (ISDIGIT (*f)); - } - - /* Check for modifiers. */ - switch (*f) - { - case L_('E'): - case L_('O'): - modifier = *f++; - break; - - default: - modifier = 0; - break; - } - - /* Now do the specified format. */ - format_char = *f; - switch (format_char) - { -#define DO_NUMBER(d, v) \ - do \ - { \ - digits = d; \ - number_value = v; \ - goto do_number; \ - } \ - while (0) -#define DO_SIGNED_NUMBER(d, negative, v) \ - DO_MAYBE_SIGNED_NUMBER (d, negative, v, do_signed_number) -#define DO_YEARISH(d, negative, v) \ - DO_MAYBE_SIGNED_NUMBER (d, negative, v, do_yearish) -#define DO_MAYBE_SIGNED_NUMBER(d, negative, v, label) \ - do \ - { \ - digits = d; \ - negative_number = negative; \ - u_number_value = v; \ - goto label; \ - } \ - while (0) - - /* The mask is not what you might think. - When the ordinal i'th bit is set, insert a colon - before the i'th digit of the time zone representation. */ -#define DO_TZ_OFFSET(d, mask, v) \ - do \ - { \ - digits = d; \ - tz_colon_mask = mask; \ - u_number_value = v; \ - goto do_tz_offset; \ - } \ - while (0) -#define DO_NUMBER_SPACEPAD(d, v) \ - do \ - { \ - digits = d; \ - number_value = v; \ - goto do_number_spacepad; \ - } \ - while (0) - - case L_('%'): - if (f - 1 != percent) - goto bad_percent; - add1 (*f); - break; - - case L_('a'): - if (modifier != 0) - goto bad_format; - if (change_case) - { - to_uppcase = true; - to_lowcase = false; - } -#ifdef _NL_CURRENT - cpy (aw_len, a_wkday); - break; -#else - goto underlying_strftime; -#endif - - case 'A': - if (modifier != 0) - goto bad_format; - if (change_case) - { - to_uppcase = true; - to_lowcase = false; - } -#ifdef _NL_CURRENT - cpy (STRLEN (f_wkday), f_wkday); - break; -#else - goto underlying_strftime; -#endif - - case L_('b'): - case L_('h'): - if (change_case) - { - to_uppcase = true; - to_lowcase = false; - } - if (modifier == L_('E')) - goto bad_format; -#ifdef _NL_CURRENT - if (modifier == L_('O')) - cpy (aam_len, a_altmonth); - else - cpy (am_len, a_month); - break; -#else - goto underlying_strftime; -#endif - - case L_('B'): - if (modifier == L_('E')) - goto bad_format; - if (change_case) - { - to_uppcase = true; - to_lowcase = false; - } -#ifdef _NL_CURRENT - if (modifier == L_('O')) - cpy (STRLEN (f_altmonth), f_altmonth); - else - cpy (STRLEN (f_month), f_month); - break; -#else - goto underlying_strftime; -#endif - - case L_('c'): - if (modifier == L_('O')) - goto bad_format; -#ifdef _NL_CURRENT - if (! (modifier == L_('E') - && (*(subfmt = - (const CHAR_T *) _NL_CURRENT (LC_TIME, - NLW(ERA_D_T_FMT))) - != '\0'))) - subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_T_FMT)); -#else - goto underlying_strftime; -#endif - - subformat: - subwidth = -1; - subformat_width: - { - size_t len = __strftime_internal (NULL, STRFTIME_ARG ((size_t) -1) - subfmt, tp, to_uppcase, - pad, subwidth, tzset_called - extra_args LOCALE_ARG); - add (len, __strftime_internal (p, - STRFTIME_ARG (maxsize - i) - subfmt, tp, to_uppcase, - pad, subwidth, tzset_called - extra_args LOCALE_ARG)); - } - break; - -#if !(defined _NL_CURRENT && HAVE_STRUCT_ERA_ENTRY) - underlying_strftime: - { - /* The relevant information is available only via the - underlying strftime implementation, so use that. */ - char ufmt[5]; - char *u = ufmt; - char ubuf[1024]; /* enough for any single format in practice */ - size_t len; - /* Make sure we're calling the actual underlying strftime. - In some cases, config.h contains something like - "#define strftime rpl_strftime". */ -# ifdef strftime -# undef strftime - size_t strftime (); -# endif - - /* The space helps distinguish strftime failure from empty - output. */ - *u++ = ' '; - *u++ = '%'; - if (modifier != 0) - *u++ = modifier; - *u++ = format_char; - *u = '\0'; - len = strftime (ubuf, sizeof ubuf, ufmt, tp); - if (len != 0) - cpy (len - 1, ubuf + 1); - } - break; -#endif - - case L_('C'): - if (modifier == L_('E')) - { -#if HAVE_STRUCT_ERA_ENTRY - struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); - if (era) - { -# ifdef COMPILE_WIDE - size_t len = __wcslen (era->era_wname); - cpy (len, era->era_wname); -# else - size_t len = strlen (era->era_name); - cpy (len, era->era_name); -# endif - break; - } -#else - goto underlying_strftime; -#endif - } - - { - bool negative_year = tp->tm_year < - TM_YEAR_BASE; - bool zero_thru_1899 = !negative_year & (tp->tm_year < 0); - int century = ((tp->tm_year - 99 * zero_thru_1899) / 100 - + TM_YEAR_BASE / 100); - DO_YEARISH (2, negative_year, century); - } - - case L_('x'): - if (modifier == L_('O')) - goto bad_format; -#ifdef _NL_CURRENT - if (! (modifier == L_('E') - && (*(subfmt = - (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ERA_D_FMT))) - != L_('\0')))) - subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_FMT)); - goto subformat; -#else - goto underlying_strftime; -#endif - case L_('D'): - if (modifier != 0) - goto bad_format; - subfmt = L_("%m/%d/%y"); - goto subformat; - - case L_('d'): - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER (2, tp->tm_mday); - - case L_('e'): - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER_SPACEPAD (2, tp->tm_mday); - - /* All numeric formats set DIGITS and NUMBER_VALUE (or U_NUMBER_VALUE) - and then jump to one of these labels. */ - - do_tz_offset: - always_output_a_sign = true; - goto do_number_body; - - do_yearish: - if (pad == 0) - pad = yr_spec; - always_output_a_sign - = (pad == L_('+') - && ((digits == 2 ? 99 : 9999) < u_number_value - || digits < width)); - goto do_maybe_signed_number; - - do_number_spacepad: - if (pad == 0) - pad = L_('_'); - - do_number: - /* Format NUMBER_VALUE according to the MODIFIER flag. */ - negative_number = number_value < 0; - u_number_value = number_value; - - do_signed_number: - always_output_a_sign = false; - - do_maybe_signed_number: - tz_colon_mask = 0; - - do_number_body: - /* Format U_NUMBER_VALUE according to the MODIFIER flag. - NEGATIVE_NUMBER is nonzero if the original number was - negative; in this case it was converted directly to - unsigned int (i.e., modulo (UINT_MAX + 1)) without - negating it. */ - if (modifier == L_('O') && !negative_number) - { -#ifdef _NL_CURRENT - /* Get the locale specific alternate representation of - the number. If none exist NULL is returned. */ - const CHAR_T *cp = nl_get_alt_digit (u_number_value - HELPER_LOCALE_ARG); - - if (cp != NULL) - { - size_t digitlen = STRLEN (cp); - if (digitlen != 0) - { - cpy (digitlen, cp); - break; - } - } -#else - goto underlying_strftime; -#endif - } - - bufp = buf + sizeof (buf) / sizeof (buf[0]); - - if (negative_number) - u_number_value = - u_number_value; - - do - { - if (tz_colon_mask & 1) - *--bufp = ':'; - tz_colon_mask >>= 1; - *--bufp = u_number_value % 10 + L_('0'); - u_number_value /= 10; - } - while (u_number_value != 0 || tz_colon_mask != 0); - - do_number_sign_and_padding: - if (pad == 0) - pad = L_('0'); - if (width < 0) - width = digits; - - { - CHAR_T sign_char = (negative_number ? L_('-') - : always_output_a_sign ? L_('+') - : 0); - int numlen = buf + sizeof buf / sizeof buf[0] - bufp; - int shortage = width - !!sign_char - numlen; - int padding = pad == L_('-') || shortage <= 0 ? 0 : shortage; - - if (sign_char) - { - if (pad == L_('_')) - { - if (p) - memset_space (p, padding); - i += padding; - width -= padding; - } - width_add1 (0, sign_char); - width--; - } - - cpy (numlen, bufp); - } - break; - - case L_('F'): - if (modifier != 0) - goto bad_format; - if (pad == 0 && width < 0) - { - pad = L_('+'); - subwidth = 4; - } - else - { - subwidth = width - 6; - if (subwidth < 0) - subwidth = 0; - } - subfmt = L_("%Y-%m-%d"); - goto subformat_width; - - case L_('H'): - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER (2, tp->tm_hour); - - case L_('I'): - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER (2, hour12); - - case L_('k'): /* GNU extension. */ - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER_SPACEPAD (2, tp->tm_hour); - - case L_('l'): /* GNU extension. */ - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER_SPACEPAD (2, hour12); - - case L_('j'): - if (modifier == L_('E')) - goto bad_format; - - DO_SIGNED_NUMBER (3, tp->tm_yday < -1, tp->tm_yday + 1U); - - case L_('M'): - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER (2, tp->tm_min); - - case L_('m'): - if (modifier == L_('E')) - goto bad_format; - - DO_SIGNED_NUMBER (2, tp->tm_mon < -1, tp->tm_mon + 1U); - -#ifndef _LIBC - case L_('N'): /* GNU extension. */ - if (modifier == L_('E')) - goto bad_format; - { - int n = ns, ns_digits = 9; - if (width <= 0) - width = ns_digits; - int ndigs = ns_digits; - while (width < ndigs || (1 < ndigs && n % 10 == 0)) - ndigs--, n /= 10; - for (int j = ndigs; 0 < j; j--) - buf[j - 1] = n % 10 + L_('0'), n /= 10; - if (!pad) - pad = L_('0'); - width_cpy (0, ndigs, buf); - width_add (width - ndigs, 0, (void) 0); - } - break; -#endif - - case L_('n'): - add1 (L_('\n')); - break; - - case L_('P'): - to_lowcase = true; -#ifndef _NL_CURRENT - format_char = L_('p'); -#endif - FALLTHROUGH; - case L_('p'): - if (change_case) - { - to_uppcase = false; - to_lowcase = true; - } -#ifdef _NL_CURRENT - cpy (ap_len, ampm); - break; -#else - goto underlying_strftime; -#endif - - case L_('q'): /* GNU extension. */ - DO_SIGNED_NUMBER (1, false, ((tp->tm_mon * 11) >> 5) + 1); - - case L_('R'): - subfmt = L_("%H:%M"); - goto subformat; - - case L_('r'): -#ifdef _NL_CURRENT - if (*(subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, - NLW(T_FMT_AMPM))) - == L_('\0')) - subfmt = L_("%I:%M:%S %p"); - goto subformat; -#else - goto underlying_strftime; -#endif - - case L_('S'): - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER (2, tp->tm_sec); - - case L_('s'): /* GNU extension. */ - { - struct tm ltm; - time_t t; - - ltm = *tp; - ltm.tm_yday = -1; - t = mktime_z (tz, <m); - if (ltm.tm_yday < 0) - { - errno = EOVERFLOW; - return 0; - } - - /* Generate string value for T using time_t arithmetic; - this works even if sizeof (long) < sizeof (time_t). */ - - bufp = buf + sizeof (buf) / sizeof (buf[0]); - negative_number = t < 0; - - do - { - int d = t % 10; - t /= 10; - *--bufp = (negative_number ? -d : d) + L_('0'); - } - while (t != 0); - - digits = 1; - always_output_a_sign = false; - goto do_number_sign_and_padding; - } - - case L_('X'): - if (modifier == L_('O')) - goto bad_format; -#ifdef _NL_CURRENT - if (! (modifier == L_('E') - && (*(subfmt = - (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ERA_T_FMT))) - != L_('\0')))) - subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(T_FMT)); - goto subformat; -#else - goto underlying_strftime; -#endif - case L_('T'): - subfmt = L_("%H:%M:%S"); - goto subformat; - - case L_('t'): - add1 (L_('\t')); - break; - - case L_('u'): - DO_NUMBER (1, (tp->tm_wday - 1 + 7) % 7 + 1); - - case L_('U'): - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER (2, (tp->tm_yday - tp->tm_wday + 7) / 7); - - case L_('V'): - case L_('g'): - case L_('G'): - if (modifier == L_('E')) - goto bad_format; - { - /* YEAR is a leap year if and only if (tp->tm_year + TM_YEAR_BASE) - is a leap year, except that YEAR and YEAR - 1 both work - correctly even when (tp->tm_year + TM_YEAR_BASE) would - overflow. */ - int year = (tp->tm_year - + (tp->tm_year < 0 - ? TM_YEAR_BASE % 400 - : TM_YEAR_BASE % 400 - 400)); - int year_adjust = 0; - int days = iso_week_days (tp->tm_yday, tp->tm_wday); - - if (days < 0) - { - /* This ISO week belongs to the previous year. */ - year_adjust = -1; - days = iso_week_days (tp->tm_yday + (365 + __isleap (year - 1)), - tp->tm_wday); - } - else - { - int d = iso_week_days (tp->tm_yday - (365 + __isleap (year)), - tp->tm_wday); - if (0 <= d) - { - /* This ISO week belongs to the next year. */ - year_adjust = 1; - days = d; - } - } - - switch (*f) - { - case L_('g'): - { - int yy = (tp->tm_year % 100 + year_adjust) % 100; - DO_YEARISH (2, false, - (0 <= yy - ? yy - : tp->tm_year < -TM_YEAR_BASE - year_adjust - ? -yy - : yy + 100)); - } - - case L_('G'): - DO_YEARISH (4, tp->tm_year < -TM_YEAR_BASE - year_adjust, - (tp->tm_year + (unsigned int) TM_YEAR_BASE - + year_adjust)); - - default: - DO_NUMBER (2, days / 7 + 1); - } - } - - case L_('W'): - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER (2, (tp->tm_yday - (tp->tm_wday - 1 + 7) % 7 + 7) / 7); - - case L_('w'): - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER (1, tp->tm_wday); - - case L_('Y'): - if (modifier == L_('E')) - { -#if HAVE_STRUCT_ERA_ENTRY - struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); - if (era) - { -# ifdef COMPILE_WIDE - subfmt = era->era_wformat; -# else - subfmt = era->era_format; -# endif - if (pad == 0) - pad = yr_spec; - goto subformat; - } -#else - goto underlying_strftime; -#endif - } - if (modifier == L_('O')) - goto bad_format; - - DO_YEARISH (4, tp->tm_year < -TM_YEAR_BASE, - tp->tm_year + (unsigned int) TM_YEAR_BASE); - - case L_('y'): - if (modifier == L_('E')) - { -#if HAVE_STRUCT_ERA_ENTRY - struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); - if (era) - { - int delta = tp->tm_year - era->start_date[0]; - if (pad == 0) - pad = yr_spec; - DO_NUMBER (2, (era->offset - + delta * era->absolute_direction)); - } -#else - goto underlying_strftime; -#endif - } - - { - int yy = tp->tm_year % 100; - if (yy < 0) - yy = tp->tm_year < - TM_YEAR_BASE ? -yy : yy + 100; - DO_YEARISH (2, false, yy); - } - - case L_('Z'): - if (change_case) - { - to_uppcase = false; - to_lowcase = true; - } - -#ifdef COMPILE_WIDE - { - /* The zone string is always given in multibyte form. We have - to convert it to wide character. */ - size_t w = pad == L_('-') || width < 0 ? 0 : width; - char const *z = zone; - mbstate_t st = {0}; - size_t len = __mbsrtowcs_l (p, &z, maxsize - i, &st, loc); - if (len == (size_t) -1) - return 0; - size_t incr = len < w ? w : len; - if (incr >= maxsize - i) - { - errno = ERANGE; - return 0; - } - if (p) - { - if (len < w) - { - size_t delta = w - len; - __wmemmove (p + delta, p, len); - wchar_t wc = pad == L_('0') || pad == L_('+') ? L'0' : L' '; - wmemset (p, wc, delta); - } - p += incr; - } - i += incr; - } -#else - cpy (strlen (zone), zone); -#endif - break; - - case L_(':'): - /* :, ::, and ::: are valid only just before 'z'. - :::: etc. are rejected later. */ - for (colons = 1; f[colons] == L_(':'); colons++) - continue; - if (f[colons] != L_('z')) - goto bad_format; - f += colons; - goto do_z_conversion; - - case L_('z'): - colons = 0; - - do_z_conversion: - if (tp->tm_isdst < 0) - break; - - { - int diff; - int hour_diff; - int min_diff; - int sec_diff; -#if HAVE_TM_GMTOFF - diff = tp->tm_gmtoff; -#else - if (!tz) - diff = 0; - else - { - struct tm gtm; - struct tm ltm; - time_t lt; - - /* POSIX.1 requires that local time zone information be used as - though strftime called tzset. */ -# ifndef my_strftime - if (!*tzset_called) - { - tzset (); - *tzset_called = true; - } -# endif - - ltm = *tp; - ltm.tm_wday = -1; - lt = mktime_z (tz, <m); - if (ltm.tm_wday < 0 || ! localtime_rz (0, <, >m)) - break; - diff = tm_diff (<m, >m); - } -#endif - - negative_number = diff < 0 || (diff == 0 && *zone == '-'); - hour_diff = diff / 60 / 60; - min_diff = diff / 60 % 60; - sec_diff = diff % 60; - - switch (colons) - { - case 0: /* +hhmm */ - DO_TZ_OFFSET (5, 0, hour_diff * 100 + min_diff); - - case 1: tz_hh_mm: /* +hh:mm */ - DO_TZ_OFFSET (6, 04, hour_diff * 100 + min_diff); - - case 2: tz_hh_mm_ss: /* +hh:mm:ss */ - DO_TZ_OFFSET (9, 024, - hour_diff * 10000 + min_diff * 100 + sec_diff); - - case 3: /* +hh if possible, else +hh:mm, else +hh:mm:ss */ - if (sec_diff != 0) - goto tz_hh_mm_ss; - if (min_diff != 0) - goto tz_hh_mm; - DO_TZ_OFFSET (3, 0, hour_diff); - - default: - goto bad_format; - } - } - - case L_('\0'): /* GNU extension: % at end of format. */ - bad_percent: - --f; - FALLTHROUGH; - default: - /* Unknown format; output the format, including the '%', - since this is most likely the right thing to do if a - multibyte string has been misparsed. */ - bad_format: - cpy (f - percent + 1, percent); - break; - } - } - -#if ! FPRINTFTIME - if (p && maxsize != 0) - *p = L_('\0'); -#endif - - errno = saved_errno; - return i; -} +#define my_strftime nstrftime +#include "strftime.c" diff --git a/lib/strftime.c b/lib/strftime.c new file mode 100644 index 00000000000..c7256c3d354 --- /dev/null +++ b/lib/strftime.c @@ -0,0 +1,2051 @@ +/* Copyright (C) 1991-2024 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + This file is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as + published by the Free Software Foundation, either version 3 of the + License, or (at your option) any later version. + + This file is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program. If not, see . */ + +#ifndef FPRINTFTIME +# define FPRINTFTIME 0 +#endif + +#ifndef USE_C_LOCALE +# define USE_C_LOCALE 0 +#endif + +#ifdef _LIBC +# define USE_IN_EXTENDED_LOCALE_MODEL 1 +# define HAVE_STRUCT_ERA_ENTRY 1 +# define HAVE_TM_GMTOFF 1 +# define HAVE_STRUCT_TM_TM_ZONE 1 +# define HAVE_TZNAME 1 +# include "../locale/localeinfo.h" +#else +# include +# if FPRINTFTIME +# include "fprintftime.h" +# else +# include "strftime.h" +# endif +# include "time-internal.h" +#endif + +/* Whether to require GNU behavior for AM and PM indicators, even on + other platforms. This matters only in non-C locales. + The default is to require it; you can override this via + AC_DEFINE([REQUIRE_GNUISH_STRFTIME_AM_PM], 1) and if you do that + you may be able to omit Gnulib's localename module and its dependencies. */ +#ifndef REQUIRE_GNUISH_STRFTIME_AM_PM +# define REQUIRE_GNUISH_STRFTIME_AM_PM true +#endif +#if USE_C_LOCALE +# undef REQUIRE_GNUISH_STRFTIME_AM_PM +# define REQUIRE_GNUISH_STRFTIME_AM_PM false +#endif + +#if USE_C_LOCALE +# include "c-ctype.h" +#else +# include +#endif +#include +#include + +#if HAVE_TZNAME && !HAVE_DECL_TZNAME +extern char *tzname[]; +#endif + +/* Do multibyte processing if multibyte encodings are supported, unless + multibyte sequences are safe in formats. Multibyte sequences are + safe if they cannot contain byte sequences that look like format + conversion specifications. The multibyte encodings used by the + C library on the various platforms (UTF-8, GB2312, GBK, CP936, + GB18030, EUC-TW, BIG5, BIG5-HKSCS, CP950, EUC-JP, EUC-KR, CP949, + SHIFT_JIS, CP932, JOHAB) are safe for formats, because the byte '%' + cannot occur in a multibyte character except in the first byte. + + The DEC-HANYU encoding used on OSF/1 is not safe for formats, but + this encoding has never been seen in real-life use, so we ignore + it. */ +#if !(defined __osf__ && 0) +# define MULTIBYTE_IS_FORMAT_SAFE 1 +#endif +#define DO_MULTIBYTE (! MULTIBYTE_IS_FORMAT_SAFE) + +#if DO_MULTIBYTE +# include + static const mbstate_t mbstate_zero; +#endif + +#include +#include +#include +#include +#include + +#if USE_C_LOCALE && HAVE_STRFTIME_L +# include +#endif + +#if (defined __NetBSD__ || defined __sun) && REQUIRE_GNUISH_STRFTIME_AM_PM +# include +# include "localename.h" +#endif + +#include "attribute.h" +#include + +#ifdef COMPILE_WIDE +# include +# define CHAR_T wchar_t +# define UCHAR_T unsigned int +# define L_(Str) L##Str +# define NLW(Sym) _NL_W##Sym + +# define MEMCPY(d, s, n) __wmemcpy (d, s, n) +# define STRLEN(s) __wcslen (s) + +#else +# define CHAR_T char +# define UCHAR_T unsigned char +# define L_(Str) Str +# define NLW(Sym) Sym +# define ABALTMON_1 _NL_ABALTMON_1 + +# define MEMCPY(d, s, n) memcpy (d, s, n) +# define STRLEN(s) strlen (s) + +#endif + +/* Shift A right by B bits portably, by dividing A by 2**B and + truncating towards minus infinity. A and B should be free of side + effects, and B should be in the range 0 <= B <= INT_BITS - 2, where + INT_BITS is the number of useful bits in an int. GNU code can + assume that INT_BITS is at least 32. + + ISO C99 says that A >> B is implementation-defined if A < 0. Some + implementations (e.g., UNICOS 9.0 on a Cray Y-MP EL) don't shift + right in the usual way when A < 0, so SHR falls back on division if + ordinary A >> B doesn't seem to be the usual signed shift. */ +#define SHR(a, b) \ + (-1 >> 1 == -1 \ + ? (a) >> (b) \ + : ((a) + ((a) < 0)) / (1 << (b)) - ((a) < 0)) + +#define TM_YEAR_BASE 1900 + +#ifndef __isleap +/* Nonzero if YEAR is a leap year (every 4 years, + except every 100th isn't, and every 400th is). */ +# define __isleap(year) \ + ((year) % 4 == 0 && ((year) % 100 != 0 || (year) % 400 == 0)) +#endif + + +#ifdef _LIBC +# define mktime_z(tz, tm) mktime (tm) +# define tzname __tzname +# define tzset __tzset + +# define time_t __time64_t +# define __gmtime_r(t, tp) __gmtime64_r (t, tp) +# define mktime(tp) __mktime64 (tp) +#endif + +#if FPRINTFTIME +# define STREAM_OR_CHAR_T FILE +# define STRFTIME_ARG(x) /* empty */ +#else +# define STREAM_OR_CHAR_T CHAR_T +# define STRFTIME_ARG(x) x, +#endif + +#if FPRINTFTIME +# define memset_byte(P, Len, Byte) \ + do { size_t _i; for (_i = 0; _i < Len; _i++) fputc (Byte, P); } while (0) +# define memset_space(P, Len) memset_byte (P, Len, ' ') +# define memset_zero(P, Len) memset_byte (P, Len, '0') +#elif defined COMPILE_WIDE +# define memset_space(P, Len) (wmemset (P, L' ', Len), (P) += (Len)) +# define memset_zero(P, Len) (wmemset (P, L'0', Len), (P) += (Len)) +#else +# define memset_space(P, Len) (memset (P, ' ', Len), (P) += (Len)) +# define memset_zero(P, Len) (memset (P, '0', Len), (P) += (Len)) +#endif + +#if FPRINTFTIME +# define advance(P, N) +#else +# define advance(P, N) ((P) += (N)) +#endif + +#define add(n, f) width_add (width, n, f) +#define width_add(width, n, f) \ + do \ + { \ + size_t _n = (n); \ + size_t _w = pad == L_('-') || width < 0 ? 0 : width; \ + size_t _incr = _n < _w ? _w : _n; \ + if (_incr >= maxsize - i) \ + { \ + errno = ERANGE; \ + return 0; \ + } \ + if (p) \ + { \ + if (_n < _w) \ + { \ + size_t _delta = _w - _n; \ + if (pad == L_('0') || pad == L_('+')) \ + memset_zero (p, _delta); \ + else \ + memset_space (p, _delta); \ + } \ + f; \ + advance (p, _n); \ + } \ + i += _incr; \ + } while (0) + +#define add1(c) width_add1 (width, c) +#if FPRINTFTIME +# define width_add1(width, c) width_add (width, 1, fputc (c, p)) +#else +# define width_add1(width, c) width_add (width, 1, *p = c) +#endif + +#define cpy(n, s) width_cpy (width, n, s) +#if FPRINTFTIME +# define width_cpy(width, n, s) \ + width_add (width, n, \ + do \ + { \ + if (to_lowcase) \ + fwrite_lowcase (p, (s), _n); \ + else if (to_uppcase) \ + fwrite_uppcase (p, (s), _n); \ + else \ + { \ + /* Ignore the value of fwrite. The caller can determine whether \ + an error occurred by inspecting ferror (P). All known fwrite \ + implementations set the stream's error indicator when they \ + fail due to ENOMEM etc., even though C11 and POSIX.1-2008 do \ + not require this. */ \ + fwrite (s, _n, 1, p); \ + } \ + } \ + while (0) \ + ) +#else +# define width_cpy(width, n, s) \ + width_add (width, n, \ + if (to_lowcase) \ + memcpy_lowcase (p, (s), _n LOCALE_ARG); \ + else if (to_uppcase) \ + memcpy_uppcase (p, (s), _n LOCALE_ARG); \ + else \ + MEMCPY ((void *) p, (void const *) (s), _n)) +#endif + +#ifdef COMPILE_WIDE +# ifndef USE_IN_EXTENDED_LOCALE_MODEL +# undef __mbsrtowcs_l +# define __mbsrtowcs_l(d, s, l, st, loc) __mbsrtowcs (d, s, l, st) +# endif +#endif + + +#if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL +/* We use this code also for the extended locale handling where the + function gets as an additional argument the locale which has to be + used. To access the values we have to redefine the _NL_CURRENT + macro. */ +# define strftime __strftime_l +# define wcsftime __wcsftime_l +# undef _NL_CURRENT +# define _NL_CURRENT(category, item) \ + (current->values[_NL_ITEM_INDEX (item)].string) +# define LOCALE_PARAM , locale_t loc +# define LOCALE_ARG , loc +# define HELPER_LOCALE_ARG , current +#else +# define LOCALE_PARAM +# define LOCALE_ARG +# ifdef _LIBC +# define HELPER_LOCALE_ARG , _NL_CURRENT_DATA (LC_TIME) +# else +# define HELPER_LOCALE_ARG +# endif +#endif + +#ifdef COMPILE_WIDE +# ifdef USE_IN_EXTENDED_LOCALE_MODEL +# define TOUPPER(Ch, L) __towupper_l (Ch, L) +# define TOLOWER(Ch, L) __towlower_l (Ch, L) +# else +# define TOUPPER(Ch, L) towupper (Ch) +# define TOLOWER(Ch, L) towlower (Ch) +# endif +#else +# ifdef USE_IN_EXTENDED_LOCALE_MODEL +# define TOUPPER(Ch, L) __toupper_l (Ch, L) +# define TOLOWER(Ch, L) __tolower_l (Ch, L) +# else +# if USE_C_LOCALE +# define TOUPPER(Ch, L) c_toupper (Ch) +# define TOLOWER(Ch, L) c_tolower (Ch) +# else +# define TOUPPER(Ch, L) toupper (Ch) +# define TOLOWER(Ch, L) tolower (Ch) +# endif +# endif +#endif +/* We don't use 'isdigit' here since the locale dependent + interpretation is not what we want here. We only need to accept + the arabic digits in the ASCII range. One day there is perhaps a + more reliable way to accept other sets of digits. */ +#define ISDIGIT(Ch) ((unsigned int) (Ch) - L_('0') <= 9) + +/* Avoid false GCC warning "'memset' specified size 18446744073709551615 exceeds + maximum object size 9223372036854775807", caused by insufficient data flow + analysis and value propagation of the 'width_add' expansion when GCC is not + optimizing. Cf. . */ +#if __GNUC__ >= 7 && !__OPTIMIZE__ +# pragma GCC diagnostic ignored "-Wstringop-overflow" +#endif + +#if FPRINTFTIME +static void +fwrite_lowcase (FILE *fp, const CHAR_T *src, size_t len) +{ + while (len-- > 0) + { + fputc (TOLOWER ((UCHAR_T) *src, loc), fp); + ++src; + } +} + +static void +fwrite_uppcase (FILE *fp, const CHAR_T *src, size_t len) +{ + while (len-- > 0) + { + fputc (TOUPPER ((UCHAR_T) *src, loc), fp); + ++src; + } +} +#else +static CHAR_T *memcpy_lowcase (CHAR_T *dest, const CHAR_T *src, + size_t len LOCALE_PARAM); + +static CHAR_T * +memcpy_lowcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM) +{ + while (len-- > 0) + dest[len] = TOLOWER ((UCHAR_T) src[len], loc); + return dest; +} + +static CHAR_T *memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, + size_t len LOCALE_PARAM); + +static CHAR_T * +memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM) +{ + while (len-- > 0) + dest[len] = TOUPPER ((UCHAR_T) src[len], loc); + return dest; +} +#endif + + +#if USE_C_LOCALE && HAVE_STRFTIME_L + +/* Cache for the C locale object. + Marked volatile so that different threads see the same value + (avoids locking). */ +static volatile locale_t c_locale_cache; + +/* Return the C locale object, or (locale_t) 0 with errno set + if it cannot be created. */ +static locale_t +c_locale (void) +{ + if (!c_locale_cache) + c_locale_cache = newlocale (LC_ALL_MASK, "C", (locale_t) 0); + return c_locale_cache; +} + +#endif + + +#if (defined __NetBSD__ || defined __sun) && REQUIRE_GNUISH_STRFTIME_AM_PM + +/* Return true if an AM/PM indicator should be removed. */ +static bool +should_remove_ampm (void) +{ + /* According to glibc's 'am_pm' attribute in the locale database, an AM/PM + indicator should be absent in the locales for the following languages: + ab an ast az be ber bg br bs ce cs csb cv da de dsb eo et eu fa fi fo fr + fur fy ga gl gv hr hsb ht hu hy it ka kk kl ku kv kw ky lb lg li lij ln + lt lv mg mhr mi mk mn ms mt nb nds nhn nl nn nr nso oc os pap pl pt ro + ru rw sah sc se sgs sk sl sm sr ss st su sv szl tg tk tn ts tt ug uk unm + uz ve wae wo xh zu */ + const char *loc = gl_locale_name (LC_TIME, "LC_TIME"); + bool remove_ampm = false; + switch (loc[0]) + { + case 'a': + switch (loc[1]) + { + case 'b': case 'n': case 'z': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 's': + if (loc[2] == 't' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 'b': + switch (loc[1]) + { + case 'e': + if (loc[2] == '\0' || loc[2] == '_' + || (loc[2] == 'r' && (loc[3] == '\0' || loc[3] == '_'))) + remove_ampm = true; + break; + case 'g': case 'r': case 's': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'c': + switch (loc[1]) + { + case 'e': case 'v': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 's': + if (loc[2] == '\0' || loc[2] == '_' + || (loc[2] == 'b' && (loc[3] == '\0' || loc[3] == '_'))) + remove_ampm = true; + break; + default: + break; + } + break; + case 'd': + switch (loc[1]) + { + case 'a': case 'e': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 's': + if (loc[2] == 'b' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 'e': + switch (loc[1]) + { + case 'o': case 't': case 'u': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'f': + switch (loc[1]) + { + case 'a': case 'i': case 'o': case 'r': case 'y': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 'u': + if (loc[2] == 'r' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 'g': + switch (loc[1]) + { + case 'a': case 'l': case 'v': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'h': + switch (loc[1]) + { + case 'r': case 't': case 'u': case 'y': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 's': + if (loc[2] == 'b' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 'i': + switch (loc[1]) + { + case 't': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'k': + switch (loc[1]) + { + case 'a': case 'k': case 'l': case 'u': case 'v': case 'w': case 'y': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'l': + switch (loc[1]) + { + case 'b': case 'g': case 'n': case 't': case 'v': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 'i': + if (loc[2] == 'j' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 'm': + switch (loc[1]) + { + case 'g': case 'i': case 'k': case 'n': case 's': case 't': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 'h': + if (loc[2] == 'r' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 'n': + switch (loc[1]) + { + case 'b': case 'l': case 'n': case 'r': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 'd': + if (loc[2] == 's' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + case 'h': + if (loc[2] == 'n' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + case 's': + if (loc[2] == 'o' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 'o': + switch (loc[1]) + { + case 'c': case 's': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'p': + switch (loc[1]) + { + case 'l': case 't': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 'a': + if (loc[2] == 'p' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 'r': + switch (loc[1]) + { + case 'o': case 'u': case 'w': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 's': + switch (loc[1]) + { + case 'c': case 'e': case 'k': case 'l': case 'm': case 'r': case 's': + case 't': case 'u': case 'v': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 'a': + if (loc[2] == 'h' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + case 'g': + if (loc[2] == 's' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + case 'z': + if (loc[2] == 'l' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 't': + switch (loc[1]) + { + case 'g': case 'k': case 'n': case 's': case 't': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'u': + switch (loc[1]) + { + case 'g': case 'k': case 'z': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 'n': + if (loc[2] == 'm'&& (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 'v': + switch (loc[1]) + { + case 'e': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'w': + switch (loc[1]) + { + case 'a': + if (loc[2] == 'e' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + case 'o': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'x': + switch (loc[1]) + { + case 'h': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'z': + switch (loc[1]) + { + case 'u': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + default: + break; + } + return remove_ampm; +} + +#endif + + +#if ! HAVE_TM_GMTOFF +/* Yield the difference between *A and *B, + measured in seconds, ignoring leap seconds. */ +# define tm_diff ftime_tm_diff +static int tm_diff (const struct tm *, const struct tm *); +static int +tm_diff (const struct tm *a, const struct tm *b) +{ + /* Compute intervening leap days correctly even if year is negative. + Take care to avoid int overflow in leap day calculations, + but it's OK to assume that A and B are close to each other. */ + int a4 = SHR (a->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (a->tm_year & 3); + int b4 = SHR (b->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (b->tm_year & 3); + int a100 = (a4 + (a4 < 0)) / 25 - (a4 < 0); + int b100 = (b4 + (b4 < 0)) / 25 - (b4 < 0); + int a400 = SHR (a100, 2); + int b400 = SHR (b100, 2); + int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400); + int years = a->tm_year - b->tm_year; + int days = (365 * years + intervening_leap_days + + (a->tm_yday - b->tm_yday)); + return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour)) + + (a->tm_min - b->tm_min)) + + (a->tm_sec - b->tm_sec)); +} +#endif /* ! HAVE_TM_GMTOFF */ + + + +/* The number of days from the first day of the first ISO week of this + year to the year day YDAY with week day WDAY. ISO weeks start on + Monday; the first ISO week has the year's first Thursday. YDAY may + be as small as YDAY_MINIMUM. */ +#define ISO_WEEK_START_WDAY 1 /* Monday */ +#define ISO_WEEK1_WDAY 4 /* Thursday */ +#define YDAY_MINIMUM (-366) +static int iso_week_days (int, int); +static __inline int +iso_week_days (int yday, int wday) +{ + /* Add enough to the first operand of % to make it nonnegative. */ + int big_enough_multiple_of_7 = (-YDAY_MINIMUM / 7 + 2) * 7; + return (yday + - (yday - wday + ISO_WEEK1_WDAY + big_enough_multiple_of_7) % 7 + + ISO_WEEK1_WDAY - ISO_WEEK_START_WDAY); +} + + +#if !defined _NL_CURRENT && (USE_C_LOCALE && !HAVE_STRFTIME_L) +static CHAR_T const c_weekday_names[][sizeof "Wednesday"] = + { + L_("Sunday"), L_("Monday"), L_("Tuesday"), L_("Wednesday"), + L_("Thursday"), L_("Friday"), L_("Saturday") + }; +static CHAR_T const c_month_names[][sizeof "September"] = + { + L_("January"), L_("February"), L_("March"), L_("April"), L_("May"), + L_("June"), L_("July"), L_("August"), L_("September"), L_("October"), + L_("November"), L_("December") + }; +#endif + + +/* When compiling this file, GNU applications can #define my_strftime + to a symbol (typically nstrftime) to get an extended strftime with + extra arguments TZ and NS. */ + +#ifdef my_strftime +# define extra_args , tz, ns +# define extra_args_spec , timezone_t tz, int ns +#else +# if defined COMPILE_WIDE +# define my_strftime wcsftime +# define nl_get_alt_digit _nl_get_walt_digit +# else +# define my_strftime strftime +# define nl_get_alt_digit _nl_get_alt_digit +# endif +# define extra_args +# define extra_args_spec +/* We don't have this information in general. */ +# define tz 1 +# define ns 0 +#endif + +static size_t __strftime_internal (STREAM_OR_CHAR_T *, STRFTIME_ARG (size_t) + const CHAR_T *, const struct tm *, + bool, int, int, bool * + extra_args_spec LOCALE_PARAM); + +/* Write information from TP into S according to the format + string FORMAT, writing no more that MAXSIZE characters + (including the terminating '\0') and returning number of + characters written. If S is NULL, nothing will be written + anywhere, so to determine how many characters would be + written, use NULL for S and (size_t) -1 for MAXSIZE. */ +size_t +my_strftime (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) + const CHAR_T *format, + const struct tm *tp extra_args_spec LOCALE_PARAM) +{ + bool tzset_called = false; + return __strftime_internal (s, STRFTIME_ARG (maxsize) format, tp, false, + 0, -1, &tzset_called extra_args LOCALE_ARG); +} +libc_hidden_def (my_strftime) + +/* Just like my_strftime, above, but with more parameters. + UPCASE indicates that the result should be converted to upper case. + YR_SPEC and WIDTH specify the padding and width for the year. + *TZSET_CALLED indicates whether tzset has been called here. */ +static size_t +__strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) + const CHAR_T *format, + const struct tm *tp, bool upcase, + int yr_spec, int width, bool *tzset_called + extra_args_spec LOCALE_PARAM) +{ +#if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL + struct __locale_data *const current = loc->__locales[LC_TIME]; +#endif +#if FPRINTFTIME + size_t maxsize = (size_t) -1; +#endif + + int saved_errno = errno; + int hour12 = tp->tm_hour; +#ifdef _NL_CURRENT + /* We cannot make the following values variables since we must delay + the evaluation of these values until really needed since some + expressions might not be valid in every situation. The 'struct tm' + might be generated by a strptime() call that initialized + only a few elements. Dereference the pointers only if the format + requires this. Then it is ok to fail if the pointers are invalid. */ +# define a_wkday \ + ((const CHAR_T *) (tp->tm_wday < 0 || tp->tm_wday > 6 \ + ? "?" : _NL_CURRENT (LC_TIME, NLW(ABDAY_1) + tp->tm_wday))) +# define f_wkday \ + ((const CHAR_T *) (tp->tm_wday < 0 || tp->tm_wday > 6 \ + ? "?" : _NL_CURRENT (LC_TIME, NLW(DAY_1) + tp->tm_wday))) +# define a_month \ + ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ + ? "?" : _NL_CURRENT (LC_TIME, NLW(ABMON_1) + tp->tm_mon))) +# define f_month \ + ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ + ? "?" : _NL_CURRENT (LC_TIME, NLW(MON_1) + tp->tm_mon))) +# define a_altmonth \ + ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ + ? "?" : _NL_CURRENT (LC_TIME, NLW(ABALTMON_1) + tp->tm_mon))) +# define f_altmonth \ + ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ + ? "?" : _NL_CURRENT (LC_TIME, NLW(ALTMON_1) + tp->tm_mon))) +# define ampm \ + ((const CHAR_T *) _NL_CURRENT (LC_TIME, tp->tm_hour > 11 \ + ? NLW(PM_STR) : NLW(AM_STR))) + +# define aw_len STRLEN (a_wkday) +# define am_len STRLEN (a_month) +# define aam_len STRLEN (a_altmonth) +# define ap_len STRLEN (ampm) +#elif USE_C_LOCALE && !HAVE_STRFTIME_L +/* The English abbreviated weekday names are just the first 3 characters of the + English full weekday names. */ +# define a_wkday \ + (tp->tm_wday < 0 || tp->tm_wday > 6 ? L_("?") : c_weekday_names[tp->tm_wday]) +# define aw_len 3 +# define f_wkday \ + (tp->tm_wday < 0 || tp->tm_wday > 6 ? L_("?") : c_weekday_names[tp->tm_wday]) +/* The English abbreviated month names are just the first 3 characters of the + English full month names. */ +# define a_month \ + (tp->tm_mon < 0 || tp->tm_mon > 11 ? L_("?") : c_month_names[tp->tm_mon]) +# define am_len 3 +# define f_month \ + (tp->tm_mon < 0 || tp->tm_mon > 11 ? L_("?") : c_month_names[tp->tm_mon]) +/* The English AM/PM strings happen to have the same length, namely 2. */ +# define ampm (L_("AMPM") + 2 * (tp->tm_hour > 11)) +# define ap_len 2 +#endif +#if HAVE_TZNAME + char **tzname_vec = tzname; +#endif + const char *zone; + size_t i = 0; + STREAM_OR_CHAR_T *p = s; + const CHAR_T *f; +#if DO_MULTIBYTE && !defined COMPILE_WIDE + const char *format_end = NULL; +#endif + + zone = NULL; +#if HAVE_STRUCT_TM_TM_ZONE + /* The POSIX test suite assumes that setting + the environment variable TZ to a new value before calling strftime() + will influence the result (the %Z format) even if the information in + TP is computed with a totally different time zone. + This is bogus: though POSIX allows bad behavior like this, + POSIX does not require it. Do the right thing instead. */ + zone = (const char *) tp->tm_zone; +#endif +#if HAVE_TZNAME + if (!tz) + { + if (! (zone && *zone)) + zone = "GMT"; + } + else + { +# if !HAVE_STRUCT_TM_TM_ZONE + /* Infer the zone name from *TZ instead of from TZNAME. */ + tzname_vec = tz->tzname_copy; +# endif + } + /* The tzset() call might have changed the value. */ + if (!(zone && *zone) && tp->tm_isdst >= 0) + { + /* POSIX.1 requires that local time zone information be used as + though strftime called tzset. */ +# ifndef my_strftime + if (!*tzset_called) + { + tzset (); + *tzset_called = true; + } +# endif + zone = tzname_vec[tp->tm_isdst != 0]; + } +#endif + if (! zone) + zone = ""; + + if (hour12 > 12) + hour12 -= 12; + else + if (hour12 == 0) + hour12 = 12; + + for (f = format; *f != '\0'; width = -1, f++) + { + int pad = 0; /* Padding for number ('_', '-', '+', '0', or 0). */ + int modifier; /* Field modifier ('E', 'O', or 0). */ + int digits = 0; /* Max digits for numeric format. */ + int number_value; /* Numeric value to be printed. */ + unsigned int u_number_value; /* (unsigned int) number_value. */ + bool negative_number; /* The number is negative. */ + bool always_output_a_sign; /* +/- should always be output. */ + int tz_colon_mask; /* Bitmask of where ':' should appear. */ + const CHAR_T *subfmt; + CHAR_T *bufp; + CHAR_T buf[1 + + 2 /* for the two colons in a %::z or %:::z time zone */ + + (sizeof (int) < sizeof (time_t) + ? INT_STRLEN_BOUND (time_t) + : INT_STRLEN_BOUND (int))]; + bool to_lowcase = false; + bool to_uppcase = upcase; + size_t colons; + bool change_case = false; + int format_char; + int subwidth; + +#if DO_MULTIBYTE && !defined COMPILE_WIDE + switch (*f) + { + case L_('%'): + break; + + case L_('\b'): case L_('\t'): case L_('\n'): + case L_('\v'): case L_('\f'): case L_('\r'): + case L_(' '): case L_('!'): case L_('"'): case L_('#'): case L_('&'): + case L_('\''): case L_('('): case L_(')'): case L_('*'): case L_('+'): + case L_(','): case L_('-'): case L_('.'): case L_('/'): case L_('0'): + case L_('1'): case L_('2'): case L_('3'): case L_('4'): case L_('5'): + case L_('6'): case L_('7'): case L_('8'): case L_('9'): case L_(':'): + case L_(';'): case L_('<'): case L_('='): case L_('>'): case L_('?'): + case L_('A'): case L_('B'): case L_('C'): case L_('D'): case L_('E'): + case L_('F'): case L_('G'): case L_('H'): case L_('I'): case L_('J'): + case L_('K'): case L_('L'): case L_('M'): case L_('N'): case L_('O'): + case L_('P'): case L_('Q'): case L_('R'): case L_('S'): case L_('T'): + case L_('U'): case L_('V'): case L_('W'): case L_('X'): case L_('Y'): + case L_('Z'): case L_('['): case L_('\\'): case L_(']'): case L_('^'): + case L_('_'): case L_('a'): case L_('b'): case L_('c'): case L_('d'): + case L_('e'): case L_('f'): case L_('g'): case L_('h'): case L_('i'): + case L_('j'): case L_('k'): case L_('l'): case L_('m'): case L_('n'): + case L_('o'): case L_('p'): case L_('q'): case L_('r'): case L_('s'): + case L_('t'): case L_('u'): case L_('v'): case L_('w'): case L_('x'): + case L_('y'): case L_('z'): case L_('{'): case L_('|'): case L_('}'): + case L_('~'): + /* The C Standard requires these 98 characters (plus '%') to + be in the basic execution character set. None of these + characters can start a multibyte sequence, so they need + not be analyzed further. */ + add1 (*f); + continue; + + default: + /* Copy this multibyte sequence until we reach its end, find + an error, or come back to the initial shift state. */ + { + mbstate_t mbstate = mbstate_zero; + size_t len = 0; + size_t fsize; + + if (! format_end) + format_end = f + strlen (f) + 1; + fsize = format_end - f; + + do + { + size_t bytes = mbrlen (f + len, fsize - len, &mbstate); + + if (bytes == 0) + break; + + if (bytes == (size_t) -2) + { + len += strlen (f + len); + break; + } + + if (bytes == (size_t) -1) + { + len++; + break; + } + + len += bytes; + } + while (! mbsinit (&mbstate)); + + cpy (len, f); + f += len - 1; + continue; + } + } + +#else /* ! DO_MULTIBYTE */ + + /* Either multibyte encodings are not supported, they are + safe for formats, so any non-'%' byte can be copied through, + or this is the wide character version. */ + if (*f != L_('%')) + { + add1 (*f); + continue; + } + +#endif /* ! DO_MULTIBYTE */ + + char const *percent = f; + + /* Check for flags that can modify a format. */ + while (1) + { + switch (*++f) + { + /* This influences the number formats. */ + case L_('_'): + case L_('-'): + case L_('+'): + case L_('0'): + pad = *f; + continue; + + /* This changes textual output. */ + case L_('^'): + to_uppcase = true; + continue; + case L_('#'): + change_case = true; + continue; + + default: + break; + } + break; + } + + if (ISDIGIT (*f)) + { + width = 0; + do + { + if (ckd_mul (&width, width, 10) + || ckd_add (&width, width, *f - L_('0'))) + width = INT_MAX; + ++f; + } + while (ISDIGIT (*f)); + } + + /* Check for modifiers. */ + switch (*f) + { + case L_('E'): + case L_('O'): + modifier = *f++; + break; + + default: + modifier = 0; + break; + } + + /* Now do the specified format. */ + format_char = *f; + switch (format_char) + { +#define DO_NUMBER(d, v) \ + do \ + { \ + digits = d; \ + number_value = v; \ + goto do_number; \ + } \ + while (0) +#define DO_SIGNED_NUMBER(d, negative, v) \ + DO_MAYBE_SIGNED_NUMBER (d, negative, v, do_signed_number) +#define DO_YEARISH(d, negative, v) \ + DO_MAYBE_SIGNED_NUMBER (d, negative, v, do_yearish) +#define DO_MAYBE_SIGNED_NUMBER(d, negative, v, label) \ + do \ + { \ + digits = d; \ + negative_number = negative; \ + u_number_value = v; \ + goto label; \ + } \ + while (0) + + /* The mask is not what you might think. + When the ordinal i'th bit is set, insert a colon + before the i'th digit of the time zone representation. */ +#define DO_TZ_OFFSET(d, mask, v) \ + do \ + { \ + digits = d; \ + tz_colon_mask = mask; \ + u_number_value = v; \ + goto do_tz_offset; \ + } \ + while (0) +#define DO_NUMBER_SPACEPAD(d, v) \ + do \ + { \ + digits = d; \ + number_value = v; \ + goto do_number_spacepad; \ + } \ + while (0) + + case L_('%'): + if (f - 1 != percent) + goto bad_percent; + add1 (*f); + break; + + case L_('a'): + if (modifier != 0) + goto bad_format; + if (change_case) + { + to_uppcase = true; + to_lowcase = false; + } +#if defined _NL_CURRENT || (USE_C_LOCALE && !HAVE_STRFTIME_L) + cpy (aw_len, a_wkday); + break; +#else + goto underlying_strftime; +#endif + + case 'A': + if (modifier != 0) + goto bad_format; + if (change_case) + { + to_uppcase = true; + to_lowcase = false; + } +#if defined _NL_CURRENT || (USE_C_LOCALE && !HAVE_STRFTIME_L) + cpy (STRLEN (f_wkday), f_wkday); + break; +#else + goto underlying_strftime; +#endif + + case L_('b'): + case L_('h'): + if (change_case) + { + to_uppcase = true; + to_lowcase = false; + } + if (modifier == L_('E')) + goto bad_format; +#ifdef _NL_CURRENT + if (modifier == L_('O')) + cpy (aam_len, a_altmonth); + else + cpy (am_len, a_month); + break; +#elif USE_C_LOCALE && !HAVE_STRFTIME_L + cpy (am_len, a_month); + break; +#else + goto underlying_strftime; +#endif + + case L_('B'): + if (modifier == L_('E')) + goto bad_format; + if (change_case) + { + to_uppcase = true; + to_lowcase = false; + } +#ifdef _NL_CURRENT + if (modifier == L_('O')) + cpy (STRLEN (f_altmonth), f_altmonth); + else + cpy (STRLEN (f_month), f_month); + break; +#elif USE_C_LOCALE && !HAVE_STRFTIME_L + cpy (STRLEN (f_month), f_month); + break; +#else + goto underlying_strftime; +#endif + + case L_('c'): + if (modifier == L_('O')) + goto bad_format; +#ifdef _NL_CURRENT + if (! (modifier == L_('E') + && (*(subfmt = + (const CHAR_T *) _NL_CURRENT (LC_TIME, + NLW(ERA_D_T_FMT))) + != '\0'))) + subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_T_FMT)); +#elif USE_C_LOCALE && !HAVE_STRFTIME_L + subfmt = L_("%a %b %e %H:%M:%S %Y"); +#else + goto underlying_strftime; +#endif + + subformat: + subwidth = -1; + subformat_width: + { + size_t len = __strftime_internal (NULL, STRFTIME_ARG ((size_t) -1) + subfmt, tp, to_uppcase, + pad, subwidth, tzset_called + extra_args LOCALE_ARG); + add (len, __strftime_internal (p, + STRFTIME_ARG (maxsize - i) + subfmt, tp, to_uppcase, + pad, subwidth, tzset_called + extra_args LOCALE_ARG)); + } + break; + +#if !((defined _NL_CURRENT && HAVE_STRUCT_ERA_ENTRY) || (USE_C_LOCALE && !HAVE_STRFTIME_L)) + underlying_strftime: + { + /* The relevant information is available only via the + underlying strftime implementation, so use that. */ + char ufmt[5]; + char *u = ufmt; + char ubuf[1024]; /* enough for any single format in practice */ + size_t len; + /* Make sure we're calling the actual underlying strftime. + In some cases, config.h contains something like + "#define strftime rpl_strftime". */ +# ifdef strftime +# undef strftime + size_t strftime (char *, size_t, const char *, struct tm const *); +# endif + + /* The space helps distinguish strftime failure from empty + output. */ + *u++ = ' '; + *u++ = '%'; + if (modifier != 0) + *u++ = modifier; + *u++ = format_char; + *u = '\0'; + +# if USE_C_LOCALE /* implies HAVE_STRFTIME_L */ + locale_t locale = c_locale (); + if (!locale) + return 0; /* errno is set here */ + len = strftime_l (ubuf, sizeof ubuf, ufmt, tp, locale); +# else + len = strftime (ubuf, sizeof ubuf, ufmt, tp); +# endif + if (len != 0) + { +# if defined __NetBSD__ || defined __sun /* NetBSD, Solaris */ + if (format_char == L_('c')) + { + /* The output of the strftime %c directive consists of the + date, the time, and the time zone. But the time zone is + wrong, since neither TZ nor ZONE was passed as argument. + Therefore, remove the the last space-delimited word. + In order not to accidentally remove a date or a year + (that contains no letter) or an AM/PM indicator (that has + length 2), remove that last word only if it contains a + letter and has length >= 3. */ + char *space; + for (space = ubuf + len - 1; *space != ' '; space--) + ; + if (space > ubuf) + { + /* Found a space. */ + if (strlen (space + 1) >= 3) + { + /* The last word has length >= 3. */ + bool found_letter = false; + const char *p; + for (p = space + 1; *p != '\0'; p++) + if ((*p >= 'A' && *p <= 'Z') + || (*p >= 'a' && *p <= 'z')) + { + found_letter = true; + break; + } + if (found_letter) + { + /* The last word contains a letter. */ + *space = '\0'; + len = space - ubuf; + } + } + } + } +# if REQUIRE_GNUISH_STRFTIME_AM_PM + /* The output of the strftime %p and %r directives contains + an AM/PM indicator even for locales where it is not + suitable, such as French. Remove this indicator. */ + else if (format_char == L_('p')) + { + bool found_ampm = (len > 1); + if (found_ampm && should_remove_ampm ()) + { + ubuf[1] = '\0'; + len = 1; + } + } + else if (format_char == L_('r')) + { + char last_char = ubuf[len - 1]; + bool found_ampm = !(last_char >= '0' && last_char <= '9'); + if (found_ampm && should_remove_ampm ()) + { + char *space; + for (space = ubuf + len - 1; *space != ' '; space--) + ; + if (space > ubuf) + { + *space = '\0'; + len = space - ubuf; + } + } + } +# endif +# endif + cpy (len - 1, ubuf + 1); + } + } + break; +#endif + + case L_('C'): + if (modifier == L_('E')) + { +#if HAVE_STRUCT_ERA_ENTRY + struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); + if (era) + { +# ifdef COMPILE_WIDE + size_t len = __wcslen (era->era_wname); + cpy (len, era->era_wname); +# else + size_t len = strlen (era->era_name); + cpy (len, era->era_name); +# endif + break; + } +#elif USE_C_LOCALE && !HAVE_STRFTIME_L +#else + goto underlying_strftime; +#endif + } + + { + bool negative_year = tp->tm_year < - TM_YEAR_BASE; + bool zero_thru_1899 = !negative_year & (tp->tm_year < 0); + int century = ((tp->tm_year - 99 * zero_thru_1899) / 100 + + TM_YEAR_BASE / 100); + DO_YEARISH (2, negative_year, century); + } + + case L_('x'): + if (modifier == L_('O')) + goto bad_format; +#ifdef _NL_CURRENT + if (! (modifier == L_('E') + && (*(subfmt = + (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ERA_D_FMT))) + != L_('\0')))) + subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_FMT)); + goto subformat; +#elif USE_C_LOCALE && !HAVE_STRFTIME_L + subfmt = L_("%m/%d/%y"); + goto subformat; +#else + goto underlying_strftime; +#endif + case L_('D'): + if (modifier != 0) + goto bad_format; + subfmt = L_("%m/%d/%y"); + goto subformat; + + case L_('d'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, tp->tm_mday); + + case L_('e'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER_SPACEPAD (2, tp->tm_mday); + + /* All numeric formats set DIGITS and NUMBER_VALUE (or U_NUMBER_VALUE) + and then jump to one of these labels. */ + + do_tz_offset: + always_output_a_sign = true; + goto do_number_body; + + do_yearish: + if (pad == 0) + pad = yr_spec; + always_output_a_sign + = (pad == L_('+') + && ((digits == 2 ? 99 : 9999) < u_number_value + || digits < width)); + goto do_maybe_signed_number; + + do_number_spacepad: + if (pad == 0) + pad = L_('_'); + + do_number: + /* Format NUMBER_VALUE according to the MODIFIER flag. */ + negative_number = number_value < 0; + u_number_value = number_value; + + do_signed_number: + always_output_a_sign = false; + + do_maybe_signed_number: + tz_colon_mask = 0; + + do_number_body: + /* Format U_NUMBER_VALUE according to the MODIFIER flag. + NEGATIVE_NUMBER is nonzero if the original number was + negative; in this case it was converted directly to + unsigned int (i.e., modulo (UINT_MAX + 1)) without + negating it. */ + if (modifier == L_('O') && !negative_number) + { +#ifdef _NL_CURRENT + /* Get the locale specific alternate representation of + the number. If none exist NULL is returned. */ + const CHAR_T *cp = nl_get_alt_digit (u_number_value + HELPER_LOCALE_ARG); + + if (cp != NULL) + { + size_t digitlen = STRLEN (cp); + if (digitlen != 0) + { + cpy (digitlen, cp); + break; + } + } +#elif USE_C_LOCALE && !HAVE_STRFTIME_L +#else + goto underlying_strftime; +#endif + } + + bufp = buf + sizeof (buf) / sizeof (buf[0]); + + if (negative_number) + u_number_value = - u_number_value; + + do + { + if (tz_colon_mask & 1) + *--bufp = ':'; + tz_colon_mask >>= 1; + *--bufp = u_number_value % 10 + L_('0'); + u_number_value /= 10; + } + while (u_number_value != 0 || tz_colon_mask != 0); + + do_number_sign_and_padding: + if (pad == 0) + pad = L_('0'); + if (width < 0) + width = digits; + + { + CHAR_T sign_char = (negative_number ? L_('-') + : always_output_a_sign ? L_('+') + : 0); + int numlen = buf + sizeof buf / sizeof buf[0] - bufp; + int shortage = width - !!sign_char - numlen; + int padding = pad == L_('-') || shortage <= 0 ? 0 : shortage; + + if (sign_char) + { + if (pad == L_('_')) + { + if (p) + memset_space (p, padding); + i += padding; + width -= padding; + } + width_add1 (0, sign_char); + width--; + } + + cpy (numlen, bufp); + } + break; + + case L_('F'): + if (modifier != 0) + goto bad_format; + if (pad == 0 && width < 0) + { + pad = L_('+'); + subwidth = 4; + } + else + { + subwidth = width - 6; + if (subwidth < 0) + subwidth = 0; + } + subfmt = L_("%Y-%m-%d"); + goto subformat_width; + + case L_('H'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, tp->tm_hour); + + case L_('I'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, hour12); + + case L_('k'): /* GNU extension. */ + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER_SPACEPAD (2, tp->tm_hour); + + case L_('l'): /* GNU extension. */ + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER_SPACEPAD (2, hour12); + + case L_('j'): + if (modifier == L_('E')) + goto bad_format; + + DO_SIGNED_NUMBER (3, tp->tm_yday < -1, tp->tm_yday + 1U); + + case L_('M'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, tp->tm_min); + + case L_('m'): + if (modifier == L_('E')) + goto bad_format; + + DO_SIGNED_NUMBER (2, tp->tm_mon < -1, tp->tm_mon + 1U); + +#ifndef _LIBC + case L_('N'): /* GNU extension. */ + if (modifier == L_('E')) + goto bad_format; + { + int n = ns, ns_digits = 9; + if (width <= 0) + width = ns_digits; + int ndigs = ns_digits; + while (width < ndigs || (1 < ndigs && n % 10 == 0)) + ndigs--, n /= 10; + for (int j = ndigs; 0 < j; j--) + buf[j - 1] = n % 10 + L_('0'), n /= 10; + if (!pad) + pad = L_('0'); + width_cpy (0, ndigs, buf); + width_add (width - ndigs, 0, (void) 0); + } + break; +#endif + + case L_('n'): + add1 (L_('\n')); + break; + + case L_('P'): + to_lowcase = true; +#ifndef _NL_CURRENT + format_char = L_('p'); +#endif + FALLTHROUGH; + case L_('p'): + if (change_case) + { + to_uppcase = false; + to_lowcase = true; + } +#if defined _NL_CURRENT || (USE_C_LOCALE && !HAVE_STRFTIME_L) + cpy (ap_len, ampm); + break; +#else + goto underlying_strftime; +#endif + + case L_('q'): /* GNU extension. */ + DO_SIGNED_NUMBER (1, false, ((tp->tm_mon * 11) >> 5) + 1); + + case L_('R'): + subfmt = L_("%H:%M"); + goto subformat; + + case L_('r'): +#ifdef _NL_CURRENT + if (*(subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, + NLW(T_FMT_AMPM))) + == L_('\0')) + subfmt = L_("%I:%M:%S %p"); + goto subformat; +#elif USE_C_LOCALE && !HAVE_STRFTIME_L + subfmt = L_("%I:%M:%S %p"); + goto subformat; +#elif (defined __APPLE__ && defined __MACH__) || defined __FreeBSD__ + /* macOS, FreeBSD strftime() may produce empty output for "%r". */ + subfmt = L_("%I:%M:%S %p"); + goto subformat; +#else + goto underlying_strftime; +#endif + + case L_('S'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, tp->tm_sec); + + case L_('s'): /* GNU extension. */ + { + struct tm ltm; + time_t t; + + ltm = *tp; + ltm.tm_yday = -1; + t = mktime_z (tz, <m); + if (ltm.tm_yday < 0) + { + errno = EOVERFLOW; + return 0; + } + + /* Generate string value for T using time_t arithmetic; + this works even if sizeof (long) < sizeof (time_t). */ + + bufp = buf + sizeof (buf) / sizeof (buf[0]); + negative_number = t < 0; + + do + { + int d = t % 10; + t /= 10; + *--bufp = (negative_number ? -d : d) + L_('0'); + } + while (t != 0); + + digits = 1; + always_output_a_sign = false; + goto do_number_sign_and_padding; + } + + case L_('X'): + if (modifier == L_('O')) + goto bad_format; +#ifdef _NL_CURRENT + if (! (modifier == L_('E') + && (*(subfmt = + (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ERA_T_FMT))) + != L_('\0')))) + subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(T_FMT)); + goto subformat; +#elif USE_C_LOCALE && !HAVE_STRFTIME_L + subfmt = L_("%H:%M:%S"); + goto subformat; +#else + goto underlying_strftime; +#endif + case L_('T'): + subfmt = L_("%H:%M:%S"); + goto subformat; + + case L_('t'): + add1 (L_('\t')); + break; + + case L_('u'): + DO_NUMBER (1, (tp->tm_wday - 1 + 7) % 7 + 1); + + case L_('U'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, (tp->tm_yday - tp->tm_wday + 7) / 7); + + case L_('V'): + case L_('g'): + case L_('G'): + if (modifier == L_('E')) + goto bad_format; + { + /* YEAR is a leap year if and only if (tp->tm_year + TM_YEAR_BASE) + is a leap year, except that YEAR and YEAR - 1 both work + correctly even when (tp->tm_year + TM_YEAR_BASE) would + overflow. */ + int year = (tp->tm_year + + (tp->tm_year < 0 + ? TM_YEAR_BASE % 400 + : TM_YEAR_BASE % 400 - 400)); + int year_adjust = 0; + int days = iso_week_days (tp->tm_yday, tp->tm_wday); + + if (days < 0) + { + /* This ISO week belongs to the previous year. */ + year_adjust = -1; + days = iso_week_days (tp->tm_yday + (365 + __isleap (year - 1)), + tp->tm_wday); + } + else + { + int d = iso_week_days (tp->tm_yday - (365 + __isleap (year)), + tp->tm_wday); + if (0 <= d) + { + /* This ISO week belongs to the next year. */ + year_adjust = 1; + days = d; + } + } + + switch (*f) + { + case L_('g'): + { + int yy = (tp->tm_year % 100 + year_adjust) % 100; + DO_YEARISH (2, false, + (0 <= yy + ? yy + : tp->tm_year < -TM_YEAR_BASE - year_adjust + ? -yy + : yy + 100)); + } + + case L_('G'): + DO_YEARISH (4, tp->tm_year < -TM_YEAR_BASE - year_adjust, + (tp->tm_year + (unsigned int) TM_YEAR_BASE + + year_adjust)); + + default: + DO_NUMBER (2, days / 7 + 1); + } + } + + case L_('W'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, (tp->tm_yday - (tp->tm_wday - 1 + 7) % 7 + 7) / 7); + + case L_('w'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (1, tp->tm_wday); + + case L_('Y'): + if (modifier == L_('E')) + { +#if HAVE_STRUCT_ERA_ENTRY + struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); + if (era) + { +# ifdef COMPILE_WIDE + subfmt = era->era_wformat; +# else + subfmt = era->era_format; +# endif + if (pad == 0) + pad = yr_spec; + goto subformat; + } +#elif USE_C_LOCALE && !HAVE_STRFTIME_L +#else + goto underlying_strftime; +#endif + } + if (modifier == L_('O')) + goto bad_format; + + DO_YEARISH (4, tp->tm_year < -TM_YEAR_BASE, + tp->tm_year + (unsigned int) TM_YEAR_BASE); + + case L_('y'): + if (modifier == L_('E')) + { +#if HAVE_STRUCT_ERA_ENTRY + struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); + if (era) + { + int delta = tp->tm_year - era->start_date[0]; + if (pad == 0) + pad = yr_spec; + DO_NUMBER (2, (era->offset + + delta * era->absolute_direction)); + } +#elif USE_C_LOCALE && !HAVE_STRFTIME_L +#else + goto underlying_strftime; +#endif + } + + { + int yy = tp->tm_year % 100; + if (yy < 0) + yy = tp->tm_year < - TM_YEAR_BASE ? -yy : yy + 100; + DO_YEARISH (2, false, yy); + } + + case L_('Z'): + if (change_case) + { + to_uppcase = false; + to_lowcase = true; + } + +#ifdef COMPILE_WIDE + { + /* The zone string is always given in multibyte form. We have + to convert it to wide character. */ + size_t w = pad == L_('-') || width < 0 ? 0 : width; + char const *z = zone; + mbstate_t st = {0}; + size_t len = __mbsrtowcs_l (p, &z, maxsize - i, &st, loc); + if (len == (size_t) -1) + return 0; + size_t incr = len < w ? w : len; + if (incr >= maxsize - i) + { + errno = ERANGE; + return 0; + } + if (p) + { + if (len < w) + { + size_t delta = w - len; + __wmemmove (p + delta, p, len); + wchar_t wc = pad == L_('0') || pad == L_('+') ? L'0' : L' '; + wmemset (p, wc, delta); + } + p += incr; + } + i += incr; + } +#else + cpy (strlen (zone), zone); +#endif + break; + + case L_(':'): + /* :, ::, and ::: are valid only just before 'z'. + :::: etc. are rejected later. */ + for (colons = 1; f[colons] == L_(':'); colons++) + continue; + if (f[colons] != L_('z')) + goto bad_format; + f += colons; + goto do_z_conversion; + + case L_('z'): + colons = 0; + + do_z_conversion: + if (tp->tm_isdst < 0) + break; + + { + int diff; + int hour_diff; + int min_diff; + int sec_diff; +#if HAVE_TM_GMTOFF + diff = tp->tm_gmtoff; +#else + if (!tz) + diff = 0; + else + { + struct tm gtm; + struct tm ltm; + time_t lt; + + /* POSIX.1 requires that local time zone information be used as + though strftime called tzset. */ +# ifndef my_strftime + if (!*tzset_called) + { + tzset (); + *tzset_called = true; + } +# endif + + ltm = *tp; + ltm.tm_wday = -1; + lt = mktime_z (tz, <m); + if (ltm.tm_wday < 0 || ! localtime_rz (0, <, >m)) + break; + diff = tm_diff (<m, >m); + } +#endif + + negative_number = diff < 0 || (diff == 0 && *zone == '-'); + hour_diff = diff / 60 / 60; + min_diff = diff / 60 % 60; + sec_diff = diff % 60; + + switch (colons) + { + case 0: /* +hhmm */ + DO_TZ_OFFSET (5, 0, hour_diff * 100 + min_diff); + + case 1: tz_hh_mm: /* +hh:mm */ + DO_TZ_OFFSET (6, 04, hour_diff * 100 + min_diff); + + case 2: tz_hh_mm_ss: /* +hh:mm:ss */ + DO_TZ_OFFSET (9, 024, + hour_diff * 10000 + min_diff * 100 + sec_diff); + + case 3: /* +hh if possible, else +hh:mm, else +hh:mm:ss */ + if (sec_diff != 0) + goto tz_hh_mm_ss; + if (min_diff != 0) + goto tz_hh_mm; + DO_TZ_OFFSET (3, 0, hour_diff); + + default: + goto bad_format; + } + } + + case L_('\0'): /* GNU extension: % at end of format. */ + bad_percent: + --f; + FALLTHROUGH; + default: + /* Unknown format; output the format, including the '%', + since this is most likely the right thing to do if a + multibyte string has been misparsed. */ + bad_format: + cpy (f - percent + 1, percent); + break; + } + } + +#if ! FPRINTFTIME + if (p && maxsize != 0) + *p = L_('\0'); +#endif + + errno = saved_errno; + return i; +} diff --git a/lib/strftime.h b/lib/strftime.h index d6efdb848a3..8ce62cdb6d7 100644 --- a/lib/strftime.h +++ b/lib/strftime.h @@ -21,17 +21,68 @@ extern "C" { #endif -/* Just like strftime, but with two more arguments: - POSIX requires that strftime use the local timezone information. - Use the timezone __TZ instead. Use __NS as the number of - nanoseconds in the %N directive. - - On error, set errno and return 0. Otherwise, return the number of - bytes generated (not counting the trailing NUL), preserving errno - if the number is 0. This errno behavior is in draft POSIX 202x - plus some requested changes to POSIX. */ -size_t nstrftime (char *restrict, size_t, char const *, struct tm const *, - timezone_t __tz, int __ns); +/* Formats the broken-down time *__TP, with additional __NS nanoseconds, + into the buffer __S of size __MAXSIZE, according to the rules of the + LC_TIME category of the current locale. + + Uses the time zone __TZ. + If *__TP represents local time, __TZ should be set to + tzalloc (getenv ("TZ")). + If *__TP represents universal time (a.k.a. GMT), __TZ should be set to + (timezone_t) 0. + + The format string __FORMAT, including GNU extensions, is described in + the GNU libc's strftime() documentation: + + Additionally, the following conversion is supported: + %N The number of nanoseconds, passed as __NS argument. + Here's a summary of the available conversions (= format directives): + literal characters %n %t %% + date: + century %C + year %Y %y + week-based year %G %g + month (in year) %m %B %b %h + week in year %U %W %V + day in year %j + day (in month) %d %e + day in week %u %w %A %a + year, month, day %x %F %D + time: + half-day %p %P + hour %H %k %I %l + minute (in hour) %M + hour, minute %R + second (in minute) %S + hour, minute, second %r %T %X + second (since epoch) %s + date and time: %c + time zone: %z %Z + nanosecond %N + + Stores the result, as a string with a trailing NUL character, at the + beginning of the array __S[0..__MAXSIZE-1], if it fits, and returns + the length of that string, not counting the trailing NUL. In this case, + errno is preserved if the return value is 0. + If it does not fit, this function sets errno to ERANGE and returns 0. + Upon other errors, this function sets errno and returns 0 as well. + + Note: The errno behavior is in draft POSIX 202x plus some requested + changes to POSIX. + + This function is like strftime, but with two more arguments: + * __TZ instead of the local timezone information, + * __NS as the number of nanoseconds in the %N directive. + */ +size_t nstrftime (char *restrict __s, size_t __maxsize, + char const *__format, + struct tm const *__tp, timezone_t __tz, int __ns); + +/* Like nstrftime, except that it uses the "C" locale instead of the + current locale. */ +size_t c_nstrftime (char *restrict __s, size_t __maxsize, + char const *__format, + struct tm const *__tp, timezone_t __tz, int __ns); #ifdef __cplusplus } diff --git a/lib/time.in.h b/lib/time.in.h index ce28f1af25d..df99c8abca9 100644 --- a/lib/time.in.h +++ b/lib/time.in.h @@ -438,11 +438,7 @@ _GL_CXXALIAS_SYS (ctime, char *, (time_t const *__tp)); _GL_CXXALIASWARN (ctime); # endif # elif defined GNULIB_POSIXCHECK -# undef ctime -# if HAVE_RAW_DECL_CTIME -_GL_WARN_ON_USE (ctime, "ctime has portability problems - " - "use gnulib module ctime for portability"); -# endif +/* No need to warn about portability, as a more serious warning is below. */ # endif /* Convert *TP to a date and time string. See diff --git a/lib/time_r.c b/lib/time_r.c index 3ef0b36802c..b724f3b38de 100644 --- a/lib/time_r.c +++ b/lib/time_r.c @@ -21,6 +21,11 @@ #include +/* The replacement functions in this file are only used on native Windows. + They are multithread-safe, because the gmtime() and localtime() functions + on native Windows — both in the ucrt and in the older MSVCRT — return a + pointer to a 'struct tm' in thread-local memory. */ + static struct tm * copy_tm_result (struct tm *dest, struct tm const *src) { diff --git a/lib/warn-on-use.h b/lib/warn-on-use.h index 8f4d40dcbeb..701013a07f4 100644 --- a/lib/warn-on-use.h +++ b/lib/warn-on-use.h @@ -32,6 +32,10 @@ _GL_WARN_ON_USE_ATTRIBUTE is for functions with 'static' or 'inline' linkage. + _GL_WARN_ON_USE should not be used more than once for a given function + in a given compilation unit (because this may generate a warning even + if the function is never called). + However, one of the reasons that a function is a portability trap is if it has the wrong signature. Declaring FUNCTION with a different signature in C is a compilation error, so this macro must use the diff --git a/lib/xalloc-oversized.h b/lib/xalloc-oversized.h index 0b7bb2cee85..7f30f83e769 100644 --- a/lib/xalloc-oversized.h +++ b/lib/xalloc-oversized.h @@ -29,8 +29,7 @@ is SIZE_MAX - 1. */ #define __xalloc_oversized(n, s) \ ((s) != 0 \ - && ((size_t) (PTRDIFF_MAX < SIZE_MAX ? PTRDIFF_MAX : SIZE_MAX - 1) / (s) \ - < (n))) + && (PTRDIFF_MAX < SIZE_MAX ? PTRDIFF_MAX : SIZE_MAX - 1) / (s) < (n)) /* Return 1 if and only if an array of N objects, each of size S, cannot exist reliably because its total size in bytes would exceed diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index 00691c0d6c3..d8d0904f787 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -1,4 +1,4 @@ -# gnulib-common.m4 serial 91 +# gnulib-common.m4 serial 92 dnl Copyright (C) 2007-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -76,42 +76,48 @@ AC_DEFUN([gl_COMMON_BODY], [ #endif]) AH_VERBATIM([attribute], [/* Attributes. */ -#if (defined __has_attribute \ - && (!defined __clang_minor__ \ - || (defined __apple_build_version__ \ - ? 7000000 <= __apple_build_version__ \ - : 5 <= __clang_major__))) -# define _GL_HAS_ATTRIBUTE(attr) __has_attribute (__##attr##__) -#else -# define _GL_HAS_ATTRIBUTE(attr) _GL_ATTR_##attr -# define _GL_ATTR_alloc_size _GL_GNUC_PREREQ (4, 3) -# define _GL_ATTR_always_inline _GL_GNUC_PREREQ (3, 2) -# define _GL_ATTR_artificial _GL_GNUC_PREREQ (4, 3) -# define _GL_ATTR_cold _GL_GNUC_PREREQ (4, 3) -# define _GL_ATTR_const _GL_GNUC_PREREQ (2, 95) -# define _GL_ATTR_deprecated _GL_GNUC_PREREQ (3, 1) -# define _GL_ATTR_diagnose_if 0 -# define _GL_ATTR_error _GL_GNUC_PREREQ (4, 3) -# define _GL_ATTR_externally_visible _GL_GNUC_PREREQ (4, 1) -# define _GL_ATTR_fallthrough _GL_GNUC_PREREQ (7, 0) -# define _GL_ATTR_format _GL_GNUC_PREREQ (2, 7) -# define _GL_ATTR_leaf _GL_GNUC_PREREQ (4, 6) -# define _GL_ATTR_malloc _GL_GNUC_PREREQ (3, 0) -# ifdef _ICC -# define _GL_ATTR_may_alias 0 +/* Define _GL_HAS_ATTRIBUTE only once, because on FreeBSD, with gcc < 5, if + gets included once again after , __has_attribute(x) + expands to 0 always, and redefining _GL_HAS_ATTRIBUTE would turn off all + attributes. */ +#ifndef _GL_HAS_ATTRIBUTE +# if (defined __has_attribute \ + && (!defined __clang_minor__ \ + || (defined __apple_build_version__ \ + ? 7000000 <= __apple_build_version__ \ + : 5 <= __clang_major__))) +# define _GL_HAS_ATTRIBUTE(attr) __has_attribute (__##attr##__) # else -# define _GL_ATTR_may_alias _GL_GNUC_PREREQ (3, 3) +# define _GL_HAS_ATTRIBUTE(attr) _GL_ATTR_##attr +# define _GL_ATTR_alloc_size _GL_GNUC_PREREQ (4, 3) +# define _GL_ATTR_always_inline _GL_GNUC_PREREQ (3, 2) +# define _GL_ATTR_artificial _GL_GNUC_PREREQ (4, 3) +# define _GL_ATTR_cold _GL_GNUC_PREREQ (4, 3) +# define _GL_ATTR_const _GL_GNUC_PREREQ (2, 95) +# define _GL_ATTR_deprecated _GL_GNUC_PREREQ (3, 1) +# define _GL_ATTR_diagnose_if 0 +# define _GL_ATTR_error _GL_GNUC_PREREQ (4, 3) +# define _GL_ATTR_externally_visible _GL_GNUC_PREREQ (4, 1) +# define _GL_ATTR_fallthrough _GL_GNUC_PREREQ (7, 0) +# define _GL_ATTR_format _GL_GNUC_PREREQ (2, 7) +# define _GL_ATTR_leaf _GL_GNUC_PREREQ (4, 6) +# define _GL_ATTR_malloc _GL_GNUC_PREREQ (3, 0) +# ifdef _ICC +# define _GL_ATTR_may_alias 0 +# else +# define _GL_ATTR_may_alias _GL_GNUC_PREREQ (3, 3) +# endif +# define _GL_ATTR_noinline _GL_GNUC_PREREQ (3, 1) +# define _GL_ATTR_nonnull _GL_GNUC_PREREQ (3, 3) +# define _GL_ATTR_nonstring _GL_GNUC_PREREQ (8, 0) +# define _GL_ATTR_nothrow _GL_GNUC_PREREQ (3, 3) +# define _GL_ATTR_packed _GL_GNUC_PREREQ (2, 7) +# define _GL_ATTR_pure _GL_GNUC_PREREQ (2, 96) +# define _GL_ATTR_returns_nonnull _GL_GNUC_PREREQ (4, 9) +# define _GL_ATTR_sentinel _GL_GNUC_PREREQ (4, 0) +# define _GL_ATTR_unused _GL_GNUC_PREREQ (2, 7) +# define _GL_ATTR_warn_unused_result _GL_GNUC_PREREQ (3, 4) # endif -# define _GL_ATTR_noinline _GL_GNUC_PREREQ (3, 1) -# define _GL_ATTR_nonnull _GL_GNUC_PREREQ (3, 3) -# define _GL_ATTR_nonstring _GL_GNUC_PREREQ (8, 0) -# define _GL_ATTR_nothrow _GL_GNUC_PREREQ (3, 3) -# define _GL_ATTR_packed _GL_GNUC_PREREQ (2, 7) -# define _GL_ATTR_pure _GL_GNUC_PREREQ (2, 96) -# define _GL_ATTR_returns_nonnull _GL_GNUC_PREREQ (4, 9) -# define _GL_ATTR_sentinel _GL_GNUC_PREREQ (4, 0) -# define _GL_ATTR_unused _GL_GNUC_PREREQ (2, 7) -# define _GL_ATTR_warn_unused_result _GL_GNUC_PREREQ (3, 4) #endif /* Use __has_c_attribute if available. However, do not use with diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 7a7ebb0f34e..d8b92e7b122 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -1024,7 +1024,7 @@ AC_DEFUN([gl_INIT], if test $ac_use_included_regex = yes; then func_gl_gnulib_m4code_fd38c7e463b54744b77b98aeafb4fa7c fi - if { test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; } && test $ac_cv_type_long_long_int = yes; then + if test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then func_gl_gnulib_m4code_strtoll fi if test $HAVE_TIMEGM = 0 || test $REPLACE_TIMEGM = 1; then @@ -1422,6 +1422,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/stdlib.in.h lib/stpcpy.c lib/str-two-way.h + lib/strftime.c lib/strftime.h lib/string.in.h lib/strnlen.c diff --git a/m4/nanosleep.m4 b/m4/nanosleep.m4 index c51f590402f..ff730b676cd 100644 --- a/m4/nanosleep.m4 +++ b/m4/nanosleep.m4 @@ -1,4 +1,4 @@ -# serial 46 +# serial 47 dnl From Jim Meyering. dnl Check for the nanosleep function. @@ -119,6 +119,10 @@ AC_DEFUN([gl_FUNC_NANOSLEEP], # Guess it halfway works when the kernel is Linux. linux*) gl_cv_func_nanosleep='guessing no (mishandles large arguments)' ;; + # Midipix generally emulates the Linux system calls, + # but here it handles large arguments correctly. + midipix*) + gl_cv_func_nanosleep='guessing yes' ;; # Guess no on native Windows. mingw* | windows*) gl_cv_func_nanosleep='guessing no' ;; diff --git a/m4/nstrftime.m4 b/m4/nstrftime.m4 index 67250dc9455..aa5d63a54b5 100644 --- a/m4/nstrftime.m4 +++ b/m4/nstrftime.m4 @@ -1,4 +1,4 @@ -# serial 37 +# serial 38 # Copyright (C) 1996-1997, 1999-2007, 2009-2024 Free Software Foundation, Inc. # @@ -16,7 +16,4 @@ AC_DEFUN([gl_FUNC_GNU_STRFTIME], AC_REQUIRE([AC_STRUCT_TIMEZONE]) AC_REQUIRE([gl_TM_GMTOFF]) - - AC_DEFINE([my_strftime], [nstrftime], - [Define to the name of the strftime replacement function.]) ]) diff --git a/m4/utimens.m4 b/m4/utimens.m4 index af03e6b52be..0f5bfd4c843 100644 --- a/m4/utimens.m4 +++ b/m4/utimens.m4 @@ -3,7 +3,7 @@ dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. -dnl serial 15 +dnl serial 16 AC_DEFUN([gl_UTIMENS], [ @@ -36,12 +36,13 @@ AC_DEFUN([gl_UTIMENS], [gl_cv_func_futimesat_works=yes], [gl_cv_func_futimesat_works=no], [case "$host_os" in - # Guess yes on Linux systems. - linux-* | linux) gl_cv_func_futimesat_works="guessing yes" ;; - # Guess yes on glibc systems. - *-gnu*) gl_cv_func_futimesat_works="guessing yes" ;; - # If we don't know, obey --enable-cross-guesses. - *) gl_cv_func_futimesat_works="$gl_cross_guess_normal" ;; + # Guess yes on Linux systems + # and on systems that emulate the Linux system calls. + linux* | midipix*) gl_cv_func_futimesat_works="guessing yes" ;; + # Guess yes on glibc systems. + *-gnu*) gl_cv_func_futimesat_works="guessing yes" ;; + # If we don't know, obey --enable-cross-guesses. + *) gl_cv_func_futimesat_works="$gl_cross_guess_normal" ;; esac ]) rm -f conftest.file]) diff --git a/m4/utimensat.m4 b/m4/utimensat.m4 index e595b333d17..4af7f6f81c8 100644 --- a/m4/utimensat.m4 +++ b/m4/utimensat.m4 @@ -1,4 +1,4 @@ -# serial 11 +# serial 12 # See if we need to provide utimensat replacement. dnl Copyright (C) 2009-2024 Free Software Foundation, Inc. @@ -83,6 +83,9 @@ AC_DEFUN([gl_FUNC_UTIMENSAT], # Guess yes on Linux or glibc systems. linux-* | linux | *-gnu* | gnu*) gl_cv_func_utimensat_works="guessing yes" ;; + # Guess yes on systems that emulate the Linux system calls. + midipix*) + gl_cv_func_utimensat_works="guessing yes" ;; # Guess 'nearly' on AIX. aix*) gl_cv_func_utimensat_works="guessing nearly" ;; -- cgit v1.2.3 From 783a511d1e31b5c9e5f9cb8ec27fd91d1b9078c9 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 15 Feb 2024 14:23:43 +0800 Subject: Handle /assets and /content file names in `android-browse-url' * lisp/net/browse-url.el (android-browse-url): New function. * lisp/term/android-win.el (android-browse-url-internal): Update function declaration. * src/androidselect.c (Fandroid_browse_url): Rename to... (Fandroid_browse_url_internal): ... this. (syms_of_androidselect): Adjust to match. --- lisp/net/browse-url.el | 2 +- lisp/term/android-win.el | 44 ++++++++++++++++++++++++++++++++++++++++++++ src/androidselect.c | 20 +++++++++++++------- 3 files changed, 58 insertions(+), 8 deletions(-) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index bc2a7db9a8b..ddc57724343 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1324,7 +1324,7 @@ and instant messengers instead of opening it in a web browser." :type 'boolean :version "30.1") -(declare-function android-browse-url "androidselect.c") +(declare-function android-browse-url "../term/android-win") ;;;###autoload (defun browse-url-default-android-browser (url &optional _new-window) diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index e0d252f17e0..b7b0920626e 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -479,6 +479,50 @@ the UTF-8 coding system." ;; Return the concatenation of both these values. (concat locale-base locale-modifier))) + +;; Miscellaneous functions. + +(declare-function android-browse-url-internal "androidselect.c") + +(defun android-browse-url (url &optional send) + "Open URL in an external application. + +URL should be a URL-encoded URL with a scheme specified unless +SEND is non-nil. Signal an error upon failure. + +If SEND is nil, start a program that is able to display the URL, +such as a web browser. Otherwise, try to share URL using +programs such as email clients. + +If URL is a file URI, convert it into a `content' address +accessible to other programs." + (when-let* ((uri (url-generic-parse-url url)) + (filename (url-filename uri)) + ;; If `uri' is a file URI and the file resides in /content + ;; or /assets, copy it to a temporary file before + ;; providing it to other programs. + (replacement-url (and (string-match-p + "/\\(content\\|assets\\)[/$]" + filename) + (prog1 t + (copy-file + filename + (setq filename + (make-temp-file + "local" + nil + (let ((extension + (file-name-extension + filename))) + (if extension + (concat "." + extension) + nil)))) + t)) + (concat "file://" filename)))) + (setq url replacement-url)) + (android-browse-url-internal url send)) + (provide 'android-win) ;; android-win.el ends here. diff --git a/src/androidselect.c b/src/androidselect.c index 5b23c559d2c..61f1c6045db 100644 --- a/src/androidselect.c +++ b/src/androidselect.c @@ -237,15 +237,21 @@ DEFUN ("android-clipboard-exists-p", Fandroid_clipboard_exists_p, return rc ? Qt : Qnil; } -DEFUN ("android-browse-url", Fandroid_browse_url, - Sandroid_browse_url, 1, 2, 0, - doc: /* Open URL in an external application. URL should be a -URL-encoded URL with a scheme specified unless SEND is non-nil. -Signal an error upon failure. +DEFUN ("android-browse-url-internal", Fandroid_browse_url_internal, + Sandroid_browse_url_internal, 1, 2, 0, + doc: /* Open URL in an external application. + +URL should be a URL-encoded URL with a scheme specified unless SEND is +non-nil. Signal an error upon failure. If SEND is nil, start a program that is able to display the URL, such as a web browser. Otherwise, try to share URL using programs such as -email clients. */) +email clients. + +If URL is a file URI, convert it into a `content' address accessible to +other programs. Files inside the /content or /assets directories cannot +be opened through such addresses, which this function does not provide +for. Use `android-browse-url' instead. */) (Lisp_Object url, Lisp_Object send) { Lisp_Object value; @@ -803,7 +809,7 @@ syms_of_androidselect (void) defsubr (&Sandroid_set_clipboard); defsubr (&Sandroid_get_clipboard); defsubr (&Sandroid_clipboard_exists_p); - defsubr (&Sandroid_browse_url); + defsubr (&Sandroid_browse_url_internal); defsubr (&Sandroid_get_clipboard_targets); defsubr (&Sandroid_get_clipboard_data); -- cgit v1.2.3 From 60cff1ac9d216e5abcb350ea5e623ab0b377c131 Mon Sep 17 00:00:00 2001 From: Simen Heggestøyl Date: Tue, 16 Jan 2024 08:21:41 +0100 Subject: Add support for reading/writing IELM input history (bug#67000) * lisp/ielm.el (inferior-emacs-lisp-mode): Add support for saving input history to a file. (ielm--history-file-name): New variable indicating IELM input history file. (ielm--exit): Holds a function to call when Emacs is killed to write out the input history. (ielm--input-history-writer): Helper function for writing the IELM input history out to file. * lisp/comint.el (comint-input-ring-file-name): Improve defcustom tag. --- etc/NEWS | 8 ++++++++ lisp/comint.el | 2 +- lisp/ielm.el | 29 +++++++++++++++++++++++++++++ 3 files changed, 38 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index dc24d775bb1..5220a7fb337 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1357,6 +1357,14 @@ characters, such as ½ (U+00BD VULGAR FRACTION ONE HALF), are also recognized as rational fractions. They have been since 2004, but it looks like it was never mentioned in the NEWS, or even the manual. +** IELM + +--- +*** IELM now remembers input history between sessions. +The new user option 'ielm-history-file-name' is the name of the file +where IELM input history will be saved. Customize it to nil to revert +to the old behavior of not remembering input history between sessions. + * New Modes and Packages in Emacs 30.1 diff --git a/lisp/comint.el b/lisp/comint.el index 0a9cdb44bef..655ff30469c 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -254,7 +254,7 @@ This variable is buffer-local." See also `comint-read-input-ring' and `comint-write-input-ring'. `comint-mode' makes this a buffer-local variable. You probably want to set this in a mode hook, rather than customize the default value." - :type '(choice (const :tag "nil" nil) + :type '(choice (const :tag "Disable input history" nil) file) :group 'comint) diff --git a/lisp/ielm.el b/lisp/ielm.el index 777aebb70cf..e583e0fe32c 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -110,6 +110,13 @@ This gives more frame width for large indented sexps, and allows functions such as `edebug-defun' to work with such inputs." :type 'boolean) +(defcustom ielm-history-file-name + (locate-user-emacs-file "ielm-history.eld") + "If non-nil, name of the file to read/write IELM input history." + :type '(choice (const :tag "Disable input history" nil) + file) + :version "30.1") + (defvaralias 'inferior-emacs-lisp-mode-hook 'ielm-mode-hook) (defcustom ielm-mode-hook nil "Hooks to be run when IELM (`inferior-emacs-lisp-mode') is started." @@ -503,6 +510,17 @@ behavior of the indirect buffer." (funcall pp-default-function beg end) end)) +;;; Input history + +(defvar ielm--exit nil + "Function to call when Emacs is killed.") + +(defun ielm--input-history-writer (buf) + "Return a function writing IELM input history to BUF." + (lambda () + (with-current-buffer buf + (comint-write-input-ring)))) + ;;; Major mode (define-derived-mode inferior-emacs-lisp-mode comint-mode "IELM" @@ -605,6 +623,17 @@ Customized bindings may be defined in `ielm-map', which currently contains: #'ielm-indirect-setup-hook 'append t) (setq comint-indirect-setup-function #'emacs-lisp-mode) + ;; Input history + (setq-local comint-input-ring-file-name ielm-history-file-name) + (setq-local ielm--exit (ielm--input-history-writer (current-buffer))) + (setq-local kill-buffer-hook + (lambda () + (funcall ielm--exit) + (remove-hook 'kill-emacs-hook ielm--exit))) + (unless noninteractive + (add-hook 'kill-emacs-hook ielm--exit)) + (comint-read-input-ring t) + ;; A dummy process to keep comint happy. It will never get any input (unless (comint-check-proc (current-buffer)) ;; Was cat, but on non-Unix platforms that might not exist, so -- cgit v1.2.3 From 3d6137116f6be8ee38f9f49c9811b97ef92e0e58 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 15 Feb 2024 12:04:07 +0200 Subject: Allow font-spec in 'face-font-rescale-alist' set at startup * lisp/startup.el (startup--rescale-elt-match-p): New function. (normal-top-level): Use it, instead of the naive 'string-match-p', to match the default font against the elements of 'face-font-rescale-alist'. Reported by Rahguzar . --- lisp/startup.el | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/lisp/startup.el b/lisp/startup.el index 773765a4b97..1c21b5de857 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -556,6 +556,17 @@ the updated value." (setq startup--original-eln-load-path (copy-sequence native-comp-eln-load-path)))) +(defun startup--rescale-elt-match-p (font-pattern font-object) + "Test whether FONT-OBJECT matches an element of `face-font-rescale-alist'. +FONT-OBJECT is a font-object that specifies a font to test. +FONT-PATTERN is the car of an element of `face-font-rescale-alist', +which can be either a regexp matching a font name or a font-spec." + (if (stringp font-pattern) + ;; FONT-PATTERN is a regexp, we need the name of FONT-OBJECT to match. + (string-match-p font-pattern (font-xlfd-name font-object)) + ;; FONT-PATTERN is a font-spec. + (font-match-p font-pattern font-object))) + (defvar android-fonts-enumerated nil "Whether or not fonts have been enumerated already. On Android, Emacs uses this variable internally at startup.") @@ -816,8 +827,9 @@ It is the default value of the variable `top-level'." (when (and (display-multi-font-p) (not (eq face-font-rescale-alist old-face-font-rescale-alist)) - (assoc (font-xlfd-name (face-attribute 'default :font)) - face-font-rescale-alist #'string-match-p)) + (assoc (face-attribute 'default :font) + face-font-rescale-alist + #'startup--rescale-elt-match-p)) (set-face-attribute 'default nil :font (font-spec))) ;; Modify the initial frame based on what .emacs puts into -- cgit v1.2.3 From e058380324e462c234bb3407d504807f22d825b0 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 15 Feb 2024 22:11:14 +0800 Subject: Fix the MS-DOS build * configure.ac (REQUIRE_GNUISH_STRFTIME_AM_PM): Move definition to... * src/conf_post.h (REQUIRE_GNUISH_STRFTIME_AM_PM): ...conf_post.h. --- configure.ac | 2 -- src/conf_post.h | 4 ++++ 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/configure.ac b/configure.ac index c162f880e48..847fdbd54d2 100644 --- a/configure.ac +++ b/configure.ac @@ -1566,8 +1566,6 @@ AC_DEFUN([gt_TYPE_WINT_T], AC_DEFUN_ONCE([gl_STDLIB_H], [AC_REQUIRE([gl_STDLIB_H_DEFAULTS]) gl_NEXT_HEADERS([stdlib.h])]) -AC_DEFINE([REQUIRE_GNUISH_STRFTIME_AM_PM], [false], - [Emacs does not need glibc strftime behavior for AM and PM indicators.]) # Initialize gnulib right after choosing the compiler. dnl Amongst other things, this sets AR and ARFLAGS. diff --git a/src/conf_post.h b/src/conf_post.h index 83a0dd1b09b..f2353803074 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -471,3 +471,7 @@ extern int emacs_setenv_TZ (char const *); #undef MB_CUR_MAX #define MB_CUR_MAX REPLACEMENT_MB_CUR_MAX #endif /* REPLACEMENT_MB_CUR_MAX */ + +/* Emacs does not need glibc strftime behavior for AM and PM + indicators. */ +#define REQUIRE_GNUISH_STRFTIME_AM_PM false -- cgit v1.2.3 From 8a63e50036f0d4284f21660efb5dd20b63748d1b Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 15 Feb 2024 16:08:00 +0100 Subject: * Define 'cl--type-hierarchy' and compute 'cl--typeof-types' from it * lisp/emacs-lisp/cl-preloaded.el (cl--type-hierarchy) (cl--direct-supertypes-of-type, cl--direct-subtypes-of-type): Define. (cl--typeof-types): Compute automatically. (cl--supertypes-for-typeof-types): New function. --- lisp/emacs-lisp/cl-preloaded.el | 97 +++++++++++++++++++++++++++-------------- 1 file changed, 64 insertions(+), 33 deletions(-) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 20e68555578..248c1fd7c24 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -50,44 +50,75 @@ (apply #'error string (append sargs args)) (signal 'cl-assertion-failed `(,form ,@sargs))))) -(defconst cl--typeof-types - ;; Hand made from the source code of `type-of'. - '((integer number integer-or-marker number-or-marker atom) - (symbol-with-pos symbol atom) (symbol atom) (string array sequence atom) - (cons list sequence) - ;; Markers aren't `numberp', yet they are accepted wherever integers are - ;; accepted, pretty much. - (marker integer-or-marker number-or-marker atom) - (overlay atom) (float number number-or-marker atom) - (window-configuration atom) (process atom) (window atom) - ;; FIXME: We'd want to put `function' here, but that's only true - ;; for those `subr's which aren't special forms! - (subr atom) - ;; FIXME: We should probably reverse the order between - ;; `compiled-function' and `byte-code-function' since arguably - ;; `subr' is also "compiled functions" but not "byte code functions", - ;; but it would require changing the value returned by `type-of' for - ;; byte code objects, which risks breaking existing code, which doesn't - ;; seem worth the trouble. - (compiled-function byte-code-function function atom) - (module-function function atom) - (buffer atom) (char-table array sequence atom) - (bool-vector array sequence atom) - (frame atom) (hash-table atom) (terminal atom) - (thread atom) (mutex atom) (condvar atom) - (font-spec atom) (font-entity atom) (font-object atom) - (vector array sequence atom) - (user-ptr atom) - (tree-sitter-parser atom) - (tree-sitter-node atom) - (tree-sitter-compiled-query atom) - ;; Plus, really hand made: - (null symbol list sequence atom)) + +(defconst cl--type-hierarchy + ;; Please run `sycdoc-update-type-hierarchy' in + ;; etc/syncdoc-type-hierarchy.el each time this is updated to + ;; reflect in the documentation. + '((t sequence atom) + (sequence list array) + (atom + class structure tree-sitter-compiled-query tree-sitter-node + tree-sitter-parser user-ptr font-object font-entity font-spec + condvar mutex thread terminal hash-table frame buffer function + window process window-configuration overlay integer-or-marker + number-or-marker symbol array) + (number float integer) + (number-or-marker marker number) + (integer bignum fixum) + (symbol keyword boolean symbol-with-pos) + (array vector bool-vector char-table string) + (list null cons) + (integer-or-marker integer marker) + (compiled-function byte-code-function) + (function subr module-function compiled-function) + (boolean null) + (subr subr-native-elisp subr-primitive) + (symbol-with-pos keyword)) + "List of lists describing all the edges of the builtin type +hierarchy. +Each sublist is in the form (TYPE . DIRECT_SUBTYPES)" + ;; Given type hierarchy is a DAG (but mostly a tree) I believe this + ;; is the most compact way to express it. + ) + +(defconst cl--direct-supertypes-of-type + (make-hash-table :test #'eq) + "Hash table TYPE -> SUPERTYPES.") + +(defconst cl--direct-subtypes-of-type + (make-hash-table :test #'eq) + "Hash table TYPE -> SUBTYPES.") + +(cl-loop for (parent . children) in cl--type-hierarchy + do (cl-loop + for child in children + do (cl-pushnew parent (gethash child cl--direct-supertypes-of-type)) + do (cl-pushnew child (gethash parent cl--direct-subtypes-of-type)))) + +(defconst cl--typeof-types nil "Alist of supertypes. Each element has the form (TYPE . SUPERTYPES) where TYPE is one of the symbols returned by `type-of', and SUPERTYPES is the list of its supertypes from the most specific to least specific.") +(defun cl--supertypes-for-typeof-types (type) + (cl-loop with res = () + with agenda = (list type) + while agenda + for element = (car agenda) + unless (or (eq element t) ;; no t in `cl--typeof-types'. + (memq element res)) + append (list element) into res + do (cl-loop for c in (gethash element cl--direct-supertypes-of-type) + do (setq agenda (append agenda (list c)))) + do (setq agenda (cdr agenda)) + finally (cl-return res))) + +(maphash (lambda (type _) + (push (cl--supertypes-for-typeof-types type) cl--typeof-types)) + cl--direct-supertypes-of-type) + (defconst cl--all-builtin-types (delete-dups (copy-sequence (apply #'append cl--typeof-types)))) -- cgit v1.2.3 From 3211825fe7cab2c330d703a9e77090d551854d53 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 15 Feb 2024 16:09:07 +0100 Subject: Generate automatically graphical and textual type hierarchy representation * etc/syncdoc-type-hierarchy.el: New file. * doc/lispref/type_hierarchy.txt: Likewise. * doc/lispref/type_hierarchy.jpg: Likewise. --- doc/lispref/type_hierarchy.jpg | Bin 0 -> 217746 bytes doc/lispref/type_hierarchy.txt | 147 +++++++++++++++++++++++++++++++++++++++++ etc/syncdoc-type-hierarchy.el | 72 ++++++++++++++++++++ 3 files changed, 219 insertions(+) create mode 100644 doc/lispref/type_hierarchy.jpg create mode 100644 doc/lispref/type_hierarchy.txt create mode 100644 etc/syncdoc-type-hierarchy.el diff --git a/doc/lispref/type_hierarchy.jpg b/doc/lispref/type_hierarchy.jpg new file mode 100644 index 00000000000..0b551b5f01e Binary files /dev/null and b/doc/lispref/type_hierarchy.jpg differ diff --git a/doc/lispref/type_hierarchy.txt b/doc/lispref/type_hierarchy.txt new file mode 100644 index 00000000000..c6e762b04a8 --- /dev/null +++ b/doc/lispref/type_hierarchy.txt @@ -0,0 +1,147 @@ + +--------------------+ + | bignum | + +--------------------+ + | + | + v + +-------------+ +--------------------+ +----------------------+ +--------+ + | fixum | --> | integer | --> | integer-or-marker | <-- | marker | + +-------------+ +--------------------+ +----------------------+ +--------+ + | | | + | | | + v | | + +-------------+ +--------------------+ | | + | float | --> | number | | | + +-------------+ +--------------------+ | | + | | | + | | | + v | | + +--------------------+ | | +------------------+ +--------------------+ +----------+ +--------+ + | number-or-marker | <-----+----------------------------+ | tree-sitter-node | | tree-sitter-parser | | user-ptr | | window | + +--------------------+ | +------------------+ +--------------------+ +----------+ +--------+ + | | | | | | + | | | | | | + v v v v v v + +-------------+ +-------------------------------------------------------------------------------------------------------------------------------------------------------------------+ +----------------------------+ + | font-entity | --> | | <-- | overlay | + +-------------+ | | +----------------------------+ + +-------------+ | | +----------------------------+ + | font-object | --> | | <-- | process | + +-------------+ | | +----------------------------+ + +-------------+ | | +----------------------------+ + | font-spec | --> | | <-- | structure | + +-------------+ | atom | +----------------------------+ + +-------------+ | | +----------------------------+ + | frame | --> | | <-- | terminal | + +-------------+ | | +----------------------------+ + +-------------+ | | +----------------------------+ + | hash-table | --> | | <-- | thread | + +-------------+ | | +----------------------------+ + +-------------+ | | +----------------------------+ + | mutex | --> | | <-- | tree-sitter-compiled-query | + +-------------+ +-------------------------------------------------------------------------------------------------------------------------------------------------------------------+ +----------------------------+ + | ^ ^ ^ ^ ^ ^ ^ + | | | | | | | | + v | | | | | | | + +--------------------+ | +----------------------+ | | +--------+ +-------+ +---------+ + +--------------------> | t | | | window-configuration | | | | buffer | | class | | condvar | + | +--------------------+ | +----------------------+ | | +--------+ +-------+ +---------+ + | +--------------------+ | | | + | | byte-code-function | | | | + | +--------------------+ | | | + | | | | | + | | | | | + | v | | | + | +--------------------+ | | | + | | compiled-function | | | | + | +--------------------+ | | | + | | | | | + | | | | | + | v | | | + | +--------------------+ | | | + | +> | function | -+ | | + | | +--------------------+ | | + | | ^ | | + | | +--------------------------------------------------+--------------+------------------------+ + | | | | | + | | +--------------------+ | | | + | | | subr-primitive | | | | + | | +--------------------+ | | | + | | | | | | + | | | | | | + | | v | | | + | | +--------------------+ | | | + | +- | subr | <-----------------------------+----+ | | + | +--------------------+ | | | | + | +--------------------+ | | | | + | | keyword | -+ | | | | + | +--------------------+ | | | | | + | | | | | | | + | | | | | | | + | v | | | | | + | +--------------------+ | | | | | + | | symbol-with-pos | | | | | | + | +--------------------+ | | | | | + | | | | | | | + | | +----+ | | | | + | v | | | | | + | +--------------------+ | | | | | + | +> | symbol | ------+-----------------------+ | | | + | | +--------------------+ | | | | + | | ^ | | | | + | | +--------------------------+ | | | + | | | | | + | | +--------------------+ | | | + | | | null | -+ | | | + | | +--------------------+ | | | | + | | | | | | | + | | | | | | | + | | v | | | | + | | +--------------------+ | | | | + | +- | boolean | | | | | + | +--------------------+ | | | | + | +--------------------+ | | | | + | | cons | | | | | + | +--------------------+ | | | | + | | | | | | + | | | | | | + | v | | | | + | +--------------------+ | | | | + | | list | <+ | | | + | +--------------------+ | | | + | | | | | + | | | | | + | v | | | + | +--------------------+ | | | + +--------------------- | sequence | | | | + +--------------------+ | | | + ^ | | | + +------------------------+ | | | + | | | | + | +--------------------+ | | | + | | subr-native-elisp | -----------------------------------+ | | + | +--------------------+ | | + | | | + | +-------------------------------------------+ | + | | | + | +--------------------+ | | + | | bool-vector | | | + | +--------------------+ | | + | | | | + | | | | + | v | | + | +-------------+ +-------------------------------------------------+ | + | | string | --> | array | | + | +-------------+ +-------------------------------------------------+ | + | ^ | ^ | + | | | | | + | | | | | + | +--------------------+ | +----------------------+ | + | | vector | | | char-table | | + | +--------------------+ | +----------------------+ | + | | | + +----------------------------------------------+ | + | + +--------------------+ | + | module-function | ----------------------------------------------------------------------+ + +--------------------+ diff --git a/etc/syncdoc-type-hierarchy.el b/etc/syncdoc-type-hierarchy.el new file mode 100644 index 00000000000..eebb092abae --- /dev/null +++ b/etc/syncdoc-type-hierarchy.el @@ -0,0 +1,72 @@ +;;; syncdoc-type-hierarchy.el--- -*- lexical-binding: t -*- + +;; Copyright (C) 2023-2024 Free Software Foundation, Inc. + +;; Author: Andrea Corallo +;; Keywords: documentation + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This file is used to keep the type hierarchy representation present +;; in the elisp manual in sync with the current type hierarchy. This +;; is specified in `cl--type-hierarchy' in cl-preloaded.el, so each +;; time `cl--type-hierarchy' is modified +;; `syncdoc-update-type-hierarchy' must be run before the +;; documentation is regenerated. + +;; We do not call this directly from make docs in order not to add a +;; dependency on the tools "dot" and "graph-easy". + +;;; Code: + +(require 'cl-lib) + +(eval-and-compile + (defconst syncdoc-lispref-dir (concat (file-name-directory + (or load-file-name + buffer-file-name)) + "../doc/lispref/"))) + +(defun syncdoc-insert-dot-content (rankdir) + (maphash (lambda (child parents) + (cl-loop for parent in parents + do (insert " \"" (symbol-name child) "\" -> \"" + (symbol-name parent) "\";\n"))) + cl--direct-supertypes-of-type) + (sort-lines nil (point-min) (point-max)) + + (goto-char (point-min)) + (insert "digraph {\n rankdir=\"" rankdir "\";\n") + (goto-char (point-max)) + (insert "}\n")) + +(defun syncdoc-update-type-hierarchy () + "Update the type hierarchy representation used by the elisp manual." + (interactive) + (with-temp-buffer + (syncdoc-insert-dot-content "LR") + (call-process-region nil nil "dot" t (current-buffer) nil "-Tjpg" "-o" + (expand-file-name "type_hierarchy.jpg" + syncdoc-lispref-dir))) + (with-temp-buffer + (syncdoc-insert-dot-content "TB") + (call-process-region nil nil "graph-easy" t (current-buffer) nil "--output" + (expand-file-name "type_hierarchy.txt" + syncdoc-lispref-dir)))) + +;;; syncdoc-type-hierarchy.el ends here -- cgit v1.2.3 From 74f060230f70ba986a1c78e4e0d1181492567597 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 15 Feb 2024 16:10:59 +0100 Subject: * Add initial "Type Hierarchy" node to the elisp manual * doc/lispref/objects.texi (Lisp Data Types, Type Hierarchy): Add Type Hierarchy node. --- doc/lispref/objects.texi | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index b8fd5ed4345..18484bac368 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -60,6 +60,7 @@ to use these types can be found in later chapters. * Type Predicates:: Tests related to types. * Equality Predicates:: Tests of equality between any two objects. * Mutability:: Some objects should not be modified. +* Type Hierarchy:: Type Hierarchy. @end menu @node Printed Representation @@ -2493,3 +2494,23 @@ their components. For example, @code{(eq "abc" "abc")} returns literal @code{"abc"}, and returns @code{nil} if it creates two instances. Lisp programs should be written so that they work regardless of whether this optimization is in use. + +@node Type Hierarchy + +Lisp types are organized in a hierarchy, this means that types can +derive from other types. Objects of a type A (which derives from type +B) inherite all the charateristics of type B. This also means that +every objects of type A is at the same time of type B. + +Every type derives from type @code{t}. + +New types can be defined by the user through @code{defclass} or +@code{cl-defstruct}. + +The Lisp Type Hierarchy for primitive types can be represented as +follow: + +@image{type_hierarchy,,,,png} + +For example type @code{list} derives from (is a special kind of) type +@code{sequence} wich on itself derives from @code{t}. -- cgit v1.2.3 From aa849984896ce393afe92dd4fb7fbce494e131a4 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 15 Feb 2024 16:13:16 +0100 Subject: * make use of 'cl--direct-supertypes-of-type' in the native-compiler * lisp/emacs-lisp/comp-cstr.el (comp--direct-supertypes): Use cl--direct-supertypes-of-type. --- lisp/emacs-lisp/comp-cstr.el | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 2984bedb1dd..0a8b3b7efb2 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -270,18 +270,19 @@ Return them as multiple value." (symbol-name y))) (defun comp--direct-supertypes (type) - "Return the direct supertypes of TYPE." - (let ((supers (comp-supertypes type))) - (cl-assert (eq type (car supers))) - (cl-loop - with notdirect = nil - with direct = nil - for parent in (cdr supers) - unless (memq parent notdirect) - do (progn - (push parent direct) - (setq notdirect (append notdirect (comp-supertypes parent)))) - finally return direct))) + (or + (gethash type cl--direct-supertypes-of-type) + (let ((supers (comp-supertypes type))) + (cl-assert (eq type (car supers))) + (cl-loop + with notdirect = nil + with direct = nil + for parent in (cdr supers) + unless (memq parent notdirect) + do (progn + (push parent direct) + (setq notdirect (append notdirect (comp-supertypes parent)))) + finally return direct)))) (defsubst comp-subtype-p (type1 type2) "Return t if TYPE1 is a subtype of TYPE2 or nil otherwise." -- cgit v1.2.3 From 4a0d430bdc3650ca3dfd8bdd14781764fbcbdc7e Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 15 Feb 2024 17:48:43 +0100 Subject: Update some native comp tests * test/src/comp-tests.el (comp-tests-ret-type-spec-13) (comp-tests-ret-type-spec-35): Update. * test/lisp/emacs-lisp/comp-cstr-tests.el (comp-cstr-test-62) (comp-cstr-test-75): Likewise. --- test/lisp/emacs-lisp/comp-cstr-tests.el | 4 ++-- test/src/comp-tests.el | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el b/test/lisp/emacs-lisp/comp-cstr-tests.el index edc70b12d4b..c3a7092819d 100644 --- a/test/lisp/emacs-lisp/comp-cstr-tests.el +++ b/test/lisp/emacs-lisp/comp-cstr-tests.el @@ -170,7 +170,7 @@ The arg is an alist of: type specifier -> expected type specifier." ;; 61 ((and atom (not symbol)) . atom) ;; 62 - ((and atom (not string)) . (or array sequence atom)) + ((and atom (not string)) . (or array atom)) ;; 63 Conservative ((and symbol (not (member foo))) . symbol) ;; 64 Conservative @@ -196,7 +196,7 @@ The arg is an alist of: type specifier -> expected type specifier." ;; 74 ((and boolean (or number marker)) . nil) ;; 75 - ((and atom (or number marker)) . number-or-marker) + ((and atom (or number marker)) . (or integer-or-marker number-or-marker)) ;; 76 ((and symbol (or number marker)) . nil) ;; 77 diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 54a9a6c11cc..8bfe939fb23 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -1022,7 +1022,7 @@ Return a list of results." (if (= x y) x 'foo)) - '(or (member foo) number-or-marker)) + '(or (member foo) number-or-marker integer-or-marker)) ;; 14 ((defun comp-tests-ret-type-spec-f (x) @@ -1162,7 +1162,7 @@ Return a list of results." ((defun comp-tests-ret-type-spec-f (x) (when (> x 1.0) x)) - '(or null number-or-marker)) + '(or null number-or-marker integer-or-marker)) ;; 36 ((defun comp-tests-ret-type-spec-f (x y) -- cgit v1.2.3 From 80dce18a393a3267b72901328bf24e518d0a6fc9 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 15 Feb 2024 19:10:35 +0100 Subject: * lisp/emacs-lisp/cl-preloaded.el (cl--direct-subtypes-of-type): Remove. --- lisp/emacs-lisp/cl-preloaded.el | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 248c1fd7c24..323d826f323 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -86,15 +86,11 @@ Each sublist is in the form (TYPE . DIRECT_SUBTYPES)" (make-hash-table :test #'eq) "Hash table TYPE -> SUPERTYPES.") -(defconst cl--direct-subtypes-of-type - (make-hash-table :test #'eq) - "Hash table TYPE -> SUBTYPES.") - -(cl-loop for (parent . children) in cl--type-hierarchy - do (cl-loop - for child in children - do (cl-pushnew parent (gethash child cl--direct-supertypes-of-type)) - do (cl-pushnew child (gethash parent cl--direct-subtypes-of-type)))) +(cl-loop + for (parent . children) in cl--type-hierarchy + do (cl-loop + for child in children + do (cl-pushnew parent (gethash child cl--direct-supertypes-of-type)))) (defconst cl--typeof-types nil "Alist of supertypes. -- cgit v1.2.3 From 7b34bb5c928798e0d40fce062c1b6d4b2ce06979 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 15 Feb 2024 19:36:05 +0200 Subject: project-or-external-find-regexp: Fix the docstring * lisp/progmodes/project.el (project-or-external-find-regexp): Fix the docstring (bug#68958). --- lisp/progmodes/project.el | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 983c0ed2ac2..aa92a73336e 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -992,9 +992,7 @@ requires quoting, e.g. `\\[quoted-insert]'." ;;;###autoload (defun project-or-external-find-regexp (regexp) - "Find all matches for REGEXP in the project roots or external roots. -With \\[universal-argument] prefix, you can specify the file name -pattern to search for." + "Find all matches for REGEXP in the project roots or external roots." (interactive (list (project--read-regexp))) (require 'xref) (let* ((pr (project-current t)) -- cgit v1.2.3 From 4dbc3bbcc568182380d4646310a652285e210876 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 15 Feb 2024 19:17:07 +0100 Subject: ; * lisp/emacs-lisp/comp.el (comp--write-bytecode-file): Add comment. --- lisp/emacs-lisp/comp.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 6879e6aeeb9..593291a379e 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3495,6 +3495,7 @@ last directory in `native-comp-eln-load-path')." else collect (byte-compile-file file)))) +;; In use by elisp-mode.el (defun comp--write-bytecode-file (eln-file) "After native compilation write the bytecode file for ELN-FILE. Make sure that eln file is younger than byte-compiled one and -- cgit v1.2.3 From cea72c1757cc45b42baf3a35fb4d963f3e722b9c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 15 Feb 2024 15:09:13 -0500 Subject: (tex-font-lock-keywords-1): Fix bug#68827 * lisp/textmodes/tex-mode.el (tex-font-lock-keywords-1): Don't apply `tex-verbatim` in comments. --- lisp/textmodes/tex-mode.el | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 8968d8ec23b..5c5ca573f38 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -514,14 +514,19 @@ An alternative value is \" . \", if you use a font with a narrow period." (inbraces-re (lambda (re) (concat "\\(?:[^{}\\]\\|\\\\.\\|" re "\\)"))) (arg (concat "{\\(" (funcall inbraces-re "{[^}]*}") "+\\)"))) - `( ;; Highlight $$math$$ and $math$. + `(;; Verbatim-like args. + ;; Do it first, because we don't want to highlight them + ;; in comments (bug#68827), but we do want to highlight them + ;; in $math$. + (,(concat slash verbish opt arg) 3 'tex-verbatim keep) + ;; Highlight $$math$$ and $math$. ;; This is done at the very beginning so as to interact with the other ;; keywords in the same way as comments and strings. (,(concat "\\$\\$?\\(?:[^$\\{}]\\|\\\\.\\|{" (funcall inbraces-re (concat "{" (funcall inbraces-re "{[^}]*}") "*}")) "*}\\)+\\$?\\$") - (0 'tex-math)) + (0 'tex-math keep)) ;; Heading args. (,(concat slash headings "\\*?" opt arg) ;; If ARG ends up matching too much (if the {} don't match, e.g.) @@ -543,8 +548,6 @@ An alternative value is \" . \", if you use a font with a narrow period." (,(concat slash variables " *" arg) 2 font-lock-variable-name-face) ;; Include args. (,(concat slash includes opt arg) 3 font-lock-builtin-face) - ;; Verbatim-like args. - (,(concat slash verbish opt arg) 3 'tex-verbatim t) ;; Definitions. I think. ("^[ \t]*\\\\def *\\\\\\(\\(\\w\\|@\\)+\\)" 1 font-lock-function-name-face)))) -- cgit v1.2.3 From 45f9af61b8ecbe500de915f63de53e9c598184b9 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Mon, 8 Jan 2024 19:38:33 +0100 Subject: Remove references to phst@google.com. I don't work for Google any more, so I'll use my private address going forward. * .mailmap: Remove references to phst@google.com. --- .mailmap | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.mailmap b/.mailmap index 8454eb9154c..5e733728b5a 100644 --- a/.mailmap +++ b/.mailmap @@ -143,8 +143,7 @@ Philip Kaludercic Philip Kaludercic Philip Kaludercic Philip Kaludercic -Philipp Stephani -Philipp Stephani Philipp Stephani +Philipp Stephani Phillip Lord Pierre Lorenzon Pieter van Oostrum -- cgit v1.2.3 From 572d58b5e8d0f1f1244b9ccab8f02c4f50ca8d12 Mon Sep 17 00:00:00 2001 From: Tomas Volf <~@wolfsden.cz> Date: Thu, 15 Feb 2024 18:23:23 -0800 Subject: When deleting output in Eshell, optionally add it to the kill ring. * lisp/eshell/esh-mode.el (eshell-kill-output): Rename to... (eshell-delete-output): ... this, for consistency with 'comint-mode', and accept KILL argument. Update callers. Copyright-paperwork-exempt: yes --- lisp/eshell/esh-mode.el | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index fd279f61673..b15f99a0359 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -290,7 +290,7 @@ non-interactive sessions, such as when using `eshell-command'.") "C-e" #'eshell-show-maximum-output "C-f" #'eshell-forward-argument "C-m" #'eshell-copy-old-input - "C-o" #'eshell-kill-output + "C-o" #'eshell-delete-output "C-r" #'eshell-show-output "C-t" #'eshell-truncate-buffer "C-u" #'eshell-kill-input @@ -832,15 +832,23 @@ This function should be in the list `eshell-output-filter-functions'." eshell-last-output-start eshell-last-output-end)) -(defun eshell-kill-output () - "Kill all output from interpreter since last input. -Does not delete the prompt." - (interactive) +(defun eshell-delete-output (&optional kill) + "Delete all output from interpreter since last input. +If KILL is non-nil (interactively, the prefix), save the killed text in +the kill ring. + +This command does not delete the prompt." + (interactive "P") (save-excursion (goto-char (eshell-beginning-of-output)) (insert "*** output flushed ***\n") + (when kill + (copy-region-as-kill (point) (eshell-end-of-output))) (delete-region (point) (eshell-end-of-output)))) +(define-obsolete-function-alias 'eshell-kill-output + #'eshell-delete-output "30.1") + (defun eshell-show-output (&optional arg) "Display start of this batch of interpreter output at top of window. Sets mark to the value of point when this command is run. -- cgit v1.2.3 From 44a1721156ec29e5799da94f7918f217f52fd751 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 16 Feb 2024 09:04:46 -0500 Subject: * lisp/loadup.el (lexical-binding): Add a comment --- lisp/loadup.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/loadup.el b/lisp/loadup.el index c498c0e53af..c6a8dcbb909 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -635,6 +635,8 @@ directory got moved. This is set to be a pair in the form of: (unwind-protect (let ((tmp-dump-mode dump-mode) (dump-mode nil) + ;; Set `lexical-binding' to nil by default + ;; in the dumped Emacs. (lexical-binding nil)) (if (member tmp-dump-mode '("pdump" "pbootstrap")) (dump-emacs-portable (expand-file-name output invocation-directory)) -- cgit v1.2.3 From 4b89fb08bdd7d0249698bc0ed578555d6755724d Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 16 Feb 2024 22:17:01 +0800 Subject: * src/androidvfs.c (android_scan_directory_tree): Get rid of xstrdup. --- src/androidvfs.c | 24 +++++++++++------------- 1 file changed, 11 insertions(+), 13 deletions(-) diff --git a/src/androidvfs.c b/src/androidvfs.c index 78f6b6da6a8..3030bd56cdc 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -1018,8 +1018,8 @@ android_extract_long (char *pointer) static const char * android_scan_directory_tree (char *file, size_t *limit_return) { - char *token, *saveptr, *copy, *copy1, *start, *max, *limit; - size_t token_length, ntokens, i; + char *token, *saveptr, *copy, *start, *max, *limit; + size_t token_length, ntokens, i, len; char *tokens[10]; USE_SAFE_ALLOCA; @@ -1031,11 +1031,14 @@ android_scan_directory_tree (char *file, size_t *limit_return) limit = (char *) directory_tree + directory_tree_size; /* Now, split `file' into tokens, with the delimiter being the file - name separator. Look for the file and seek past it. */ + name separator. Look for the file and seek past it. Create a copy + of FILE for the enjoyment of `strtok_r'. */ ntokens = 0; saveptr = NULL; - copy = copy1 = xstrdup (file); + len = strlen (file) + 1; + copy = SAFE_ALLOCA (len); + memcpy (copy, file, len); memset (tokens, 0, sizeof tokens); while ((token = strtok_r (copy, "/", &saveptr))) @@ -1044,19 +1047,14 @@ android_scan_directory_tree (char *file, size_t *limit_return) /* Make sure ntokens is within bounds. */ if (ntokens == ARRAYELTS (tokens)) - { - xfree (copy1); - goto fail; - } + goto fail; - tokens[ntokens] = SAFE_ALLOCA (strlen (token) + 1); - memcpy (tokens[ntokens], token, strlen (token) + 1); + len = strlen (token) + 1; + tokens[ntokens] = SAFE_ALLOCA (len); + memcpy (tokens[ntokens], token, len); ntokens++; } - /* Free the copy created for strtok_r. */ - xfree (copy1); - /* If there are no tokens, just return the start of the directory tree. */ -- cgit v1.2.3 From 5b65c2ad7526ec081ac37d32c87e9b58e787d66a Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 17 Feb 2024 10:27:26 +0800 Subject: Properly record mtime after insert-file-contents on Android * src/fileio.c (write_region): Do not verify file identity after retreiving file status for the second time if st_ino is 0. --- src/fileio.c | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/src/fileio.c b/src/fileio.c index a92da93ae48..483498fd879 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5628,7 +5628,15 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, changed to a call to `stat'. */ if (emacs_fstatat (AT_FDCWD, fn, &st1, 0) == 0 - && st.st_dev == st1.st_dev && st.st_ino == st1.st_ino) + && st.st_dev == st1.st_dev + && (st.st_ino == st1.st_ino +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY + /* `st1.st_ino' == 0 indicates that the inode number + cannot be extracted from this document file, despite + `st' potentially being backed by a real file. */ + || st1.st_ino == 0 +#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ + )) { /* Use the heuristic if it appears to be valid. With neither O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the -- cgit v1.2.3 From 537914561eb3809e34b9daf8c2b4719ae9b30a6b Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 17 Feb 2024 10:33:54 +0800 Subject: * java/debug.sh: Print errors correctly if device is ambiguous. --- java/debug.sh | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/java/debug.sh b/java/debug.sh index 8fc03d014cf..c5d40141355 100755 --- a/java/debug.sh +++ b/java/debug.sh @@ -104,13 +104,14 @@ if [ -z "$devices" ]; then exit 1 fi -if [ -z $device ]; then - device=$devices +if [ `wc -w <<< "$devices"` -gt 1 ] && [ -z $device ]; then + echo "Multiple devices are available. Please specify one with" + echo "the option --device and try again." + exit 1 fi -if [ `wc -w <<< "$devices"` -gt 1 ] && [ -z device ]; then - echo "Multiple devices are available. Please pick one using" - echo "--device and try again." +if [ -z $device ]; then + device=$devices fi echo "Looking for $package on device $device" @@ -189,6 +190,8 @@ if [ "$attach_existing" != "yes" ]; then package_pids=`awk -f tmp.awk <<< $package_pids` fi +rm tmp.awk + pid=$package_pids num_pids=`wc -w <<< "$package_pids"` -- cgit v1.2.3 From e288e1b2f352952e826727967a406c8675fd5594 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 15 Feb 2024 20:17:20 -0800 Subject: Remove "erc-" prefixed Compat definitions * lisp/erc/erc-compat.el: Remove NO-ERROR argument from top-level `require' for library `compat' because it's guaranteed to be present. (erc-compat-function, erc-compat-call): Redefine as obsolete aliases for unprefixed namesakes. * lisp/erc/erc-fill.el (erc-fill-wrap-nudge): Use `compat-call' instead of `erc-compat-call'. --- lisp/erc/erc-compat.el | 46 +++------------------------------------------- lisp/erc/erc-fill.el | 2 +- 2 files changed, 4 insertions(+), 44 deletions(-) diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 9b8699f6949..b5b8fbaf8ab 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -31,51 +31,11 @@ ;;; Code: -(require 'compat nil 'noerror) +(require 'compat) (eval-when-compile (require 'cl-lib)) -;; Except for the "erc-" namespacing, these two definitions should be -;; continuously updated to match the latest upstream ones verbatim. -;; Although they're pretty simple, it's likely not worth checking for -;; and possibly deferring to the non-prefixed versions. -;; -;; BEGIN Compat macros - -;;;; Macros for extended compatibility function calls - -(defmacro erc-compat-function (fun) - "Return compatibility function symbol for FUN. - -If the Emacs version provides a sufficiently recent version of -FUN, the symbol FUN is returned itself. Otherwise the macro -returns the symbol of a compatibility function which supports the -behavior and calling convention of the current stable Emacs -version. For example Compat 29.1 will provide compatibility -functions which implement the behavior and calling convention of -Emacs 29.1. - -See also `compat-call' to directly call compatibility functions." - (let ((compat (intern (format "compat--%s" fun)))) - `#',(if (fboundp compat) compat fun))) - -(defmacro erc-compat-call (fun &rest args) - "Call compatibility function or macro FUN with ARGS. - -A good example function is `plist-get' which was extended with an -additional predicate argument in Emacs 29.1. The compatibility -function, which supports this additional argument, can be -obtained via (compat-function plist-get) and called -via (compat-call plist-get plist prop predicate). It is not -possible to directly call (plist-get plist prop predicate) on -Emacs older than 29.1, since the original `plist-get' function -does not yet support the predicate argument. Note that the -Compat library never overrides existing functions. - -See also `compat-function' to lookup compatibility functions." - (let ((compat (intern (format "compat--%s" fun)))) - `(,(if (fboundp compat) compat fun) ,@args))) - -;; END Compat macros +(define-obsolete-function-alias 'erc-compat-function #'compat-function "30.1") +(define-obsolete-function-alias 'erc-compat-call #'compat-call "30.1") ;;;###autoload(autoload 'erc-define-minor-mode "erc-compat") (define-obsolete-function-alias 'erc-define-minor-mode diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index b91ce007087..547b3a11043 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -832,7 +832,7 @@ decorations applied by third-party modules." (line (count-screen-lines (window-start) (window-point)))) (when (zerop arg) (setq arg 1)) - (erc-compat-call + (compat-call set-transient-map (let ((map (make-sparse-keymap))) (dolist (key '(?= ?- ?0)) -- cgit v1.2.3 From a43b062ee57fd9b7c410e741946e51281db5b92a Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 8 Feb 2024 19:19:53 -0800 Subject: ; Load erc-compat before ert-x in ERC tests Avoid eager macro-expansion error in tests files on Emacs 27 and 28 by ensuring definitions provided by Compat, like `macroexp-file-name', load first. * lisp/erc/erc-speedbar.el (erc-speedbar--reset-last-ran-on-timer): Suppress "`buffer-local-value' is an obsolete generalized variable" warning on Emacs 29 and below. * lisp/erc/erc-stamp.el (erc-stamp--time-as-day): Avoid "unused lexical variable `current-time-list'" warning on 28 and below. * lisp/erc/erc.el (erc-check-text-conversion): Add `defvar' for `text-conversion-style' to avoid "reference to free variable" warning on Emacs 29 and below. * test/lisp/erc/erc-button-tests.el: Load `erc-button' before `ert-x'. * test/lisp/erc/erc-fill-tests.el: Load `erc-fill' before `ert-x'. * test/lisp/erc/erc-goodies-tests.el: Load `erc-goodies' before `ert-x'. * test/lisp/erc/erc-networks-tests.el: Explicitly load `erc-compat' before anything else. * test/lisp/erc/erc-scenarios-base-renick.el: Update timeouts. * test/lisp/erc/erc-stamp-tests.el: Load `erc-stamp' before `ert-x'. * test/lisp/erc/erc-tests.el: Load `erc-ring' before `ert-x'. --- lisp/erc/erc-speedbar.el | 5 +++-- lisp/erc/erc-stamp.el | 1 + lisp/erc/erc.el | 1 + test/lisp/erc/erc-button-tests.el | 3 +-- test/lisp/erc/erc-fill-tests.el | 4 ++-- test/lisp/erc/erc-goodies-tests.el | 4 ++-- test/lisp/erc/erc-networks-tests.el | 1 + test/lisp/erc/erc-scenarios-base-renick.el | 8 ++++---- test/lisp/erc/erc-stamp-tests.el | 6 +++--- test/lisp/erc/erc-tests.el | 2 +- 10 files changed, 19 insertions(+), 16 deletions(-) diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index e3d28aa60dd..a81a3869436 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -566,8 +566,9 @@ The INDENT level is ignored." (defun erc-speedbar--reset-last-ran-on-timer () "Reset `erc-speedbar--last-ran'." (when speedbar-buffer - (setf (buffer-local-value 'erc-speedbar--last-ran speedbar-buffer) - (current-time)))) + (with-suppressed-warnings ((obsolete buffer-local-value)) ; <=29 + (setf (buffer-local-value 'erc-speedbar--last-ran speedbar-buffer) + (current-time))))) ;;;###autoload(autoload 'erc-nickbar-mode "erc-speedbar" nil t) (define-erc-module nickbar nil diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index a11739a4195..a8190a2c94a 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -828,6 +828,7 @@ left-sided stamps and date stamps inserted by this function." ;; perform day alignments via this function only when needed. (defun erc-stamp--time-as-day (current-time) "Discard hour, minute, and second info from timestamp CURRENT-TIME." + (defvar current-time-list) ; <=28 (let* ((current-time-list) ; flag (decoded (decode-time current-time erc-stamp--tz))) (setf (decoded-time-second decoded) 0 diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 08dfa4b8f1b..88227688064 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -9492,6 +9492,7 @@ guarantee that the input method functions properly for the purpose of typing within the ERC prompt." (when (and (eq major-mode 'erc-mode) (fboundp 'set-text-conversion-style)) + (defvar text-conversion-style) ; avoid free variable warning on <=29 (if (>= (point) (erc-beg-of-input-line)) (unless (eq text-conversion-style 'action) (set-text-conversion-style 'action)) diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el index ba6fe9fd8c1..603b3745a27 100644 --- a/test/lisp/erc/erc-button-tests.el +++ b/test/lisp/erc/erc-button-tests.el @@ -20,14 +20,13 @@ ;;; Commentary: ;;; Code: +(require 'erc-button) (require 'ert-x) ; cl-lib (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-button) - (ert-deftest erc-button-alist--url () (erc-tests-common-init-server-proc "sleep" "1") (with-current-buffer (erc--open-target "#chan") diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 0f19b481f37..2c3537676a7 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -23,13 +23,13 @@ ;; scenarios. ;;; Code: +(require 'erc-fill) + (require 'ert-x) (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-fill) - (defvar erc-fill-tests--buffers nil) (defvar erc-fill-tests--current-time-value nil) diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index 170e28bda96..7013ce0c8fc 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -19,13 +19,13 @@ ;;; Commentary: ;;; Code: +(require 'erc-goodies) + (require 'ert-x) (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-goodies) - (defun erc-goodies-tests--assert-face (beg end-str present &optional absent) (setq beg (+ beg (point-min))) (let ((end (+ beg (1- (length end-str))))) diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index 53cff8f489c..90b8aa99741 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el @@ -18,6 +18,7 @@ ;; along with GNU Emacs. If not, see . ;;; Code: +(require 'erc-compat) (require 'ert-x) ; cl-lib (eval-and-compile diff --git a/test/lisp/erc/erc-scenarios-base-renick.el b/test/lisp/erc/erc-scenarios-base-renick.el index ca22728b152..e0fcb8b9366 100644 --- a/test/lisp/erc/erc-scenarios-base-renick.el +++ b/test/lisp/erc/erc-scenarios-base-renick.el @@ -281,12 +281,12 @@ (should-not (get-buffer "rando@barnet")) (with-current-buffer "frenemy@foonet" - (funcall expect 1 "now known as") - (funcall expect 1 "doubly so")) + (funcall expect 10 "now known as") + (funcall expect 10 "doubly so")) (with-current-buffer "frenemy@barnet" - (funcall expect 1 "now known as") - (funcall expect 1 "reality picture")) + (funcall expect 10 "now known as") + (funcall expect 10 "reality picture")) (when noninteractive (with-current-buffer "frenemy@barnet" (kill-buffer)) diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index 70ca224ac74..a49173ffa2f 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -20,14 +20,14 @@ ;;; Commentary: ;;; Code: +(require 'erc-stamp) +(require 'erc-goodies) ; for `erc-make-read-only' + (require 'ert-x) (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-stamp) -(require 'erc-goodies) ; for `erc-make-read-only' - ;; These display-oriented tests are brittle because many factors ;; influence how text properties are applied. We should just ;; rework these into full scenarios. diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 7d189d37929..dad161a2827 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -20,13 +20,13 @@ ;; along with GNU Emacs. If not, see . ;;; Code: +(require 'erc-ring) (require 'ert-x) (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-ring) (ert-deftest erc--read-time-period () (cl-letf (((symbol-function 'read-string) (lambda (&rest _) ""))) -- cgit v1.2.3 From 1a36d52413c784750f650ccba95436e4f76ab104 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 3 Feb 2024 17:17:48 -0800 Subject: Autoload custom-loads for new Custom groups in erc.el * lisp/erc/erc.el: Add `custom-loads' library features for group symbols `erc-spelling' and `erc-imenu' since they aren't defined in all supported Emacs versions. Also add groups `erc-sasl' and `erc-nicks', new libraries recently added to ERC. Note that this is unrelated to prefixes generated for the help system. (Bug#68943) --- lisp/erc/erc.el | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 88227688064..db5a9baf5c3 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -135,6 +135,13 @@ concerning buffers." "Running scripts at startup and with /LOAD." :group 'erc) +;; Add `custom-loads' features for group symbols missing from a +;; supported Emacs version, possibly because they belong to a new ERC +;; library. These groups all share their library's feature name. +;;;###autoload(dolist (symbol '( erc-sasl erc-spelling ; 29 +;;;###autoload erc-imenu erc-nicks)) ; 30 +;;;###autoload (custom-add-load symbol symbol)) + (defvar erc-message-parsed) ; only known to this file (defvar erc--msg-props nil -- cgit v1.2.3 From 9668b4f97c2fc6bfff83258861d455a6d02516a8 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 13 Nov 2023 12:07:36 -0800 Subject: Make erc-fill-wrap depend on scrolltobottom * lisp/erc/erc-fill.el (erc-fill-mode): Add reference to `erc-fill-wrap-mode' in doc string. (erc--fill-wrap-scrolltobottom-exempt-p): New variable to allow tests involving `fill-wrap' to opt out of having to enable `scrolltobottom'. (erc-fill--wrap-ensure-dependencies): Warn and enable `erc-scrolltobottom-mode' if necessary. (erc-fill-wrap-mode): Mention workaround for automatically enabling `scrolltobottom'. * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--wrap-populate): Exempt tests from `scrolltobottom' dependency. * test/lisp/erc/resources/erc-scenarios-common.el: Load `erc-fill' when compiling. (erc-scenarios-common--print-trace): Exempt tests using `fill-wrap' from the `scrolltobottom' dependency by making `erc--fill-wrap-scrolltobottom-exempt-p' non-nil during test runs. (Bug#60936) --- lisp/erc/erc-fill.el | 62 +++++++++++++------------ test/lisp/erc/erc-fill-tests.el | 1 + test/lisp/erc/resources/erc-scenarios-common.el | 4 +- 3 files changed, 36 insertions(+), 31 deletions(-) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 547b3a11043..aa12b807fbc 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -44,11 +44,7 @@ (define-erc-module fill nil "Manage filling in ERC buffers. ERC fill mode is a global minor mode. When enabled, messages in -the channel buffers are filled." - ;; FIXME ensure a consistent ordering relative to hook members from - ;; other modules. Ideally, this module's processing should happen - ;; after "morphological" modifications to a message's text but - ;; before superficial decorations. +channel buffers are filled. See also `erc-fill-wrap-mode'." ((add-hook 'erc-insert-modify-hook #'erc-fill 60) (add-hook 'erc-send-modify-hook #'erc-fill 60)) ((remove-hook 'erc-insert-modify-hook #'erc-fill) @@ -425,8 +421,11 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." " " #'erc-fill--wrap-beginning-of-line) (defvar erc-button-mode) +(defvar erc-scrolltobottom-mode) (defvar erc-legacy-invisible-bounds-p) +(defvar erc--fill-wrap-scrolltobottom-exempt-p nil) + (defun erc-fill--wrap-ensure-dependencies () (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) (when erc-legacy-invisible-bounds-p @@ -439,6 +438,10 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." (unless erc-fill-mode (push 'fill missing-deps) (erc-fill-mode +1)) + (unless (or erc-scrolltobottom-mode erc--fill-wrap-scrolltobottom-exempt-p + (memq 'scrolltobottom erc-modules)) + (push 'scrolltobottom missing-deps) + (erc-scrolltobottom-mode +1)) (when erc-fill-wrap-merge (require 'erc-button) (unless erc-button-mode @@ -459,27 +462,25 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." ;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill) (define-erc-module fill-wrap nil "Fill style leveraging `visual-line-mode'. + This module displays nicks overhanging leftward to a common -offset, as determined by the option `erc-fill-static-center'. -And it \"wraps\" messages at a common margin width, as determined -by the option `erc-fill-wrap-margin-width'. To use it, either -include `fill-wrap' in `erc-modules' or set `erc-fill-function' -to `erc-fill-wrap'. Most users will want to enable the -`scrolltobottom' module as well. - -During sessions in which this module is active, use -\\[erc-fill-wrap-nudge] to adjust the width of the indent and the -stamp margin, and use \\[erc-fill-wrap-toggle-truncate-lines] for -cycling between logical- and screen-line oriented command -movement. Similarly, use \\[erc-fill-wrap-refill-buffer] to fix -alignment problems after running certain commands, like -`text-scale-adjust'. Also see related stylistic options -`erc-fill-wrap-merge', and `erc-fill-wrap-merge-indicator'. -\(Hint: in narrow windows, where is space tight, try setting -`erc-fill-static-center' to 1. And if you also use the option -`erc-fill-wrap-merge-indicator', set that to value-menu item -\"Leading MIDDLE DOT sans gap\" or one of the various -\"trailing\" items.) +offset, as determined by the option `erc-fill-static-center'. It +also \"wraps\" messages at a common width, as determined by the +option `erc-fill-wrap-margin-width'. To use it, either include +`fill-wrap' in `erc-modules' or set `erc-fill-function' to +`erc-fill-wrap'. + +Once enabled, use \\[erc-fill-wrap-nudge] to adjust the width of +the indent and the stamp margin. And For cycling between +logical- and screen-line oriented command movement, see +\\[erc-fill-wrap-toggle-truncate-lines]. Similarly, use +\\[erc-fill-wrap-refill-buffer] to fix alignment problems after +running certain commands, like `text-scale-adjust'. Also see +related stylistic options `erc-fill-wrap-merge', and +`erc-fill-wrap-merge-indicator'. (Hint: in narrow windows, try +setting `erc-fill-static-center' to 1, and if you use +`erc-fill-wrap-merge-indicator', choose \"Leading MIDDLE DOT sans +gap\" or one of the \"trailing\" items from the Customize menu.) This module imposes various restrictions on the appearance of timestamps. Most notably, it insists on displaying them in the @@ -497,11 +498,12 @@ a workaround provided by `erc-stamp-prefix-log-filter', which strips trailing stamps from logged messages and instead prepends them to every line. -As a so-called \"local\" module, `fill-wrap' depends on the -global modules `fill', `stamp', and `button'; it activates them -as needed when initializing. Please note that enabling and -disabling this module by invoking one of its minor-mode toggles -is not recommended." +A so-called \"local\" module, `fill-wrap' depends on the global +modules `fill', `stamp', `button', and `scrolltobottom'. It +activates them as needed when initializing and leaves them +enabled when shutting down. To opt out of `scrolltobottom' +specifically, disable its minor mode, `erc-scrolltobottom-mode', +via `erc-fill-wrap-mode-hook'." ((erc-fill--wrap-ensure-dependencies) (erc--restore-initialize-priors erc-fill-wrap-mode erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 2c3537676a7..3c4ad04abd7 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -52,6 +52,7 @@ (defun erc-fill-tests--wrap-populate (test) (let ((original-window-buffer (window-buffer (selected-window))) + (erc--fill-wrap-scrolltobottom-exempt-p t) (erc-stamp--tz t) (erc-fill-function 'erc-fill-wrap) (pre-command-hook pre-command-hook) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 042b3a8c05b..9ad5ce49429 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -94,7 +94,8 @@ (require 'erc) (eval-when-compile (require 'erc-join) - (require 'erc-services)) + (require 'erc-services) + (require 'erc-fill)) (declare-function erc-network "erc-networks") (defvar erc-network) @@ -148,6 +149,7 @@ (timer-list (copy-sequence timer-list)) (timer-idle-list (copy-sequence timer-idle-list)) (erc-auth-source-parameters-join-function nil) + (erc--fill-wrap-scrolltobottom-exempt-p t) (erc-autojoin-channels-alist nil) (erc-server-auto-reconnect nil) (erc-after-connect nil) -- cgit v1.2.3 From d7c18a7b4f218de8c4d2178c9124ea26c7dc5b6b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 11 Feb 2024 20:42:18 -0800 Subject: Ignore the TGT-LIST parameter in erc-open * etc/ERC-NEWS: Mention `erc-open' now ignores TGT-LIST. * lisp/erc/erc.el (erc-open): Set `erc-default-recipients' to a list containing only the supplied target. Other values may cause ERC to malfunction. Also redo doc string. --- etc/ERC-NEWS | 10 ++++++++++ lisp/erc/erc.el | 39 ++++++++++++++++----------------------- 2 files changed, 26 insertions(+), 23 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 1e88500d169..b2aceaa9f39 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -502,6 +502,16 @@ encouraged to keep a module's name aligned with its group's as well as the provided feature of its containing library, if only for the usual reasons of namespace hygiene and discoverability. +*** The function 'erc-open' no longer uses the 'TGT-LIST' parameter. +ERC has always used the parameter to initialize the local variable +'erc-default-recipients', which stores a list of routing targets with +the topmost considered "active." However, since at least ERC 5.1, a +buffer and its active target effectively mate for life, making +'TGT-LIST', in practice, a read-only list of a single target. And +because that target must also appear as the 'CHANNEL' parameter, +'TGT-LIST' mainly serves to reinforce 'erc-open's reputation of being +unruly. + *** ERC supports arbitrary CHANTYPES. Specifically, channels can be prefixed with any predesignated character, mainly to afford more flexibility to specialty services, diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index db5a9baf5c3..94e98bd7660 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2486,29 +2486,22 @@ nil." (cl-assert (= (point) (point-max))))) (defun erc-open (&optional server port nick full-name - connect passwd tgt-list channel process + connect passwd _tgt-list channel process client-certificate user id) - "Connect to SERVER on PORT as NICK with USER and FULL-NAME. - -If CONNECT is non-nil, connect to the server. Otherwise assume -already connected and just create a separate buffer for the new -target given by CHANNEL, meaning these parameters are mutually -exclusive. Note that CHANNEL may also be a query; its name has -been retained for historical reasons. - -Use PASSWD as user password on the server. If TGT-LIST is -non-nil, use it to initialize `erc-default-recipients'. - -CLIENT-CERTIFICATE, if non-nil, should either be a list where the -first element is the file name of the private key corresponding -to a client certificate and the second element is the file name -of the client certificate itself to use when connecting over TLS, -or t, which means that `auth-source' will be queried for the -private key and the certificate. - -When non-nil, ID should be a symbol for identifying the connection. - -Returns the buffer for the given server or channel." + "Return a new or reinitialized server or target buffer. +If CONNECT is non-nil, connect to SERVER and return its new or +reassociated buffer. Otherwise, assume PROCESS is non-nil and belongs +to an active session, and return a new or refurbished target buffer for +CHANNEL, which may also be a query target (the parameter name remains +for historical reasons). Pass SERVER, PORT, NICK, USER, FULL-NAME, and +PASSWD to `erc-determine-parameters' for preserving as session-local +variables. Do something similar for CLIENT-CERTIFICATE and ID, which +should be as described by `erc-tls'. + +Note that ERC ignores TGT-LIST and initializes `erc-default-recipients' +with CHANNEL as its only member. Note also that this function has the +side effect of setting the current buffer to the one it returns. Use +`with-current-buffer' or `save-excursion' to nullify this effect." (let* ((target (and channel (erc--target-from-string channel))) (buffer (erc-get-buffer-create server port nil target id)) (old-buffer (current-buffer)) @@ -2545,7 +2538,7 @@ Returns the buffer for the given server or channel." ;; connection parameters (setq erc-server-process process) ;; stack of default recipients - (setq erc-default-recipients tgt-list) + (when channel (setq erc-default-recipients (list channel))) (when target (setq erc--target target erc-network (erc-network))) -- cgit v1.2.3 From 25d15391f2683ea95c4d7ee291fb82e0c9858d73 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 11 Feb 2024 17:15:14 -0800 Subject: Normalize ISUPPORT params with empty values in ERC * lisp/erc/erc-backend.el (erc-server-parameters) (erc--isupport-params): Mention parsing and storage behavior regarding nonstandard "FOO=" tokens. (erc--parse-isupport-value): Move comment closer to code. (erc--get-isupport-entry): Treat the empty string as truly null, as prescribed by the Brocklesby draft cited in the top-level comment. * test/lisp/erc/erc-tests.el (erc--get-isupport-entry): Add case for the empty string appearing as a value for an `erc-server-parameters' item. (erc-server-005): Assert compat-related behavior of retaining the empty string as a valid value from a raw "FOO=" token. (Bug#67220) --- lisp/erc/erc-backend.el | 21 +++++++++++++-------- test/lisp/erc/erc-tests.el | 26 ++++++++++++++++++-------- 2 files changed, 31 insertions(+), 16 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index e379066b08e..2aaedad1b64 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -254,6 +254,11 @@ Entries are of the form: or (PARAMETER) if no value is provided. +where PARAMETER is a string and VALUE is a string or nil. For +compatibility, a raw parameter of the form \"FOO=\" becomes +(\"FOO\" . \"\") even though it's equivalent to the preferred +canonical form \"FOO\" and its lisp representation (\"FOO\"). + Some examples of possible parameters sent by servers: CHANMODES=b,k,l,imnpst - list of supported channel modes CHANNELLEN=50 - maximum length of channel names @@ -273,7 +278,8 @@ WALLCHOPS - supports sending messages to all operators in a channel") (defvar-local erc--isupport-params nil "Hash map of \"ISUPPORT\" params. Keys are symbols. Values are lists of zero or more strings with hex -escapes removed.") +escapes removed. ERC normalizes incoming parameters of the form +\"FOO=\" to (FOO).") ;;; Server and connection state @@ -2150,10 +2156,6 @@ Then display the welcome message." ;; ;; > The server SHOULD send "X", not "X="; this is the normalized form. ;; - ;; Note: for now, assume the server will only send non-empty values, - ;; possibly with printable ASCII escapes. Though in practice, the - ;; only two escapes we're likely to see are backslash and space, - ;; meaning the pattern is too liberal. (let (case-fold-search) (mapcar (lambda (v) @@ -2164,7 +2166,9 @@ Then display the welcome message." (string-match "[\\]x[0-9A-F][0-9A-F]" v start)) (setq m (substring v (+ 2 (match-beginning 0)) (match-end 0)) c (string-to-number m 16)) - (if (<= ?\ c ?~) + ;; In practice, this range is too liberal. The only + ;; escapes we're likely to see are ?\\, ?=, and ?\s. + (if (<= ?\s c ?~) (setq v (concat (substring v 0 (match-beginning 0)) (string c) (substring v (match-end 0))) @@ -2189,8 +2193,9 @@ primitive value." (or erc-server-parameters (erc-with-server-buffer erc-server-parameters))))) - (if (cdr v) - (erc--parse-isupport-value (cdr v)) + (if-let ((val (cdr v)) + ((not (string-empty-p val)))) + (erc--parse-isupport-value val) '--empty--))))) (pcase value ('--empty-- (unless single (list key))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index dad161a2827..4762be468a5 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1054,7 +1054,8 @@ (ert-deftest erc--get-isupport-entry () (let ((erc--isupport-params (make-hash-table)) - (erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C"))) + (erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C") + ("SPAM" . ""))) (items (lambda () (cl-loop for k being the hash-keys of erc--isupport-params using (hash-values v) collect (cons k v))))) @@ -1075,7 +1076,9 @@ (should (equal (erc--get-isupport-entry 'FOO) '(FOO "1"))) (should (equal (funcall items) - '((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1")))))) + '((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1")))) + (should (equal (erc--get-isupport-entry 'SPAM) '(SPAM))) + (should-not (erc--get-isupport-entry 'SPAM 'single)))) (ert-deftest erc-server-005 () (let* ((hooked 0) @@ -1093,34 +1096,41 @@ (lambda (_ _ _ line) (push line calls)))) (ert-info ("Baseline") - (setq args '("tester" "BOT=B" "EXCEPTS" "PREFIX=(ov)@+" "are supp...") + (setq args '("tester" "BOT=B" "CHANTYPES=" "EXCEPTS" "PREFIX=(ov)@+" + "are supp...") parsed (make-erc-response :command-args args :command "005")) (setq verify (lambda () (should (equal erc-server-parameters '(("PREFIX" . "(ov)@+") ("EXCEPTS") + ;; Should be ("CHANTYPES") but + ;; retained for compatibility. + ("CHANTYPES" . "") ("BOT" . "B")))) (should (zerop (hash-table-count erc--isupport-params))) (should (equal "(ov)@+" (erc--get-isupport-entry 'PREFIX t))) (should (equal '(EXCEPTS) (erc--get-isupport-entry 'EXCEPTS))) (should (equal "B" (erc--get-isupport-entry 'BOT t))) - (should (string= (pop calls) - "BOT=B EXCEPTS PREFIX=(ov)@+ are supp...")) + (should (string= + (pop calls) + "BOT=B CHANTYPES= EXCEPTS PREFIX=(ov)@+ are supp...")) (should (equal args (erc-response.command-args parsed))))) (erc-call-hooks nil parsed)) (ert-info ("Negated, updated") - (setq args '("tester" "-EXCEPTS" "-FAKE" "PREFIX=(ohv)@%+" "are su...") + (setq args '("tester" "-EXCEPTS" "-CHANTYPES" "-FAKE" "PREFIX=(ohv)@%+" + "are su...") parsed (make-erc-response :command-args args :command "005")) (setq verify (lambda () (should (equal erc-server-parameters '(("PREFIX" . "(ohv)@%+") ("BOT" . "B")))) - (should (string= (pop calls) - "-EXCEPTS -FAKE PREFIX=(ohv)@%+ are su...")) + (should (string-prefix-p + "-EXCEPTS -CHANTYPES -FAKE PREFIX=(ohv)@%+ " + (pop calls))) (should (equal "(ohv)@%+" (erc--get-isupport-entry 'PREFIX t))) (should (equal "B" (erc--get-isupport-entry 'BOT t))) (should-not (erc--get-isupport-entry 'EXCEPTS)) -- cgit v1.2.3 From 3d87e343276081247102838b827b8a1f5e9e0c54 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 11 Feb 2024 20:01:54 -0800 Subject: Use modern fallback for channel name detection in ERC * lisp/erc/erc-backend.el (erc-query-buffer-p): Remove forward declaration. * lisp/erc/erc.el (erc-query-buffer-p): Defer to `erc-channel-p'. (erc-channel-p): Refactor and use `erc--fallback-channel-prefixes' for the default CHANTYPES value. Honor an empty CHANTYPES value as valid, e.g., for servers that only support direct messages. (erc--fallback-channel-prefixes): New variable to hold fallback CHANTYPES prefixes recommended by RFC1459 and modern authorities on the matter. * test/lisp/erc/erc-tests.el (erc-channel-p): Revise test. (Bug#67220) --- lisp/erc/erc-backend.el | 1 - lisp/erc/erc.el | 32 +++++++++++++++----------------- test/lisp/erc/erc-tests.el | 46 +++++++++++++++++++++++++++++----------------- 3 files changed, 44 insertions(+), 35 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 2aaedad1b64..7b782d0ef44 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -158,7 +158,6 @@ (declare-function erc-parse-user "erc" (string)) (declare-function erc-process-away "erc" (proc away-p)) (declare-function erc-process-ctcp-query "erc" (proc parsed nick login host)) -(declare-function erc-query-buffer-p "erc" (&optional buffer)) (declare-function erc-remove-channel-member "erc" (channel nick)) (declare-function erc-remove-channel-users "erc" nil) (declare-function erc-remove-user "erc" (nick)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 94e98bd7660..f250584e47a 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1663,11 +1663,7 @@ If BUFFER is nil, the current buffer is used." (defun erc-query-buffer-p (&optional buffer) "Return non-nil if BUFFER is an ERC query buffer. If BUFFER is nil, the current buffer is used." - (with-current-buffer (or buffer (current-buffer)) - (let ((target (erc-target))) - (and (eq major-mode 'erc-mode) - target - (not (memq (aref target 0) '(?# ?& ?+ ?!))))))) + (not (erc-channel-p (or buffer (current-buffer))))) (defun erc-ison-p (nick) "Return non-nil if NICK is online." @@ -1882,18 +1878,20 @@ buries those." :group 'erc-buffers :type 'boolean) -(defun erc-channel-p (channel) - "Return non-nil if CHANNEL seems to be an IRC channel name." - (cond ((stringp channel) - (memq (aref channel 0) - (if-let ((types (erc--get-isupport-entry 'CHANTYPES 'single))) - (append types nil) - '(?# ?& ?+ ?!)))) - ((and-let* (((bufferp channel)) - ((buffer-live-p channel)) - (target (buffer-local-value 'erc--target channel))) - (erc-channel-p (erc--target-string target)))) - (t nil))) +(defvar erc--fallback-channel-prefixes "#&" + "Prefix chars for distinguishing channel targets when CHANTYPES is unknown.") + +(defun erc-channel-p (target) + "Return non-nil if TARGET is a valid channel name or a channel buffer." + (cond ((stringp target) + (and-let* + (((not (string-empty-p target))) + (value (let ((entry (erc--get-isupport-entry 'CHANTYPES))) + (if entry (cadr entry) erc--fallback-channel-prefixes))) + ((erc--strpos (aref target 0) value))))) + ((and-let* (((buffer-live-p target)) + (target (buffer-local-value 'erc--target target)) + ((erc--target-channel-p target))))))) ;; For the sake of compatibility, a historical quirk concerning this ;; option, when nil, has been preserved: all buffers are suffixed with diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 4762be468a5..085b063bdb2 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1167,25 +1167,37 @@ (should (equal (erc-downcase "\\O/") "|o/" ))))) (ert-deftest erc-channel-p () - (let ((erc--isupport-params (make-hash-table)) - erc-server-parameters) - - (should (erc-channel-p "#chan")) - (should (erc-channel-p "##chan")) - (should (erc-channel-p "&chan")) - (should (erc-channel-p "+chan")) - (should (erc-channel-p "!chan")) - (should-not (erc-channel-p "@chan")) - - (push '("CHANTYPES" . "#&@+!") erc-server-parameters) + (erc-tests-common-make-server-buf) - (should (erc-channel-p "!chan")) - (should (erc-channel-p "#chan")) + (should (erc-channel-p "#chan")) + (should (erc-channel-p "##chan")) + (should (erc-channel-p "&chan")) + (should-not (erc-channel-p "+chan")) + (should-not (erc-channel-p "!chan")) + (should-not (erc-channel-p "@chan")) + + ;; Server sends "CHANTYPES=#&+!" + (should-not erc-server-parameters) + (setq erc-server-parameters '(("CHANTYPES" . "#&+!"))) + (should (erc-channel-p "#chan")) + (should (erc-channel-p "&chan")) + (should (erc-channel-p "+chan")) + (should (erc-channel-p "!chan")) + + (with-current-buffer (erc--open-target "#chan") + (should (erc-channel-p (current-buffer)))) + (with-current-buffer (erc--open-target "+chan") + (should (erc-channel-p (current-buffer)))) + (should (erc-channel-p (get-buffer "#chan"))) + (should (erc-channel-p (get-buffer "+chan"))) + + ;; Server sends "CHANTYPES=" because it's query only. + (puthash 'CHANTYPES '("CHANTYPES") erc--isupport-params) + (should-not (erc-channel-p "#spam")) + (should-not (erc-channel-p "&spam")) + (should-not (erc-channel-p (save-excursion (erc--open-target "#spam")))) - (with-current-buffer (get-buffer-create "#chan") - (setq erc--target (erc--target-from-string "#chan"))) - (should (erc-channel-p (get-buffer "#chan")))) - (kill-buffer "#chan")) + (erc-tests-common-kill-buffers)) (ert-deftest erc--valid-local-channel-p () (ert-info ("Local channels not supported") -- cgit v1.2.3 From de6f7f3c86ea0e52e8f9825585c726a7f93fa9cf Mon Sep 17 00:00:00 2001 From: Kévin Le Gouguec Date: Sat, 10 Feb 2024 16:14:08 +0100 Subject: Refine shebang tests (bug#64939) * test/lisp/files-tests.el (files-tests--check-shebang): For shell-script modes, verify that the correct shell is set. (files-tests-auto-mode-interpreter): Prefer 'sh-base-mode' to 'sh-mode' to stay tree-sitter-agnostic; re-organize test cases to make future ones easier to add. --- test/lisp/files-tests.el | 45 +++++++++++++++++++++++++++------------------ 1 file changed, 27 insertions(+), 18 deletions(-) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 718ecd51f8b..23516ff0d7d 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1656,30 +1656,39 @@ The door of all subtleties! (should (equal (file-name-base "foo") "foo")) (should (equal (file-name-base "foo/bar") "bar"))) -(defun files-tests--check-shebang (shebang expected-mode) - "Assert that mode for SHEBANG derives from EXPECTED-MODE." - (let ((actual-mode - (ert-with-temp-file script-file - :text shebang - (find-file script-file) - (if (derived-mode-p expected-mode) - expected-mode - major-mode)))) - ;; Tuck all the information we need in the `should' form: input - ;; shebang, expected mode vs actual. - (should - (equal (list shebang actual-mode) - (list shebang expected-mode))))) +(defvar sh-shell) + +(defun files-tests--check-shebang (shebang expected-mode &optional expected-dialect) + "Assert that mode for SHEBANG derives from EXPECTED-MODE. + +If EXPECTED-MODE is sh-base-mode, DIALECT says what `sh-shell' should be +set to." + (ert-with-temp-file script-file + :text shebang + (find-file script-file) + (let ((actual-mode (if (derived-mode-p expected-mode) + expected-mode + major-mode))) + ;; Tuck all the information we need in the `should' form: input + ;; shebang, expected mode vs actual. + (should + (equal (list shebang actual-mode) + (list shebang expected-mode))) + (when (eq expected-mode 'sh-base-mode) + (should (eq sh-shell expected-dialect)))))) (ert-deftest files-tests-auto-mode-interpreter () "Test that `set-auto-mode' deduces correct modes from shebangs." - (files-tests--check-shebang "#!/bin/bash" 'sh-mode) - (files-tests--check-shebang "#!/usr/bin/env bash" 'sh-mode) + ;; Straightforward interpreter invocation. + (files-tests--check-shebang "#!/bin/bash" 'sh-base-mode 'bash) + (files-tests--check-shebang "#!/usr/bin/make -f" 'makefile-mode) + ;; Invocation through env. + (files-tests--check-shebang "#!/usr/bin/env bash" 'sh-base-mode 'bash) (files-tests--check-shebang "#!/usr/bin/env python" 'python-base-mode) (files-tests--check-shebang "#!/usr/bin/env python3" 'python-base-mode) + ;; Invocation through env, with supplementary arguments. (files-tests--check-shebang "#!/usr/bin/env -S awk -v FS=\"\\t\" -v OFS=\"\\t\" -f" 'awk-mode) - (files-tests--check-shebang "#!/usr/bin/env -S make -f" 'makefile-mode) - (files-tests--check-shebang "#!/usr/bin/make -f" 'makefile-mode)) + (files-tests--check-shebang "#!/usr/bin/env -S make -f" 'makefile-mode)) (ert-deftest files-test-dir-locals-auto-mode-alist () "Test an `auto-mode-alist' entry in `.dir-locals.el'" -- cgit v1.2.3 From ecb9641ecb5f42899042ff9c164ec7dbb8e166fe Mon Sep 17 00:00:00 2001 From: Kévin Le Gouguec Date: Sat, 10 Feb 2024 17:37:35 +0100 Subject: Support more complex env invocations in shebang lines This is not an exact re-implementation of what env accepts, but hopefully it should be "good enough". Example of known limitation: we assume that arguments for --long-options will be set with '=', but that is not necessarily the case. '--unset' (mandatory argument) can be passed as '--unset=VAR' or '--unset VAR', but '--default-signal' (optional argument) requires an '=' sign. For bug#64939. * lisp/files.el (auto-mode-interpreter-regexp): Account for supplementary arguments passed beside -S/--split-string. * test/lisp/files-tests.el (files-tests-auto-mode-interpreter): Test some of these combinations. --- lisp/files.el | 8 +++++++- test/lisp/files-tests.el | 8 +++++++- 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index f67b650cb92..5098d49048e 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3274,7 +3274,13 @@ and `inhibit-local-variables-suffixes'. If ;; Optional group 1: env(1) invocation. "\\(" "[^ \t\n]*/bin/env[ \t]*" - "\\(?:-S[ \t]*\\|--split-string\\(?:=\\|[ \t]*\\)\\)?" + ;; Within group 1: possible -S/--split-string. + "\\(?:" + ;; -S/--split-string + "\\(?:-[0a-z]*S[ \t]*\\|--split-string=\\)" + ;; More env arguments. + "\\(?:-[^ \t\n]+[ \t]+\\)*" + "\\)?" "\\)?" ;; Group 2: interpreter. "\\([^ \t\n]+\\)")) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 23516ff0d7d..0a5c3b897e4 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1687,8 +1687,14 @@ set to." (files-tests--check-shebang "#!/usr/bin/env python" 'python-base-mode) (files-tests--check-shebang "#!/usr/bin/env python3" 'python-base-mode) ;; Invocation through env, with supplementary arguments. + (files-tests--check-shebang "#!/usr/bin/env --split-string=bash -eux" 'sh-base-mode 'bash) + (files-tests--check-shebang "#!/usr/bin/env --split-string=-iv --default-signal bash -eux" 'sh-base-mode 'bash) (files-tests--check-shebang "#!/usr/bin/env -S awk -v FS=\"\\t\" -v OFS=\"\\t\" -f" 'awk-mode) - (files-tests--check-shebang "#!/usr/bin/env -S make -f" 'makefile-mode)) + (files-tests--check-shebang "#!/usr/bin/env -S make -f" 'makefile-mode) + (files-tests--check-shebang "#!/usr/bin/env -S-vi bash -eux" 'sh-base-mode 'bash) + (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal=INT bash -eux" 'sh-base-mode 'bash) + (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal bash -eux" 'sh-base-mode 'bash) + (files-tests--check-shebang "#!/usr/bin/env -vS -uFOOBAR bash -eux" 'sh-base-mode 'bash)) (ert-deftest files-test-dir-locals-auto-mode-alist () "Test an `auto-mode-alist' entry in `.dir-locals.el'" -- cgit v1.2.3 From c64e650fb346d92294703d22f8cd7deb7c47b49e Mon Sep 17 00:00:00 2001 From: Kévin Le Gouguec Date: Sat, 10 Feb 2024 17:56:57 +0100 Subject: Support shebang lines with amended environment For bug#64939. * lisp/files.el (auto-mode-interpreter-regexp): Account for possible VARIABLE=[VALUE] operands. * test/lisp/files-tests.el (files-tests-auto-mode-interpreter): Add an example from the coreutils manual. --- lisp/files.el | 5 ++++- test/lisp/files-tests.el | 4 +++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index 5098d49048e..524385edc84 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3274,12 +3274,15 @@ and `inhibit-local-variables-suffixes'. If ;; Optional group 1: env(1) invocation. "\\(" "[^ \t\n]*/bin/env[ \t]*" - ;; Within group 1: possible -S/--split-string. + ;; Within group 1: possible -S/--split-string and environment + ;; adjustments. "\\(?:" ;; -S/--split-string "\\(?:-[0a-z]*S[ \t]*\\|--split-string=\\)" ;; More env arguments. "\\(?:-[^ \t\n]+[ \t]+\\)*" + ;; Interpreter environment modifications. + "\\(?:[^ \t\n]+=[^ \t\n]*[ \t]+\\)*" "\\)?" "\\)?" ;; Group 2: interpreter. diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 0a5c3b897e4..d4c1ef3ba67 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1694,7 +1694,9 @@ set to." (files-tests--check-shebang "#!/usr/bin/env -S-vi bash -eux" 'sh-base-mode 'bash) (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal=INT bash -eux" 'sh-base-mode 'bash) (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal bash -eux" 'sh-base-mode 'bash) - (files-tests--check-shebang "#!/usr/bin/env -vS -uFOOBAR bash -eux" 'sh-base-mode 'bash)) + (files-tests--check-shebang "#!/usr/bin/env -vS -uFOOBAR bash -eux" 'sh-base-mode 'bash) + ;; Invocation through env, with modified environment. + (files-tests--check-shebang "#!/usr/bin/env -S PYTHONPATH=/...:${PYTHONPATH} python" 'python-base-mode)) (ert-deftest files-test-dir-locals-auto-mode-alist () "Test an `auto-mode-alist' entry in `.dir-locals.el'" -- cgit v1.2.3 From 84e4f1259b54442f52183c1ccee72a417e0a2658 Mon Sep 17 00:00:00 2001 From: john muhl Date: Mon, 12 Feb 2024 18:46:51 -0600 Subject: Eagerly indent first field in tables in 'lua-ts-mode' * lisp/progmodes/lua-ts-mode.el (lua-ts--simple-indent-rules): Properly indent the first field of a table when it appears on a line by itself. (Bug#69088) --- lisp/progmodes/lua-ts-mode.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index dc2a8fcec1e..c7f5ac50b04 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -317,6 +317,8 @@ values of OVERRIDE." (node-is ")") (node-is "}")) standalone-parent 0) + ((match null "table_constructor") + standalone-parent lua-ts-indent-offset) ((or (and (parent-is "arguments") lua-ts--first-child-matcher) (and (parent-is "parameters") lua-ts--first-child-matcher) (and (parent-is "table_constructor") lua-ts--first-child-matcher)) -- cgit v1.2.3 From 6477be93bd8a29cba8ce383f9ea3fba23c45f225 Mon Sep 17 00:00:00 2001 From: Aleksandr Vityazev Date: Thu, 15 Feb 2024 22:51:24 +0300 Subject: Make key selection method configurable in EPA. * lisp/epa.el (epa-keys-select-method): New defcustom. (epa--select-keys-in-minibuffer): New function. (epa-select-keys): Use new option and function. * etc/NEWS: Announce it. * doc/misc/epa.texi (Key Management): Document it. (Bug#69133) --- doc/misc/epa.texi | 7 +++++++ etc/NEWS | 8 ++++++++ lisp/epa.el | 33 ++++++++++++++++++++++++++++++++- 3 files changed, 47 insertions(+), 1 deletion(-) diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi index 27a9e2b0ebb..cd6da1dadba 100644 --- a/doc/misc/epa.texi +++ b/doc/misc/epa.texi @@ -289,6 +289,13 @@ also ask you whether or not to sign the text before encryption and if you answered yes, it will let you select the signing keys. @end deffn +You can change the default method that is used to select keys with the +variable @code{epa-file-select-keys}. + +@defvar epa-keys-select-method +Method used to select keys in @code{epa-select-keys}. +@end defvar + @node Cryptographic operations on files @section Cryptographic Operations on Files @cindex cryptographic operations on files diff --git a/etc/NEWS b/etc/NEWS index 5220a7fb337..4477116248e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1365,6 +1365,14 @@ The new user option 'ielm-history-file-name' is the name of the file where IELM input history will be saved. Customize it to nil to revert to the old behavior of not remembering input history between sessions. +** EasyPG + ++++ +*** New user option 'epa-keys-select-method'. +This allows the user to customize the key selection method, which can be +either by using a pop-up buffer or from the minibuffer. The pop-up +buffer method is the default, which preserves previous behavior. + * New Modes and Packages in Emacs 30.1 diff --git a/lisp/epa.el b/lisp/epa.el index 53da3bf6cce..b2593bc62ba 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -73,6 +73,16 @@ The command `epa-mail-encrypt' uses this." :group 'epa :version "24.4") +(defcustom epa-keys-select-method 'buffer + "Method used to select keys in `epa-select-keys'. +If the value is \\='buffer, the default, keys are selected via a +pop-up buffer. If the value is \\='minibuffer, keys are selected +via the minibuffer instead, using `completing-read-multiple'." + :type '(choice (const :tag "Read keys from a pop-up buffer" buffer) + (const :tag "Read keys from minibuffer" minibuffer)) + :group 'epa + :version "30.1") + ;;; Faces (defgroup epa-faces nil @@ -450,6 +460,25 @@ q trust status questionable. - trust status unspecified. (epa--marked-keys)) (kill-buffer epa-keys-buffer))))) +(defun epa--select-keys-in-minibuffer (prompt keys) + (let* ((prompt (pcase-let ((`(,first ,second ,third) + (string-split prompt "\\.")) + (hint "(separated by comma)")) + (if third + (format "%s %s. %s: " first hint second) + (format "%s %s: " first hint)))) + (keys-alist + (seq-map + (lambda (key) + (cons (substring-no-properties + (epa--button-key-text key)) + key)) + keys)) + (selected-keys (completing-read-multiple prompt keys-alist))) + (seq-map + (lambda (key) (cdr (assoc key keys-alist))) + selected-keys))) + ;;;###autoload (defun epa-select-keys (context prompt &optional names secret) "Display a user's keyring and ask him to select keys. @@ -459,7 +488,9 @@ NAMES is a list of strings to be matched with keys. If it is nil, all the keys are listed. If SECRET is non-nil, list secret keys instead of public keys." (let ((keys (epg-list-keys context names secret))) - (epa--select-keys prompt keys))) + (pcase epa-keys-select-method + ('minibuffer (epa--select-keys-in-minibuffer prompt keys)) + (_ (epa--select-keys prompt keys))))) ;;;; Key Details -- cgit v1.2.3 From d85461ac61c5ea99ea194f99c771de1efdabbef4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 17 Feb 2024 11:31:20 +0200 Subject: ; Fix last change * doc/misc/epa.texi (Cryptographic operations on regions): Fix wording of the 'epa-keys-select-method's documentation. * lisp/epa.el (epa-keys-select-method): Doc fix (bug#69133). --- doc/misc/epa.texi | 10 ++++++---- lisp/epa.el | 3 ++- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi index cd6da1dadba..f450b9cbdd9 100644 --- a/doc/misc/epa.texi +++ b/doc/misc/epa.texi @@ -289,11 +289,13 @@ also ask you whether or not to sign the text before encryption and if you answered yes, it will let you select the signing keys. @end deffn -You can change the default method that is used to select keys with the -variable @code{epa-file-select-keys}. - @defvar epa-keys-select-method -Method used to select keys in @code{epa-select-keys}. +This variable controls the method used for key selection in +@code{epa-select-keys}. The default value @code{buffer} pops up a +special buffer where you can select the keys. If the value is +@code{minibuffer}, @code{epa-select-keys} will instead prompt for the +keys in the minibuffer, where you should type the keys separated by +commas. @end defvar @node Cryptographic operations on files diff --git a/lisp/epa.el b/lisp/epa.el index b2593bc62ba..c29df18bb58 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -77,7 +77,8 @@ The command `epa-mail-encrypt' uses this." "Method used to select keys in `epa-select-keys'. If the value is \\='buffer, the default, keys are selected via a pop-up buffer. If the value is \\='minibuffer, keys are selected -via the minibuffer instead, using `completing-read-multiple'." +via the minibuffer instead, using `completing-read-multiple'. +Any other value is treated as \\='buffer." :type '(choice (const :tag "Read keys from a pop-up buffer" buffer) (const :tag "Read keys from minibuffer" minibuffer)) :group 'epa -- cgit v1.2.3 From 77576cd7626e4a99a5c88aa854091d701edd53a8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 17 Feb 2024 12:15:11 +0200 Subject: ; Don't use non-ASCII characters in C comments in xdisp.c. --- src/xdisp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/xdisp.c b/src/xdisp.c index 6087a25afcc..4d60915f31c 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -24774,7 +24774,7 @@ maybe_produce_line_number (struct it *it) /* NOTE: We use `base_line_number` without checking BASE_LINE_NUMBER_VALID_P because we assume that `redisplay_window` has already flushed this cache for us when needed. - NOTE²: Checking BASE_LINE_NUMBER_VALID_P here would be + NOTE2: Checking BASE_LINE_NUMBER_VALID_P here would be overly pessimistic because it might say that the cache was invalid before entering `redisplay_window` yet the value has just been refreshed. */ -- cgit v1.2.3 From 07a392f445eb21c5e4681027eee9d981300a4309 Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 17 Feb 2024 10:17:41 -0500 Subject: Update to Org 9.6.19 --- doc/misc/org.org | 22 +++++++--------------- etc/refcards/orgcard.tex | 2 +- lisp/org/ol-man.el | 14 ++++++++++++++ lisp/org/ol.el | 5 +---- lisp/org/org-compat.el | 2 +- lisp/org/org-id.el | 12 ++++++------ lisp/org/org-lint.el | 7 +++++-- lisp/org/org-table.el | 8 ++++---- lisp/org/org-tempo.el | 2 +- lisp/org/org-version.el | 4 ++-- lisp/org/org.el | 10 ++++++---- lisp/org/ox-latex.el | 5 +++-- lisp/org/ox-odt.el | 5 +++-- lisp/org/ox.el | 9 ++++----- 14 files changed, 58 insertions(+), 49 deletions(-) diff --git a/doc/misc/org.org b/doc/misc/org.org index 9535eccc1e6..441985c905f 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -16712,6 +16712,7 @@ to HTML, the following links all point to a dedicated anchor in :END: #+cindex: sitemap, of published pages +#+vindex: org-publish-project-alist The following properties may be used to control publishing of a map of files for a given project. @@ -16729,6 +16730,12 @@ a map of files for a given project. Title of sitemap page. Defaults to name of file. +- ~:sitemap-style~ :: + + Can be ~list~ (site-map is just an itemized list of the titles of + the files involved) or ~tree~ (the directory structure of the + source files is reflected in the site-map). Defaults to ~tree~. + - ~:sitemap-format-entry~ :: #+findex: org-publish-find-date @@ -16774,21 +16781,6 @@ a map of files for a given project. Should sorting be case-sensitive? Default ~nil~. -- ~:sitemap-file-entry-format~ :: - - With this option one can tell how a sitemap's entry is formatted in - the sitemap. This is a format string with some escape sequences: - ~%t~ stands for the title of the file, ~%a~ stands for the author of - the file and ~%d~ stands for the date of the file. The date is - retrieved with the ~org-publish-find-date~ function and formatted - with ~org-publish-sitemap-date-format~. Default ~%t~. - -- ~:sitemap-date-format~ :: - - Format string for the ~format-time-string~ function that tells how - a sitemap entry's date is to be formatted. This property bypasses - ~org-publish-sitemap-date-format~ which defaults to ~%Y-%m-%d~. - *** Generating an index :PROPERTIES: :DESCRIPTION: An index that reaches across pages. diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index 705ab62d69d..e1d40d8632f 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{9.6.15} +\def\orgversionnumber{9.6.19} \def\versionyear{2023} % latest update \input emacsver.tex diff --git a/lisp/org/ol-man.el b/lisp/org/ol-man.el index b6cada1b3c3..d3d7db04700 100644 --- a/lisp/org/ol-man.el +++ b/lisp/org/ol-man.el @@ -39,13 +39,27 @@ :group 'org-link :type '(choice (const man) (const woman))) +(declare-function Man-translate-references "man" (ref)) (defun org-man-open (path _) "Visit the manpage on PATH. PATH should be a topic that can be thrown at the man command. If PATH contains extra ::STRING which will use `occur' to search matched strings in man buffer." + (require 'man) ; For `Man-translate-references' (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?$" path) (let* ((command (match-string 1 path)) + ;; FIXME: Remove after we drop Emacs 29 support. + ;; Working around security bug #66390. + (command (if (not (equal (Man-translate-references ";id") ";id")) + ;; We are on Emacs that escapes man command args + ;; (see Emacs commit 820f0793f0b). + command + ;; Older Emacs without the fix - escape the + ;; arguments ourselves. + (mapconcat 'identity + (mapcar #'shell-quote-argument + (split-string command "\\s-+")) + " "))) (search (match-string 2 path)) (buffer (funcall org-man-command command))) (when search diff --git a/lisp/org/ol.el b/lisp/org/ol.el index 4c84e62f4c9..c3b03087842 100644 --- a/lisp/org/ol.el +++ b/lisp/org/ol.el @@ -291,10 +291,7 @@ or emacs-wiki packages to Org syntax. The function must accept two parameters, a TYPE containing the link protocol name like \"rmail\" or \"gnus\" as a string, and the linked path, which is everything after the link protocol. It should return a cons -with possibly modified values of type and path. -Org contains a function for this, so if you set this variable to -`org-translate-link-from-planner', you should be able follow many -links created by planner." +with possibly modified values of type and path." :group 'org-link-follow :type '(choice (const nil) (function)) :safe #'null) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index 33a510cd7f2..c17a100d3c1 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -664,7 +664,7 @@ You could use brackets to delimit on what part the link will be. %t is the title. %a is the author. -%d is the date formatted using `org-publish-sitemap-date-format'." +%d is the date." :group 'org-export-publish :type 'string) (make-obsolete-variable diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index 9561f2de184..fe7d5f4c1a5 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -29,13 +29,13 @@ ;; are provided that create and retrieve such identifiers, and that find ;; entries based on the identifier. -;; Identifiers consist of a prefix (default "Org" given by the variable +;; Identifiers consist of a prefix (given by the variable ;; `org-id-prefix') and a unique part that can be created by a number -;; of different methods, see the variable `org-id-method'. -;; Org has a builtin method that uses a compact encoding of the creation -;; time of the ID, with microsecond accuracy. This virtually -;; guarantees globally unique identifiers, even if several people are -;; creating IDs at the same time in files that will eventually be used +;; of different methods, see the variable `org-id-method'. Org has a +;; builtin method that uses a compact encoding of the creation time of +;; the ID, with microsecond accuracy. This virtually guarantees +;; globally unique identifiers, even if several people are creating +;; IDs at the same time in files that will eventually be used ;; together. ;; ;; By default Org uses UUIDs as global unique identifiers. diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el index dc12ec272fa..a503de7d364 100644 --- a/lisp/org/org-lint.el +++ b/lisp/org/org-lint.el @@ -1209,8 +1209,11 @@ Use \"export %s\" instead" (`(,(and (pred symbolp) name) ,(pred string-or-null-p) ,(pred string-or-null-p)) - (unless (org-cite-get-processor name) - (list source "Unknown cite export processor %S" name))) + (unless (or (org-cite-get-processor name) + (progn + (org-cite-try-load-processor name) + (org-cite-get-processor name))) + (list source (format "Unknown cite export processor %S" name)))) (_ (list source "Invalid cite export processor declaration"))) (error diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 6408f48ccbd..92490f9f6bf 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -1922,8 +1922,8 @@ However, when N is 0, do not increment the field at all." (let ((org-table-may-need-update nil)) (org-table-next-row)) (org-table-blank-field)) ;; Insert the new field. NEW-FIELD may be nil if - ;; `org-table-increment' is nil, or N = 0. In that case, copy - ;; FIELD. + ;; `org-table-copy-increment' is nil, or N = 0. In that case, + ;; copy FIELD. (insert (or next-field field)) (org-table-maybe-recalculate-line) (org-table-align))) @@ -4084,8 +4084,8 @@ already hidden." "Read column selection select as a list of numbers. SELECT is a string containing column ranges, separated by white -space characters, see `org-table-hide-column' for details. MAX -is the maximum column number. +space characters, see `org-table-toggle-column-width' for details. +MAX is the maximum column number. Return value is a sorted list of numbers. Ignore any number outside of the [1;MAX] range." diff --git a/lisp/org/org-tempo.el b/lisp/org/org-tempo.el index 44b04a9f4be..afa69867f2a 100644 --- a/lisp/org/org-tempo.el +++ b/lisp/org/org-tempo.el @@ -24,7 +24,7 @@ ;;; Commentary: ;; ;; Org Tempo reimplements completions of structure template before -;; point like `org-try-structure-completion' in Org v9.1 and earlier. +;; point in Org v9.1 and earlier. ;; For example, strings like " Date: Sat, 17 Feb 2024 18:53:05 +0200 Subject: Revert "Update to Org 9.6.19" This reverts commit 07a392f445eb21c5e4681027eee9d981300a4309. It was installed by mistake. --- doc/misc/org.org | 22 +++++++++++++++------- etc/refcards/orgcard.tex | 2 +- lisp/org/ol-man.el | 14 -------------- lisp/org/ol.el | 5 ++++- lisp/org/org-compat.el | 2 +- lisp/org/org-id.el | 12 ++++++------ lisp/org/org-lint.el | 7 ++----- lisp/org/org-table.el | 8 ++++---- lisp/org/org-tempo.el | 2 +- lisp/org/org-version.el | 4 ++-- lisp/org/org.el | 10 ++++------ lisp/org/ox-latex.el | 5 ++--- lisp/org/ox-odt.el | 5 ++--- lisp/org/ox.el | 9 +++++---- 14 files changed, 49 insertions(+), 58 deletions(-) diff --git a/doc/misc/org.org b/doc/misc/org.org index 441985c905f..9535eccc1e6 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -16712,7 +16712,6 @@ to HTML, the following links all point to a dedicated anchor in :END: #+cindex: sitemap, of published pages -#+vindex: org-publish-project-alist The following properties may be used to control publishing of a map of files for a given project. @@ -16730,12 +16729,6 @@ a map of files for a given project. Title of sitemap page. Defaults to name of file. -- ~:sitemap-style~ :: - - Can be ~list~ (site-map is just an itemized list of the titles of - the files involved) or ~tree~ (the directory structure of the - source files is reflected in the site-map). Defaults to ~tree~. - - ~:sitemap-format-entry~ :: #+findex: org-publish-find-date @@ -16781,6 +16774,21 @@ a map of files for a given project. Should sorting be case-sensitive? Default ~nil~. +- ~:sitemap-file-entry-format~ :: + + With this option one can tell how a sitemap's entry is formatted in + the sitemap. This is a format string with some escape sequences: + ~%t~ stands for the title of the file, ~%a~ stands for the author of + the file and ~%d~ stands for the date of the file. The date is + retrieved with the ~org-publish-find-date~ function and formatted + with ~org-publish-sitemap-date-format~. Default ~%t~. + +- ~:sitemap-date-format~ :: + + Format string for the ~format-time-string~ function that tells how + a sitemap entry's date is to be formatted. This property bypasses + ~org-publish-sitemap-date-format~ which defaults to ~%Y-%m-%d~. + *** Generating an index :PROPERTIES: :DESCRIPTION: An index that reaches across pages. diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index e1d40d8632f..705ab62d69d 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{9.6.19} +\def\orgversionnumber{9.6.15} \def\versionyear{2023} % latest update \input emacsver.tex diff --git a/lisp/org/ol-man.el b/lisp/org/ol-man.el index d3d7db04700..b6cada1b3c3 100644 --- a/lisp/org/ol-man.el +++ b/lisp/org/ol-man.el @@ -39,27 +39,13 @@ :group 'org-link :type '(choice (const man) (const woman))) -(declare-function Man-translate-references "man" (ref)) (defun org-man-open (path _) "Visit the manpage on PATH. PATH should be a topic that can be thrown at the man command. If PATH contains extra ::STRING which will use `occur' to search matched strings in man buffer." - (require 'man) ; For `Man-translate-references' (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?$" path) (let* ((command (match-string 1 path)) - ;; FIXME: Remove after we drop Emacs 29 support. - ;; Working around security bug #66390. - (command (if (not (equal (Man-translate-references ";id") ";id")) - ;; We are on Emacs that escapes man command args - ;; (see Emacs commit 820f0793f0b). - command - ;; Older Emacs without the fix - escape the - ;; arguments ourselves. - (mapconcat 'identity - (mapcar #'shell-quote-argument - (split-string command "\\s-+")) - " "))) (search (match-string 2 path)) (buffer (funcall org-man-command command))) (when search diff --git a/lisp/org/ol.el b/lisp/org/ol.el index c3b03087842..4c84e62f4c9 100644 --- a/lisp/org/ol.el +++ b/lisp/org/ol.el @@ -291,7 +291,10 @@ or emacs-wiki packages to Org syntax. The function must accept two parameters, a TYPE containing the link protocol name like \"rmail\" or \"gnus\" as a string, and the linked path, which is everything after the link protocol. It should return a cons -with possibly modified values of type and path." +with possibly modified values of type and path. +Org contains a function for this, so if you set this variable to +`org-translate-link-from-planner', you should be able follow many +links created by planner." :group 'org-link-follow :type '(choice (const nil) (function)) :safe #'null) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index c17a100d3c1..33a510cd7f2 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -664,7 +664,7 @@ You could use brackets to delimit on what part the link will be. %t is the title. %a is the author. -%d is the date." +%d is the date formatted using `org-publish-sitemap-date-format'." :group 'org-export-publish :type 'string) (make-obsolete-variable diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index fe7d5f4c1a5..9561f2de184 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -29,13 +29,13 @@ ;; are provided that create and retrieve such identifiers, and that find ;; entries based on the identifier. -;; Identifiers consist of a prefix (given by the variable +;; Identifiers consist of a prefix (default "Org" given by the variable ;; `org-id-prefix') and a unique part that can be created by a number -;; of different methods, see the variable `org-id-method'. Org has a -;; builtin method that uses a compact encoding of the creation time of -;; the ID, with microsecond accuracy. This virtually guarantees -;; globally unique identifiers, even if several people are creating -;; IDs at the same time in files that will eventually be used +;; of different methods, see the variable `org-id-method'. +;; Org has a builtin method that uses a compact encoding of the creation +;; time of the ID, with microsecond accuracy. This virtually +;; guarantees globally unique identifiers, even if several people are +;; creating IDs at the same time in files that will eventually be used ;; together. ;; ;; By default Org uses UUIDs as global unique identifiers. diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el index a503de7d364..dc12ec272fa 100644 --- a/lisp/org/org-lint.el +++ b/lisp/org/org-lint.el @@ -1209,11 +1209,8 @@ Use \"export %s\" instead" (`(,(and (pred symbolp) name) ,(pred string-or-null-p) ,(pred string-or-null-p)) - (unless (or (org-cite-get-processor name) - (progn - (org-cite-try-load-processor name) - (org-cite-get-processor name))) - (list source (format "Unknown cite export processor %S" name)))) + (unless (org-cite-get-processor name) + (list source "Unknown cite export processor %S" name))) (_ (list source "Invalid cite export processor declaration"))) (error diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 92490f9f6bf..6408f48ccbd 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -1922,8 +1922,8 @@ However, when N is 0, do not increment the field at all." (let ((org-table-may-need-update nil)) (org-table-next-row)) (org-table-blank-field)) ;; Insert the new field. NEW-FIELD may be nil if - ;; `org-table-copy-increment' is nil, or N = 0. In that case, - ;; copy FIELD. + ;; `org-table-increment' is nil, or N = 0. In that case, copy + ;; FIELD. (insert (or next-field field)) (org-table-maybe-recalculate-line) (org-table-align))) @@ -4084,8 +4084,8 @@ already hidden." "Read column selection select as a list of numbers. SELECT is a string containing column ranges, separated by white -space characters, see `org-table-toggle-column-width' for details. -MAX is the maximum column number. +space characters, see `org-table-hide-column' for details. MAX +is the maximum column number. Return value is a sorted list of numbers. Ignore any number outside of the [1;MAX] range." diff --git a/lisp/org/org-tempo.el b/lisp/org/org-tempo.el index afa69867f2a..44b04a9f4be 100644 --- a/lisp/org/org-tempo.el +++ b/lisp/org/org-tempo.el @@ -24,7 +24,7 @@ ;;; Commentary: ;; ;; Org Tempo reimplements completions of structure template before -;; point in Org v9.1 and earlier. +;; point like `org-try-structure-completion' in Org v9.1 and earlier. ;; For example, strings like " Date: Sun, 11 Feb 2024 21:26:41 +0000 Subject: Add manual entries for which-key * doc/emacs/display.texi (Display Custom): Briefly introduce which-key. * doc/emacs/help.texi (Key Help): Briefly mention which-key. --- doc/emacs/display.texi | 3 ++- doc/emacs/help.texi | 5 +++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index d2557d6148e..bda57d2b30e 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -2215,7 +2215,8 @@ there is something to echo. @xref{Echo Area}. default), the multi-character key sequence echo shown according to @code{echo-keystrokes} will include a short help text about keys which will invoke @code{describe-prefix-bindings} (@pxref{Misc Help}) to show -the list of commands for the prefix you already typed. +the list of commands for the prefix you already typed. For a related +help facility, see @ref{which-key}. @cindex mouse pointer @cindex hourglass pointer display diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 99a4173ac29..1a76e663657 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -260,6 +260,11 @@ by these buttons, Emacs provides the @code{button-describe} and @code{widget-describe} commands, that should be run with point over the button. +@anchor which-key +@kbd{M-x which-key} is a global minor mode which helps in discovering + keymaps. It displays keybindings following your currently entered + incomplete command (prefix), in a popup. + @node Name Help @section Help by Command or Variable Name -- cgit v1.2.3 From c14a67a80f4263c13db55b6a79fb545b82a8b5b7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 17 Feb 2024 18:57:12 +0200 Subject: ; Fix markup in last change (bug#68929). --- doc/emacs/help.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 1a76e663657..05457a3f34f 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -260,7 +260,7 @@ by these buttons, Emacs provides the @code{button-describe} and @code{widget-describe} commands, that should be run with point over the button. -@anchor which-key +@anchor{which-key} @kbd{M-x which-key} is a global minor mode which helps in discovering keymaps. It displays keybindings following your currently entered incomplete command (prefix), in a popup. -- cgit v1.2.3 From e56f0ef51bfdd0e03e817670754bc813fb3702a2 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Fri, 2 Feb 2024 20:59:41 +0100 Subject: org: Fix security prompt for downloading remote resource * lisp/org.el (org--confirm-resource-safe): Do not assume that resource is safe when user replies "n" (do not download). Reported-by: Max Nikulin Link: https://orgmode.org/list/upj6uk$b7o$1@ciao.gmane.io --- lisp/org/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org/org.el b/lisp/org/org.el index 3075729d01d..c75afbf5a67 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -4685,7 +4685,7 @@ returns non-nil if any of them match." (if (and (= char ?f) current-file) (concat "file://" current-file) uri)) "\\'"))))) - (prog1 (memq char '(?y ?n ?! ?d ?\s ?f)) + (prog1 (memq char '(?y ?! ?d ?\s ?f)) (quit-window t))))))) (defun org-extract-log-state-settings (x) -- cgit v1.2.3 From db5e84af202532b138918295ea6dd1b0ea910d78 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sat, 17 Feb 2024 09:31:50 -0800 Subject: Alias some gnus-specific do-nothing functions Replace with #'always and #'ignore * lisp/gnus/gnus-agent.el: `gnus-agent-true' and `gnus-agent-false' * lisp/gnus/gnus-util.el: `gnus-not-ignore' --- lisp/gnus/gnus-agent.el | 13 +++++-------- lisp/gnus/gnus-util.el | 3 +-- 2 files changed, 6 insertions(+), 10 deletions(-) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 3ee93031119..0928b179787 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -2910,13 +2910,9 @@ The following commands are available: (car func) (gnus-byte-compile `(lambda () ,func))))) -(defun gnus-agent-true () - "Return t." - t) +(defalias 'gnus-agent-true #'always) -(defun gnus-agent-false () - "Return nil." - nil) +(defalias 'gnus-agent-false #'ignore) (defun gnus-category-make-function-1 (predicate) "Make a function from PREDICATE." @@ -2924,8 +2920,9 @@ The following commands are available: ;; Functions are just returned as is. ((or (symbolp predicate) (functionp predicate)) - `(,(or (cdr (assq predicate gnus-category-predicate-alist)) - predicate))) + (let ((fun (or (cdr (assq predicate gnus-category-predicate-alist)) + predicate))) + (if (symbolp fun) `(,fun) `(funcall ',fun)))) ;; More complex predicate. ((consp predicate) `(,(cond diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index b5aa0b02d34..7218c686a2a 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1113,8 +1113,7 @@ sure of changing the value of `foo'." (setq gnus-info-buffer (current-buffer)) (gnus-configure-windows 'info))) -(defun gnus-not-ignore (&rest _args) - t) +(defalias gnus-not-ignore #'always) (defvar gnus-directory-sep-char-regexp "/" "The regexp of directory separator character. -- cgit v1.2.3 From 32c5bdfa971220bae37991a298628605c82f866c Mon Sep 17 00:00:00 2001 From: Jakub Ječmínek Date: Sat, 17 Feb 2024 09:34:36 -0800 Subject: Provide better default value for date in Gnus scoring MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Bug#61002, thanks to Kamil Jońca for reporting * lisp/gnus/gnus-score.el (gnus-summary-score-entry): When scoring on Date header, the default value for the prompt should be number of days between the date of the article under point, and "now". --- lisp/gnus/gnus-score.el | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index bd19e7d7cd7..479b7496cf1 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -893,9 +893,14 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header." (t "permanent")) header (if (< score 0) "lower" "raise")) - (if (numberp match) - (int-to-string match) - match)))) + (cond ((numberp match) (int-to-string match)) + ((string= header "date") + (int-to-string + (- + (/ (car (time-convert (current-time) 1)) 86400) + (/ (car (time-convert (gnus-date-get-time match) 1)) + 86400)))) + (t match))))) ;; If this is an integer comparison, we transform from string to int. (if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) -- cgit v1.2.3 From 20997aa20728a6fc2a3de736e9fc718b97dcef99 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sat, 17 Feb 2024 19:20:42 +0100 Subject: ; Fix typo from commit 32c5bdfa971 * lisp/gnus/gnus-util.el (gnus-not-ignore): Quote the argument to defalias. --- lisp/gnus/gnus-util.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 7218c686a2a..0b0a9bbfc1d 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1113,7 +1113,7 @@ sure of changing the value of `foo'." (setq gnus-info-buffer (current-buffer)) (gnus-configure-windows 'info))) -(defalias gnus-not-ignore #'always) +(defalias 'gnus-not-ignore #'always) (defvar gnus-directory-sep-char-regexp "/" "The regexp of directory separator character. -- cgit v1.2.3 From 9e56bd5ed8775f53c3025b114525cee7c578e2d0 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 11 Feb 2024 18:38:13 +0100 Subject: Removed decommissioned PGP keyservers * lisp/epa-ks.el (epa-keyserver): Update the user option type of `epa-keyserver'. See https://mail.gnu.org/archive/html/emacs-devel/2023-11/msg00857.html. --- lisp/epa-ks.el | 3 --- 1 file changed, 3 deletions(-) diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el index c3c11bb0b0b..13840da0bd9 100644 --- a/lisp/epa-ks.el +++ b/lisp/epa-ks.el @@ -47,11 +47,8 @@ This is used by `epa-search-keys', for looking up public keys." (repeat :tag "Random pool" (string :tag "Keyserver address")) (const "keyring.debian.org") - (const "keys.gnupg.net") (const "keyserver.ubuntu.com") (const "pgp.mit.edu") - (const "pool.sks-keyservers.net") - (const "zimmermann.mayfirst.org") (string :tag "Custom keyserver")) :version "28.1") -- cgit v1.2.3 From 5a64d2c7595dc393504c6eee9321d74dbd8ae9e2 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sat, 17 Feb 2024 22:34:55 +0200 Subject: java-ts-mode: Indentation for opening brace on a separate line * lisp/progmodes/java-ts-mode.el (java-ts-mode--indent-rules): Support putting the opening brace on a separate line (bug#67556). * test/lisp/progmodes/java-ts-mode-resources/indent.erts: Add a test. --- lisp/progmodes/java-ts-mode.el | 13 ++++++--- .../progmodes/java-ts-mode-resources/indent.erts | 31 ++++++++++++++++++++++ 2 files changed, 40 insertions(+), 4 deletions(-) diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 52d025e365a..5c4bce340f0 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -74,7 +74,12 @@ ((parent-is "program") column-0 0) ((match "}" "element_value_array_initializer") parent-bol 0) - ((node-is "}") column-0 c-ts-common-statement-offset) + ((node-is + ,(format "\\`%s\\'" + (regexp-opt '("constructor_body" "class_body" "interface_body" + "block" "switch_block" "array_initializer")))) + parent-bol 0) + ((node-is "}") standalone-parent 0) ((node-is ")") parent-bol 0) ((node-is "else") parent-bol 0) ((node-is "]") parent-bol 0) @@ -86,10 +91,10 @@ ((parent-is "array_initializer") parent-bol java-ts-mode-indent-offset) ((parent-is "annotation_type_body") column-0 c-ts-common-statement-offset) ((parent-is "interface_body") column-0 c-ts-common-statement-offset) - ((parent-is "constructor_body") column-0 c-ts-common-statement-offset) + ((parent-is "constructor_body") standalone-parent java-ts-mode-indent-offset) ((parent-is "enum_body_declarations") parent-bol 0) ((parent-is "enum_body") column-0 c-ts-common-statement-offset) - ((parent-is "switch_block") column-0 c-ts-common-statement-offset) + ((parent-is "switch_block") standalone-parent java-ts-mode-indent-offset) ((parent-is "record_declaration_body") column-0 c-ts-common-statement-offset) ((query "(method_declaration (block _ @indent))") parent-bol java-ts-mode-indent-offset) ((query "(method_declaration (block (_) @indent))") parent-bol java-ts-mode-indent-offset) @@ -125,7 +130,7 @@ ((parent-is "case_statement") parent-bol java-ts-mode-indent-offset) ((parent-is "labeled_statement") parent-bol java-ts-mode-indent-offset) ((parent-is "do_statement") parent-bol java-ts-mode-indent-offset) - ((parent-is "block") column-0 c-ts-common-statement-offset))) + ((parent-is "block") standalone-parent java-ts-mode-indent-offset))) "Tree-sitter indent rules.") (defvar java-ts-mode--keywords diff --git a/test/lisp/progmodes/java-ts-mode-resources/indent.erts b/test/lisp/progmodes/java-ts-mode-resources/indent.erts index 4fca74dd2e1..514d2e08977 100644 --- a/test/lisp/progmodes/java-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/java-ts-mode-resources/indent.erts @@ -110,3 +110,34 @@ public class Java { } } =-=-= + +Name: Opening bracket on separate line (bug#67556) + +=-= +public class Java { + void foo( + String foo) + { + for (var f : rs) + return new String[] + { + "foo", + "bar" + }; + if (a == 0) + { + return 0; + } else if (a == 1) + { + return 1; + } + + switch(expr) + { + case x: + // code block + break; + } + } +} +=-=-= -- cgit v1.2.3 From 37bb33dae791e5f59f1d0d27c0221db3b3b4c16d Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 15 Feb 2024 18:45:29 -0800 Subject: Adjust to yesterday’s Gnulib nstrftime changes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Bruno Haible fixed Gnulib so that nstrftime no longer requires locking code, which means we no longer need to avoid localename. However, nstrftime now requires localename-unsafe-limited which pulls in some Gnulib-specific locale code, and it’s likely this needs to be replaced with Emacs-specific locale code. In the meantime let’s continue to finess this by avoiding localename-unsafe-limited. * admin/merge-gnulib (AVOIDED_MODULES): Avoid localename-unsafe-limited instead of localename. --- admin/merge-gnulib | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 35966852e27..41531d573b0 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -53,7 +53,7 @@ GNULIB_MODULES=' AVOIDED_MODULES=' access btowc chmod close crypto/af_alg dup fchdir fstat - iswblank iswctype iswdigit iswxdigit langinfo localename lock + iswblank iswctype iswdigit iswxdigit langinfo localename-unsafe-limited lock mbrtowc mbsinit memchr mkdir msvc-inval msvc-nothrow nl_langinfo openat-die opendir pthread-h raise save-cwd select setenv sigprocmask stat stdarg -- cgit v1.2.3 From bd0e281a6a27c048b12847811bc0385acbaa1eec Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 17 Feb 2024 15:58:03 -0800 Subject: Update from Gnulib by running admin/merge-gnulib --- lib/gnulib.mk.in | 2 +- lib/strftime.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 9970f7810e2..711ddcf1260 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -47,7 +47,7 @@ # --avoid=iswdigit \ # --avoid=iswxdigit \ # --avoid=langinfo \ -# --avoid=localename \ +# --avoid=localename-unsafe-limited \ # --avoid=lock \ # --avoid=mbrtowc \ # --avoid=mbsinit \ diff --git a/lib/strftime.c b/lib/strftime.c index c7256c3d354..128176cad40 100644 --- a/lib/strftime.c +++ b/lib/strftime.c @@ -401,7 +401,7 @@ should_remove_ampm (void) lt lv mg mhr mi mk mn ms mt nb nds nhn nl nn nr nso oc os pap pl pt ro ru rw sah sc se sgs sk sl sm sr ss st su sv szl tg tk tn ts tt ug uk unm uz ve wae wo xh zu */ - const char *loc = gl_locale_name (LC_TIME, "LC_TIME"); + const char *loc = gl_locale_name_unsafe (LC_TIME, "LC_TIME"); bool remove_ampm = false; switch (loc[0]) { -- cgit v1.2.3 From c2d714886ef139f601d89463675b0d5b49d18ff9 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 18 Feb 2024 12:48:41 +0800 Subject: Implement tooltip_reuse_hidden_frame for Android * java/org/gnu/emacs/EmacsWindow.java (findSuitableActivityContext): Return Activity rather than Context. (mapWindow): Provide window token manually. * src/androidfns.c (Fx_show_tip, Fx_hide_tip): Respect tooltip_reuse_hidden_frame. --- java/org/gnu/emacs/EmacsWindow.java | 27 +++++++++++++++---- src/androidfns.c | 53 ++++++++++++++++++++++++++++++++++++- 2 files changed, 74 insertions(+), 6 deletions(-) diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index 978891ba619..427a1a92332 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java @@ -27,6 +27,8 @@ import java.util.HashMap; import java.util.LinkedHashMap; import java.util.Map; +import android.app.Activity; + import android.content.ClipData; import android.content.ClipDescription; import android.content.Context; @@ -362,6 +364,9 @@ public final class EmacsWindow extends EmacsHandleObject requestViewLayout (); } + /* Return WM layout parameters for an override redirect window with + the geometry provided here. */ + private WindowManager.LayoutParams getWindowLayoutParams () { @@ -384,15 +389,15 @@ public final class EmacsWindow extends EmacsHandleObject return params; } - private Context + private Activity findSuitableActivityContext () { /* Find a recently focused activity. */ if (!EmacsActivity.focusedActivities.isEmpty ()) return EmacsActivity.focusedActivities.get (0); - /* Return the service context, which probably won't work. */ - return EmacsService.SERVICE; + /* Resort to the last activity to be focused. */ + return EmacsActivity.lastFocusedActivity; } public synchronized void @@ -416,7 +421,7 @@ public final class EmacsWindow extends EmacsHandleObject { EmacsWindowAttachmentManager manager; WindowManager windowManager; - Context ctx; + Activity ctx; Object tem; WindowManager.LayoutParams params; @@ -447,11 +452,23 @@ public final class EmacsWindow extends EmacsHandleObject activity using the system window manager. */ ctx = findSuitableActivityContext (); + + if (ctx == null) + { + Log.w (TAG, "failed to attach override-redirect window" + + " for want of activity"); + return; + } + tem = ctx.getSystemService (Context.WINDOW_SERVICE); windowManager = (WindowManager) tem; - /* Calculate layout parameters. */ + /* Calculate layout parameters and propagate the + activity's token into it. */ + params = getWindowLayoutParams (); + params.token = (ctx.findViewById (android.R.id.content) + .getWindowToken ()); view.setLayoutParams (params); /* Attach the view. */ diff --git a/src/androidfns.c b/src/androidfns.c index ea3d5f71c7c..0675a0a3c98 100644 --- a/src/androidfns.c +++ b/src/androidfns.c @@ -2287,6 +2287,57 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, goto start_timer; } + else if (tooltip_reuse_hidden_frame && BASE_EQ (frame, tip_last_frame)) + { + bool delete = false; + Lisp_Object tail, elt, parm, last; + + /* Check if every parameter in PARMS has the same value in + tip_last_parms. This may destruct tip_last_parms which, + however, will be recreated below. */ + for (tail = parms; CONSP (tail); tail = XCDR (tail)) + { + elt = XCAR (tail); + parm = CAR (elt); + /* The left, top, right and bottom parameters are handled + by compute_tip_xy so they can be ignored here. */ + if (!EQ (parm, Qleft) && !EQ (parm, Qtop) + && !EQ (parm, Qright) && !EQ (parm, Qbottom)) + { + last = Fassq (parm, tip_last_parms); + if (NILP (Fequal (CDR (elt), CDR (last)))) + { + /* We lost, delete the old tooltip. */ + delete = true; + break; + } + else + tip_last_parms + = call2 (Qassq_delete_all, parm, tip_last_parms); + } + else + tip_last_parms + = call2 (Qassq_delete_all, parm, tip_last_parms); + } + + /* Now check if every parameter in what is left of + tip_last_parms with a non-nil value has an association in + PARMS. */ + for (tail = tip_last_parms; CONSP (tail); tail = XCDR (tail)) + { + elt = XCAR (tail); + parm = CAR (elt); + if (!EQ (parm, Qleft) && !EQ (parm, Qtop) && !EQ (parm, Qright) + && !EQ (parm, Qbottom) && !NILP (CDR (elt))) + { + /* We lost, delete the old tooltip. */ + delete = true; + break; + } + } + + android_hide_tip (delete); + } else android_hide_tip (true); } @@ -2453,7 +2504,7 @@ DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0, #endif /* 0 */ return Qnil; #else /* !ANDROID_STUBIFY */ - return android_hide_tip (true); + return android_hide_tip (!tooltip_reuse_hidden_frame); #endif /* ANDROID_STUBIFY */ } -- cgit v1.2.3 From aa8baf77b47e3de114f5dc5e9aaa987bb96ed248 Mon Sep 17 00:00:00 2001 From: Jean-Christophe Helary Date: Sun, 18 Feb 2024 00:04:18 +0900 Subject: Add README file about translations of Emacs manuals * doc/README: New file. --- doc/README | 204 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 204 insertions(+) create mode 100644 doc/README diff --git a/doc/README b/doc/README new file mode 100644 index 00000000000..81b54c91a76 --- /dev/null +++ b/doc/README @@ -0,0 +1,204 @@ +* Translating the Emacs manuals + +** Copyright assignment + +People who contribute translated documents should provide a copyright +assignment to the Free Software Foundation. See the 'Copyright +Assignment' section in the Emacs manual. + + +** Translated documents license + +The translated documents are distributed under the same license as the +original documents: the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation. + +See https://www.gnu.org/licenses/fdl-1.3.html for more information. + +If you have questions regarding the use of the FDL license in your +translation work that are not answered in the FAQ, do not hesitate to +contact the GNU project: https://www.gnu.org/contact/ + +** Location + +*** Texinfo source files + +The source files of the translated manuals are located in the doc/ +directory, under the directory whose name corresponds to the translated +language. + + E.g. French manuals sources are found under doc/fr. + +The structure of the language folders should match the structure of the +English manuals (i.e. include misc, man, lispref, lispintro, emacs). + +*** built files + +Translated deliverables in info format are built at release time and are +made available for local installation. + + +** Format + +The manuals and their translations are written in the Texinfo format +(with the exception of the org-mode manual that is written in org-mode +and of illustrations for the Introduction to Emacs Lisp Programming that +are written in eps). + +See https://www.gnu.org/software/Texinfo/ for more information. + +You should install the Texinfo utilities to be able to verify the +translated files, and refer to the Texinfo manual if you do not +understand the meaning of the various Texinfo declarations. + +Emacs has a Texinfo mode that properly highlights the Texinfo code to +make it easier to see which parts are text to be translated and which +parts are not. + + +*** Texinfo specific issues + +Until the Emacs/Texinfo projects provide better solutions, here are a +few rules to follow: + +- Under each @node, add an @anchor that has the same content at the +original English @node. + +- Translate the @node content but leave the @anchor in English. + +- Most Emacs manuals are set to include the docstyle.Texi file. This +file adds the @documentencoding UTF-8 directive to the targeted manual. +There is no need to add this directive in a manual that includes +docstyle.Texi. + +- Add a @documentlanguage directive that includes your language. + + E.g. @documentlanguage zh + +This directive has currently little effect but will be useful in the +future. + +- The @author directive can be used for the translator's name. + + E.g. @author traduit en français par Achile Talon + + +** Fixing the original document + +During the course of the translation, you might find parts of the +original document that need to be updated or otherwise fixed, or even +bugs in Emacs. If you do not intend to provide fixes right away, please +file a bug report promptly so someone can fix it soon. + +See the 'Bugs' section in the Emacs manual. + +** Sending contributions + +Send your contributions (either files or revisions) to +emacs-devel@gnu.org for review. + +Always send contributions in the format of the original document. Most +of the contents in the Emacs manuals are in Texinfo format, so do not +send contributions that are in derivative formats (e.g. info, html, +docbook, plain text, etc.) + +Before sending files for review, ensure that they have been properly +checked for spelling/grammar/typography by at least using the tools that +Emacs provides. + +You should also make sure that the Texinfo files build properly on your +system. + +Send your contributions as patches (git diff -p --stat), and prefer the +git format-patch form because the format allows easier review and easier +installation of the changes by someone with write access to the +repository. + +The Emacs project has a lot of coding, documentation and commenting +conventions. Sending such patches allows the project managers to make +sure that the contributions comply with the various conventions. + + +** Discussing translation issues + +Translation-related discussions are welcome on the emacs-devel list. +Discussions specific to your language do not have to take place in +English. + + +** Translation teams + +The number of words in the Emacs manuals is above 2,000,000 words and +growing. While one individual could theoretically translate all the +files, it is more practical to work in language teams. + +If you have a small group of translators willing to help, make sure that +the files are properly reviewed before sending them to emacs-devel (see +above). + +You are invited to refer to the translation-related documents that the +GNU Project maintains and to get in touch with your language's +translation team to learn from the practices they have developed over +the years. + +See https://www.gnu.org/server/standards/README.translations.html for +more information. + + +** Translation processes + +Emacs does not yet provide tools that significantly help the translation +process. A few useful functions would be + +- automatic lookup of a list of glossary items when starting to work on +a translation "unit" (paragraph or otherwise), such glossary terms +should be easily insertable at point, + +- automatic lookup of past translations to check for similarity and +improve homogeneity over the whole document set, such past translation +matches should be easily insertable at point, + +etc. + + +*** Using the PO format as an intermediate translation format + +Although the PO format has not been developed with documentation in +mind, it is well known among free software translation teams and you can +easily use the po4a utility to convert Texinfo to PO for work in +translation tools that support the PO format. + +See https://po4a.org for more information. + +However, regardless of the intermediate file format that you might use, +you should only send Texinfo files for review to emacs-devel. + + +*** Free tools that you can use in your processes + +A number of free software tools exist, outside the Emacs ecosystem, to +help translators (amateurs and professionals alike) with the translation +process. + +If you find that Emacs should implement some of their features, you are +welcome to provide patches to the Emacs project. + +Such tools include: + +- the GNOME Translation Editor, https://wiki.gnome.org/Apps/Gtranslator/ +- KDE's Lokalize, https://apps.kde.org/lokalize/ +- OmegaT, http://omegat.org +- the Okapi Framework, https://www.okapiframework.org +- pootle, https://pootle.translatehouse.org + +etc. + + +* Licence of this document + +Copyright (C) 2024 Free Software Foundation, Inc. + +Copying and distribution of this file, with or without modification, are +permitted in any medium without royalty provided the copyright notice +and this notice are preserved. This file is offered as-is, without any +warranty. -- cgit v1.2.3 From a58bcb96ac898d218b3169e76db798f192107d52 Mon Sep 17 00:00:00 2001 From: Jean-Christophe Helary Date: Sun, 18 Feb 2024 00:02:09 +0900 Subject: Move French translations to the top-level doc/ directory. --- doc/fr/misc/ses-fr.texi | 1631 ++++++++++++++++++++++++++++++++++++++++++ doc/lang/fr/misc/ses-fr.texi | 1631 ------------------------------------------ 2 files changed, 1631 insertions(+), 1631 deletions(-) create mode 100644 doc/fr/misc/ses-fr.texi delete mode 100644 doc/lang/fr/misc/ses-fr.texi diff --git a/doc/fr/misc/ses-fr.texi b/doc/fr/misc/ses-fr.texi new file mode 100644 index 00000000000..e1b9cac5fc3 --- /dev/null +++ b/doc/fr/misc/ses-fr.texi @@ -0,0 +1,1631 @@ +\input texinfo @c -*- mode: texinfo; coding: utf-8; -*- +@c %**start of header +@setfilename ../../../../info/ses-fr.info +@documentlanguage fr +@documentencoding UTF-8 +@settitle @acronym{SES}: Le tableur simple d’Emacs +@include docstyle.texi +@setchapternewpage off +@syncodeindex fn cp +@syncodeindex vr cp +@syncodeindex ky cp +@c %**end of header + +@copying +Ce fichier documente @acronym{SES} : le tableur simple d’Emacs (Simple +Emacs Spreadsheet). + +Copyright @copyright{} 2002--2024 Free Software Foundation, Inc. + +@quotation +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with no +Invariant Sections, with the Front-Cover Texts being ``A GNU Manual,'' +and with the Back-Cover Texts as in (a) below. A copy of the license +is included in the section entitled ``GNU Free Documentation License.'' + +(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and +modify this GNU manual.'' +@end quotation +@end copying + +@dircategory Emacs misc features +@direntry +* @acronym{SES}-fr: (ses-fr). Le tableur simple d’Emacs. +@end direntry + +@finalout + +@titlepage +@title @acronym{SES} +@subtitle Le tableur simple d’Emacs +@author Jonathan A. Yavner +@author @email{jyavner@@member.fsf.org} + +@page +@vskip 0pt plus 1filll +@insertcopying +@end titlepage + +@contents + +@c =================================================================== + +@ifnottex +@node Top +@comment node-name, next, previous, up +@top @acronym{SES}: Simple Emacs Spreadsheet + +@display +@acronym{SES} est mode majeur de GNU Emacs pour éditer des fichiers +tableur, c.-à-d.@: des fichiers contenant une grille rectangulaire de +cellules. Les valeurs des cellules sont spécifiées par des formules +pouvant se référer aux valeurs d’autres cellules. +@end display +@end ifnottex + +Pour les rapports d’anomalie, utiliser @kbd{M-x report-emacs-bug}. + +@insertcopying + +@menu +* Boniment: Sales Pitch. Pourquoi utiliser @acronym{SES}? +* Tuto: Quick Tutorial. Une introduction sommaire +* Les bases: The Basics. Les commandes de base du tableur +* Fonctions avancées: Advanced Features. Vous voulez en savoir plus ? +* Pour les gourous: For Gurus. Vous voulez en savoir @emph{encore plus} ? +* Index: Index. Index des concepts, fonctions et variables +* Remerciements: Acknowledgments. Remerciements +* Licence GNU pour la documentation libre: GNU Free Documentation License. La licence de cette documentation. +@end menu + +@c =================================================================== + +@node Sales Pitch +@comment node-name, next, previous, up +@chapter Boniment +@cindex features + +@itemize -- +@item Créer et éditer des feuilles de calcul avec un minimum de tracas. +@item Prise en charge complète du Défaire/Refaire/Sauvegarde auto. +@item Protection contre les virus enfouis dans les feuilles de calcul. +@item Les formules de cellule sont directement du code Emacs Lisp. +@item Fonctions d’impression pour contrôler l’apparence des cellules. +@item Raccourcis clavier intuitifs : C-o = insérer une ligne, M-o = insérer une colonne, etc. +@item « Débordement » des valeurs de cellule longues dans les cellules vides suivantes. +@item La ligne d’en-tête montre les lettres désignant les colonnes. +@item Autocomplétion pour la saisie des symboles de cellules nommées lors de la saisie des formules. +@item Couper, copier et coller peut transferer les formules et les fonctions d’impression. +@item Import and export de valeurs séparées par des tabulations, ou de formules séparées par des tabulations. +@item Format de fichier en texte, facile à bidouiller. +@end itemize + +@c =================================================================== + +@node Quick Tutorial +@chapter Tuto +@cindex introduction +@cindex tuto + +Si vous désirez être rapidement lancé et pensez que vous savez ce que +vous attendez d’un tableur simple, alors ce chapitre peut être tout ce +dont vous avez besoin. + +Premièrement, visitez un nouveau fichier avec pour extension de nom de +fichier @file{.ses}. Emacs vous présente alors une feuille de calcul +vide contenant une seule cellule. + +Commencez par saisir une ligne d’en-tête : @kbd{"Revenu@key{RET}}. Le +guillemet double @code{"} indique que vous saisissez une cellule +textuelle, il ne fait pas partie de la valeur de la cellule, et aucun +guillemet de fermeture n’est nécessaire. + +Pour insérer votre première valeur de revenu, vous devez d’abord +redimensionner la feuille. Appuyer sur la touche @key{TAB} pour +ajouter une nouvelle cellule et revenez à elle en remontant. +Saisissez un nombre, tel que @samp{2.23}. Puis continuer pour ajouter +quelques valeurs supplémentaires de revenu, par ex. : + +@example +@group +A + Revenu + 2.23 + 0.02 + 15.76 + -4.00 +@end group +@end example + +Pour additionner les valeurs entre elles, saisissez une expression +Lisp : + +@example +(+ A2 A3 A4 A5) +@end example + +Peut-être désirez vous ajouter une cellule à la droite de la cellule +@samp{A4} pour expliquer pourquoi vous avez une valeur négative. En +appuyant sur @kbd{TAB} dans cette cellule vous ajouter entièrement une +nouvelle colonne @samp{B} où vous pourrez ajouter une telle note. + +La colonne est assez étroite par défaut, mais en appuyant sur @kbd{w} +vous pouvez la redimensionner selon vos besoins. Faites la de 22 +caractères de large. Vous pouvez maintenant ajoutez des notes +descriptives pour chacune des cases, par ex.@: : + +@example +@group +A B + Revenu + 2.23 Frais de consultation + 0.02 Opinion informée + 15.76 Stand limonade + -4 Prêt à Joseph + 14.01 Total +@end group +@end example + +Par défaut, l’impression des valeurs de cellule se fait alignée à +droite, c’est la raison d’un tel alignement pour les notes dans la +colonne @samp{B}. Pour changer cela, vous pouvez saisir une fonction +d’impression pour la colonne entière, en utilisant par ex. @kbd{M-p +("%s")}. Le fait que @code{"%s"} soit contenu dans une liste indique à +@acronym{SES} que l’alignement est à faire à gauche. Vous pouvez +l’emporter sur la fonction d’impression de colonne pour l’une +quelconque de ses cellules en donnant une fonction d’impression par +cellule avec @kbd{p}. + +Vous pouvez nommer une fonction d’impression, et utiliser le nom de la +fonction à la place de sa définition, de sorte à faciliter la +modification de l’impression de toutes les cellules utilisant cette +fonction. Par exemple tapez @kbd{M-x +ses-define-local-printer@key{ret}}, puis @kbd{note@key{ret}}, puis +@kbd{("%s")} pour définir une fonction d’impression nommée @code{note} +dont la définition est @code{("%s")}, puis sur la colonne @samp{B} tapez +@kbd{M-p note@key{ret}} + +@example +@group +A B + Revenu + 2.23 Frais de consultation + 0.02 Opinion informée + 15.76 Stand limonade + -4 Prêt à Joseph + 14.01 Total +@end group +@end example + +Si maintenant vous redéfinissez @code{note} avec pour nouvelle +définition @kbd{("*%s")} qui ajoute un astérisque @code{*} devant le +texte, la zone d’impression est modifiée ainsi : +@example +@group +A B + Revenu + 2.23 *Frais de consultation + 0.02 *Opinion informée + 15.76 *Stand limonade + -4 *Prêt à Joseph + 14.01 *Total +@end group +@end example + +Notez que la cellule @samp{B1} reste affichée vide et n’est pas +affichée comme @samp{*}. C’est parce que la valeur de la cellule est +@code{nil}, et que les fonctions d’impression définies à partir d’une +chaîne de formatage comme @code{"%s"} dans @code{("%s")} impriment +systématiquement @code{nil} comme une chaîne vide, et tentent +d’imprimer toute valeur non-@code{nil} en utilisant la fonction +standarde @code{format} avec la chaîne de formatage, et si cela +échoue, utilisent la fonction de repli @code{ses-prin1} la place. + +Si maintenant Joseph rembourse son prêt, vous pourriez effacer cette +case ; par ex.@: en positionnant le curseur sur la cellule A5 et en +appuyant sur @kbd{C-d}. Si vous faites celle le total imprimé dans la +cellule A6 affichera @samp{######}. La raison de cela est la valeur +dans une cellule vide est typiquement @code{nil} et que l’opérateur +@code{+} ordinaire échoue à gérer une telle valeur. Au lieu de vider +la cellule, vous pourriez littéralement saisir @samp{0}, ou supprimer +entièrement la ligne en utilisant @kbd{C-k}. Une alternative est +d’utiliser la fonction spéciale @code{ses+} au lieu du @code{+} +ordinaire : + +@example +(ses+ A2 A3 A4 A5) +@end example + +Pour rendre une formule robuste au changement de géométrie de la +feuille, vous pouvez utiliser la macro @code{ses-range} pour faire +référence à une plage de cellules par ses extrémités, par ex. : + +@example +(apply 'ses+ (ses-range A2 A5)) +@end example + +(Le @code{apply} est nécessaire parce que @code{ses-range} produite +une @emph{liste} de valeurs, ce qui ouvre des possibilités plus +complexes). + +Alternativement vous pouvez utiliser le modificateur @code{!} de +@code{ses-range} pour retirer les cellules vides de la liste renvoyée, +ce qui permet d’utiliser @code{+} au lieu de @code{ses+}: + +@lisp +(apply '+ (ses-range A2 A5 !)) +@end lisp + +@c =================================================================== + +@node The Basics +@comment node-name, next, previous, up +@chapter Les bases +@cindex commandes de base +@cindex base, commandes de +@findex ses-jump +@findex ses-mark-row +@findex ses-mark-column +@findex ses-mark-whole-buffer +@findex set-mark-command +@findex keyboard-quit + +Pour créer une nouveau tableur, visitez un fichier inexistant dont le +nom se termine en @file{.ses}. Par exemple, @kbd{C-x C-f essai.ses +@key{ret}}. + + +Un @dfn{identificateur de cellule} est un symbole avec une lettre de +colonne et un numéro de ligne. La cellule B7 est la 2e column de la +7e ligne. Pour les feuilles très larges, il ya deux lettres de +colonne : la cellule AB7 les la 28e colonne de la 7e ligne. Les +feuilles encore plus larges ont AAA1, etc. On se déplace avec les +commandes ordinaires de déplacement d’Emacs. + +@table @kbd +@item j +Déplace le point vers la cellule spécifiée par identificateur +(@code{ses-jump}). À moins que la cellule ne soit une cellule +renommée, l’identificateur est insensible à la casse. Un argument +préfixe @math{n} déplace vers la cellule de coordonnées @math{(n\div +R, n \% C)} pour une feuille de @math{R} ligne et @math{C} colonnes, +et @samp{A1} étant aux coordonnées @math{(0,0)}. La façon dont +l’identificateur ou l’argument préfixe de commande sont interprétés +peut être personnalisée via les variables +@code{ses-jump-cell-name-function} et @code{ses-jump-prefix-function}. +@end table + +Le Point est toujours sur le bord de gauche d’une cellule, ou à la fin +de ligne vide. Quand la marque est inactive, la cellule courante est +soulignée. Quand la marque est active, la plage est le rectangle de +cellules mis en vedette (@acronym{SES} utilise toujours le mode de +marque transitoire). Faire glisser la souris de @samp{A1} à @samp{A3} +crée la plage @samp{A1-A2}. Beaucoup de commandes @acronym{SES} +opèrent seulement sur une seule cellule, et non sur une plage. + +@table @kbd +@item C-@key{SPC} +@itemx C-@@ +Règle la marque au point (@code{set-mark-command}). + +@item C-g +Désactive la marque (@code{keyboard-quit}). + +@item M-h +Met en vedette la ligne courante (@code{ses-mark-row}). + +@item S-M-h +Met en vedette la colonne courante (@code{ses-mark-column}). + +@item C-x h +Mettre en vedette toutes les cellules (@code{mark-whole-buffer}). +@end table + +@menu +* Formules: Formulas. +* Redimensionner: Resizing. +* Fonctions d’impression: Printer functions. +* Effacer des cellules: Clearing cells. +* Copier/couper/coller: Copy/cut/paste. +* Personnaliser @acronym{SES}: Customizing @acronym{SES}. +@end menu + +@node Formulas +@section Formules de cellule +@cindex formules +@cindex formules, saisire +@cindex valeurs +@cindex valeurs de cellule +@cindex éditer des cellules +@findex ses-read-cell +@findex ses-read-symbole +@findex ses-edit-cell +@findex ses-recalculate-cell +@findex ses-recalculate-all + +Pour insérer une valeur dans une cellule, tapez juste une expression +numérique, un @samp{"texte entre guillemets anglais"}, ou une +expression Lisp. + +@table @kbd +@item 0..9 +Auto-insérer un nombre (@code{ses-read-cell}). + +@item - +Auto-insérer un nombre négatif (@code{ses-read-cell}). + +@item . +Auto-insérer un nombre décimal (@code{ses-read-cell}). + +@item " +Auto-insérer une chaîne de caractères. Le guillemet anglais de +terminaison est inséré automatiquement (@code{ses-read-cell}). + +@item ( +Auto-insérer une expression. La parenthèse de droite est insérée +automatiquement (@code{ses-read-cell}). Pour accéder à la valeur +d’une autre cellule, il suffit d’utiliser son identificateur dans +votre expression. Dès que l’autre cellule change, la formule de cette +cellule-ci est réévaluée. En tapant l’expression, vous pouvez +utiliser les raccourcis clavier suivants : +@table @kbd +@item M-@key{TAB} +pour compléter les noms de symboles, et +@item C-h C-n +pour lister les symboles de cellules renommées dans un tampon d’aide. +@end table + +@item ' @r{(apostrophe)} +Entrer un symbole (@code{ses-read-symbol}). @acronym{SES} se souvient +de tous les symboles qui ont été utilisés comme formules, de sorte que +vous pouvez taper juste le début d’un symbole et utiliser +@kbd{@key{SPC}}, @kbd{@key{TAB}}, et @kbd{?} pour le compléter. +@end table + +Pour saisire quelque-chose d’autre (par ex., un vecteur), commencer +avec un chiffre, puis effacer le chiffre et tapez ce que vous désirez. + +@table @kbd +@item @key{RET} +Édite la formule existante dans la cellule courante (@code{ses-edit-cell}). + +@item C-c C-c +Force le recalcul de la cellule ou plage courante (@code{ses-recalculate-cell}). + +@item C-c C-l +Recalcule la feuille entière (@code{ses-recalculate-all}). +@end table + +@node Resizing +@section Redimensionner la feuille +@cindex redimensionner des feuilles +@cindex dimensions +@cindex ligne, ajout ou suppression +@cindex colonne, ajout ou suppression +@cindex ajouter des lignes ou colonnes +@cindex insérer des lignes ou colonnes +@cindex enlever des lignes ou colonnes +@cindex supprimer des lignes ou colonnes +@findex ses-insert-row +@findex ses-insert-column +@findex ses-delete-row +@findex ses-delete-column +@findex ses-set-column-width +@findex ses-forward-or-insert +@findex ses-append-row-jump-first-column + + +Commande de base : + +@table @kbd +@item C-o +(@code{ses-insert-row}) + +@item M-o +(@code{ses-insert-column}) + +@item C-k +(@code{ses-delete-row}) + +@item M-k +(@code{ses-delete-column}) + +@item w +(@code{ses-set-column-width}) + +@item @key{TAB} +Déplace le point sur la prochaine cellule vers la droite, ou insère +une nouvelle colonne si on est déjà sur la dernière cellule de la +ligne, ou insère une nouvelle ligne si on est sur la ligne de +terminaison (@code{ses-forward-or-insert}). + +@item C-j +Insère une nouvelle ligne sous la ligne courante et va à la colonne A +de cette ligne (@code{ses-append-row-jump-first-column}). +@end table + +En redimensionnant la feuille (à moins que vous ne fassiez que changer +la largeur d’une colonne) les références de cellule au sein des +formules sont toutes relocalisées de sorte à continuer à faire +référence aux mêmes cellules. Si une formule mentionne B1 et que vous +insérez une nouvelle première ligne, alors la formule mentionnera B2. + +Si vous supprimez une cellule à laquelle une formule fait référence, +le symbole de cellule est supprimé de la formule, de sorte que +@code{(+ A1 B1 C1)} après suppression de la troisième colonne devient +@code{(+ A1 B1)}. Au cas où cela ne serait pas ce que vous désiriez : + +@table @kbd +@item C-_ +@itemx C-x u +Défait l’action action précédente (@code{(undo)}). +@end table + + +@node Printer functions +@section Fonctions d’impression +@cindex fonctions d’impression +@cindex formatage de cellule +@cindex cellules, formater + +Les fonctions d’impression convertissent des valeurs binaires de +cellule en formes d’impression qu’Emacs affiche à l’écran. + +@menu +* Différents types de fonctions d’impression: Various kinds of printer functions. +* Configurer quelle fonction d’impression s’applique: Configuring what printer function applies. +* Les fonctions d’impression standardes: Standard printer functions. +* Les fonctions d’impression locales: Local printer functions. +* Écrire une fonctions d’impression lambda: Writing a lambda printer function. +@end menu + +@node Various kinds of printer functions +@subsection Différents types de fonctions d’impression + +Lorsque on configure quelle fonction d’impression s’applique +(@pxref{Configuring what printer function applies}), on peut saisir +une fonction d’impression comme l’une des possibilités suivantes : + +@itemize +@item +Une chaîne de formatage, telle que @samp{"$%.2f"}. la chaîne formatée +résultante est alignée à droite au sein de la cellule +d’impression. Pour obtenir un alignement à gauche, utilisez des +parenthèses : @samp{("$%.2f")}. +@item +Une fonction d’impression peut aussi être une fonction à un argument +dont la valeur renvoyée est une chaîne (pour obtenir un alignement à +droite) ou une liste d’une chaîne (pour obtenir un alignement à +gauche). Une telle fonction peut à son tour être configurée comme : +@itemize +@item +Une expression lambda, par exemple : + +@lisp +(lambda (x) + (cond + ((null x) "") + ((numberp x) (format "%.2f" x)) + (t (ses-center-span x ?# 'ses-prin1)))) +@end lisp + +Pendant la saisie d’une lambda, vous pouvez utiliser @kbd{M-@key{TAB}} +pour completer les noms de symboles. +@item +Un symbole faisant référence à une fonction d’impression standarde +(@pxref{Standard printer functions}). +@item +Un symbole faisant référence à une fonction d’impression locale +(@pxref{Local printer functions}). +@end itemize + + +@end itemize + + +@node Configuring what printer function applies +@subsection Configurer quelle fonction d’impression s’applique + +Chaque cellule a une fonction d’impression. Si c’est @code{nil}, +alors la fonction d’impression de la colonne de cette cellule est +utilisée. Et si cela est aussi @code{nil}, alors la fonction +d’impression par défaut de la feuille est utilisée. + +@table @kbd +@item p +@findex ses-read-cell-printer +Saisit une fonction d’impression pour la cellule ou plage courante +(@code{ses-read-cell-printer}). + +@item M-p +@findex ses-read-column-printer +Saisit une fonction d’impression pour la colonne courante (@code{ses-read-column-printer}). + +@item C-c C-p +@findex ses-read-default-printer +Saisit la fonction d’impression par défaut de la feuille +(@code{ses-read-default-printer}). +@end table + +Les commandes @code{ses-read-@var{xxx}-printer} permettent les commandes +suivantes pendant l’édition: + +@table @kbd +@item @key{arrow-up} +@itemx @key{arrow-down} +Pour parcourir l’historique : les commandes +@code{ses-read-@var{xxx}-printer} ont leur propre historique de +mini-tampon, il est préchargé avec l’ensemble de toutes les fonctions +d’impression utilisées dans cette feuille, plus les fonctions +d’impression standardes (@pxref{Standard printer functions}) et les +fonctions d’impression locales (@pxref{Local printer functions}). +@item @key{TAB} +Pour compléter les symboles de fonctions d’impression locales, et +@item C-h C-p +Pour lister les fonctions d’impression locales dans un tampon d’aide. +@end table + + +@node Standard printer functions +@subsection Les fonctions d’impression standardes + + +Mise à part @code{ses-prin1}, les autres fonctions d’impression +standardes ne conviennent que pour les cellules, et non pour les +colonnes ou comme fonction d’impression par défaut de la feuille, +parce qu’elles formatent la valeur en utilisant la fonction +d’impression de colonne (ou par défaut si @code{nil}) et ensuite +post-traite le résultat, par ex.@: le centre : + +@ftable @code +@item ses-center +Centre juste. + +@item ses-center-span +Centrer en débordant sur les cellules vides suivantes. + +@item ses-dashfill +Centrer en utilisant des tirets (@samp{-}) au lieu d’espaces. + +@item ses-dashfill-span +Centrer avec tirets et débordement. + +@item ses-tildefill-span +Centrer avec tildes (@samp{~}) et débordement. + +@item ses-prin1 +C’est la fonction d’impression de repli, utilisée quand l’appel à la +fonction d’impression configurée envoie une erreur. +@end ftable + +@node Local printer functions +@subsection Les fonctions d’impression locales + +@findex ses-define-local-printer +Vous pouvez définir une fonction d’impression locale à la feuille avec +la commande @code{ses-define-local-printer}. Par exemple, définissez +une fonction d’impression @samp{toto} à @code{"%.2f"}, et ensuite +utilisez le symbole @samp{toto} comme fonction d’impression. Ensuite, +si vous rappelez @code{ses-define-local-printer} sur @samp{toto} pour +le redéfinir comme @code{"%.3f"}, alors toutes les cellules utilisant +la fonction d’impression @samp{toto} seront re-imprimées conformément. + +Il peut arriver que vous désiriez définir ou redéfinir certaines +fonctions d’impression à chaque fois que vous ouvrez une feuille. Par +exemple, imaginez que vous désiriez définir/re-définir automatiquement +une fonction d’impression locale @code{euro} pour afficher un nombre +comme une somme en euros, par exemple le nombre @code{3.1} serait +affiché comme @code{3.10@dmn{}@euro{}}. Pour faire cela dans tout +tampon SES qui n’est pas en lecture seule, vous pouvez ajouter ce +genre de code à votre fichier d’init @file{.emacs} : + +@lisp +(defun my-ses-mode-hook () + (unless buffer-read-only + (ses-define-local-printer + 'euro + (lambda (x) + (cond + ((null x) "") + ((numberp x) (format "%.2f€" x)) + (t (ses-center-span x ?# 'ses-prin1))))))) +(add-hook 'ses-mode-hook 'my-ses-mode-hook) +@end lisp + +Si vous remplacez la commande @code{ses-define-local-printer} par la +fonction @code{ses-define-if-new-local-printer} +@findex ses-define-if-new-local-printer +la définition ne se produira que si aucune fonction d’impression de +même nom n’est déjà définie. + + +@node Writing a lambda printer function +@subsection Écrire une fonctions d’impression lambda + +Vous pouvez écrire une fonction d’impression avec une expression +lambda prenant un seul argument en deux cas : + +@itemize +@item +quand vous configurez la fonction d’impression s’appliquant à +une cellule ou colonne, ou +@item +quand vous définissez une fonction d’impression avec la commande +@code{ses-define-local-printer}. +@end itemize + +En faisant cela, prenez garde à ce que la valeur renvoyée soit une +chaîne, ou une liste contenant une chaîne, même quand l’argument +d’entrée a une valeur inattendue. Voici un exemple : + +@example +(lambda (val) + (cond + ((null val) "") + ((and (numberp val) (>= val 0)) (format "%.1f" val)) + (t (ses-center-span val ?# 'ses-prin1)))) +@end example + +Cet exemple fait ceci : + +@itemize +@item +Quand la cellule est vide (c.-à-d.@: quand @code{val} est @code{nil}), +imprime une chaîne vide @code{""} +@item +Quand la valeur de cellule est un nombre positif ou nul, formate la +valeur en notation à virgule fixe avec une decimale après la virgule +@item +Sinon, gère la valeur comme erronnée en l’imprimant comme une +s-expression (avec @code{ses-prin1}), centrée et entourée de +croisillons @code{#} de bourrage. +@end itemize + +Une autre précaution à prendre est d’éviter un débordement de pile à +cause d’une fonction d’impression se rappelant elle-même sans +fin. Cette erreur peut se produire quand vous utilisez une fonction +d’impression locale comme fonction d’impression de colonne, et que +cette fonction d’impression locale appelle implicitement la fonction +d’impression de colonne courante, ainsi elle se rappelle elle-même +récursivement. Imaginez par exemple que vous désirez créer une +fonction d’impression locale @code{=bourre} qui centre le contenu +imprimé d’une cellule et l’entoure de signes égal @code{=}, et que +vous le faites (erronnément) comme cela : + +@lisp +;; CODE ERRONÉ +(lambda (x) + (cond + ((null x) "") + (t (ses-center x 0 ?=)))) +@end lisp + +Comme @code{=bourre} utilise la fonction d’impression standarde +@code{ses-center} mais sans lui passer exemplicitement une fonction +d’impression, @code{ses-center} appelle la fonction d’impression de +colonne courante s’il y en a une, ou la fonction d’impression par +défaut de la feuille sinon. Aussi, utiliser @code{=bourre} comme +fonction d’impression de colonne aura pour résultat de causer un +débordement de pile dans cette colonne sur toute cellule non vide, +puisque @code{ses-center} rappelle récursivement la fonction qui l'a +appelé. @acronym{SES} ne vérifie pas cela ; il vous faut donc faire +attention. Par exemple, reécrivez @code{=bourre} ainsi : + +@lisp +(lambda (x) + (cond + ((null x) "") + ((stringp x) (ses-center x 0 ?= " %s ")) + (t (ses-center-span x ?# 'ses-prin1)))) +@end lisp + +Le code ci-dessus est réparé au sens où @code{ses-center} et +@code{ses-center-span} sont toutes deux appelées avec un dernier +argument @var{printer} explicite spécifiant la fonction d'impression, +respectivement @code{" %s "} et @code{'ses-prin1}. + + +Le code ci-dessus applique le bourrage de @code{=} seulement aux +chaînes ; et aussi il entoure la chaîne par un espace de chaque côté +avant de bourrer avec des signes @code{=}. Ainsi la chaîne @samp{Ula} +s’affichera comme @samp{@w{=== Ula ===}} dans une colonne large de 11 +caractères. Toute valeur qui n’est ni @code{nil} (c.-à-d.@: une +cellule vide) ni une chaîne est affichée comme une erreur par l’usage +de bourrage par des croisillons @code{#}. + +@node Clearing cells +@section Effacer des cellules +@cindex effacer, commandes +@findex ses-clear-cell-backward +@findex ses-clear-cell-forward + +Ces commandes règlent à la fois la formule et la fonction d’impression +à @code{nil} : + +@table @kbd +@item @key{DEL} +Se deplace à gauche et efface la cellule (@code{ses-clear-cell-backward}). + +@item C-d +Efface la cellule et se déplace à droite (@code{ses-clear-cell-forward}). +@end table + + +@node Copy/cut/paste +@section Copier, couper, et coller +@cindex copier +@cindex couper +@cindex coller +@findex kill-ring-save +@findex mouse-set-region +@findex mouse-set-secondary +@findex ses-kill-override +@findex yank +@findex clipboard-yank +@findex mouse-yank-at-click +@findex mouse-yank-at-secondary +@findex ses-yank-pop + +Les fonctions de copie opèrent sur des regions rectangulaires de +cellules. Vous pouvez coller les copies dans des tampons +non-@acronym{SES} pour exporter le texte d’impression. + +@table @kbd +@item M-w +@itemx [copy] +@itemx [C-insert] +Copie les cellules en vedette vers l’anneau presse-papier et le +presse-papier primaire (@code{kill-ring-save}). + +@item [drag-mouse-1] +Marque une region et la copie vers l’anneau presse-papier et le +presse-papier primaire (@code{mouse-set-region}). + +@item [M-drag-mouse-1] +Marque une region et la copie vers l’anneau presse-papier et le +presse-papier secondaire (@code{mouse-set-secondary}). + +@item C-w +@itemx [cut] +@itemx [S-delete] +Les fonctions couper ne suppriment pas en fait de lignes ou de +colonnes --- elles les copient et puis les effacent +(@code{ses-kill-override}). + +@item C-y +@itemx [S-insert] +Colle à partir de l’anneau presse-papier (@code{yank}). Les fonctions +coller se comportent différemment selon le format du texte qu’elles +insèrent : +@itemize @bullet +@item +Quand on colle des cellules qui ont été coupées ou copiées à partir +d’un tampon @acronym{SES}, le texte d’impression est ignoré et +seulement la formule et fonction d’impression jointes sont insérées ; +les références de cellule de la formule sont relocalisées à moins que +vous n’utilisiez @kbd{C-u}. +@item +Le texte collé écrase un rectangle de cellules dont le coin haut +gauche est la cellule courante. Si une partie du rectangle est +au-délà des bords de la feuille, vous devez confirmer l’augmentation +de la taille de la feuille. +@item +Du texte Non-@acronym{SES} est d’ordinaire inséré comme formule de +remplacement pour la cellule courante. Si la formule serait un +symbole, elle est traitée comme une chaîne à moins que vous +n’utilisiez @kbd{C-u}. Les formules collées comprenant des erreurs de +syntaxe sont toujours traitées comme des chaînes. +@end itemize + +@item [paste] +Colle à partir du presse-papier primaire ou de l’anneau presse-papier +(@code{clipboard-yank}). + +@item [mouse-2] +Règle le point et colle à partir du presse-papier primaire +(@code{mouse-yank-at-click}). + +@item [M-mouse-2] +Règle le point et colle à partir du presse-papier secondaire +(@code{mouse-yank-secondary}). + +@item M-y +Immédiatement après un coller, vous pouvez remplacer le texte avec un +élément précédent à partir de l’anneau presse-papier +(@code{ses-yank-pop}). Contrairement au yank-pop standard d’Emacs, la +version de @acronym{SES} utilise @code{undo} pour supprimer l’ancien +collage. Est-ce que cela ne fait aucune différence ? +@end table + +@node Customizing @acronym{SES} +@section Personnaliser @acronym{SES} +@cindex personnaliser +@vindex enable-local-eval + +Par défaut, une feuille venant d’être créée a 1 ligne et 1 colonne. +La largeur de colonne est 7 et la fonction d’impression par défaut est +@samp{"%.7g"}. Chacune de ces choses peut être personnalisée. Allez +voir dans le groupe « ses ». + +Après avoir saisi une valeur de cellule, normalement +@code{forward-char} est appelé, ce qui déplace le point vers la +cellule suivante à droite, ou à la première cellule à gauche de la +ligne suivante si la cellule courante est la plus à droite de la +feuille. Vous pouvez personnaliser @code{ses-after-entry-functions} +pour que le déplacement soit vers la gauche ou le haut ou le bas. +Pour un mouvement diagonal, selectionnez deux fonctions de la liste. + +@vindex ses-jump-cell-name-function +@code{ses-jump-cell-name-function} est une variable personnalisable +réglée par défaut à la fonction @code{upcase}. Cette fonction est +appelée quand vous passez un nom de cellule à la commande +@command{ses-jump} (@kbd{j}), et que ce nom n’est pas le nom d’une +cellule renommée. Elle change le nom de cellule saisi en celui de la +cellule vers laquelle sauter. Le réglage par défaut @code{upcase} vous +permet de saisir le nom de cellule en bas de casse. Un autre usage de +@code{ses-jump-cell-name-function} pourrait être une +internationalisation pour convertir des caractères non latins en +équivalents latins pour nommer la cellule. Au lieu d’un nom de +cellule, la fonction peut renvoyer des coordonnées de cellule sous la +forme d’un cons, par exemple @code{(0 . 0)} pour la cellule @code{A1}, +@code{(1 . 0)} pour la cellule @code{A2}, etc. + +@vindex ses-jump-prefix-function +@code{ses-jump-prefix-function} est une variable personnalisable +réglée par défaut à la fonction @code{ses-jump-prefix}. Cette fonction +est appelée quand vous donnez un argument préfixe à la commande +@command{ses-jump} (@kbd{j}). Elle renvoie un nom de cellule ou des +coordonnées de cellule correspondant à l’argument préfixe. Les +coordonnées de cellule sont sous la forme d’un cons, par exemple +@code{(1 . 0)} pour la cellule @code{A2}. Le réglage par défaut +@code{ses-jump-prefix} numérote les cellules de gauche à droite et +puis de haut en bas, de sorte que si on suppose une feuille 4×3, +l’argument préfixe @samp{0} saute à la cellule @samp{A1}, l’argument +préfixe @samp{2} saute à @samp{C1}, l’argument préfixe @samp{3} saute +à @samp{A2}, etc. + +@vindex ses-mode-hook +@code{ses-mode-hook} est un crochet de mode normal (une liste de +fonctions qui s’exécutent quand le mode @acronym{SES} démarre sur un +tampon). + +@vindex safe-functions +La variable @code{safe-functions} est une liste de fonctions +potentiellement risquées à traiter comme si elles étaient sûres lors +de l’analyse des formules et fonctions d’impression. @xref{Virus +protection}. Avant de personnaliser @code{safe-functions}, +réfléchissez à quel point vous faites confiance à la personne qui vous +suggère cette modification. La valeur @code{t} désactive toute +protection anti-virus. Une valeur donnant une liste-de-fonctions peut +rendre une feuille « trop bien », mais elle crée aussi des portes +dérobées dans votre armure anti-virus. Pour que votre protection +contre les virus fonctionne, vous devez toujours appuyer sur @kbd{n} +quand un avertissement contre un virus vous est présenté, à moins que +vous compreniez ce que le code en question essaie de faire. N’écoutez +pas ceux qui vous racontent de personnaliser @code{enable-local-eval} +--- cette variable est pour les gens qui ne portent pas de ceinture de +sécurité ! + + +@c =================================================================== + +@node Advanced Features +@chapter Fonctions avancées +@cindex avancées, fonctions +@findex ses-read-header-row + + +@table @kbd +@item C-c M-C-h +(@code{ses-set-header-row}). +@findex ses-set-header-row +@kindex C-c M-C-h +La ligne d’en-tête au sommet de la fenêtre @acronym{SES} affiche +normalement la ligne de colonne pour chaque colonne. Vous pouvez la +régler pour afficher une copie de l’une des lignes, tell que qu’une +ligne de titres de colonnes, ainsi cette ligne sera toujours visible. +Par défaut la commande règle la ligne courante comme en-tête ; +utiliser C-u pour une invite à désigner la ligne d’en-têre. Régler la +ligne d’en-tête à la ligne 0 pour afficher les lettres de colonne de +nouveau. +@item [header-line mouse-3] +Affiche un menu pour régler la ligne courante comme en-tête, ou +revenir à des lettres de colonne. +@item M-x ses-rename-cell +@findex ses-rename-cell +Renomme une cellule pour passer d'un nom standard du genre de A1 à +toute chaîne pouvant être un nom valide pour une variable locale (Voir +aussi @ref{Nonrelocatable references}). +@item M-x ses-repair-cell-reference-all +@findex ses-repair-cell-reference-all +Quand vous interrompez la mise à jour d’une formule de cellule en +tapant @kbd{C-g}, alors cela peut casser le lien de référence de +cellule, ce qui compromet la mise à jour automatique de cellule quand +toute autre cellule dont elle dépend est modifiée. Pour réparer cela, +utilisez la fonction @code{ses-repair-cell-reference-all} +@end table + +@menu +* La zone d’impression: The print area. +* Plages dans les formules: Ranges in formulas. +* Trier par colonne: Sorting by column. +* Fonctions de formule standardes: Standard formula functions. +* Plus sur l’impression de cellule: More on cell printing. +* Import et export: Import and export. +* Protection contre les virus: Virus protection. +* Feuilles avec détails et synthèse: Spreadsheets with details and summary. +@end menu + +@node The print area +@section La zone d’impression +@cindex zone d’impression +@cindex impression, zone d’ +@findex widen +@findex ses-renarrow-buffer +@findex ses-reprint-all + +Un fichier @acronym{SES} consiste en une zone d’impression et une zone +de données. Normalement le tampon est réduit de sorte à n’afficher +que la zone d’impression. La zone d’impression est en lecture seule, +hormis pour les commandes spéciales de @acronym{SES} ; elle contient +les valeurs de cellule formatées par les fonctions d’impression. La +zone de données enregistre les formules, fonctions d’impression, etc. + +@table @kbd +@item C-x n w +Affiche à la fois les zones d’impression et de données (@code{widen}). + +@item C-c C-n +Affiche seulement la zone d’impression (@code{ses-renarrow-buffer}). + +@item S-C-l +@itemx M-C-l +Recrée la zone d’impression en réévaluant pour toutes les cellules sa +fonction d’impression (@code{ses-reprint-all}). +@end table + +@node Ranges in formulas +@section Plages dans les formules +@cindex plages +@findex ses-insert-plage-click +@findex ses-insert-plage +@findex ses-insert-ses-plage-click +@findex ses-insert-ses-plage +@vindex de +@vindex à + +Une formule du genre de : +@lisp +(+ A1 A2 A3) +@end lisp +est la somme de trois cellules spécifiques. Si vous insérez une +nouvelle deuxième ligne, la formule devient +@lisp +(+ A1 A3 A4) +@end lisp +et la nouvelle ligne n’est pas incluse dans la somme. + +La macro @code{(ses-range @var{de} @var{à})} s’évalue en une liste des +valeurs dans un rectangle de cellules. Si votre formule est +@lisp +(apply '+ (ses-range A1 A3)) +@end lisp +et que vous insérez une nouvelle deuxième ligne, elle devient +@lisp +(apply '+ (ses-range A1 A4)) +@end lisp +et la nouvelle ligne est incluse dans la somme. + +Alors que vous saisissez ou éditez une formule dans le minitampon, +vous pouvez sélectionner une plage dans la feuille (en utilisant la +souris ou le clavier), et injecter une représentation de cette plage +dans votre formule. Supposez que vous sélectionnez @samp{A1-C1} : + +@table @kbd +@item [S-mouse-3] +Insère @samp{A1 B1 C1} (@code{ses-insert-range-click}) + +@item C-c C-r +Version clavier (@code{ses-insert-range}). + +@item [C-S-mouse-3] +Insère @samp{(ses-range A1 C1)} (@code{ses-insert-ses-range-click}). + +@item C-c C-s +Version clavier (@code{ses-insert-ses-range}). +@end table + +Si vous supprimez la cellule @var{de} ou @var{à} d’une plage, la +cellule la plus proche toujours existante est utilisée à la place. Si +vous supprimez l’entière plage, le relocalisateur de formule supprime +le @samp{ses-range} de la formule. + +Si vous insérez une nouvelle ligne juste au delà de la fin d’une plage +à une colonne, ou une nouvelle colonne juste au delà d’une plage à une +ligne, la nouvelle cellule est incluse dans la plage. Les nouvelles +cellules insérées juste avant une plage ne sont pas incluses. + +Des fanions peuvent être ajoutés à @code{ses-range} immédiatement +après la cellule @var{à} . +@table @code +@item ! +Les cellules vides de la plage peuvent être enlevées en ajoutant le +fanion @code{!}. Une cellule vide est une cellule dont la valeur est +l’un des symboles @code{nil} ou @code{*skip*}. Par exemple +@code{(ses-range A1 A4 !)} fait la même chose que @code{(list A1 A3)} +quand les cellules @code{A2} et @code{A4} sont vides. +@item _ +Les valeurs de cellules vides sont remplacées par l’argument suivant +le fanion @code{_}, ou @code{0} quand le fanion @code{_} est le +dernier dans la liste d’arguments. Par exemple @code{(ses-range A1 A4 +_ "vide")} fera la même chose que @code{(list A1 "vide" A3 "vide")} +quand les cellules @code{A2} et @code{A4} sont vides. Similairement, +@code{(ses-range A1 A4 _ )} fera la même chose que @code{(list A1 0 A3 +0)}. +@item >v +Quand l’ordre a de l’importance, liste les cellules en lisant les +cellules ligne par ligne de la cellule en haut à gauche vers la +cellule en bas à droite. Ce fanion est fourni pour être complet car +c’est déjà l’ordre par défaut. +@item +Liste les cellules en lisant les cellules colonne par colonne de la +cellule en haut à gauche vers la cellule en bas à droite. +@item v< +Liste les cellules en lisant les cellules colonne par colonne de la +cellule en haut à droite vers la cellule en bas à gauche. +@item v +Un raccourci pour @code{v>}. +@item ^ +Un raccourci pour @code{^>}. +@item > +Un raccourci pour @code{>v}. +@item < +Un raccourci pour @code{>^}. +@item * +Au lieu de lister les cellules, en fait un vecteur ou une matrice Calc +(@pxref{Top,,,calc,GNU Emacs Calc Manual}). Si la plage contient +seulement une ligne ou une colonne un vecteur est fait, sinon une +matrice est faite. +@item *2 +Idem que @code{*} à ceci près qu’une matrice est toujours faite même +quand il y a une seule ligne ou colonne dans la plage. +@item *1 +Idem que @code{*} à ceci près qu’un vecteur est toujours fait même +quand il n’y a qu’une ligne ou colonne dans la plage, c.-à-d.@: que la +matrice correspondante est aplatie. +@end table + +@node Sorting by column +@section Trier par colonne +@cindex trier +@findex ses-sort-column +@findex ses-sort-column-click + +@table @kbd +@item C-c M-C-s +Trie les cellules d’une plage en utilisant l’une des colonnes +(@code{ses-sort-column}). Les lignes (ou lignes partielles si la +plage n’inclut pas toutes les colonnes) sont réarrangées de sorte que +la colonne choisie soit ordonnée. + +@item [header-line mouse-2] +La façon la plus facile de trier est de cliquer sur mouse-2 sur la +ligne d’en-tête de colonne (@code{ses-sort-column-click}). +@end table + +La comparaison du tri utilise @code{string<}, ce qui fonctionne bien +pour des nombres alignés à droite ou des chaînes alignées à gauche. + +Avec un argument préfixe, trie dans l’ordre descendant. + +Les lignes sont déplacées une à la fois, avec relocalisation des +formules. Ceci fonctionne bien si les formules font référence à +d’autres cellules dans leur ligne, mais non pas si bien pour des +formules qui font référence à d’autres lignes dans la plage ou à des +cellules hors de la plage. + + +@node Standard formula functions +@section Fonctions de formule standardes +@cindex fonctions standardes de formule +@cindex *skip* +@cindex *error* +@findex ses-delete-blanks +@findex ses-average +@findex ses+ + +Souvent on désire qu’un calcul exclue les cellules vides. Voici +quelques fonctions utiles à appeler dans vos formules : + +@table @code +@item (ses-delete-blanks &rest @var{args}) +Renvoie une liste dont toutes les cellules vides (dont la valeur est +soit @code{nil} ou @code{'*skip*}) ont été supprimées. L’ordre des +arguments est inversé. Prière de noter que @code{ses-range} a un +modificateur @code{!} qui permet de supprimer les cellules vides, +ainsi il est possible d’écrire : +@lisp +(ses-range A1 A5 !) +@end lisp +au lieu de +@lisp +(apply 'ses-delete-blanks (ses-range A1 A5 <)) +@end lisp + +@item (ses+ &rest @var{args}) +Somme des arguments non vides pris en ordre inverse. + +@item (ses-average @var{liste}) +Moyenne des éléments non vides de @var{liste}. Ici la liste est +passée comme un seul argument, vu que typiquement on la forme avec +@code{ses-range}. +@end table + +@node More on cell printing +@section Plus sur l’impression de cellule +@cindex cellule, plus sur l'impression +@cindex impression de cellule +@findex ses-truncate-cell +@findex ses-recalculate-cell + +Valeurs spéciales de cellule : +@itemize +@item nil +s’imprime typiquement de la même façon que "", mais permet que la +cellule précédente déborde dessus. +@item '*skip* +remplace nil quand la cellule précédente déborde effectivement ; rien +n’est donc imprimée pour cette cellule. +@item '*error* +indique que la formule a signalé une erreur au lieu de produire une +valeur : la cellule imprimée est remplie de croisillons (#). +@end itemize + +Lorsque la fonction d’impression est définie par une chaîne de +formatage, par ex. @samp{"%.3f"}, @acronym{SES} imprime +automatiquement @code{nil} comme une chaîne vide, mais si la fonction +d’impression est définie par une expression lambda, vous devez définir +explicitement comment @code{nil} est traité, par ex. : +@example +(lambda (x) + (cond + ((null x) "") + ((stringp x) (list x)) + ((numberp x) (format "%.3f" x)) + (t (ses-prin1 x))) +@end example +imprime @code{nil} comme une chaîne vide, aligne à gauche la valeur si +c’est une chaîne, et si c’est un nombre l’aligne à droite en +l’imprimant avec trois décimales. + +Il n’est pas nécessaire par contre que vous vous souciez de +@code{'*skip*} dans la définition d’une fonction d’impression, en +effet aucune fonction d’impression n’est appelée sur @code{'*skip*}. + +Si le résultat de la fonction d’impression est trop large pour la +cellule et que la cellule suivante est @code{nil}, le résultat +débordera sur la cellule suivante. Les résultats très larges peuvent +déborder sur plusieurs cellules. Si le résultat est trop large pour +l’espace disponible (jusqu'à la fin de la ligne ou la prochaine +cellule non-@code{nil}), le résultat est tronqué si la valeur de +cellule est une chaîne, ou remplacé par des croisillons (@samp{#}) +sinon. + +@acronym{SES} pourrait être perturbé par des résultats de fonction +d'impression contenant des sauts de ligne ou des tabulations, aussi +ces caractères sont remplacés par des points d'interrogation. + +@table @kbd +@item t +Confine une cellule à sa propre colonne (@code{ses-truncate-cell}). +Ceci vous permet de déplacer le point sur la cellule de droite qui +sinon serait couverte par un débordement. Si vous ne modifiez pas la +cellule de droite, la cellule confinée débordera de nouveau la +prochaine fois qu’elle sera imprimée. + +@item c +Appliquée à une seule cellule, cette commande affiche dans la zone +d’écho toute erreur de formule ou erreur d’impression survenue pendant +le recalcul/la réimpression (@code{ses-recalculate-cell}). Vous +pouvez utiliser cela pour défaire l’effet de @kbd{t}. +@end table + +Quand une fonction d’impression signale une erreur, la fonction +d’impression de repli +@findex ses-prin1 +@code{ses-prin1} lui est substituée. Ceci est utile quand votre +fonction d’impression de colonne est seulement numérique et que vous +utilisez une chaîne comme valeur de cellule. Notez que la fonction +d’impression par défaut standarde est @samp{"%.7g"} qui est numérique +seulement, ainsi les cellules auxquelles la fonction d’impression par +défaut standarde s’applique et qui ne sont pas vides et ne contiennent +pas un nombre utilisent la fonction d’impression de repli +@code{ses-prin1}, par ex.@: les cellules qui contiennent une chaîne +font cela. @kbd{c} sur de telles cellules affiche « Format specifier +doesn't match argument type ». + + +@node Import and export +@section Import et export +@cindex import et export +@cindex export, et import +@findex ses-export-tsv +@findex ses-export-tsf + +@table @kbd +@item x t +Exporte une plage de cellules comme des valeurs séparées par des +tabulations (@code{ses-export-tsv}). +@item x T +Exporte une plage de cellules comme des formules séparées par des +tabulations (@code{ses-export-tsf}). +@end table + +Le texte exporté va dans l’anneau presse-papier ; vous pouvez le +coller dans un autre tampon. Les colonnes sont séparées par des +tabulations, les lignes par des sauts de lignes. + +Pour importer du texte, utilisez n’importe laquelle des commandes +coller où le texte à coller contient des tabulations et/ou des sauts de +lignes. Les formules importées ne sont pas relocalisées. + +@node Virus protection +@section Protection contre les virus +@cindex virus protection + +À chaque fois une formule ou fonction d’impression est lue d’un +fichier ou est collée dans la feuille, elle est marquée comme +« nécessitant une vérification de sécurité ». Plus tard, quand la +formule ou la fonction d’impression est évaluée pour la première fois, +elle est vérifiée comme sûre en utilisant le prédicat @code{unsafep} ; +si elle s’avère « potentiellement risquée », la formule ou fonction +d’impression en question est affichée et vous devez appuyer @kbd{Y} +pour l’approuver ou @kbd{N} pour utiliser un substitut. Le substitut +signale toujours une erreur. + +Les formules ou fonctions d’impression que vous tapez sont +immédiatement vérifiées quant à leur sûreté. Si elles s’avèrent +potentiellement risquées et que vous appuyez @kbd{N} pour refuser, +l’action est annulée et l’ancienne formule ou fonction d’impression +demeure. + +En plus des virus (qui tentent de se recopier dans d’autres +fichiers), @code{unsafep} peut aussi détecter toutes sortes de chevaux +de Troie, tels que des feuilles de calcul qui effacent les fichiers, +envoient des courriels, inondent des sites Web, corrompent vos +réglages d’Emacs, etc. + +Généralement, les formules et fonctions d’impression de feuilles sont +des choses simples qui n’ont pas besoin de faire des traitements +exotiques, aussi toute partie potentiellement dangereuse de +l’environnement Emacs Lisp peut être exclus sans entraver votre style +comme écrivain de formule. Lisez la documentation dans +@file{unsafep.el} pour plus d’information sur la façon dont les formes +Lisp sont classifiées comme sûres ou risquées. + +@node Spreadsheets with details and summary +@section Feuilles avec détails et synthèse +@cindex détails et synthèse +@cindex synthèses, et détails + +Une organisation usuelle pour une feuille de calcul est d’avoir un tas +de lignes de « détail », chacune décrivant possiblement une +transaction, et ensuite un ensemble de lignes de « synthèse » qui +affichent chacune des données condensées pour un certain sous-ensemble +des détails. @acronym{SES} prend en charge ce type d’organisation via +la fonction @code{ses-select}. + +@table @code +@item (ses-select @var{de-plage} @var{test} @var{à-plage}) +Renvoie un sous-ensemble de @var{à-plage}. Pour chaque membre dans +@var{de-plage} qui est égal à @var{test}, le membre correspondant de +@var{à-plage} est inclus dans le résultat. +@end table + +Exemple d’utilisation : +@lisp +(ses-average (ses-select (ses-range A1 A5) 'Bidochon (ses-range B1 B5))) +@end lisp +Ceci calcule la moyenne des valeurs de la colonne @samp{B} pour les +lignes dont la valeur dans la colonne @samp{A} est le symbole +@samp{'Bidochon}. + +Vous vous demandez peut-être pourquoi les arguments de +@code{ses-select} ne consistent pas au lieu de @var{à-plage} de +décalages @var{décalage-à-la-ligne} et @var{décalage-à-la-colonne} +relativement à @var{de-plage} : spécifier @var{à-plage} explicitement +assure que la formule est recalculée si l’une quelconque des cellules +de cette plage est modifiée. + +Le fichier @file{etc/ses-example.el} dans la distribution Emacs est un +exemple d’une feuille organisée en détails-et-synthèse. + + +@c =================================================================== + +@node For Gurus +@chapter Pour les gourous +@cindex avancées, fonctions +@cindex fonctions avancées + +@menu +* Mises à jour différées: Deferred updates. +* Références non-relocalisables: Nonrelocatable references. +* La zone données: The data area. +* Variables locales-tampon dans les feuilles: Buffer-local variables in spreadsheets. +* Utilisation de advice-add dans @acronym{SES}: Uses of advice-add in @acronym{SES}. +@end menu + +@node Deferred updates +@section Mises à jour différées +@cindex différées, mises à jour +@cindex mises à jour différées +@vindex run-with-idle-timer + +Pour épargner du temps de calcul redondant, les cellules dont le +recalcul est rendu nécessaire par des changements dans d’autres +cellules sont ajoutées à un ensemble. À la fin de la commande, chaque +cellule de cet ensemble est recalculée une fois. Ceci peut créer un +nouvel ensemble de cellules nécessitant un recalcul. Ce processus est +répété jusqu'à ce que l’ensemble soit vide ou que des références +circulaires soient détectées. Dans les cas extrêmes, et notamment si +une référence circulaire est en cours de détection, vous pourriez voir +des messages de progression de la forme « Recalculating... (@var{nnn} +cells left) ». Si vous interrompez le calcul avec @kbd{C-g}, la +feuille demeurera dans un état incohérent, utilisez alors @kbd{C-_} ou +@kbd{C-c C-l} pour réparer cela. + +Pour épargner encore plus de temps en évitant les écritures +redondantes, les cellules qui sont modifiées sont ajoutées à un +ensemble au lieu d’être immédiatement écrites dans la zone de +données. Chaque cellule de cet ensemble est écrite une fois à la fin +de la commande. Si vous modifiez un grand nombre de cellules, vous +pourriez voir un message de progression de la forme +« Writing... (@var{nnn} cells left) ». Ces écritures différées de +cellules ne peuvent pas être interrompues par @kbd{C-g}, alors il vous +faudra juste attendre. + +@acronym{SES} utilise @code{run-with-idle-timer} pour déplacer le +souligné de cellule quand Emacs fait défiler le tampon à la fin d’une +commande, et aussi pour @c xxx narrow and underline +réduire et souligner après visiter un fichier. Ceci peut être visible +par une perturbation transitoire après visiter un fichier et certaines +commandes de défilement. Vous pouvez continuer à taper sans vous +inquiéter de cette perturbation. + + +@node Nonrelocatable references +@section Références non relocalisables +@cindex non-relocalisables, références +@cindex références non-relocalisables + +@kbd{C-y} relocalise toutes les références de cellule dans une formule +collée, alors que @kbd{C-u C-y} n’en relocalise aucune. Et pour les +cas mélangés ? + +La meilleure approche est de renommer les cellules que vous @emph{ne} +voulez @emph{pas} être relocalisables en utilisant +@code{ses-rename-cell}. +@findex ses-rename-cell +Les cellules qui n’ont pas un style de nom du genre de A1 ne sont pas +relocalisées au collage. En utilisant cette méthode, les cellules +concernées ne seront pas relocalisées quelle que soit la formule où +elles apparaissent. Prière toutefois de noter que dans une formule +contenant quelque plage @code{(ses-range @var{cell1} @var{cell2})} +alors dans la formule collée chacune des bornes @var{cell1} et +@var{cell2} de la plage est relocalisée, ou non, indépendemment, selon +qu’elle est nommée du genre de @samp{A1} ou renommée. + +Une méthode alternative est d’utiliser +@lisp +(symbol-value 'B3) +@end lisp +pour faire une @dfn{référence absolue}. Le relocalisateur de formule +saute par dessus tout ce qui est sous un @code{quote}, aussi cela ne +sera pas relocalisé quand on le colle ou quand des lignes/colonnes +sont insérées/supprimées. Toutefois, @samp{B3} ne sera pas +enregistrée comme une dépendance de cette cellule, et donc cette +cellule ne sera pas mise à jour automatiquement quand @samp{B3} est +modifiée, c’est pourquoi l’usage de @code{ses-rename-cell} est la +plupart du temps préférable. + +Les variables @code{row} et @code{col} sont liées dynamiquement +pendant l’évaluation d’une formule de cellule. Vous pouvez utiliser +@lisp +(ses-cell-value row 0) +@end lisp +pour obtenir la valeur de la colonne la plus à gauche de la ligne +courante. Ce type de dépendance n’est pas non plus enregistré. + + +@node The data area +@section La zone de données +@cindex données, zone de +@cindex zone de données +@findex ses-reconstruct-all + +Commence avec un caractère saut de page (de code ASCII 014 en octal), +suivi par un ensemble de macros de définition de cellule pour chaque +ligne, suivi par l’ensemble des définitions de fonctions d’impression +locales, suivi par les largeurs de colonnes, fonctions d’impression de +colonne, fonction d’impression par défaut, et ligne d’en-tête. Ensuite +il y a les paramètres globaux (ID de format fichier, nombre de lignes, +nombre de colonnes, nombre de fonctions d’impression locales) et les +variables locales (spécification du mode @acronym{SES} pour le tampon, +etc.). + +Quand un fichier @acronym{SES} est chargé, tout d’abord les paramètres +globaux sont chargés, puis l’ensemble de la zone de données est +@code{eval}ué, et finalement les variables locales sont traitées. + +Vous pouvez éditer la zone de données, mais n’insérez pas ni ne +supprimez de sauts de ligne, hormis dans la partie des variables +locales, en effet @acronym{SES} localise les choses en comptant les +sauts de ligne. Utilisez @kbd{C-x C-e} à la fin d’une ligne pour +installer ce que vous avez édité dans les structures de données de la +feuille (ceci ne met pas à jour la zone d’impression, utilisez, par +ex., @kbd{C-c C-l} pour cela). + +La zone de données est maintenue comme une image des structures de +données de la feuille stockée dans des variables locales tampon au +moment du chargement initial de la zone. Si le contenu de la zone de +données se trouve corrompu par la suite, vous pouvez essayer de +reconstruire la zone de données à partir des structures de données +avec : + +@table @kbd +@item C-c M-C-l +(@code{ses-reconstruct-all}). +@end table + + +@node Buffer-local variables in spreadsheets +@section Les variables locales-tampon dans les feuilles de calcul +@cindex locales-tampon, variables +@cindex variables locales-tampon + +Vous pouvez ajouter des variables locales supplémentaires à la liste +au bas de la zone de données, telles que des constantes cachées +auxquelles vous désirez faire référence dans vos formules. + +Vous pouvez initialiser la variable @code{ses--symbolic-formulas} pour +être une liste de symboles (comme une suite de chaînes entre +parenthèses) à proposer comme complétions pour la commande @kbd{'}. +Cette liste initiale de complétions sera utilisée à la place de +l’ensemble effectif des symboles-comme-formules de la feuille. + +Pour un exemple de ceci, voir le fichier @file{etc/ses-example.ses}. + +Si (pour une raison quelconque) vous désirez que vos formules ou +fonctions d’impression sauvegardent des données dans des variables, +vous devez déclarer ces variables comme locales tampon pour éviter un +avertissement de virus. + +Vous pouvez définir des fonctions en en faisant des valeurs pour la +fausse variable locale @code{eval}. De telles fonctions peuvent +ensuite être utilisées dans les formules et comme fonctions +d’impression, mais d’ordinaire chaque @code{eval} est présenté à +l’utilisateur pendant le chargement du fichier comme un virus +potentiel. Et cela peut devenir gênant. + +Vous pouvez définir des fonctions dans votre fichier @file{.emacs}. +Toute personne pourra encore lire la zone d’impression de votre +feuille, mais ne pourra pas recalculer ou réimprimer quoi que ce soit +qui dépende de vos fonctions. Pour éviter des avertissements contre +les virus, chaque fonction utilisée dans une formule nécessite +@lisp +(put 'le-nom-de-votre-fonction 'safe-function t) +@end lisp + +@node Uses of advice-add in @acronym{SES} +@section Utilisation de advice-add dans @acronym{SES} +@findex advice-add +@findex copy-region-as-kill +@findex yank + +@table @code +@item copy-region-as-kill +Quand on copie de la zone d’impression d’une feuille, traite la région +comme un rectangle et joint pour chaque cellule sa formule et sa +fonction d’impression comme des propriétés @code{'ses}. + +@item yank +Quand on colle dans la zone d’impression d’une feuille de calcul, +essaie de coller comme des cellules (si le texte à coller a des +propriétés @code{'ses}), ensuite comme des formules séparées par des +tabulations, ensuite (si tout le reste a échoué) comme une seule +formule pour la cellule courante. +@end table + +@c =================================================================== +@node Index +@unnumbered Index + +@printindex cp + +@c =================================================================== + +@node Acknowledgments +@unnumbered Remerciements + +Codé par : +@quotation +@c jyavner@@member.fsf.org +Jonathan Yavner, +@c monnier@@gnu.org +Stefan Monnier, +@c shigeru.fukaya@@gmail.com +Shigeru Fukaya, +@c vincent.belaiche@@sourceforge.net +Vincent Belaïche +@end quotation + +@noindent +Manuel Texinfo de : +@quotation +@c jyavner@@member.fsf.org +Jonathan Yavner, +@c brad@@chenla.org +Brad Collins, +@c vincent.belaiche@@sourceforge.net +Vincent Belaïche +@end quotation + +@noindent +Idées de : +@quotation +@c christoph.conrad@@gmx.de +Christoph Conrad, +@c cyberbob@@redneck.gacracker.org +CyberBob, +@c syver-en@@online.no +Syver Enstad, +@c fischman@@zion.bpnetworks.com +Ami Fischman, +@c Thomas.Gehrlein@@t-online.de +Thomas Gehrlein, +@c c.f.a.johnson@@rogers.com +Chris F.A. Johnson, +@c lyusong@@hotmail.com +Yusong Li, +@c juri@@jurta.org +Juri Linkov, +@c maierh@@myself.com +Harald Maier, +@c anash@@san.rr.com +Alan Nash, +@c pinard@@iro.umontreal.ca +François Pinard, +@c ppinto@@cs.cmu.edu +Pedro Pinto, +@c xsteve@@riic.at +Stefan Reichör, +@c epameinondas@@gmx.de +Oliver Scholz, +@c rms@@gnu.org +Richard M. Stallman, +@c teirllm@@dms.auburn.edu +Luc Teirlinck, +@c jotto@@pobox.com +J. Otto Tennant, +@c jphil@@acs.pagesjaunes.fr +Jean-Philippe Theberge, +@c rrandresf@@hotmail.com +Andrés Ramírez +@end quotation + +@c =================================================================== + +@node GNU Free Documentation License +@appendix GNU Free Documentation License +@include doclicense.texi + +@bye +@c Local Variables: +@c ispell-dictionary: "fr" +@c End: diff --git a/doc/lang/fr/misc/ses-fr.texi b/doc/lang/fr/misc/ses-fr.texi deleted file mode 100644 index e1b9cac5fc3..00000000000 --- a/doc/lang/fr/misc/ses-fr.texi +++ /dev/null @@ -1,1631 +0,0 @@ -\input texinfo @c -*- mode: texinfo; coding: utf-8; -*- -@c %**start of header -@setfilename ../../../../info/ses-fr.info -@documentlanguage fr -@documentencoding UTF-8 -@settitle @acronym{SES}: Le tableur simple d’Emacs -@include docstyle.texi -@setchapternewpage off -@syncodeindex fn cp -@syncodeindex vr cp -@syncodeindex ky cp -@c %**end of header - -@copying -Ce fichier documente @acronym{SES} : le tableur simple d’Emacs (Simple -Emacs Spreadsheet). - -Copyright @copyright{} 2002--2024 Free Software Foundation, Inc. - -@quotation -Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation; with no -Invariant Sections, with the Front-Cover Texts being ``A GNU Manual,'' -and with the Back-Cover Texts as in (a) below. A copy of the license -is included in the section entitled ``GNU Free Documentation License.'' - -(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and -modify this GNU manual.'' -@end quotation -@end copying - -@dircategory Emacs misc features -@direntry -* @acronym{SES}-fr: (ses-fr). Le tableur simple d’Emacs. -@end direntry - -@finalout - -@titlepage -@title @acronym{SES} -@subtitle Le tableur simple d’Emacs -@author Jonathan A. Yavner -@author @email{jyavner@@member.fsf.org} - -@page -@vskip 0pt plus 1filll -@insertcopying -@end titlepage - -@contents - -@c =================================================================== - -@ifnottex -@node Top -@comment node-name, next, previous, up -@top @acronym{SES}: Simple Emacs Spreadsheet - -@display -@acronym{SES} est mode majeur de GNU Emacs pour éditer des fichiers -tableur, c.-à-d.@: des fichiers contenant une grille rectangulaire de -cellules. Les valeurs des cellules sont spécifiées par des formules -pouvant se référer aux valeurs d’autres cellules. -@end display -@end ifnottex - -Pour les rapports d’anomalie, utiliser @kbd{M-x report-emacs-bug}. - -@insertcopying - -@menu -* Boniment: Sales Pitch. Pourquoi utiliser @acronym{SES}? -* Tuto: Quick Tutorial. Une introduction sommaire -* Les bases: The Basics. Les commandes de base du tableur -* Fonctions avancées: Advanced Features. Vous voulez en savoir plus ? -* Pour les gourous: For Gurus. Vous voulez en savoir @emph{encore plus} ? -* Index: Index. Index des concepts, fonctions et variables -* Remerciements: Acknowledgments. Remerciements -* Licence GNU pour la documentation libre: GNU Free Documentation License. La licence de cette documentation. -@end menu - -@c =================================================================== - -@node Sales Pitch -@comment node-name, next, previous, up -@chapter Boniment -@cindex features - -@itemize -- -@item Créer et éditer des feuilles de calcul avec un minimum de tracas. -@item Prise en charge complète du Défaire/Refaire/Sauvegarde auto. -@item Protection contre les virus enfouis dans les feuilles de calcul. -@item Les formules de cellule sont directement du code Emacs Lisp. -@item Fonctions d’impression pour contrôler l’apparence des cellules. -@item Raccourcis clavier intuitifs : C-o = insérer une ligne, M-o = insérer une colonne, etc. -@item « Débordement » des valeurs de cellule longues dans les cellules vides suivantes. -@item La ligne d’en-tête montre les lettres désignant les colonnes. -@item Autocomplétion pour la saisie des symboles de cellules nommées lors de la saisie des formules. -@item Couper, copier et coller peut transferer les formules et les fonctions d’impression. -@item Import and export de valeurs séparées par des tabulations, ou de formules séparées par des tabulations. -@item Format de fichier en texte, facile à bidouiller. -@end itemize - -@c =================================================================== - -@node Quick Tutorial -@chapter Tuto -@cindex introduction -@cindex tuto - -Si vous désirez être rapidement lancé et pensez que vous savez ce que -vous attendez d’un tableur simple, alors ce chapitre peut être tout ce -dont vous avez besoin. - -Premièrement, visitez un nouveau fichier avec pour extension de nom de -fichier @file{.ses}. Emacs vous présente alors une feuille de calcul -vide contenant une seule cellule. - -Commencez par saisir une ligne d’en-tête : @kbd{"Revenu@key{RET}}. Le -guillemet double @code{"} indique que vous saisissez une cellule -textuelle, il ne fait pas partie de la valeur de la cellule, et aucun -guillemet de fermeture n’est nécessaire. - -Pour insérer votre première valeur de revenu, vous devez d’abord -redimensionner la feuille. Appuyer sur la touche @key{TAB} pour -ajouter une nouvelle cellule et revenez à elle en remontant. -Saisissez un nombre, tel que @samp{2.23}. Puis continuer pour ajouter -quelques valeurs supplémentaires de revenu, par ex. : - -@example -@group -A - Revenu - 2.23 - 0.02 - 15.76 - -4.00 -@end group -@end example - -Pour additionner les valeurs entre elles, saisissez une expression -Lisp : - -@example -(+ A2 A3 A4 A5) -@end example - -Peut-être désirez vous ajouter une cellule à la droite de la cellule -@samp{A4} pour expliquer pourquoi vous avez une valeur négative. En -appuyant sur @kbd{TAB} dans cette cellule vous ajouter entièrement une -nouvelle colonne @samp{B} où vous pourrez ajouter une telle note. - -La colonne est assez étroite par défaut, mais en appuyant sur @kbd{w} -vous pouvez la redimensionner selon vos besoins. Faites la de 22 -caractères de large. Vous pouvez maintenant ajoutez des notes -descriptives pour chacune des cases, par ex.@: : - -@example -@group -A B - Revenu - 2.23 Frais de consultation - 0.02 Opinion informée - 15.76 Stand limonade - -4 Prêt à Joseph - 14.01 Total -@end group -@end example - -Par défaut, l’impression des valeurs de cellule se fait alignée à -droite, c’est la raison d’un tel alignement pour les notes dans la -colonne @samp{B}. Pour changer cela, vous pouvez saisir une fonction -d’impression pour la colonne entière, en utilisant par ex. @kbd{M-p -("%s")}. Le fait que @code{"%s"} soit contenu dans une liste indique à -@acronym{SES} que l’alignement est à faire à gauche. Vous pouvez -l’emporter sur la fonction d’impression de colonne pour l’une -quelconque de ses cellules en donnant une fonction d’impression par -cellule avec @kbd{p}. - -Vous pouvez nommer une fonction d’impression, et utiliser le nom de la -fonction à la place de sa définition, de sorte à faciliter la -modification de l’impression de toutes les cellules utilisant cette -fonction. Par exemple tapez @kbd{M-x -ses-define-local-printer@key{ret}}, puis @kbd{note@key{ret}}, puis -@kbd{("%s")} pour définir une fonction d’impression nommée @code{note} -dont la définition est @code{("%s")}, puis sur la colonne @samp{B} tapez -@kbd{M-p note@key{ret}} - -@example -@group -A B - Revenu - 2.23 Frais de consultation - 0.02 Opinion informée - 15.76 Stand limonade - -4 Prêt à Joseph - 14.01 Total -@end group -@end example - -Si maintenant vous redéfinissez @code{note} avec pour nouvelle -définition @kbd{("*%s")} qui ajoute un astérisque @code{*} devant le -texte, la zone d’impression est modifiée ainsi : -@example -@group -A B - Revenu - 2.23 *Frais de consultation - 0.02 *Opinion informée - 15.76 *Stand limonade - -4 *Prêt à Joseph - 14.01 *Total -@end group -@end example - -Notez que la cellule @samp{B1} reste affichée vide et n’est pas -affichée comme @samp{*}. C’est parce que la valeur de la cellule est -@code{nil}, et que les fonctions d’impression définies à partir d’une -chaîne de formatage comme @code{"%s"} dans @code{("%s")} impriment -systématiquement @code{nil} comme une chaîne vide, et tentent -d’imprimer toute valeur non-@code{nil} en utilisant la fonction -standarde @code{format} avec la chaîne de formatage, et si cela -échoue, utilisent la fonction de repli @code{ses-prin1} la place. - -Si maintenant Joseph rembourse son prêt, vous pourriez effacer cette -case ; par ex.@: en positionnant le curseur sur la cellule A5 et en -appuyant sur @kbd{C-d}. Si vous faites celle le total imprimé dans la -cellule A6 affichera @samp{######}. La raison de cela est la valeur -dans une cellule vide est typiquement @code{nil} et que l’opérateur -@code{+} ordinaire échoue à gérer une telle valeur. Au lieu de vider -la cellule, vous pourriez littéralement saisir @samp{0}, ou supprimer -entièrement la ligne en utilisant @kbd{C-k}. Une alternative est -d’utiliser la fonction spéciale @code{ses+} au lieu du @code{+} -ordinaire : - -@example -(ses+ A2 A3 A4 A5) -@end example - -Pour rendre une formule robuste au changement de géométrie de la -feuille, vous pouvez utiliser la macro @code{ses-range} pour faire -référence à une plage de cellules par ses extrémités, par ex. : - -@example -(apply 'ses+ (ses-range A2 A5)) -@end example - -(Le @code{apply} est nécessaire parce que @code{ses-range} produite -une @emph{liste} de valeurs, ce qui ouvre des possibilités plus -complexes). - -Alternativement vous pouvez utiliser le modificateur @code{!} de -@code{ses-range} pour retirer les cellules vides de la liste renvoyée, -ce qui permet d’utiliser @code{+} au lieu de @code{ses+}: - -@lisp -(apply '+ (ses-range A2 A5 !)) -@end lisp - -@c =================================================================== - -@node The Basics -@comment node-name, next, previous, up -@chapter Les bases -@cindex commandes de base -@cindex base, commandes de -@findex ses-jump -@findex ses-mark-row -@findex ses-mark-column -@findex ses-mark-whole-buffer -@findex set-mark-command -@findex keyboard-quit - -Pour créer une nouveau tableur, visitez un fichier inexistant dont le -nom se termine en @file{.ses}. Par exemple, @kbd{C-x C-f essai.ses -@key{ret}}. - - -Un @dfn{identificateur de cellule} est un symbole avec une lettre de -colonne et un numéro de ligne. La cellule B7 est la 2e column de la -7e ligne. Pour les feuilles très larges, il ya deux lettres de -colonne : la cellule AB7 les la 28e colonne de la 7e ligne. Les -feuilles encore plus larges ont AAA1, etc. On se déplace avec les -commandes ordinaires de déplacement d’Emacs. - -@table @kbd -@item j -Déplace le point vers la cellule spécifiée par identificateur -(@code{ses-jump}). À moins que la cellule ne soit une cellule -renommée, l’identificateur est insensible à la casse. Un argument -préfixe @math{n} déplace vers la cellule de coordonnées @math{(n\div -R, n \% C)} pour une feuille de @math{R} ligne et @math{C} colonnes, -et @samp{A1} étant aux coordonnées @math{(0,0)}. La façon dont -l’identificateur ou l’argument préfixe de commande sont interprétés -peut être personnalisée via les variables -@code{ses-jump-cell-name-function} et @code{ses-jump-prefix-function}. -@end table - -Le Point est toujours sur le bord de gauche d’une cellule, ou à la fin -de ligne vide. Quand la marque est inactive, la cellule courante est -soulignée. Quand la marque est active, la plage est le rectangle de -cellules mis en vedette (@acronym{SES} utilise toujours le mode de -marque transitoire). Faire glisser la souris de @samp{A1} à @samp{A3} -crée la plage @samp{A1-A2}. Beaucoup de commandes @acronym{SES} -opèrent seulement sur une seule cellule, et non sur une plage. - -@table @kbd -@item C-@key{SPC} -@itemx C-@@ -Règle la marque au point (@code{set-mark-command}). - -@item C-g -Désactive la marque (@code{keyboard-quit}). - -@item M-h -Met en vedette la ligne courante (@code{ses-mark-row}). - -@item S-M-h -Met en vedette la colonne courante (@code{ses-mark-column}). - -@item C-x h -Mettre en vedette toutes les cellules (@code{mark-whole-buffer}). -@end table - -@menu -* Formules: Formulas. -* Redimensionner: Resizing. -* Fonctions d’impression: Printer functions. -* Effacer des cellules: Clearing cells. -* Copier/couper/coller: Copy/cut/paste. -* Personnaliser @acronym{SES}: Customizing @acronym{SES}. -@end menu - -@node Formulas -@section Formules de cellule -@cindex formules -@cindex formules, saisire -@cindex valeurs -@cindex valeurs de cellule -@cindex éditer des cellules -@findex ses-read-cell -@findex ses-read-symbole -@findex ses-edit-cell -@findex ses-recalculate-cell -@findex ses-recalculate-all - -Pour insérer une valeur dans une cellule, tapez juste une expression -numérique, un @samp{"texte entre guillemets anglais"}, ou une -expression Lisp. - -@table @kbd -@item 0..9 -Auto-insérer un nombre (@code{ses-read-cell}). - -@item - -Auto-insérer un nombre négatif (@code{ses-read-cell}). - -@item . -Auto-insérer un nombre décimal (@code{ses-read-cell}). - -@item " -Auto-insérer une chaîne de caractères. Le guillemet anglais de -terminaison est inséré automatiquement (@code{ses-read-cell}). - -@item ( -Auto-insérer une expression. La parenthèse de droite est insérée -automatiquement (@code{ses-read-cell}). Pour accéder à la valeur -d’une autre cellule, il suffit d’utiliser son identificateur dans -votre expression. Dès que l’autre cellule change, la formule de cette -cellule-ci est réévaluée. En tapant l’expression, vous pouvez -utiliser les raccourcis clavier suivants : -@table @kbd -@item M-@key{TAB} -pour compléter les noms de symboles, et -@item C-h C-n -pour lister les symboles de cellules renommées dans un tampon d’aide. -@end table - -@item ' @r{(apostrophe)} -Entrer un symbole (@code{ses-read-symbol}). @acronym{SES} se souvient -de tous les symboles qui ont été utilisés comme formules, de sorte que -vous pouvez taper juste le début d’un symbole et utiliser -@kbd{@key{SPC}}, @kbd{@key{TAB}}, et @kbd{?} pour le compléter. -@end table - -Pour saisire quelque-chose d’autre (par ex., un vecteur), commencer -avec un chiffre, puis effacer le chiffre et tapez ce que vous désirez. - -@table @kbd -@item @key{RET} -Édite la formule existante dans la cellule courante (@code{ses-edit-cell}). - -@item C-c C-c -Force le recalcul de la cellule ou plage courante (@code{ses-recalculate-cell}). - -@item C-c C-l -Recalcule la feuille entière (@code{ses-recalculate-all}). -@end table - -@node Resizing -@section Redimensionner la feuille -@cindex redimensionner des feuilles -@cindex dimensions -@cindex ligne, ajout ou suppression -@cindex colonne, ajout ou suppression -@cindex ajouter des lignes ou colonnes -@cindex insérer des lignes ou colonnes -@cindex enlever des lignes ou colonnes -@cindex supprimer des lignes ou colonnes -@findex ses-insert-row -@findex ses-insert-column -@findex ses-delete-row -@findex ses-delete-column -@findex ses-set-column-width -@findex ses-forward-or-insert -@findex ses-append-row-jump-first-column - - -Commande de base : - -@table @kbd -@item C-o -(@code{ses-insert-row}) - -@item M-o -(@code{ses-insert-column}) - -@item C-k -(@code{ses-delete-row}) - -@item M-k -(@code{ses-delete-column}) - -@item w -(@code{ses-set-column-width}) - -@item @key{TAB} -Déplace le point sur la prochaine cellule vers la droite, ou insère -une nouvelle colonne si on est déjà sur la dernière cellule de la -ligne, ou insère une nouvelle ligne si on est sur la ligne de -terminaison (@code{ses-forward-or-insert}). - -@item C-j -Insère une nouvelle ligne sous la ligne courante et va à la colonne A -de cette ligne (@code{ses-append-row-jump-first-column}). -@end table - -En redimensionnant la feuille (à moins que vous ne fassiez que changer -la largeur d’une colonne) les références de cellule au sein des -formules sont toutes relocalisées de sorte à continuer à faire -référence aux mêmes cellules. Si une formule mentionne B1 et que vous -insérez une nouvelle première ligne, alors la formule mentionnera B2. - -Si vous supprimez une cellule à laquelle une formule fait référence, -le symbole de cellule est supprimé de la formule, de sorte que -@code{(+ A1 B1 C1)} après suppression de la troisième colonne devient -@code{(+ A1 B1)}. Au cas où cela ne serait pas ce que vous désiriez : - -@table @kbd -@item C-_ -@itemx C-x u -Défait l’action action précédente (@code{(undo)}). -@end table - - -@node Printer functions -@section Fonctions d’impression -@cindex fonctions d’impression -@cindex formatage de cellule -@cindex cellules, formater - -Les fonctions d’impression convertissent des valeurs binaires de -cellule en formes d’impression qu’Emacs affiche à l’écran. - -@menu -* Différents types de fonctions d’impression: Various kinds of printer functions. -* Configurer quelle fonction d’impression s’applique: Configuring what printer function applies. -* Les fonctions d’impression standardes: Standard printer functions. -* Les fonctions d’impression locales: Local printer functions. -* Écrire une fonctions d’impression lambda: Writing a lambda printer function. -@end menu - -@node Various kinds of printer functions -@subsection Différents types de fonctions d’impression - -Lorsque on configure quelle fonction d’impression s’applique -(@pxref{Configuring what printer function applies}), on peut saisir -une fonction d’impression comme l’une des possibilités suivantes : - -@itemize -@item -Une chaîne de formatage, telle que @samp{"$%.2f"}. la chaîne formatée -résultante est alignée à droite au sein de la cellule -d’impression. Pour obtenir un alignement à gauche, utilisez des -parenthèses : @samp{("$%.2f")}. -@item -Une fonction d’impression peut aussi être une fonction à un argument -dont la valeur renvoyée est une chaîne (pour obtenir un alignement à -droite) ou une liste d’une chaîne (pour obtenir un alignement à -gauche). Une telle fonction peut à son tour être configurée comme : -@itemize -@item -Une expression lambda, par exemple : - -@lisp -(lambda (x) - (cond - ((null x) "") - ((numberp x) (format "%.2f" x)) - (t (ses-center-span x ?# 'ses-prin1)))) -@end lisp - -Pendant la saisie d’une lambda, vous pouvez utiliser @kbd{M-@key{TAB}} -pour completer les noms de symboles. -@item -Un symbole faisant référence à une fonction d’impression standarde -(@pxref{Standard printer functions}). -@item -Un symbole faisant référence à une fonction d’impression locale -(@pxref{Local printer functions}). -@end itemize - - -@end itemize - - -@node Configuring what printer function applies -@subsection Configurer quelle fonction d’impression s’applique - -Chaque cellule a une fonction d’impression. Si c’est @code{nil}, -alors la fonction d’impression de la colonne de cette cellule est -utilisée. Et si cela est aussi @code{nil}, alors la fonction -d’impression par défaut de la feuille est utilisée. - -@table @kbd -@item p -@findex ses-read-cell-printer -Saisit une fonction d’impression pour la cellule ou plage courante -(@code{ses-read-cell-printer}). - -@item M-p -@findex ses-read-column-printer -Saisit une fonction d’impression pour la colonne courante (@code{ses-read-column-printer}). - -@item C-c C-p -@findex ses-read-default-printer -Saisit la fonction d’impression par défaut de la feuille -(@code{ses-read-default-printer}). -@end table - -Les commandes @code{ses-read-@var{xxx}-printer} permettent les commandes -suivantes pendant l’édition: - -@table @kbd -@item @key{arrow-up} -@itemx @key{arrow-down} -Pour parcourir l’historique : les commandes -@code{ses-read-@var{xxx}-printer} ont leur propre historique de -mini-tampon, il est préchargé avec l’ensemble de toutes les fonctions -d’impression utilisées dans cette feuille, plus les fonctions -d’impression standardes (@pxref{Standard printer functions}) et les -fonctions d’impression locales (@pxref{Local printer functions}). -@item @key{TAB} -Pour compléter les symboles de fonctions d’impression locales, et -@item C-h C-p -Pour lister les fonctions d’impression locales dans un tampon d’aide. -@end table - - -@node Standard printer functions -@subsection Les fonctions d’impression standardes - - -Mise à part @code{ses-prin1}, les autres fonctions d’impression -standardes ne conviennent que pour les cellules, et non pour les -colonnes ou comme fonction d’impression par défaut de la feuille, -parce qu’elles formatent la valeur en utilisant la fonction -d’impression de colonne (ou par défaut si @code{nil}) et ensuite -post-traite le résultat, par ex.@: le centre : - -@ftable @code -@item ses-center -Centre juste. - -@item ses-center-span -Centrer en débordant sur les cellules vides suivantes. - -@item ses-dashfill -Centrer en utilisant des tirets (@samp{-}) au lieu d’espaces. - -@item ses-dashfill-span -Centrer avec tirets et débordement. - -@item ses-tildefill-span -Centrer avec tildes (@samp{~}) et débordement. - -@item ses-prin1 -C’est la fonction d’impression de repli, utilisée quand l’appel à la -fonction d’impression configurée envoie une erreur. -@end ftable - -@node Local printer functions -@subsection Les fonctions d’impression locales - -@findex ses-define-local-printer -Vous pouvez définir une fonction d’impression locale à la feuille avec -la commande @code{ses-define-local-printer}. Par exemple, définissez -une fonction d’impression @samp{toto} à @code{"%.2f"}, et ensuite -utilisez le symbole @samp{toto} comme fonction d’impression. Ensuite, -si vous rappelez @code{ses-define-local-printer} sur @samp{toto} pour -le redéfinir comme @code{"%.3f"}, alors toutes les cellules utilisant -la fonction d’impression @samp{toto} seront re-imprimées conformément. - -Il peut arriver que vous désiriez définir ou redéfinir certaines -fonctions d’impression à chaque fois que vous ouvrez une feuille. Par -exemple, imaginez que vous désiriez définir/re-définir automatiquement -une fonction d’impression locale @code{euro} pour afficher un nombre -comme une somme en euros, par exemple le nombre @code{3.1} serait -affiché comme @code{3.10@dmn{}@euro{}}. Pour faire cela dans tout -tampon SES qui n’est pas en lecture seule, vous pouvez ajouter ce -genre de code à votre fichier d’init @file{.emacs} : - -@lisp -(defun my-ses-mode-hook () - (unless buffer-read-only - (ses-define-local-printer - 'euro - (lambda (x) - (cond - ((null x) "") - ((numberp x) (format "%.2f€" x)) - (t (ses-center-span x ?# 'ses-prin1))))))) -(add-hook 'ses-mode-hook 'my-ses-mode-hook) -@end lisp - -Si vous remplacez la commande @code{ses-define-local-printer} par la -fonction @code{ses-define-if-new-local-printer} -@findex ses-define-if-new-local-printer -la définition ne se produira que si aucune fonction d’impression de -même nom n’est déjà définie. - - -@node Writing a lambda printer function -@subsection Écrire une fonctions d’impression lambda - -Vous pouvez écrire une fonction d’impression avec une expression -lambda prenant un seul argument en deux cas : - -@itemize -@item -quand vous configurez la fonction d’impression s’appliquant à -une cellule ou colonne, ou -@item -quand vous définissez une fonction d’impression avec la commande -@code{ses-define-local-printer}. -@end itemize - -En faisant cela, prenez garde à ce que la valeur renvoyée soit une -chaîne, ou une liste contenant une chaîne, même quand l’argument -d’entrée a une valeur inattendue. Voici un exemple : - -@example -(lambda (val) - (cond - ((null val) "") - ((and (numberp val) (>= val 0)) (format "%.1f" val)) - (t (ses-center-span val ?# 'ses-prin1)))) -@end example - -Cet exemple fait ceci : - -@itemize -@item -Quand la cellule est vide (c.-à-d.@: quand @code{val} est @code{nil}), -imprime une chaîne vide @code{""} -@item -Quand la valeur de cellule est un nombre positif ou nul, formate la -valeur en notation à virgule fixe avec une decimale après la virgule -@item -Sinon, gère la valeur comme erronnée en l’imprimant comme une -s-expression (avec @code{ses-prin1}), centrée et entourée de -croisillons @code{#} de bourrage. -@end itemize - -Une autre précaution à prendre est d’éviter un débordement de pile à -cause d’une fonction d’impression se rappelant elle-même sans -fin. Cette erreur peut se produire quand vous utilisez une fonction -d’impression locale comme fonction d’impression de colonne, et que -cette fonction d’impression locale appelle implicitement la fonction -d’impression de colonne courante, ainsi elle se rappelle elle-même -récursivement. Imaginez par exemple que vous désirez créer une -fonction d’impression locale @code{=bourre} qui centre le contenu -imprimé d’une cellule et l’entoure de signes égal @code{=}, et que -vous le faites (erronnément) comme cela : - -@lisp -;; CODE ERRONÉ -(lambda (x) - (cond - ((null x) "") - (t (ses-center x 0 ?=)))) -@end lisp - -Comme @code{=bourre} utilise la fonction d’impression standarde -@code{ses-center} mais sans lui passer exemplicitement une fonction -d’impression, @code{ses-center} appelle la fonction d’impression de -colonne courante s’il y en a une, ou la fonction d’impression par -défaut de la feuille sinon. Aussi, utiliser @code{=bourre} comme -fonction d’impression de colonne aura pour résultat de causer un -débordement de pile dans cette colonne sur toute cellule non vide, -puisque @code{ses-center} rappelle récursivement la fonction qui l'a -appelé. @acronym{SES} ne vérifie pas cela ; il vous faut donc faire -attention. Par exemple, reécrivez @code{=bourre} ainsi : - -@lisp -(lambda (x) - (cond - ((null x) "") - ((stringp x) (ses-center x 0 ?= " %s ")) - (t (ses-center-span x ?# 'ses-prin1)))) -@end lisp - -Le code ci-dessus est réparé au sens où @code{ses-center} et -@code{ses-center-span} sont toutes deux appelées avec un dernier -argument @var{printer} explicite spécifiant la fonction d'impression, -respectivement @code{" %s "} et @code{'ses-prin1}. - - -Le code ci-dessus applique le bourrage de @code{=} seulement aux -chaînes ; et aussi il entoure la chaîne par un espace de chaque côté -avant de bourrer avec des signes @code{=}. Ainsi la chaîne @samp{Ula} -s’affichera comme @samp{@w{=== Ula ===}} dans une colonne large de 11 -caractères. Toute valeur qui n’est ni @code{nil} (c.-à-d.@: une -cellule vide) ni une chaîne est affichée comme une erreur par l’usage -de bourrage par des croisillons @code{#}. - -@node Clearing cells -@section Effacer des cellules -@cindex effacer, commandes -@findex ses-clear-cell-backward -@findex ses-clear-cell-forward - -Ces commandes règlent à la fois la formule et la fonction d’impression -à @code{nil} : - -@table @kbd -@item @key{DEL} -Se deplace à gauche et efface la cellule (@code{ses-clear-cell-backward}). - -@item C-d -Efface la cellule et se déplace à droite (@code{ses-clear-cell-forward}). -@end table - - -@node Copy/cut/paste -@section Copier, couper, et coller -@cindex copier -@cindex couper -@cindex coller -@findex kill-ring-save -@findex mouse-set-region -@findex mouse-set-secondary -@findex ses-kill-override -@findex yank -@findex clipboard-yank -@findex mouse-yank-at-click -@findex mouse-yank-at-secondary -@findex ses-yank-pop - -Les fonctions de copie opèrent sur des regions rectangulaires de -cellules. Vous pouvez coller les copies dans des tampons -non-@acronym{SES} pour exporter le texte d’impression. - -@table @kbd -@item M-w -@itemx [copy] -@itemx [C-insert] -Copie les cellules en vedette vers l’anneau presse-papier et le -presse-papier primaire (@code{kill-ring-save}). - -@item [drag-mouse-1] -Marque une region et la copie vers l’anneau presse-papier et le -presse-papier primaire (@code{mouse-set-region}). - -@item [M-drag-mouse-1] -Marque une region et la copie vers l’anneau presse-papier et le -presse-papier secondaire (@code{mouse-set-secondary}). - -@item C-w -@itemx [cut] -@itemx [S-delete] -Les fonctions couper ne suppriment pas en fait de lignes ou de -colonnes --- elles les copient et puis les effacent -(@code{ses-kill-override}). - -@item C-y -@itemx [S-insert] -Colle à partir de l’anneau presse-papier (@code{yank}). Les fonctions -coller se comportent différemment selon le format du texte qu’elles -insèrent : -@itemize @bullet -@item -Quand on colle des cellules qui ont été coupées ou copiées à partir -d’un tampon @acronym{SES}, le texte d’impression est ignoré et -seulement la formule et fonction d’impression jointes sont insérées ; -les références de cellule de la formule sont relocalisées à moins que -vous n’utilisiez @kbd{C-u}. -@item -Le texte collé écrase un rectangle de cellules dont le coin haut -gauche est la cellule courante. Si une partie du rectangle est -au-délà des bords de la feuille, vous devez confirmer l’augmentation -de la taille de la feuille. -@item -Du texte Non-@acronym{SES} est d’ordinaire inséré comme formule de -remplacement pour la cellule courante. Si la formule serait un -symbole, elle est traitée comme une chaîne à moins que vous -n’utilisiez @kbd{C-u}. Les formules collées comprenant des erreurs de -syntaxe sont toujours traitées comme des chaînes. -@end itemize - -@item [paste] -Colle à partir du presse-papier primaire ou de l’anneau presse-papier -(@code{clipboard-yank}). - -@item [mouse-2] -Règle le point et colle à partir du presse-papier primaire -(@code{mouse-yank-at-click}). - -@item [M-mouse-2] -Règle le point et colle à partir du presse-papier secondaire -(@code{mouse-yank-secondary}). - -@item M-y -Immédiatement après un coller, vous pouvez remplacer le texte avec un -élément précédent à partir de l’anneau presse-papier -(@code{ses-yank-pop}). Contrairement au yank-pop standard d’Emacs, la -version de @acronym{SES} utilise @code{undo} pour supprimer l’ancien -collage. Est-ce que cela ne fait aucune différence ? -@end table - -@node Customizing @acronym{SES} -@section Personnaliser @acronym{SES} -@cindex personnaliser -@vindex enable-local-eval - -Par défaut, une feuille venant d’être créée a 1 ligne et 1 colonne. -La largeur de colonne est 7 et la fonction d’impression par défaut est -@samp{"%.7g"}. Chacune de ces choses peut être personnalisée. Allez -voir dans le groupe « ses ». - -Après avoir saisi une valeur de cellule, normalement -@code{forward-char} est appelé, ce qui déplace le point vers la -cellule suivante à droite, ou à la première cellule à gauche de la -ligne suivante si la cellule courante est la plus à droite de la -feuille. Vous pouvez personnaliser @code{ses-after-entry-functions} -pour que le déplacement soit vers la gauche ou le haut ou le bas. -Pour un mouvement diagonal, selectionnez deux fonctions de la liste. - -@vindex ses-jump-cell-name-function -@code{ses-jump-cell-name-function} est une variable personnalisable -réglée par défaut à la fonction @code{upcase}. Cette fonction est -appelée quand vous passez un nom de cellule à la commande -@command{ses-jump} (@kbd{j}), et que ce nom n’est pas le nom d’une -cellule renommée. Elle change le nom de cellule saisi en celui de la -cellule vers laquelle sauter. Le réglage par défaut @code{upcase} vous -permet de saisir le nom de cellule en bas de casse. Un autre usage de -@code{ses-jump-cell-name-function} pourrait être une -internationalisation pour convertir des caractères non latins en -équivalents latins pour nommer la cellule. Au lieu d’un nom de -cellule, la fonction peut renvoyer des coordonnées de cellule sous la -forme d’un cons, par exemple @code{(0 . 0)} pour la cellule @code{A1}, -@code{(1 . 0)} pour la cellule @code{A2}, etc. - -@vindex ses-jump-prefix-function -@code{ses-jump-prefix-function} est une variable personnalisable -réglée par défaut à la fonction @code{ses-jump-prefix}. Cette fonction -est appelée quand vous donnez un argument préfixe à la commande -@command{ses-jump} (@kbd{j}). Elle renvoie un nom de cellule ou des -coordonnées de cellule correspondant à l’argument préfixe. Les -coordonnées de cellule sont sous la forme d’un cons, par exemple -@code{(1 . 0)} pour la cellule @code{A2}. Le réglage par défaut -@code{ses-jump-prefix} numérote les cellules de gauche à droite et -puis de haut en bas, de sorte que si on suppose une feuille 4×3, -l’argument préfixe @samp{0} saute à la cellule @samp{A1}, l’argument -préfixe @samp{2} saute à @samp{C1}, l’argument préfixe @samp{3} saute -à @samp{A2}, etc. - -@vindex ses-mode-hook -@code{ses-mode-hook} est un crochet de mode normal (une liste de -fonctions qui s’exécutent quand le mode @acronym{SES} démarre sur un -tampon). - -@vindex safe-functions -La variable @code{safe-functions} est une liste de fonctions -potentiellement risquées à traiter comme si elles étaient sûres lors -de l’analyse des formules et fonctions d’impression. @xref{Virus -protection}. Avant de personnaliser @code{safe-functions}, -réfléchissez à quel point vous faites confiance à la personne qui vous -suggère cette modification. La valeur @code{t} désactive toute -protection anti-virus. Une valeur donnant une liste-de-fonctions peut -rendre une feuille « trop bien », mais elle crée aussi des portes -dérobées dans votre armure anti-virus. Pour que votre protection -contre les virus fonctionne, vous devez toujours appuyer sur @kbd{n} -quand un avertissement contre un virus vous est présenté, à moins que -vous compreniez ce que le code en question essaie de faire. N’écoutez -pas ceux qui vous racontent de personnaliser @code{enable-local-eval} ---- cette variable est pour les gens qui ne portent pas de ceinture de -sécurité ! - - -@c =================================================================== - -@node Advanced Features -@chapter Fonctions avancées -@cindex avancées, fonctions -@findex ses-read-header-row - - -@table @kbd -@item C-c M-C-h -(@code{ses-set-header-row}). -@findex ses-set-header-row -@kindex C-c M-C-h -La ligne d’en-tête au sommet de la fenêtre @acronym{SES} affiche -normalement la ligne de colonne pour chaque colonne. Vous pouvez la -régler pour afficher une copie de l’une des lignes, tell que qu’une -ligne de titres de colonnes, ainsi cette ligne sera toujours visible. -Par défaut la commande règle la ligne courante comme en-tête ; -utiliser C-u pour une invite à désigner la ligne d’en-têre. Régler la -ligne d’en-tête à la ligne 0 pour afficher les lettres de colonne de -nouveau. -@item [header-line mouse-3] -Affiche un menu pour régler la ligne courante comme en-tête, ou -revenir à des lettres de colonne. -@item M-x ses-rename-cell -@findex ses-rename-cell -Renomme une cellule pour passer d'un nom standard du genre de A1 à -toute chaîne pouvant être un nom valide pour une variable locale (Voir -aussi @ref{Nonrelocatable references}). -@item M-x ses-repair-cell-reference-all -@findex ses-repair-cell-reference-all -Quand vous interrompez la mise à jour d’une formule de cellule en -tapant @kbd{C-g}, alors cela peut casser le lien de référence de -cellule, ce qui compromet la mise à jour automatique de cellule quand -toute autre cellule dont elle dépend est modifiée. Pour réparer cela, -utilisez la fonction @code{ses-repair-cell-reference-all} -@end table - -@menu -* La zone d’impression: The print area. -* Plages dans les formules: Ranges in formulas. -* Trier par colonne: Sorting by column. -* Fonctions de formule standardes: Standard formula functions. -* Plus sur l’impression de cellule: More on cell printing. -* Import et export: Import and export. -* Protection contre les virus: Virus protection. -* Feuilles avec détails et synthèse: Spreadsheets with details and summary. -@end menu - -@node The print area -@section La zone d’impression -@cindex zone d’impression -@cindex impression, zone d’ -@findex widen -@findex ses-renarrow-buffer -@findex ses-reprint-all - -Un fichier @acronym{SES} consiste en une zone d’impression et une zone -de données. Normalement le tampon est réduit de sorte à n’afficher -que la zone d’impression. La zone d’impression est en lecture seule, -hormis pour les commandes spéciales de @acronym{SES} ; elle contient -les valeurs de cellule formatées par les fonctions d’impression. La -zone de données enregistre les formules, fonctions d’impression, etc. - -@table @kbd -@item C-x n w -Affiche à la fois les zones d’impression et de données (@code{widen}). - -@item C-c C-n -Affiche seulement la zone d’impression (@code{ses-renarrow-buffer}). - -@item S-C-l -@itemx M-C-l -Recrée la zone d’impression en réévaluant pour toutes les cellules sa -fonction d’impression (@code{ses-reprint-all}). -@end table - -@node Ranges in formulas -@section Plages dans les formules -@cindex plages -@findex ses-insert-plage-click -@findex ses-insert-plage -@findex ses-insert-ses-plage-click -@findex ses-insert-ses-plage -@vindex de -@vindex à - -Une formule du genre de : -@lisp -(+ A1 A2 A3) -@end lisp -est la somme de trois cellules spécifiques. Si vous insérez une -nouvelle deuxième ligne, la formule devient -@lisp -(+ A1 A3 A4) -@end lisp -et la nouvelle ligne n’est pas incluse dans la somme. - -La macro @code{(ses-range @var{de} @var{à})} s’évalue en une liste des -valeurs dans un rectangle de cellules. Si votre formule est -@lisp -(apply '+ (ses-range A1 A3)) -@end lisp -et que vous insérez une nouvelle deuxième ligne, elle devient -@lisp -(apply '+ (ses-range A1 A4)) -@end lisp -et la nouvelle ligne est incluse dans la somme. - -Alors que vous saisissez ou éditez une formule dans le minitampon, -vous pouvez sélectionner une plage dans la feuille (en utilisant la -souris ou le clavier), et injecter une représentation de cette plage -dans votre formule. Supposez que vous sélectionnez @samp{A1-C1} : - -@table @kbd -@item [S-mouse-3] -Insère @samp{A1 B1 C1} (@code{ses-insert-range-click}) - -@item C-c C-r -Version clavier (@code{ses-insert-range}). - -@item [C-S-mouse-3] -Insère @samp{(ses-range A1 C1)} (@code{ses-insert-ses-range-click}). - -@item C-c C-s -Version clavier (@code{ses-insert-ses-range}). -@end table - -Si vous supprimez la cellule @var{de} ou @var{à} d’une plage, la -cellule la plus proche toujours existante est utilisée à la place. Si -vous supprimez l’entière plage, le relocalisateur de formule supprime -le @samp{ses-range} de la formule. - -Si vous insérez une nouvelle ligne juste au delà de la fin d’une plage -à une colonne, ou une nouvelle colonne juste au delà d’une plage à une -ligne, la nouvelle cellule est incluse dans la plage. Les nouvelles -cellules insérées juste avant une plage ne sont pas incluses. - -Des fanions peuvent être ajoutés à @code{ses-range} immédiatement -après la cellule @var{à} . -@table @code -@item ! -Les cellules vides de la plage peuvent être enlevées en ajoutant le -fanion @code{!}. Une cellule vide est une cellule dont la valeur est -l’un des symboles @code{nil} ou @code{*skip*}. Par exemple -@code{(ses-range A1 A4 !)} fait la même chose que @code{(list A1 A3)} -quand les cellules @code{A2} et @code{A4} sont vides. -@item _ -Les valeurs de cellules vides sont remplacées par l’argument suivant -le fanion @code{_}, ou @code{0} quand le fanion @code{_} est le -dernier dans la liste d’arguments. Par exemple @code{(ses-range A1 A4 -_ "vide")} fera la même chose que @code{(list A1 "vide" A3 "vide")} -quand les cellules @code{A2} et @code{A4} sont vides. Similairement, -@code{(ses-range A1 A4 _ )} fera la même chose que @code{(list A1 0 A3 -0)}. -@item >v -Quand l’ordre a de l’importance, liste les cellules en lisant les -cellules ligne par ligne de la cellule en haut à gauche vers la -cellule en bas à droite. Ce fanion est fourni pour être complet car -c’est déjà l’ordre par défaut. -@item -Liste les cellules en lisant les cellules colonne par colonne de la -cellule en haut à gauche vers la cellule en bas à droite. -@item v< -Liste les cellules en lisant les cellules colonne par colonne de la -cellule en haut à droite vers la cellule en bas à gauche. -@item v -Un raccourci pour @code{v>}. -@item ^ -Un raccourci pour @code{^>}. -@item > -Un raccourci pour @code{>v}. -@item < -Un raccourci pour @code{>^}. -@item * -Au lieu de lister les cellules, en fait un vecteur ou une matrice Calc -(@pxref{Top,,,calc,GNU Emacs Calc Manual}). Si la plage contient -seulement une ligne ou une colonne un vecteur est fait, sinon une -matrice est faite. -@item *2 -Idem que @code{*} à ceci près qu’une matrice est toujours faite même -quand il y a une seule ligne ou colonne dans la plage. -@item *1 -Idem que @code{*} à ceci près qu’un vecteur est toujours fait même -quand il n’y a qu’une ligne ou colonne dans la plage, c.-à-d.@: que la -matrice correspondante est aplatie. -@end table - -@node Sorting by column -@section Trier par colonne -@cindex trier -@findex ses-sort-column -@findex ses-sort-column-click - -@table @kbd -@item C-c M-C-s -Trie les cellules d’une plage en utilisant l’une des colonnes -(@code{ses-sort-column}). Les lignes (ou lignes partielles si la -plage n’inclut pas toutes les colonnes) sont réarrangées de sorte que -la colonne choisie soit ordonnée. - -@item [header-line mouse-2] -La façon la plus facile de trier est de cliquer sur mouse-2 sur la -ligne d’en-tête de colonne (@code{ses-sort-column-click}). -@end table - -La comparaison du tri utilise @code{string<}, ce qui fonctionne bien -pour des nombres alignés à droite ou des chaînes alignées à gauche. - -Avec un argument préfixe, trie dans l’ordre descendant. - -Les lignes sont déplacées une à la fois, avec relocalisation des -formules. Ceci fonctionne bien si les formules font référence à -d’autres cellules dans leur ligne, mais non pas si bien pour des -formules qui font référence à d’autres lignes dans la plage ou à des -cellules hors de la plage. - - -@node Standard formula functions -@section Fonctions de formule standardes -@cindex fonctions standardes de formule -@cindex *skip* -@cindex *error* -@findex ses-delete-blanks -@findex ses-average -@findex ses+ - -Souvent on désire qu’un calcul exclue les cellules vides. Voici -quelques fonctions utiles à appeler dans vos formules : - -@table @code -@item (ses-delete-blanks &rest @var{args}) -Renvoie une liste dont toutes les cellules vides (dont la valeur est -soit @code{nil} ou @code{'*skip*}) ont été supprimées. L’ordre des -arguments est inversé. Prière de noter que @code{ses-range} a un -modificateur @code{!} qui permet de supprimer les cellules vides, -ainsi il est possible d’écrire : -@lisp -(ses-range A1 A5 !) -@end lisp -au lieu de -@lisp -(apply 'ses-delete-blanks (ses-range A1 A5 <)) -@end lisp - -@item (ses+ &rest @var{args}) -Somme des arguments non vides pris en ordre inverse. - -@item (ses-average @var{liste}) -Moyenne des éléments non vides de @var{liste}. Ici la liste est -passée comme un seul argument, vu que typiquement on la forme avec -@code{ses-range}. -@end table - -@node More on cell printing -@section Plus sur l’impression de cellule -@cindex cellule, plus sur l'impression -@cindex impression de cellule -@findex ses-truncate-cell -@findex ses-recalculate-cell - -Valeurs spéciales de cellule : -@itemize -@item nil -s’imprime typiquement de la même façon que "", mais permet que la -cellule précédente déborde dessus. -@item '*skip* -remplace nil quand la cellule précédente déborde effectivement ; rien -n’est donc imprimée pour cette cellule. -@item '*error* -indique que la formule a signalé une erreur au lieu de produire une -valeur : la cellule imprimée est remplie de croisillons (#). -@end itemize - -Lorsque la fonction d’impression est définie par une chaîne de -formatage, par ex. @samp{"%.3f"}, @acronym{SES} imprime -automatiquement @code{nil} comme une chaîne vide, mais si la fonction -d’impression est définie par une expression lambda, vous devez définir -explicitement comment @code{nil} est traité, par ex. : -@example -(lambda (x) - (cond - ((null x) "") - ((stringp x) (list x)) - ((numberp x) (format "%.3f" x)) - (t (ses-prin1 x))) -@end example -imprime @code{nil} comme une chaîne vide, aligne à gauche la valeur si -c’est une chaîne, et si c’est un nombre l’aligne à droite en -l’imprimant avec trois décimales. - -Il n’est pas nécessaire par contre que vous vous souciez de -@code{'*skip*} dans la définition d’une fonction d’impression, en -effet aucune fonction d’impression n’est appelée sur @code{'*skip*}. - -Si le résultat de la fonction d’impression est trop large pour la -cellule et que la cellule suivante est @code{nil}, le résultat -débordera sur la cellule suivante. Les résultats très larges peuvent -déborder sur plusieurs cellules. Si le résultat est trop large pour -l’espace disponible (jusqu'à la fin de la ligne ou la prochaine -cellule non-@code{nil}), le résultat est tronqué si la valeur de -cellule est une chaîne, ou remplacé par des croisillons (@samp{#}) -sinon. - -@acronym{SES} pourrait être perturbé par des résultats de fonction -d'impression contenant des sauts de ligne ou des tabulations, aussi -ces caractères sont remplacés par des points d'interrogation. - -@table @kbd -@item t -Confine une cellule à sa propre colonne (@code{ses-truncate-cell}). -Ceci vous permet de déplacer le point sur la cellule de droite qui -sinon serait couverte par un débordement. Si vous ne modifiez pas la -cellule de droite, la cellule confinée débordera de nouveau la -prochaine fois qu’elle sera imprimée. - -@item c -Appliquée à une seule cellule, cette commande affiche dans la zone -d’écho toute erreur de formule ou erreur d’impression survenue pendant -le recalcul/la réimpression (@code{ses-recalculate-cell}). Vous -pouvez utiliser cela pour défaire l’effet de @kbd{t}. -@end table - -Quand une fonction d’impression signale une erreur, la fonction -d’impression de repli -@findex ses-prin1 -@code{ses-prin1} lui est substituée. Ceci est utile quand votre -fonction d’impression de colonne est seulement numérique et que vous -utilisez une chaîne comme valeur de cellule. Notez que la fonction -d’impression par défaut standarde est @samp{"%.7g"} qui est numérique -seulement, ainsi les cellules auxquelles la fonction d’impression par -défaut standarde s’applique et qui ne sont pas vides et ne contiennent -pas un nombre utilisent la fonction d’impression de repli -@code{ses-prin1}, par ex.@: les cellules qui contiennent une chaîne -font cela. @kbd{c} sur de telles cellules affiche « Format specifier -doesn't match argument type ». - - -@node Import and export -@section Import et export -@cindex import et export -@cindex export, et import -@findex ses-export-tsv -@findex ses-export-tsf - -@table @kbd -@item x t -Exporte une plage de cellules comme des valeurs séparées par des -tabulations (@code{ses-export-tsv}). -@item x T -Exporte une plage de cellules comme des formules séparées par des -tabulations (@code{ses-export-tsf}). -@end table - -Le texte exporté va dans l’anneau presse-papier ; vous pouvez le -coller dans un autre tampon. Les colonnes sont séparées par des -tabulations, les lignes par des sauts de lignes. - -Pour importer du texte, utilisez n’importe laquelle des commandes -coller où le texte à coller contient des tabulations et/ou des sauts de -lignes. Les formules importées ne sont pas relocalisées. - -@node Virus protection -@section Protection contre les virus -@cindex virus protection - -À chaque fois une formule ou fonction d’impression est lue d’un -fichier ou est collée dans la feuille, elle est marquée comme -« nécessitant une vérification de sécurité ». Plus tard, quand la -formule ou la fonction d’impression est évaluée pour la première fois, -elle est vérifiée comme sûre en utilisant le prédicat @code{unsafep} ; -si elle s’avère « potentiellement risquée », la formule ou fonction -d’impression en question est affichée et vous devez appuyer @kbd{Y} -pour l’approuver ou @kbd{N} pour utiliser un substitut. Le substitut -signale toujours une erreur. - -Les formules ou fonctions d’impression que vous tapez sont -immédiatement vérifiées quant à leur sûreté. Si elles s’avèrent -potentiellement risquées et que vous appuyez @kbd{N} pour refuser, -l’action est annulée et l’ancienne formule ou fonction d’impression -demeure. - -En plus des virus (qui tentent de se recopier dans d’autres -fichiers), @code{unsafep} peut aussi détecter toutes sortes de chevaux -de Troie, tels que des feuilles de calcul qui effacent les fichiers, -envoient des courriels, inondent des sites Web, corrompent vos -réglages d’Emacs, etc. - -Généralement, les formules et fonctions d’impression de feuilles sont -des choses simples qui n’ont pas besoin de faire des traitements -exotiques, aussi toute partie potentiellement dangereuse de -l’environnement Emacs Lisp peut être exclus sans entraver votre style -comme écrivain de formule. Lisez la documentation dans -@file{unsafep.el} pour plus d’information sur la façon dont les formes -Lisp sont classifiées comme sûres ou risquées. - -@node Spreadsheets with details and summary -@section Feuilles avec détails et synthèse -@cindex détails et synthèse -@cindex synthèses, et détails - -Une organisation usuelle pour une feuille de calcul est d’avoir un tas -de lignes de « détail », chacune décrivant possiblement une -transaction, et ensuite un ensemble de lignes de « synthèse » qui -affichent chacune des données condensées pour un certain sous-ensemble -des détails. @acronym{SES} prend en charge ce type d’organisation via -la fonction @code{ses-select}. - -@table @code -@item (ses-select @var{de-plage} @var{test} @var{à-plage}) -Renvoie un sous-ensemble de @var{à-plage}. Pour chaque membre dans -@var{de-plage} qui est égal à @var{test}, le membre correspondant de -@var{à-plage} est inclus dans le résultat. -@end table - -Exemple d’utilisation : -@lisp -(ses-average (ses-select (ses-range A1 A5) 'Bidochon (ses-range B1 B5))) -@end lisp -Ceci calcule la moyenne des valeurs de la colonne @samp{B} pour les -lignes dont la valeur dans la colonne @samp{A} est le symbole -@samp{'Bidochon}. - -Vous vous demandez peut-être pourquoi les arguments de -@code{ses-select} ne consistent pas au lieu de @var{à-plage} de -décalages @var{décalage-à-la-ligne} et @var{décalage-à-la-colonne} -relativement à @var{de-plage} : spécifier @var{à-plage} explicitement -assure que la formule est recalculée si l’une quelconque des cellules -de cette plage est modifiée. - -Le fichier @file{etc/ses-example.el} dans la distribution Emacs est un -exemple d’une feuille organisée en détails-et-synthèse. - - -@c =================================================================== - -@node For Gurus -@chapter Pour les gourous -@cindex avancées, fonctions -@cindex fonctions avancées - -@menu -* Mises à jour différées: Deferred updates. -* Références non-relocalisables: Nonrelocatable references. -* La zone données: The data area. -* Variables locales-tampon dans les feuilles: Buffer-local variables in spreadsheets. -* Utilisation de advice-add dans @acronym{SES}: Uses of advice-add in @acronym{SES}. -@end menu - -@node Deferred updates -@section Mises à jour différées -@cindex différées, mises à jour -@cindex mises à jour différées -@vindex run-with-idle-timer - -Pour épargner du temps de calcul redondant, les cellules dont le -recalcul est rendu nécessaire par des changements dans d’autres -cellules sont ajoutées à un ensemble. À la fin de la commande, chaque -cellule de cet ensemble est recalculée une fois. Ceci peut créer un -nouvel ensemble de cellules nécessitant un recalcul. Ce processus est -répété jusqu'à ce que l’ensemble soit vide ou que des références -circulaires soient détectées. Dans les cas extrêmes, et notamment si -une référence circulaire est en cours de détection, vous pourriez voir -des messages de progression de la forme « Recalculating... (@var{nnn} -cells left) ». Si vous interrompez le calcul avec @kbd{C-g}, la -feuille demeurera dans un état incohérent, utilisez alors @kbd{C-_} ou -@kbd{C-c C-l} pour réparer cela. - -Pour épargner encore plus de temps en évitant les écritures -redondantes, les cellules qui sont modifiées sont ajoutées à un -ensemble au lieu d’être immédiatement écrites dans la zone de -données. Chaque cellule de cet ensemble est écrite une fois à la fin -de la commande. Si vous modifiez un grand nombre de cellules, vous -pourriez voir un message de progression de la forme -« Writing... (@var{nnn} cells left) ». Ces écritures différées de -cellules ne peuvent pas être interrompues par @kbd{C-g}, alors il vous -faudra juste attendre. - -@acronym{SES} utilise @code{run-with-idle-timer} pour déplacer le -souligné de cellule quand Emacs fait défiler le tampon à la fin d’une -commande, et aussi pour @c xxx narrow and underline -réduire et souligner après visiter un fichier. Ceci peut être visible -par une perturbation transitoire après visiter un fichier et certaines -commandes de défilement. Vous pouvez continuer à taper sans vous -inquiéter de cette perturbation. - - -@node Nonrelocatable references -@section Références non relocalisables -@cindex non-relocalisables, références -@cindex références non-relocalisables - -@kbd{C-y} relocalise toutes les références de cellule dans une formule -collée, alors que @kbd{C-u C-y} n’en relocalise aucune. Et pour les -cas mélangés ? - -La meilleure approche est de renommer les cellules que vous @emph{ne} -voulez @emph{pas} être relocalisables en utilisant -@code{ses-rename-cell}. -@findex ses-rename-cell -Les cellules qui n’ont pas un style de nom du genre de A1 ne sont pas -relocalisées au collage. En utilisant cette méthode, les cellules -concernées ne seront pas relocalisées quelle que soit la formule où -elles apparaissent. Prière toutefois de noter que dans une formule -contenant quelque plage @code{(ses-range @var{cell1} @var{cell2})} -alors dans la formule collée chacune des bornes @var{cell1} et -@var{cell2} de la plage est relocalisée, ou non, indépendemment, selon -qu’elle est nommée du genre de @samp{A1} ou renommée. - -Une méthode alternative est d’utiliser -@lisp -(symbol-value 'B3) -@end lisp -pour faire une @dfn{référence absolue}. Le relocalisateur de formule -saute par dessus tout ce qui est sous un @code{quote}, aussi cela ne -sera pas relocalisé quand on le colle ou quand des lignes/colonnes -sont insérées/supprimées. Toutefois, @samp{B3} ne sera pas -enregistrée comme une dépendance de cette cellule, et donc cette -cellule ne sera pas mise à jour automatiquement quand @samp{B3} est -modifiée, c’est pourquoi l’usage de @code{ses-rename-cell} est la -plupart du temps préférable. - -Les variables @code{row} et @code{col} sont liées dynamiquement -pendant l’évaluation d’une formule de cellule. Vous pouvez utiliser -@lisp -(ses-cell-value row 0) -@end lisp -pour obtenir la valeur de la colonne la plus à gauche de la ligne -courante. Ce type de dépendance n’est pas non plus enregistré. - - -@node The data area -@section La zone de données -@cindex données, zone de -@cindex zone de données -@findex ses-reconstruct-all - -Commence avec un caractère saut de page (de code ASCII 014 en octal), -suivi par un ensemble de macros de définition de cellule pour chaque -ligne, suivi par l’ensemble des définitions de fonctions d’impression -locales, suivi par les largeurs de colonnes, fonctions d’impression de -colonne, fonction d’impression par défaut, et ligne d’en-tête. Ensuite -il y a les paramètres globaux (ID de format fichier, nombre de lignes, -nombre de colonnes, nombre de fonctions d’impression locales) et les -variables locales (spécification du mode @acronym{SES} pour le tampon, -etc.). - -Quand un fichier @acronym{SES} est chargé, tout d’abord les paramètres -globaux sont chargés, puis l’ensemble de la zone de données est -@code{eval}ué, et finalement les variables locales sont traitées. - -Vous pouvez éditer la zone de données, mais n’insérez pas ni ne -supprimez de sauts de ligne, hormis dans la partie des variables -locales, en effet @acronym{SES} localise les choses en comptant les -sauts de ligne. Utilisez @kbd{C-x C-e} à la fin d’une ligne pour -installer ce que vous avez édité dans les structures de données de la -feuille (ceci ne met pas à jour la zone d’impression, utilisez, par -ex., @kbd{C-c C-l} pour cela). - -La zone de données est maintenue comme une image des structures de -données de la feuille stockée dans des variables locales tampon au -moment du chargement initial de la zone. Si le contenu de la zone de -données se trouve corrompu par la suite, vous pouvez essayer de -reconstruire la zone de données à partir des structures de données -avec : - -@table @kbd -@item C-c M-C-l -(@code{ses-reconstruct-all}). -@end table - - -@node Buffer-local variables in spreadsheets -@section Les variables locales-tampon dans les feuilles de calcul -@cindex locales-tampon, variables -@cindex variables locales-tampon - -Vous pouvez ajouter des variables locales supplémentaires à la liste -au bas de la zone de données, telles que des constantes cachées -auxquelles vous désirez faire référence dans vos formules. - -Vous pouvez initialiser la variable @code{ses--symbolic-formulas} pour -être une liste de symboles (comme une suite de chaînes entre -parenthèses) à proposer comme complétions pour la commande @kbd{'}. -Cette liste initiale de complétions sera utilisée à la place de -l’ensemble effectif des symboles-comme-formules de la feuille. - -Pour un exemple de ceci, voir le fichier @file{etc/ses-example.ses}. - -Si (pour une raison quelconque) vous désirez que vos formules ou -fonctions d’impression sauvegardent des données dans des variables, -vous devez déclarer ces variables comme locales tampon pour éviter un -avertissement de virus. - -Vous pouvez définir des fonctions en en faisant des valeurs pour la -fausse variable locale @code{eval}. De telles fonctions peuvent -ensuite être utilisées dans les formules et comme fonctions -d’impression, mais d’ordinaire chaque @code{eval} est présenté à -l’utilisateur pendant le chargement du fichier comme un virus -potentiel. Et cela peut devenir gênant. - -Vous pouvez définir des fonctions dans votre fichier @file{.emacs}. -Toute personne pourra encore lire la zone d’impression de votre -feuille, mais ne pourra pas recalculer ou réimprimer quoi que ce soit -qui dépende de vos fonctions. Pour éviter des avertissements contre -les virus, chaque fonction utilisée dans une formule nécessite -@lisp -(put 'le-nom-de-votre-fonction 'safe-function t) -@end lisp - -@node Uses of advice-add in @acronym{SES} -@section Utilisation de advice-add dans @acronym{SES} -@findex advice-add -@findex copy-region-as-kill -@findex yank - -@table @code -@item copy-region-as-kill -Quand on copie de la zone d’impression d’une feuille, traite la région -comme un rectangle et joint pour chaque cellule sa formule et sa -fonction d’impression comme des propriétés @code{'ses}. - -@item yank -Quand on colle dans la zone d’impression d’une feuille de calcul, -essaie de coller comme des cellules (si le texte à coller a des -propriétés @code{'ses}), ensuite comme des formules séparées par des -tabulations, ensuite (si tout le reste a échoué) comme une seule -formule pour la cellule courante. -@end table - -@c =================================================================== -@node Index -@unnumbered Index - -@printindex cp - -@c =================================================================== - -@node Acknowledgments -@unnumbered Remerciements - -Codé par : -@quotation -@c jyavner@@member.fsf.org -Jonathan Yavner, -@c monnier@@gnu.org -Stefan Monnier, -@c shigeru.fukaya@@gmail.com -Shigeru Fukaya, -@c vincent.belaiche@@sourceforge.net -Vincent Belaïche -@end quotation - -@noindent -Manuel Texinfo de : -@quotation -@c jyavner@@member.fsf.org -Jonathan Yavner, -@c brad@@chenla.org -Brad Collins, -@c vincent.belaiche@@sourceforge.net -Vincent Belaïche -@end quotation - -@noindent -Idées de : -@quotation -@c christoph.conrad@@gmx.de -Christoph Conrad, -@c cyberbob@@redneck.gacracker.org -CyberBob, -@c syver-en@@online.no -Syver Enstad, -@c fischman@@zion.bpnetworks.com -Ami Fischman, -@c Thomas.Gehrlein@@t-online.de -Thomas Gehrlein, -@c c.f.a.johnson@@rogers.com -Chris F.A. Johnson, -@c lyusong@@hotmail.com -Yusong Li, -@c juri@@jurta.org -Juri Linkov, -@c maierh@@myself.com -Harald Maier, -@c anash@@san.rr.com -Alan Nash, -@c pinard@@iro.umontreal.ca -François Pinard, -@c ppinto@@cs.cmu.edu -Pedro Pinto, -@c xsteve@@riic.at -Stefan Reichör, -@c epameinondas@@gmx.de -Oliver Scholz, -@c rms@@gnu.org -Richard M. Stallman, -@c teirllm@@dms.auburn.edu -Luc Teirlinck, -@c jotto@@pobox.com -J. Otto Tennant, -@c jphil@@acs.pagesjaunes.fr -Jean-Philippe Theberge, -@c rrandresf@@hotmail.com -Andrés Ramírez -@end quotation - -@c =================================================================== - -@node GNU Free Documentation License -@appendix GNU Free Documentation License -@include doclicense.texi - -@bye -@c Local Variables: -@c ispell-dictionary: "fr" -@c End: -- cgit v1.2.3 From 42179750c5f3f722b1ce2f82d2b2e73bba8e4de8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 18 Feb 2024 09:49:16 +0200 Subject: Move translations-related files to do/translations/. --- doc/README | 204 ----- doc/fr/misc/ses-fr.texi | 1631 ---------------------------------- doc/translations/README | 204 +++++ doc/translations/fr/misc/ses-fr.texi | 1631 ++++++++++++++++++++++++++++++++++ 4 files changed, 1835 insertions(+), 1835 deletions(-) delete mode 100644 doc/README delete mode 100644 doc/fr/misc/ses-fr.texi create mode 100644 doc/translations/README create mode 100644 doc/translations/fr/misc/ses-fr.texi diff --git a/doc/README b/doc/README deleted file mode 100644 index 81b54c91a76..00000000000 --- a/doc/README +++ /dev/null @@ -1,204 +0,0 @@ -* Translating the Emacs manuals - -** Copyright assignment - -People who contribute translated documents should provide a copyright -assignment to the Free Software Foundation. See the 'Copyright -Assignment' section in the Emacs manual. - - -** Translated documents license - -The translated documents are distributed under the same license as the -original documents: the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation. - -See https://www.gnu.org/licenses/fdl-1.3.html for more information. - -If you have questions regarding the use of the FDL license in your -translation work that are not answered in the FAQ, do not hesitate to -contact the GNU project: https://www.gnu.org/contact/ - -** Location - -*** Texinfo source files - -The source files of the translated manuals are located in the doc/ -directory, under the directory whose name corresponds to the translated -language. - - E.g. French manuals sources are found under doc/fr. - -The structure of the language folders should match the structure of the -English manuals (i.e. include misc, man, lispref, lispintro, emacs). - -*** built files - -Translated deliverables in info format are built at release time and are -made available for local installation. - - -** Format - -The manuals and their translations are written in the Texinfo format -(with the exception of the org-mode manual that is written in org-mode -and of illustrations for the Introduction to Emacs Lisp Programming that -are written in eps). - -See https://www.gnu.org/software/Texinfo/ for more information. - -You should install the Texinfo utilities to be able to verify the -translated files, and refer to the Texinfo manual if you do not -understand the meaning of the various Texinfo declarations. - -Emacs has a Texinfo mode that properly highlights the Texinfo code to -make it easier to see which parts are text to be translated and which -parts are not. - - -*** Texinfo specific issues - -Until the Emacs/Texinfo projects provide better solutions, here are a -few rules to follow: - -- Under each @node, add an @anchor that has the same content at the -original English @node. - -- Translate the @node content but leave the @anchor in English. - -- Most Emacs manuals are set to include the docstyle.Texi file. This -file adds the @documentencoding UTF-8 directive to the targeted manual. -There is no need to add this directive in a manual that includes -docstyle.Texi. - -- Add a @documentlanguage directive that includes your language. - - E.g. @documentlanguage zh - -This directive has currently little effect but will be useful in the -future. - -- The @author directive can be used for the translator's name. - - E.g. @author traduit en français par Achile Talon - - -** Fixing the original document - -During the course of the translation, you might find parts of the -original document that need to be updated or otherwise fixed, or even -bugs in Emacs. If you do not intend to provide fixes right away, please -file a bug report promptly so someone can fix it soon. - -See the 'Bugs' section in the Emacs manual. - -** Sending contributions - -Send your contributions (either files or revisions) to -emacs-devel@gnu.org for review. - -Always send contributions in the format of the original document. Most -of the contents in the Emacs manuals are in Texinfo format, so do not -send contributions that are in derivative formats (e.g. info, html, -docbook, plain text, etc.) - -Before sending files for review, ensure that they have been properly -checked for spelling/grammar/typography by at least using the tools that -Emacs provides. - -You should also make sure that the Texinfo files build properly on your -system. - -Send your contributions as patches (git diff -p --stat), and prefer the -git format-patch form because the format allows easier review and easier -installation of the changes by someone with write access to the -repository. - -The Emacs project has a lot of coding, documentation and commenting -conventions. Sending such patches allows the project managers to make -sure that the contributions comply with the various conventions. - - -** Discussing translation issues - -Translation-related discussions are welcome on the emacs-devel list. -Discussions specific to your language do not have to take place in -English. - - -** Translation teams - -The number of words in the Emacs manuals is above 2,000,000 words and -growing. While one individual could theoretically translate all the -files, it is more practical to work in language teams. - -If you have a small group of translators willing to help, make sure that -the files are properly reviewed before sending them to emacs-devel (see -above). - -You are invited to refer to the translation-related documents that the -GNU Project maintains and to get in touch with your language's -translation team to learn from the practices they have developed over -the years. - -See https://www.gnu.org/server/standards/README.translations.html for -more information. - - -** Translation processes - -Emacs does not yet provide tools that significantly help the translation -process. A few useful functions would be - -- automatic lookup of a list of glossary items when starting to work on -a translation "unit" (paragraph or otherwise), such glossary terms -should be easily insertable at point, - -- automatic lookup of past translations to check for similarity and -improve homogeneity over the whole document set, such past translation -matches should be easily insertable at point, - -etc. - - -*** Using the PO format as an intermediate translation format - -Although the PO format has not been developed with documentation in -mind, it is well known among free software translation teams and you can -easily use the po4a utility to convert Texinfo to PO for work in -translation tools that support the PO format. - -See https://po4a.org for more information. - -However, regardless of the intermediate file format that you might use, -you should only send Texinfo files for review to emacs-devel. - - -*** Free tools that you can use in your processes - -A number of free software tools exist, outside the Emacs ecosystem, to -help translators (amateurs and professionals alike) with the translation -process. - -If you find that Emacs should implement some of their features, you are -welcome to provide patches to the Emacs project. - -Such tools include: - -- the GNOME Translation Editor, https://wiki.gnome.org/Apps/Gtranslator/ -- KDE's Lokalize, https://apps.kde.org/lokalize/ -- OmegaT, http://omegat.org -- the Okapi Framework, https://www.okapiframework.org -- pootle, https://pootle.translatehouse.org - -etc. - - -* Licence of this document - -Copyright (C) 2024 Free Software Foundation, Inc. - -Copying and distribution of this file, with or without modification, are -permitted in any medium without royalty provided the copyright notice -and this notice are preserved. This file is offered as-is, without any -warranty. diff --git a/doc/fr/misc/ses-fr.texi b/doc/fr/misc/ses-fr.texi deleted file mode 100644 index e1b9cac5fc3..00000000000 --- a/doc/fr/misc/ses-fr.texi +++ /dev/null @@ -1,1631 +0,0 @@ -\input texinfo @c -*- mode: texinfo; coding: utf-8; -*- -@c %**start of header -@setfilename ../../../../info/ses-fr.info -@documentlanguage fr -@documentencoding UTF-8 -@settitle @acronym{SES}: Le tableur simple d’Emacs -@include docstyle.texi -@setchapternewpage off -@syncodeindex fn cp -@syncodeindex vr cp -@syncodeindex ky cp -@c %**end of header - -@copying -Ce fichier documente @acronym{SES} : le tableur simple d’Emacs (Simple -Emacs Spreadsheet). - -Copyright @copyright{} 2002--2024 Free Software Foundation, Inc. - -@quotation -Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation; with no -Invariant Sections, with the Front-Cover Texts being ``A GNU Manual,'' -and with the Back-Cover Texts as in (a) below. A copy of the license -is included in the section entitled ``GNU Free Documentation License.'' - -(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and -modify this GNU manual.'' -@end quotation -@end copying - -@dircategory Emacs misc features -@direntry -* @acronym{SES}-fr: (ses-fr). Le tableur simple d’Emacs. -@end direntry - -@finalout - -@titlepage -@title @acronym{SES} -@subtitle Le tableur simple d’Emacs -@author Jonathan A. Yavner -@author @email{jyavner@@member.fsf.org} - -@page -@vskip 0pt plus 1filll -@insertcopying -@end titlepage - -@contents - -@c =================================================================== - -@ifnottex -@node Top -@comment node-name, next, previous, up -@top @acronym{SES}: Simple Emacs Spreadsheet - -@display -@acronym{SES} est mode majeur de GNU Emacs pour éditer des fichiers -tableur, c.-à-d.@: des fichiers contenant une grille rectangulaire de -cellules. Les valeurs des cellules sont spécifiées par des formules -pouvant se référer aux valeurs d’autres cellules. -@end display -@end ifnottex - -Pour les rapports d’anomalie, utiliser @kbd{M-x report-emacs-bug}. - -@insertcopying - -@menu -* Boniment: Sales Pitch. Pourquoi utiliser @acronym{SES}? -* Tuto: Quick Tutorial. Une introduction sommaire -* Les bases: The Basics. Les commandes de base du tableur -* Fonctions avancées: Advanced Features. Vous voulez en savoir plus ? -* Pour les gourous: For Gurus. Vous voulez en savoir @emph{encore plus} ? -* Index: Index. Index des concepts, fonctions et variables -* Remerciements: Acknowledgments. Remerciements -* Licence GNU pour la documentation libre: GNU Free Documentation License. La licence de cette documentation. -@end menu - -@c =================================================================== - -@node Sales Pitch -@comment node-name, next, previous, up -@chapter Boniment -@cindex features - -@itemize -- -@item Créer et éditer des feuilles de calcul avec un minimum de tracas. -@item Prise en charge complète du Défaire/Refaire/Sauvegarde auto. -@item Protection contre les virus enfouis dans les feuilles de calcul. -@item Les formules de cellule sont directement du code Emacs Lisp. -@item Fonctions d’impression pour contrôler l’apparence des cellules. -@item Raccourcis clavier intuitifs : C-o = insérer une ligne, M-o = insérer une colonne, etc. -@item « Débordement » des valeurs de cellule longues dans les cellules vides suivantes. -@item La ligne d’en-tête montre les lettres désignant les colonnes. -@item Autocomplétion pour la saisie des symboles de cellules nommées lors de la saisie des formules. -@item Couper, copier et coller peut transferer les formules et les fonctions d’impression. -@item Import and export de valeurs séparées par des tabulations, ou de formules séparées par des tabulations. -@item Format de fichier en texte, facile à bidouiller. -@end itemize - -@c =================================================================== - -@node Quick Tutorial -@chapter Tuto -@cindex introduction -@cindex tuto - -Si vous désirez être rapidement lancé et pensez que vous savez ce que -vous attendez d’un tableur simple, alors ce chapitre peut être tout ce -dont vous avez besoin. - -Premièrement, visitez un nouveau fichier avec pour extension de nom de -fichier @file{.ses}. Emacs vous présente alors une feuille de calcul -vide contenant une seule cellule. - -Commencez par saisir une ligne d’en-tête : @kbd{"Revenu@key{RET}}. Le -guillemet double @code{"} indique que vous saisissez une cellule -textuelle, il ne fait pas partie de la valeur de la cellule, et aucun -guillemet de fermeture n’est nécessaire. - -Pour insérer votre première valeur de revenu, vous devez d’abord -redimensionner la feuille. Appuyer sur la touche @key{TAB} pour -ajouter une nouvelle cellule et revenez à elle en remontant. -Saisissez un nombre, tel que @samp{2.23}. Puis continuer pour ajouter -quelques valeurs supplémentaires de revenu, par ex. : - -@example -@group -A - Revenu - 2.23 - 0.02 - 15.76 - -4.00 -@end group -@end example - -Pour additionner les valeurs entre elles, saisissez une expression -Lisp : - -@example -(+ A2 A3 A4 A5) -@end example - -Peut-être désirez vous ajouter une cellule à la droite de la cellule -@samp{A4} pour expliquer pourquoi vous avez une valeur négative. En -appuyant sur @kbd{TAB} dans cette cellule vous ajouter entièrement une -nouvelle colonne @samp{B} où vous pourrez ajouter une telle note. - -La colonne est assez étroite par défaut, mais en appuyant sur @kbd{w} -vous pouvez la redimensionner selon vos besoins. Faites la de 22 -caractères de large. Vous pouvez maintenant ajoutez des notes -descriptives pour chacune des cases, par ex.@: : - -@example -@group -A B - Revenu - 2.23 Frais de consultation - 0.02 Opinion informée - 15.76 Stand limonade - -4 Prêt à Joseph - 14.01 Total -@end group -@end example - -Par défaut, l’impression des valeurs de cellule se fait alignée à -droite, c’est la raison d’un tel alignement pour les notes dans la -colonne @samp{B}. Pour changer cela, vous pouvez saisir une fonction -d’impression pour la colonne entière, en utilisant par ex. @kbd{M-p -("%s")}. Le fait que @code{"%s"} soit contenu dans une liste indique à -@acronym{SES} que l’alignement est à faire à gauche. Vous pouvez -l’emporter sur la fonction d’impression de colonne pour l’une -quelconque de ses cellules en donnant une fonction d’impression par -cellule avec @kbd{p}. - -Vous pouvez nommer une fonction d’impression, et utiliser le nom de la -fonction à la place de sa définition, de sorte à faciliter la -modification de l’impression de toutes les cellules utilisant cette -fonction. Par exemple tapez @kbd{M-x -ses-define-local-printer@key{ret}}, puis @kbd{note@key{ret}}, puis -@kbd{("%s")} pour définir une fonction d’impression nommée @code{note} -dont la définition est @code{("%s")}, puis sur la colonne @samp{B} tapez -@kbd{M-p note@key{ret}} - -@example -@group -A B - Revenu - 2.23 Frais de consultation - 0.02 Opinion informée - 15.76 Stand limonade - -4 Prêt à Joseph - 14.01 Total -@end group -@end example - -Si maintenant vous redéfinissez @code{note} avec pour nouvelle -définition @kbd{("*%s")} qui ajoute un astérisque @code{*} devant le -texte, la zone d’impression est modifiée ainsi : -@example -@group -A B - Revenu - 2.23 *Frais de consultation - 0.02 *Opinion informée - 15.76 *Stand limonade - -4 *Prêt à Joseph - 14.01 *Total -@end group -@end example - -Notez que la cellule @samp{B1} reste affichée vide et n’est pas -affichée comme @samp{*}. C’est parce que la valeur de la cellule est -@code{nil}, et que les fonctions d’impression définies à partir d’une -chaîne de formatage comme @code{"%s"} dans @code{("%s")} impriment -systématiquement @code{nil} comme une chaîne vide, et tentent -d’imprimer toute valeur non-@code{nil} en utilisant la fonction -standarde @code{format} avec la chaîne de formatage, et si cela -échoue, utilisent la fonction de repli @code{ses-prin1} la place. - -Si maintenant Joseph rembourse son prêt, vous pourriez effacer cette -case ; par ex.@: en positionnant le curseur sur la cellule A5 et en -appuyant sur @kbd{C-d}. Si vous faites celle le total imprimé dans la -cellule A6 affichera @samp{######}. La raison de cela est la valeur -dans une cellule vide est typiquement @code{nil} et que l’opérateur -@code{+} ordinaire échoue à gérer une telle valeur. Au lieu de vider -la cellule, vous pourriez littéralement saisir @samp{0}, ou supprimer -entièrement la ligne en utilisant @kbd{C-k}. Une alternative est -d’utiliser la fonction spéciale @code{ses+} au lieu du @code{+} -ordinaire : - -@example -(ses+ A2 A3 A4 A5) -@end example - -Pour rendre une formule robuste au changement de géométrie de la -feuille, vous pouvez utiliser la macro @code{ses-range} pour faire -référence à une plage de cellules par ses extrémités, par ex. : - -@example -(apply 'ses+ (ses-range A2 A5)) -@end example - -(Le @code{apply} est nécessaire parce que @code{ses-range} produite -une @emph{liste} de valeurs, ce qui ouvre des possibilités plus -complexes). - -Alternativement vous pouvez utiliser le modificateur @code{!} de -@code{ses-range} pour retirer les cellules vides de la liste renvoyée, -ce qui permet d’utiliser @code{+} au lieu de @code{ses+}: - -@lisp -(apply '+ (ses-range A2 A5 !)) -@end lisp - -@c =================================================================== - -@node The Basics -@comment node-name, next, previous, up -@chapter Les bases -@cindex commandes de base -@cindex base, commandes de -@findex ses-jump -@findex ses-mark-row -@findex ses-mark-column -@findex ses-mark-whole-buffer -@findex set-mark-command -@findex keyboard-quit - -Pour créer une nouveau tableur, visitez un fichier inexistant dont le -nom se termine en @file{.ses}. Par exemple, @kbd{C-x C-f essai.ses -@key{ret}}. - - -Un @dfn{identificateur de cellule} est un symbole avec une lettre de -colonne et un numéro de ligne. La cellule B7 est la 2e column de la -7e ligne. Pour les feuilles très larges, il ya deux lettres de -colonne : la cellule AB7 les la 28e colonne de la 7e ligne. Les -feuilles encore plus larges ont AAA1, etc. On se déplace avec les -commandes ordinaires de déplacement d’Emacs. - -@table @kbd -@item j -Déplace le point vers la cellule spécifiée par identificateur -(@code{ses-jump}). À moins que la cellule ne soit une cellule -renommée, l’identificateur est insensible à la casse. Un argument -préfixe @math{n} déplace vers la cellule de coordonnées @math{(n\div -R, n \% C)} pour une feuille de @math{R} ligne et @math{C} colonnes, -et @samp{A1} étant aux coordonnées @math{(0,0)}. La façon dont -l’identificateur ou l’argument préfixe de commande sont interprétés -peut être personnalisée via les variables -@code{ses-jump-cell-name-function} et @code{ses-jump-prefix-function}. -@end table - -Le Point est toujours sur le bord de gauche d’une cellule, ou à la fin -de ligne vide. Quand la marque est inactive, la cellule courante est -soulignée. Quand la marque est active, la plage est le rectangle de -cellules mis en vedette (@acronym{SES} utilise toujours le mode de -marque transitoire). Faire glisser la souris de @samp{A1} à @samp{A3} -crée la plage @samp{A1-A2}. Beaucoup de commandes @acronym{SES} -opèrent seulement sur une seule cellule, et non sur une plage. - -@table @kbd -@item C-@key{SPC} -@itemx C-@@ -Règle la marque au point (@code{set-mark-command}). - -@item C-g -Désactive la marque (@code{keyboard-quit}). - -@item M-h -Met en vedette la ligne courante (@code{ses-mark-row}). - -@item S-M-h -Met en vedette la colonne courante (@code{ses-mark-column}). - -@item C-x h -Mettre en vedette toutes les cellules (@code{mark-whole-buffer}). -@end table - -@menu -* Formules: Formulas. -* Redimensionner: Resizing. -* Fonctions d’impression: Printer functions. -* Effacer des cellules: Clearing cells. -* Copier/couper/coller: Copy/cut/paste. -* Personnaliser @acronym{SES}: Customizing @acronym{SES}. -@end menu - -@node Formulas -@section Formules de cellule -@cindex formules -@cindex formules, saisire -@cindex valeurs -@cindex valeurs de cellule -@cindex éditer des cellules -@findex ses-read-cell -@findex ses-read-symbole -@findex ses-edit-cell -@findex ses-recalculate-cell -@findex ses-recalculate-all - -Pour insérer une valeur dans une cellule, tapez juste une expression -numérique, un @samp{"texte entre guillemets anglais"}, ou une -expression Lisp. - -@table @kbd -@item 0..9 -Auto-insérer un nombre (@code{ses-read-cell}). - -@item - -Auto-insérer un nombre négatif (@code{ses-read-cell}). - -@item . -Auto-insérer un nombre décimal (@code{ses-read-cell}). - -@item " -Auto-insérer une chaîne de caractères. Le guillemet anglais de -terminaison est inséré automatiquement (@code{ses-read-cell}). - -@item ( -Auto-insérer une expression. La parenthèse de droite est insérée -automatiquement (@code{ses-read-cell}). Pour accéder à la valeur -d’une autre cellule, il suffit d’utiliser son identificateur dans -votre expression. Dès que l’autre cellule change, la formule de cette -cellule-ci est réévaluée. En tapant l’expression, vous pouvez -utiliser les raccourcis clavier suivants : -@table @kbd -@item M-@key{TAB} -pour compléter les noms de symboles, et -@item C-h C-n -pour lister les symboles de cellules renommées dans un tampon d’aide. -@end table - -@item ' @r{(apostrophe)} -Entrer un symbole (@code{ses-read-symbol}). @acronym{SES} se souvient -de tous les symboles qui ont été utilisés comme formules, de sorte que -vous pouvez taper juste le début d’un symbole et utiliser -@kbd{@key{SPC}}, @kbd{@key{TAB}}, et @kbd{?} pour le compléter. -@end table - -Pour saisire quelque-chose d’autre (par ex., un vecteur), commencer -avec un chiffre, puis effacer le chiffre et tapez ce que vous désirez. - -@table @kbd -@item @key{RET} -Édite la formule existante dans la cellule courante (@code{ses-edit-cell}). - -@item C-c C-c -Force le recalcul de la cellule ou plage courante (@code{ses-recalculate-cell}). - -@item C-c C-l -Recalcule la feuille entière (@code{ses-recalculate-all}). -@end table - -@node Resizing -@section Redimensionner la feuille -@cindex redimensionner des feuilles -@cindex dimensions -@cindex ligne, ajout ou suppression -@cindex colonne, ajout ou suppression -@cindex ajouter des lignes ou colonnes -@cindex insérer des lignes ou colonnes -@cindex enlever des lignes ou colonnes -@cindex supprimer des lignes ou colonnes -@findex ses-insert-row -@findex ses-insert-column -@findex ses-delete-row -@findex ses-delete-column -@findex ses-set-column-width -@findex ses-forward-or-insert -@findex ses-append-row-jump-first-column - - -Commande de base : - -@table @kbd -@item C-o -(@code{ses-insert-row}) - -@item M-o -(@code{ses-insert-column}) - -@item C-k -(@code{ses-delete-row}) - -@item M-k -(@code{ses-delete-column}) - -@item w -(@code{ses-set-column-width}) - -@item @key{TAB} -Déplace le point sur la prochaine cellule vers la droite, ou insère -une nouvelle colonne si on est déjà sur la dernière cellule de la -ligne, ou insère une nouvelle ligne si on est sur la ligne de -terminaison (@code{ses-forward-or-insert}). - -@item C-j -Insère une nouvelle ligne sous la ligne courante et va à la colonne A -de cette ligne (@code{ses-append-row-jump-first-column}). -@end table - -En redimensionnant la feuille (à moins que vous ne fassiez que changer -la largeur d’une colonne) les références de cellule au sein des -formules sont toutes relocalisées de sorte à continuer à faire -référence aux mêmes cellules. Si une formule mentionne B1 et que vous -insérez une nouvelle première ligne, alors la formule mentionnera B2. - -Si vous supprimez une cellule à laquelle une formule fait référence, -le symbole de cellule est supprimé de la formule, de sorte que -@code{(+ A1 B1 C1)} après suppression de la troisième colonne devient -@code{(+ A1 B1)}. Au cas où cela ne serait pas ce que vous désiriez : - -@table @kbd -@item C-_ -@itemx C-x u -Défait l’action action précédente (@code{(undo)}). -@end table - - -@node Printer functions -@section Fonctions d’impression -@cindex fonctions d’impression -@cindex formatage de cellule -@cindex cellules, formater - -Les fonctions d’impression convertissent des valeurs binaires de -cellule en formes d’impression qu’Emacs affiche à l’écran. - -@menu -* Différents types de fonctions d’impression: Various kinds of printer functions. -* Configurer quelle fonction d’impression s’applique: Configuring what printer function applies. -* Les fonctions d’impression standardes: Standard printer functions. -* Les fonctions d’impression locales: Local printer functions. -* Écrire une fonctions d’impression lambda: Writing a lambda printer function. -@end menu - -@node Various kinds of printer functions -@subsection Différents types de fonctions d’impression - -Lorsque on configure quelle fonction d’impression s’applique -(@pxref{Configuring what printer function applies}), on peut saisir -une fonction d’impression comme l’une des possibilités suivantes : - -@itemize -@item -Une chaîne de formatage, telle que @samp{"$%.2f"}. la chaîne formatée -résultante est alignée à droite au sein de la cellule -d’impression. Pour obtenir un alignement à gauche, utilisez des -parenthèses : @samp{("$%.2f")}. -@item -Une fonction d’impression peut aussi être une fonction à un argument -dont la valeur renvoyée est une chaîne (pour obtenir un alignement à -droite) ou une liste d’une chaîne (pour obtenir un alignement à -gauche). Une telle fonction peut à son tour être configurée comme : -@itemize -@item -Une expression lambda, par exemple : - -@lisp -(lambda (x) - (cond - ((null x) "") - ((numberp x) (format "%.2f" x)) - (t (ses-center-span x ?# 'ses-prin1)))) -@end lisp - -Pendant la saisie d’une lambda, vous pouvez utiliser @kbd{M-@key{TAB}} -pour completer les noms de symboles. -@item -Un symbole faisant référence à une fonction d’impression standarde -(@pxref{Standard printer functions}). -@item -Un symbole faisant référence à une fonction d’impression locale -(@pxref{Local printer functions}). -@end itemize - - -@end itemize - - -@node Configuring what printer function applies -@subsection Configurer quelle fonction d’impression s’applique - -Chaque cellule a une fonction d’impression. Si c’est @code{nil}, -alors la fonction d’impression de la colonne de cette cellule est -utilisée. Et si cela est aussi @code{nil}, alors la fonction -d’impression par défaut de la feuille est utilisée. - -@table @kbd -@item p -@findex ses-read-cell-printer -Saisit une fonction d’impression pour la cellule ou plage courante -(@code{ses-read-cell-printer}). - -@item M-p -@findex ses-read-column-printer -Saisit une fonction d’impression pour la colonne courante (@code{ses-read-column-printer}). - -@item C-c C-p -@findex ses-read-default-printer -Saisit la fonction d’impression par défaut de la feuille -(@code{ses-read-default-printer}). -@end table - -Les commandes @code{ses-read-@var{xxx}-printer} permettent les commandes -suivantes pendant l’édition: - -@table @kbd -@item @key{arrow-up} -@itemx @key{arrow-down} -Pour parcourir l’historique : les commandes -@code{ses-read-@var{xxx}-printer} ont leur propre historique de -mini-tampon, il est préchargé avec l’ensemble de toutes les fonctions -d’impression utilisées dans cette feuille, plus les fonctions -d’impression standardes (@pxref{Standard printer functions}) et les -fonctions d’impression locales (@pxref{Local printer functions}). -@item @key{TAB} -Pour compléter les symboles de fonctions d’impression locales, et -@item C-h C-p -Pour lister les fonctions d’impression locales dans un tampon d’aide. -@end table - - -@node Standard printer functions -@subsection Les fonctions d’impression standardes - - -Mise à part @code{ses-prin1}, les autres fonctions d’impression -standardes ne conviennent que pour les cellules, et non pour les -colonnes ou comme fonction d’impression par défaut de la feuille, -parce qu’elles formatent la valeur en utilisant la fonction -d’impression de colonne (ou par défaut si @code{nil}) et ensuite -post-traite le résultat, par ex.@: le centre : - -@ftable @code -@item ses-center -Centre juste. - -@item ses-center-span -Centrer en débordant sur les cellules vides suivantes. - -@item ses-dashfill -Centrer en utilisant des tirets (@samp{-}) au lieu d’espaces. - -@item ses-dashfill-span -Centrer avec tirets et débordement. - -@item ses-tildefill-span -Centrer avec tildes (@samp{~}) et débordement. - -@item ses-prin1 -C’est la fonction d’impression de repli, utilisée quand l’appel à la -fonction d’impression configurée envoie une erreur. -@end ftable - -@node Local printer functions -@subsection Les fonctions d’impression locales - -@findex ses-define-local-printer -Vous pouvez définir une fonction d’impression locale à la feuille avec -la commande @code{ses-define-local-printer}. Par exemple, définissez -une fonction d’impression @samp{toto} à @code{"%.2f"}, et ensuite -utilisez le symbole @samp{toto} comme fonction d’impression. Ensuite, -si vous rappelez @code{ses-define-local-printer} sur @samp{toto} pour -le redéfinir comme @code{"%.3f"}, alors toutes les cellules utilisant -la fonction d’impression @samp{toto} seront re-imprimées conformément. - -Il peut arriver que vous désiriez définir ou redéfinir certaines -fonctions d’impression à chaque fois que vous ouvrez une feuille. Par -exemple, imaginez que vous désiriez définir/re-définir automatiquement -une fonction d’impression locale @code{euro} pour afficher un nombre -comme une somme en euros, par exemple le nombre @code{3.1} serait -affiché comme @code{3.10@dmn{}@euro{}}. Pour faire cela dans tout -tampon SES qui n’est pas en lecture seule, vous pouvez ajouter ce -genre de code à votre fichier d’init @file{.emacs} : - -@lisp -(defun my-ses-mode-hook () - (unless buffer-read-only - (ses-define-local-printer - 'euro - (lambda (x) - (cond - ((null x) "") - ((numberp x) (format "%.2f€" x)) - (t (ses-center-span x ?# 'ses-prin1))))))) -(add-hook 'ses-mode-hook 'my-ses-mode-hook) -@end lisp - -Si vous remplacez la commande @code{ses-define-local-printer} par la -fonction @code{ses-define-if-new-local-printer} -@findex ses-define-if-new-local-printer -la définition ne se produira que si aucune fonction d’impression de -même nom n’est déjà définie. - - -@node Writing a lambda printer function -@subsection Écrire une fonctions d’impression lambda - -Vous pouvez écrire une fonction d’impression avec une expression -lambda prenant un seul argument en deux cas : - -@itemize -@item -quand vous configurez la fonction d’impression s’appliquant à -une cellule ou colonne, ou -@item -quand vous définissez une fonction d’impression avec la commande -@code{ses-define-local-printer}. -@end itemize - -En faisant cela, prenez garde à ce que la valeur renvoyée soit une -chaîne, ou une liste contenant une chaîne, même quand l’argument -d’entrée a une valeur inattendue. Voici un exemple : - -@example -(lambda (val) - (cond - ((null val) "") - ((and (numberp val) (>= val 0)) (format "%.1f" val)) - (t (ses-center-span val ?# 'ses-prin1)))) -@end example - -Cet exemple fait ceci : - -@itemize -@item -Quand la cellule est vide (c.-à-d.@: quand @code{val} est @code{nil}), -imprime une chaîne vide @code{""} -@item -Quand la valeur de cellule est un nombre positif ou nul, formate la -valeur en notation à virgule fixe avec une decimale après la virgule -@item -Sinon, gère la valeur comme erronnée en l’imprimant comme une -s-expression (avec @code{ses-prin1}), centrée et entourée de -croisillons @code{#} de bourrage. -@end itemize - -Une autre précaution à prendre est d’éviter un débordement de pile à -cause d’une fonction d’impression se rappelant elle-même sans -fin. Cette erreur peut se produire quand vous utilisez une fonction -d’impression locale comme fonction d’impression de colonne, et que -cette fonction d’impression locale appelle implicitement la fonction -d’impression de colonne courante, ainsi elle se rappelle elle-même -récursivement. Imaginez par exemple que vous désirez créer une -fonction d’impression locale @code{=bourre} qui centre le contenu -imprimé d’une cellule et l’entoure de signes égal @code{=}, et que -vous le faites (erronnément) comme cela : - -@lisp -;; CODE ERRONÉ -(lambda (x) - (cond - ((null x) "") - (t (ses-center x 0 ?=)))) -@end lisp - -Comme @code{=bourre} utilise la fonction d’impression standarde -@code{ses-center} mais sans lui passer exemplicitement une fonction -d’impression, @code{ses-center} appelle la fonction d’impression de -colonne courante s’il y en a une, ou la fonction d’impression par -défaut de la feuille sinon. Aussi, utiliser @code{=bourre} comme -fonction d’impression de colonne aura pour résultat de causer un -débordement de pile dans cette colonne sur toute cellule non vide, -puisque @code{ses-center} rappelle récursivement la fonction qui l'a -appelé. @acronym{SES} ne vérifie pas cela ; il vous faut donc faire -attention. Par exemple, reécrivez @code{=bourre} ainsi : - -@lisp -(lambda (x) - (cond - ((null x) "") - ((stringp x) (ses-center x 0 ?= " %s ")) - (t (ses-center-span x ?# 'ses-prin1)))) -@end lisp - -Le code ci-dessus est réparé au sens où @code{ses-center} et -@code{ses-center-span} sont toutes deux appelées avec un dernier -argument @var{printer} explicite spécifiant la fonction d'impression, -respectivement @code{" %s "} et @code{'ses-prin1}. - - -Le code ci-dessus applique le bourrage de @code{=} seulement aux -chaînes ; et aussi il entoure la chaîne par un espace de chaque côté -avant de bourrer avec des signes @code{=}. Ainsi la chaîne @samp{Ula} -s’affichera comme @samp{@w{=== Ula ===}} dans une colonne large de 11 -caractères. Toute valeur qui n’est ni @code{nil} (c.-à-d.@: une -cellule vide) ni une chaîne est affichée comme une erreur par l’usage -de bourrage par des croisillons @code{#}. - -@node Clearing cells -@section Effacer des cellules -@cindex effacer, commandes -@findex ses-clear-cell-backward -@findex ses-clear-cell-forward - -Ces commandes règlent à la fois la formule et la fonction d’impression -à @code{nil} : - -@table @kbd -@item @key{DEL} -Se deplace à gauche et efface la cellule (@code{ses-clear-cell-backward}). - -@item C-d -Efface la cellule et se déplace à droite (@code{ses-clear-cell-forward}). -@end table - - -@node Copy/cut/paste -@section Copier, couper, et coller -@cindex copier -@cindex couper -@cindex coller -@findex kill-ring-save -@findex mouse-set-region -@findex mouse-set-secondary -@findex ses-kill-override -@findex yank -@findex clipboard-yank -@findex mouse-yank-at-click -@findex mouse-yank-at-secondary -@findex ses-yank-pop - -Les fonctions de copie opèrent sur des regions rectangulaires de -cellules. Vous pouvez coller les copies dans des tampons -non-@acronym{SES} pour exporter le texte d’impression. - -@table @kbd -@item M-w -@itemx [copy] -@itemx [C-insert] -Copie les cellules en vedette vers l’anneau presse-papier et le -presse-papier primaire (@code{kill-ring-save}). - -@item [drag-mouse-1] -Marque une region et la copie vers l’anneau presse-papier et le -presse-papier primaire (@code{mouse-set-region}). - -@item [M-drag-mouse-1] -Marque une region et la copie vers l’anneau presse-papier et le -presse-papier secondaire (@code{mouse-set-secondary}). - -@item C-w -@itemx [cut] -@itemx [S-delete] -Les fonctions couper ne suppriment pas en fait de lignes ou de -colonnes --- elles les copient et puis les effacent -(@code{ses-kill-override}). - -@item C-y -@itemx [S-insert] -Colle à partir de l’anneau presse-papier (@code{yank}). Les fonctions -coller se comportent différemment selon le format du texte qu’elles -insèrent : -@itemize @bullet -@item -Quand on colle des cellules qui ont été coupées ou copiées à partir -d’un tampon @acronym{SES}, le texte d’impression est ignoré et -seulement la formule et fonction d’impression jointes sont insérées ; -les références de cellule de la formule sont relocalisées à moins que -vous n’utilisiez @kbd{C-u}. -@item -Le texte collé écrase un rectangle de cellules dont le coin haut -gauche est la cellule courante. Si une partie du rectangle est -au-délà des bords de la feuille, vous devez confirmer l’augmentation -de la taille de la feuille. -@item -Du texte Non-@acronym{SES} est d’ordinaire inséré comme formule de -remplacement pour la cellule courante. Si la formule serait un -symbole, elle est traitée comme une chaîne à moins que vous -n’utilisiez @kbd{C-u}. Les formules collées comprenant des erreurs de -syntaxe sont toujours traitées comme des chaînes. -@end itemize - -@item [paste] -Colle à partir du presse-papier primaire ou de l’anneau presse-papier -(@code{clipboard-yank}). - -@item [mouse-2] -Règle le point et colle à partir du presse-papier primaire -(@code{mouse-yank-at-click}). - -@item [M-mouse-2] -Règle le point et colle à partir du presse-papier secondaire -(@code{mouse-yank-secondary}). - -@item M-y -Immédiatement après un coller, vous pouvez remplacer le texte avec un -élément précédent à partir de l’anneau presse-papier -(@code{ses-yank-pop}). Contrairement au yank-pop standard d’Emacs, la -version de @acronym{SES} utilise @code{undo} pour supprimer l’ancien -collage. Est-ce que cela ne fait aucune différence ? -@end table - -@node Customizing @acronym{SES} -@section Personnaliser @acronym{SES} -@cindex personnaliser -@vindex enable-local-eval - -Par défaut, une feuille venant d’être créée a 1 ligne et 1 colonne. -La largeur de colonne est 7 et la fonction d’impression par défaut est -@samp{"%.7g"}. Chacune de ces choses peut être personnalisée. Allez -voir dans le groupe « ses ». - -Après avoir saisi une valeur de cellule, normalement -@code{forward-char} est appelé, ce qui déplace le point vers la -cellule suivante à droite, ou à la première cellule à gauche de la -ligne suivante si la cellule courante est la plus à droite de la -feuille. Vous pouvez personnaliser @code{ses-after-entry-functions} -pour que le déplacement soit vers la gauche ou le haut ou le bas. -Pour un mouvement diagonal, selectionnez deux fonctions de la liste. - -@vindex ses-jump-cell-name-function -@code{ses-jump-cell-name-function} est une variable personnalisable -réglée par défaut à la fonction @code{upcase}. Cette fonction est -appelée quand vous passez un nom de cellule à la commande -@command{ses-jump} (@kbd{j}), et que ce nom n’est pas le nom d’une -cellule renommée. Elle change le nom de cellule saisi en celui de la -cellule vers laquelle sauter. Le réglage par défaut @code{upcase} vous -permet de saisir le nom de cellule en bas de casse. Un autre usage de -@code{ses-jump-cell-name-function} pourrait être une -internationalisation pour convertir des caractères non latins en -équivalents latins pour nommer la cellule. Au lieu d’un nom de -cellule, la fonction peut renvoyer des coordonnées de cellule sous la -forme d’un cons, par exemple @code{(0 . 0)} pour la cellule @code{A1}, -@code{(1 . 0)} pour la cellule @code{A2}, etc. - -@vindex ses-jump-prefix-function -@code{ses-jump-prefix-function} est une variable personnalisable -réglée par défaut à la fonction @code{ses-jump-prefix}. Cette fonction -est appelée quand vous donnez un argument préfixe à la commande -@command{ses-jump} (@kbd{j}). Elle renvoie un nom de cellule ou des -coordonnées de cellule correspondant à l’argument préfixe. Les -coordonnées de cellule sont sous la forme d’un cons, par exemple -@code{(1 . 0)} pour la cellule @code{A2}. Le réglage par défaut -@code{ses-jump-prefix} numérote les cellules de gauche à droite et -puis de haut en bas, de sorte que si on suppose une feuille 4×3, -l’argument préfixe @samp{0} saute à la cellule @samp{A1}, l’argument -préfixe @samp{2} saute à @samp{C1}, l’argument préfixe @samp{3} saute -à @samp{A2}, etc. - -@vindex ses-mode-hook -@code{ses-mode-hook} est un crochet de mode normal (une liste de -fonctions qui s’exécutent quand le mode @acronym{SES} démarre sur un -tampon). - -@vindex safe-functions -La variable @code{safe-functions} est une liste de fonctions -potentiellement risquées à traiter comme si elles étaient sûres lors -de l’analyse des formules et fonctions d’impression. @xref{Virus -protection}. Avant de personnaliser @code{safe-functions}, -réfléchissez à quel point vous faites confiance à la personne qui vous -suggère cette modification. La valeur @code{t} désactive toute -protection anti-virus. Une valeur donnant une liste-de-fonctions peut -rendre une feuille « trop bien », mais elle crée aussi des portes -dérobées dans votre armure anti-virus. Pour que votre protection -contre les virus fonctionne, vous devez toujours appuyer sur @kbd{n} -quand un avertissement contre un virus vous est présenté, à moins que -vous compreniez ce que le code en question essaie de faire. N’écoutez -pas ceux qui vous racontent de personnaliser @code{enable-local-eval} ---- cette variable est pour les gens qui ne portent pas de ceinture de -sécurité ! - - -@c =================================================================== - -@node Advanced Features -@chapter Fonctions avancées -@cindex avancées, fonctions -@findex ses-read-header-row - - -@table @kbd -@item C-c M-C-h -(@code{ses-set-header-row}). -@findex ses-set-header-row -@kindex C-c M-C-h -La ligne d’en-tête au sommet de la fenêtre @acronym{SES} affiche -normalement la ligne de colonne pour chaque colonne. Vous pouvez la -régler pour afficher une copie de l’une des lignes, tell que qu’une -ligne de titres de colonnes, ainsi cette ligne sera toujours visible. -Par défaut la commande règle la ligne courante comme en-tête ; -utiliser C-u pour une invite à désigner la ligne d’en-têre. Régler la -ligne d’en-tête à la ligne 0 pour afficher les lettres de colonne de -nouveau. -@item [header-line mouse-3] -Affiche un menu pour régler la ligne courante comme en-tête, ou -revenir à des lettres de colonne. -@item M-x ses-rename-cell -@findex ses-rename-cell -Renomme une cellule pour passer d'un nom standard du genre de A1 à -toute chaîne pouvant être un nom valide pour une variable locale (Voir -aussi @ref{Nonrelocatable references}). -@item M-x ses-repair-cell-reference-all -@findex ses-repair-cell-reference-all -Quand vous interrompez la mise à jour d’une formule de cellule en -tapant @kbd{C-g}, alors cela peut casser le lien de référence de -cellule, ce qui compromet la mise à jour automatique de cellule quand -toute autre cellule dont elle dépend est modifiée. Pour réparer cela, -utilisez la fonction @code{ses-repair-cell-reference-all} -@end table - -@menu -* La zone d’impression: The print area. -* Plages dans les formules: Ranges in formulas. -* Trier par colonne: Sorting by column. -* Fonctions de formule standardes: Standard formula functions. -* Plus sur l’impression de cellule: More on cell printing. -* Import et export: Import and export. -* Protection contre les virus: Virus protection. -* Feuilles avec détails et synthèse: Spreadsheets with details and summary. -@end menu - -@node The print area -@section La zone d’impression -@cindex zone d’impression -@cindex impression, zone d’ -@findex widen -@findex ses-renarrow-buffer -@findex ses-reprint-all - -Un fichier @acronym{SES} consiste en une zone d’impression et une zone -de données. Normalement le tampon est réduit de sorte à n’afficher -que la zone d’impression. La zone d’impression est en lecture seule, -hormis pour les commandes spéciales de @acronym{SES} ; elle contient -les valeurs de cellule formatées par les fonctions d’impression. La -zone de données enregistre les formules, fonctions d’impression, etc. - -@table @kbd -@item C-x n w -Affiche à la fois les zones d’impression et de données (@code{widen}). - -@item C-c C-n -Affiche seulement la zone d’impression (@code{ses-renarrow-buffer}). - -@item S-C-l -@itemx M-C-l -Recrée la zone d’impression en réévaluant pour toutes les cellules sa -fonction d’impression (@code{ses-reprint-all}). -@end table - -@node Ranges in formulas -@section Plages dans les formules -@cindex plages -@findex ses-insert-plage-click -@findex ses-insert-plage -@findex ses-insert-ses-plage-click -@findex ses-insert-ses-plage -@vindex de -@vindex à - -Une formule du genre de : -@lisp -(+ A1 A2 A3) -@end lisp -est la somme de trois cellules spécifiques. Si vous insérez une -nouvelle deuxième ligne, la formule devient -@lisp -(+ A1 A3 A4) -@end lisp -et la nouvelle ligne n’est pas incluse dans la somme. - -La macro @code{(ses-range @var{de} @var{à})} s’évalue en une liste des -valeurs dans un rectangle de cellules. Si votre formule est -@lisp -(apply '+ (ses-range A1 A3)) -@end lisp -et que vous insérez une nouvelle deuxième ligne, elle devient -@lisp -(apply '+ (ses-range A1 A4)) -@end lisp -et la nouvelle ligne est incluse dans la somme. - -Alors que vous saisissez ou éditez une formule dans le minitampon, -vous pouvez sélectionner une plage dans la feuille (en utilisant la -souris ou le clavier), et injecter une représentation de cette plage -dans votre formule. Supposez que vous sélectionnez @samp{A1-C1} : - -@table @kbd -@item [S-mouse-3] -Insère @samp{A1 B1 C1} (@code{ses-insert-range-click}) - -@item C-c C-r -Version clavier (@code{ses-insert-range}). - -@item [C-S-mouse-3] -Insère @samp{(ses-range A1 C1)} (@code{ses-insert-ses-range-click}). - -@item C-c C-s -Version clavier (@code{ses-insert-ses-range}). -@end table - -Si vous supprimez la cellule @var{de} ou @var{à} d’une plage, la -cellule la plus proche toujours existante est utilisée à la place. Si -vous supprimez l’entière plage, le relocalisateur de formule supprime -le @samp{ses-range} de la formule. - -Si vous insérez une nouvelle ligne juste au delà de la fin d’une plage -à une colonne, ou une nouvelle colonne juste au delà d’une plage à une -ligne, la nouvelle cellule est incluse dans la plage. Les nouvelles -cellules insérées juste avant une plage ne sont pas incluses. - -Des fanions peuvent être ajoutés à @code{ses-range} immédiatement -après la cellule @var{à} . -@table @code -@item ! -Les cellules vides de la plage peuvent être enlevées en ajoutant le -fanion @code{!}. Une cellule vide est une cellule dont la valeur est -l’un des symboles @code{nil} ou @code{*skip*}. Par exemple -@code{(ses-range A1 A4 !)} fait la même chose que @code{(list A1 A3)} -quand les cellules @code{A2} et @code{A4} sont vides. -@item _ -Les valeurs de cellules vides sont remplacées par l’argument suivant -le fanion @code{_}, ou @code{0} quand le fanion @code{_} est le -dernier dans la liste d’arguments. Par exemple @code{(ses-range A1 A4 -_ "vide")} fera la même chose que @code{(list A1 "vide" A3 "vide")} -quand les cellules @code{A2} et @code{A4} sont vides. Similairement, -@code{(ses-range A1 A4 _ )} fera la même chose que @code{(list A1 0 A3 -0)}. -@item >v -Quand l’ordre a de l’importance, liste les cellules en lisant les -cellules ligne par ligne de la cellule en haut à gauche vers la -cellule en bas à droite. Ce fanion est fourni pour être complet car -c’est déjà l’ordre par défaut. -@item -Liste les cellules en lisant les cellules colonne par colonne de la -cellule en haut à gauche vers la cellule en bas à droite. -@item v< -Liste les cellules en lisant les cellules colonne par colonne de la -cellule en haut à droite vers la cellule en bas à gauche. -@item v -Un raccourci pour @code{v>}. -@item ^ -Un raccourci pour @code{^>}. -@item > -Un raccourci pour @code{>v}. -@item < -Un raccourci pour @code{>^}. -@item * -Au lieu de lister les cellules, en fait un vecteur ou une matrice Calc -(@pxref{Top,,,calc,GNU Emacs Calc Manual}). Si la plage contient -seulement une ligne ou une colonne un vecteur est fait, sinon une -matrice est faite. -@item *2 -Idem que @code{*} à ceci près qu’une matrice est toujours faite même -quand il y a une seule ligne ou colonne dans la plage. -@item *1 -Idem que @code{*} à ceci près qu’un vecteur est toujours fait même -quand il n’y a qu’une ligne ou colonne dans la plage, c.-à-d.@: que la -matrice correspondante est aplatie. -@end table - -@node Sorting by column -@section Trier par colonne -@cindex trier -@findex ses-sort-column -@findex ses-sort-column-click - -@table @kbd -@item C-c M-C-s -Trie les cellules d’une plage en utilisant l’une des colonnes -(@code{ses-sort-column}). Les lignes (ou lignes partielles si la -plage n’inclut pas toutes les colonnes) sont réarrangées de sorte que -la colonne choisie soit ordonnée. - -@item [header-line mouse-2] -La façon la plus facile de trier est de cliquer sur mouse-2 sur la -ligne d’en-tête de colonne (@code{ses-sort-column-click}). -@end table - -La comparaison du tri utilise @code{string<}, ce qui fonctionne bien -pour des nombres alignés à droite ou des chaînes alignées à gauche. - -Avec un argument préfixe, trie dans l’ordre descendant. - -Les lignes sont déplacées une à la fois, avec relocalisation des -formules. Ceci fonctionne bien si les formules font référence à -d’autres cellules dans leur ligne, mais non pas si bien pour des -formules qui font référence à d’autres lignes dans la plage ou à des -cellules hors de la plage. - - -@node Standard formula functions -@section Fonctions de formule standardes -@cindex fonctions standardes de formule -@cindex *skip* -@cindex *error* -@findex ses-delete-blanks -@findex ses-average -@findex ses+ - -Souvent on désire qu’un calcul exclue les cellules vides. Voici -quelques fonctions utiles à appeler dans vos formules : - -@table @code -@item (ses-delete-blanks &rest @var{args}) -Renvoie une liste dont toutes les cellules vides (dont la valeur est -soit @code{nil} ou @code{'*skip*}) ont été supprimées. L’ordre des -arguments est inversé. Prière de noter que @code{ses-range} a un -modificateur @code{!} qui permet de supprimer les cellules vides, -ainsi il est possible d’écrire : -@lisp -(ses-range A1 A5 !) -@end lisp -au lieu de -@lisp -(apply 'ses-delete-blanks (ses-range A1 A5 <)) -@end lisp - -@item (ses+ &rest @var{args}) -Somme des arguments non vides pris en ordre inverse. - -@item (ses-average @var{liste}) -Moyenne des éléments non vides de @var{liste}. Ici la liste est -passée comme un seul argument, vu que typiquement on la forme avec -@code{ses-range}. -@end table - -@node More on cell printing -@section Plus sur l’impression de cellule -@cindex cellule, plus sur l'impression -@cindex impression de cellule -@findex ses-truncate-cell -@findex ses-recalculate-cell - -Valeurs spéciales de cellule : -@itemize -@item nil -s’imprime typiquement de la même façon que "", mais permet que la -cellule précédente déborde dessus. -@item '*skip* -remplace nil quand la cellule précédente déborde effectivement ; rien -n’est donc imprimée pour cette cellule. -@item '*error* -indique que la formule a signalé une erreur au lieu de produire une -valeur : la cellule imprimée est remplie de croisillons (#). -@end itemize - -Lorsque la fonction d’impression est définie par une chaîne de -formatage, par ex. @samp{"%.3f"}, @acronym{SES} imprime -automatiquement @code{nil} comme une chaîne vide, mais si la fonction -d’impression est définie par une expression lambda, vous devez définir -explicitement comment @code{nil} est traité, par ex. : -@example -(lambda (x) - (cond - ((null x) "") - ((stringp x) (list x)) - ((numberp x) (format "%.3f" x)) - (t (ses-prin1 x))) -@end example -imprime @code{nil} comme une chaîne vide, aligne à gauche la valeur si -c’est une chaîne, et si c’est un nombre l’aligne à droite en -l’imprimant avec trois décimales. - -Il n’est pas nécessaire par contre que vous vous souciez de -@code{'*skip*} dans la définition d’une fonction d’impression, en -effet aucune fonction d’impression n’est appelée sur @code{'*skip*}. - -Si le résultat de la fonction d’impression est trop large pour la -cellule et que la cellule suivante est @code{nil}, le résultat -débordera sur la cellule suivante. Les résultats très larges peuvent -déborder sur plusieurs cellules. Si le résultat est trop large pour -l’espace disponible (jusqu'à la fin de la ligne ou la prochaine -cellule non-@code{nil}), le résultat est tronqué si la valeur de -cellule est une chaîne, ou remplacé par des croisillons (@samp{#}) -sinon. - -@acronym{SES} pourrait être perturbé par des résultats de fonction -d'impression contenant des sauts de ligne ou des tabulations, aussi -ces caractères sont remplacés par des points d'interrogation. - -@table @kbd -@item t -Confine une cellule à sa propre colonne (@code{ses-truncate-cell}). -Ceci vous permet de déplacer le point sur la cellule de droite qui -sinon serait couverte par un débordement. Si vous ne modifiez pas la -cellule de droite, la cellule confinée débordera de nouveau la -prochaine fois qu’elle sera imprimée. - -@item c -Appliquée à une seule cellule, cette commande affiche dans la zone -d’écho toute erreur de formule ou erreur d’impression survenue pendant -le recalcul/la réimpression (@code{ses-recalculate-cell}). Vous -pouvez utiliser cela pour défaire l’effet de @kbd{t}. -@end table - -Quand une fonction d’impression signale une erreur, la fonction -d’impression de repli -@findex ses-prin1 -@code{ses-prin1} lui est substituée. Ceci est utile quand votre -fonction d’impression de colonne est seulement numérique et que vous -utilisez une chaîne comme valeur de cellule. Notez que la fonction -d’impression par défaut standarde est @samp{"%.7g"} qui est numérique -seulement, ainsi les cellules auxquelles la fonction d’impression par -défaut standarde s’applique et qui ne sont pas vides et ne contiennent -pas un nombre utilisent la fonction d’impression de repli -@code{ses-prin1}, par ex.@: les cellules qui contiennent une chaîne -font cela. @kbd{c} sur de telles cellules affiche « Format specifier -doesn't match argument type ». - - -@node Import and export -@section Import et export -@cindex import et export -@cindex export, et import -@findex ses-export-tsv -@findex ses-export-tsf - -@table @kbd -@item x t -Exporte une plage de cellules comme des valeurs séparées par des -tabulations (@code{ses-export-tsv}). -@item x T -Exporte une plage de cellules comme des formules séparées par des -tabulations (@code{ses-export-tsf}). -@end table - -Le texte exporté va dans l’anneau presse-papier ; vous pouvez le -coller dans un autre tampon. Les colonnes sont séparées par des -tabulations, les lignes par des sauts de lignes. - -Pour importer du texte, utilisez n’importe laquelle des commandes -coller où le texte à coller contient des tabulations et/ou des sauts de -lignes. Les formules importées ne sont pas relocalisées. - -@node Virus protection -@section Protection contre les virus -@cindex virus protection - -À chaque fois une formule ou fonction d’impression est lue d’un -fichier ou est collée dans la feuille, elle est marquée comme -« nécessitant une vérification de sécurité ». Plus tard, quand la -formule ou la fonction d’impression est évaluée pour la première fois, -elle est vérifiée comme sûre en utilisant le prédicat @code{unsafep} ; -si elle s’avère « potentiellement risquée », la formule ou fonction -d’impression en question est affichée et vous devez appuyer @kbd{Y} -pour l’approuver ou @kbd{N} pour utiliser un substitut. Le substitut -signale toujours une erreur. - -Les formules ou fonctions d’impression que vous tapez sont -immédiatement vérifiées quant à leur sûreté. Si elles s’avèrent -potentiellement risquées et que vous appuyez @kbd{N} pour refuser, -l’action est annulée et l’ancienne formule ou fonction d’impression -demeure. - -En plus des virus (qui tentent de se recopier dans d’autres -fichiers), @code{unsafep} peut aussi détecter toutes sortes de chevaux -de Troie, tels que des feuilles de calcul qui effacent les fichiers, -envoient des courriels, inondent des sites Web, corrompent vos -réglages d’Emacs, etc. - -Généralement, les formules et fonctions d’impression de feuilles sont -des choses simples qui n’ont pas besoin de faire des traitements -exotiques, aussi toute partie potentiellement dangereuse de -l’environnement Emacs Lisp peut être exclus sans entraver votre style -comme écrivain de formule. Lisez la documentation dans -@file{unsafep.el} pour plus d’information sur la façon dont les formes -Lisp sont classifiées comme sûres ou risquées. - -@node Spreadsheets with details and summary -@section Feuilles avec détails et synthèse -@cindex détails et synthèse -@cindex synthèses, et détails - -Une organisation usuelle pour une feuille de calcul est d’avoir un tas -de lignes de « détail », chacune décrivant possiblement une -transaction, et ensuite un ensemble de lignes de « synthèse » qui -affichent chacune des données condensées pour un certain sous-ensemble -des détails. @acronym{SES} prend en charge ce type d’organisation via -la fonction @code{ses-select}. - -@table @code -@item (ses-select @var{de-plage} @var{test} @var{à-plage}) -Renvoie un sous-ensemble de @var{à-plage}. Pour chaque membre dans -@var{de-plage} qui est égal à @var{test}, le membre correspondant de -@var{à-plage} est inclus dans le résultat. -@end table - -Exemple d’utilisation : -@lisp -(ses-average (ses-select (ses-range A1 A5) 'Bidochon (ses-range B1 B5))) -@end lisp -Ceci calcule la moyenne des valeurs de la colonne @samp{B} pour les -lignes dont la valeur dans la colonne @samp{A} est le symbole -@samp{'Bidochon}. - -Vous vous demandez peut-être pourquoi les arguments de -@code{ses-select} ne consistent pas au lieu de @var{à-plage} de -décalages @var{décalage-à-la-ligne} et @var{décalage-à-la-colonne} -relativement à @var{de-plage} : spécifier @var{à-plage} explicitement -assure que la formule est recalculée si l’une quelconque des cellules -de cette plage est modifiée. - -Le fichier @file{etc/ses-example.el} dans la distribution Emacs est un -exemple d’une feuille organisée en détails-et-synthèse. - - -@c =================================================================== - -@node For Gurus -@chapter Pour les gourous -@cindex avancées, fonctions -@cindex fonctions avancées - -@menu -* Mises à jour différées: Deferred updates. -* Références non-relocalisables: Nonrelocatable references. -* La zone données: The data area. -* Variables locales-tampon dans les feuilles: Buffer-local variables in spreadsheets. -* Utilisation de advice-add dans @acronym{SES}: Uses of advice-add in @acronym{SES}. -@end menu - -@node Deferred updates -@section Mises à jour différées -@cindex différées, mises à jour -@cindex mises à jour différées -@vindex run-with-idle-timer - -Pour épargner du temps de calcul redondant, les cellules dont le -recalcul est rendu nécessaire par des changements dans d’autres -cellules sont ajoutées à un ensemble. À la fin de la commande, chaque -cellule de cet ensemble est recalculée une fois. Ceci peut créer un -nouvel ensemble de cellules nécessitant un recalcul. Ce processus est -répété jusqu'à ce que l’ensemble soit vide ou que des références -circulaires soient détectées. Dans les cas extrêmes, et notamment si -une référence circulaire est en cours de détection, vous pourriez voir -des messages de progression de la forme « Recalculating... (@var{nnn} -cells left) ». Si vous interrompez le calcul avec @kbd{C-g}, la -feuille demeurera dans un état incohérent, utilisez alors @kbd{C-_} ou -@kbd{C-c C-l} pour réparer cela. - -Pour épargner encore plus de temps en évitant les écritures -redondantes, les cellules qui sont modifiées sont ajoutées à un -ensemble au lieu d’être immédiatement écrites dans la zone de -données. Chaque cellule de cet ensemble est écrite une fois à la fin -de la commande. Si vous modifiez un grand nombre de cellules, vous -pourriez voir un message de progression de la forme -« Writing... (@var{nnn} cells left) ». Ces écritures différées de -cellules ne peuvent pas être interrompues par @kbd{C-g}, alors il vous -faudra juste attendre. - -@acronym{SES} utilise @code{run-with-idle-timer} pour déplacer le -souligné de cellule quand Emacs fait défiler le tampon à la fin d’une -commande, et aussi pour @c xxx narrow and underline -réduire et souligner après visiter un fichier. Ceci peut être visible -par une perturbation transitoire après visiter un fichier et certaines -commandes de défilement. Vous pouvez continuer à taper sans vous -inquiéter de cette perturbation. - - -@node Nonrelocatable references -@section Références non relocalisables -@cindex non-relocalisables, références -@cindex références non-relocalisables - -@kbd{C-y} relocalise toutes les références de cellule dans une formule -collée, alors que @kbd{C-u C-y} n’en relocalise aucune. Et pour les -cas mélangés ? - -La meilleure approche est de renommer les cellules que vous @emph{ne} -voulez @emph{pas} être relocalisables en utilisant -@code{ses-rename-cell}. -@findex ses-rename-cell -Les cellules qui n’ont pas un style de nom du genre de A1 ne sont pas -relocalisées au collage. En utilisant cette méthode, les cellules -concernées ne seront pas relocalisées quelle que soit la formule où -elles apparaissent. Prière toutefois de noter que dans une formule -contenant quelque plage @code{(ses-range @var{cell1} @var{cell2})} -alors dans la formule collée chacune des bornes @var{cell1} et -@var{cell2} de la plage est relocalisée, ou non, indépendemment, selon -qu’elle est nommée du genre de @samp{A1} ou renommée. - -Une méthode alternative est d’utiliser -@lisp -(symbol-value 'B3) -@end lisp -pour faire une @dfn{référence absolue}. Le relocalisateur de formule -saute par dessus tout ce qui est sous un @code{quote}, aussi cela ne -sera pas relocalisé quand on le colle ou quand des lignes/colonnes -sont insérées/supprimées. Toutefois, @samp{B3} ne sera pas -enregistrée comme une dépendance de cette cellule, et donc cette -cellule ne sera pas mise à jour automatiquement quand @samp{B3} est -modifiée, c’est pourquoi l’usage de @code{ses-rename-cell} est la -plupart du temps préférable. - -Les variables @code{row} et @code{col} sont liées dynamiquement -pendant l’évaluation d’une formule de cellule. Vous pouvez utiliser -@lisp -(ses-cell-value row 0) -@end lisp -pour obtenir la valeur de la colonne la plus à gauche de la ligne -courante. Ce type de dépendance n’est pas non plus enregistré. - - -@node The data area -@section La zone de données -@cindex données, zone de -@cindex zone de données -@findex ses-reconstruct-all - -Commence avec un caractère saut de page (de code ASCII 014 en octal), -suivi par un ensemble de macros de définition de cellule pour chaque -ligne, suivi par l’ensemble des définitions de fonctions d’impression -locales, suivi par les largeurs de colonnes, fonctions d’impression de -colonne, fonction d’impression par défaut, et ligne d’en-tête. Ensuite -il y a les paramètres globaux (ID de format fichier, nombre de lignes, -nombre de colonnes, nombre de fonctions d’impression locales) et les -variables locales (spécification du mode @acronym{SES} pour le tampon, -etc.). - -Quand un fichier @acronym{SES} est chargé, tout d’abord les paramètres -globaux sont chargés, puis l’ensemble de la zone de données est -@code{eval}ué, et finalement les variables locales sont traitées. - -Vous pouvez éditer la zone de données, mais n’insérez pas ni ne -supprimez de sauts de ligne, hormis dans la partie des variables -locales, en effet @acronym{SES} localise les choses en comptant les -sauts de ligne. Utilisez @kbd{C-x C-e} à la fin d’une ligne pour -installer ce que vous avez édité dans les structures de données de la -feuille (ceci ne met pas à jour la zone d’impression, utilisez, par -ex., @kbd{C-c C-l} pour cela). - -La zone de données est maintenue comme une image des structures de -données de la feuille stockée dans des variables locales tampon au -moment du chargement initial de la zone. Si le contenu de la zone de -données se trouve corrompu par la suite, vous pouvez essayer de -reconstruire la zone de données à partir des structures de données -avec : - -@table @kbd -@item C-c M-C-l -(@code{ses-reconstruct-all}). -@end table - - -@node Buffer-local variables in spreadsheets -@section Les variables locales-tampon dans les feuilles de calcul -@cindex locales-tampon, variables -@cindex variables locales-tampon - -Vous pouvez ajouter des variables locales supplémentaires à la liste -au bas de la zone de données, telles que des constantes cachées -auxquelles vous désirez faire référence dans vos formules. - -Vous pouvez initialiser la variable @code{ses--symbolic-formulas} pour -être une liste de symboles (comme une suite de chaînes entre -parenthèses) à proposer comme complétions pour la commande @kbd{'}. -Cette liste initiale de complétions sera utilisée à la place de -l’ensemble effectif des symboles-comme-formules de la feuille. - -Pour un exemple de ceci, voir le fichier @file{etc/ses-example.ses}. - -Si (pour une raison quelconque) vous désirez que vos formules ou -fonctions d’impression sauvegardent des données dans des variables, -vous devez déclarer ces variables comme locales tampon pour éviter un -avertissement de virus. - -Vous pouvez définir des fonctions en en faisant des valeurs pour la -fausse variable locale @code{eval}. De telles fonctions peuvent -ensuite être utilisées dans les formules et comme fonctions -d’impression, mais d’ordinaire chaque @code{eval} est présenté à -l’utilisateur pendant le chargement du fichier comme un virus -potentiel. Et cela peut devenir gênant. - -Vous pouvez définir des fonctions dans votre fichier @file{.emacs}. -Toute personne pourra encore lire la zone d’impression de votre -feuille, mais ne pourra pas recalculer ou réimprimer quoi que ce soit -qui dépende de vos fonctions. Pour éviter des avertissements contre -les virus, chaque fonction utilisée dans une formule nécessite -@lisp -(put 'le-nom-de-votre-fonction 'safe-function t) -@end lisp - -@node Uses of advice-add in @acronym{SES} -@section Utilisation de advice-add dans @acronym{SES} -@findex advice-add -@findex copy-region-as-kill -@findex yank - -@table @code -@item copy-region-as-kill -Quand on copie de la zone d’impression d’une feuille, traite la région -comme un rectangle et joint pour chaque cellule sa formule et sa -fonction d’impression comme des propriétés @code{'ses}. - -@item yank -Quand on colle dans la zone d’impression d’une feuille de calcul, -essaie de coller comme des cellules (si le texte à coller a des -propriétés @code{'ses}), ensuite comme des formules séparées par des -tabulations, ensuite (si tout le reste a échoué) comme une seule -formule pour la cellule courante. -@end table - -@c =================================================================== -@node Index -@unnumbered Index - -@printindex cp - -@c =================================================================== - -@node Acknowledgments -@unnumbered Remerciements - -Codé par : -@quotation -@c jyavner@@member.fsf.org -Jonathan Yavner, -@c monnier@@gnu.org -Stefan Monnier, -@c shigeru.fukaya@@gmail.com -Shigeru Fukaya, -@c vincent.belaiche@@sourceforge.net -Vincent Belaïche -@end quotation - -@noindent -Manuel Texinfo de : -@quotation -@c jyavner@@member.fsf.org -Jonathan Yavner, -@c brad@@chenla.org -Brad Collins, -@c vincent.belaiche@@sourceforge.net -Vincent Belaïche -@end quotation - -@noindent -Idées de : -@quotation -@c christoph.conrad@@gmx.de -Christoph Conrad, -@c cyberbob@@redneck.gacracker.org -CyberBob, -@c syver-en@@online.no -Syver Enstad, -@c fischman@@zion.bpnetworks.com -Ami Fischman, -@c Thomas.Gehrlein@@t-online.de -Thomas Gehrlein, -@c c.f.a.johnson@@rogers.com -Chris F.A. Johnson, -@c lyusong@@hotmail.com -Yusong Li, -@c juri@@jurta.org -Juri Linkov, -@c maierh@@myself.com -Harald Maier, -@c anash@@san.rr.com -Alan Nash, -@c pinard@@iro.umontreal.ca -François Pinard, -@c ppinto@@cs.cmu.edu -Pedro Pinto, -@c xsteve@@riic.at -Stefan Reichör, -@c epameinondas@@gmx.de -Oliver Scholz, -@c rms@@gnu.org -Richard M. Stallman, -@c teirllm@@dms.auburn.edu -Luc Teirlinck, -@c jotto@@pobox.com -J. Otto Tennant, -@c jphil@@acs.pagesjaunes.fr -Jean-Philippe Theberge, -@c rrandresf@@hotmail.com -Andrés Ramírez -@end quotation - -@c =================================================================== - -@node GNU Free Documentation License -@appendix GNU Free Documentation License -@include doclicense.texi - -@bye -@c Local Variables: -@c ispell-dictionary: "fr" -@c End: diff --git a/doc/translations/README b/doc/translations/README new file mode 100644 index 00000000000..81b54c91a76 --- /dev/null +++ b/doc/translations/README @@ -0,0 +1,204 @@ +* Translating the Emacs manuals + +** Copyright assignment + +People who contribute translated documents should provide a copyright +assignment to the Free Software Foundation. See the 'Copyright +Assignment' section in the Emacs manual. + + +** Translated documents license + +The translated documents are distributed under the same license as the +original documents: the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation. + +See https://www.gnu.org/licenses/fdl-1.3.html for more information. + +If you have questions regarding the use of the FDL license in your +translation work that are not answered in the FAQ, do not hesitate to +contact the GNU project: https://www.gnu.org/contact/ + +** Location + +*** Texinfo source files + +The source files of the translated manuals are located in the doc/ +directory, under the directory whose name corresponds to the translated +language. + + E.g. French manuals sources are found under doc/fr. + +The structure of the language folders should match the structure of the +English manuals (i.e. include misc, man, lispref, lispintro, emacs). + +*** built files + +Translated deliverables in info format are built at release time and are +made available for local installation. + + +** Format + +The manuals and their translations are written in the Texinfo format +(with the exception of the org-mode manual that is written in org-mode +and of illustrations for the Introduction to Emacs Lisp Programming that +are written in eps). + +See https://www.gnu.org/software/Texinfo/ for more information. + +You should install the Texinfo utilities to be able to verify the +translated files, and refer to the Texinfo manual if you do not +understand the meaning of the various Texinfo declarations. + +Emacs has a Texinfo mode that properly highlights the Texinfo code to +make it easier to see which parts are text to be translated and which +parts are not. + + +*** Texinfo specific issues + +Until the Emacs/Texinfo projects provide better solutions, here are a +few rules to follow: + +- Under each @node, add an @anchor that has the same content at the +original English @node. + +- Translate the @node content but leave the @anchor in English. + +- Most Emacs manuals are set to include the docstyle.Texi file. This +file adds the @documentencoding UTF-8 directive to the targeted manual. +There is no need to add this directive in a manual that includes +docstyle.Texi. + +- Add a @documentlanguage directive that includes your language. + + E.g. @documentlanguage zh + +This directive has currently little effect but will be useful in the +future. + +- The @author directive can be used for the translator's name. + + E.g. @author traduit en français par Achile Talon + + +** Fixing the original document + +During the course of the translation, you might find parts of the +original document that need to be updated or otherwise fixed, or even +bugs in Emacs. If you do not intend to provide fixes right away, please +file a bug report promptly so someone can fix it soon. + +See the 'Bugs' section in the Emacs manual. + +** Sending contributions + +Send your contributions (either files or revisions) to +emacs-devel@gnu.org for review. + +Always send contributions in the format of the original document. Most +of the contents in the Emacs manuals are in Texinfo format, so do not +send contributions that are in derivative formats (e.g. info, html, +docbook, plain text, etc.) + +Before sending files for review, ensure that they have been properly +checked for spelling/grammar/typography by at least using the tools that +Emacs provides. + +You should also make sure that the Texinfo files build properly on your +system. + +Send your contributions as patches (git diff -p --stat), and prefer the +git format-patch form because the format allows easier review and easier +installation of the changes by someone with write access to the +repository. + +The Emacs project has a lot of coding, documentation and commenting +conventions. Sending such patches allows the project managers to make +sure that the contributions comply with the various conventions. + + +** Discussing translation issues + +Translation-related discussions are welcome on the emacs-devel list. +Discussions specific to your language do not have to take place in +English. + + +** Translation teams + +The number of words in the Emacs manuals is above 2,000,000 words and +growing. While one individual could theoretically translate all the +files, it is more practical to work in language teams. + +If you have a small group of translators willing to help, make sure that +the files are properly reviewed before sending them to emacs-devel (see +above). + +You are invited to refer to the translation-related documents that the +GNU Project maintains and to get in touch with your language's +translation team to learn from the practices they have developed over +the years. + +See https://www.gnu.org/server/standards/README.translations.html for +more information. + + +** Translation processes + +Emacs does not yet provide tools that significantly help the translation +process. A few useful functions would be + +- automatic lookup of a list of glossary items when starting to work on +a translation "unit" (paragraph or otherwise), such glossary terms +should be easily insertable at point, + +- automatic lookup of past translations to check for similarity and +improve homogeneity over the whole document set, such past translation +matches should be easily insertable at point, + +etc. + + +*** Using the PO format as an intermediate translation format + +Although the PO format has not been developed with documentation in +mind, it is well known among free software translation teams and you can +easily use the po4a utility to convert Texinfo to PO for work in +translation tools that support the PO format. + +See https://po4a.org for more information. + +However, regardless of the intermediate file format that you might use, +you should only send Texinfo files for review to emacs-devel. + + +*** Free tools that you can use in your processes + +A number of free software tools exist, outside the Emacs ecosystem, to +help translators (amateurs and professionals alike) with the translation +process. + +If you find that Emacs should implement some of their features, you are +welcome to provide patches to the Emacs project. + +Such tools include: + +- the GNOME Translation Editor, https://wiki.gnome.org/Apps/Gtranslator/ +- KDE's Lokalize, https://apps.kde.org/lokalize/ +- OmegaT, http://omegat.org +- the Okapi Framework, https://www.okapiframework.org +- pootle, https://pootle.translatehouse.org + +etc. + + +* Licence of this document + +Copyright (C) 2024 Free Software Foundation, Inc. + +Copying and distribution of this file, with or without modification, are +permitted in any medium without royalty provided the copyright notice +and this notice are preserved. This file is offered as-is, without any +warranty. diff --git a/doc/translations/fr/misc/ses-fr.texi b/doc/translations/fr/misc/ses-fr.texi new file mode 100644 index 00000000000..e1b9cac5fc3 --- /dev/null +++ b/doc/translations/fr/misc/ses-fr.texi @@ -0,0 +1,1631 @@ +\input texinfo @c -*- mode: texinfo; coding: utf-8; -*- +@c %**start of header +@setfilename ../../../../info/ses-fr.info +@documentlanguage fr +@documentencoding UTF-8 +@settitle @acronym{SES}: Le tableur simple d’Emacs +@include docstyle.texi +@setchapternewpage off +@syncodeindex fn cp +@syncodeindex vr cp +@syncodeindex ky cp +@c %**end of header + +@copying +Ce fichier documente @acronym{SES} : le tableur simple d’Emacs (Simple +Emacs Spreadsheet). + +Copyright @copyright{} 2002--2024 Free Software Foundation, Inc. + +@quotation +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with no +Invariant Sections, with the Front-Cover Texts being ``A GNU Manual,'' +and with the Back-Cover Texts as in (a) below. A copy of the license +is included in the section entitled ``GNU Free Documentation License.'' + +(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and +modify this GNU manual.'' +@end quotation +@end copying + +@dircategory Emacs misc features +@direntry +* @acronym{SES}-fr: (ses-fr). Le tableur simple d’Emacs. +@end direntry + +@finalout + +@titlepage +@title @acronym{SES} +@subtitle Le tableur simple d’Emacs +@author Jonathan A. Yavner +@author @email{jyavner@@member.fsf.org} + +@page +@vskip 0pt plus 1filll +@insertcopying +@end titlepage + +@contents + +@c =================================================================== + +@ifnottex +@node Top +@comment node-name, next, previous, up +@top @acronym{SES}: Simple Emacs Spreadsheet + +@display +@acronym{SES} est mode majeur de GNU Emacs pour éditer des fichiers +tableur, c.-à-d.@: des fichiers contenant une grille rectangulaire de +cellules. Les valeurs des cellules sont spécifiées par des formules +pouvant se référer aux valeurs d’autres cellules. +@end display +@end ifnottex + +Pour les rapports d’anomalie, utiliser @kbd{M-x report-emacs-bug}. + +@insertcopying + +@menu +* Boniment: Sales Pitch. Pourquoi utiliser @acronym{SES}? +* Tuto: Quick Tutorial. Une introduction sommaire +* Les bases: The Basics. Les commandes de base du tableur +* Fonctions avancées: Advanced Features. Vous voulez en savoir plus ? +* Pour les gourous: For Gurus. Vous voulez en savoir @emph{encore plus} ? +* Index: Index. Index des concepts, fonctions et variables +* Remerciements: Acknowledgments. Remerciements +* Licence GNU pour la documentation libre: GNU Free Documentation License. La licence de cette documentation. +@end menu + +@c =================================================================== + +@node Sales Pitch +@comment node-name, next, previous, up +@chapter Boniment +@cindex features + +@itemize -- +@item Créer et éditer des feuilles de calcul avec un minimum de tracas. +@item Prise en charge complète du Défaire/Refaire/Sauvegarde auto. +@item Protection contre les virus enfouis dans les feuilles de calcul. +@item Les formules de cellule sont directement du code Emacs Lisp. +@item Fonctions d’impression pour contrôler l’apparence des cellules. +@item Raccourcis clavier intuitifs : C-o = insérer une ligne, M-o = insérer une colonne, etc. +@item « Débordement » des valeurs de cellule longues dans les cellules vides suivantes. +@item La ligne d’en-tête montre les lettres désignant les colonnes. +@item Autocomplétion pour la saisie des symboles de cellules nommées lors de la saisie des formules. +@item Couper, copier et coller peut transferer les formules et les fonctions d’impression. +@item Import and export de valeurs séparées par des tabulations, ou de formules séparées par des tabulations. +@item Format de fichier en texte, facile à bidouiller. +@end itemize + +@c =================================================================== + +@node Quick Tutorial +@chapter Tuto +@cindex introduction +@cindex tuto + +Si vous désirez être rapidement lancé et pensez que vous savez ce que +vous attendez d’un tableur simple, alors ce chapitre peut être tout ce +dont vous avez besoin. + +Premièrement, visitez un nouveau fichier avec pour extension de nom de +fichier @file{.ses}. Emacs vous présente alors une feuille de calcul +vide contenant une seule cellule. + +Commencez par saisir une ligne d’en-tête : @kbd{"Revenu@key{RET}}. Le +guillemet double @code{"} indique que vous saisissez une cellule +textuelle, il ne fait pas partie de la valeur de la cellule, et aucun +guillemet de fermeture n’est nécessaire. + +Pour insérer votre première valeur de revenu, vous devez d’abord +redimensionner la feuille. Appuyer sur la touche @key{TAB} pour +ajouter une nouvelle cellule et revenez à elle en remontant. +Saisissez un nombre, tel que @samp{2.23}. Puis continuer pour ajouter +quelques valeurs supplémentaires de revenu, par ex. : + +@example +@group +A + Revenu + 2.23 + 0.02 + 15.76 + -4.00 +@end group +@end example + +Pour additionner les valeurs entre elles, saisissez une expression +Lisp : + +@example +(+ A2 A3 A4 A5) +@end example + +Peut-être désirez vous ajouter une cellule à la droite de la cellule +@samp{A4} pour expliquer pourquoi vous avez une valeur négative. En +appuyant sur @kbd{TAB} dans cette cellule vous ajouter entièrement une +nouvelle colonne @samp{B} où vous pourrez ajouter une telle note. + +La colonne est assez étroite par défaut, mais en appuyant sur @kbd{w} +vous pouvez la redimensionner selon vos besoins. Faites la de 22 +caractères de large. Vous pouvez maintenant ajoutez des notes +descriptives pour chacune des cases, par ex.@: : + +@example +@group +A B + Revenu + 2.23 Frais de consultation + 0.02 Opinion informée + 15.76 Stand limonade + -4 Prêt à Joseph + 14.01 Total +@end group +@end example + +Par défaut, l’impression des valeurs de cellule se fait alignée à +droite, c’est la raison d’un tel alignement pour les notes dans la +colonne @samp{B}. Pour changer cela, vous pouvez saisir une fonction +d’impression pour la colonne entière, en utilisant par ex. @kbd{M-p +("%s")}. Le fait que @code{"%s"} soit contenu dans une liste indique à +@acronym{SES} que l’alignement est à faire à gauche. Vous pouvez +l’emporter sur la fonction d’impression de colonne pour l’une +quelconque de ses cellules en donnant une fonction d’impression par +cellule avec @kbd{p}. + +Vous pouvez nommer une fonction d’impression, et utiliser le nom de la +fonction à la place de sa définition, de sorte à faciliter la +modification de l’impression de toutes les cellules utilisant cette +fonction. Par exemple tapez @kbd{M-x +ses-define-local-printer@key{ret}}, puis @kbd{note@key{ret}}, puis +@kbd{("%s")} pour définir une fonction d’impression nommée @code{note} +dont la définition est @code{("%s")}, puis sur la colonne @samp{B} tapez +@kbd{M-p note@key{ret}} + +@example +@group +A B + Revenu + 2.23 Frais de consultation + 0.02 Opinion informée + 15.76 Stand limonade + -4 Prêt à Joseph + 14.01 Total +@end group +@end example + +Si maintenant vous redéfinissez @code{note} avec pour nouvelle +définition @kbd{("*%s")} qui ajoute un astérisque @code{*} devant le +texte, la zone d’impression est modifiée ainsi : +@example +@group +A B + Revenu + 2.23 *Frais de consultation + 0.02 *Opinion informée + 15.76 *Stand limonade + -4 *Prêt à Joseph + 14.01 *Total +@end group +@end example + +Notez que la cellule @samp{B1} reste affichée vide et n’est pas +affichée comme @samp{*}. C’est parce que la valeur de la cellule est +@code{nil}, et que les fonctions d’impression définies à partir d’une +chaîne de formatage comme @code{"%s"} dans @code{("%s")} impriment +systématiquement @code{nil} comme une chaîne vide, et tentent +d’imprimer toute valeur non-@code{nil} en utilisant la fonction +standarde @code{format} avec la chaîne de formatage, et si cela +échoue, utilisent la fonction de repli @code{ses-prin1} la place. + +Si maintenant Joseph rembourse son prêt, vous pourriez effacer cette +case ; par ex.@: en positionnant le curseur sur la cellule A5 et en +appuyant sur @kbd{C-d}. Si vous faites celle le total imprimé dans la +cellule A6 affichera @samp{######}. La raison de cela est la valeur +dans une cellule vide est typiquement @code{nil} et que l’opérateur +@code{+} ordinaire échoue à gérer une telle valeur. Au lieu de vider +la cellule, vous pourriez littéralement saisir @samp{0}, ou supprimer +entièrement la ligne en utilisant @kbd{C-k}. Une alternative est +d’utiliser la fonction spéciale @code{ses+} au lieu du @code{+} +ordinaire : + +@example +(ses+ A2 A3 A4 A5) +@end example + +Pour rendre une formule robuste au changement de géométrie de la +feuille, vous pouvez utiliser la macro @code{ses-range} pour faire +référence à une plage de cellules par ses extrémités, par ex. : + +@example +(apply 'ses+ (ses-range A2 A5)) +@end example + +(Le @code{apply} est nécessaire parce que @code{ses-range} produite +une @emph{liste} de valeurs, ce qui ouvre des possibilités plus +complexes). + +Alternativement vous pouvez utiliser le modificateur @code{!} de +@code{ses-range} pour retirer les cellules vides de la liste renvoyée, +ce qui permet d’utiliser @code{+} au lieu de @code{ses+}: + +@lisp +(apply '+ (ses-range A2 A5 !)) +@end lisp + +@c =================================================================== + +@node The Basics +@comment node-name, next, previous, up +@chapter Les bases +@cindex commandes de base +@cindex base, commandes de +@findex ses-jump +@findex ses-mark-row +@findex ses-mark-column +@findex ses-mark-whole-buffer +@findex set-mark-command +@findex keyboard-quit + +Pour créer une nouveau tableur, visitez un fichier inexistant dont le +nom se termine en @file{.ses}. Par exemple, @kbd{C-x C-f essai.ses +@key{ret}}. + + +Un @dfn{identificateur de cellule} est un symbole avec une lettre de +colonne et un numéro de ligne. La cellule B7 est la 2e column de la +7e ligne. Pour les feuilles très larges, il ya deux lettres de +colonne : la cellule AB7 les la 28e colonne de la 7e ligne. Les +feuilles encore plus larges ont AAA1, etc. On se déplace avec les +commandes ordinaires de déplacement d’Emacs. + +@table @kbd +@item j +Déplace le point vers la cellule spécifiée par identificateur +(@code{ses-jump}). À moins que la cellule ne soit une cellule +renommée, l’identificateur est insensible à la casse. Un argument +préfixe @math{n} déplace vers la cellule de coordonnées @math{(n\div +R, n \% C)} pour une feuille de @math{R} ligne et @math{C} colonnes, +et @samp{A1} étant aux coordonnées @math{(0,0)}. La façon dont +l’identificateur ou l’argument préfixe de commande sont interprétés +peut être personnalisée via les variables +@code{ses-jump-cell-name-function} et @code{ses-jump-prefix-function}. +@end table + +Le Point est toujours sur le bord de gauche d’une cellule, ou à la fin +de ligne vide. Quand la marque est inactive, la cellule courante est +soulignée. Quand la marque est active, la plage est le rectangle de +cellules mis en vedette (@acronym{SES} utilise toujours le mode de +marque transitoire). Faire glisser la souris de @samp{A1} à @samp{A3} +crée la plage @samp{A1-A2}. Beaucoup de commandes @acronym{SES} +opèrent seulement sur une seule cellule, et non sur une plage. + +@table @kbd +@item C-@key{SPC} +@itemx C-@@ +Règle la marque au point (@code{set-mark-command}). + +@item C-g +Désactive la marque (@code{keyboard-quit}). + +@item M-h +Met en vedette la ligne courante (@code{ses-mark-row}). + +@item S-M-h +Met en vedette la colonne courante (@code{ses-mark-column}). + +@item C-x h +Mettre en vedette toutes les cellules (@code{mark-whole-buffer}). +@end table + +@menu +* Formules: Formulas. +* Redimensionner: Resizing. +* Fonctions d’impression: Printer functions. +* Effacer des cellules: Clearing cells. +* Copier/couper/coller: Copy/cut/paste. +* Personnaliser @acronym{SES}: Customizing @acronym{SES}. +@end menu + +@node Formulas +@section Formules de cellule +@cindex formules +@cindex formules, saisire +@cindex valeurs +@cindex valeurs de cellule +@cindex éditer des cellules +@findex ses-read-cell +@findex ses-read-symbole +@findex ses-edit-cell +@findex ses-recalculate-cell +@findex ses-recalculate-all + +Pour insérer une valeur dans une cellule, tapez juste une expression +numérique, un @samp{"texte entre guillemets anglais"}, ou une +expression Lisp. + +@table @kbd +@item 0..9 +Auto-insérer un nombre (@code{ses-read-cell}). + +@item - +Auto-insérer un nombre négatif (@code{ses-read-cell}). + +@item . +Auto-insérer un nombre décimal (@code{ses-read-cell}). + +@item " +Auto-insérer une chaîne de caractères. Le guillemet anglais de +terminaison est inséré automatiquement (@code{ses-read-cell}). + +@item ( +Auto-insérer une expression. La parenthèse de droite est insérée +automatiquement (@code{ses-read-cell}). Pour accéder à la valeur +d’une autre cellule, il suffit d’utiliser son identificateur dans +votre expression. Dès que l’autre cellule change, la formule de cette +cellule-ci est réévaluée. En tapant l’expression, vous pouvez +utiliser les raccourcis clavier suivants : +@table @kbd +@item M-@key{TAB} +pour compléter les noms de symboles, et +@item C-h C-n +pour lister les symboles de cellules renommées dans un tampon d’aide. +@end table + +@item ' @r{(apostrophe)} +Entrer un symbole (@code{ses-read-symbol}). @acronym{SES} se souvient +de tous les symboles qui ont été utilisés comme formules, de sorte que +vous pouvez taper juste le début d’un symbole et utiliser +@kbd{@key{SPC}}, @kbd{@key{TAB}}, et @kbd{?} pour le compléter. +@end table + +Pour saisire quelque-chose d’autre (par ex., un vecteur), commencer +avec un chiffre, puis effacer le chiffre et tapez ce que vous désirez. + +@table @kbd +@item @key{RET} +Édite la formule existante dans la cellule courante (@code{ses-edit-cell}). + +@item C-c C-c +Force le recalcul de la cellule ou plage courante (@code{ses-recalculate-cell}). + +@item C-c C-l +Recalcule la feuille entière (@code{ses-recalculate-all}). +@end table + +@node Resizing +@section Redimensionner la feuille +@cindex redimensionner des feuilles +@cindex dimensions +@cindex ligne, ajout ou suppression +@cindex colonne, ajout ou suppression +@cindex ajouter des lignes ou colonnes +@cindex insérer des lignes ou colonnes +@cindex enlever des lignes ou colonnes +@cindex supprimer des lignes ou colonnes +@findex ses-insert-row +@findex ses-insert-column +@findex ses-delete-row +@findex ses-delete-column +@findex ses-set-column-width +@findex ses-forward-or-insert +@findex ses-append-row-jump-first-column + + +Commande de base : + +@table @kbd +@item C-o +(@code{ses-insert-row}) + +@item M-o +(@code{ses-insert-column}) + +@item C-k +(@code{ses-delete-row}) + +@item M-k +(@code{ses-delete-column}) + +@item w +(@code{ses-set-column-width}) + +@item @key{TAB} +Déplace le point sur la prochaine cellule vers la droite, ou insère +une nouvelle colonne si on est déjà sur la dernière cellule de la +ligne, ou insère une nouvelle ligne si on est sur la ligne de +terminaison (@code{ses-forward-or-insert}). + +@item C-j +Insère une nouvelle ligne sous la ligne courante et va à la colonne A +de cette ligne (@code{ses-append-row-jump-first-column}). +@end table + +En redimensionnant la feuille (à moins que vous ne fassiez que changer +la largeur d’une colonne) les références de cellule au sein des +formules sont toutes relocalisées de sorte à continuer à faire +référence aux mêmes cellules. Si une formule mentionne B1 et que vous +insérez une nouvelle première ligne, alors la formule mentionnera B2. + +Si vous supprimez une cellule à laquelle une formule fait référence, +le symbole de cellule est supprimé de la formule, de sorte que +@code{(+ A1 B1 C1)} après suppression de la troisième colonne devient +@code{(+ A1 B1)}. Au cas où cela ne serait pas ce que vous désiriez : + +@table @kbd +@item C-_ +@itemx C-x u +Défait l’action action précédente (@code{(undo)}). +@end table + + +@node Printer functions +@section Fonctions d’impression +@cindex fonctions d’impression +@cindex formatage de cellule +@cindex cellules, formater + +Les fonctions d’impression convertissent des valeurs binaires de +cellule en formes d’impression qu’Emacs affiche à l’écran. + +@menu +* Différents types de fonctions d’impression: Various kinds of printer functions. +* Configurer quelle fonction d’impression s’applique: Configuring what printer function applies. +* Les fonctions d’impression standardes: Standard printer functions. +* Les fonctions d’impression locales: Local printer functions. +* Écrire une fonctions d’impression lambda: Writing a lambda printer function. +@end menu + +@node Various kinds of printer functions +@subsection Différents types de fonctions d’impression + +Lorsque on configure quelle fonction d’impression s’applique +(@pxref{Configuring what printer function applies}), on peut saisir +une fonction d’impression comme l’une des possibilités suivantes : + +@itemize +@item +Une chaîne de formatage, telle que @samp{"$%.2f"}. la chaîne formatée +résultante est alignée à droite au sein de la cellule +d’impression. Pour obtenir un alignement à gauche, utilisez des +parenthèses : @samp{("$%.2f")}. +@item +Une fonction d’impression peut aussi être une fonction à un argument +dont la valeur renvoyée est une chaîne (pour obtenir un alignement à +droite) ou une liste d’une chaîne (pour obtenir un alignement à +gauche). Une telle fonction peut à son tour être configurée comme : +@itemize +@item +Une expression lambda, par exemple : + +@lisp +(lambda (x) + (cond + ((null x) "") + ((numberp x) (format "%.2f" x)) + (t (ses-center-span x ?# 'ses-prin1)))) +@end lisp + +Pendant la saisie d’une lambda, vous pouvez utiliser @kbd{M-@key{TAB}} +pour completer les noms de symboles. +@item +Un symbole faisant référence à une fonction d’impression standarde +(@pxref{Standard printer functions}). +@item +Un symbole faisant référence à une fonction d’impression locale +(@pxref{Local printer functions}). +@end itemize + + +@end itemize + + +@node Configuring what printer function applies +@subsection Configurer quelle fonction d’impression s’applique + +Chaque cellule a une fonction d’impression. Si c’est @code{nil}, +alors la fonction d’impression de la colonne de cette cellule est +utilisée. Et si cela est aussi @code{nil}, alors la fonction +d’impression par défaut de la feuille est utilisée. + +@table @kbd +@item p +@findex ses-read-cell-printer +Saisit une fonction d’impression pour la cellule ou plage courante +(@code{ses-read-cell-printer}). + +@item M-p +@findex ses-read-column-printer +Saisit une fonction d’impression pour la colonne courante (@code{ses-read-column-printer}). + +@item C-c C-p +@findex ses-read-default-printer +Saisit la fonction d’impression par défaut de la feuille +(@code{ses-read-default-printer}). +@end table + +Les commandes @code{ses-read-@var{xxx}-printer} permettent les commandes +suivantes pendant l’édition: + +@table @kbd +@item @key{arrow-up} +@itemx @key{arrow-down} +Pour parcourir l’historique : les commandes +@code{ses-read-@var{xxx}-printer} ont leur propre historique de +mini-tampon, il est préchargé avec l’ensemble de toutes les fonctions +d’impression utilisées dans cette feuille, plus les fonctions +d’impression standardes (@pxref{Standard printer functions}) et les +fonctions d’impression locales (@pxref{Local printer functions}). +@item @key{TAB} +Pour compléter les symboles de fonctions d’impression locales, et +@item C-h C-p +Pour lister les fonctions d’impression locales dans un tampon d’aide. +@end table + + +@node Standard printer functions +@subsection Les fonctions d’impression standardes + + +Mise à part @code{ses-prin1}, les autres fonctions d’impression +standardes ne conviennent que pour les cellules, et non pour les +colonnes ou comme fonction d’impression par défaut de la feuille, +parce qu’elles formatent la valeur en utilisant la fonction +d’impression de colonne (ou par défaut si @code{nil}) et ensuite +post-traite le résultat, par ex.@: le centre : + +@ftable @code +@item ses-center +Centre juste. + +@item ses-center-span +Centrer en débordant sur les cellules vides suivantes. + +@item ses-dashfill +Centrer en utilisant des tirets (@samp{-}) au lieu d’espaces. + +@item ses-dashfill-span +Centrer avec tirets et débordement. + +@item ses-tildefill-span +Centrer avec tildes (@samp{~}) et débordement. + +@item ses-prin1 +C’est la fonction d’impression de repli, utilisée quand l’appel à la +fonction d’impression configurée envoie une erreur. +@end ftable + +@node Local printer functions +@subsection Les fonctions d’impression locales + +@findex ses-define-local-printer +Vous pouvez définir une fonction d’impression locale à la feuille avec +la commande @code{ses-define-local-printer}. Par exemple, définissez +une fonction d’impression @samp{toto} à @code{"%.2f"}, et ensuite +utilisez le symbole @samp{toto} comme fonction d’impression. Ensuite, +si vous rappelez @code{ses-define-local-printer} sur @samp{toto} pour +le redéfinir comme @code{"%.3f"}, alors toutes les cellules utilisant +la fonction d’impression @samp{toto} seront re-imprimées conformément. + +Il peut arriver que vous désiriez définir ou redéfinir certaines +fonctions d’impression à chaque fois que vous ouvrez une feuille. Par +exemple, imaginez que vous désiriez définir/re-définir automatiquement +une fonction d’impression locale @code{euro} pour afficher un nombre +comme une somme en euros, par exemple le nombre @code{3.1} serait +affiché comme @code{3.10@dmn{}@euro{}}. Pour faire cela dans tout +tampon SES qui n’est pas en lecture seule, vous pouvez ajouter ce +genre de code à votre fichier d’init @file{.emacs} : + +@lisp +(defun my-ses-mode-hook () + (unless buffer-read-only + (ses-define-local-printer + 'euro + (lambda (x) + (cond + ((null x) "") + ((numberp x) (format "%.2f€" x)) + (t (ses-center-span x ?# 'ses-prin1))))))) +(add-hook 'ses-mode-hook 'my-ses-mode-hook) +@end lisp + +Si vous remplacez la commande @code{ses-define-local-printer} par la +fonction @code{ses-define-if-new-local-printer} +@findex ses-define-if-new-local-printer +la définition ne se produira que si aucune fonction d’impression de +même nom n’est déjà définie. + + +@node Writing a lambda printer function +@subsection Écrire une fonctions d’impression lambda + +Vous pouvez écrire une fonction d’impression avec une expression +lambda prenant un seul argument en deux cas : + +@itemize +@item +quand vous configurez la fonction d’impression s’appliquant à +une cellule ou colonne, ou +@item +quand vous définissez une fonction d’impression avec la commande +@code{ses-define-local-printer}. +@end itemize + +En faisant cela, prenez garde à ce que la valeur renvoyée soit une +chaîne, ou une liste contenant une chaîne, même quand l’argument +d’entrée a une valeur inattendue. Voici un exemple : + +@example +(lambda (val) + (cond + ((null val) "") + ((and (numberp val) (>= val 0)) (format "%.1f" val)) + (t (ses-center-span val ?# 'ses-prin1)))) +@end example + +Cet exemple fait ceci : + +@itemize +@item +Quand la cellule est vide (c.-à-d.@: quand @code{val} est @code{nil}), +imprime une chaîne vide @code{""} +@item +Quand la valeur de cellule est un nombre positif ou nul, formate la +valeur en notation à virgule fixe avec une decimale après la virgule +@item +Sinon, gère la valeur comme erronnée en l’imprimant comme une +s-expression (avec @code{ses-prin1}), centrée et entourée de +croisillons @code{#} de bourrage. +@end itemize + +Une autre précaution à prendre est d’éviter un débordement de pile à +cause d’une fonction d’impression se rappelant elle-même sans +fin. Cette erreur peut se produire quand vous utilisez une fonction +d’impression locale comme fonction d’impression de colonne, et que +cette fonction d’impression locale appelle implicitement la fonction +d’impression de colonne courante, ainsi elle se rappelle elle-même +récursivement. Imaginez par exemple que vous désirez créer une +fonction d’impression locale @code{=bourre} qui centre le contenu +imprimé d’une cellule et l’entoure de signes égal @code{=}, et que +vous le faites (erronnément) comme cela : + +@lisp +;; CODE ERRONÉ +(lambda (x) + (cond + ((null x) "") + (t (ses-center x 0 ?=)))) +@end lisp + +Comme @code{=bourre} utilise la fonction d’impression standarde +@code{ses-center} mais sans lui passer exemplicitement une fonction +d’impression, @code{ses-center} appelle la fonction d’impression de +colonne courante s’il y en a une, ou la fonction d’impression par +défaut de la feuille sinon. Aussi, utiliser @code{=bourre} comme +fonction d’impression de colonne aura pour résultat de causer un +débordement de pile dans cette colonne sur toute cellule non vide, +puisque @code{ses-center} rappelle récursivement la fonction qui l'a +appelé. @acronym{SES} ne vérifie pas cela ; il vous faut donc faire +attention. Par exemple, reécrivez @code{=bourre} ainsi : + +@lisp +(lambda (x) + (cond + ((null x) "") + ((stringp x) (ses-center x 0 ?= " %s ")) + (t (ses-center-span x ?# 'ses-prin1)))) +@end lisp + +Le code ci-dessus est réparé au sens où @code{ses-center} et +@code{ses-center-span} sont toutes deux appelées avec un dernier +argument @var{printer} explicite spécifiant la fonction d'impression, +respectivement @code{" %s "} et @code{'ses-prin1}. + + +Le code ci-dessus applique le bourrage de @code{=} seulement aux +chaînes ; et aussi il entoure la chaîne par un espace de chaque côté +avant de bourrer avec des signes @code{=}. Ainsi la chaîne @samp{Ula} +s’affichera comme @samp{@w{=== Ula ===}} dans une colonne large de 11 +caractères. Toute valeur qui n’est ni @code{nil} (c.-à-d.@: une +cellule vide) ni une chaîne est affichée comme une erreur par l’usage +de bourrage par des croisillons @code{#}. + +@node Clearing cells +@section Effacer des cellules +@cindex effacer, commandes +@findex ses-clear-cell-backward +@findex ses-clear-cell-forward + +Ces commandes règlent à la fois la formule et la fonction d’impression +à @code{nil} : + +@table @kbd +@item @key{DEL} +Se deplace à gauche et efface la cellule (@code{ses-clear-cell-backward}). + +@item C-d +Efface la cellule et se déplace à droite (@code{ses-clear-cell-forward}). +@end table + + +@node Copy/cut/paste +@section Copier, couper, et coller +@cindex copier +@cindex couper +@cindex coller +@findex kill-ring-save +@findex mouse-set-region +@findex mouse-set-secondary +@findex ses-kill-override +@findex yank +@findex clipboard-yank +@findex mouse-yank-at-click +@findex mouse-yank-at-secondary +@findex ses-yank-pop + +Les fonctions de copie opèrent sur des regions rectangulaires de +cellules. Vous pouvez coller les copies dans des tampons +non-@acronym{SES} pour exporter le texte d’impression. + +@table @kbd +@item M-w +@itemx [copy] +@itemx [C-insert] +Copie les cellules en vedette vers l’anneau presse-papier et le +presse-papier primaire (@code{kill-ring-save}). + +@item [drag-mouse-1] +Marque une region et la copie vers l’anneau presse-papier et le +presse-papier primaire (@code{mouse-set-region}). + +@item [M-drag-mouse-1] +Marque une region et la copie vers l’anneau presse-papier et le +presse-papier secondaire (@code{mouse-set-secondary}). + +@item C-w +@itemx [cut] +@itemx [S-delete] +Les fonctions couper ne suppriment pas en fait de lignes ou de +colonnes --- elles les copient et puis les effacent +(@code{ses-kill-override}). + +@item C-y +@itemx [S-insert] +Colle à partir de l’anneau presse-papier (@code{yank}). Les fonctions +coller se comportent différemment selon le format du texte qu’elles +insèrent : +@itemize @bullet +@item +Quand on colle des cellules qui ont été coupées ou copiées à partir +d’un tampon @acronym{SES}, le texte d’impression est ignoré et +seulement la formule et fonction d’impression jointes sont insérées ; +les références de cellule de la formule sont relocalisées à moins que +vous n’utilisiez @kbd{C-u}. +@item +Le texte collé écrase un rectangle de cellules dont le coin haut +gauche est la cellule courante. Si une partie du rectangle est +au-délà des bords de la feuille, vous devez confirmer l’augmentation +de la taille de la feuille. +@item +Du texte Non-@acronym{SES} est d’ordinaire inséré comme formule de +remplacement pour la cellule courante. Si la formule serait un +symbole, elle est traitée comme une chaîne à moins que vous +n’utilisiez @kbd{C-u}. Les formules collées comprenant des erreurs de +syntaxe sont toujours traitées comme des chaînes. +@end itemize + +@item [paste] +Colle à partir du presse-papier primaire ou de l’anneau presse-papier +(@code{clipboard-yank}). + +@item [mouse-2] +Règle le point et colle à partir du presse-papier primaire +(@code{mouse-yank-at-click}). + +@item [M-mouse-2] +Règle le point et colle à partir du presse-papier secondaire +(@code{mouse-yank-secondary}). + +@item M-y +Immédiatement après un coller, vous pouvez remplacer le texte avec un +élément précédent à partir de l’anneau presse-papier +(@code{ses-yank-pop}). Contrairement au yank-pop standard d’Emacs, la +version de @acronym{SES} utilise @code{undo} pour supprimer l’ancien +collage. Est-ce que cela ne fait aucune différence ? +@end table + +@node Customizing @acronym{SES} +@section Personnaliser @acronym{SES} +@cindex personnaliser +@vindex enable-local-eval + +Par défaut, une feuille venant d’être créée a 1 ligne et 1 colonne. +La largeur de colonne est 7 et la fonction d’impression par défaut est +@samp{"%.7g"}. Chacune de ces choses peut être personnalisée. Allez +voir dans le groupe « ses ». + +Après avoir saisi une valeur de cellule, normalement +@code{forward-char} est appelé, ce qui déplace le point vers la +cellule suivante à droite, ou à la première cellule à gauche de la +ligne suivante si la cellule courante est la plus à droite de la +feuille. Vous pouvez personnaliser @code{ses-after-entry-functions} +pour que le déplacement soit vers la gauche ou le haut ou le bas. +Pour un mouvement diagonal, selectionnez deux fonctions de la liste. + +@vindex ses-jump-cell-name-function +@code{ses-jump-cell-name-function} est une variable personnalisable +réglée par défaut à la fonction @code{upcase}. Cette fonction est +appelée quand vous passez un nom de cellule à la commande +@command{ses-jump} (@kbd{j}), et que ce nom n’est pas le nom d’une +cellule renommée. Elle change le nom de cellule saisi en celui de la +cellule vers laquelle sauter. Le réglage par défaut @code{upcase} vous +permet de saisir le nom de cellule en bas de casse. Un autre usage de +@code{ses-jump-cell-name-function} pourrait être une +internationalisation pour convertir des caractères non latins en +équivalents latins pour nommer la cellule. Au lieu d’un nom de +cellule, la fonction peut renvoyer des coordonnées de cellule sous la +forme d’un cons, par exemple @code{(0 . 0)} pour la cellule @code{A1}, +@code{(1 . 0)} pour la cellule @code{A2}, etc. + +@vindex ses-jump-prefix-function +@code{ses-jump-prefix-function} est une variable personnalisable +réglée par défaut à la fonction @code{ses-jump-prefix}. Cette fonction +est appelée quand vous donnez un argument préfixe à la commande +@command{ses-jump} (@kbd{j}). Elle renvoie un nom de cellule ou des +coordonnées de cellule correspondant à l’argument préfixe. Les +coordonnées de cellule sont sous la forme d’un cons, par exemple +@code{(1 . 0)} pour la cellule @code{A2}. Le réglage par défaut +@code{ses-jump-prefix} numérote les cellules de gauche à droite et +puis de haut en bas, de sorte que si on suppose une feuille 4×3, +l’argument préfixe @samp{0} saute à la cellule @samp{A1}, l’argument +préfixe @samp{2} saute à @samp{C1}, l’argument préfixe @samp{3} saute +à @samp{A2}, etc. + +@vindex ses-mode-hook +@code{ses-mode-hook} est un crochet de mode normal (une liste de +fonctions qui s’exécutent quand le mode @acronym{SES} démarre sur un +tampon). + +@vindex safe-functions +La variable @code{safe-functions} est une liste de fonctions +potentiellement risquées à traiter comme si elles étaient sûres lors +de l’analyse des formules et fonctions d’impression. @xref{Virus +protection}. Avant de personnaliser @code{safe-functions}, +réfléchissez à quel point vous faites confiance à la personne qui vous +suggère cette modification. La valeur @code{t} désactive toute +protection anti-virus. Une valeur donnant une liste-de-fonctions peut +rendre une feuille « trop bien », mais elle crée aussi des portes +dérobées dans votre armure anti-virus. Pour que votre protection +contre les virus fonctionne, vous devez toujours appuyer sur @kbd{n} +quand un avertissement contre un virus vous est présenté, à moins que +vous compreniez ce que le code en question essaie de faire. N’écoutez +pas ceux qui vous racontent de personnaliser @code{enable-local-eval} +--- cette variable est pour les gens qui ne portent pas de ceinture de +sécurité ! + + +@c =================================================================== + +@node Advanced Features +@chapter Fonctions avancées +@cindex avancées, fonctions +@findex ses-read-header-row + + +@table @kbd +@item C-c M-C-h +(@code{ses-set-header-row}). +@findex ses-set-header-row +@kindex C-c M-C-h +La ligne d’en-tête au sommet de la fenêtre @acronym{SES} affiche +normalement la ligne de colonne pour chaque colonne. Vous pouvez la +régler pour afficher une copie de l’une des lignes, tell que qu’une +ligne de titres de colonnes, ainsi cette ligne sera toujours visible. +Par défaut la commande règle la ligne courante comme en-tête ; +utiliser C-u pour une invite à désigner la ligne d’en-têre. Régler la +ligne d’en-tête à la ligne 0 pour afficher les lettres de colonne de +nouveau. +@item [header-line mouse-3] +Affiche un menu pour régler la ligne courante comme en-tête, ou +revenir à des lettres de colonne. +@item M-x ses-rename-cell +@findex ses-rename-cell +Renomme une cellule pour passer d'un nom standard du genre de A1 à +toute chaîne pouvant être un nom valide pour une variable locale (Voir +aussi @ref{Nonrelocatable references}). +@item M-x ses-repair-cell-reference-all +@findex ses-repair-cell-reference-all +Quand vous interrompez la mise à jour d’une formule de cellule en +tapant @kbd{C-g}, alors cela peut casser le lien de référence de +cellule, ce qui compromet la mise à jour automatique de cellule quand +toute autre cellule dont elle dépend est modifiée. Pour réparer cela, +utilisez la fonction @code{ses-repair-cell-reference-all} +@end table + +@menu +* La zone d’impression: The print area. +* Plages dans les formules: Ranges in formulas. +* Trier par colonne: Sorting by column. +* Fonctions de formule standardes: Standard formula functions. +* Plus sur l’impression de cellule: More on cell printing. +* Import et export: Import and export. +* Protection contre les virus: Virus protection. +* Feuilles avec détails et synthèse: Spreadsheets with details and summary. +@end menu + +@node The print area +@section La zone d’impression +@cindex zone d’impression +@cindex impression, zone d’ +@findex widen +@findex ses-renarrow-buffer +@findex ses-reprint-all + +Un fichier @acronym{SES} consiste en une zone d’impression et une zone +de données. Normalement le tampon est réduit de sorte à n’afficher +que la zone d’impression. La zone d’impression est en lecture seule, +hormis pour les commandes spéciales de @acronym{SES} ; elle contient +les valeurs de cellule formatées par les fonctions d’impression. La +zone de données enregistre les formules, fonctions d’impression, etc. + +@table @kbd +@item C-x n w +Affiche à la fois les zones d’impression et de données (@code{widen}). + +@item C-c C-n +Affiche seulement la zone d’impression (@code{ses-renarrow-buffer}). + +@item S-C-l +@itemx M-C-l +Recrée la zone d’impression en réévaluant pour toutes les cellules sa +fonction d’impression (@code{ses-reprint-all}). +@end table + +@node Ranges in formulas +@section Plages dans les formules +@cindex plages +@findex ses-insert-plage-click +@findex ses-insert-plage +@findex ses-insert-ses-plage-click +@findex ses-insert-ses-plage +@vindex de +@vindex à + +Une formule du genre de : +@lisp +(+ A1 A2 A3) +@end lisp +est la somme de trois cellules spécifiques. Si vous insérez une +nouvelle deuxième ligne, la formule devient +@lisp +(+ A1 A3 A4) +@end lisp +et la nouvelle ligne n’est pas incluse dans la somme. + +La macro @code{(ses-range @var{de} @var{à})} s’évalue en une liste des +valeurs dans un rectangle de cellules. Si votre formule est +@lisp +(apply '+ (ses-range A1 A3)) +@end lisp +et que vous insérez une nouvelle deuxième ligne, elle devient +@lisp +(apply '+ (ses-range A1 A4)) +@end lisp +et la nouvelle ligne est incluse dans la somme. + +Alors que vous saisissez ou éditez une formule dans le minitampon, +vous pouvez sélectionner une plage dans la feuille (en utilisant la +souris ou le clavier), et injecter une représentation de cette plage +dans votre formule. Supposez que vous sélectionnez @samp{A1-C1} : + +@table @kbd +@item [S-mouse-3] +Insère @samp{A1 B1 C1} (@code{ses-insert-range-click}) + +@item C-c C-r +Version clavier (@code{ses-insert-range}). + +@item [C-S-mouse-3] +Insère @samp{(ses-range A1 C1)} (@code{ses-insert-ses-range-click}). + +@item C-c C-s +Version clavier (@code{ses-insert-ses-range}). +@end table + +Si vous supprimez la cellule @var{de} ou @var{à} d’une plage, la +cellule la plus proche toujours existante est utilisée à la place. Si +vous supprimez l’entière plage, le relocalisateur de formule supprime +le @samp{ses-range} de la formule. + +Si vous insérez une nouvelle ligne juste au delà de la fin d’une plage +à une colonne, ou une nouvelle colonne juste au delà d’une plage à une +ligne, la nouvelle cellule est incluse dans la plage. Les nouvelles +cellules insérées juste avant une plage ne sont pas incluses. + +Des fanions peuvent être ajoutés à @code{ses-range} immédiatement +après la cellule @var{à} . +@table @code +@item ! +Les cellules vides de la plage peuvent être enlevées en ajoutant le +fanion @code{!}. Une cellule vide est une cellule dont la valeur est +l’un des symboles @code{nil} ou @code{*skip*}. Par exemple +@code{(ses-range A1 A4 !)} fait la même chose que @code{(list A1 A3)} +quand les cellules @code{A2} et @code{A4} sont vides. +@item _ +Les valeurs de cellules vides sont remplacées par l’argument suivant +le fanion @code{_}, ou @code{0} quand le fanion @code{_} est le +dernier dans la liste d’arguments. Par exemple @code{(ses-range A1 A4 +_ "vide")} fera la même chose que @code{(list A1 "vide" A3 "vide")} +quand les cellules @code{A2} et @code{A4} sont vides. Similairement, +@code{(ses-range A1 A4 _ )} fera la même chose que @code{(list A1 0 A3 +0)}. +@item >v +Quand l’ordre a de l’importance, liste les cellules en lisant les +cellules ligne par ligne de la cellule en haut à gauche vers la +cellule en bas à droite. Ce fanion est fourni pour être complet car +c’est déjà l’ordre par défaut. +@item +Liste les cellules en lisant les cellules colonne par colonne de la +cellule en haut à gauche vers la cellule en bas à droite. +@item v< +Liste les cellules en lisant les cellules colonne par colonne de la +cellule en haut à droite vers la cellule en bas à gauche. +@item v +Un raccourci pour @code{v>}. +@item ^ +Un raccourci pour @code{^>}. +@item > +Un raccourci pour @code{>v}. +@item < +Un raccourci pour @code{>^}. +@item * +Au lieu de lister les cellules, en fait un vecteur ou une matrice Calc +(@pxref{Top,,,calc,GNU Emacs Calc Manual}). Si la plage contient +seulement une ligne ou une colonne un vecteur est fait, sinon une +matrice est faite. +@item *2 +Idem que @code{*} à ceci près qu’une matrice est toujours faite même +quand il y a une seule ligne ou colonne dans la plage. +@item *1 +Idem que @code{*} à ceci près qu’un vecteur est toujours fait même +quand il n’y a qu’une ligne ou colonne dans la plage, c.-à-d.@: que la +matrice correspondante est aplatie. +@end table + +@node Sorting by column +@section Trier par colonne +@cindex trier +@findex ses-sort-column +@findex ses-sort-column-click + +@table @kbd +@item C-c M-C-s +Trie les cellules d’une plage en utilisant l’une des colonnes +(@code{ses-sort-column}). Les lignes (ou lignes partielles si la +plage n’inclut pas toutes les colonnes) sont réarrangées de sorte que +la colonne choisie soit ordonnée. + +@item [header-line mouse-2] +La façon la plus facile de trier est de cliquer sur mouse-2 sur la +ligne d’en-tête de colonne (@code{ses-sort-column-click}). +@end table + +La comparaison du tri utilise @code{string<}, ce qui fonctionne bien +pour des nombres alignés à droite ou des chaînes alignées à gauche. + +Avec un argument préfixe, trie dans l’ordre descendant. + +Les lignes sont déplacées une à la fois, avec relocalisation des +formules. Ceci fonctionne bien si les formules font référence à +d’autres cellules dans leur ligne, mais non pas si bien pour des +formules qui font référence à d’autres lignes dans la plage ou à des +cellules hors de la plage. + + +@node Standard formula functions +@section Fonctions de formule standardes +@cindex fonctions standardes de formule +@cindex *skip* +@cindex *error* +@findex ses-delete-blanks +@findex ses-average +@findex ses+ + +Souvent on désire qu’un calcul exclue les cellules vides. Voici +quelques fonctions utiles à appeler dans vos formules : + +@table @code +@item (ses-delete-blanks &rest @var{args}) +Renvoie une liste dont toutes les cellules vides (dont la valeur est +soit @code{nil} ou @code{'*skip*}) ont été supprimées. L’ordre des +arguments est inversé. Prière de noter que @code{ses-range} a un +modificateur @code{!} qui permet de supprimer les cellules vides, +ainsi il est possible d’écrire : +@lisp +(ses-range A1 A5 !) +@end lisp +au lieu de +@lisp +(apply 'ses-delete-blanks (ses-range A1 A5 <)) +@end lisp + +@item (ses+ &rest @var{args}) +Somme des arguments non vides pris en ordre inverse. + +@item (ses-average @var{liste}) +Moyenne des éléments non vides de @var{liste}. Ici la liste est +passée comme un seul argument, vu que typiquement on la forme avec +@code{ses-range}. +@end table + +@node More on cell printing +@section Plus sur l’impression de cellule +@cindex cellule, plus sur l'impression +@cindex impression de cellule +@findex ses-truncate-cell +@findex ses-recalculate-cell + +Valeurs spéciales de cellule : +@itemize +@item nil +s’imprime typiquement de la même façon que "", mais permet que la +cellule précédente déborde dessus. +@item '*skip* +remplace nil quand la cellule précédente déborde effectivement ; rien +n’est donc imprimée pour cette cellule. +@item '*error* +indique que la formule a signalé une erreur au lieu de produire une +valeur : la cellule imprimée est remplie de croisillons (#). +@end itemize + +Lorsque la fonction d’impression est définie par une chaîne de +formatage, par ex. @samp{"%.3f"}, @acronym{SES} imprime +automatiquement @code{nil} comme une chaîne vide, mais si la fonction +d’impression est définie par une expression lambda, vous devez définir +explicitement comment @code{nil} est traité, par ex. : +@example +(lambda (x) + (cond + ((null x) "") + ((stringp x) (list x)) + ((numberp x) (format "%.3f" x)) + (t (ses-prin1 x))) +@end example +imprime @code{nil} comme une chaîne vide, aligne à gauche la valeur si +c’est une chaîne, et si c’est un nombre l’aligne à droite en +l’imprimant avec trois décimales. + +Il n’est pas nécessaire par contre que vous vous souciez de +@code{'*skip*} dans la définition d’une fonction d’impression, en +effet aucune fonction d’impression n’est appelée sur @code{'*skip*}. + +Si le résultat de la fonction d’impression est trop large pour la +cellule et que la cellule suivante est @code{nil}, le résultat +débordera sur la cellule suivante. Les résultats très larges peuvent +déborder sur plusieurs cellules. Si le résultat est trop large pour +l’espace disponible (jusqu'à la fin de la ligne ou la prochaine +cellule non-@code{nil}), le résultat est tronqué si la valeur de +cellule est une chaîne, ou remplacé par des croisillons (@samp{#}) +sinon. + +@acronym{SES} pourrait être perturbé par des résultats de fonction +d'impression contenant des sauts de ligne ou des tabulations, aussi +ces caractères sont remplacés par des points d'interrogation. + +@table @kbd +@item t +Confine une cellule à sa propre colonne (@code{ses-truncate-cell}). +Ceci vous permet de déplacer le point sur la cellule de droite qui +sinon serait couverte par un débordement. Si vous ne modifiez pas la +cellule de droite, la cellule confinée débordera de nouveau la +prochaine fois qu’elle sera imprimée. + +@item c +Appliquée à une seule cellule, cette commande affiche dans la zone +d’écho toute erreur de formule ou erreur d’impression survenue pendant +le recalcul/la réimpression (@code{ses-recalculate-cell}). Vous +pouvez utiliser cela pour défaire l’effet de @kbd{t}. +@end table + +Quand une fonction d’impression signale une erreur, la fonction +d’impression de repli +@findex ses-prin1 +@code{ses-prin1} lui est substituée. Ceci est utile quand votre +fonction d’impression de colonne est seulement numérique et que vous +utilisez une chaîne comme valeur de cellule. Notez que la fonction +d’impression par défaut standarde est @samp{"%.7g"} qui est numérique +seulement, ainsi les cellules auxquelles la fonction d’impression par +défaut standarde s’applique et qui ne sont pas vides et ne contiennent +pas un nombre utilisent la fonction d’impression de repli +@code{ses-prin1}, par ex.@: les cellules qui contiennent une chaîne +font cela. @kbd{c} sur de telles cellules affiche « Format specifier +doesn't match argument type ». + + +@node Import and export +@section Import et export +@cindex import et export +@cindex export, et import +@findex ses-export-tsv +@findex ses-export-tsf + +@table @kbd +@item x t +Exporte une plage de cellules comme des valeurs séparées par des +tabulations (@code{ses-export-tsv}). +@item x T +Exporte une plage de cellules comme des formules séparées par des +tabulations (@code{ses-export-tsf}). +@end table + +Le texte exporté va dans l’anneau presse-papier ; vous pouvez le +coller dans un autre tampon. Les colonnes sont séparées par des +tabulations, les lignes par des sauts de lignes. + +Pour importer du texte, utilisez n’importe laquelle des commandes +coller où le texte à coller contient des tabulations et/ou des sauts de +lignes. Les formules importées ne sont pas relocalisées. + +@node Virus protection +@section Protection contre les virus +@cindex virus protection + +À chaque fois une formule ou fonction d’impression est lue d’un +fichier ou est collée dans la feuille, elle est marquée comme +« nécessitant une vérification de sécurité ». Plus tard, quand la +formule ou la fonction d’impression est évaluée pour la première fois, +elle est vérifiée comme sûre en utilisant le prédicat @code{unsafep} ; +si elle s’avère « potentiellement risquée », la formule ou fonction +d’impression en question est affichée et vous devez appuyer @kbd{Y} +pour l’approuver ou @kbd{N} pour utiliser un substitut. Le substitut +signale toujours une erreur. + +Les formules ou fonctions d’impression que vous tapez sont +immédiatement vérifiées quant à leur sûreté. Si elles s’avèrent +potentiellement risquées et que vous appuyez @kbd{N} pour refuser, +l’action est annulée et l’ancienne formule ou fonction d’impression +demeure. + +En plus des virus (qui tentent de se recopier dans d’autres +fichiers), @code{unsafep} peut aussi détecter toutes sortes de chevaux +de Troie, tels que des feuilles de calcul qui effacent les fichiers, +envoient des courriels, inondent des sites Web, corrompent vos +réglages d’Emacs, etc. + +Généralement, les formules et fonctions d’impression de feuilles sont +des choses simples qui n’ont pas besoin de faire des traitements +exotiques, aussi toute partie potentiellement dangereuse de +l’environnement Emacs Lisp peut être exclus sans entraver votre style +comme écrivain de formule. Lisez la documentation dans +@file{unsafep.el} pour plus d’information sur la façon dont les formes +Lisp sont classifiées comme sûres ou risquées. + +@node Spreadsheets with details and summary +@section Feuilles avec détails et synthèse +@cindex détails et synthèse +@cindex synthèses, et détails + +Une organisation usuelle pour une feuille de calcul est d’avoir un tas +de lignes de « détail », chacune décrivant possiblement une +transaction, et ensuite un ensemble de lignes de « synthèse » qui +affichent chacune des données condensées pour un certain sous-ensemble +des détails. @acronym{SES} prend en charge ce type d’organisation via +la fonction @code{ses-select}. + +@table @code +@item (ses-select @var{de-plage} @var{test} @var{à-plage}) +Renvoie un sous-ensemble de @var{à-plage}. Pour chaque membre dans +@var{de-plage} qui est égal à @var{test}, le membre correspondant de +@var{à-plage} est inclus dans le résultat. +@end table + +Exemple d’utilisation : +@lisp +(ses-average (ses-select (ses-range A1 A5) 'Bidochon (ses-range B1 B5))) +@end lisp +Ceci calcule la moyenne des valeurs de la colonne @samp{B} pour les +lignes dont la valeur dans la colonne @samp{A} est le symbole +@samp{'Bidochon}. + +Vous vous demandez peut-être pourquoi les arguments de +@code{ses-select} ne consistent pas au lieu de @var{à-plage} de +décalages @var{décalage-à-la-ligne} et @var{décalage-à-la-colonne} +relativement à @var{de-plage} : spécifier @var{à-plage} explicitement +assure que la formule est recalculée si l’une quelconque des cellules +de cette plage est modifiée. + +Le fichier @file{etc/ses-example.el} dans la distribution Emacs est un +exemple d’une feuille organisée en détails-et-synthèse. + + +@c =================================================================== + +@node For Gurus +@chapter Pour les gourous +@cindex avancées, fonctions +@cindex fonctions avancées + +@menu +* Mises à jour différées: Deferred updates. +* Références non-relocalisables: Nonrelocatable references. +* La zone données: The data area. +* Variables locales-tampon dans les feuilles: Buffer-local variables in spreadsheets. +* Utilisation de advice-add dans @acronym{SES}: Uses of advice-add in @acronym{SES}. +@end menu + +@node Deferred updates +@section Mises à jour différées +@cindex différées, mises à jour +@cindex mises à jour différées +@vindex run-with-idle-timer + +Pour épargner du temps de calcul redondant, les cellules dont le +recalcul est rendu nécessaire par des changements dans d’autres +cellules sont ajoutées à un ensemble. À la fin de la commande, chaque +cellule de cet ensemble est recalculée une fois. Ceci peut créer un +nouvel ensemble de cellules nécessitant un recalcul. Ce processus est +répété jusqu'à ce que l’ensemble soit vide ou que des références +circulaires soient détectées. Dans les cas extrêmes, et notamment si +une référence circulaire est en cours de détection, vous pourriez voir +des messages de progression de la forme « Recalculating... (@var{nnn} +cells left) ». Si vous interrompez le calcul avec @kbd{C-g}, la +feuille demeurera dans un état incohérent, utilisez alors @kbd{C-_} ou +@kbd{C-c C-l} pour réparer cela. + +Pour épargner encore plus de temps en évitant les écritures +redondantes, les cellules qui sont modifiées sont ajoutées à un +ensemble au lieu d’être immédiatement écrites dans la zone de +données. Chaque cellule de cet ensemble est écrite une fois à la fin +de la commande. Si vous modifiez un grand nombre de cellules, vous +pourriez voir un message de progression de la forme +« Writing... (@var{nnn} cells left) ». Ces écritures différées de +cellules ne peuvent pas être interrompues par @kbd{C-g}, alors il vous +faudra juste attendre. + +@acronym{SES} utilise @code{run-with-idle-timer} pour déplacer le +souligné de cellule quand Emacs fait défiler le tampon à la fin d’une +commande, et aussi pour @c xxx narrow and underline +réduire et souligner après visiter un fichier. Ceci peut être visible +par une perturbation transitoire après visiter un fichier et certaines +commandes de défilement. Vous pouvez continuer à taper sans vous +inquiéter de cette perturbation. + + +@node Nonrelocatable references +@section Références non relocalisables +@cindex non-relocalisables, références +@cindex références non-relocalisables + +@kbd{C-y} relocalise toutes les références de cellule dans une formule +collée, alors que @kbd{C-u C-y} n’en relocalise aucune. Et pour les +cas mélangés ? + +La meilleure approche est de renommer les cellules que vous @emph{ne} +voulez @emph{pas} être relocalisables en utilisant +@code{ses-rename-cell}. +@findex ses-rename-cell +Les cellules qui n’ont pas un style de nom du genre de A1 ne sont pas +relocalisées au collage. En utilisant cette méthode, les cellules +concernées ne seront pas relocalisées quelle que soit la formule où +elles apparaissent. Prière toutefois de noter que dans une formule +contenant quelque plage @code{(ses-range @var{cell1} @var{cell2})} +alors dans la formule collée chacune des bornes @var{cell1} et +@var{cell2} de la plage est relocalisée, ou non, indépendemment, selon +qu’elle est nommée du genre de @samp{A1} ou renommée. + +Une méthode alternative est d’utiliser +@lisp +(symbol-value 'B3) +@end lisp +pour faire une @dfn{référence absolue}. Le relocalisateur de formule +saute par dessus tout ce qui est sous un @code{quote}, aussi cela ne +sera pas relocalisé quand on le colle ou quand des lignes/colonnes +sont insérées/supprimées. Toutefois, @samp{B3} ne sera pas +enregistrée comme une dépendance de cette cellule, et donc cette +cellule ne sera pas mise à jour automatiquement quand @samp{B3} est +modifiée, c’est pourquoi l’usage de @code{ses-rename-cell} est la +plupart du temps préférable. + +Les variables @code{row} et @code{col} sont liées dynamiquement +pendant l’évaluation d’une formule de cellule. Vous pouvez utiliser +@lisp +(ses-cell-value row 0) +@end lisp +pour obtenir la valeur de la colonne la plus à gauche de la ligne +courante. Ce type de dépendance n’est pas non plus enregistré. + + +@node The data area +@section La zone de données +@cindex données, zone de +@cindex zone de données +@findex ses-reconstruct-all + +Commence avec un caractère saut de page (de code ASCII 014 en octal), +suivi par un ensemble de macros de définition de cellule pour chaque +ligne, suivi par l’ensemble des définitions de fonctions d’impression +locales, suivi par les largeurs de colonnes, fonctions d’impression de +colonne, fonction d’impression par défaut, et ligne d’en-tête. Ensuite +il y a les paramètres globaux (ID de format fichier, nombre de lignes, +nombre de colonnes, nombre de fonctions d’impression locales) et les +variables locales (spécification du mode @acronym{SES} pour le tampon, +etc.). + +Quand un fichier @acronym{SES} est chargé, tout d’abord les paramètres +globaux sont chargés, puis l’ensemble de la zone de données est +@code{eval}ué, et finalement les variables locales sont traitées. + +Vous pouvez éditer la zone de données, mais n’insérez pas ni ne +supprimez de sauts de ligne, hormis dans la partie des variables +locales, en effet @acronym{SES} localise les choses en comptant les +sauts de ligne. Utilisez @kbd{C-x C-e} à la fin d’une ligne pour +installer ce que vous avez édité dans les structures de données de la +feuille (ceci ne met pas à jour la zone d’impression, utilisez, par +ex., @kbd{C-c C-l} pour cela). + +La zone de données est maintenue comme une image des structures de +données de la feuille stockée dans des variables locales tampon au +moment du chargement initial de la zone. Si le contenu de la zone de +données se trouve corrompu par la suite, vous pouvez essayer de +reconstruire la zone de données à partir des structures de données +avec : + +@table @kbd +@item C-c M-C-l +(@code{ses-reconstruct-all}). +@end table + + +@node Buffer-local variables in spreadsheets +@section Les variables locales-tampon dans les feuilles de calcul +@cindex locales-tampon, variables +@cindex variables locales-tampon + +Vous pouvez ajouter des variables locales supplémentaires à la liste +au bas de la zone de données, telles que des constantes cachées +auxquelles vous désirez faire référence dans vos formules. + +Vous pouvez initialiser la variable @code{ses--symbolic-formulas} pour +être une liste de symboles (comme une suite de chaînes entre +parenthèses) à proposer comme complétions pour la commande @kbd{'}. +Cette liste initiale de complétions sera utilisée à la place de +l’ensemble effectif des symboles-comme-formules de la feuille. + +Pour un exemple de ceci, voir le fichier @file{etc/ses-example.ses}. + +Si (pour une raison quelconque) vous désirez que vos formules ou +fonctions d’impression sauvegardent des données dans des variables, +vous devez déclarer ces variables comme locales tampon pour éviter un +avertissement de virus. + +Vous pouvez définir des fonctions en en faisant des valeurs pour la +fausse variable locale @code{eval}. De telles fonctions peuvent +ensuite être utilisées dans les formules et comme fonctions +d’impression, mais d’ordinaire chaque @code{eval} est présenté à +l’utilisateur pendant le chargement du fichier comme un virus +potentiel. Et cela peut devenir gênant. + +Vous pouvez définir des fonctions dans votre fichier @file{.emacs}. +Toute personne pourra encore lire la zone d’impression de votre +feuille, mais ne pourra pas recalculer ou réimprimer quoi que ce soit +qui dépende de vos fonctions. Pour éviter des avertissements contre +les virus, chaque fonction utilisée dans une formule nécessite +@lisp +(put 'le-nom-de-votre-fonction 'safe-function t) +@end lisp + +@node Uses of advice-add in @acronym{SES} +@section Utilisation de advice-add dans @acronym{SES} +@findex advice-add +@findex copy-region-as-kill +@findex yank + +@table @code +@item copy-region-as-kill +Quand on copie de la zone d’impression d’une feuille, traite la région +comme un rectangle et joint pour chaque cellule sa formule et sa +fonction d’impression comme des propriétés @code{'ses}. + +@item yank +Quand on colle dans la zone d’impression d’une feuille de calcul, +essaie de coller comme des cellules (si le texte à coller a des +propriétés @code{'ses}), ensuite comme des formules séparées par des +tabulations, ensuite (si tout le reste a échoué) comme une seule +formule pour la cellule courante. +@end table + +@c =================================================================== +@node Index +@unnumbered Index + +@printindex cp + +@c =================================================================== + +@node Acknowledgments +@unnumbered Remerciements + +Codé par : +@quotation +@c jyavner@@member.fsf.org +Jonathan Yavner, +@c monnier@@gnu.org +Stefan Monnier, +@c shigeru.fukaya@@gmail.com +Shigeru Fukaya, +@c vincent.belaiche@@sourceforge.net +Vincent Belaïche +@end quotation + +@noindent +Manuel Texinfo de : +@quotation +@c jyavner@@member.fsf.org +Jonathan Yavner, +@c brad@@chenla.org +Brad Collins, +@c vincent.belaiche@@sourceforge.net +Vincent Belaïche +@end quotation + +@noindent +Idées de : +@quotation +@c christoph.conrad@@gmx.de +Christoph Conrad, +@c cyberbob@@redneck.gacracker.org +CyberBob, +@c syver-en@@online.no +Syver Enstad, +@c fischman@@zion.bpnetworks.com +Ami Fischman, +@c Thomas.Gehrlein@@t-online.de +Thomas Gehrlein, +@c c.f.a.johnson@@rogers.com +Chris F.A. Johnson, +@c lyusong@@hotmail.com +Yusong Li, +@c juri@@jurta.org +Juri Linkov, +@c maierh@@myself.com +Harald Maier, +@c anash@@san.rr.com +Alan Nash, +@c pinard@@iro.umontreal.ca +François Pinard, +@c ppinto@@cs.cmu.edu +Pedro Pinto, +@c xsteve@@riic.at +Stefan Reichör, +@c epameinondas@@gmx.de +Oliver Scholz, +@c rms@@gnu.org +Richard M. Stallman, +@c teirllm@@dms.auburn.edu +Luc Teirlinck, +@c jotto@@pobox.com +J. Otto Tennant, +@c jphil@@acs.pagesjaunes.fr +Jean-Philippe Theberge, +@c rrandresf@@hotmail.com +Andrés Ramírez +@end quotation + +@c =================================================================== + +@node GNU Free Documentation License +@appendix GNU Free Documentation License +@include doclicense.texi + +@bye +@c Local Variables: +@c ispell-dictionary: "fr" +@c End: -- cgit v1.2.3 From d80f1352d80938bb4ef61c5d74aa056902abd9b4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 18 Feb 2024 09:56:14 +0200 Subject: ; Fix punctuation and encoding of doc/translations/README * doc/translations/README: Fix non-ASCII characters and punctuation. Add local variables section. --- doc/translations/README | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/doc/translations/README b/doc/translations/README index 81b54c91a76..c689f0b14b3 100644 --- a/doc/translations/README +++ b/doc/translations/README @@ -3,14 +3,14 @@ ** Copyright assignment People who contribute translated documents should provide a copyright -assignment to the Free Software Foundation. See the 'Copyright -Assignment' section in the Emacs manual. +assignment to the Free Software Foundation. See the "Copyright +Assignment" section in the Emacs manual. ** Translated documents license The translated documents are distributed under the same license as the -original documents: the GNU Free Documentation License, Version 1.3 or +original documents: the GNU Free Documentation License, Version 1.3 or any later version published by the Free Software Foundation. See https://www.gnu.org/licenses/fdl-1.3.html for more information. @@ -27,7 +27,7 @@ The source files of the translated manuals are located in the doc/ directory, under the directory whose name corresponds to the translated language. - E.g. French manuals sources are found under doc/fr. + E.g., French manuals sources are found under doc/fr. The structure of the language folders should match the structure of the English manuals (i.e. include misc, man, lispref, lispintro, emacs). @@ -73,14 +73,14 @@ docstyle.Texi. - Add a @documentlanguage directive that includes your language. - E.g. @documentlanguage zh + E.g., @documentlanguage zh This directive has currently little effect but will be useful in the future. - The @author directive can be used for the translator's name. - E.g. @author traduit en français par Achile Talon + E.g., @author traduit en français par Achile Talon ** Fixing the original document @@ -99,7 +99,7 @@ emacs-devel@gnu.org for review. Always send contributions in the format of the original document. Most of the contents in the Emacs manuals are in Texinfo format, so do not -send contributions that are in derivative formats (e.g. info, html, +send contributions that are in derivative formats (e.g., info, html, docbook, plain text, etc.) Before sending files for review, ensure that they have been properly @@ -202,3 +202,10 @@ Copying and distribution of this file, with or without modification, are permitted in any medium without royalty provided the copyright notice and this notice are preserved. This file is offered as-is, without any warranty. + + +Local Variables: +mode: outline +paragraph-separate: "[ ]*$" +coding: utf-8 +End: -- cgit v1.2.3 From f8d27a8a1fd5bdc8e25569cc05a9298e186a8c63 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 17 Feb 2024 23:12:18 -0800 Subject: Ignore fewer GCC -fanalyzer diagnostics in ccl.c * src/ccl.c: Do not ignore -Wanalyzer-use-of-uninitialized-value, as that bug has been fixed in GCC. Ignore -Wanalyzer-out-of-bounds only if GCC 13, as the bug will reportedly be fixed when GCC 14 comes out. --- src/ccl.c | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/src/ccl.c b/src/ccl.c index a3a03a5b7b1..8bb8a78fe3d 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -35,11 +35,6 @@ along with GNU Emacs. If not, see . */ #include "coding.h" #include "keyboard.h" -/* Avoid GCC 12 bug . */ -#if GNUC_PREREQ (12, 0, 0) -# pragma GCC diagnostic ignored "-Wanalyzer-use-of-uninitialized-value" -#endif - /* Table of registered CCL programs. Each element is a vector of NAME, CCL_PROG, RESOLVEDP, and UPDATEDP, where NAME (symbol) is the name of the program, CCL_PROG (vector) is the compiled code of the @@ -609,7 +604,7 @@ while (0) https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109579 which causes GCC to mistakenly complain about popping the mapping stack. */ -#if GNUC_PREREQ (13, 0, 0) +#if __GNUC__ == 13 # pragma GCC diagnostic ignored "-Wanalyzer-out-of-bounds" #endif -- cgit v1.2.3 From 42c6cf4e5804312defa9d9caac8882500bd38179 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 17 Feb 2024 23:38:30 -0800 Subject: Remove no-longer-needed pdumper_load workaround * src/pdumper.c (pdumper_load): Revert my commit "Pacify GCC 12.1.1 in default developer build" dated 2022-06-13 13:21:18 -07, as GCC bug 105961 is fixed, and this workaround is not needed for unfixed GCC as these builds should not use --enable-gcc-warnings. --- src/pdumper.c | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/pdumper.c b/src/pdumper.c index 5c488d8e90f..509fb079db7 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5593,10 +5593,7 @@ pdumper_load (const char *dump_filename, char *argv0) struct dump_header header_buf = { 0 }; struct dump_header *header = &header_buf; - struct dump_memory_map sections[NUMBER_DUMP_SECTIONS]; - - /* Use memset instead of "= { 0 }" to work around GCC bug 105961. */ - memset (sections, 0, sizeof sections); + struct dump_memory_map sections[NUMBER_DUMP_SECTIONS] = { 0 }; const struct timespec start_time = current_timespec (); char *dump_filename_copy; -- cgit v1.2.3 From 659770fdf535ca683a97d965d2e4ed0f9f321145 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 17 Feb 2024 23:48:20 -0800 Subject: Do not ignore -Wanalyzer-allocation-size in GCC 14 * src/lisp.h (SAFE_ALLOCA_LISP_EXTRA): Use pragma to ignore the warning only in GCC 13, as the GCC developers say GCC bug 109577 is fixed in GCC 14. --- src/lisp.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lisp.h b/src/lisp.h index bf96bfd39f7..79a6a054b81 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -5525,7 +5525,7 @@ safe_free_unbind_to (specpdl_ref count, specpdl_ref sa_count, Lisp_Object val) https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109577 which causes GCC to mistakenly complain about the memory allocation in SAFE_ALLOCA_LISP_EXTRA. */ -#if GNUC_PREREQ (13, 0, 0) +#if GNUC_PREREQ (13, 0, 0) && !GNUC_PREREQ (14, 0, 0) # pragma GCC diagnostic ignored "-Wanalyzer-allocation-size" #endif -- cgit v1.2.3 From 4a8d3c5b75b28167300d2df061d053935809d43e Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 18 Feb 2024 00:12:28 -0800 Subject: Use -Wanalyzer-deref-before-check in GCC 14 * src/marker.c: Work around GCC bug 113253 only if GCC 13. The GCC bug reportedly will be fixed in GCC 14. --- src/marker.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/marker.c b/src/marker.c index 0101e144b4d..1559dd52719 100644 --- a/src/marker.c +++ b/src/marker.c @@ -21,7 +21,7 @@ along with GNU Emacs. If not, see . */ #include /* Work around GCC bug 113253. */ -#if 13 <= __GNUC__ +#if __GNUC__ == 13 # pragma GCC diagnostic ignored "-Wanalyzer-deref-before-check" #endif -- cgit v1.2.3 From 24e8fceb960e0b3b7e270211bd7f460c4c871008 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 18 Feb 2024 20:03:53 +0100 Subject: Fix typo in 'cl--type-hierarchy' * lisp/emacs-lisp/cl-preloaded.el (cl--type-hierarchy): Fix typo. * doc/lispref/type_hierarchy.txt: Regenerate. * doc/lispref/type_hierarchy.jpg: Likewise. --- doc/lispref/type_hierarchy.jpg | Bin 217746 -> 217931 bytes doc/lispref/type_hierarchy.txt | 2 +- lisp/emacs-lisp/cl-preloaded.el | 2 +- 3 files changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/lispref/type_hierarchy.jpg b/doc/lispref/type_hierarchy.jpg index 0b551b5f01e..72996897165 100644 Binary files a/doc/lispref/type_hierarchy.jpg and b/doc/lispref/type_hierarchy.jpg differ diff --git a/doc/lispref/type_hierarchy.txt b/doc/lispref/type_hierarchy.txt index c6e762b04a8..2ffee0b6a85 100644 --- a/doc/lispref/type_hierarchy.txt +++ b/doc/lispref/type_hierarchy.txt @@ -5,7 +5,7 @@ | v +-------------+ +--------------------+ +----------------------+ +--------+ - | fixum | --> | integer | --> | integer-or-marker | <-- | marker | + | fixnum | --> | integer | --> | integer-or-marker | <-- | marker | +-------------+ +--------------------+ +----------------------+ +--------+ | | | | | | diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 323d826f323..0b30e10b344 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -65,7 +65,7 @@ number-or-marker symbol array) (number float integer) (number-or-marker marker number) - (integer bignum fixum) + (integer bignum fixnum) (symbol keyword boolean symbol-with-pos) (array vector bool-vector char-table string) (list null cons) -- cgit v1.2.3 From f6743099cc907f1f2847f028ff8f3712288c559f Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sun, 18 Feb 2024 18:08:51 -0800 Subject: Back out part of commit db5e84af202 * lisp/gnus/gnus-agent.el (gnus-category-make-function-1): This code is untested and was not meant to be part of the earlier commit. --- lisp/gnus/gnus-agent.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 0928b179787..1726b806913 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -2920,9 +2920,8 @@ The following commands are available: ;; Functions are just returned as is. ((or (symbolp predicate) (functionp predicate)) - (let ((fun (or (cdr (assq predicate gnus-category-predicate-alist)) - predicate))) - (if (symbolp fun) `(,fun) `(funcall ',fun)))) + `(,(or (cdr (assq predicate gnus-category-predicate-alist)) + predicate))) ;; More complex predicate. ((consp predicate) `(,(cond -- cgit v1.2.3 From 8f260bb93f534b24d9a93d3315804ffe0c1fec4f Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sun, 18 Feb 2024 21:39:31 -0800 Subject: Don't update ranges for the whole buffer in treesit--pre-redisplay * lisp/treesit.el (treesit--pre-redisplay): Only update two screen-full of text around point. --- lisp/treesit.el | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/lisp/treesit.el b/lisp/treesit.el index f811b8090bc..fa82ad898a9 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1382,7 +1382,15 @@ as comment due to incomplete parse tree." ;; `treesit-update-ranges' will force the host language's parser to ;; reparse and set correct ranges for embedded parsers. Then ;; `treesit-parser-root-node' will force those parsers to reparse. - (treesit-update-ranges) + (let ((len (+ (* (window-body-height) (window-body-width)) 800))) + ;; FIXME: As a temporary fix, this prevents Emacs from updating + ;; every single local parsers in the buffer every time there's an + ;; edit. Moving forward, we need some way to properly track the + ;; regions which need update on parser ranges, like what jit-lock + ;; and syntax-ppss does. + (treesit-update-ranges + (max (point-min) (- (point) len)) + (min (point-max) (+ (point) len)))) ;; Force repase on _all_ the parsers might not be necessary, but ;; this is probably the most robust way. (dolist (parser (treesit-parser-list)) -- cgit v1.2.3 From be8f3e68a88a00bc12f1cc405a8a341666c41858 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 2 Jan 2024 12:06:16 +0100 Subject: * test/src/eval-tests.el (eval-tests/default-value): Add new test case. Bug#66117 --- test/src/eval-tests.el | 37 +++++++++++++++++++++++++------------ 1 file changed, 25 insertions(+), 12 deletions(-) diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index e1c90feb09a..187dc2f34d5 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -282,26 +282,39 @@ expressions works for identifiers starting with period." (should-error (defvaralias 'eval-tests--my-c 'eval-tests--my-d) :type 'cyclic-variable-indirection)) -(defvar eval-tests/global-var 'value) -(defvar-local eval-tests/buffer-local-var 'value) +(defvar eval-tests/global-var 'global-value) +(defvar-local eval-tests/buffer-local-var 'default-value) (ert-deftest eval-tests/default-value () ;; `let' overrides the default value for global variables. (should (default-boundp 'eval-tests/global-var)) - (should (eq 'value (default-value 'eval-tests/global-var))) - (should (eq 'value eval-tests/global-var)) - (let ((eval-tests/global-var 'bar)) - (should (eq 'bar (default-value 'eval-tests/global-var))) - (should (eq 'bar eval-tests/global-var))) + (should (eq 'global-value (default-value 'eval-tests/global-var))) + (should (eq 'global-value eval-tests/global-var)) + (let ((eval-tests/global-var 'let-value)) + (should (eq 'let-value (default-value 'eval-tests/global-var))) + (should (eq 'let-value eval-tests/global-var))) ;; `let' overrides the default value everywhere, but leaves ;; buffer-local values unchanged in current buffer and in the ;; buffers where there is no explicitly set buffer-local value. (should (default-boundp 'eval-tests/buffer-local-var)) - (should (eq 'value (default-value 'eval-tests/buffer-local-var))) - (should (eq 'value eval-tests/buffer-local-var)) + (should (eq 'default-value (default-value 'eval-tests/buffer-local-var))) + (should (eq 'default-value eval-tests/buffer-local-var)) (with-temp-buffer - (let ((eval-tests/buffer-local-var 'bar)) - (should (eq 'bar (default-value 'eval-tests/buffer-local-var))) - (should (eq 'bar eval-tests/buffer-local-var))))) + (let ((eval-tests/buffer-local-var 'let-value)) + (should (eq 'let-value (default-value 'eval-tests/buffer-local-var))) + (should (eq 'let-value eval-tests/buffer-local-var)))) + ;; When current buffer has explicit buffer-local binding, `let' does + ;; not alter the default binding. + (with-temp-buffer + (setq-local eval-tests/buffer-local-var 'local-value) + (let ((eval-tests/buffer-local-var 'let-value)) + ;; Let in a buffer with local binding does not change the + ;; default value for variable. + (should (eq 'default-value (default-value 'eval-tests/buffer-local-var))) + (should (eq 'let-value eval-tests/buffer-local-var)) + (with-temp-buffer + ;; We are in a new buffer - `eval-tests/buffer-local-var' has its global default value. + (should (eq 'default-value (default-value 'eval-tests/buffer-local-var))) + (should (eq 'default-value eval-tests/buffer-local-var)))))) (ert-deftest eval-tests--handler-bind () ;; A `handler-bind' has no effect if no error is signaled. -- cgit v1.2.3 From 5d3ecd7358252349dd26e6015a83054893af4474 Mon Sep 17 00:00:00 2001 From: Jean-Christophe Helary Date: Mon, 19 Feb 2024 20:05:14 +0900 Subject: ; Proofreading changes in doc/translations/README. --- doc/translations/README | 135 ++++++++++++++++++++++++------------------------ 1 file changed, 67 insertions(+), 68 deletions(-) diff --git a/doc/translations/README b/doc/translations/README index c689f0b14b3..35b9b9e9cf9 100644 --- a/doc/translations/README +++ b/doc/translations/README @@ -15,22 +15,23 @@ any later version published by the Free Software Foundation. See https://www.gnu.org/licenses/fdl-1.3.html for more information. -If you have questions regarding the use of the FDL license in your -translation work that are not answered in the FAQ, do not hesitate to -contact the GNU project: https://www.gnu.org/contact/ +If you have any questions regarding the use of the FDL license in your +translation work that do not appear in the FAQ, feel free to contact the +GNU project. -** Location +See https://www.gnu.org/contact/ for more information. + +** Location of the translated files *** Texinfo source files -The source files of the translated manuals are located in the doc/ -directory, under the directory whose name corresponds to the translated -language. +The source files of the translated manuals are located in the +doc/translations directory, under the translated language sub-directory. - E.g., French manuals sources are found under doc/fr. + E.g., French manual sources are found under doc/translations/fr. -The structure of the language folders should match the structure of the -English manuals (i.e. include misc, man, lispref, lispintro, emacs). +The structure of each language folder should match that of the English +manuals (i.e. include misc, man, lispref, lispintro, emacs). *** built files @@ -38,22 +39,21 @@ Translated deliverables in info format are built at release time and are made available for local installation. -** Format +** Source files format The manuals and their translations are written in the Texinfo format -(with the exception of the org-mode manual that is written in org-mode -and of illustrations for the Introduction to Emacs Lisp Programming that -are written in eps). +(with the exception of the org-mode manual, which is written in +org-mode, and illustrations for the Introduction to Emacs Lisp +Programming, which are written in eps). See https://www.gnu.org/software/Texinfo/ for more information. -You should install the Texinfo utilities to be able to verify the -translated files, and refer to the Texinfo manual if you do not -understand the meaning of the various Texinfo declarations. +You must install the Texinfo utilities in order to verify the translated +files, and refer to the Texinfo manual for information on the various +Texinfo declarations. -Emacs has a Texinfo mode that properly highlights the Texinfo code to -make it easier to see which parts are text to be translated and which -parts are not. +Emacs has a Texinfo mode that highlights the parts of the Texinfo code +to be translated for easy reference. *** Texinfo specific issues @@ -61,21 +61,21 @@ parts are not. Until the Emacs/Texinfo projects provide better solutions, here are a few rules to follow: -- Under each @node, add an @anchor that has the same content at the -original English @node. +- Under each @node, add an @anchor that has the same content as the + original English @node. - Translate the @node content but leave the @anchor in English. - Most Emacs manuals are set to include the docstyle.Texi file. This -file adds the @documentencoding UTF-8 directive to the targeted manual. -There is no need to add this directive in a manual that includes -docstyle.Texi. + file adds the @documentencoding UTF-8 directive to the targeted + manual. There is no need to add this directive in a manual that + includes docstyle.texi. - Add a @documentlanguage directive that includes your language. E.g., @documentlanguage zh -This directive has currently little effect but will be useful in the +This directive currently has little effect but will be useful in the future. - The @author directive can be used for the translator's name. @@ -85,34 +85,35 @@ future. ** Fixing the original document -During the course of the translation, you might find parts of the -original document that need to be updated or otherwise fixed, or even -bugs in Emacs. If you do not intend to provide fixes right away, please -file a bug report promptly so someone can fix it soon. +During the course of the translation, you might encounter passages in +the original document that need to be updated or otherwise corrected, or +even run into a bug in Emacs. If you cannot immediately correct the +problem, please file a bug report promptly. See the 'Bugs' section in the Emacs manual. -** Sending contributions +** Sending your contributions -Send your contributions (either files or revisions) to -emacs-devel@gnu.org for review. +Send your contributions (files or revisions) for review to the Emacs +development list at emacs-devel@gnu.org. Subscribing to the list is not +obligatory. Always send contributions in the format of the original document. Most -of the contents in the Emacs manuals are in Texinfo format, so do not -send contributions that are in derivative formats (e.g., info, html, -docbook, plain text, etc.) +of the content in the Emacs manuals is in Texinfo format, so please do +not send contributions in derivative formats (e.g. info, html, docbook, +plain text, etc.) -Before sending files for review, ensure that they have been properly -checked for spelling/grammar/typography by at least using the tools that -Emacs provides. +Before sending files for review, please ensure that they have been +thoroughly checked for spelling/grammar/typography by at least using the +tools provided by Emacs. -You should also make sure that the Texinfo files build properly on your +Please also make sure that the Texinfo files build properly on your system. Send your contributions as patches (git diff -p --stat), and prefer the -git format-patch form because the format allows easier review and easier -installation of the changes by someone with write access to the -repository. +git format-patch form, since the format allows for easier review and +easier installation of the changes by the persons with write access to +the repository. The Emacs project has a lot of coding, documentation and commenting conventions. Sending such patches allows the project managers to make @@ -121,25 +122,24 @@ sure that the contributions comply with the various conventions. ** Discussing translation issues -Translation-related discussions are welcome on the emacs-devel list. -Discussions specific to your language do not have to take place in +Translation-related discussions are welcome on the emacs development +list. Discussions specific to your language do not have to be in English. ** Translation teams -The number of words in the Emacs manuals is above 2,000,000 words and +The number of words in the Emacs manuals is over 2,000,000 words and growing. While one individual could theoretically translate all the files, it is more practical to work in language teams. -If you have a small group of translators willing to help, make sure that -the files are properly reviewed before sending them to emacs-devel (see -above). +If you have a small group of translators willing to help, please make +sure that the files are properly reviewed before sending them to the +Emacs development list (see above). -You are invited to refer to the translation-related documents that the -GNU Project maintains and to get in touch with your language's -translation team to learn from the practices they have developed over -the years. +Please refer to the translation-related documents maintained by the GNU +Project, and contact your language translation team to learn the +practices they have developed over the years. See https://www.gnu.org/server/standards/README.translations.html for more information. @@ -148,46 +148,45 @@ more information. ** Translation processes Emacs does not yet provide tools that significantly help the translation -process. A few useful functions would be +process. A few useful functions would be: - automatic lookup of a list of glossary items when starting to work on -a translation "unit" (paragraph or otherwise), such glossary terms -should be easily insertable at point, + a translation "unit" (paragraph or otherwise); such glossary terms + should be easily insertable at point, - automatic lookup of past translations to check for similarity and -improve homogeneity over the whole document set, such past translation -matches should be easily insertable at point, - -etc. + improve homogeneity over the whole document set; such past translation + matches should be easily insertable at point, etc. *** Using the PO format as an intermediate translation format Although the PO format has not been developed with documentation in -mind, it is well known among free software translation teams and you can -easily use the po4a utility to convert Texinfo to PO for work in +mind, it is well-known among free software translation teams, and you +can easily use the po4a utility to convert Texinfo to PO for work in translation tools that support the PO format. See https://po4a.org for more information. However, regardless of the intermediate file format that you might use, -you should only send Texinfo files for review to emacs-devel. +you should only send files in the original format (Texinfo, org-mode, +eps) for review and installation. *** Free tools that you can use in your processes -A number of free software tools exist, outside the Emacs ecosystem, to -help translators (amateurs and professionals alike) with the translation -process. +A number of free software tools are available outside the Emacs +ecosystem, to help translators (both amateur and professional) in the +translation process. -If you find that Emacs should implement some of their features, you are +If they have any features that you think Emacs should implement, you are welcome to provide patches to the Emacs project. Such tools include: - the GNOME Translation Editor, https://wiki.gnome.org/Apps/Gtranslator/ - KDE's Lokalize, https://apps.kde.org/lokalize/ -- OmegaT, http://omegat.org +- OmegaT, https://omegat.org - the Okapi Framework, https://www.okapiframework.org - pootle, https://pootle.translatehouse.org -- cgit v1.2.3 From 70dc1700562309c2612a71be35f9c71e9e1641b8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 19 Feb 2024 15:19:54 +0200 Subject: ; Further copyedits of doc/translations/README. --- doc/translations/README | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/doc/translations/README b/doc/translations/README index 35b9b9e9cf9..02edb829dcf 100644 --- a/doc/translations/README +++ b/doc/translations/README @@ -26,31 +26,32 @@ See https://www.gnu.org/contact/ for more information. *** Texinfo source files The source files of the translated manuals are located in the -doc/translations directory, under the translated language sub-directory. +doc/translations directory, under the sub-directory corresponding to the +translated language. E.g., French manual sources are found under doc/translations/fr. -The structure of each language folder should match that of the English +The structure of each language's folder should match that of the English manuals (i.e. include misc, man, lispref, lispintro, emacs). -*** built files +*** Built files -Translated deliverables in info format are built at release time and are +Translated deliverables in Info format are built at release time and are made available for local installation. ** Source files format The manuals and their translations are written in the Texinfo format -(with the exception of the org-mode manual, which is written in -org-mode, and illustrations for the Introduction to Emacs Lisp -Programming, which are written in eps). +(with the exception of the org-mode manual, which is written in Org, and +illustrations for the Introduction to Emacs Lisp Programming, which are +EPS files). See https://www.gnu.org/software/Texinfo/ for more information. -You must install the Texinfo utilities in order to verify the translated +You must install the Texinfo package in order to verify the translated files, and refer to the Texinfo manual for information on the various -Texinfo declarations. +Texinfo features. Emacs has a Texinfo mode that highlights the parts of the Texinfo code to be translated for easy reference. @@ -67,7 +68,7 @@ few rules to follow: - Translate the @node content but leave the @anchor in English. - Most Emacs manuals are set to include the docstyle.Texi file. This - file adds the @documentencoding UTF-8 directive to the targeted + file adds the "@documentencoding UTF-8" directive to the targeted manual. There is no need to add this directive in a manual that includes docstyle.texi. @@ -111,7 +112,7 @@ Please also make sure that the Texinfo files build properly on your system. Send your contributions as patches (git diff -p --stat), and prefer the -git format-patch form, since the format allows for easier review and +git format-patch form, since that format allows for easier review and easier installation of the changes by the persons with write access to the repository. @@ -123,7 +124,7 @@ sure that the contributions comply with the various conventions. ** Discussing translation issues Translation-related discussions are welcome on the emacs development -list. Discussions specific to your language do not have to be in +list. Discussions specific to your language do not have to be in English. @@ -175,9 +176,9 @@ eps) for review and installation. *** Free tools that you can use in your processes -A number of free software tools are available outside the Emacs -ecosystem, to help translators (both amateur and professional) in the -translation process. +A number of free software tools are available outside the Emacs project, +to help translators (both amateur and professional) in the translation +process. If they have any features that you think Emacs should implement, you are welcome to provide patches to the Emacs project. -- cgit v1.2.3 From ddfba511c190e5bb44e44a50aef5ab8c08e3d798 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 19 Feb 2024 10:27:02 +0100 Subject: Check shortdoc keywords and fix one mistake * lisp/emacs-lisp/shortdoc.el (shortdoc--check) (define-short-documentation-group): Check that used keywords exist. * lisp/emacs-lisp/shortdoc.el (list): Fix a typo. --- lisp/emacs-lisp/shortdoc.el | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index a6a49c72f74..cde28985cd0 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -50,6 +50,17 @@ '((t :inherit variable-pitch)) "Face used for a section.") +;;;###autoload +(defun shortdoc--check (group functions) + (let ((keywords '( :no-manual :args :eval :no-eval :no-value :no-eval* + :result :result-string :eg-result :eg-result-string :doc))) + (dolist (f functions) + (when (consp f) + (dolist (x f) + (when (and (keywordp x) (not (memq x keywords))) + (error "Shortdoc %s function `%s': bad keyword `%s'" + group (car f) x))))))) + ;;;###autoload (progn (defvar shortdoc--groups nil) @@ -118,6 +129,7 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), `:no-eval*', `:result', `:result-string', `:eg-result' and `:eg-result-string' properties." (declare (indent defun)) + (shortdoc--check group functions) `(progn (setq shortdoc--groups (delq (assq ',group shortdoc--groups) shortdoc--groups)) @@ -715,7 +727,7 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (plist-get '(a 1 b 2 c 3) 'b)) (plist-put :no-eval (setq plist (plist-put plist 'd 4)) - :eq-result (a 1 b 2 c 3 d 4)) + :eg-result (a 1 b 2 c 3 d 4)) (plist-member :eval (plist-member '(a 1 b 2 c 3) 'b)) "Data About Lists" -- cgit v1.2.3 From 188fe6bffa69e08b60a7d65709998bd803b7ada5 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 19 Feb 2024 11:44:53 +0100 Subject: Replace XSET_HASH_TABLE with make_lisp_hash_table * src/lisp.h (XSET_HASH_TABLE): Remove, replace with... (make_lisp_hash_table): ...this. All callers adapted. --- src/alloc.c | 3 +-- src/fns.c | 13 ++----------- src/lisp.h | 8 ++++++-- 3 files changed, 9 insertions(+), 15 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 6abe9e28650..8c94c7eb33c 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6034,8 +6034,7 @@ purecopy (Lisp_Object obj) return obj; /* Don't hash cons it. */ } - struct Lisp_Hash_Table *h = purecopy_hash_table (table); - XSET_HASH_TABLE (obj, h); + obj = make_lisp_hash_table (purecopy_hash_table (table)); } else if (COMPILEDP (obj) || VECTORP (obj) || RECORDP (obj)) { diff --git a/src/fns.c b/src/fns.c index f94e8519957..0a9692f36e8 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4608,13 +4608,7 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size, h->next_weak = NULL; h->purecopy = purecopy; h->mutable = true; - - Lisp_Object table; - XSET_HASH_TABLE (table, h); - eassert (HASH_TABLE_P (table)); - eassert (XHASH_TABLE (table) == h); - - return table; + return make_lisp_hash_table (h); } @@ -4624,7 +4618,6 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size, static Lisp_Object copy_hash_table (struct Lisp_Hash_Table *h1) { - Lisp_Object table; struct Lisp_Hash_Table *h2; h2 = allocate_hash_table (); @@ -4649,9 +4642,7 @@ copy_hash_table (struct Lisp_Hash_Table *h1) h2->index = hash_table_alloc_bytes (index_bytes); memcpy (h2->index, h1->index, index_bytes); } - XSET_HASH_TABLE (table, h2); - - return table; + return make_lisp_hash_table (h2); } diff --git a/src/lisp.h b/src/lisp.h index 79a6a054b81..db053ba9f70 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2547,8 +2547,12 @@ XHASH_TABLE (Lisp_Object a) return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Hash_Table); } -#define XSET_HASH_TABLE(VAR, PTR) \ - XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE) +INLINE Lisp_Object +make_lisp_hash_table (struct Lisp_Hash_Table *h) +{ + eassert (PSEUDOVECTOR_TYPEP (&h->header, PVEC_HASH_TABLE)); + return make_lisp_ptr (h, Lisp_Vectorlike); +} /* Value is the key part of entry IDX in hash table H. */ INLINE Lisp_Object -- cgit v1.2.3 From 23793600778c4efe5615b646f2d3895624c23ef0 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 19 Feb 2024 14:42:55 +0100 Subject: Slight switch byte op speedup * src/bytecode.c (exec_byte_code): Hoist symbols_with_pos_enabled check from fast loop, and eliminate the initial index check. --- src/bytecode.c | 37 +++++++++++++++++++------------------ 1 file changed, 19 insertions(+), 18 deletions(-) diff --git a/src/bytecode.c b/src/bytecode.c index dd805cbd97a..8d7240b9966 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1737,28 +1737,29 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, if (BYTE_CODE_SAFE && !HASH_TABLE_P (jmp_table)) emacs_abort (); Lisp_Object v1 = POP; - ptrdiff_t i; struct Lisp_Hash_Table *h = XHASH_TABLE (jmp_table); - - /* h->count is a faster approximation for HASH_TABLE_SIZE (h) - here. */ - if (h->count <= 5 && !h->test->cmpfn) - { /* Do a linear search if there are not many cases - FIXME: 5 is arbitrarily chosen. */ - for (i = h->count; 0 <= --i; ) - if (EQ (v1, HASH_KEY (h, i))) - break; + /* Do a linear search if there are few cases and the test is `eq'. + (The table is assumed to be sized exactly; all entries are + consecutive at the beginning.) + FIXME: 5 is arbitrarily chosen. */ + if (h->count <= 5 && !h->test->cmpfn && !symbols_with_pos_enabled) + { + eassume (h->count >= 2); + for (ptrdiff_t i = h->count - 1; i >= 0; i--) + if (BASE_EQ (v1, HASH_KEY (h, i))) + { + op = XFIXNUM (HASH_VALUE (h, i)); + goto op_branch; + } } else - i = hash_lookup (h, v1); - - if (i >= 0) { - Lisp_Object val = HASH_VALUE (h, i); - if (BYTE_CODE_SAFE && !FIXNUMP (val)) - emacs_abort (); - op = XFIXNUM (val); - goto op_branch; + ptrdiff_t i = hash_lookup (h, v1); + if (i >= 0) + { + op = XFIXNUM (HASH_VALUE (h, i)); + goto op_branch; + } } } NEXT; -- cgit v1.2.3 From 0393bfdc912912e3368b786d062894f3069d210b Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 19 Feb 2024 17:40:04 +0100 Subject: Make type hierarchy textual representation a table * etc/syncdoc-type-hierarchy.el (syncdoc-make-type-table): New function. (syncdoc-update-type-hierarchy): Make use of. * doc/lispref/type_hierarchy.txt: Regenerate. --- doc/lispref/type_hierarchy.txt | 169 ++++++----------------------------------- etc/syncdoc-type-hierarchy.el | 25 ++++-- 2 files changed, 42 insertions(+), 152 deletions(-) diff --git a/doc/lispref/type_hierarchy.txt b/doc/lispref/type_hierarchy.txt index 2ffee0b6a85..f68218b507a 100644 --- a/doc/lispref/type_hierarchy.txt +++ b/doc/lispref/type_hierarchy.txt @@ -1,147 +1,22 @@ - +--------------------+ - | bignum | - +--------------------+ - | - | - v - +-------------+ +--------------------+ +----------------------+ +--------+ - | fixnum | --> | integer | --> | integer-or-marker | <-- | marker | - +-------------+ +--------------------+ +----------------------+ +--------+ - | | | - | | | - v | | - +-------------+ +--------------------+ | | - | float | --> | number | | | - +-------------+ +--------------------+ | | - | | | - | | | - v | | - +--------------------+ | | +------------------+ +--------------------+ +----------+ +--------+ - | number-or-marker | <-----+----------------------------+ | tree-sitter-node | | tree-sitter-parser | | user-ptr | | window | - +--------------------+ | +------------------+ +--------------------+ +----------+ +--------+ - | | | | | | - | | | | | | - v v v v v v - +-------------+ +-------------------------------------------------------------------------------------------------------------------------------------------------------------------+ +----------------------------+ - | font-entity | --> | | <-- | overlay | - +-------------+ | | +----------------------------+ - +-------------+ | | +----------------------------+ - | font-object | --> | | <-- | process | - +-------------+ | | +----------------------------+ - +-------------+ | | +----------------------------+ - | font-spec | --> | | <-- | structure | - +-------------+ | atom | +----------------------------+ - +-------------+ | | +----------------------------+ - | frame | --> | | <-- | terminal | - +-------------+ | | +----------------------------+ - +-------------+ | | +----------------------------+ - | hash-table | --> | | <-- | thread | - +-------------+ | | +----------------------------+ - +-------------+ | | +----------------------------+ - | mutex | --> | | <-- | tree-sitter-compiled-query | - +-------------+ +-------------------------------------------------------------------------------------------------------------------------------------------------------------------+ +----------------------------+ - | ^ ^ ^ ^ ^ ^ ^ - | | | | | | | | - v | | | | | | | - +--------------------+ | +----------------------+ | | +--------+ +-------+ +---------+ - +--------------------> | t | | | window-configuration | | | | buffer | | class | | condvar | - | +--------------------+ | +----------------------+ | | +--------+ +-------+ +---------+ - | +--------------------+ | | | - | | byte-code-function | | | | - | +--------------------+ | | | - | | | | | - | | | | | - | v | | | - | +--------------------+ | | | - | | compiled-function | | | | - | +--------------------+ | | | - | | | | | - | | | | | - | v | | | - | +--------------------+ | | | - | +> | function | -+ | | - | | +--------------------+ | | - | | ^ | | - | | +--------------------------------------------------+--------------+------------------------+ - | | | | | - | | +--------------------+ | | | - | | | subr-primitive | | | | - | | +--------------------+ | | | - | | | | | | - | | | | | | - | | v | | | - | | +--------------------+ | | | - | +- | subr | <-----------------------------+----+ | | - | +--------------------+ | | | | - | +--------------------+ | | | | - | | keyword | -+ | | | | - | +--------------------+ | | | | | - | | | | | | | - | | | | | | | - | v | | | | | - | +--------------------+ | | | | | - | | symbol-with-pos | | | | | | - | +--------------------+ | | | | | - | | | | | | | - | | +----+ | | | | - | v | | | | | - | +--------------------+ | | | | | - | +> | symbol | ------+-----------------------+ | | | - | | +--------------------+ | | | | - | | ^ | | | | - | | +--------------------------+ | | | - | | | | | - | | +--------------------+ | | | - | | | null | -+ | | | - | | +--------------------+ | | | | - | | | | | | | - | | | | | | | - | | v | | | | - | | +--------------------+ | | | | - | +- | boolean | | | | | - | +--------------------+ | | | | - | +--------------------+ | | | | - | | cons | | | | | - | +--------------------+ | | | | - | | | | | | - | | | | | | - | v | | | | - | +--------------------+ | | | | - | | list | <+ | | | - | +--------------------+ | | | - | | | | | - | | | | | - | v | | | - | +--------------------+ | | | - +--------------------- | sequence | | | | - +--------------------+ | | | - ^ | | | - +------------------------+ | | | - | | | | - | +--------------------+ | | | - | | subr-native-elisp | -----------------------------------+ | | - | +--------------------+ | | - | | | - | +-------------------------------------------+ | - | | | - | +--------------------+ | | - | | bool-vector | | | - | +--------------------+ | | - | | | | - | | | | - | v | | - | +-------------+ +-------------------------------------------------+ | - | | string | --> | array | | - | +-------------+ +-------------------------------------------------+ | - | ^ | ^ | - | | | | | - | | | | | - | +--------------------+ | +----------------------+ | - | | vector | | | char-table | | - | +--------------------+ | +----------------------+ | - | | | - +----------------------------------------------+ | - | - +--------------------+ | - | module-function | ----------------------------------------------------------------------+ - +--------------------+ +| Type | Derived Types | +|-------------------+----------------------------------------------------------| +| t | sequence atom | +| sequence | list array | +| atom | class structure tree-sitter-compiled-query | +| | tree-sitter-node tree-sitter-parser user-ptr font-object | +| | font-entity font-spec condvar mutex thread terminal | +| | hash-table frame buffer function window process | +| | window-configuration overlay integer-or-marker | +| | number-or-marker symbol array | +| number | float integer | +| number-or-marker | marker number | +| integer | bignum fixnum | +| symbol | keyword boolean symbol-with-pos | +| array | vector bool-vector char-table string | +| list | null cons | +| integer-or-marker | integer marker | +| compiled-function | byte-code-function | +| function | subr module-function compiled-function | +| boolean | null | +| subr | subr-native-elisp subr-primitive | +| symbol-with-pos | keyword | diff --git a/etc/syncdoc-type-hierarchy.el b/etc/syncdoc-type-hierarchy.el index eebb092abae..cd0cae2f954 100644 --- a/etc/syncdoc-type-hierarchy.el +++ b/etc/syncdoc-type-hierarchy.el @@ -35,6 +35,7 @@ ;;; Code: (require 'cl-lib) +(require 'org-table) (eval-and-compile (defconst syncdoc-lispref-dir (concat (file-name-directory @@ -55,6 +56,23 @@ (goto-char (point-max)) (insert "}\n")) +(defun syncdoc-make-type-table (file) + (with-temp-file file + (insert "|Type| Derived Types|\n|-\n") + (cl-loop for (type . children) in cl--type-hierarchy + do (insert "|" (symbol-name type) " |") + do (cl-loop with x = 0 + for child in children + for child-len = (length (symbol-name child)) + when (> (+ x child-len 2) 60) + do (progn + (insert "|\n||") + (setq x 0)) + do (insert (symbol-name child) " ") + do (cl-incf x (1+ child-len)) ) + do (insert "\n")) + (org-table-align))) + (defun syncdoc-update-type-hierarchy () "Update the type hierarchy representation used by the elisp manual." (interactive) @@ -63,10 +81,7 @@ (call-process-region nil nil "dot" t (current-buffer) nil "-Tjpg" "-o" (expand-file-name "type_hierarchy.jpg" syncdoc-lispref-dir))) - (with-temp-buffer - (syncdoc-insert-dot-content "TB") - (call-process-region nil nil "graph-easy" t (current-buffer) nil "--output" - (expand-file-name "type_hierarchy.txt" - syncdoc-lispref-dir)))) + (syncdoc-make-type-table (expand-file-name "type_hierarchy.txt" + syncdoc-lispref-dir))) ;;; syncdoc-type-hierarchy.el ends here -- cgit v1.2.3 From afed7f959a39c077aba6dc585cdfc0edcf05ddc8 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 19 Feb 2024 17:42:14 +0100 Subject: * etc/syncdoc-type-hierarchy.el: Update comment. --- etc/syncdoc-type-hierarchy.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etc/syncdoc-type-hierarchy.el b/etc/syncdoc-type-hierarchy.el index cd0cae2f954..10bcb059ac8 100644 --- a/etc/syncdoc-type-hierarchy.el +++ b/etc/syncdoc-type-hierarchy.el @@ -30,7 +30,7 @@ ;; documentation is regenerated. ;; We do not call this directly from make docs in order not to add a -;; dependency on the tools "dot" and "graph-easy". +;; dependency on the tool "dot". ;;; Code: -- cgit v1.2.3 From 6a2b43c5692e7427be0ddc6b084052f283b77d65 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 19 Feb 2024 17:47:45 +0100 Subject: * etc/syncdoc-type-hierarchy.el (syncdoc-lispref-dir): Clean-up. --- etc/syncdoc-type-hierarchy.el | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/etc/syncdoc-type-hierarchy.el b/etc/syncdoc-type-hierarchy.el index 10bcb059ac8..b3dfe63406a 100644 --- a/etc/syncdoc-type-hierarchy.el +++ b/etc/syncdoc-type-hierarchy.el @@ -37,11 +37,10 @@ (require 'cl-lib) (require 'org-table) -(eval-and-compile - (defconst syncdoc-lispref-dir (concat (file-name-directory - (or load-file-name - buffer-file-name)) - "../doc/lispref/"))) +(defconst syncdoc-lispref-dir (concat (file-name-directory + (or load-file-name + buffer-file-name)) + "../doc/lispref/")) (defun syncdoc-insert-dot-content (rankdir) (maphash (lambda (child parents) -- cgit v1.2.3 From 6893106fe9302b1be68dd04034441799e6d29b68 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Thu, 15 Feb 2024 12:10:12 +0100 Subject: Allow attaching files at point using 'gnus-dired-attach' * lisp/gnus/gnus-dired.el (gnus-dired-attach-at-end): Add option. (gnus-dired-attach): Respect it. * doc/misc/gnus.texi (Other modes): Document it. (Bug#69141) --- doc/misc/gnus.texi | 5 ++++- lisp/gnus/gnus-dired.el | 9 ++++++++- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 2f8f97e5845..98196310b5c 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -26695,9 +26695,12 @@ buffers. It is enabled with @table @kbd @item C-c C-m C-a @findex gnus-dired-attach +@vindex gnus-dired-attach-at-end @cindex attachments, selection via dired Send dired's marked files as an attachment (@code{gnus-dired-attach}). -You will be prompted for a message buffer. +You will be prompted for a message buffer. By default it will attach +files to the end of the message buffer, but you can modify that +behaviour by customising @code{gnus-dired-attach-at-end}. @item C-c C-m C-l @findex gnus-dired-find-file-mailcap diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index 48c1aef968b..f33c5f7f2e5 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -111,6 +111,12 @@ See `mail-user-agent' for more information." (autoload 'gnus-completing-read "gnus-util") +(defcustom gnus-dired-attach-at-end t + "Non-nil means that files should be attached at the end of a buffer." + :group 'mail ;; dired? + :version "30.1" + :type 'boolean) + ;; Method to attach files to a mail composition. (defun gnus-dired-attach (files-to-attach) "Attach dired's marked files to a gnus message composition. @@ -161,7 +167,8 @@ filenames." ;; set buffer to destination buffer, and attach files (set-buffer destination) - (goto-char (point-max)) ;attach at end of buffer + (when gnus-dired-attach-at-end + (goto-char (point-max))) ;attach at end of buffer (while files-to-attach (mml-attach-file (car files-to-attach) (or (mm-default-file-type (car files-to-attach)) -- cgit v1.2.3 From a1cbc4d810bc1b525fa46b23249b414c1ad6b031 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 19 Feb 2024 21:34:43 +0200 Subject: ; * doc/misc/gnus.texi (Other modes): Fix last change. --- doc/misc/gnus.texi | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 98196310b5c..419a5390374 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -26698,9 +26698,9 @@ buffers. It is enabled with @vindex gnus-dired-attach-at-end @cindex attachments, selection via dired Send dired's marked files as an attachment (@code{gnus-dired-attach}). -You will be prompted for a message buffer. By default it will attach -files to the end of the message buffer, but you can modify that -behaviour by customising @code{gnus-dired-attach-at-end}. +The function prompts for a message buffer, and by default attaches files +to the end of that buffer; customize @code{gnus-dired-attach-at-end} to +place the attachments at point instead. @item C-c C-m C-l @findex gnus-dired-find-file-mailcap -- cgit v1.2.3 From 4e9993cada32a866a75b458092de0028db2f5f41 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 20 Feb 2024 12:52:40 +0100 Subject: Add Tramp methods dockercp and podmancp * doc/misc/tramp.texi (External methods): Add dockercp and podmancp. * etc/NEWS: Add Tramp methods "dockercp" and "podmancp". * lisp/net/tramp.el (tramp-handle-make-process): * lisp/net/tramp-adb.el (tramp-adb-maybe-open-connection): * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band) (tramp-maybe-open-connection): * lisp/net/tramp-sshfs.el (tramp-sshfs-handle-process-file) (tramp-sshfs-maybe-open-connection): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-send-command): Adapt `tramp-expand-args' calls. * lisp/net/tramp-container.el (tramp-dockercp-method) (tramp-podmancp-method): New defconst. (tramp-methods) : Add new methods. (tramp-container--completion-function): Adapt docstring. Use it for "dockercp" and "podmancp" completion. * lisp/net/tramp.el (tramp-get-remote-tmpdir): * lisp/net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection): * lisp/net/tramp-sh.el (tramp-maybe-open-connection): Use a default value with `tramp-get-method-parameter'. * lisp/net/tramp-sh.el (tramp-methods) : Add `tramp-copy-file-name'. (tramp-default-copy-file-name): New defconst. (tramp-make-copy-file-name): Rename from `tramp-make-copy-program-file-name'. Use method parameter `tramp-copy-file-name'. (Bug#69085) (tramp-do-copy-or-rename-file-out-of-band): Adapt callees. * lisp/net/tramp.el (tramp-methods): Adapt docstring. (tramp-get-method-parameter, tramp-expand-args): New optional argument DEFAULT. * test/lisp/net/tramp-tests.el (tramp--test-container-p): Adapt. (tramp--test-container-oob-p): New defun. (tramp-test17-dired-with-wildcards, tramp-test35-remote-path) (tramp-test41-special-characters): Use it. (tramp--test-set-ert-test-documentation): Use `split-string'. --- doc/misc/tramp.texi | 14 ++++++++ etc/NEWS | 12 ++++--- lisp/net/tramp-adb.el | 2 +- lisp/net/tramp-container.el | 60 ++++++++++++++++++++++++++++++- lisp/net/tramp-gvfs.el | 4 +-- lisp/net/tramp-sh.el | 38 +++++++++++--------- lisp/net/tramp-sshfs.el | 4 +-- lisp/net/tramp-sudoedit.el | 2 +- lisp/net/tramp.el | 35 ++++++++++++------ test/lisp/net/tramp-tests.el | 85 ++++++++++++++++++++++++++------------------ 10 files changed, 182 insertions(+), 74 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index affd760730b..6d4654f1a8a 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1059,6 +1059,20 @@ session. These methods support the @samp{-P} argument. +@item @option{dockercp} +@item @option{podmancp} +@cindex method @option{dockercp} +@cindex @option{dockercp} method +@cindex method @option{podmancp} +@cindex @option{podmancp} method + +These methods are similar to @option{docker} or @option{podman}, but +they use the command @command{docker cp} or @command{podman cp} for +transferring large files. + +These copy commands do not support file globs, and they ignore a user +name. + @item @option{fcp} @cindex method @option{fcp} @cindex @option{fcp} method diff --git a/etc/NEWS b/etc/NEWS index 4477116248e..7b248c3fe78 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -884,6 +884,10 @@ mode line. 'header' will display in the header line; ** Tramp ++++ +*** New connection methods "dockercp" and "podmancp". +These are the external methods counterparts of "docker" and "podman". + +++ *** New connection methods "toolbox" and "flatpak". They allow accessing system containers provided by Toolbox or @@ -1121,7 +1125,7 @@ the user option 'nnweb-type' to 'gmane'. *** New user option 'gnus-mode-line-logo'. This allows the user to either disable the display of any logo or specify which logo will be displayed as part of the -buffer-identification in the mode-line of Gnus-buffers. +buffer-identification in the mode-line of Gnus buffers. ** Rmail @@ -1333,7 +1337,7 @@ chat buffers use by default. This command toggles the display of internal buffers in Buffer Menu mode; that is, buffers not visiting a file and whose names start with a space. Previously, such buffers were never shown. This command is bound to 'I' -in Buffer menu mode. +in Buffer Menu mode. ** Customize @@ -1429,7 +1433,7 @@ current project configuration, and later updates it as you edit the files and save the changes. +++ -** New package Compat +** New package Compat. Emacs now comes with a stub implementation of the forwards-compatibility Compat package from GNU ELPA. This allows built-in packages to use the library more effectively, and helps @@ -1560,7 +1564,7 @@ values. +++ ** Pcase's functions (in 'pred' and 'app') can specify the argument position. -For example, instead of (pred (< 5)) you can write (pred (> _ 5)). +For example, instead of '(pred (< 5))' you can write '(pred (> _ 5))'. +++ ** 'define-advice' now sets the new advice's 'name' property to NAME. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 2e4ad1cc412..96625fc5680 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -1230,7 +1230,7 @@ connection if a previous connection has died for some reason." (let* ((coding-system-for-read 'utf-8-dos) ; Is this correct? (process-connection-type tramp-process-connection-type) (args (tramp-expand-args - vec 'tramp-login-args ?d (or device ""))) + vec 'tramp-login-args nil ?d (or device ""))) (p (let ((default-directory tramp-compat-temporary-file-directory)) (apply diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index 1f578949e4d..30639cbeb85 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -31,15 +31,20 @@ ;; Open a file on a running Docker container: ;; ;; C-x C-f /docker:USER@CONTAINER:/path/to/file +;; C-x C-f /dockercp:USER@CONTAINER:/path/to/file ;; ;; or Podman: ;; ;; C-x C-f /podman:USER@CONTAINER:/path/to/file +;; C-x C-f /podmancp:USER@CONTAINER:/path/to/file ;; ;; Where: ;; USER is the user on the container to connect as (optional). ;; CONTAINER is the container to connect to. ;; +;; "docker" and "podman" are inline methods, "dockercp" and "podmancp" +;; are out-of-band methods. +;; ;; ;; ;; Open file in a Kubernetes container: @@ -141,10 +146,20 @@ If it is nil, the default context will be used." (defconst tramp-docker-method "docker" "Tramp method name to use to connect to Docker containers.") +;;;###tramp-autoload +(defconst tramp-dockercp-method "dockercp" + "Tramp method name to use to connect to Docker containers. +This is for out-of-band connections.") + ;;;###tramp-autoload (defconst tramp-podman-method "podman" "Tramp method name to use to connect to Podman containers.") +;;;###tramp-autoload +(defconst tramp-podmancp-method "podmancp" + "Tramp method name to use to connect to Podman containers. +This is for out-of-band connections.") + ;;;###tramp-autoload (defconst tramp-kubernetes-method "kubernetes" "Tramp method name to use to connect to Kubernetes containers.") @@ -183,7 +198,8 @@ BODY is the backend specific code." (defun tramp-container--completion-function (method) "List running containers available for connection. METHOD is the Tramp method to be used for \"ps\", either -`tramp-docker-method' or `tramp-podman-method'. +`tramp-docker-method', `tramp-dockercp-method', `tramp-podman-method', +or `tramp-podmancp-method'. This function is used by `tramp-set-completion-function', please see its function help for a description of the format." @@ -375,6 +391,23 @@ see its function help for a description of the format." (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-i" "-c")))) + (add-to-list 'tramp-methods + `(,tramp-dockercp-method + (tramp-login-program ,tramp-docker-program) + (tramp-login-args (("exec") + ("-it") + ("-u" "%u") + ("%h") + ("%l"))) + (tramp-direct-async (,tramp-default-remote-shell "-c")) + (tramp-remote-shell ,tramp-default-remote-shell) + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-i" "-c")) + (tramp-copy-program ,tramp-docker-program) + (tramp-copy-args (("cp"))) + (tramp-copy-file-name (("%h" ":") ("%f"))) + (tramp-copy-recursive t))) + (add-to-list 'tramp-methods `(,tramp-podman-method (tramp-login-program ,tramp-podman-program) @@ -388,6 +421,23 @@ see its function help for a description of the format." (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-i" "-c")))) + (add-to-list 'tramp-methods + `(,tramp-podmancp-method + (tramp-login-program ,tramp-podman-program) + (tramp-login-args (("exec") + ("-it") + ("-u" "%u") + ("%h") + ("%l"))) + (tramp-direct-async (,tramp-default-remote-shell "-c")) + (tramp-remote-shell ,tramp-default-remote-shell) + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-i" "-c")) + (tramp-copy-program ,tramp-podman-program) + (tramp-copy-args (("cp"))) + (tramp-copy-file-name (("%h" ":") ("%f"))) + (tramp-copy-recursive t))) + (add-to-list 'tramp-methods `(,tramp-kubernetes-method (tramp-login-program ,tramp-kubernetes-program) @@ -431,10 +481,18 @@ see its function help for a description of the format." tramp-docker-method `((tramp-container--completion-function ,tramp-docker-method))) + (tramp-set-completion-function + tramp-dockercp-method + `((tramp-container--completion-function ,tramp-dockercp-method))) + (tramp-set-completion-function tramp-podman-method `((tramp-container--completion-function ,tramp-podman-method))) + (tramp-set-completion-function + tramp-podmancp-method + `((tramp-container--completion-function ,tramp-podmancp-method))) + (tramp-set-completion-function tramp-kubernetes-method `((tramp-kubernetes--completion-function ,tramp-kubernetes-method))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 4e949e7e60b..93071ed7350 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -2294,8 +2294,8 @@ connection if a previous connection has died for some reason." ;; indicated by the "mounted" signal, i.e. the ;; "fuse-mountpoint" file property. (with-timeout - ((or (tramp-get-method-parameter vec 'tramp-connection-timeout) - tramp-connection-timeout) + ((tramp-get-method-parameter + vec 'tramp-connection-timeout tramp-connection-timeout) (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec)) (tramp-error vec 'file-error diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 3557b3a1b64..66e648624b2 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -282,6 +282,7 @@ The string is used in `tramp-methods'.") (tramp-copy-program "nc") ;; We use "-v" for better error tracking. (tramp-copy-args (("-w" "1") ("-v") ("%h") ("%r"))) + (tramp-copy-file-name (("%f"))) (tramp-remote-copy-program "nc") ;; We use "-p" as required for newer busyboxes. For older ;; busybox/nc versions, the value must be (("-l") ("%r")). This @@ -428,6 +429,9 @@ The string is used in `tramp-methods'.") eos) nil ,(user-login-name)))) +(defconst tramp-default-copy-file-name '(("%u" "@") ("%h" ":") ("%f")) + "Default `tramp-copy-file-name' entry for out-of-band methods.") + ;;;###tramp-autoload (defconst tramp-completion-function-alist-rsh '((tramp-parse-rhosts "/etc/hosts.equiv") @@ -2399,10 +2403,10 @@ The method used must be an out-of-band method." #'file-name-as-directory #'identity) (if v1 - (tramp-make-copy-program-file-name v1) + (tramp-make-copy-file-name v1) (file-name-unquote filename))) target (if v2 - (tramp-make-copy-program-file-name v2) + (tramp-make-copy-file-name v2) (file-name-unquote newname))) ;; Check for listener port. @@ -2441,7 +2445,7 @@ The method used must be an out-of-band method." ;; " " has either been a replacement of "%k" (when ;; KEEP-DATE argument is non-nil), or a replacement for ;; the whole keep-date sublist. - (delete " " (apply #'tramp-expand-args v 'tramp-copy-args spec)) + (delete " " (apply #'tramp-expand-args v 'tramp-copy-args nil spec)) ;; `tramp-ssh-controlmaster-options' is a string instead ;; of a list. Unflatten it. copy-args @@ -2450,11 +2454,11 @@ The method used must be an out-of-band method." (lambda (x) (if (tramp-compat-string-search " " x) (split-string x) x)) copy-args)) - copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec) + copy-env (apply #'tramp-expand-args v 'tramp-copy-env nil spec) remote-copy-program (tramp-get-method-parameter v 'tramp-remote-copy-program) remote-copy-args - (apply #'tramp-expand-args v 'tramp-remote-copy-args spec)) + (apply #'tramp-expand-args v 'tramp-remote-copy-args nil spec)) ;; Check for local copy program. (unless (executable-find copy-program) @@ -5290,7 +5294,8 @@ connection if a previous connection has died for some reason." (tramp-get-method-parameter hop 'tramp-async-args))) (connection-timeout (tramp-get-method-parameter - hop 'tramp-connection-timeout)) + hop 'tramp-connection-timeout + tramp-connection-timeout)) (command (tramp-get-method-parameter hop 'tramp-login-program)) @@ -5348,7 +5353,7 @@ connection if a previous connection has died for some reason." ;; Add arguments for asynchronous processes. (when process-name async-args) (tramp-expand-args - hop 'tramp-login-args + hop 'tramp-login-args nil ?h (or l-host "") ?u (or l-user "") ?p (or l-port "") ?c (format-spec options (format-spec-make ?t tmpfile)) ?n (concat @@ -5365,8 +5370,7 @@ connection if a previous connection has died for some reason." p vec (min pos (with-current-buffer (process-buffer p) (point-max))) - tramp-actions-before-shell - (or connection-timeout tramp-connection-timeout)) + tramp-actions-before-shell connection-timeout) (tramp-message vec 3 "Found remote shell prompt on `%s'" l-host) @@ -5559,8 +5563,8 @@ raises an error." string "")) -(defun tramp-make-copy-program-file-name (vec) - "Create a file name suitable for `scp', `pscp', or `nc' and workalikes." +(defun tramp-make-copy-file-name (vec) + "Create a file name suitable for out-of-band methods." (let ((method (tramp-file-name-method vec)) (user (tramp-file-name-user vec)) (host (tramp-file-name-host vec)) @@ -5571,13 +5575,13 @@ raises an error." ;; This does not work for MS Windows scp, if there are characters ;; to be quoted. OpenSSH 8 supports disabling of strict file name ;; checking in scp, we use it when available. - (unless (string-match-p (rx "ftp" eos) method) + (unless (string-match-p (rx (| "dockercp" "podmancp" "ftp") eos) method) (setq localname (tramp-unquote-shell-quote-argument localname))) - (cond - ((tramp-get-method-parameter vec 'tramp-remote-copy-program) - localname) - ((tramp-string-empty-or-nil-p user) (format "%s:%s" host localname)) - (t (format "%s@%s:%s" user host localname))))) + (string-join + (apply #'tramp-expand-args vec + 'tramp-copy-file-name tramp-default-copy-file-name + (list ?h (or host "") ?u (or user "") ?f localname)) + ""))) (defun tramp-method-out-of-band-p (vec size) "Return t if this is an out-of-band method, nil otherwise." diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 8dad599c7e7..d0d56b8967e 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -322,7 +322,7 @@ arguments to pass to the OPERATION." v (tramp-get-method-parameter v 'tramp-login-program) nil outbuf display (tramp-expand-args - v 'tramp-login-args + v 'tramp-login-args nil ?h (or (tramp-file-name-host v) "") ?u (or (tramp-file-name-user v) "") ?p (or (tramp-file-name-port v) "") @@ -424,7 +424,7 @@ connection if a previous connection has died for some reason." (tramp-fuse-mount-spec vec) (tramp-fuse-mount-point vec) (tramp-expand-args - vec 'tramp-mount-args + vec 'tramp-mount-args nil ?p (or (tramp-file-name-port vec) "")))))) (tramp-error vec 'file-error "Error mounting %s" (tramp-fuse-mount-spec vec))) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 0c717c4a5aa..7bbfec62753 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -771,7 +771,7 @@ in case of error, t otherwise." (tramp-get-connection-name vec) (current-buffer) (append (tramp-expand-args - vec 'tramp-sudo-login + vec 'tramp-sudo-login nil ?h (or (tramp-file-name-host vec) "") ?u (or (tramp-file-name-user vec) "")) (flatten-tree args)))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 2efee2344d2..e6d6eb0ee66 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -301,6 +301,15 @@ pair of the form (KEY VALUE). The following KEYs are defined: This specifies the list of parameters to pass to the above mentioned program, the hints for `tramp-login-args' also apply here. + * `tramp-copy-file-name' + The remote source or destination file name for out-of-band methods. + You can use \"%u\" and \"%h\" like in `tramp-login-args'. + Additionally, \"%f\" denotes the local file name part. This list + will be expanded to a string without spaces between the elements of + the list. + + The default value is `tramp-default-copy-file-name'. + * `tramp-copy-env' A list of environment variables and their values, which will be set when calling `tramp-copy-program'. @@ -1545,21 +1554,23 @@ LOCALNAME and HOP do not count." (equal (tramp-file-name-unify vec1) (tramp-file-name-unify vec2)))) -(defun tramp-get-method-parameter (vec param) +(defun tramp-get-method-parameter (vec param &optional default) "Return the method parameter PARAM. If VEC is a vector, check first in connection properties. Afterwards, check in `tramp-methods'. If the `tramp-methods' -entry does not exist, return nil." +entry does not exist, return DEFAULT." (let ((hash-entry (replace-regexp-in-string (rx bos "tramp-") "" (symbol-name param)))) (if (tramp-connection-property-p vec hash-entry) ;; We use the cached property. (tramp-get-connection-property vec hash-entry) ;; Use the static value from `tramp-methods'. - (when-let ((methods-entry + (if-let ((methods-entry (assoc param (assoc (tramp-file-name-method vec) tramp-methods)))) - (cadr methods-entry))))) + (cadr methods-entry) + ;; Return the default value. + default)))) ;; The localname can be quoted with "/:". Extract this. (defun tramp-file-name-unquote-localname (vec) @@ -3943,6 +3954,9 @@ Let-bind it when necessary.") (tramp-get-method-parameter v 'tramp-case-insensitive) ;; There isn't. So we must check, in case there's a connection already. + ;; Note: We cannot use it as DEFAULT value of + ;; `tramp-get-method-parameter', because it would be evalled + ;; during the call. (and (let ((non-essential t)) (tramp-connectable-p v)) (with-tramp-connection-property v "case-insensitive" (ignore-errors @@ -4752,15 +4766,15 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (defvar tramp-extra-expand-args nil "Method specific arguments.") -(defun tramp-expand-args (vec parameter &rest spec-list) +(defun tramp-expand-args (vec parameter default &rest spec-list) "Expand login arguments as given by PARAMETER in `tramp-methods'. PARAMETER is a symbol like `tramp-login-args', denoting a list of list of strings from `tramp-methods', containing %-sequences for -substitution. +substitution. DEFAULT is used when PARAMETER is not specified. SPEC-LIST is a list of char/value pairs used for `format-spec-make'. It is appended by `tramp-extra-expand-args', a connection-local variable." - (let ((args (tramp-get-method-parameter vec parameter)) + (let ((args (tramp-get-method-parameter vec parameter default)) (extra-spec-list (mapcar #'eval @@ -4939,7 +4953,7 @@ a connection-local variable." (mapcar (lambda (x) (split-string x " ")) (tramp-expand-args - v 'tramp-login-args + v 'tramp-login-args nil ?h (or host "") ?u (or user "") ?p (or port "") ?c (format-spec (or options "") (format-spec-make ?t tmpfile)) ?d (or device "") ?a (or pta "") ?l "")))) @@ -6326,9 +6340,8 @@ This handles also chrooted environments, which are not regarded as local." (defun tramp-get-remote-tmpdir (vec) "Return directory for temporary files on the remote host identified by VEC." (with-tramp-connection-property (tramp-get-process vec) "remote-tmpdir" - (let ((dir - (tramp-make-tramp-file-name - vec (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp")))) + (let ((dir (tramp-make-tramp-file-name + vec (tramp-get-method-parameter vec 'tramp-tmpdir "/tmp")))) (or (and (file-directory-p dir) (file-writable-p dir) (tramp-file-local-name dir)) (tramp-error vec 'file-error "Directory %s not accessible" dir)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 623e0860a01..cdd2a1efdb2 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3493,6 +3493,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (skip-unless (not (tramp--test-rsync-p))) ;; Wildcards are not supported in tramp-crypt.el. (skip-unless (not (tramp--test-crypt-p))) + ;; Wildcards are not supported with "docker cp ..." or "podman cp ...". + (skip-unless (not (tramp--test-container-oob-p))) (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let* ((tmp-name1 @@ -3819,7 +3821,7 @@ This tests also `access-file', `file-readable-p', "Set the documentation string for a derived test. The test is derived from TEST and COMMAND." (let ((test-doc - (string-split (ert-test-documentation (get test 'ert--test)) "\n"))) + (split-string (ert-test-documentation (get test 'ert--test)) "\n"))) ;; The first line must be extended. (setcar test-doc (format "%s Use the \"%s\" command." (car test-doc) command)) @@ -6379,33 +6381,35 @@ INPUT, if non-nil, is a string sent to the process." (setq tramp-remote-path orig-tramp-remote-path) ;; We make a super long `tramp-remote-path'. - (make-directory tmp-name) - (should (file-directory-p tmp-name)) - (while (tramp-compat-length< (string-join orig-exec-path ":") 5000) - (let ((dir (make-temp-file (file-name-as-directory tmp-name) 'dir))) - (should (file-directory-p dir)) - (setq tramp-remote-path - (append - tramp-remote-path `(,(file-remote-p dir 'localname))) - orig-exec-path - (append - (butlast orig-exec-path) - `(,(file-remote-p dir 'localname)) - (last orig-exec-path))))) - (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) - (should (equal (exec-path) orig-exec-path)) - ;; Ignore trailing newline. - (setq path (substring (shell-command-to-string "echo $PATH") nil -1)) - ;; The shell doesn't handle such long strings. - (unless (tramp-compat-length> - path - (tramp-get-connection-property - tramp-test-vec "pipe-buf" 4096)) - ;; The last element of `exec-path' is `exec-directory'. - (should - (string-equal path (string-join (butlast orig-exec-path) ":")))) - ;; The shell "sh" shall always exist. - (should (executable-find "sh" 'remote))) + (unless (tramp--test-container-oob-p) + (make-directory tmp-name) + (should (file-directory-p tmp-name)) + (while (tramp-compat-length< (string-join orig-exec-path ":") 5000) + (let ((dir (make-temp-file + (file-name-as-directory tmp-name) 'dir))) + (should (file-directory-p dir)) + (setq tramp-remote-path + (append + tramp-remote-path `(,(file-remote-p dir 'localname))) + orig-exec-path + (append + (butlast orig-exec-path) + `(,(file-remote-p dir 'localname)) + (last orig-exec-path))))) + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) + (should (equal (exec-path) orig-exec-path)) + ;; Ignore trailing newline. + (setq path (substring (shell-command-to-string "echo $PATH") nil -1)) + ;; The shell doesn't handle such long strings. + (unless (tramp-compat-length> + path + (tramp-get-connection-property + tramp-test-vec "pipe-buf" 4096)) + ;; The last element of `exec-path' is `exec-directory'. + (should + (string-equal path (string-join (butlast orig-exec-path) ":")))) + ;; The shell "sh" shall always exist. + (should (executable-find "sh" 'remote)))) ;; Cleanup. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) @@ -7056,17 +7060,24 @@ This is used in tests which we don't want to tag (not (and (tramp--test-adb-p) (string-match-p (rx multibyte) default-directory))))) -(defun tramp--test-crypt-p () - "Check, whether the remote directory is encrypted." - (tramp-crypt-file-name-p ert-remote-temporary-file-directory)) - (defun tramp--test-container-p () "Check, whether a container method is used. This does not support some special file names." (string-match-p - (rx bol (| "docker" "podman") eol) + (rx bol (| "docker" "podman")) (file-remote-p ert-remote-temporary-file-directory 'method))) +(defun tramp--test-container-oob-p () + "Check, whether the dockercp or podmancp method is used. +They does not support wildcard copy." + (string-match-p + (rx bol (| "dockercp" "podmancp") eol) + (file-remote-p ert-remote-temporary-file-directory 'method))) + +(defun tramp--test-crypt-p () + "Check, whether the remote directory is encrypted." + (tramp-crypt-file-name-p ert-remote-temporary-file-directory)) + (defun tramp--test-expensive-test-p () "Whether expensive tests are run. This is used in tests which we don't want to tag `:expensive' @@ -7483,7 +7494,8 @@ This requires restrictions of file name syntax." (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) "?foo?bar?baz?") - (unless (or (tramp--test-ftp-p) + (unless (or (tramp--test-container-oob-p) + (tramp--test-ftp-p) (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) "*foo+bar*baz+") @@ -7503,7 +7515,10 @@ This requires restrictions of file name syntax." (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) "bar") "(foo)bar(baz)" - (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]") + (unless (or (tramp--test-container-oob-p) + (tramp--test-ftp-p) + (tramp--test-gvfs-p)) + "[foo]bar[baz]") "{foo}bar{baz}"))) ;; Simplify test in order to speed up. (apply #'tramp--test-check-files -- cgit v1.2.3 From d5775ae4d3ac8a1a4d2625e05307c9296df28d6f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 20 Feb 2024 12:53:15 +0100 Subject: ; Copyedits --- lisp/net/tramp-compat.el | 2 ++ lisp/net/tramp-integration.el | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 061766090a0..98de0dba7ff 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -337,6 +337,8 @@ Also see `ignore'." ;; ;; * Starting with Emacs 29.1, use `buffer-match-p'. ;; +;; * Starting with Emacs 29.1, use `string-split'. +;; ;; * Starting with Emacs 30.1, there is `handler-bind'. Use it ;; instead of `condition-case' when the origin of an error shall be ;; kept, for example when the HANDLER propagates the error with diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index c0b60f57e40..e1f0b2a3495 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -69,7 +69,7 @@ special handling of `substitute-in-file-name'." (when minibuffer-completing-file-name (setq tramp-rfn-eshadow-overlay (make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end))) - ;; Copy rfn-eshadow-overlay properties. + ;; Copy `rfn-eshadow-overlay' properties. (let ((props (overlay-properties rfn-eshadow-overlay))) (while props ;; The `field' property prevents correct minibuffer -- cgit v1.2.3 From d9afa1f30fdf9d00b447fea0a8343397333e172f Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Mon, 19 Feb 2024 23:36:17 +0100 Subject: Make find-function-regexp also find transient-define-* * lisp/emacs-lisp/find-func.el (find-function-regexp): Also find transient-define-prefix, transient-define-suffix, transient-define-infix and transient-define-argument. --- lisp/emacs-lisp/find-func.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 63f547ebeb8..411602ef166 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -60,6 +60,7 @@ ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\ foo\\|\\(?:[^icfgv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\ cl-\\(?:defun\\|defmethod\\|defgeneric\\)\\|\ +transient-define-\\(?:prefix\\|suffix\\|infix\\|argument\\)\\|\ menu-bar-make-toggle\\|menu-bar-make-toggle-command\\)" find-function-space-re "\\('\\|(quote \\)?%s\\(\\s-\\|$\\|[()]\\)") -- cgit v1.2.3 From 4c6653f23aef097e3a6ed687e21decea6c790b5e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 20 Feb 2024 15:44:13 +0200 Subject: ; * lisp/emacs-lisp/pcase.el (pcase-let*, pcase-let): Doc fix. --- lisp/emacs-lisp/pcase.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 47db2b89b9e..692c8f9b3fe 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -261,7 +261,7 @@ As with `pcase-let', BINDINGS are of the form (PATTERN EXP), but the EXP in each binding in BINDINGS can use the results of the destructuring bindings that precede it in BINDINGS' order. -Each EXP should match (i.e. be of compatible structure) to its +Each EXP should match (i.e. be of compatible structure) its respective PATTERN; a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil." (declare (indent 1) @@ -283,7 +283,7 @@ All EXPs are evaluated first, and then used to perform destructuring bindings by matching each EXP against its respective PATTERN. Then BODY is evaluated with those bindings in effect. -Each EXP should match (i.e. be of compatible structure) to its +Each EXP should match (i.e. be of compatible structure) its respective PATTERN; a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil." (declare (indent 1) (debug pcase-let*)) -- cgit v1.2.3 From 2eb85a9de1a5068d09b21464601dbd3263e55c85 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 20 Feb 2024 19:15:38 +0200 Subject: ; * lisp/emacs-lisp/pcase.el (pcase-let*, pcase-let): Another doc fix. --- lisp/emacs-lisp/pcase.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 692c8f9b3fe..ff68203eaea 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -261,8 +261,8 @@ As with `pcase-let', BINDINGS are of the form (PATTERN EXP), but the EXP in each binding in BINDINGS can use the results of the destructuring bindings that precede it in BINDINGS' order. -Each EXP should match (i.e. be of compatible structure) its -respective PATTERN; a mismatch may signal an error or may go +Each EXP should match its respective PATTERN (i.e. be of structure +compatible to PATTERN); a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil." (declare (indent 1) (debug ((&rest (pcase-PAT &optional form)) body))) @@ -283,8 +283,8 @@ All EXPs are evaluated first, and then used to perform destructuring bindings by matching each EXP against its respective PATTERN. Then BODY is evaluated with those bindings in effect. -Each EXP should match (i.e. be of compatible structure) its -respective PATTERN; a mismatch may signal an error or may go +Each EXP should match its respective PATTERN (i.e. be of structure +compatible to PATTERN); a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil." (declare (indent 1) (debug pcase-let*)) (if (null (cdr bindings)) -- cgit v1.2.3 From bbf0b7d0407883ea0a59c09b501c6e550bb8e10c Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 20 Feb 2024 19:47:29 +0100 Subject: * Fix missing entry in 'cl--typeof-types' * lisp/emacs-lisp/cl-preloaded.el (cl--typeof-types): Add 'native-comp-unit'. --- lisp/emacs-lisp/cl-preloaded.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 20e68555578..d533eea9e73 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -81,6 +81,7 @@ (tree-sitter-parser atom) (tree-sitter-node atom) (tree-sitter-compiled-query atom) + (native-comp-unit atom) ;; Plus, really hand made: (null symbol list sequence atom)) "Alist of supertypes. -- cgit v1.2.3 From 167d9b9040333a5bff64325423750243c60edfa1 Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Tue, 20 Feb 2024 18:49:20 +0100 Subject: Allow trivially autoloading uses of transient's define macros Since 49e41991b2f transient-define-prefix itself was autoloaded, but that meant that when ever an autoload file was loaded, which contained an autoload for a command defined using that macro, transient itself had to be loaded. That shouldn't be necessary. For commands using these macros, an autoload that is identical to what would have been generated if it had been defined using defun, works just fine. * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--make-autoload): Allow uses of transient-define-prefix, transient-define-suffix, transient-define-infix and transient-define-argument to be autoloaded using just ";;;autoload". * lisp/transient.el (transient-define-prefix): No longer autoload. --- lisp/emacs-lisp/loaddefs-gen.el | 17 ++++++++++++----- lisp/transient.el | 1 - 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 238ec9d179b..581053f6304 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -201,8 +201,7 @@ expression, in which case we want to handle forms differently." define-globalized-minor-mode defun defmacro easy-mmode-define-minor-mode define-minor-mode define-inline cl-defun cl-defmacro cl-defgeneric - cl-defstruct pcase-defmacro iter-defun cl-iter-defun - transient-define-prefix)) + cl-defstruct pcase-defmacro iter-defun cl-iter-defun)) (macrop car) (setq expand (let ((load-true-file-name file) (load-file-name file)) @@ -218,13 +217,17 @@ expression, in which case we want to handle forms differently." define-globalized-minor-mode easy-mmode-define-minor-mode define-minor-mode cl-defun defun* cl-defmacro defmacro* - define-overloadable-function)) + define-overloadable-function + transient-define-prefix transient-define-suffix + transient-define-infix transient-define-argument)) (let* ((macrop (memq car '(defmacro cl-defmacro defmacro*))) (name (nth 1 form)) (args (pcase car ((or 'defun 'defmacro 'defun* 'defmacro* 'cl-defun 'cl-defmacro - 'define-overloadable-function) + 'define-overloadable-function + 'transient-define-prefix 'transient-define-suffix + 'transient-define-infix 'transient-define-argument) (nth 2 form)) ('define-skeleton '(&optional str arg)) ((or 'define-generic-mode 'define-derived-mode @@ -246,7 +249,11 @@ expression, in which case we want to handle forms differently." define-global-minor-mode define-globalized-minor-mode easy-mmode-define-minor-mode - define-minor-mode)) + define-minor-mode + transient-define-prefix + transient-define-suffix + transient-define-infix + transient-define-argument)) t) (and (eq (car-safe (car body)) 'interactive) ;; List of modes or just t. diff --git a/lisp/transient.el b/lisp/transient.el index f9060f5ba85..bb35746e186 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -855,7 +855,6 @@ elements themselves.") ;;; Define -;;;###autoload (defmacro transient-define-prefix (name arglist &rest args) "Define NAME as a transient prefix command. -- cgit v1.2.3 From 1acc7cb851417b83ae90fe4d0ee9f01af2e03722 Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Tue, 20 Feb 2024 22:49:07 +0100 Subject: Do not attempt to check declarations in lock files * lisp/emacs-lisp/check-declare.el (check-declare-directory): Do not attempt to check declarations in lock files. (Bug#69084) --- lisp/emacs-lisp/check-declare.el | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el index a6d1a330d90..faa7824c8bd 100644 --- a/lisp/emacs-lisp/check-declare.el +++ b/lisp/emacs-lisp/check-declare.el @@ -328,9 +328,14 @@ Returns non-nil if any false statements are found." (setq root (directory-file-name (file-relative-name root))) (or (file-directory-p root) (error "Directory `%s' not found" root)) - (let ((files (directory-files-recursively root "\\.el\\'"))) - (when files - (apply #'check-declare-files files)))) + (when-let* ((files (directory-files-recursively root "\\.el\\'")) + (files (mapcan (lambda (file) + ;; Filter out lock files. + (and (not (string-prefix-p + ".#" (file-name-nondirectory file))) + (list file))) + files))) + (apply #'check-declare-files files))) (provide 'check-declare) -- cgit v1.2.3 From 7b0d75018885d8d34ff7c4427a83a21a4808282c Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 21 Feb 2024 11:49:47 +0800 Subject: Work around premature dismissals of submenus under Android * java/org/gnu/emacs/EmacsContextMenu.java (display): If between HONEYCOMB and N, set wasSubmenuSelected. --- java/org/gnu/emacs/EmacsContextMenu.java | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/java/org/gnu/emacs/EmacsContextMenu.java b/java/org/gnu/emacs/EmacsContextMenu.java index 17e6033377d..f1d70f05a25 100644 --- a/java/org/gnu/emacs/EmacsContextMenu.java +++ b/java/org/gnu/emacs/EmacsContextMenu.java @@ -361,8 +361,24 @@ public final class EmacsContextMenu public Boolean call () { + boolean rc; + lastMenuEventSerial = serial; - return display1 (window, xPosition, yPosition); + rc = display1 (window, xPosition, yPosition); + + /* Android 3.0 to Android 7.0 perform duplicate calls to + onContextMenuClosed after a context menu is dismissed for + the second or third time. Since the second call after such + a dismissal is otherwise liable to prematurely cancel any + context menu displayed immediately afterwards, ignore calls + received within 300 milliseconds of this menu's being + displayed. */ + + if (rc && Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB + && Build.VERSION.SDK_INT < Build.VERSION_CODES.N) + wasSubmenuSelected = System.currentTimeMillis (); + + return rc; } }); -- cgit v1.2.3 From d6131b5902a70339305285f9861bdfd24c567eab Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 21 Feb 2024 09:02:33 +0100 Subject: * lisp/net/tramp.el (tramp-methods): Fix typo in docstring. (Bug#69294) --- lisp/net/tramp.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 9d883c96252..2d6db31fee8 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -332,8 +332,8 @@ pair of the form (KEY VALUE). The following KEYs are defined: chosen port for the remote listener. * `tramp-copy-keep-date' - This specifies whether the copying program when the preserves the - timestamp of the original file. + This specifies whether the copying program preserves the timestamp + of the original file. * `tramp-copy-keep-tmpfile' This specifies whether a temporary local file shall be kept -- cgit v1.2.3 From 3b34c5e4a583dd88f476570cbd58655a18e9a6b4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 21 Feb 2024 08:49:15 -0500 Subject: * lisp/emacs-lisp/map.el (map--make-pcase-bindings): Fix use in Emacs<30 --- lisp/emacs-lisp/map.el | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 95a25978d1c..d3d71a36ee4 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -608,19 +608,30 @@ This allows using default values for `map-elt', which can't be done using `pcase--flip'. KEY is the key sought in the map. DEFAULT is the default value." + ;; It's obsolete in Emacs>29, but `map.el' is distributed via GNU ELPA + ;; for earlier Emacsen. (declare (obsolete _ "30.1")) `(map-elt ,map ,key ,default)) (defun map--make-pcase-bindings (args) "Return a list of pcase bindings from ARGS to the elements of a map." - (mapcar (lambda (elt) - (cond ((consp elt) - `(app (map-elt _ ,(car elt) ,(caddr elt)) - ,(cadr elt))) - ((keywordp elt) - (let ((var (intern (substring (symbol-name elt) 1)))) - `(app (map-elt _ ,elt) ,var))) - (t `(app (map-elt _ ',elt) ,elt)))) + (mapcar (if (< emacs-major-version 30) + (lambda (elt) + (cond ((consp elt) + `(app (map--pcase-map-elt ,(car elt) ,(caddr elt)) + ,(cadr elt))) + ((keywordp elt) + (let ((var (intern (substring (symbol-name elt) 1)))) + `(app (pcase--flip map-elt ,elt) ,var))) + (t `(app (pcase--flip map-elt ',elt) ,elt)))) + (lambda (elt) + (cond ((consp elt) + `(app (map-elt _ ,(car elt) ,(caddr elt)) + ,(cadr elt))) + ((keywordp elt) + (let ((var (intern (substring (symbol-name elt) 1)))) + `(app (map-elt _ ,elt) ,var))) + (t `(app (map-elt _ ',elt) ,elt))))) args)) (defun map--make-pcase-patterns (args) -- cgit v1.2.3 From 0a4d4781ddc079509cb256edf803d663439dcf92 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 21 Feb 2024 21:49:35 +0800 Subject: * java/org/gnu/emacs/EmacsContextMenu.java (display): Reduce timeout. --- java/org/gnu/emacs/EmacsContextMenu.java | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/java/org/gnu/emacs/EmacsContextMenu.java b/java/org/gnu/emacs/EmacsContextMenu.java index f1d70f05a25..2bbf2a313d6 100644 --- a/java/org/gnu/emacs/EmacsContextMenu.java +++ b/java/org/gnu/emacs/EmacsContextMenu.java @@ -367,16 +367,15 @@ public final class EmacsContextMenu rc = display1 (window, xPosition, yPosition); /* Android 3.0 to Android 7.0 perform duplicate calls to - onContextMenuClosed after a context menu is dismissed for - the second or third time. Since the second call after such - a dismissal is otherwise liable to prematurely cancel any - context menu displayed immediately afterwards, ignore calls - received within 300 milliseconds of this menu's being - displayed. */ + onContextMenuClosed the second time a context menu is + dismissed. Since the second call after such a dismissal is + otherwise liable to prematurely cancel any context menu + displayed immediately afterwards, ignore calls received + within 150 milliseconds of this menu's being displayed. */ if (rc && Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB && Build.VERSION.SDK_INT < Build.VERSION_CODES.N) - wasSubmenuSelected = System.currentTimeMillis (); + wasSubmenuSelected = System.currentTimeMillis () - 150; return rc; } -- cgit v1.2.3 From d5757178464ca51f79c7fc1ab199a1582e92ab32 Mon Sep 17 00:00:00 2001 From: kobarity Date: Fri, 16 Feb 2024 22:52:06 +0900 Subject: Set tty mode to raw when setting up Inferior Python * lisp/progmodes/python.el (python-shell-setup-code): New constant. (python-shell-comint-watch-for-first-prompt-output-filter): Send `python-shell-setup-code' to the Inferior Python process. * test/lisp/progmodes/python-tests.el (python-ffap-module-path-1): Eliminate skipping on Mac. (Bug#68559) --- lisp/progmodes/python.el | 11 +++++++++++ test/lisp/progmodes/python-tests.el | 5 ----- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index b7e43f3fc68..5501926e69d 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -3521,6 +3521,16 @@ eventually provide a shell." :version "25.1" :type 'hook) +(defconst python-shell-setup-code + "\ +try: + import tty +except ImportError: + pass +else: + tty.setraw(0)" + "Code used to setup the inferior Python processes.") + (defconst python-shell-eval-setup-code "\ def __PYTHON_EL_eval(source, filename): @@ -3586,6 +3596,7 @@ The coding cookie regexp is specified in PEP 263.") (format "exec(%s)\n" (python-shell--encode-string string)))))) ;; Bootstrap: the normal definition of `python-shell-send-string' ;; depends on the Python code sent here. + (python-shell-send-string-no-output python-shell-setup-code) (python-shell-send-string-no-output python-shell-eval-setup-code) (python-shell-send-string-no-output python-shell-eval-file-setup-code)) (with-current-buffer (current-buffer) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index af6c199b5bd..6c6cd9eee2b 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -5037,11 +5037,6 @@ import abc (ert-deftest python-ffap-module-path-1 () (skip-unless (executable-find python-tests-shell-interpreter)) - ;; Skip the test on macOS, since the standard Python installation uses - ;; libedit rather than readline which confuses the running of an inferior - ;; interpreter in this case (see bug#59477 and bug#25753). - (skip-when (eq system-type 'darwin)) - (trace-function 'python-shell-output-filter) (python-tests-with-temp-buffer-with-shell " import abc -- cgit v1.2.3 From a2eb123fb606af2a62ad6d0d0162255d7f0601e1 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Wed, 21 Feb 2024 15:22:21 +0100 Subject: ; * src/lisp.h: Add Lisp_Object tagging scheme overview --- src/lisp.h | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/lisp.h b/src/lisp.h index db053ba9f70..b02466390f1 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -478,6 +478,16 @@ typedef EMACS_INT Lisp_Word; #endif +/* Lisp_Object tagging scheme: + Tag location + Upper bits Lower bits Type Payload + 000....... .......000 symbol offset from lispsym to struct Lisp_Symbol + 001....... .......001 unused + 01........ ........10 fixnum signed integer of FIXNUM_BITS + 110....... .......011 cons pointer to struct Lisp_Cons + 100....... .......100 string pointer to struct Lisp_String + 101....... .......101 vectorlike pointer to union vectorlike_header + 111....... .......111 float pointer to struct Lisp_Float */ enum Lisp_Type { /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */ -- cgit v1.2.3 From 8987e1b093b07756d18c861d1c7febb85fe88bef Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 21 Feb 2024 17:16:45 +0200 Subject: Remove redundant call to 'eln_load_path_final_clean_up' * src/emacs.c (shut_down_emacs): Remove redundant call to 'eln_load_path_final_clean_up'. We call it from 'kill-emacs' right before the call to 'exit'. --- src/emacs.c | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/emacs.c b/src/emacs.c index 97c65fbfd33..f4bfb9a6bbd 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -3116,10 +3116,6 @@ shut_down_emacs (int sig, Lisp_Object stuff) check_message_stack (); } -#ifdef HAVE_NATIVE_COMP - eln_load_path_final_clean_up (); -#endif - #ifdef MSDOS dos_cleanup (); #endif -- cgit v1.2.3 From 7215c63fc0f9d7f48ac20578d310a8b3d86b0eae Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 11:18:06 +0100 Subject: * Make 'comp--compute-function-types' a pass * lisp/emacs-lisp/comp.el (comp-passes): Add comp--compute-function-types. (comp--compute-function-types): New function. (comp--compute-function-type): Move it. (comp--final): Update it. --- lisp/emacs-lisp/comp.el | 61 +++++++++++++++++++++++++++---------------------- 1 file changed, 34 insertions(+), 27 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 593291a379e..b27cf2b6620 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -165,6 +165,7 @@ Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.") comp--tco comp--fwprop comp--remove-type-hints + comp--compute-function-types comp--final) "Passes to be executed in order.") @@ -2994,32 +2995,7 @@ These are substituted with a normal `set' op." (comp-ctxt-funcs-h comp-ctxt))) -;;; Final pass specific code. - -(defun comp--args-to-lambda-list (args) - "Return a lambda list for ARGS." - (cl-loop - with res - repeat (comp-args-base-min args) - do (push t res) - finally - (if (comp-args-p args) - (cl-loop - with n = (- (comp-args-max args) (comp-args-min args)) - initially (unless (zerop n) - (push '&optional res)) - repeat n - do (push t res)) - (cl-loop - with n = (- (comp-nargs-nonrest args) (comp-nargs-min args)) - initially (unless (zerop n) - (push '&optional res)) - repeat n - do (push t res) - finally (when (comp-nargs-rest args) - (push '&rest res) - (push 't res)))) - (cl-return (reverse res)))) +;;; Function types pass specific code. (defun comp--compute-function-type (_ func) "Compute type specifier for `comp-func' FUNC. @@ -3047,6 +3023,38 @@ Set it into the `type' slot." ;; Fix it up. (setf (comp-cstr-imm (comp-func-type func)) type)))) +(defun comp--compute-function-types (_) + "" + (maphash #'comp--compute-function-type (comp-ctxt-funcs-h comp-ctxt))) + + +;;; Final pass specific code. + +(defun comp--args-to-lambda-list (args) + "Return a lambda list for ARGS." + (cl-loop + with res + repeat (comp-args-base-min args) + do (push t res) + finally + (if (comp-args-p args) + (cl-loop + with n = (- (comp-args-max args) (comp-args-min args)) + initially (unless (zerop n) + (push '&optional res)) + repeat n + do (push t res)) + (cl-loop + with n = (- (comp-nargs-nonrest args) (comp-nargs-min args)) + initially (unless (zerop n) + (push '&optional res)) + repeat n + do (push t res) + finally (when (comp-nargs-rest args) + (push '&rest res) + (push 't res)))) + (cl-return (reverse res)))) + (defun comp--finalize-container (cont) "Finalize data container CONT." (setf (comp-data-container-l cont) @@ -3149,7 +3157,6 @@ Prepare every function for final compilation and drive the C back-end." (defun comp--final (_) "Final pass driving the C back-end for code emission." - (maphash #'comp--compute-function-type (comp-ctxt-funcs-h comp-ctxt)) (unless comp-dry-run ;; Always run the C side of the compilation as a sub-process ;; unless during bootstrap or async compilation (bug#45056). GCC -- cgit v1.2.3 From 1e1d3f3acd8567addc0dab4bc34dc5c7f2405556 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 11:18:28 +0100 Subject: ; * lisp/emacs-lisp/comp.el (native-comp-debug): Fix spacing. --- lisp/emacs-lisp/comp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index b27cf2b6620..6532fb8d1ce 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -68,7 +68,7 @@ :safe #'integerp :version "28.1") -(defcustom native-comp-debug 0 +(defcustom native-comp-debug 0 "Debug level for native compilation, a number between 0 and 3. This is intended for debugging the compiler itself. 0 no debug output. -- cgit v1.2.3 From 5aeea8dc2c0bdd01de3ad271723e9d1737d8a056 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 15:06:18 +0100 Subject: * lisp/emacs-lisp/comp-cstr.el (comp-cstr): Rename constructors. --- lisp/emacs-lisp/comp-cstr.el | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 0bc97e51592..48e3645629b 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -44,7 +44,7 @@ ;; TODO can we just add t in `cl--typeof-types'? "Like `cl--typeof-types' but with t as common supertype.") -(cl-defstruct (comp-cstr (:constructor comp-type-to-cstr +(cl-defstruct (comp-cstr (:constructor comp--type-to-cstr (type &aux (null (eq type 'null)) (integer (eq type 'integer)) @@ -55,7 +55,7 @@ '(nil))) (range (when integer '((- . +)))))) - (:constructor comp-value-to-cstr + (:constructor comp--value-to-cstr (value &aux (integer (integerp value)) (valset (unless integer @@ -63,7 +63,7 @@ (range (when integer `((,value . ,value)))) (typeset ()))) - (:constructor comp-irange-to-cstr + (:constructor comp--irange-to-cstr (irange &aux (range (list irange)) (typeset ()))) @@ -229,10 +229,10 @@ Return them as multiple value." ;; builds. (defvar comp-ctxt nil) -(defvar comp-cstr-one (comp-value-to-cstr 1) +(defvar comp-cstr-one (comp--value-to-cstr 1) "Represent the integer immediate one.") -(defvar comp-cstr-t (comp-type-to-cstr t) +(defvar comp-cstr-t (comp--type-to-cstr t) "Represent the superclass t.") @@ -1212,14 +1212,14 @@ FN non-nil indicates we are parsing a function lambda list." ('nil (make-comp-cstr :typeset ())) ('fixnum - (comp-irange-to-cstr `(,most-negative-fixnum . ,most-positive-fixnum))) + (comp--irange-to-cstr `(,most-negative-fixnum . ,most-positive-fixnum))) ('boolean (comp-type-spec-to-cstr '(member t nil))) ('integer - (comp-irange-to-cstr '(- . +))) - ('null (comp-value-to-cstr nil)) + (comp--irange-to-cstr '(- . +))) + ('null (comp--value-to-cstr nil)) ((pred atom) - (comp-type-to-cstr type-spec)) + (comp--type-to-cstr type-spec)) (`(or . ,rest) (apply #'comp-cstr-union-make (mapcar #'comp-type-spec-to-cstr rest))) @@ -1229,16 +1229,16 @@ FN non-nil indicates we are parsing a function lambda list." (`(not ,cstr) (comp-cstr-negation-make (comp-type-spec-to-cstr cstr))) (`(integer ,(and (pred integerp) l) ,(and (pred integerp) h)) - (comp-irange-to-cstr `(,l . ,h))) + (comp--irange-to-cstr `(,l . ,h))) (`(integer * ,(and (pred integerp) h)) - (comp-irange-to-cstr `(- . ,h))) + (comp--irange-to-cstr `(- . ,h))) (`(integer ,(and (pred integerp) l) *) - (comp-irange-to-cstr `(,l . +))) + (comp--irange-to-cstr `(,l . +))) (`(float ,(pred comp-star-or-num-p) ,(pred comp-star-or-num-p)) ;; No float range support :/ - (comp-type-to-cstr 'float)) + (comp--type-to-cstr 'float)) (`(member . ,rest) - (apply #'comp-cstr-union-make (mapcar #'comp-value-to-cstr rest))) + (apply #'comp-cstr-union-make (mapcar #'comp--value-to-cstr rest))) (`(function ,args ,ret) (make-comp-cstr-f :args (mapcar (lambda (x) -- cgit v1.2.3 From c65a59a9e90524efa23d9151c31dad66a08ccb90 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 15:45:10 +0100 Subject: * Add few missing entries in 'comp-known-predicates' * lisp/emacs-lisp/comp.el (comp-known-predicates): Add framep, markerp, number-or-marker-p, overlayp, processp, subrp and windowp and sort it alphabetically. --- lisp/emacs-lisp/comp.el | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 6532fb8d1ce..a833bf5bfc4 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -191,28 +191,34 @@ Useful to hook into pass checkers.") (defconst comp-known-predicates '((arrayp . array) (atom . atom) - (characterp . fixnum) - (booleanp . boolean) (bool-vector-p . bool-vector) + (booleanp . boolean) (bufferp . buffer) - (natnump . (integer 0 *)) (char-table-p . char-table) - (hash-table-p . hash-table) + (characterp . fixnum) (consp . cons) - (integerp . integer) (floatp . float) + (framep . frame) (functionp . (or function symbol)) + (hash-table-p . hash-table) + (integer-or-marker-p . integer-or-marker) (integerp . integer) (keywordp . keyword) (listp . list) - (numberp . number) + (markerp . marker) + (natnump . (integer 0 *)) (null . null) + (number-or-marker-p . number-or-marker) + (numberp . number) (numberp . number) + (overlayp . overlay) + (processp . process) (sequencep . sequence) (stringp . string) + (subrp . subr) (symbolp . symbol) (vectorp . vector) - (integer-or-marker-p . integer-or-marker)) + (windowp . window)) "Alist predicate -> matched type specifier.") (defconst comp-known-predicates-h -- cgit v1.2.3 From 88abbf00af69cf7e5f36e318e6935f7d1500af7f Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 15:45:40 +0100 Subject: ; Add two comments on comp-known-predicates cl-deftype-satisfies * lisp/emacs-lisp/comp.el (comp-known-predicates): Add comment. * lisp/emacs-lisp/cl-macs.el: Likewise. --- lisp/emacs-lisp/cl-macs.el | 1 + lisp/emacs-lisp/comp.el | 3 +++ 2 files changed, 4 insertions(+) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 06a09885c88..44ebadeebff 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3460,6 +3460,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." (or (cdr (assq sym byte-compile-function-environment)) (cdr (assq sym macroexpand-all-environment)))))) +;; Please keep it in sync with `comp-known-predicates'. (pcase-dolist (`(,type . ,pred) ;; Mostly kept in alphabetical order. '((array . arrayp) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index a833bf5bfc4..46d2896f2be 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -188,6 +188,9 @@ Useful to hook into pass checkers.") finally return h) "Hash table function -> `comp-constraint'.") +;; Keep it in sync with the `cl-deftype-satisfies' property set in +;; cl-macs.el. We can't use `cl-deftype-satisfies' directly as the +;; relation type <-> predicate is not bijective (bug#45576). (defconst comp-known-predicates '((arrayp . array) (atom . atom) -- cgit v1.2.3 From 35d99b1ec7c56d4a5c09af36e6bbd7f0f959cccc Mon Sep 17 00:00:00 2001 From: john muhl Date: Wed, 21 Feb 2024 10:14:05 -0600 Subject: ; Update URL of the tree-sitter-lua grammar * admin/notes/tree-sitter/build-module/build.sh: * lisp/progmodes/lua-ts-mode.el: * test/infra/Dockerfile.emba: Use the new URL. (bug#69304) --- admin/notes/tree-sitter/build-module/build.sh | 2 +- lisp/progmodes/lua-ts-mode.el | 4 ++-- test/infra/Dockerfile.emba | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/admin/notes/tree-sitter/build-module/build.sh b/admin/notes/tree-sitter/build-module/build.sh index 969187b7f92..9a567bb094d 100755 --- a/admin/notes/tree-sitter/build-module/build.sh +++ b/admin/notes/tree-sitter/build-module/build.sh @@ -43,7 +43,7 @@ case "${lang}" in org="phoenixframework" ;; "lua") - org="MunifTanjim" + org="tree-sitter-grammars" ;; "typescript") sourcedir="tree-sitter-typescript/typescript/src" diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index c7f5ac50b04..8bd3db2b75f 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -26,8 +26,8 @@ ;; This package provides `lua-ts-mode' which is a major mode for Lua ;; files that uses Tree Sitter to parse the language. ;; -;; This package is compatible with and tested against the grammar -;; for Lua found at https://github.com/MunifTanjim/tree-sitter-lua +;; This package is compatible with and tested against the grammar for +;; Lua found at https://github.com/tree-sitter-grammars/tree-sitter-lua ;;; Code: diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba index 8e583fade9f..d79072b06b5 100644 --- a/test/infra/Dockerfile.emba +++ b/test/infra/Dockerfile.emba @@ -126,7 +126,7 @@ RUN src/emacs -Q --batch \ (java "https://github.com/tree-sitter/tree-sitter-java") \ (javascript "https://github.com/tree-sitter/tree-sitter-javascript") \ (json "https://github.com/tree-sitter/tree-sitter-json") \ - (lua "https://github.com/MunifTanjim/tree-sitter-lua") \ + (lua "https://github.com/tree-sitter-grammars/tree-sitter-lua") \ (python "https://github.com/tree-sitter/tree-sitter-python") \ (ruby "https://github.com/tree-sitter/tree-sitter-ruby") \ (tsx "https://github.com/tree-sitter/tree-sitter-typescript" "master" "tsx/src") \ -- cgit v1.2.3 From e6882a5cc89d9375dfa73156db6836af19ef7b8a Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Thu, 1 Feb 2024 12:30:24 +0100 Subject: ; Fix mid-symbol updating/cycling completion preview This fixes an issue where 'completion-preview-next-candidate' would fail to take into account the part of the symbol that follows point (the suffix) when point is at the middle of a symbol, as well as a similar issue in 'completion-preview--show' that would manifest with slow 'completion-at-point-functions'. * lisp/completion-preview.el (completion-preview-next-candidate) (completion-preview--show): Ensure that the completion preview remains at the end of a symbol, when updating it while point is in the middle of that symbol. * test/lisp/completion-preview-tests.el (completion-preview-mid-symbol-cycle): New test. (Bug#68875) --- lisp/completion-preview.el | 24 ++++++++++++------------ test/lisp/completion-preview-tests.el | 15 +++++++++++++++ 2 files changed, 27 insertions(+), 12 deletions(-) diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 6fd60f3c416..e827da43a08 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -302,21 +302,21 @@ point, otherwise hide it." ;; never display a stale preview and that the preview doesn't ;; flicker, even with slow completion backends. (let* ((beg (completion-preview--get 'completion-preview-beg)) + (end (max (point) (overlay-start completion-preview--overlay))) (cands (completion-preview--get 'completion-preview-cands)) (index (completion-preview--get 'completion-preview-index)) (cand (nth index cands)) - (len (length cand)) - (end (+ beg len)) - (cur (point)) - (face (get-text-property 0 'face (completion-preview--get 'after-string)))) - (if (and (< beg cur end) (string-prefix-p (buffer-substring beg cur) cand)) + (after (completion-preview--get 'after-string)) + (face (get-text-property 0 'face after))) + (if (and (<= beg (point) end (1- (+ beg (length cand)))) + (string-prefix-p (buffer-substring beg end) cand)) ;; The previous preview is still applicable, update it. (overlay-put (completion-preview--make-overlay - cur (propertize (substring cand (- cur beg)) + end (propertize (substring cand (- end beg)) 'face face 'mouse-face 'completion-preview-highlight 'keymap completion-preview--mouse-map)) - 'completion-preview-end cur) + 'completion-preview-end end) ;; The previous preview is no longer applicable, hide it. (completion-preview-active-mode -1)))) ;; Run `completion-at-point-functions' to get a new candidate. @@ -366,16 +366,16 @@ prefix argument and defaults to 1." (interactive "p") (when completion-preview-active-mode (let* ((beg (completion-preview--get 'completion-preview-beg)) + (end (completion-preview--get 'completion-preview-end)) (all (completion-preview--get 'completion-preview-cands)) (cur (completion-preview--get 'completion-preview-index)) (len (length all)) (new (mod (+ cur direction) len)) - (str (nth new all)) - (pos (point))) - (while (or (<= (+ beg (length str)) pos) - (not (string-prefix-p (buffer-substring beg pos) str))) + (str (nth new all))) + (while (or (<= (+ beg (length str)) end) + (not (string-prefix-p (buffer-substring beg end) str))) (setq new (mod (+ new direction) len) str (nth new all))) - (let ((aft (propertize (substring str (- pos beg)) + (let ((aft (propertize (substring str (- end beg)) 'face (if (< 1 len) 'completion-preview 'completion-preview-exact) diff --git a/test/lisp/completion-preview-tests.el b/test/lisp/completion-preview-tests.el index 190764e9125..5b2c28bd3dd 100644 --- a/test/lisp/completion-preview-tests.el +++ b/test/lisp/completion-preview-tests.el @@ -181,4 +181,19 @@ instead." (completion-preview--post-command)) (completion-preview-tests--check-preview "barbaz" 'exact))) +(ert-deftest completion-preview-mid-symbol-cycle () + "Test cycling the completion preview with point at the middle of a symbol." + (with-temp-buffer + (setq-local completion-at-point-functions + (list + (completion-preview-tests--capf + '("foobar" "foobaz")))) + (insert "fooba") + (forward-char -2) + (let ((this-command 'self-insert-command)) + (completion-preview--post-command)) + (completion-preview-tests--check-preview "r") + (completion-preview-next-candidate 1) + (completion-preview-tests--check-preview "z"))) + ;;; completion-preview-tests.el ends here -- cgit v1.2.3 From 44d5c667d7775f881473c7c6f7d9bdef7594bd79 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 17:45:41 +0100 Subject: * lisp/emacs-lisp/comp.el (comp--compute-function-types): Fix missing doc. --- lisp/emacs-lisp/comp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 46d2896f2be..e0da01bcc5d 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3033,7 +3033,7 @@ Set it into the `type' slot." (setf (comp-cstr-imm (comp-func-type func)) type)))) (defun comp--compute-function-types (_) - "" + "Compute and store the type specifier for all functions." (maphash #'comp--compute-function-type (comp-ctxt-funcs-h comp-ctxt))) -- cgit v1.2.3 From f28a557c7d4b39f302630ed2b19a73fc375e7ff4 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 21 Feb 2024 19:43:28 +0200 Subject: * doc/lispref/modes.texi (Tabulated List Mode): Update. In the description of 'tabulated-list-format' document the missing value 'props' that was added long ago. --- doc/lispref/modes.texi | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index bd4c055c2c2..9fe4d332a21 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1124,7 +1124,7 @@ column is sorted in the descending order. This buffer-local variable specifies the format of the Tabulated List data. Its value should be a vector. Each element of the vector represents a data column, and should be a list @code{(@var{name} -@var{width} @var{sort})}, where +@var{width} @var{sort} . @var{props})}, where @itemize @item @@ -1141,6 +1141,13 @@ sorted by comparing string values. Otherwise, this should be a predicate function for @code{sort} (@pxref{Rearrangement}), which accepts two arguments with the same form as the elements of @code{tabulated-list-entries} (see below). + +@item +@var{props} is a plist (@pxref{Property Lists}) of additional column +properties. If the value of the property @code{:right-align} is +non-@code{nil} then the column should be right-aligned. And the +property @code{:pad-right} specifies the number of additional padding +spaces to the right of the column (by default 1 if omitted). @end itemize @end defvar -- cgit v1.2.3 From b214cb2843851c410d603e7fb487a462d5f7bee1 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 21:38:11 +0100 Subject: ; * lisp/emacs-lisp/comp-run.el: Fix typo. --- lisp/emacs-lisp/comp-run.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index 5d1a193269d..8fcbe31cf0b 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -25,7 +25,7 @@ ;; While the main native compiler is implemented in comp.el, when ;; commonly used as a jit compiler it is only loaded by Emacs sub -;; processes performing async compilation. This files contains all +;; processes performing async compilation. This file contains all ;; the code needed to drive async compilations and any Lisp code ;; needed at runtime to run native code. -- cgit v1.2.3 From 39a84232700c40fa74305970dd16cd5cb8b8bea0 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 22 Feb 2024 09:53:48 +0800 Subject: Enable inotify on systems with inotify_init yet no init1 variant * configure.ac (HAVE_INOTIFY): Check for the presence of inotify_init in addition to inotify_init1. * src/inotify.c (Finotify_add_watch): Implement with inotify_init if inotify_init1 is absent. --- configure.ac | 8 ++++---- src/inotify.c | 10 ++++++++++ 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/configure.ac b/configure.ac index 847fdbd54d2..71a899f5f40 100644 --- a/configure.ac +++ b/configure.ac @@ -4088,16 +4088,16 @@ case $with_file_notification,$opsys in fi ;; esac -dnl inotify is available only on GNU/Linux. +dnl inotify is available only on Linux-kernel based systems. case $with_file_notification,$NOTIFY_OBJ in inotify, | yes,) AC_CHECK_HEADER([sys/inotify.h]) if test "$ac_cv_header_sys_inotify_h" = yes ; then - AC_CHECK_FUNC([inotify_init1]) - if test "$ac_cv_func_inotify_init1" = yes; then + AC_CHECK_FUNCS([inotify_init inotify_init1]) + if test "$ac_cv_func_inotify_init" = yes; then AC_DEFINE([HAVE_INOTIFY], [1], [Define to 1 to use inotify.]) NOTIFY_OBJ=inotify.o - NOTIFY_SUMMARY="yes -lglibc (inotify)" + NOTIFY_SUMMARY="yes (inotify)" fi fi ;; esac diff --git a/src/inotify.c b/src/inotify.c index 2ee874530cc..7140568f1b6 100644 --- a/src/inotify.c +++ b/src/inotify.c @@ -26,6 +26,8 @@ along with GNU Emacs. If not, see . */ #include "termhooks.h" #include +#include + #include #include @@ -434,7 +436,15 @@ IN_ONESHOT */) if (inotifyfd < 0) { +#ifdef HAVE_INOTIFY_INIT1 inotifyfd = inotify_init1 (IN_NONBLOCK | IN_CLOEXEC); +#else /* !HAVE_INOTIFY_INIT1 */ + /* This is prey to race conditions with other threads calling + exec. */ + inotifyfd = inotify_init (); + fcntl (inotifyfd, F_SETFL, O_NONBLOCK); + fcntl (inotifyfd, F_SETFD, O_CLOEXEC); +#endif /* HAVE_INOTIFY_INIT1 */ if (inotifyfd < 0) report_file_notify_error ("File watching is not available", Qnil); watch_list = Qnil; -- cgit v1.2.3 From f024b63ecf8d4ebfd518beb4c2dfc853d725ec19 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 22 Feb 2024 10:08:12 +0800 Subject: ; * admin/CPP-DEFINES: Update with Android defines. --- admin/CPP-DEFINES | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index 06986ec8f48..8143a394578 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -25,6 +25,9 @@ SOLARIS2 USG USG5_4 HAIKU Compiling on Haiku. +__ANDROID__ Compiling for the Android operating system. +__ANDROID_API__ A numerical "API level" indicating the version of + Android being compiled for; see http://apilevels.com. ** Distinguishing GUIs ** @@ -35,10 +38,14 @@ NS_IMPL_COCOA Compile support for Cocoa (Apple) implementation of NS GUI API. HAVE_X11 Compile support for the X11 GUI. HAVE_PGTK Compile support for using GTK itself without directly using X Windows APIs. HAVE_HAIKU Compile support for the Haiku window system. -HAVE_X_WINDOWS Compile support for X Window system - (It looks like, nowadays, if HAVE_X11 is set, HAVE_X_WINDOWS must - be, and vice versa. At least, this is true for configure, and - msdos; not sure about nt.) +HAVE_X_WINDOWS Compile support for X Window system. Equivalent to HAVE_X11. +HAVE_ANDROID Compiling the Android GUI interface. Enough of this + code is compiled for the build machine cross-compiling + the Android port to produce an Emacs binary that can + Lisp code in batch mode, for the purpose of compiling + Lisp code for packaging. +ANDROID_STUBIFY The Android GUI interface is being compiled for the build + machine, as above. ** X Windows features ** HAVE_X11R6 Whether or not the system has X11R6. (Always defined.) -- cgit v1.2.3 From ee6343556a53770cd2c7730b48ce1731423d8825 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 22 Feb 2024 10:21:12 +0800 Subject: ; * admin/CPP-DEFINES: Fix typos. --- admin/CPP-DEFINES | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index 8143a394578..c07fdc487ee 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -42,8 +42,8 @@ HAVE_X_WINDOWS Compile support for X Window system. Equivalent to HAVE_X11. HAVE_ANDROID Compiling the Android GUI interface. Enough of this code is compiled for the build machine cross-compiling the Android port to produce an Emacs binary that can - Lisp code in batch mode, for the purpose of compiling - Lisp code for packaging. + run Lisp code in batch mode, for the purpose of running + the byte-compiler. ANDROID_STUBIFY The Android GUI interface is being compiled for the build machine, as above. -- cgit v1.2.3 From 8e0f134653b2951e80cd5659fba5c36e416931fa Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 22 Feb 2024 13:30:18 +0800 Subject: ; Insert missing JNI prologues * src/android.c (shouldForwardMultimediaButtons) (shouldForwardCtrlSpace, notifyPixelsChanged, setupSystemThread): * src/androidvfs.c (safSyncAndReadInput, safSync, safPostRequest) (ftruncate): Insert absent JNI prologues. --- src/android.c | 8 ++++++++ src/androidvfs.c | 8 ++++++++ 2 files changed, 16 insertions(+) diff --git a/src/android.c b/src/android.c index 4d56df1da3f..41481afa475 100644 --- a/src/android.c +++ b/src/android.c @@ -2519,6 +2519,8 @@ JNIEXPORT jboolean JNICALL NATIVE_NAME (shouldForwardMultimediaButtons) (JNIEnv *env, jobject object) { + JNI_STACK_ALIGNMENT_PROLOGUE; + /* Yes, android_pass_multimedia_buttons_to_system is being read from the UI thread. */ return !android_pass_multimedia_buttons_to_system; @@ -2527,6 +2529,8 @@ NATIVE_NAME (shouldForwardMultimediaButtons) (JNIEnv *env, JNIEXPORT jboolean JNICALL NATIVE_NAME (shouldForwardCtrlSpace) (JNIEnv *env, jobject object) { + JNI_STACK_ALIGNMENT_PROLOGUE; + return !android_intercept_control_space; } @@ -2630,6 +2634,8 @@ JNIEXPORT void JNICALL NATIVE_NAME (notifyPixelsChanged) (JNIEnv *env, jobject object, jobject bitmap) { + JNI_STACK_ALIGNMENT_PROLOGUE; + void *data; /* Lock and unlock the bitmap. This calls @@ -2683,6 +2689,8 @@ NATIVE_NAME (answerQuerySpin) (JNIEnv *env, jobject object) JNIEXPORT void JNICALL NATIVE_NAME (setupSystemThread) (void) { + JNI_STACK_ALIGNMENT_PROLOGUE; + sigset_t sigset; /* Block everything except for SIGSEGV and SIGBUS; those two are diff --git a/src/androidvfs.c b/src/androidvfs.c index 3030bd56cdc..d618e351204 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -6317,6 +6317,8 @@ static sem_t saf_completion_sem; JNIEXPORT jint JNICALL NATIVE_NAME (safSyncAndReadInput) (JNIEnv *env, jobject object) { + JNI_STACK_ALIGNMENT_PROLOGUE; + while (sem_wait (&saf_completion_sem) < 0) { if (input_blocked_p ()) @@ -6338,6 +6340,8 @@ NATIVE_NAME (safSyncAndReadInput) (JNIEnv *env, jobject object) JNIEXPORT void JNICALL NATIVE_NAME (safSync) (JNIEnv *env, jobject object) { + JNI_STACK_ALIGNMENT_PROLOGUE; + while (sem_wait (&saf_completion_sem) < 0) process_pending_signals (); } @@ -6345,12 +6349,16 @@ NATIVE_NAME (safSync) (JNIEnv *env, jobject object) JNIEXPORT void JNICALL NATIVE_NAME (safPostRequest) (JNIEnv *env, jobject object) { + JNI_STACK_ALIGNMENT_PROLOGUE; + sem_post (&saf_completion_sem); } JNIEXPORT jboolean JNICALL NATIVE_NAME (ftruncate) (JNIEnv *env, jobject object, jint fd) { + JNI_STACK_ALIGNMENT_PROLOGUE; + if (ftruncate (fd, 0) < 0) return false; -- cgit v1.2.3 From 6b6761d534259ab4d5409e72754e46af13623dda Mon Sep 17 00:00:00 2001 From: Jörg Bornemann Date: Sat, 17 Feb 2024 21:18:02 +0100 Subject: Recognize functions and macros as defuns in 'cmake-ts-mode' * lisp/progmodes/cmake-ts-mode.el (cmake-ts-mode--function-name): Renamed to 'cmake-ts-mode--defun-name' since the function handles now functions and macros. (cmake-ts-mode--defun-name): Return text of the first 'argument' node below 'function_def' and 'macro_def' nodes. (cmake-ts-mode): Set up treesit-defun-type-regexp and 'treesit-defun-name-function'. Change the imenu setup to recognize macros too. Since we have set up 'treesit-defun-name-function', we don't have to pass 'cmake-ts-mode--function-name' anymore. (Bug#69186) To make `treesit-defun-at-point' work properly, we have to recognize function_def/macro_def nodes, not the lower-level *_command nodes. --- lisp/progmodes/cmake-ts-mode.el | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el index 29c9e957d3c..45c4882d873 100644 --- a/lisp/progmodes/cmake-ts-mode.el +++ b/lisp/progmodes/cmake-ts-mode.el @@ -193,13 +193,13 @@ Check if a node type is available, then return the right font lock rules." '((ERROR) @font-lock-warning-face)) "Tree-sitter font-lock settings for `cmake-ts-mode'.") -(defun cmake-ts-mode--function-name (node) - "Return the function name of NODE. -Return nil if there is no name or if NODE is not a function node." +(defun cmake-ts-mode--defun-name (node) + "Return the defun name of NODE. +Return nil if there is no name or if NODE is not a defun node." (pcase (treesit-node-type node) - ("function_command" + ((or "function_def" "macro_def") (treesit-node-text - (treesit-search-subtree node "^argument$" nil nil 2) + (treesit-search-subtree node "^argument$" nil nil 3) t)))) ;;;###autoload @@ -216,9 +216,15 @@ Return nil if there is no name or if NODE is not a function node." (setq-local comment-end "") (setq-local comment-start-skip (rx "#" (* (syntax whitespace)))) + ;; Defuns. + (setq-local treesit-defun-type-regexp (rx (or "function" "macro") + "_def")) + (setq-local treesit-defun-name-function #'cmake-ts-mode--defun-name) + ;; Imenu. (setq-local treesit-simple-imenu-settings - `(("Function" "\\`function_command\\'" nil cmake-ts-mode--function-name))) + `(("Function" "^function_def$") + ("Macro" "^macro_def$"))) (setq-local which-func-functions nil) ;; Indent. -- cgit v1.2.3 From 70cf4b694b317b367a046b0b03746c56e23fcb91 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 22 Feb 2024 15:15:53 +0200 Subject: ; * etc/PROBLEMS: Describe input lags due to GTK IM (bug#69246). --- etc/PROBLEMS | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 60904408af8..b4df40f5d8e 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -432,7 +432,7 @@ than the corresponding .el file. Alternatively, if you set the option 'load-prefer-newer' non-nil, Emacs will load whichever version of a file is the newest. -*** Watch out for the EMACSLOADPATH environment variable +*** Watch out for the EMACSLOADPATH environment variable. EMACSLOADPATH overrides which directories the function "load" will search. @@ -441,7 +441,7 @@ environment. ** Keyboard problems -*** PGTK build of Emacs running on Wayland doesn't recognize Hyper modifier +*** PGTK build of Emacs running on Wayland doesn't recognize Hyper modifier. If you arrange for the Wayland compositor to send the Hyper key modifier (e.g., via XKB customizations), the Hyper modifier will still @@ -452,6 +452,17 @@ Since GDK 3.x is no longer developed, this bug in GDK will probably never be solved. And the Emacs PGTK build cannot yet support GTK4, where this problem is reportedly solved. +*** Emacs built with GTK lags in its response to keyboard input. +This can happen when input methods are used. It happens because Emacs +behaves in an unconventional way with respect to GTK input methods: it +registers to receive keyboard input as unprocessed key events with +metadata (as opposed to receiving them as text strings). Most GTK +programs use the latter approach, so some modern input methods have +bugs and misbehave when faced with the way Emacs does it. + +A workaround is to set GTK_IM_MODULE=none in the environment, or maybe +find a different input method without these problems. + *** Unable to enter the M-| key on some German keyboards. Some users have reported that M-| suffers from "keyboard ghosting". This can't be fixed by Emacs, as the keypress never gets passed to it -- cgit v1.2.3 From cc58626f643c1b19e66bab9c6a39026c7e419ab9 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 22 Feb 2024 19:38:17 +0200 Subject: * lisp/help-fns.el (describe-mode-outline): New user option (bug#64684). (describe-mode, describe-mode--minor-modes): Use 'describe-mode-outline'. * lisp/help-mode.el (help-setup-xref): After disabling outline-minor-mode also kill all outline-related local variables. So that they won't affect the output of other help commands in the same help buffer. --- etc/NEWS | 4 +++ lisp/help-fns.el | 97 ++++++++++++++++++++++++++++++++++++++----------------- lisp/help-mode.el | 12 ++++++- 3 files changed, 83 insertions(+), 30 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 7b248c3fe78..13b41feccbc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -130,6 +130,10 @@ the signature) the automatically inferred function type as well. This user option controls outline visibility in the output buffer of 'describe-bindings' when 'describe-bindings-outline' is non-nil. +--- +*** 'C-h m' ('describe-mode') uses outlining by default. +Set 'describe-mode-outline' to nil to get back the old behavior. + ** Outline Mode +++ diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 1ba848c107d..15d87f9925c 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -2133,6 +2133,12 @@ keymap value." (when used-gentemp (makunbound keymap)))) +(defcustom describe-mode-outline t + "Non-nil enables outlines in the output buffer of `describe-mode'." + :type 'boolean + :group 'help + :version "30.1") + ;;;###autoload (defun describe-mode (&optional buffer) "Display documentation of current major mode and minor modes. @@ -2145,7 +2151,10 @@ variable \(listed in `minor-mode-alist') must also be a function whose documentation describes the minor mode. If called from Lisp with a non-nil BUFFER argument, display -documentation for the major and minor modes of that buffer." +documentation for the major and minor modes of that buffer. + +When `describe-mode-outline' is non-nil, Outline minor mode +is enabled in the Help buffer." (interactive "@") (unless buffer (setq buffer (current-buffer))) @@ -2159,13 +2168,20 @@ documentation for the major and minor modes of that buffer." (with-current-buffer (help-buffer) ;; Add the local minor modes at the start. (when local-minors - (insert (format "Minor mode%s enabled in this buffer:" - (if (length> local-minors 1) - "s" ""))) + (unless describe-mode-outline + (insert (format "Minor mode%s enabled in this buffer:" + (if (length> local-minors 1) + "s" "")))) (describe-mode--minor-modes local-minors)) ;; Document the major mode. (let ((major (buffer-local-value 'major-mode buffer))) + (when describe-mode-outline + (goto-char (point-min)) + (put-text-property + (point) (progn (insert (format "Major mode %S" major)) (point)) + 'outline-level 1) + (insert "\n\n")) (insert "The major mode is " (buttonize (propertize (format-mode-line @@ -2189,36 +2205,56 @@ documentation for the major and minor modes of that buffer." ;; Insert the global minor modes after the major mode. (when global-minor-modes - (insert (format "Global minor mode%s enabled:" - (if (length> global-minor-modes 1) - "s" ""))) - (describe-mode--minor-modes global-minor-modes) - (when (re-search-forward "^\f") - (beginning-of-line) - (ensure-empty-lines 1))) + (unless describe-mode-outline + (insert (format "Global minor mode%s enabled:" + (if (length> global-minor-modes 1) + "s" "")))) + (describe-mode--minor-modes global-minor-modes t) + (unless describe-mode-outline + (when (re-search-forward "^\f") + (beginning-of-line) + (ensure-empty-lines 1)))) + + (when describe-mode-outline + (setq-local outline-search-function #'outline-search-level) + (setq-local outline-level (lambda () 1)) + (setq-local outline-minor-mode-cycle t + outline-minor-mode-highlight t + outline-minor-mode-use-buttons 'insert) + (outline-minor-mode 1)) + ;; For the sake of IELM and maybe others nil))))) -(defun describe-mode--minor-modes (modes) +(defun describe-mode--minor-modes (modes &optional global) (dolist (mode (seq-sort #'string< modes)) (let ((pretty-minor-mode (capitalize (replace-regexp-in-string "\\(\\(-minor\\)?-mode\\)?\\'" "" (symbol-name mode))))) - (insert - " " - (buttonize - pretty-minor-mode - (lambda (mode) - (goto-char (point-min)) - (text-property-search-forward - 'help-minor-mode mode t) - (beginning-of-line)) - mode)) + (if (not describe-mode-outline) + (insert + " " + (buttonize + pretty-minor-mode + (lambda (mode) + (goto-char (point-min)) + (text-property-search-forward + 'help-minor-mode mode t) + (beginning-of-line)) + mode)) + (goto-char (point-max)) + (put-text-property + (point) (progn (insert (if global "Global" "Local") + (format " minor mode %S" mode)) + (point)) + 'outline-level 1) + (insert "\n\n")) (save-excursion - (goto-char (point-max)) - (insert "\n\n\f\n") + (unless describe-mode-outline + (goto-char (point-max)) + (insert "\n\n\f\n")) ;; Document the minor modes fully. (insert (buttonize (propertize pretty-minor-mode 'help-minor-mode mode) @@ -2232,11 +2268,14 @@ documentation for the major and minor modes of that buffer." (format "indicator%s" indicator))))) (insert (or (help-split-fundoc (documentation mode) nil 'doc) - "No docstring"))))) - (forward-line -1) - (fill-paragraph nil) - (forward-paragraph 1) - (ensure-empty-lines 1)) + "No docstring")) + (when describe-mode-outline + (insert "\n\n"))))) + (unless describe-mode-outline + (forward-line -1) + (fill-paragraph nil) + (forward-paragraph 1) + (ensure-empty-lines 1))) (defun help-fns--list-local-commands () (let ((functions nil)) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 9c405efeee5..f9ec8a5cc2b 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -501,7 +501,17 @@ restore it properly when going back." ;; Disable `outline-minor-mode' in a reused Help buffer ;; created by `describe-bindings' that enables this mode. (when (bound-and-true-p outline-minor-mode) - (outline-minor-mode -1)) + (outline-minor-mode -1) + (mapc #'kill-local-variable + '(outline-search-function + outline-regexp + outline-heading-end-regexp + outline-level + outline-minor-mode-cycle + outline-minor-mode-highlight + outline-minor-mode-use-buttons + outline-default-state + outline-default-rules))) (when help-xref-stack-item (push (cons (point) help-xref-stack-item) help-xref-stack) (setq help-xref-forward-stack nil)) -- cgit v1.2.3 From 58ca91fe0723c861d53375f52e5b6dd54a49a2e3 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 22 Feb 2024 20:40:57 +0100 Subject: * Fix 'parse-colon-path' entry in 'comp-known-type-specifiers' * lisp/emacs-lisp/comp-common.el (comp-known-type-specifiers): Fix 'parse-colon-path'. --- lisp/emacs-lisp/comp-common.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index 6ba9664ea5c..ca21ed05bb4 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -309,7 +309,7 @@ Used to modify the compiler environment." (numberp (function (t) boolean)) (one-window-p (function (&optional t t) boolean)) (overlayp (function (t) boolean)) - (parse-colon-path (function (string) cons)) + (parse-colon-path (function (string) list)) (plist-get (function (list t &optional t) t)) (plist-member (function (list t &optional t) list)) (point (function () integer)) -- cgit v1.2.3 From b868690feff44c7242c942490d1d8bc6d2811fa2 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 23 Feb 2024 10:18:17 +0800 Subject: Fix bug#69140 * src/window.c (grow_mini_window): Don't adjust frame matrices or force redisplay if the provided window cannot be resized. (bug#69140) --- src/window.c | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/window.c b/src/window.c index 565ad00804f..0c84b4f4bf3 100644 --- a/src/window.c +++ b/src/window.c @@ -5380,7 +5380,14 @@ grow_mini_window (struct window *w, int delta) grow = call3 (Qwindow__resize_root_window_vertically, root, make_fixnum (- delta), Qt); - if (FIXNUMP (grow) && window_resize_check (r, false)) + if (FIXNUMP (grow) + /* It might be impossible to resize the window, in which case + calling resize_mini_window_apply will set off an infinite + loop where the redisplay cycle so forced returns to + resize_mini_window, making endless attempts to expand the + minibuffer window to this impossible size. (bug#69140) */ + && XFIXNUM (grow) != 0 + && window_resize_check (r, false)) resize_mini_window_apply (w, -XFIXNUM (grow)); } } -- cgit v1.2.3 From f85280503a3a67e1618069b1c7d6810efa924fe8 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 22 Feb 2024 17:20:58 +0100 Subject: Tone down python-mode warning to a simple message (bug#68559) * lisp/progmodes/python.el (python-shell-completion-native-turn-on-maybe): There is no need for an alarming warning when using an inferior Python without GNU readline; a calm message will do. --- lisp/progmodes/python.el | 17 +++++------------ 1 file changed, 5 insertions(+), 12 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 5501926e69d..bedc61408ef 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4536,18 +4536,11 @@ With argument MSG show activation/deactivation message." ((python-shell-completion-native-setup) (when msg (message "Shell native completion is enabled."))) - (t (lwarn - '(python python-shell-completion-native-turn-on-maybe) - :warning - (concat - "Your `python-shell-interpreter' doesn't seem to " - "support readline, yet `python-shell-completion-native-enable' " - (format "was t and %S is not part of the " - (file-name-nondirectory python-shell-interpreter)) - "`python-shell-completion-native-disabled-interpreters' " - "list. Native completions have been disabled locally. " - "Consider installing the python package \"readline\". ")) - (python-shell-completion-native-turn-off msg)))))) + (t + (when msg + (message (concat "Python does not use GNU readline;" + " no completion in multi-line commands."))) + (python-shell-completion-native-turn-off nil)))))) (defun python-shell-completion-native-turn-on-maybe-with-msg () "Like `python-shell-completion-native-turn-on-maybe' but force messages." -- cgit v1.2.3 From 53e60fb004c0e8b40b01fcfcf7f406557e35aa3e Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 22 Feb 2024 20:15:33 +0100 Subject: * src/fns.c (hash_string): Suppress warning on 32-bit platforms Remove a shift-too-wide complaint by GCC in code that is never reached on platforms where that shift is too wide. --- src/fns.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/fns.c b/src/fns.c index 0a9692f36e8..737757d06cc 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5086,6 +5086,8 @@ hash_string (char const *ptr, ptrdiff_t len) /* String is shorter than an EMACS_UINT. Use smaller loads. */ eassume (p <= end && end - p < sizeof (EMACS_UINT)); EMACS_UINT tail = 0; + verify (sizeof tail <= 8); +#if EMACS_INT_MAX > INT32_MAX if (end - p >= 4) { uint32_t c; @@ -5093,6 +5095,7 @@ hash_string (char const *ptr, ptrdiff_t len) tail = (tail << (8 * sizeof c)) + c; p += sizeof c; } +#endif if (end - p >= 2) { uint16_t c; -- cgit v1.2.3 From 6a53836a245a8154f1f176ce2a787c24aa7409cb Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 23 Feb 2024 11:26:45 +0100 Subject: * src/fns.c (sxhash_bignum): Include sign bit in hash. --- src/fns.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fns.c b/src/fns.c index 737757d06cc..550545d1486 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5193,7 +5193,7 @@ sxhash_bignum (Lisp_Object bignum) { mpz_t const *n = xbignum_val (bignum); size_t i, nlimbs = mpz_size (*n); - EMACS_UINT hash = 0; + EMACS_UINT hash = mpz_sgn(*n) < 0; for (i = 0; i < nlimbs; ++i) hash = sxhash_combine (hash, mpz_getlimbn (*n, i)); -- cgit v1.2.3 From 32843c7b36b8bf3dc9ac82059a1c3cab03cd8c98 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 23 Feb 2024 01:07:46 +0100 Subject: * src/pdumper.c (dump_subr): Rename 'native_comp' -> 'non_primitive'. --- src/pdumper.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/pdumper.c b/src/pdumper.c index 509fb079db7..778d8facabd 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2912,17 +2912,17 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) dump_object_start (ctx, &out, sizeof (out)); DUMP_FIELD_COPY (&out, subr, header.size); #ifdef HAVE_NATIVE_COMP - bool native_comp = !NILP (subr->native_comp_u); + bool non_primitive = !NILP (subr->native_comp_u); #else - bool native_comp = false; + bool non_primitive = false; #endif - if (native_comp) + if (non_primitive) out.function.a0 = NULL; else dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0); DUMP_FIELD_COPY (&out, subr, min_args); DUMP_FIELD_COPY (&out, subr, max_args); - if (native_comp) + if (non_primitive) { dump_field_fixup_later (ctx, &out, subr, &subr->symbol_name); dump_remember_cold_op (ctx, @@ -2947,7 +2947,7 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) dump_field_lv (ctx, &out, subr, &subr->type, WEIGHT_NORMAL); #endif dump_off subr_off = dump_object_finish (ctx, &out, sizeof (out)); - if (native_comp && ctx->flags.dump_object_contents) + if (non_primitive && ctx->flags.dump_object_contents) /* We'll do the final addr relocation during VERY_LATE_RELOCS time after the compilation units has been loaded. */ dump_push (&ctx->dump_relocs[VERY_LATE_RELOCS], -- cgit v1.2.3 From aa82fe9931851e66aa335e96ae35fd967951b281 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 8 Feb 2024 18:23:00 +0100 Subject: Use obarray-make instead of make-vector to create obarrays This prepares for the introduction of an actual obarray type. * lisp/cedet/semantic/lex-spp.el (semantic-lex-spp-dynamic-map) (semantic-lex-spp-dynamic-map-stack, semantic-lex-make-spp-table): * lisp/cedet/semantic/lex.el (semantic-lex-make-keyword-table) (semantic-lex-make-type-table): * lisp/completion.el (cmpl-prefix-obarray, cmpl-obarray) (clear-all-completions): * lisp/emacs-lisp/checkdoc.el (checkdoc-defun-info): * lisp/emacs-lisp/eldoc.el (eldoc-message-commands) (eldoc-edit-message-commands): * lisp/mail/mail-extr.el (mail-extr-all-top-level-domains): * lisp/mail/rmailkwd.el (rmail-label-obarray): * lisp/net/dns.el (dns-cache): * lisp/net/eww.el (eww-suggested-uris): * lisp/net/imap.el (imap-open, imap-mailbox-select-1) (imap-message-copyuid-1, imap-message-appenduid-1): * lisp/obsolete/pgg.el (pgg-passphrase-cache, pgg-pending-timers): * lisp/play/cookie1.el (cookie-cache): * lisp/progmodes/cc-defs.el (c-lang-constants, c-define-lang-constant): * lisp/progmodes/cc-langs.el (c-keywords-obarray): * lisp/vc/vc-hooks.el (vc-file-prop-obarray): * test/lisp/obarray-tests.el (obarrayp-test): * test/src/minibuf-tests.el (minibuf-tests--strings-to-obarray): Use obarray-make instead of obarray-make. --- lisp/cedet/semantic/lex-spp.el | 6 +++--- lisp/cedet/semantic/lex.el | 4 ++-- lisp/completion.el | 8 ++++---- lisp/emacs-lisp/checkdoc.el | 2 +- lisp/emacs-lisp/eldoc.el | 4 ++-- lisp/mail/mail-extr.el | 2 +- lisp/mail/rmailkwd.el | 2 +- lisp/net/dns.el | 2 +- lisp/net/eww.el | 2 +- lisp/net/imap.el | 8 ++++---- lisp/obsolete/pgg.el | 4 ++-- lisp/play/cookie1.el | 2 +- lisp/progmodes/cc-defs.el | 4 ++-- lisp/progmodes/cc-langs.el | 2 +- lisp/vc/vc-hooks.el | 2 +- test/lisp/obarray-tests.el | 3 ++- test/src/minibuf-tests.el | 2 +- 17 files changed, 30 insertions(+), 29 deletions(-) diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index a4be5bf67e2..f63d316c1ac 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -153,13 +153,13 @@ The search priority is: "Return the dynamic macro map for the current buffer." (or semantic-lex-spp-dynamic-macro-symbol-obarray (setq semantic-lex-spp-dynamic-macro-symbol-obarray - (make-vector 13 0)))) + (obarray-make 13)))) (defsubst semantic-lex-spp-dynamic-map-stack () "Return the dynamic macro map for the current buffer." (or semantic-lex-spp-dynamic-macro-symbol-obarray-stack (setq semantic-lex-spp-dynamic-macro-symbol-obarray-stack - (make-vector 13 0)))) + (obarray-make 13)))) (defun semantic-lex-spp-value-valid-p (value) "Return non-nil if VALUE is valid." @@ -260,7 +260,7 @@ NAME is the name of the spp macro symbol to define. REPLACEMENT a string that would be substituted in for NAME." ;; Create the symbol hash table - (let ((semantic-lex-spp-macro-symbol-obarray (make-vector 13 0)) + (let ((semantic-lex-spp-macro-symbol-obarray (obarray-make 13)) spec) ;; fill it with stuff (while specs diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index b32cb96bed9..f3d671ac312 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -259,7 +259,7 @@ If optional argument PROPSPECS is non-nil, then interpret it, and apply those properties. PROPSPECS must be a list of (NAME PROPERTY VALUE) elements." ;; Create the symbol hash table - (let ((semantic-flex-keywords-obarray (make-vector 13 0)) + (let ((semantic-flex-keywords-obarray (obarray-make 13)) spec) ;; fill it with stuff (while specs @@ -416,7 +416,7 @@ If optional argument PROPSPECS is non-nil, then interpret it, and apply those properties. PROPSPECS must be a list of (TYPE PROPERTY VALUE)." ;; Create the symbol hash table - (let* ((semantic-lex-types-obarray (make-vector 13 0)) + (let* ((semantic-lex-types-obarray (obarray-make 13)) spec type tokens token alist default) ;; fill it with stuff (while specs diff --git a/lisp/completion.el b/lisp/completion.el index ab7f2a7bc52..6c758e56eab 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -875,11 +875,11 @@ This is sensitive to `case-fold-search'." ;; GNU implements obarrays (defconst cmpl-obarray-length 511) -(defvar cmpl-prefix-obarray (make-vector cmpl-obarray-length 0) +(defvar cmpl-prefix-obarray (obarray-make cmpl-obarray-length) "An obarray used to store the downcased completion prefixes. Each symbol is bound to a list of completion entries.") -(defvar cmpl-obarray (make-vector cmpl-obarray-length 0) +(defvar cmpl-obarray (obarray-make cmpl-obarray-length) "An obarray used to store the downcased completions. Each symbol is bound to a single completion entry.") @@ -962,8 +962,8 @@ Each symbol is bound to a single completion entry.") (defun clear-all-completions () "Initialize the completion storage. All existing completions are lost." (interactive) - (setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0)) - (setq cmpl-obarray (make-vector cmpl-obarray-length 0))) + (setq cmpl-prefix-obarray (obarray-make cmpl-obarray-length)) + (setq cmpl-obarray (obarray-make cmpl-obarray-length))) (defun list-all-completions () "Return a list of all the known completion entries." diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 82c6c03a592..02c11cae573 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1994,7 +1994,7 @@ from the comment." (defun-depth (ppss-depth (syntax-ppss))) (lst nil) (ret nil) - (oo (make-vector 3 0))) ;substitute obarray for `read' + (oo (obarray-make 3))) ;substitute obarray for `read' (forward-char 1) (forward-sexp 1) (skip-chars-forward " \n\t") diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 912a7357ca7..24afd03fbe6 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -155,7 +155,7 @@ Remember to keep it a prime number to improve hash performance.") (defvar eldoc-message-commands ;; Don't define as `defconst' since it would then go to (read-only) purespace. - (make-vector eldoc-message-commands-table-size 0) + (obarray-make eldoc-message-commands-table-size) "Commands after which it is appropriate to print in the echo area. ElDoc does not try to print function arglists, etc., after just any command, because some commands print their own messages in the echo area and these @@ -191,7 +191,7 @@ It should receive the same arguments as `message'.") When `eldoc-print-after-edit' is non-nil, ElDoc messages are only printed after commands contained in this obarray." - (let ((cmds (make-vector 31 0)) + (let ((cmds (obarray-make 31)) (re (regexp-opt '("delete" "insert" "edit" "electric" "newline")))) (mapatoms (lambda (s) (and (commandp s) diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index 668cae05521..cfdbc1b2509 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -1845,7 +1845,7 @@ place. It affects how `mail-extract-address-components' works." ;; https://en.wikipedia.org/wiki/List_of_Internet_top-level_domains (defconst mail-extr-all-top-level-domains - (let ((ob (make-vector 739 0))) + (let ((ob (obarray-make 739))) (mapc (lambda (x) (put (intern (downcase (car x)) ob) diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el index d9c4cb8cfee..a13c42edb5c 100644 --- a/lisp/mail/rmailkwd.el +++ b/lisp/mail/rmailkwd.el @@ -31,7 +31,7 @@ ;; Global to all RMAIL buffers. It exists for the sake of completion. ;; It is better to use strings with the label functions and let them ;; worry about making the label. -(defvar rmail-label-obarray (make-vector 47 0) +(defvar rmail-label-obarray (obarray-make 47) "Obarray of labels used by Rmail. `rmail-read-label' uses this to offer completion.") diff --git a/lisp/net/dns.el b/lisp/net/dns.el index 23ea88ef4ad..54f4d227a49 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el @@ -359,7 +359,7 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"." result)) ;;; Interface functions. -(defvar dns-cache (make-vector 4096 0)) +(defvar dns-cache (obarray-make 4096)) (defun dns-query-cached (name &optional type fullp reversep) (let* ((key (format "%s:%s:%s:%s" name type fullp reversep)) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 6ae1e6d3d0a..5a25eef9e3c 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -340,7 +340,7 @@ parameter, and should return the (possibly) transformed URL." (defun eww-suggested-uris nil "Return the list of URIs to suggest at the `eww' prompt. This list can be customized via `eww-suggest-uris'." - (let ((obseen (make-vector 42 0)) + (let ((obseen (obarray-make 42)) (uris nil)) (dolist (fun eww-suggest-uris) (let ((ret (funcall fun))) diff --git a/lisp/net/imap.el b/lisp/net/imap.el index f10b5b8fc12..a06740528e9 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -1057,7 +1057,7 @@ necessary. If nil, the buffer name is generated." (setq imap-capability nil) (setq streams nil)))))) (when (imap-opened buffer) - (setq imap-mailbox-data (make-vector imap-mailbox-prime 0))) + (setq imap-mailbox-data (obarray-make imap-mailbox-prime))) ;; (debug "opened+state+auth+buffer" (imap-opened buffer) imap-state imap-auth buffer) (when imap-stream buffer)))) @@ -1280,7 +1280,7 @@ If EXAMINE is non-nil, do a read-only select." (concat (if examine "EXAMINE" "SELECT") " \"" mailbox "\""))) (progn - (setq imap-message-data (make-vector imap-message-prime 0) + (setq imap-message-data (obarray-make imap-message-prime) imap-state (if examine 'examine 'selected)) imap-current-mailbox) ;; Failed SELECT/EXAMINE unselects current mailbox @@ -1722,7 +1722,7 @@ See `imap-enable-exchange-bug-workaround'." (string-to-number (nth 2 (imap-mailbox-get-1 'copyuid mailbox)))) (let ((old-mailbox imap-current-mailbox) (state imap-state) - (imap-message-data (make-vector 2 0))) + (imap-message-data (obarray-make 2))) (when (imap-mailbox-examine-1 mailbox) (prog1 (and (imap-fetch-safe '("*" . "*:*") "UID") @@ -1768,7 +1768,7 @@ first element. The rest of list contains the saved articles' UIDs." (imap-mailbox-get-1 'appenduid mailbox) (let ((old-mailbox imap-current-mailbox) (state imap-state) - (imap-message-data (make-vector 2 0))) + (imap-message-data (obarray-make 2))) (when (imap-mailbox-examine-1 mailbox) (prog1 (and (imap-fetch-safe '("*" . "*:*") "UID") diff --git a/lisp/obsolete/pgg.el b/lisp/obsolete/pgg.el index 6c00ad201f1..4c7b653155e 100644 --- a/lisp/obsolete/pgg.el +++ b/lisp/obsolete/pgg.el @@ -85,9 +85,9 @@ is true, or else the output buffer is displayed." (set-buffer standard-output) (insert-buffer-substring pgg-errors-buffer)))) -(defvar pgg-passphrase-cache (make-vector 7 0)) +(defvar pgg-passphrase-cache (obarray-make 7)) -(defvar pgg-pending-timers (make-vector 7 0) +(defvar pgg-pending-timers (obarray-make 7) "Hash table for managing scheduled pgg cache management timers. We associate key and timer, so the timer can be canceled if a new diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el index c8e9d097a5f..c4697a0d3b9 100644 --- a/lisp/play/cookie1.el +++ b/lisp/play/cookie1.el @@ -65,7 +65,7 @@ (defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0" "Delimiter used to separate cookie file entries.") -(defvar cookie-cache (make-vector 511 0) +(defvar cookie-cache (obarray-make 511) "Cache of cookie files that have already been snarfed.") (defun cookie-check-file (file) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index f84d95dbc94..e45ab76ec07 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -2425,7 +2425,7 @@ system." (error "Unknown base mode `%s'" base-mode)) (put mode 'c-fallback-mode base-mode)) -(defvar c-lang-constants (make-vector 151 0)) +(defvar c-lang-constants (obarray-make 151)) ;; Obarray used as a cache to keep track of the language constants. ;; The constants stored are those defined by `c-lang-defconst' and the values ;; computed by `c-lang-const'. It's mostly used at compile time but it's not @@ -2630,7 +2630,7 @@ constant. A file is identified by its base name." ;; Clear the evaluated values that depend on this source. (let ((agenda (get sym 'dependents)) - (visited (make-vector 101 0)) + (visited (obarray-make 101)) ptr) (while agenda (setq sym (car agenda) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index ba0d1d0fc49..ae2389c75c2 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -3511,7 +3511,7 @@ Note that Java specific rules are currently applied to tell this from (let* ((alist (c-lang-const c-keyword-member-alist)) kwd lang-const-list - (obarray (make-vector (* (length alist) 2) 0))) + (obarray (obarray-make (* (length alist) 2)))) (while alist (setq kwd (caar alist) lang-const-list (cdar alist) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 1493845e2d9..a95cc732dab 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -197,7 +197,7 @@ VC commands are globally reachable under the prefix \\[vc-prefix-map]: ;; during any subsequent VC operations, and forget them when ;; the buffer is killed. -(defvar vc-file-prop-obarray (make-vector 17 0) +(defvar vc-file-prop-obarray (obarray-make 17) "Obarray for per-file properties.") (defvar vc-touched-properties nil) diff --git a/test/lisp/obarray-tests.el b/test/lisp/obarray-tests.el index d7e547fcf29..dd8f1c8abd4 100644 --- a/test/lisp/obarray-tests.el +++ b/test/lisp/obarray-tests.el @@ -32,7 +32,8 @@ (should-not (obarrayp "aoeu")) (should-not (obarrayp '())) (should-not (obarrayp [])) - (should (obarrayp (make-vector 7 0)))) + (should (obarrayp (obarray-make 7))) + (should (obarrayp (make-vector 7 0)))) ; for compatibility? (ert-deftest obarrayp-unchecked-content-test () "Should fail to check content of passed obarray." diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el index cb305ca0e55..99d522d1856 100644 --- a/test/src/minibuf-tests.el +++ b/test/src/minibuf-tests.el @@ -34,7 +34,7 @@ (let ((num 0)) (mapcar (lambda (str) (cons str (cl-incf num))) list))) (defun minibuf-tests--strings-to-obarray (list) - (let ((ob (make-vector 7 0))) + (let ((ob (obarray-make 7))) (mapc (lambda (str) (intern str ob)) list) ob)) (defun minibuf-tests--strings-to-string-hashtable (list) -- cgit v1.2.3 From 3beaa3131e78bea618cb93d03c5d8b0f8977fb94 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 10 Feb 2024 20:59:42 +0100 Subject: Use obarrayp, not vectorp, to detect obarrays * lisp/abbrev.el (abbrev--active-tables): * lisp/mail/mailabbrev.el (mail-abbrevs-setup, build-mail-abbrevs) (define-mail-abbrev, mail-resolve-all-aliases) (mail-abbrev-insert-alias): * lisp/mail/rmail.el (rmail-resend): * lisp/minibuffer.el (completion-table-with-context): * lisp/progmodes/etags.el (etags-tags-apropos-additional): (etags--xref-apropos-additional): Use obarrayp as predicate for obarrays. --- lisp/abbrev.el | 2 +- lisp/mail/mailabbrev.el | 12 ++++++------ lisp/mail/rmail.el | 2 +- lisp/minibuffer.el | 2 +- lisp/progmodes/etags.el | 4 ++-- 5 files changed, 11 insertions(+), 11 deletions(-) diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 2bd9faad69d..b523977fed5 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -721,7 +721,7 @@ either a single abbrev table or a list of abbrev tables." ;; to treat the distinction between a single table and a list of tables. (cond ((consp tables) tables) - ((vectorp tables) (list tables)) + ((obarrayp tables) (list tables)) (t (let ((tables (if (listp local-abbrev-table) (append local-abbrev-table diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el index 68d325ea261..c8006294a7d 100644 --- a/lisp/mail/mailabbrev.el +++ b/lisp/mail/mailabbrev.el @@ -171,7 +171,7 @@ no aliases, which is represented by this being a table with no entries.)") ;;;###autoload (defun mail-abbrevs-setup () "Initialize use of the `mailabbrev' package." - (if (and (not (vectorp mail-abbrevs)) + (if (and (not (obarrayp mail-abbrevs)) (file-exists-p mail-personal-alias-file)) (progn (setq mail-abbrev-modtime @@ -196,7 +196,7 @@ no aliases, which is represented by this being a table with no entries.)") "Read mail aliases from personal mail alias file and set `mail-abbrevs'. By default this is the file specified by `mail-personal-alias-file'." (setq file (expand-file-name (or file mail-personal-alias-file))) - (if (vectorp mail-abbrevs) + (if (obarrayp mail-abbrevs) nil (setq mail-abbrevs nil) (define-abbrev-table 'mail-abbrevs '())) @@ -278,7 +278,7 @@ double-quotes." ;; true, and we do some evil space->comma hacking like /bin/mail does. (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ") ;; Read the defaults first, if we have not done so. - (unless (vectorp mail-abbrevs) (build-mail-abbrevs)) + (unless (obarrayp mail-abbrevs) (build-mail-abbrevs)) ;; strip garbage from front and end (if (string-match "\\`[ \t\n,]+" definition) (setq definition (substring definition (match-end 0)))) @@ -355,7 +355,7 @@ double-quotes." (if mail-abbrev-aliases-need-to-be-resolved (progn ;; (message "Resolving mail aliases...") - (if (vectorp mail-abbrevs) + (if (obarrayp mail-abbrevs) (mapatoms (function mail-resolve-all-aliases-1) mail-abbrevs)) (setq mail-abbrev-aliases-need-to-be-resolved nil) ;; (message "Resolving mail aliases... done.") @@ -555,9 +555,9 @@ of a mail alias. The value is set up, buffer-local, when first needed.") (defun mail-abbrev-insert-alias (&optional alias) "Prompt for and insert a mail alias." (interactive (progn - (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup)) + (if (not (obarrayp mail-abbrevs)) (mail-abbrevs-setup)) (list (completing-read "Expand alias: " mail-abbrevs nil t)))) - (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup)) + (if (not (obarrayp mail-abbrevs)) (mail-abbrevs-setup)) (insert (or (and alias (symbol-value (intern-soft alias mail-abbrevs))) "")) (mail-abbrev-expand-hook)) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 85eaec33660..6f343c23bbe 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4097,7 +4097,7 @@ typically for purposes of moderating a list." (let ((end (point-marker)) (local-abbrev-table mail-abbrevs) (old-syntax-table (syntax-table))) - (if (and (not (vectorp mail-abbrevs)) + (if (and (not (obarrayp mail-abbrevs)) (file-exists-p mail-personal-alias-file)) (build-mail-abbrevs)) (unless mail-abbrev-syntax-table diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 708f3684d11..099fa1599d5 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -321,7 +321,7 @@ the form (concat S2 S)." ;; Predicates are called differently depending on the nature of ;; the completion table :-( (cond - ((vectorp table) ;Obarray. + ((obarrayp table) (lambda (sym) (funcall pred (concat prefix (symbol-name sym))))) ((hash-table-p table) (lambda (s _v) (funcall pred (concat prefix s)))) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index b9bd772ddfc..476037eb8bd 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1488,7 +1488,7 @@ hits the start of file." (setq symbs (symbol-value symbs)) (insert (format-message "symbol `%s' has no value\n" symbs)) (setq symbs nil))) - (if (vectorp symbs) + (if (obarrayp symbs) (mapatoms ins-symb symbs) (dolist (sy symbs) (funcall ins-symb (car sy)))) @@ -2183,7 +2183,7 @@ file name, add `tag-partial-file-name-match-p' to the list value.") (setq symbs (symbol-value symbs)) (warn "symbol `%s' has no value" symbs) (setq symbs nil)) - (if (vectorp symbs) + (if (obarrayp symbs) (mapatoms add-xref symbs) (dolist (sy symbs) (funcall add-xref (car sy)))) -- cgit v1.2.3 From 6a182658a533acab94d8fa0aec3e2b7a4f7d6a93 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 11 Feb 2024 18:30:22 +0100 Subject: Add obarray-clear and use it * lisp/obarray.el (obarray-clear): New. * lisp/abbrev.el (clear-abbrev-table): * lisp/vc/vc.el (vc-clear-context): Use it instead of assuming the obarray is a vector that can be 0-filled. * test/lisp/obarray-tests.el (obarray-clear): New test. --- lisp/abbrev.el | 3 +-- lisp/obarray.el | 5 +++++ lisp/vc/vc.el | 2 +- test/lisp/obarray-tests.el | 10 ++++++++++ 4 files changed, 17 insertions(+), 3 deletions(-) diff --git a/lisp/abbrev.el b/lisp/abbrev.el index b523977fed5..188eeb720c0 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -602,8 +602,7 @@ It is nil if the abbrev has already been unexpanded.") "Undefine all abbrevs in abbrev table TABLE, leaving TABLE empty." (setq abbrevs-changed t) (let* ((sym (obarray-get table ""))) - (dotimes (i (length table)) - (aset table i 0)) + (obarray-clear table) ;; Preserve the table's properties. (cl-assert sym) (let ((newsym (obarray-put table ""))) diff --git a/lisp/obarray.el b/lisp/obarray.el index a26992df8e2..e1ebb2ade51 100644 --- a/lisp/obarray.el +++ b/lisp/obarray.el @@ -66,5 +66,10 @@ Return t on success, nil otherwise." "Call function FN on every symbol in obarray OB and return nil." (mapatoms fn ob)) +(defun obarray-clear (ob) + "Remove all symbols from obarray OB." + ;; FIXME: This doesn't change the symbols to uninterned status. + (fillarray ob 0)) + (provide 'obarray) ;;; obarray.el ends here diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 619b469bebb..3cd17276fa4 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -935,7 +935,7 @@ is sensitive to blank lines." (defun vc-clear-context () "Clear all cached file properties." (interactive) - (fillarray vc-file-prop-obarray 0)) + (obarray-clear vc-file-prop-obarray)) (defmacro with-vc-properties (files form settings) "Execute FORM, then maybe set per-file properties for FILES. diff --git a/test/lisp/obarray-tests.el b/test/lisp/obarray-tests.el index dd8f1c8abd4..dd40d0f4d76 100644 --- a/test/lisp/obarray-tests.el +++ b/test/lisp/obarray-tests.el @@ -89,5 +89,15 @@ (obarray-map collect-names table) (should (equal (sort syms #'string<) '("a" "b" "c"))))) +(ert-deftest obarray-clear () + (let ((o (obarray-make))) + (intern "a" o) + (intern "b" o) + (intern "c" o) + (obarray-clear o) + (let ((n 0)) + (mapatoms (lambda (_) (setq n (1+ n))) o) + (should (equal n 0))))) + (provide 'obarray-tests) ;;; obarray-tests.el ends here -- cgit v1.2.3 From 462d8ba813e07a25b71f5c1b38810a29e21f784c Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 10 Feb 2024 21:14:09 +0100 Subject: Add a proper type for obarrays The new opaque type replaces the previous use of vectors for obarrays. `obarray-make` now returns objects of this type. Functions that take obarrays continue to accept vectors for compatibility, now just using their first slot to store an actual obarray object. obarray-size and obarray-default-size now obsolete. * lisp/obarray.el (obarray-default-size, obarray-size): Declare obsolete. (obarray-make, obarrayp, obarray-clear): Remove from here. * src/fns.c (reduce_emacs_uint_to_hash_hash): Remove from here. * src/lisp.h (struct Lisp_Obarray, OBARRAYP, XOBARRAY, CHECK_OBARRAY) (make_lisp_obarray, obarray_size, check_obarray) (obarray_iter_t, make_obarray_iter, obarray_iter_at_end) (obarray_iter_step, obarray_iter_symbol, DOOBARRAY, knuth_hash): New. (reduce_emacs_uint_to_hash_hash): Moved here. * src/lread.c (check_obarray): Renamed and reworked as... (checked_obarray_slow): ...this. (intern_sym, Funintern, oblookup, map_obarray) (Finternal__obarray_buckets): Adapt to new type. (obarray_index, allocate_obarray, make_obarray, grow_obarray) (obarray_default_bits, Fobarray_make, Fobarrayp, Fobarray_clear): New. * etc/emacs_lldb.py (Lisp_Object): * lisp/emacs-lisp/cl-macs.el (`(,type . ,pred)): * lisp/emacs-lisp/cl-preloaded.el (cl--typeof-types): * lisp/emacs-lisp/comp-common.el (comp-known-type-specifiers): * lisp/emacs-lisp/comp.el (comp-known-predicates): * src/alloc.c (cleanup_vector, process_mark_stack): * src/data.c (Ftype_of, syms_of_data): * src/minibuf.c (Ftry_completion, Fall_completions, Ftest_completion): * src/pdumper.c (dump_obarray_buckets, dump_obarray, dump_vectorlike): * src/print.c (print_vectorlike_unreadable): * test/lisp/abbrev-tests.el (abbrev-make-abbrev-table-test): * test/lisp/obarray-tests.el (obarrayp-test) (obarrayp-unchecked-content-test, obarray-make-default-test) (obarray-make-with-size-test): Adapt to new type. --- etc/emacs_lldb.py | 1 + lisp/emacs-lisp/cl-macs.el | 1 + lisp/emacs-lisp/cl-preloaded.el | 2 +- lisp/emacs-lisp/comp-common.el | 3 +- lisp/emacs-lisp/comp.el | 1 + lisp/emacs-lisp/shortdoc.el | 19 ++- lisp/obarray.el | 27 +--- src/alloc.c | 26 +++- src/data.c | 2 + src/fns.c | 17 +-- src/lisp.h | 136 +++++++++++++++++- src/lread.c | 297 ++++++++++++++++++++++++++++------------ src/minibuf.c | 110 +++++---------- src/pdumper.c | 47 +++++++ src/print.c | 10 ++ test/lisp/abbrev-tests.el | 4 +- test/lisp/obarray-tests.el | 22 +-- 17 files changed, 499 insertions(+), 226 deletions(-) diff --git a/etc/emacs_lldb.py b/etc/emacs_lldb.py index fdf4314e2d0..9865fe391a2 100644 --- a/etc/emacs_lldb.py +++ b/etc/emacs_lldb.py @@ -56,6 +56,7 @@ class Lisp_Object: "PVEC_BOOL_VECTOR": "struct Lisp_Bool_Vector", "PVEC_BUFFER": "struct buffer", "PVEC_HASH_TABLE": "struct Lisp_Hash_Table", + "PVEC_OBARRAY": "struct Lisp_Obarray", "PVEC_TERMINAL": "struct terminal", "PVEC_WINDOW_CONFIGURATION": "struct save_window_data", "PVEC_SUBR": "struct Lisp_Subr", diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 44ebadeebff..ddc9775bcce 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3488,6 +3488,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." (natnum . natnump) (number . numberp) (null . null) + (obarray . obarrayp) (overlay . overlayp) (process . processp) (real . numberp) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index d533eea9e73..840219c2260 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -73,7 +73,7 @@ (module-function function atom) (buffer atom) (char-table array sequence atom) (bool-vector array sequence atom) - (frame atom) (hash-table atom) (terminal atom) + (frame atom) (hash-table atom) (terminal atom) (obarray atom) (thread atom) (mutex atom) (condvar atom) (font-spec atom) (font-entity atom) (font-object atom) (vector array sequence atom) diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index ca21ed05bb4..221f819e474 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -240,7 +240,8 @@ Used to modify the compiler environment." (integer-or-marker-p (function (t) boolean)) (integerp (function (t) boolean)) (interactive-p (function () boolean)) - (intern-soft (function ((or string symbol) &optional vector) symbol)) + (intern-soft (function ((or string symbol) &optional (or obarray vector)) + symbol)) (invocation-directory (function () string)) (invocation-name (function () string)) (isnan (function (float) boolean)) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index e0da01bcc5d..ae964b041d0 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -214,6 +214,7 @@ Useful to hook into pass checkers.") (number-or-marker-p . number-or-marker) (numberp . number) (numberp . number) + (obarrayp . obarray) (overlayp . overlay) (processp . process) (sequencep . sequence) diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index cde28985cd0..cbb5618ffce 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -747,9 +747,13 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), (intern :eval (intern "abc")) (intern-soft + :eval (intern-soft "list") :eval (intern-soft "Phooey!")) (make-symbol :eval (make-symbol "abc")) + (gensym + :no-eval (gensym) + :eg-result g37) "Comparing symbols" (eq :eval (eq 'abc 'abc) @@ -760,7 +764,20 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (equal 'abc 'abc)) "Name" (symbol-name - :eval (symbol-name 'abc))) + :eval (symbol-name 'abc)) + "Obarrays" + (obarray-make + :eval (obarray-make)) + (obarrayp + :eval (obarrayp (obarray-make)) + :eval (obarrayp nil)) + (unintern + :no-eval (unintern "abc" my-obarray) + :eg-result t) + (mapatoms + :no-eval (mapatoms (lambda (symbol) (print symbol)) my-obarray)) + (obarray-clear + :no-eval (obarray-clear my-obarray))) (define-short-documentation-group comparison "General-purpose" diff --git a/lisp/obarray.el b/lisp/obarray.el index e1ebb2ade51..e6e51c1382a 100644 --- a/lisp/obarray.el +++ b/lisp/obarray.el @@ -27,24 +27,12 @@ ;;; Code: -(defconst obarray-default-size 59 - "The value 59 is an arbitrary prime number that gives a good hash.") +(defconst obarray-default-size 4) +(make-obsolete-variable 'obarray-default-size + "obarrays now grow automatically" "30.1") -(defun obarray-make (&optional size) - "Return a new obarray of size SIZE or `obarray-default-size'." - (let ((size (or size obarray-default-size))) - (if (< 0 size) - (make-vector size 0) - (signal 'wrong-type-argument '(size 0))))) - -(defun obarray-size (ob) - "Return the number of slots of obarray OB." - (length ob)) - -(defun obarrayp (object) - "Return t if OBJECT is an obarray." - (and (vectorp object) - (< 0 (length object)))) +(defun obarray-size (_ob) obarray-default-size) +(make-obsolete 'obarray-size "obarrays now grow automatically" "30.1") ;; Don’t use obarray as a variable name to avoid shadowing. (defun obarray-get (ob name) @@ -66,10 +54,5 @@ Return t on success, nil otherwise." "Call function FN on every symbol in obarray OB and return nil." (mapatoms fn ob)) -(defun obarray-clear (ob) - "Remove all symbols from obarray OB." - ;; FIXME: This doesn't change the symbols to uninterned status. - (fillarray ob 0)) - (provide 'obarray) ;;; obarray.el ends here diff --git a/src/alloc.c b/src/alloc.c index 8c94c7eb33c..2ffd2415447 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -360,13 +360,13 @@ static struct gcstat object_ct total_intervals, total_free_intervals; object_ct total_buffers; - /* Size of the ancillary arrays of live hash-table objects. + /* Size of the ancillary arrays of live hash-table and obarray objects. The objects themselves are not included (counted as vectors above). */ byte_ct total_hash_table_bytes; } gcstat; -/* Total size of ancillary arrays of all allocated hash-table objects, - both dead and alive. This number is always kept up-to-date. */ +/* Total size of ancillary arrays of all allocated hash-table and obarray + objects, both dead and alive. This number is always kept up-to-date. */ static ptrdiff_t hash_table_allocated_bytes = 0; /* Points to memory space allocated as "spare", to be freed if we run @@ -3455,6 +3455,15 @@ cleanup_vector (struct Lisp_Vector *vector) hash_table_allocated_bytes -= bytes; } } + break; + case PVEC_OBARRAY: + { + struct Lisp_Obarray *o = PSEUDOVEC_STRUCT (vector, Lisp_Obarray); + xfree (o->buckets); + ptrdiff_t bytes = obarray_size (o) * sizeof *o->buckets; + hash_table_allocated_bytes -= bytes; + } + break; /* Keep the switch exhaustive. */ case PVEC_NORMAL_VECTOR: case PVEC_FREE: @@ -5632,7 +5641,8 @@ valid_lisp_object_p (Lisp_Object obj) return 0; } -/* Like xmalloc, but makes allocation count toward the total consing. +/* Like xmalloc, but makes allocation count toward the total consing + and hash table or obarray usage. Return NULL for a zero-sized allocation. */ void * hash_table_alloc_bytes (ptrdiff_t nbytes) @@ -7310,6 +7320,14 @@ process_mark_stack (ptrdiff_t base_sp) break; } + case PVEC_OBARRAY: + { + struct Lisp_Obarray *o = (struct Lisp_Obarray *)ptr; + set_vector_marked (ptr); + mark_stack_push_values (o->buckets, obarray_size (o)); + break; + } + case PVEC_CHAR_TABLE: case PVEC_SUB_CHAR_TABLE: mark_char_table (ptr, (enum pvec_type) pvectype); diff --git a/src/data.c b/src/data.c index f2f35fb355a..bb4cdd62d66 100644 --- a/src/data.c +++ b/src/data.c @@ -231,6 +231,7 @@ for example, (type-of 1) returns `integer'. */) case PVEC_BOOL_VECTOR: return Qbool_vector; case PVEC_FRAME: return Qframe; case PVEC_HASH_TABLE: return Qhash_table; + case PVEC_OBARRAY: return Qobarray; case PVEC_FONT: if (FONT_SPEC_P (object)) return Qfont_spec; @@ -4229,6 +4230,7 @@ syms_of_data (void) DEFSYM (Qtreesit_parser, "treesit-parser"); DEFSYM (Qtreesit_node, "treesit-node"); DEFSYM (Qtreesit_compiled_query, "treesit-compiled-query"); + DEFSYM (Qobarray, "obarray"); DEFSYM (Qdefun, "defun"); diff --git a/src/fns.c b/src/fns.c index 550545d1486..0a64e515402 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4450,16 +4450,6 @@ cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2, return hash_table_user_defined_call (ARRAYELTS (args), args, h); } -/* Reduce an EMACS_UINT hash value to hash_hash_t. */ -static inline hash_hash_t -reduce_emacs_uint_to_hash_hash (EMACS_UINT x) -{ - verify (sizeof x <= 2 * sizeof (hash_hash_t)); - return (sizeof x == sizeof (hash_hash_t) - ? x - : x ^ (x >> (8 * (sizeof x - sizeof (hash_hash_t))))); -} - static EMACS_INT sxhash_eq (Lisp_Object key) { @@ -4645,16 +4635,11 @@ copy_hash_table (struct Lisp_Hash_Table *h1) return make_lisp_hash_table (h2); } - /* Compute index into the index vector from a hash value. */ static inline ptrdiff_t hash_index_index (struct Lisp_Hash_Table *h, hash_hash_t hash) { - /* Knuth multiplicative hashing, tailored for 32-bit indices - (avoiding a 64-bit multiply). */ - uint32_t alpha = 2654435769; /* 2**32/phi */ - /* Note the cast to uint64_t, to make it work for index_bits=0. */ - return (uint64_t)((uint32_t)hash * alpha) >> (32 - h->index_bits); + return knuth_hash (hash, h->index_bits); } /* Resize hash table H if it's too full. If H cannot be resized diff --git a/src/lisp.h b/src/lisp.h index b02466390f1..5fbbef80e8e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1032,6 +1032,7 @@ enum pvec_type PVEC_BOOL_VECTOR, PVEC_BUFFER, PVEC_HASH_TABLE, + PVEC_OBARRAY, PVEC_TERMINAL, PVEC_WINDOW_CONFIGURATION, PVEC_SUBR, @@ -2386,6 +2387,118 @@ INLINE int definition is done by lread.c's define_symbol. */ #define DEFSYM(sym, name) /* empty */ + +struct Lisp_Obarray +{ + union vectorlike_header header; + + /* Array of 2**size_bits values, each being either a (bare) symbol or + the fixnum 0. The symbols for each bucket are chained via + their s.next field. */ + Lisp_Object *buckets; + + unsigned size_bits; /* log2(size of buckets vector) */ + unsigned count; /* number of symbols in obarray */ +}; + +INLINE bool +OBARRAYP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_OBARRAY); +} + +INLINE struct Lisp_Obarray * +XOBARRAY (Lisp_Object a) +{ + eassert (OBARRAYP (a)); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Obarray); +} + +INLINE void +CHECK_OBARRAY (Lisp_Object x) +{ + CHECK_TYPE (OBARRAYP (x), Qobarrayp, x); +} + +INLINE Lisp_Object +make_lisp_obarray (struct Lisp_Obarray *o) +{ + eassert (PSEUDOVECTOR_TYPEP (&o->header, PVEC_OBARRAY)); + return make_lisp_ptr (o, Lisp_Vectorlike); +} + +INLINE ptrdiff_t +obarray_size (const struct Lisp_Obarray *o) +{ + return (ptrdiff_t)1 << o->size_bits; +} + +Lisp_Object check_obarray_slow (Lisp_Object); + +/* Return an obarray object from OBARRAY or signal an error. */ +INLINE Lisp_Object +check_obarray (Lisp_Object obarray) +{ + return OBARRAYP (obarray) ? obarray : check_obarray_slow (obarray); +} + +/* Obarray iterator state. Don't access these members directly. + The iterator functions must be called in the order followed by DOOBARRAY. */ +typedef struct { + struct Lisp_Obarray *o; + ptrdiff_t idx; /* Current bucket index. */ + struct Lisp_Symbol *symbol; /* Current symbol, or NULL if at end + of current bucket. */ +} obarray_iter_t; + +INLINE obarray_iter_t +make_obarray_iter (struct Lisp_Obarray *oa) +{ + return (obarray_iter_t){.o = oa, .idx = -1, .symbol = NULL}; +} + +/* Whether IT has reached the end and there are no more symbols. + If true, IT is dead and cannot be used any more. */ +INLINE bool +obarray_iter_at_end (obarray_iter_t *it) +{ + if (it->symbol) + return false; + ptrdiff_t size = obarray_size (it->o); + while (++it->idx < size) + { + Lisp_Object obj = it->o->buckets[it->idx]; + if (!BASE_EQ (obj, make_fixnum (0))) + { + it->symbol = XBARE_SYMBOL (obj); + return false; + } + } + return true; +} + +/* Advance IT to the next symbol if any. */ +INLINE void +obarray_iter_step (obarray_iter_t *it) +{ + it->symbol = it->symbol->u.s.next; +} + +/* The Lisp symbol at IT, if obarray_iter_at_end returned false. */ +INLINE Lisp_Object +obarray_iter_symbol (obarray_iter_t *it) +{ + return make_lisp_symbol (it->symbol); +} + +/* Iterate IT over the symbols of the obarray OA. + The body shouldn't add or remove symbols in OA, but disobeying that rule + only risks symbols to be iterated more than once or not at all, + not crashes or data corruption. */ +#define DOOBARRAY(oa, it) \ + for (obarray_iter_t it = make_obarray_iter (oa); \ + !obarray_iter_at_end (&it); obarray_iter_step (&it)) + /*********************************************************************** Hash Tables @@ -2666,6 +2779,28 @@ SXHASH_REDUCE (EMACS_UINT x) return (x ^ x >> (EMACS_INT_WIDTH - FIXNUM_BITS)) & INTMASK; } +/* Reduce an EMACS_UINT hash value to hash_hash_t. */ +INLINE hash_hash_t +reduce_emacs_uint_to_hash_hash (EMACS_UINT x) +{ + verify (sizeof x <= 2 * sizeof (hash_hash_t)); + return (sizeof x == sizeof (hash_hash_t) + ? x + : x ^ (x >> (8 * (sizeof x - sizeof (hash_hash_t))))); +} + +/* Reduce HASH to a value BITS wide. */ +INLINE ptrdiff_t +knuth_hash (hash_hash_t hash, unsigned bits) +{ + /* Knuth multiplicative hashing, tailored for 32-bit indices + (avoiding a 64-bit multiply). */ + uint32_t alpha = 2654435769; /* 2**32/phi */ + /* Note the cast to uint64_t, to make it work for bits=0. */ + return (uint64_t)((uint32_t)hash * alpha) >> (32 - bits); +} + + struct Lisp_Marker { union vectorlike_header header; @@ -4585,7 +4720,6 @@ extern ptrdiff_t evxprintf (char **, ptrdiff_t *, char *, ptrdiff_t, ATTRIBUTE_FORMAT_PRINTF (5, 0); /* Defined in lread.c. */ -extern Lisp_Object check_obarray (Lisp_Object); extern Lisp_Object intern_1 (const char *, ptrdiff_t); extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t); extern Lisp_Object intern_driver (Lisp_Object, Lisp_Object, Lisp_Object); diff --git a/src/lread.c b/src/lread.c index c11c641440d..c4a34c5d73f 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4886,30 +4886,43 @@ static Lisp_Object initial_obarray; static size_t oblookup_last_bucket_number; -/* Get an error if OBARRAY is not an obarray. - If it is one, return it. */ +static Lisp_Object make_obarray (unsigned bits); +/* Slow path obarray check: return the obarray to use or signal an error. */ Lisp_Object -check_obarray (Lisp_Object obarray) +check_obarray_slow (Lisp_Object obarray) { - /* We don't want to signal a wrong-type-argument error when we are - shutting down due to a fatal error, and we don't want to hit - assertions in VECTORP and ASIZE if the fatal error was during GC. */ - if (!fatal_error_in_progress - && (!VECTORP (obarray) || ASIZE (obarray) == 0)) + /* For compatibility, we accept vectors whose first element is 0, + and store an obarray object there. */ + if (VECTORP (obarray) && ASIZE (obarray) > 0) { - /* If Vobarray is now invalid, force it to be valid. */ - if (EQ (Vobarray, obarray)) Vobarray = initial_obarray; - wrong_type_argument (Qvectorp, obarray); + Lisp_Object obj = AREF (obarray, 0); + if (OBARRAYP (obj)) + return obj; + if (BASE_EQ (obj, make_fixnum (0))) + { + /* Put an actual obarray object in the first slot. + The rest of the vector remains unused. */ + obj = make_obarray (0); + ASET (obarray, 0, obj); + return obj; + } } - return obarray; + /* Reset Vobarray to the standard obarray for nicer error handling. */ + if (BASE_EQ (Vobarray, obarray)) Vobarray = initial_obarray; + + wrong_type_argument (Qobarrayp, obarray); } +static void grow_obarray (struct Lisp_Obarray *o); + /* Intern symbol SYM in OBARRAY using bucket INDEX. */ +/* FIXME: retype arguments as pure C types */ static Lisp_Object intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) { + eassert (BARE_SYMBOL_P (sym) && OBARRAYP (obarray) && FIXNUMP (index)); struct Lisp_Symbol *s = XBARE_SYMBOL (sym); s->u.s.interned = (BASE_EQ (obarray, initial_obarray) ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY @@ -4925,9 +4938,13 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) SET_SYMBOL_VAL (s, sym); } - Lisp_Object *ptr = aref_addr (obarray, XFIXNUM (index)); + struct Lisp_Obarray *o = XOBARRAY (obarray); + Lisp_Object *ptr = o->buckets + XFIXNUM (index); s->u.s.next = BARE_SYMBOL_P (*ptr) ? XBARE_SYMBOL (*ptr) : NULL; *ptr = sym; + o->count++; + if (o->count > obarray_size (o)) + grow_obarray (o); return sym; } @@ -5082,7 +5099,6 @@ usage: (unintern NAME OBARRAY) */) { register Lisp_Object tem; Lisp_Object string; - size_t hash; if (NILP (obarray)) obarray = Vobarray; obarray = check_obarray (obarray); @@ -5122,41 +5138,42 @@ usage: (unintern NAME OBARRAY) */) /* if (NILP (tem) || EQ (tem, Qt)) error ("Attempt to unintern t or nil"); */ - XBARE_SYMBOL (tem)->u.s.interned = SYMBOL_UNINTERNED; + struct Lisp_Symbol *sym = XBARE_SYMBOL (tem); + sym->u.s.interned = SYMBOL_UNINTERNED; - hash = oblookup_last_bucket_number; + ptrdiff_t idx = oblookup_last_bucket_number; + Lisp_Object *loc = &XOBARRAY (obarray)->buckets[idx]; - if (BASE_EQ (AREF (obarray, hash), tem)) - { - if (XBARE_SYMBOL (tem)->u.s.next) - { - Lisp_Object sym; - XSETSYMBOL (sym, XBARE_SYMBOL (tem)->u.s.next); - ASET (obarray, hash, sym); - } - else - ASET (obarray, hash, make_fixnum (0)); - } + eassert (BARE_SYMBOL_P (*loc)); + struct Lisp_Symbol *prev = XBARE_SYMBOL (*loc); + if (sym == prev) + *loc = sym->u.s.next ? make_lisp_symbol (sym->u.s.next) : make_fixnum (0); else - { - Lisp_Object tail, following; + while (1) + { + struct Lisp_Symbol *next = prev->u.s.next; + if (next == sym) + { + prev->u.s.next = next->u.s.next; + break; + } + prev = next; + } - for (tail = AREF (obarray, hash); - XBARE_SYMBOL (tail)->u.s.next; - tail = following) - { - XSETSYMBOL (following, XBARE_SYMBOL (tail)->u.s.next); - if (BASE_EQ (following, tem)) - { - set_symbol_next (tail, XBARE_SYMBOL (following)->u.s.next); - break; - } - } - } + XOBARRAY (obarray)->count--; return Qt; } + +/* Bucket index of the string STR of length SIZE_BYTE bytes in obarray OA. */ +static ptrdiff_t +obarray_index (struct Lisp_Obarray *oa, const char *str, ptrdiff_t size_byte) +{ + EMACS_UINT hash = hash_string (str, size_byte); + return knuth_hash (reduce_emacs_uint_to_hash_hash (hash), oa->size_bits); +} + /* Return the symbol in OBARRAY whose names matches the string of SIZE characters (SIZE_BYTE bytes) at PTR. If there is no such symbol, return the integer bucket number of @@ -5167,36 +5184,27 @@ usage: (unintern NAME OBARRAY) */) Lisp_Object oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff_t size_byte) { - size_t hash; - size_t obsize; - register Lisp_Object tail; - Lisp_Object bucket, tem; + struct Lisp_Obarray *o = XOBARRAY (obarray); + ptrdiff_t idx = obarray_index (o, ptr, size_byte); + Lisp_Object bucket = o->buckets[idx]; - obarray = check_obarray (obarray); - /* This is sometimes needed in the middle of GC. */ - obsize = gc_asize (obarray); - hash = hash_string (ptr, size_byte) % obsize; - bucket = AREF (obarray, hash); - oblookup_last_bucket_number = hash; - if (BASE_EQ (bucket, make_fixnum (0))) - ; - else if (!BARE_SYMBOL_P (bucket)) - /* Like CADR error message. */ - xsignal2 (Qwrong_type_argument, Qobarrayp, - build_string ("Bad data in guts of obarray")); - else - for (tail = bucket; ; XSETSYMBOL (tail, XBARE_SYMBOL (tail)->u.s.next)) - { - Lisp_Object name = XBARE_SYMBOL (tail)->u.s.name; - if (SBYTES (name) == size_byte - && SCHARS (name) == size - && !memcmp (SDATA (name), ptr, size_byte)) - return tail; - else if (XBARE_SYMBOL (tail)->u.s.next == 0) - break; - } - XSETINT (tem, hash); - return tem; + oblookup_last_bucket_number = idx; + if (!BASE_EQ (bucket, make_fixnum (0))) + { + Lisp_Object sym = bucket; + while (1) + { + struct Lisp_Symbol *s = XBARE_SYMBOL (sym); + Lisp_Object name = s->u.s.name; + if (SBYTES (name) == size_byte && SCHARS (name) == size + && memcmp (SDATA (name), ptr, size_byte) == 0) + return sym; + if (s->u.s.next == NULL) + break; + sym = make_lisp_symbol(s->u.s.next); + } + } + return make_fixnum (idx); } /* Like 'oblookup', but considers 'Vread_symbol_shorthands', @@ -5263,24 +5271,134 @@ oblookup_considering_shorthand (Lisp_Object obarray, const char *in, } -void -map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg) +static struct Lisp_Obarray * +allocate_obarray (void) { - ptrdiff_t i; - register Lisp_Object tail; - CHECK_VECTOR (obarray); - for (i = ASIZE (obarray) - 1; i >= 0; i--) + return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Obarray, PVEC_OBARRAY); +} + +static Lisp_Object +make_obarray (unsigned bits) +{ + struct Lisp_Obarray *o = allocate_obarray (); + o->count = 0; + o->size_bits = bits; + ptrdiff_t size = (ptrdiff_t)1 << bits; + o->buckets = hash_table_alloc_bytes (size * sizeof *o->buckets); + for (ptrdiff_t i = 0; i < size; i++) + o->buckets[i] = make_fixnum (0); + return make_lisp_obarray (o); +} + +enum { + obarray_default_bits = 3, + word_size_log2 = word_size < 8 ? 5 : 6, /* good enough */ + obarray_max_bits = min (8 * sizeof (int), + 8 * sizeof (ptrdiff_t) - word_size_log2) - 1, +}; + +static void +grow_obarray (struct Lisp_Obarray *o) +{ + ptrdiff_t old_size = obarray_size (o); + eassert (o->count > old_size); + Lisp_Object *old_buckets = o->buckets; + + int new_bits = o->size_bits + 1; + if (new_bits > obarray_max_bits) + error ("Obarray too big"); + ptrdiff_t new_size = (ptrdiff_t)1 << new_bits; + o->buckets = hash_table_alloc_bytes (new_size * sizeof *o->buckets); + for (ptrdiff_t i = 0; i < new_size; i++) + o->buckets[i] = make_fixnum (0); + o->size_bits = new_bits; + + /* Rehash symbols. + FIXME: this is expensive since we need to recompute the hash for every + symbol name. Would it be reasonable to store it in the symbol? */ + for (ptrdiff_t i = 0; i < old_size; i++) { - tail = AREF (obarray, i); - if (BARE_SYMBOL_P (tail)) - while (1) - { - (*fn) (tail, arg); - if (XBARE_SYMBOL (tail)->u.s.next == 0) - break; - XSETSYMBOL (tail, XBARE_SYMBOL (tail)->u.s.next); - } + Lisp_Object obj = old_buckets[i]; + if (BARE_SYMBOL_P (obj)) + { + struct Lisp_Symbol *s = XBARE_SYMBOL (obj); + while (1) + { + Lisp_Object name = s->u.s.name; + ptrdiff_t idx = obarray_index (o, SSDATA (name), SBYTES (name)); + Lisp_Object *loc = o->buckets + idx; + struct Lisp_Symbol *next = s->u.s.next; + s->u.s.next = BARE_SYMBOL_P (*loc) ? XBARE_SYMBOL (*loc) : NULL; + *loc = make_lisp_symbol (s); + if (next == NULL) + break; + s = next; + } + } } + + hash_table_free_bytes (old_buckets, old_size * sizeof *old_buckets); +} + +DEFUN ("obarray-make", Fobarray_make, Sobarray_make, 0, 1, 0, + doc: /* Return a new obarray of size SIZE. +The obarray will grow to accommodate any number of symbols; the size, if +given, is only a hint for the expected number. */) + (Lisp_Object size) +{ + int bits; + if (NILP (size)) + bits = obarray_default_bits; + else + { + CHECK_FIXNAT (size); + EMACS_UINT n = XFIXNUM (size); + bits = elogb (n) + 1; + if (bits > obarray_max_bits) + xsignal (Qargs_out_of_range, size); + } + return make_obarray (bits); +} + +DEFUN ("obarrayp", Fobarrayp, Sobarrayp, 1, 1, 0, + doc: /* Return t iff OBJECT is an obarray. */) + (Lisp_Object object) +{ + return OBARRAYP (object) ? Qt : Qnil; +} + +DEFUN ("obarray-clear", Fobarray_clear, Sobarray_clear, 1, 1, 0, + doc: /* Remove all symbols from OBARRAY. */) + (Lisp_Object obarray) +{ + CHECK_OBARRAY (obarray); + struct Lisp_Obarray *o = XOBARRAY (obarray); + + /* This function does not bother setting the status of its contained symbols + to uninterned. It doesn't matter very much. */ + int new_bits = obarray_default_bits; + int new_size = (ptrdiff_t)1 << new_bits; + Lisp_Object *new_buckets + = hash_table_alloc_bytes (new_size * sizeof *new_buckets); + for (ptrdiff_t i = 0; i < new_size; i++) + new_buckets[i] = make_fixnum (0); + + int old_size = obarray_size (o); + hash_table_free_bytes (o->buckets, old_size * sizeof *o->buckets); + o->buckets = new_buckets; + o->size_bits = new_bits; + o->count = 0; + + return Qnil; +} + +void +map_obarray (Lisp_Object obarray, + void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg) +{ + CHECK_OBARRAY (obarray); + DOOBARRAY (XOBARRAY (obarray), it) + (*fn) (obarray_iter_symbol (&it), arg); } static void @@ -5307,12 +5425,13 @@ DEFUN ("internal--obarray-buckets", (Lisp_Object obarray) { obarray = check_obarray (obarray); - ptrdiff_t size = ASIZE (obarray); + ptrdiff_t size = obarray_size (XOBARRAY (obarray)); + Lisp_Object ret = Qnil; for (ptrdiff_t i = 0; i < size; i++) { Lisp_Object bucket = Qnil; - Lisp_Object sym = AREF (obarray, i); + Lisp_Object sym = XOBARRAY (obarray)->buckets[i]; if (BARE_SYMBOL_P (sym)) while (1) { @@ -5332,6 +5451,7 @@ DEFUN ("internal--obarray-buckets", void init_obarray_once (void) { + /* FIXME: use PVEC_OBARRAY */ Vobarray = make_vector (OBARRAY_SIZE, make_fixnum (0)); initial_obarray = Vobarray; staticpro (&initial_obarray); @@ -5715,6 +5835,9 @@ syms_of_lread (void) defsubr (&Smapatoms); defsubr (&Slocate_file_internal); defsubr (&Sinternal__obarray_buckets); + defsubr (&Sobarray_make); + defsubr (&Sobarrayp); + defsubr (&Sobarray_clear); DEFVAR_LISP ("obarray", Vobarray, doc: /* Symbol table for use by `intern' and `read'. diff --git a/src/minibuf.c b/src/minibuf.c index 7c0c9799a60..df6ca7ce1d8 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1615,13 +1615,15 @@ or from one of the possible completions. */) ptrdiff_t bestmatchsize = 0; /* These are in bytes, too. */ ptrdiff_t compare, matchsize; + if (VECTORP (collection)) + collection = check_obarray (collection); enum { function_table, list_table, obarray_table, hash_table} type = (HASH_TABLE_P (collection) ? hash_table - : VECTORP (collection) ? obarray_table + : OBARRAYP (collection) ? obarray_table : ((NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection))) ? list_table : function_table)); - ptrdiff_t idx = 0, obsize = 0; + ptrdiff_t idx = 0; int matchcount = 0; Lisp_Object bucket, zero, end, tem; @@ -1634,12 +1636,9 @@ or from one of the possible completions. */) /* If COLLECTION is not a list, set TAIL just for gc pro. */ tail = collection; + obarray_iter_t obit; if (type == obarray_table) - { - collection = check_obarray (collection); - obsize = ASIZE (collection); - bucket = AREF (collection, idx); - } + obit = make_obarray_iter (XOBARRAY (collection)); while (1) { @@ -1658,24 +1657,10 @@ or from one of the possible completions. */) } else if (type == obarray_table) { - if (!EQ (bucket, zero)) - { - if (!SYMBOLP (bucket)) - error ("Bad data in guts of obarray"); - elt = bucket; - eltstring = elt; - if (XSYMBOL (bucket)->u.s.next) - XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next); - else - XSETFASTINT (bucket, 0); - } - else if (++idx >= obsize) + if (obarray_iter_at_end (&obit)) break; - else - { - bucket = AREF (collection, idx); - continue; - } + elt = eltstring = obarray_iter_symbol (&obit); + obarray_iter_step (&obit); } else /* if (type == hash_table) */ { @@ -1858,10 +1843,12 @@ with a space are ignored unless STRING itself starts with a space. */) { Lisp_Object tail, elt, eltstring; Lisp_Object allmatches; + if (VECTORP (collection)) + collection = check_obarray (collection); int type = HASH_TABLE_P (collection) ? 3 - : VECTORP (collection) ? 2 + : OBARRAYP (collection) ? 2 : NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection)); - ptrdiff_t idx = 0, obsize = 0; + ptrdiff_t idx = 0; Lisp_Object bucket, tem, zero; CHECK_STRING (string); @@ -1872,12 +1859,9 @@ with a space are ignored unless STRING itself starts with a space. */) /* If COLLECTION is not a list, set TAIL just for gc pro. */ tail = collection; + obarray_iter_t obit; if (type == 2) - { - collection = check_obarray (collection); - obsize = ASIZE (collection); - bucket = AREF (collection, idx); - } + obit = make_obarray_iter (XOBARRAY (collection)); while (1) { @@ -1896,24 +1880,10 @@ with a space are ignored unless STRING itself starts with a space. */) } else if (type == 2) { - if (!EQ (bucket, zero)) - { - if (!SYMBOLP (bucket)) - error ("Bad data in guts of obarray"); - elt = bucket; - eltstring = elt; - if (XSYMBOL (bucket)->u.s.next) - XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next); - else - XSETFASTINT (bucket, 0); - } - else if (++idx >= obsize) + if (obarray_iter_at_end (&obit)) break; - else - { - bucket = AREF (collection, idx); - continue; - } + elt = eltstring = obarray_iter_symbol (&obit); + obarray_iter_step (&obit); } else /* if (type == 3) */ { @@ -2059,7 +2029,7 @@ If COLLECTION is a function, it is called with three arguments: the values STRING, PREDICATE and `lambda'. */) (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate) { - Lisp_Object tail, tem = Qnil, arg = Qnil; + Lisp_Object tem = Qnil, arg = Qnil; CHECK_STRING (string); @@ -2069,38 +2039,30 @@ the values STRING, PREDICATE and `lambda'. */) if (NILP (tem)) return Qnil; } - else if (VECTORP (collection)) + else if (OBARRAYP (collection) || VECTORP (collection)) { + collection = check_obarray (collection); /* Bypass intern-soft as that loses for nil. */ tem = oblookup (collection, SSDATA (string), SCHARS (string), SBYTES (string)); - if (completion_ignore_case && !SYMBOLP (tem)) - { - for (ptrdiff_t i = ASIZE (collection) - 1; i >= 0; i--) - { - tail = AREF (collection, i); - if (SYMBOLP (tail)) - while (1) - { - if (BASE_EQ (Fcompare_strings (string, make_fixnum (0), - Qnil, - Fsymbol_name (tail), - make_fixnum (0) , Qnil, Qt), - Qt)) - { - tem = tail; - break; - } - if (XSYMBOL (tail)->u.s.next == 0) - break; - XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next); - } - } - } + if (completion_ignore_case && !BARE_SYMBOL_P (tem)) + DOOBARRAY (XOBARRAY (collection), it) + { + Lisp_Object obj = obarray_iter_symbol (&it); + if (BASE_EQ (Fcompare_strings (string, make_fixnum (0), + Qnil, + Fsymbol_name (obj), + make_fixnum (0) , Qnil, Qt), + Qt)) + { + tem = obj; + break; + } + } - if (!SYMBOLP (tem)) + if (!BARE_SYMBOL_P (tem)) return Qnil; } else if (HASH_TABLE_P (collection)) diff --git a/src/pdumper.c b/src/pdumper.c index 778d8facabd..ca457858219 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2748,6 +2748,51 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object) return offset; } +static dump_off +dump_obarray_buckets (struct dump_context *ctx, const struct Lisp_Obarray *o) +{ + dump_align_output (ctx, DUMP_ALIGNMENT); + dump_off start_offset = ctx->offset; + ptrdiff_t n = obarray_size (o); + + struct dump_flags old_flags = ctx->flags; + ctx->flags.pack_objects = true; + + for (ptrdiff_t i = 0; i < n; i++) + { + Lisp_Object out; + const Lisp_Object *slot = &o->buckets[i]; + dump_object_start (ctx, &out, sizeof out); + dump_field_lv (ctx, &out, slot, slot, WEIGHT_STRONG); + dump_object_finish (ctx, &out, sizeof out); + } + + ctx->flags = old_flags; + return start_offset; +} + +static dump_off +dump_obarray (struct dump_context *ctx, Lisp_Object object) +{ +#if CHECK_STRUCTS && !defined HASH_Lisp_Obarray_XXXXXXXXXX +# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h." +#endif + const struct Lisp_Obarray *in_oa = XOBARRAY (object); + struct Lisp_Obarray munged_oa = *in_oa; + struct Lisp_Obarray *oa = &munged_oa; + START_DUMP_PVEC (ctx, &oa->header, struct Lisp_Obarray, out); + dump_pseudovector_lisp_fields (ctx, &out->header, &oa->header); + DUMP_FIELD_COPY (out, oa, count); + DUMP_FIELD_COPY (out, oa, size_bits); + dump_field_fixup_later (ctx, out, oa, &oa->buckets); + dump_off offset = finish_dump_pvec (ctx, &out->header); + dump_remember_fixup_ptr_raw + (ctx, + offset + dump_offsetof (struct Lisp_Obarray, buckets), + dump_obarray_buckets (ctx, oa)); + return offset; +} + static dump_off dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) { @@ -3031,6 +3076,8 @@ dump_vectorlike (struct dump_context *ctx, return dump_bool_vector(ctx, v); case PVEC_HASH_TABLE: return dump_hash_table (ctx, lv); + case PVEC_OBARRAY: + return dump_obarray (ctx, lv); case PVEC_BUFFER: return dump_buffer (ctx, XBUFFER (lv)); case PVEC_SUBR: diff --git a/src/print.c b/src/print.c index e2252562915..76c577ec800 100644 --- a/src/print.c +++ b/src/print.c @@ -2078,6 +2078,16 @@ print_vectorlike_unreadable (Lisp_Object obj, Lisp_Object printcharfun, } return; + case PVEC_OBARRAY: + { + struct Lisp_Obarray *o = XOBARRAY (obj); + /* FIXME: Would it make sense to print the actual symbols (up to + a limit)? */ + int i = sprintf (buf, "#", o->count); + strout (buf, i, i, printcharfun); + return; + } + /* Types handled earlier. */ case PVEC_NORMAL_VECTOR: case PVEC_RECORD: diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el index bfdfac8be1b..cdd1a7832d3 100644 --- a/test/lisp/abbrev-tests.el +++ b/test/lisp/abbrev-tests.el @@ -57,12 +57,10 @@ (ert-deftest abbrev-make-abbrev-table-test () ;; Table without properties: (let ((table (make-abbrev-table))) - (should (abbrev-table-p table)) - (should (= (length table) obarray-default-size))) + (should (abbrev-table-p table))) ;; Table with one property 'foo with value 'bar: (let ((table (make-abbrev-table '(foo bar)))) (should (abbrev-table-p table)) - (should (= (length table) obarray-default-size)) (should (eq (abbrev-table-get table 'foo) 'bar)))) (ert-deftest abbrev--table-symbols-test () diff --git a/test/lisp/obarray-tests.el b/test/lisp/obarray-tests.el index dd40d0f4d76..f9f97dba535 100644 --- a/test/lisp/obarray-tests.el +++ b/test/lisp/obarray-tests.el @@ -32,28 +32,18 @@ (should-not (obarrayp "aoeu")) (should-not (obarrayp '())) (should-not (obarrayp [])) - (should (obarrayp (obarray-make 7))) - (should (obarrayp (make-vector 7 0)))) ; for compatibility? - -(ert-deftest obarrayp-unchecked-content-test () - "Should fail to check content of passed obarray." - :expected-result :failed (should-not (obarrayp ["a" "b" "c"])) - (should-not (obarrayp [1 2 3]))) - -(ert-deftest obarray-make-default-test () - (let ((table (obarray-make))) - (should (obarrayp table)) - (should (eq (obarray-size table) obarray-default-size)))) + (should-not (obarrayp [1 2 3])) + (should-not (obarrayp (make-vector 7 0))) + (should-not (obarrayp (vector (obarray-make)))) + (should (obarrayp (obarray-make))) + (should (obarrayp (obarray-make 7)))) (ert-deftest obarray-make-with-size-test () ;; FIXME: Actually, `wrong-type-argument' is not the right error to signal, ;; so we shouldn't enforce this misbehavior in tests! (should-error (obarray-make -1) :type 'wrong-type-argument) - (should-error (obarray-make 0) :type 'wrong-type-argument) - (let ((table (obarray-make 1))) - (should (obarrayp table)) - (should (eq (obarray-size table) 1)))) + (should-error (obarray-make 'a) :type 'wrong-type-argument)) (ert-deftest obarray-get-test () (let ((table (obarray-make 3))) -- cgit v1.2.3 From 3ea77c735de975ebda707e0e1e8bb5e0adad2bf5 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 11 Feb 2024 15:11:21 +0100 Subject: Use the new obarray type for the initial obarray This can improve performance a lot, especially after the obarray has been fed many symbols. * src/lread.c (OBARRAY_SIZE): Remove. (load_path_check): Create an obarray object instead of a vector. --- src/lread.c | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/lread.c b/src/lread.c index c4a34c5d73f..49683d02401 100644 --- a/src/lread.c +++ b/src/lread.c @@ -5446,13 +5446,10 @@ DEFUN ("internal--obarray-buckets", return Fnreverse (ret); } -#define OBARRAY_SIZE 15121 - void init_obarray_once (void) { - /* FIXME: use PVEC_OBARRAY */ - Vobarray = make_vector (OBARRAY_SIZE, make_fixnum (0)); + Vobarray = make_obarray (15); initial_obarray = Vobarray; staticpro (&initial_obarray); -- cgit v1.2.3 From 6803b70c1972bc82f7dc1f1d6bbb2a60b6f40367 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 17 Feb 2024 13:27:25 +0100 Subject: Update NEWS and manual after obarray changes * doc/lispref/abbrevs.texi (Abbrev Tables): * doc/lispref/symbols.texi (Creating Symbols): * doc/lispref/objects.texi (Type Predicates): Update text for obarray now being an opaque type. * etc/NEWS: Announce. --- doc/lispref/abbrevs.texi | 2 +- doc/lispref/objects.texi | 5 +++- doc/lispref/symbols.texi | 65 +++++++++++++++++------------------------------- etc/NEWS | 20 +++++++++++++++ 4 files changed, 48 insertions(+), 44 deletions(-) diff --git a/doc/lispref/abbrevs.texi b/doc/lispref/abbrevs.texi index 9b719145584..d89cec4bc2b 100644 --- a/doc/lispref/abbrevs.texi +++ b/doc/lispref/abbrevs.texi @@ -65,7 +65,7 @@ expanded in the buffer. For the user-level commands for abbrevs, see @defun make-abbrev-table &optional props This function creates and returns a new, empty abbrev table---an -obarray containing no symbols. It is a vector filled with zeros. +obarray containing no symbols. @var{props} is a property list that is applied to the new table (@pxref{Abbrev Table Properties}). @end defun diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index b8fd5ed4345..e6def69454e 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -2121,6 +2121,9 @@ with references to further information. @item numberp @xref{Predicates on Numbers, numberp}. +@item obarrayp +@xref{Creating Symbols, obarrayp}. + @item overlayp @xref{Overlays, overlayp}. @@ -2181,7 +2184,7 @@ This function returns a symbol naming the primitive type of @code{condition-variable}, @code{cons}, @code{finalizer}, @code{float}, @code{font-entity}, @code{font-object}, @code{font-spec}, @code{frame}, @code{hash-table}, @code{integer}, -@code{marker}, @code{mutex}, @code{overlay}, @code{process}, +@code{marker}, @code{mutex}, @code{obarray}, @code{overlay}, @code{process}, @code{string}, @code{subr}, @code{symbol}, @code{thread}, @code{vector}, @code{window}, or @code{window-configuration}. However, if @var{object} is a record, the type specified by its first diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index e95e53d972d..5207ea4ea7b 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -177,34 +177,16 @@ know how Lisp reads them. Lisp must ensure that it finds the same symbol every time it reads the same sequence of characters in the same context. Failure to do so would cause complete confusion. -@cindex symbol name hashing -@cindex hashing @cindex obarray -@cindex bucket (in obarray) When the Lisp reader encounters a name that references a symbol in -the source code, it reads all the characters of that name. Then it -looks up that name in a table called an @dfn{obarray} to find the -symbol that the programmer meant. The technique used in this lookup -is called ``hashing'', an efficient method of looking something up by -converting a sequence of characters to a number, known as a ``hash -code''. For example, instead of searching a telephone book cover to -cover when looking up Jan Jones, you start with the J's and go from -there. That is a simple version of hashing. Each element of the -obarray is a @dfn{bucket} which holds all the symbols with a given -hash code; to look for a given name, it is sufficient to look through -all the symbols in the bucket for that name's hash code. (The same -idea is used for general Emacs hash tables, but they are a different -data type; see @ref{Hash Tables}.) - -When looking up names, the Lisp reader also considers ``shorthands''. +the source code, it looks up that name in a table called an @dfn{obarray} +to find the symbol that the programmer meant. An obarray is an unordered +container of symbols, indexed by name. + +The Lisp reader also considers ``shorthands''. If the programmer supplied them, this allows the reader to find a symbol even if its name isn't present in its full form in the source -code. Of course, the reader needs to be aware of some pre-established -context about such shorthands, much as one needs context to be to able -to refer uniquely to Jan Jones by just the name ``Jan'': it's probably -fine when amongst the Joneses, or when Jan has been mentioned -recently, but very ambiguous in any other situation. -@xref{Shorthands}. +code. @xref{Shorthands}. @cindex interning If a symbol with the desired name is found, the reader uses that @@ -236,23 +218,6 @@ to gain access to it is by finding it in some other object or as the value of a variable. Uninterned symbols are sometimes useful in generating Lisp code, see below. - In Emacs Lisp, an obarray is actually a vector. Each element of the -vector is a bucket; its value is either an interned symbol whose name -hashes to that bucket, or 0 if the bucket is empty. Each interned -symbol has an internal link (invisible to the user) to the next symbol -in the bucket. Because these links are invisible, there is no way to -find all the symbols in an obarray except using @code{mapatoms} (below). -The order of symbols in a bucket is not significant. - - In an empty obarray, every element is 0, so you can create an obarray -with @code{(make-vector @var{length} 0)}. @strong{This is the only -valid way to create an obarray.} Prime numbers as lengths tend -to result in good hashing; lengths one less than a power of two are also -good. - - @strong{Do not try to put symbols in an obarray yourself.} This does -not work---only @code{intern} can enter a symbol in an obarray properly. - @cindex CL note---symbol in obarrays @quotation @b{Common Lisp note:} Unlike Common Lisp, Emacs Lisp does not provide @@ -262,9 +227,21 @@ Emacs Lisp provides a different namespacing system called ``shorthands'' (@pxref{Shorthands}). @end quotation +@defun obarray-make &optional size +This function creates and returns a new obarray. +The optional @var{size} may be used to specify the number of symbols +that it is expected to hold, but since obarrays grow automatically +as needed, this rarely provide any benefit. +@end defun + +@defun obarrayp object +This function returns @code{t} if @var{object} is an obarray, +@code{nil} otherwise. +@end defun + Most of the functions below take a name and sometimes an obarray as arguments. A @code{wrong-type-argument} error is signaled if the name -is not a string, or if the obarray is not a vector. +is not a string, or if the obarray is not an obarray object. @defun symbol-name symbol This function returns the string that is @var{symbol}'s name. For example: @@ -416,6 +393,10 @@ If @code{unintern} does delete a symbol, it returns @code{t}. Otherwise it returns @code{nil}. @end defun +@defun obarray-clear obarray +This function removes all symbols from @var{obarray}. +@end defun + @node Symbol Properties @section Symbol Properties @cindex symbol property diff --git a/etc/NEWS b/etc/NEWS index 13b41feccbc..1a5ddf0f7e3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1993,6 +1993,26 @@ The 'test' parameter is omitted if it is 'eql' (the default), as is 'data' if empty. 'rehash-size', 'rehash-threshold' and 'size' are always omitted, and ignored if present when the object is read back in. +** Obarrays + ++++ +*** New obarray type. +Obarrays are now represented by an opaque type instead of using vectors. +They are created by 'obarray-make' and manage their internal storage +automatically, which means that the size parameter to 'obarray-make' can +safely be omitted. That is, they do not become slower as they fill up. + +The old vector representation is still accepted by functions operating +on obarrays, but 'obarrayp' only returns 't' for obarray objects. +'type-of' now returns 'obarray' for obarray objects. + ++++ +*** New function 'obarray-clear' removes all symbols from an obarray. + +--- +*** 'obarray-size' and 'obarray-default-size' are now obsolete. +They pertained to the internal storage size which is now irrelevant. + +++ ** 'treesit-install-language-grammar' can handle local directory instead of URL. It is now possible to pass a directory of a local repository as URL -- cgit v1.2.3 From a8f167547bc15eacaf5fbc07c1e75f603e70862d Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 23 Feb 2024 13:14:18 +0100 Subject: Replace use of obsolete eshell-kill-output in test * test/lisp/eshell/eshell-tests.el (eshell-test/flush-output): Use eshell-delete-output instead of eshell-kill-output. --- test/lisp/eshell/eshell-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index e01e033e25e..e58b5a14ed9 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -153,7 +153,7 @@ insert the queued one at the next prompt, and finally run it." "Test flushing of previous output" (with-temp-eshell (eshell-insert-command "echo alpha") - (eshell-kill-output) + (eshell-delete-output) (should (eshell-match-output (concat "^" (regexp-quote "*** output flushed ***\n") "$"))))) -- cgit v1.2.3 From 90d3b3408e404aba383302c3147d3ca614619986 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 23 Feb 2024 13:57:04 +0100 Subject: Warn about docstrings with control characters It is easy to include control chars in doc strings by mistake, and the result is often an unreadable mess. * lisp/emacs-lisp/bytecomp.el (byte-compile-warning-types) (byte-compile-warnings, byte-compile--docstring-style-warn): Add `docstrings-control-chars` warning. * etc/NEWS: Announce. --- etc/NEWS | 14 ++++++++++++++ lisp/emacs-lisp/bytecomp.el | 21 +++++++++++++++++++++ 2 files changed, 35 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 1a5ddf0f7e3..6725b596ea9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1921,6 +1921,20 @@ name 'ignored-return-value'. The warning will only be issued for calls to functions declared 'important-return-value' or 'side-effect-free' (but not 'error-free'). +--- +*** Warn about docstrings that contain control characters. +The compiler now warns about docstrings with control characters other +than newline and tab. This is often a result of improper escaping. +Example: + + (defun my-fun () + "Uses c:\remote\dir\files and the key \C-x." + ...) + +where the doc string contains four control characters CR, DEL, FF and ^X. + +The warning name is 'docstrings-control-chars'. + --- *** The warning about wide docstrings can now be disabled separately. Its warning name is 'docstrings-wide'. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5d2aa3355be..c3355eedd75 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -285,6 +285,7 @@ The information is logged to `byte-compile-log-buffer'." (defconst byte-compile-warning-types '( callargs constants docstrings docstrings-non-ascii-quotes docstrings-wide + docstrings-control-chars empty-body free-vars ignored-return-value interactive-only lexical lexical-dynamic make-local mapcar ; obsolete @@ -307,6 +308,8 @@ Elements of the list may be: docstrings that are too wide, containing lines longer than both `byte-compile-docstring-max-column' and `fill-column' characters. Only enabled when `docstrings' also is. + docstrings-control-chars + docstrings that contain control characters other than NL and TAB empty-body body argument to a special form or macro is empty. free-vars references to variables not in the current lexical scope. ignored-return-value @@ -1769,6 +1772,24 @@ It is too wide if it has any lines longer than the largest of (byte-compile-warn-x name "%sdocstring wider than %s characters" (funcall prefix) col))) + + (when (byte-compile-warning-enabled-p 'docstrings-control-chars) + (let ((start 0) + (len (length docs))) + (while (and (< start len) + (string-match (rx (intersection (in (0 . 31) 127) + (not (in "\n\t")))) + docs start)) + (let* ((ofs (match-beginning 0)) + (c (aref docs ofs))) + ;; FIXME: it should be possible to use the exact source position + ;; of the control char in most cases, and it would be helpful + (byte-compile-warn-x + name + "%sdocstring contains control char #x%02x (position %d)" + (funcall prefix) c ofs) + (setq start (1+ ofs)))))) + ;; There's a "naked" ' character before a symbol/list, so it ;; should probably be quoted with \=. (when (string-match-p (rx (| (in " \t") bol) -- cgit v1.2.3 From 2b7dc7fef814753f1c6d4c352fe69bb6e167cd07 Mon Sep 17 00:00:00 2001 From: "Robert A. Burks" Date: Fri, 16 Feb 2024 18:17:52 -0500 Subject: Fix Flymake lighter tool-tip from generating errors Flymake tool-tip was generating errors on mouse over of mode-line lighter on inactive windows and on the minor mode indicator in the describe-mode Help page. * lisp/progmodes/flymake.el (flymake--mode-line-title): 'help-echo' now uses buffer local state and makes null check. (Bug#69248) Copyright-paperwork-exempt: yes --- lisp/progmodes/flymake.el | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 5974f076556..db00cc59c0e 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1569,13 +1569,19 @@ correctly.") ,flymake-mode-line-lighter mouse-face mode-line-highlight help-echo - ,(lambda (&rest _) - (concat - (format "%s known backends\n" (hash-table-count flymake--state)) - (format "%s running\n" (length (flymake-running-backends))) - (format "%s disabled\n" (length (flymake-disabled-backends))) - "mouse-1: Display minor mode menu\n" - "mouse-2: Show help for minor mode")) + ,(lambda (w &rest _) + (with-current-buffer (window-buffer w) + ;; Mouse can activate tool-tip without window being active. + ;; `flymake--state' is buffer local and is null when line + ;; lighter appears in *Help* `describe-mode'. + (concat + (unless (null flymake--state) + (concat + (format "%s known backends\n" (hash-table-count flymake--state)) + (format "%s running\n" (length (flymake-running-backends))) + (format "%s disabled\n" (length (flymake-disabled-backends))))) + "mouse-1: Display minor mode menu\n" + "mouse-2: Show help for minor mode"))) keymap ,(let ((map (make-sparse-keymap))) (define-key map [mode-line down-mouse-1] -- cgit v1.2.3 From 0b855e1465b26f69156a35befebb4167145cdccf Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 23 Feb 2024 11:31:43 -0500 Subject: (rmail-font-lock-keywords): Avoid old-style `font-lock*-face` variables * lisp/mail/rmail.el (rmail-font-lock-keywords): Refer directly to the font-lock faces. --- lisp/mail/rmail.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 6f343c23bbe..7ebfff3d7af 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -805,8 +805,8 @@ that knows the exact ordering of the \\( \\) subexpressions.") "\\(" cite-chars "[ \t]*\\)\\)+\\)" "\\(.*\\)") (beginning-of-line) (end-of-line) - (1 font-lock-comment-delimiter-face nil t) - (5 font-lock-comment-face nil t))) + (1 'font-lock-comment-delimiter-face nil t) + (5 'font-lock-comment-face nil t))) '("^\\(X-[a-z0-9-]+\\|In-Reply-To\\|Date\\):.*\\(\n[ \t]+.*\\)*$" . 'rmail-header-name)))) "Additional expressions to highlight in Rmail mode.") -- cgit v1.2.3 From 048eaadd8cc97faf0f3e70a8d81d06f915c52081 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 23 Feb 2024 11:37:24 -0500 Subject: rmail.el: Prefer #' to quote function names * lisp/mail/rmail.el (rmail-pop-to-buffer, rmail-mode-map) (rmail-mode-1, rmail-generate-viewer-buffer, rmail-variables) (rmail-find-all-files, rmail-insert-inbox-text) (rmail-set-message-counters, rmail-only-expunge, rmail-reply) (rmail-resend, rmail-fontify-buffer-function) (rmail-unfontify-buffer-function, rmail-install-speedbar-variables) (after-save-hook): Use #' where applicable. --- lisp/mail/rmail.el | 160 +++++++++++++++++++++++++++-------------------------- 1 file changed, 81 insertions(+), 79 deletions(-) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 7ebfff3d7af..7006d59be66 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -815,7 +815,7 @@ that knows the exact ordering of the \\( \\) subexpressions.") (defun rmail-pop-to-buffer (&rest args) "Like `pop-to-buffer', but with `split-width-threshold' set to nil." (let (split-width-threshold) - (apply 'pop-to-buffer args))) + (apply #'pop-to-buffer args))) ;; Perform BODY in the summary buffer ;; in such a way that its cursor is properly updated in its own window. @@ -1008,66 +1008,66 @@ The buffer is expected to be narrowed to just the header of the message." (defvar rmail-mode-map (let ((map (make-keymap))) (suppress-keymap map) - (define-key map "a" 'rmail-add-label) - (define-key map "b" 'rmail-bury) - (define-key map "c" 'rmail-continue) - (define-key map "d" 'rmail-delete-forward) - (define-key map "\C-d" 'rmail-delete-backward) - (define-key map "e" 'rmail-edit-current-message) + (define-key map "a" #'rmail-add-label) + (define-key map "b" #'rmail-bury) + (define-key map "c" #'rmail-continue) + (define-key map "d" #'rmail-delete-forward) + (define-key map "\C-d" #'rmail-delete-backward) + (define-key map "e" #'rmail-edit-current-message) ;; If you change this, change the rmail-resend menu-item's :keys. - (define-key map "f" 'rmail-forward) - (define-key map "g" 'rmail-get-new-mail) - (define-key map "h" 'rmail-summary) - (define-key map "i" 'rmail-input) - (define-key map "j" 'rmail-show-message) - (define-key map "k" 'rmail-kill-label) - (define-key map "l" 'rmail-summary-by-labels) - (define-key map "\e\C-h" 'rmail-summary) - (define-key map "\e\C-l" 'rmail-summary-by-labels) - (define-key map "\e\C-r" 'rmail-summary-by-recipients) - (define-key map "\e\C-s" 'rmail-summary-by-regexp) - (define-key map "\e\C-f" 'rmail-summary-by-senders) - (define-key map "\e\C-t" 'rmail-summary-by-topic) - (define-key map "m" 'rmail-mail) - (define-key map "\em" 'rmail-retry-failure) - (define-key map "n" 'rmail-next-undeleted-message) - (define-key map "\en" 'rmail-next-message) - (define-key map "\e\C-n" 'rmail-next-labeled-message) - (define-key map "o" 'rmail-output) - (define-key map "\C-o" 'rmail-output-as-seen) - (define-key map "p" 'rmail-previous-undeleted-message) - (define-key map "\ep" 'rmail-previous-message) - (define-key map "\e\C-p" 'rmail-previous-labeled-message) - (define-key map "q" 'rmail-quit) - (define-key map "r" 'rmail-reply) + (define-key map "f" #'rmail-forward) + (define-key map "g" #'rmail-get-new-mail) + (define-key map "h" #'rmail-summary) + (define-key map "i" #'rmail-input) + (define-key map "j" #'rmail-show-message) + (define-key map "k" #'rmail-kill-label) + (define-key map "l" #'rmail-summary-by-labels) + (define-key map "\e\C-h" #'rmail-summary) + (define-key map "\e\C-l" #'rmail-summary-by-labels) + (define-key map "\e\C-r" #'rmail-summary-by-recipients) + (define-key map "\e\C-s" #'rmail-summary-by-regexp) + (define-key map "\e\C-f" #'rmail-summary-by-senders) + (define-key map "\e\C-t" #'rmail-summary-by-topic) + (define-key map "m" #'rmail-mail) + (define-key map "\em" #'rmail-retry-failure) + (define-key map "n" #'rmail-next-undeleted-message) + (define-key map "\en" #'rmail-next-message) + (define-key map "\e\C-n" #'rmail-next-labeled-message) + (define-key map "o" #'rmail-output) + (define-key map "\C-o" #'rmail-output-as-seen) + (define-key map "p" #'rmail-previous-undeleted-message) + (define-key map "\ep" #'rmail-previous-message) + (define-key map "\e\C-p" #'rmail-previous-labeled-message) + (define-key map "q" #'rmail-quit) + (define-key map "r" #'rmail-reply) ;; I find I can't live without the default M-r command -- rms. - ;; (define-key rmail-mode-map "\er" 'rmail-search-backwards) - (define-key map "s" 'rmail-expunge-and-save) - (define-key map "\es" 'rmail-search) - (define-key map "t" 'rmail-toggle-header) - (define-key map "u" 'rmail-undelete-previous-message) - (define-key map "v" 'rmail-mime) - (define-key map "w" 'rmail-output-body-to-file) - (define-key map "\C-c\C-w" 'rmail-widen) - (define-key map "x" 'rmail-expunge) - (define-key map "." 'rmail-beginning-of-message) - (define-key map "/" 'rmail-end-of-message) - (define-key map "<" 'rmail-first-message) - (define-key map ">" 'rmail-last-message) - (define-key map " " 'scroll-up-command) - (define-key map [?\S-\ ] 'scroll-down-command) - (define-key map "\177" 'scroll-down-command) - (define-key map "?" 'describe-mode) - (define-key map "\C-c\C-d" 'rmail-epa-decrypt) - (define-key map "\C-c\C-s\C-d" 'rmail-sort-by-date) - (define-key map "\C-c\C-s\C-s" 'rmail-sort-by-subject) - (define-key map "\C-c\C-s\C-a" 'rmail-sort-by-author) - (define-key map "\C-c\C-s\C-r" 'rmail-sort-by-recipient) - (define-key map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent) - (define-key map "\C-c\C-s\C-l" 'rmail-sort-by-lines) - (define-key map "\C-c\C-s\C-k" 'rmail-sort-by-labels) - (define-key map "\C-c\C-n" 'rmail-next-same-subject) - (define-key map "\C-c\C-p" 'rmail-previous-same-subject) + ;; (define-key rmail-mode-map "\er" #'rmail-search-backwards) + (define-key map "s" #'rmail-expunge-and-save) + (define-key map "\es" #'rmail-search) + (define-key map "t" #'rmail-toggle-header) + (define-key map "u" #'rmail-undelete-previous-message) + (define-key map "v" #'rmail-mime) + (define-key map "w" #'rmail-output-body-to-file) + (define-key map "\C-c\C-w" #'rmail-widen) + (define-key map "x" #'rmail-expunge) + (define-key map "." #'rmail-beginning-of-message) + (define-key map "/" #'rmail-end-of-message) + (define-key map "<" #'rmail-first-message) + (define-key map ">" #'rmail-last-message) + (define-key map " " #'scroll-up-command) + (define-key map [?\S-\ ] #'scroll-down-command) + (define-key map "\177" #'scroll-down-command) + (define-key map "?" #'describe-mode) + (define-key map "\C-c\C-d" #'rmail-epa-decrypt) + (define-key map "\C-c\C-s\C-d" #'rmail-sort-by-date) + (define-key map "\C-c\C-s\C-s" #'rmail-sort-by-subject) + (define-key map "\C-c\C-s\C-a" #'rmail-sort-by-author) + (define-key map "\C-c\C-s\C-r" #'rmail-sort-by-recipient) + (define-key map "\C-c\C-s\C-c" #'rmail-sort-by-correspondent) + (define-key map "\C-c\C-s\C-l" #'rmail-sort-by-lines) + (define-key map "\C-c\C-s\C-k" #'rmail-sort-by-labels) + (define-key map "\C-c\C-n" #'rmail-next-same-subject) + (define-key map "\C-c\C-p" #'rmail-previous-same-subject) (define-key map [menu-bar] (make-sparse-keymap)) @@ -1344,9 +1344,9 @@ Instead, these commands are available: (setq local-abbrev-table text-mode-abbrev-table) ;; Functions to support buffer swapping: (add-hook 'write-region-annotate-functions - 'rmail-write-region-annotate nil t) - (add-hook 'kill-buffer-hook 'rmail-mode-kill-buffer-hook nil t) - (add-hook 'change-major-mode-hook 'rmail-change-major-mode-hook nil t)) + #'rmail-write-region-annotate nil t) + (add-hook 'kill-buffer-hook #'rmail-mode-kill-buffer-hook nil t) + (add-hook 'change-major-mode-hook #'rmail-change-major-mode-hook nil t)) (defun rmail-generate-viewer-buffer () "Return a reusable buffer suitable for viewing messages. @@ -1363,7 +1363,7 @@ Create the buffer if necessary." (file-name-nondirectory (or buffer-file-name (buffer-name))))))) (with-current-buffer newbuf - (add-hook 'kill-buffer-hook 'rmail-view-buffer-kill-buffer-hook nil t)) + (add-hook 'kill-buffer-hook #'rmail-view-buffer-kill-buffer-hook nil t)) newbuf))) (defun rmail-swap-buffers () @@ -1479,7 +1479,7 @@ If so restore the actual mbox message collection." ;; Don't turn off auto-saving based on the size of the buffer ;; because that code does not understand buffer-swapping. (setq-local auto-save-include-big-deletions t) - (setq-local revert-buffer-function 'rmail-revert) + (setq-local revert-buffer-function #'rmail-revert) (setq-local font-lock-defaults '(rmail-font-lock-keywords t t nil nil @@ -1490,7 +1490,7 @@ If so restore the actual mbox message collection." (setq-local file-precious-flag t) (setq-local desktop-save-buffer t) (setq-local save-buffer-coding-system 'no-conversion) - (setq next-error-move-function 'rmail-next-error-move)) + (setq next-error-move-function #'rmail-next-error-move)) ;; Handle M-x revert-buffer done in an rmail-mode buffer. (defun rmail-revert (arg noconfirm) @@ -1606,7 +1606,7 @@ The duplicate copy goes into the Rmail file just after the original." (files (directory-files start t rmail-secondary-file-regexp))) ;; Sort here instead of in directory-files ;; because this list is usually much shorter. - (sort files 'string<)))) + (sort files #'string<)))) (defun rmail-list-to-menu (menu-name l action &optional full-name) (let ((menu (make-sparse-keymap menu-name)) @@ -2026,7 +2026,7 @@ Value is the size of the newly read mail after conversion." rmail-movemail-flags) (list file tofile) (if password (list password) nil)))) - (apply 'call-process args)) + (apply #'call-process args)) (if (not (buffer-modified-p errors)) ;; No output => movemail won nil @@ -2518,7 +2518,7 @@ Output a helpful message unless NOMSG is non-nil." ;; which will never be used. (push nil messages-head) (push ?0 deleted-head) - (setq rmail-message-vector (apply 'vector messages-head) + (setq rmail-message-vector (apply #'vector messages-head) rmail-deleted-vector (concat deleted-head)) (setq rmail-summary-vector (make-vector rmail-total-messages nil) @@ -3605,10 +3605,10 @@ If `rmail-confirm-expunge' is non-nil, ask user to confirm." (cons (aref messages number) nil))) (setq rmail-current-message new-message-number rmail-total-messages counter - rmail-message-vector (apply 'vector messages-head) + rmail-message-vector (apply #'vector messages-head) rmail-deleted-vector (make-string (1+ counter) ?\s) rmail-summary-vector (vconcat (nreverse new-summary)) - rmail-msgref-vector (apply 'vector (nreverse new-msgref)) + rmail-msgref-vector (apply #'vector (nreverse new-msgref)) win t))) (message "Expunging deleted messages...done") (if (not win) @@ -3891,7 +3891,7 @@ use \\[mail-yank-original] to yank the original message into it." (if (or references message-id) (list (cons "References" (if references (concat - (mapconcat 'identity references " ") + (mapconcat #'identity references " ") " " message-id) message-id))))))) @@ -4089,7 +4089,7 @@ typically for purposes of moderating a list." (insert "Resent-Bcc: " (user-login-name) "\n")) (insert "Resent-To: " (if (stringp address) address - (mapconcat 'identity address ",\n\t")) + (mapconcat #'identity address ",\n\t")) "\n") ;; Expand abbrevs in the recipients. (save-excursion @@ -4335,7 +4335,7 @@ This has an effect only if a summary buffer exists." (defun rmail-fontify-buffer-function () ;; This function's symbol is bound to font-lock-fontify-buffer-function. - (add-hook 'rmail-show-message-hook 'rmail-fontify-message nil t) + (add-hook 'rmail-show-message-hook #'rmail-fontify-message nil t) ;; If we're already showing a message, fontify it now. (if rmail-current-message (rmail-fontify-message)) ;; Prevent Font Lock mode from kicking in. @@ -4346,7 +4346,7 @@ This has an effect only if a summary buffer exists." (with-silent-modifications (save-restriction (widen) - (remove-hook 'rmail-show-message-hook 'rmail-fontify-message t) + (remove-hook 'rmail-show-message-hook #'rmail-fontify-message t) (remove-text-properties (point-min) (point-max) '(rmail-fontified nil)) (font-lock-default-unfontify-buffer)))) @@ -4381,11 +4381,12 @@ browsing, and moving of messages." "Install those variables used by speedbar to enhance rmail." (unless rmail-speedbar-key-map (setq rmail-speedbar-key-map (speedbar-make-specialized-keymap)) - (define-key rmail-speedbar-key-map "e" 'speedbar-edit-line) - (define-key rmail-speedbar-key-map "r" 'speedbar-edit-line) - (define-key rmail-speedbar-key-map "\C-m" 'speedbar-edit-line) + (declare-function speedbar-edit-line "speedbar") + (define-key rmail-speedbar-key-map "e" #'speedbar-edit-line) + (define-key rmail-speedbar-key-map "r" #'speedbar-edit-line) + (define-key rmail-speedbar-key-map "\C-m" #'speedbar-edit-line) (define-key rmail-speedbar-key-map "M" - 'rmail-speedbar-move-message-to-folder-on-line))) + #'rmail-speedbar-move-message-to-folder-on-line))) ;; Mouse-3. (defvar rmail-speedbar-menu-items @@ -4829,7 +4830,8 @@ Content-Transfer-Encoding: base64\n") (with-current-buffer (if (rmail-buffers-swapped-p) rmail-buffer rmail-view-buffer) (setq buffer-file-coding-system rmail-message-encoding)))) -(add-hook 'after-save-hook 'rmail-after-save-hook) +;; FIXME: Don't do it globally!! +(add-hook 'after-save-hook #'rmail-after-save-hook) ;;; Mailing list support -- cgit v1.2.3 From 3599a9a1cf1f8bed7c7f00fd8f00b2bfc0c4271f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 23 Feb 2024 11:38:48 -0500 Subject: * lisp/mail/rmail.el (rmail-resend): Use `with-syntax-table` --- lisp/mail/rmail.el | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 7006d59be66..d422383acdf 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4095,20 +4095,18 @@ typically for purposes of moderating a list." (save-excursion (if (featurep 'mailabbrev) (let ((end (point-marker)) - (local-abbrev-table mail-abbrevs) - (old-syntax-table (syntax-table))) + (local-abbrev-table mail-abbrevs)) (if (and (not (obarrayp mail-abbrevs)) (file-exists-p mail-personal-alias-file)) (build-mail-abbrevs)) (unless mail-abbrev-syntax-table (mail-abbrev-make-syntax-table)) - (set-syntax-table mail-abbrev-syntax-table) - (goto-char before) - (while (and (< (point) end) - (progn (forward-word-strictly 1) - (<= (point) end))) - (expand-abbrev)) - (set-syntax-table old-syntax-table)) + (with-syntax-table mail-abbrev-syntax-table + (goto-char before) + (while (and (< (point) end) + (progn (forward-word-strictly 1) + (<= (point) end))) + (expand-abbrev)))) (expand-mail-aliases before (point))))) ;;>> Set up comment, if any. (if (and (sequencep comment) (not (zerop (length comment)))) -- cgit v1.2.3 From 84f72f19e514db8f8f6e469340fb5fa0719d40b6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 23 Feb 2024 16:46:01 -0500 Subject: elisp-mode.el: Use `handler-bind` instead of `debug-on-error` * lisp/progmodes/elisp-mode.el (elisp-enable-lexical-binding): Don't get fooled by a global binding of `lexical-binding` to t. (elisp--eval-last-sexp-fake-value): Delete var. (elisp--eval-defun): Don't let-bind `debug-on-error` since it's already arranged by the only caller. (eval-last-sexp, eval-defun): Use `handler-bind` instead of `debug-on-error`. --- lisp/progmodes/elisp-mode.el | 38 +++++++++++++------------------------- 1 file changed, 13 insertions(+), 25 deletions(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index e0c18214ef7..4b1f8022f81 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -309,7 +309,7 @@ Comments in the form will be lost." INTERACTIVE non-nil means ask the user for confirmation; this happens in interactive invocations." (interactive "p") - (if lexical-binding + (if (and (local-variable-p 'lexical-binding) lexical-binding) (when interactive (message "lexical-binding already enabled!") (ding)) @@ -371,6 +371,12 @@ be used instead. ;; Font-locking support. +(defun elisp--font-lock-shorthand (_limit) + ;; Add faces on shorthands between point and LIMIT. + ;; ... + ;; Return nil to tell font-lock, that there's nothing left to do. + nil) + (defun elisp--font-lock-flush-elisp-buffers (&optional file) ;; We're only ever called from after-load-functions, load-in-progress can ;; still be t in case of nested loads. @@ -1582,9 +1588,6 @@ character)." (buffer-substring-no-properties beg end)) )))) - -(defvar elisp--eval-last-sexp-fake-value (make-symbol "t")) - (defun eval-sexp-add-defvars (exp &optional pos) "Prepend EXP with all the `defvar's that precede it in the buffer. POS specifies the starting position where EXP was found and defaults to point." @@ -1626,16 +1629,9 @@ integer value is also printed as a character of that codepoint. If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger." (interactive "P") - (if (null eval-expression-debug-on-error) - (values--store-value - (elisp--eval-last-sexp eval-last-sexp-arg-internal)) - (let ((value - (let ((debug-on-error elisp--eval-last-sexp-fake-value)) - (cons (elisp--eval-last-sexp eval-last-sexp-arg-internal) - debug-on-error)))) - (unless (eq (cdr value) elisp--eval-last-sexp-fake-value) - (setq debug-on-error (cdr value))) - (car value)))) + (values--store-value + (handler-bind ((error (if #'eval-expression--debug #'ignore))) + (elisp--eval-last-sexp eval-last-sexp-arg-internal)))) (defun elisp--eval-defun-1 (form) "Treat some expressions in FORM specially. @@ -1694,8 +1690,7 @@ Return the result of evaluation." ;; FIXME: the print-length/level bindings should only be applied while ;; printing, not while evaluating. (defvar elisp--eval-defun-result) - (let ((debug-on-error eval-expression-debug-on-error) - (edebugging edebug-all-defs) + (let ((edebugging edebug-all-defs) elisp--eval-defun-result) (save-excursion ;; Arrange for eval-region to "read" the (possibly) altered form. @@ -1774,15 +1769,8 @@ which see." (defvar edebug-all-defs) (eval-defun (not edebug-all-defs))) (t - (if (null eval-expression-debug-on-error) - (elisp--eval-defun) - (let (new-value value) - (let ((debug-on-error elisp--eval-last-sexp-fake-value)) - (setq value (elisp--eval-defun)) - (setq new-value debug-on-error)) - (unless (eq elisp--eval-last-sexp-fake-value new-value) - (setq debug-on-error new-value)) - value))))) + (handler-bind ((error (if #'eval-expression--debug #'ignore))) + (elisp--eval-defun))))) ;;; ElDoc Support -- cgit v1.2.3 From 26290870b3505b8971c73fe3a82b69e3c4e86b88 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 23 Feb 2024 17:03:10 -0500 Subject: diff-mode.el (diff-refine-nonmodified): New option * lisp/vc/diff-mode.el (diff-font-lock-keywords): Refer directly to font-lock faces. (diff-apply-hunk): Use `user-error` for errors usually not due to bugs. (diff--refine-propertize): New function. (diff-refine-nonmodified): New custom var (bug#61396). (diff--refine-hunk): Use them. --- etc/NEWS | 5 +++++ lisp/vc/diff-mode.el | 51 +++++++++++++++++++++++++++++++++++++-------------- 2 files changed, 42 insertions(+), 14 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 6725b596ea9..5653b51784f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -596,6 +596,11 @@ It allows tweaking the thresholds for rename and copy detection. ** Diff mode +--- +*** New user option 'diff-refine-nonmodified'. +Makes 'diff-refine' highlight added and removed whole lines with the +same faces as the words added and removed within modified lines. + +++ *** 'diff-ignore-whitespace-hunk' can now be applied to all hunks. When called with a non-nil prefix argument, diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 34a4b70691d..f914cc76790 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -517,8 +517,8 @@ use the face `diff-removed' for removed lines, and the face ("^Only in .*\n" . 'diff-nonexistent) ("^Binary files .* differ\n" . 'diff-file-header) ("^\\(#\\)\\(.*\\)" - (1 font-lock-comment-delimiter-face) - (2 font-lock-comment-face)) + (1 'font-lock-comment-delimiter-face) + (2 'font-lock-comment-face)) ("^diff: .*" (0 'diff-error)) ("^[^-=+*!<>#].*\n" (0 'diff-context)) (,#'diff--font-lock-syntax) @@ -944,7 +944,8 @@ like \(diff-merge-strings \"b/foo\" \"b/bar\" \"/a/c/foo\")." (when (and (string-match (concat "\\`\\(.*?\\)\\(.*\\)\\(.*\\)\n" "\\1\\(.*\\)\\3\n" - "\\(.*\\(\\2\\).*\\)\\'") str) + "\\(.*\\(\\2\\).*\\)\\'") + str) (equal to (match-string 5 str))) (concat (substring str (match-beginning 5) (match-beginning 6)) (match-string 4 str) @@ -1999,7 +2000,7 @@ With a prefix argument, REVERSE the hunk." (diff-find-source-location nil reverse))) (cond ((null line-offset) - (error "Can't find the text to patch")) + (user-error "Can't find the text to patch")) ((with-current-buffer buf (and buffer-file-name (backup-file-name-p buffer-file-name) @@ -2008,7 +2009,7 @@ With a prefix argument, REVERSE the hunk." (yes-or-no-p (format "Really apply this hunk to %s? " (file-name-nondirectory buffer-file-name))))))) - (error "%s" + (user-error "%s" (substitute-command-keys (format "Use %s\\[diff-apply-hunk] to apply it to the other file" (if (not reverse) "\\[universal-argument] "))))) @@ -2275,6 +2276,18 @@ Return new point, if it was moved." (end (progn (diff-end-of-hunk) (point)))) (diff--refine-hunk beg end))))) +(defun diff--refine-propertize (beg end face) + (let ((ol (make-overlay beg end))) + (overlay-put ol 'diff-mode 'fine) + (overlay-put ol 'evaporate t) + (overlay-put ol 'face face))) + +(defcustom diff-refine-nonmodified nil + "If non-nil also highlight as \"refined\" the added/removed lines. +This is currently only implemented for `unified' diffs." + :version "30.1" + :type 'boolean) + (defun diff--refine-hunk (start end) (require 'smerge-mode) (goto-char start) @@ -2289,18 +2302,28 @@ Return new point, if it was moved." (goto-char beg) (pcase style ('unified - (while (re-search-forward "^-" end t) + (while (re-search-forward "^[-+]" end t) (let ((beg-del (progn (beginning-of-line) (point))) beg-add end-add) - (when (and (diff--forward-while-leading-char ?- end) - ;; Allow for "\ No newline at end of file". - (progn (diff--forward-while-leading-char ?\\ end) - (setq beg-add (point))) - (diff--forward-while-leading-char ?+ end) - (progn (diff--forward-while-leading-char ?\\ end) - (setq end-add (point)))) + (cond + ((eq (char-after) ?+) + (diff--forward-while-leading-char ?+ end) + (when diff-refine-nonmodified + (diff--refine-propertize beg-del (point) 'diff-refine-added))) + ((and (diff--forward-while-leading-char ?- end) + ;; Allow for "\ No newline at end of file". + (progn (diff--forward-while-leading-char ?\\ end) + (setq beg-add (point))) + (diff--forward-while-leading-char ?+ end) + (progn (diff--forward-while-leading-char ?\\ end) + (setq end-add (point)))) (smerge-refine-regions beg-del beg-add beg-add end-add - nil #'diff-refine-preproc props-r props-a))))) + nil #'diff-refine-preproc props-r props-a)) + (t ;; If we're here, it's because + ;; (diff--forward-while-leading-char ?+ end) failed. + (when diff-refine-nonmodified + (diff--refine-propertize beg-del (point) + 'diff-refine-removed))))))) ('context (let* ((middle (save-excursion (re-search-forward "^---" end t))) (other middle)) -- cgit v1.2.3 From 65d4bf711055dc8d23cea9b2ec8a57cdbfa6cf05 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 24 Feb 2024 10:01:03 +0800 Subject: ; * .dir-locals.el (java-mode): Transfer suitable c-mode options. --- .dir-locals.el | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.dir-locals.el b/.dir-locals.el index 89fb76a55f3..1a6acecc206 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -23,6 +23,11 @@ (electric-quote-string . nil) (indent-tabs-mode . t) (mode . bug-reference-prog))) + (java-mode . ((c-file-style . "GNU") + (electric-quote-comment . nil) + (electric-quote-string . nil) + (indent-tabs-mode . t) + (mode . bug-reference-prog))) (objc-mode . ((c-file-style . "GNU") (electric-quote-comment . nil) (electric-quote-string . nil) -- cgit v1.2.3 From 8d5983aa78e36afa815325e7bce85a81d314e67b Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 24 Feb 2024 10:01:57 +0800 Subject: Fix bug#69321 * java/org/gnu/emacs/EmacsWindow.java (onKeyDown, onKeyUp): Provide Right Alt (Alt Gr) masks to system keymap routines. (bug#69321) --- java/org/gnu/emacs/EmacsWindow.java | 68 ++++++++++++++++++++++++++----------- 1 file changed, 48 insertions(+), 20 deletions(-) diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index 427a1a92332..6e8bdaf7401 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java @@ -661,7 +661,7 @@ public final class EmacsWindow extends EmacsHandleObject public void onKeyDown (int keyCode, KeyEvent event) { - int state, state_1, num_lock_flag; + int state, state_1, extra_ignored; long serial; String characters; @@ -682,23 +682,37 @@ public final class EmacsWindow extends EmacsHandleObject state = eventModifiers (event); - /* Num Lock and Scroll Lock aren't supported by systems older than - Android 3.0. */ + /* Num Lock, Scroll Lock and Meta aren't supported by systems older + than Android 3.0. */ if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB) - num_lock_flag = (KeyEvent.META_NUM_LOCK_ON - | KeyEvent.META_SCROLL_LOCK_ON); + extra_ignored = (KeyEvent.META_NUM_LOCK_ON + | KeyEvent.META_SCROLL_LOCK_ON + | KeyEvent.META_META_MASK); else - num_lock_flag = 0; + extra_ignored = 0; /* Ignore meta-state understood by Emacs for now, or key presses - such as Ctrl+C and Meta+C will not be recognized as an ASCII - key press event. */ + such as Ctrl+C and Meta+C will not be recognized as ASCII key + press events. */ state_1 = state & ~(KeyEvent.META_ALT_MASK | KeyEvent.META_CTRL_MASK - | KeyEvent.META_SYM_ON | KeyEvent.META_META_MASK - | num_lock_flag); + | KeyEvent.META_SYM_ON | extra_ignored); + + /* There's no distinction between Right Alt and Alt Gr on Android, + so restore META_ALT_RIGHT_ON if set in state to enable composing + characters. (bug#69321) */ + + if ((state & KeyEvent.META_ALT_RIGHT_ON) != 0) + { + state_1 |= KeyEvent.META_ALT_ON | KeyEvent.META_ALT_RIGHT_ON; + + /* If Alt is also not depressed, remove its bit from the mask + reported to Emacs. */ + if ((state & KeyEvent.META_ALT_LEFT_ON) == 0) + state &= ~KeyEvent.META_ALT_MASK; + } synchronized (eventStrings) { @@ -719,29 +733,43 @@ public final class EmacsWindow extends EmacsHandleObject public void onKeyUp (int keyCode, KeyEvent event) { - int state, state_1, unicode_char, num_lock_flag; + int state, state_1, unicode_char, extra_ignored; long time; /* Compute the event's modifier mask. */ state = eventModifiers (event); - /* Num Lock and Scroll Lock aren't supported by systems older than - Android 3.0. */ + /* Num Lock, Scroll Lock and Meta aren't supported by systems older + than Android 3.0. */ if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB) - num_lock_flag = (KeyEvent.META_NUM_LOCK_ON - | KeyEvent.META_SCROLL_LOCK_ON); + extra_ignored = (KeyEvent.META_NUM_LOCK_ON + | KeyEvent.META_SCROLL_LOCK_ON + | KeyEvent.META_META_MASK); else - num_lock_flag = 0; + extra_ignored = 0; /* Ignore meta-state understood by Emacs for now, or key presses - such as Ctrl+C and Meta+C will not be recognized as an ASCII - key press event. */ + such as Ctrl+C and Meta+C will not be recognized as ASCII key + press events. */ state_1 = state & ~(KeyEvent.META_ALT_MASK | KeyEvent.META_CTRL_MASK - | KeyEvent.META_SYM_ON | KeyEvent.META_META_MASK - | num_lock_flag); + | KeyEvent.META_SYM_ON | extra_ignored); + + /* There's no distinction between Right Alt and Alt Gr on Android, + so restore META_ALT_RIGHT_ON if set in state to enable composing + characters. */ + + if ((state & KeyEvent.META_ALT_RIGHT_ON) != 0) + { + state_1 |= KeyEvent.META_ALT_ON | KeyEvent.META_ALT_RIGHT_ON; + + /* If Alt is also not depressed, remove its bit from the mask + reported to Emacs. */ + if ((state & KeyEvent.META_ALT_LEFT_ON) == 0) + state &= ~KeyEvent.META_ALT_MASK; + } unicode_char = getEventUnicodeChar (event, state_1); -- cgit v1.2.3 From 56706254a8ee09e651097fb5075cae75b3bd4e22 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 21 Feb 2024 20:08:37 -0800 Subject: ; Don't mention erc-branded Compat macros in ERC-NEWS * doc/misc/erc.texi: Change fancy SASL example to also demonstrate `let'-binding a local module. * etc/ERC-NEWS: Don't mention `erc-compat-call' and `erc-compat-function' because Emacs now ships with a compat.el stub library. * lisp/erc/erc-backend.el (erc-decode-parsed-server-response): Add comments. * lisp/erc/erc.el (erc): Mention return value. --- doc/misc/erc.texi | 33 +++++++++++++++++++-------------- etc/ERC-NEWS | 2 -- lisp/erc/erc-backend.el | 2 ++ lisp/erc/erc.el | 5 +++-- 4 files changed, 24 insertions(+), 18 deletions(-) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index f877fb681fe..c7ab7e7bf21 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -1230,25 +1230,30 @@ machine Example.Net login aph-bot password sesame (defun my-erc-up (network) (interactive "Snetwork: ") - - (pcase network - ('libera - (let ((erc-sasl-mechanism 'external)) - (erc-tls :server "irc.libera.chat" :port 6697 - :client-certificate t))) - ('example - (let ((erc-sasl-auth-source-function - #'erc-sasl-auth-source-password-as-host)) - (erc-tls :server "irc.example.net" :port 6697 - :user "alyssa" - :password "Example.Net"))))) + (require 'erc-sasl) + (or (let ((erc-modules (cons 'sasl erc-modules))) + (pcase network + ('libera + (let ((erc-sasl-mechanism 'external)) + (erc-tls :server "irc.libera.chat" + :client-certificate t))) + ('example + (let ((erc-sasl-auth-source-function + #'erc-sasl-auth-source-password-as-host)) + (erc-tls :server "irc.example.net" + :user "alyssa" + :password "Example.Net"))))) + ;; Non-SASL + (call-interactively #'erc-tls))) @end lisp You've started storing your credentials with auth-source and have decided to try SASL on another network as well. But there's a catch: this network doesn't support @samp{EXTERNAL}. You use -@code{let}-binding to get around this and successfully authenticate to -both networks. +@code{let}-binding to work around this and successfully authenticate +to both networks. (Note that this example assumes you've removed +@code{sasl} from @code{erc-modules} globally and have instead opted to +add it locally when connecting to preconfigured networks.) @end itemize diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index b2aceaa9f39..e8082582de3 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -694,8 +694,6 @@ by toggling a provided compatibility switch. See source code around the function 'erc-send-action' for details. *** Miscellaneous changes -Two helper macros from GNU ELPA's Compat library are now available to -third-party modules as 'erc-compat-call' and 'erc-compat-function'. In 'erc-button-alist', 'Info-goto-node' has been supplanted by plain old 'info', and the "" entry has been removed because it was more or less redundant. In all ERC buffers, the "" key is now diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 7b782d0ef44..9fc8a4d29f4 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1479,10 +1479,12 @@ for decoding." (let ((args (erc-response.command-args parsed-response)) (decode-target nil) (decoded-args ())) + ;; FIXME this should stop after the first match. (dolist (arg args nil) (when (string-match "^[#&].*" arg) (setq decode-target arg))) (when (stringp decode-target) + ;; FIXME `decode-target' should be passed as TARGET. (setq decode-target (erc-decode-string-from-target decode-target nil))) (setf (erc-response.unparsed parsed-response) (erc-decode-string-from-target diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index f250584e47a..5c8b3785bc6 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2772,8 +2772,9 @@ PORT, NICK, and PASSWORD, along with USER and FULL-NAME when given a prefix argument. Non-interactively, expect the rarely needed ID parameter, when non-nil, to be a symbol or a string for naming the server buffer and identifying the connection -unequivocally. (See Info node `(erc) Connecting' for details -about all mentioned parameters.) +unequivocally. Once connected, return the server buffer. (See +Info node `(erc) Connecting' for details about all mentioned +parameters.) Together with `erc-tls', this command serves as the main entry point for ERC, the powerful, modular, and extensible IRC client. -- cgit v1.2.3 From 15a140a24664e96620838136640d660f842dfa49 Mon Sep 17 00:00:00 2001 From: Emanuel Berg Date: Tue, 23 Jan 2024 14:21:49 +0100 Subject: Make erc-cmd-AMSG session local; add /GMSG, /AME and /GME * etc/ERC-NEWS: Mention new slash commands. * lisp/erc/erc.el (erc-cmd-AMSG): Make it consistent with the doc string by only affecting the current connection. (erc-cmd-GMSG, erc-cmd-AME, erc-cmd-GME): New IRC slash commands. * test/lisp/erc/erc-scenarios-misc-commands.el (erc-scenarios-misc-commands--AMSG-GMSG-AME-GME): New test. * test/lisp/erc/resources/commands/amsg-barnet.eld: New file. * test/lisp/erc/resources/commands/amsg-foonet.eld: New file. (Bug#68401) --- etc/ERC-NEWS | 9 ++- lisp/erc/erc.el | 38 ++++++++-- test/lisp/erc/erc-scenarios-misc-commands.el | 90 ++++++++++++++++++++++++ test/lisp/erc/resources/commands/amsg-barnet.eld | 54 ++++++++++++++ test/lisp/erc/resources/commands/amsg-foonet.eld | 56 +++++++++++++++ 5 files changed, 239 insertions(+), 8 deletions(-) create mode 100644 test/lisp/erc/resources/commands/amsg-barnet.eld create mode 100644 test/lisp/erc/resources/commands/amsg-foonet.eld diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index e8082582de3..d7f513addfb 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -334,6 +334,11 @@ has changed in some way. At present, ERC does not perform this step automatically on your behalf, even if a change was made in a 'Custom-mode' buffer or via 'setopt'. +** New broadcast-oriented slash commands /AME, /GME, and /GMSG. +Also available as the library functions 'erc-cmd-AME', 'erc-cmd-GME', +and 'erc-cmd-GMSG', these new slash commands can prove handy in test +environments. + ** Miscellaneous UX changes. Some minor quality-of-life niceties have finally made their way to ERC. For example, fool visibility has become togglable with the new @@ -1375,7 +1380,7 @@ reconnection attempts that ERC will make per server. in seconds, that ERC will wait between successive reconnect attempts. *** erc-server-send-ping-timeout: Determines when to consider a connection -stalled and restart it. The default is after 120 seconds. +stalled and restart it. The default is after 120 seconds. *** erc-system-name: Determines the system name to use when logging in. The default is to figure this out by calling `system-name'. @@ -2336,7 +2341,7 @@ in XEmacs. Please use M-x customize-variable RET erc-modules RET to change the default if it does not suite your needs. -** THe symbol used in `erc-nickserv-passwords' for debian.org IRC servers +** The symbol used in `erc-nickserv-passwords' for debian.org IRC servers (formerly called OpenProjects, now FreeNode) has changed from openprojects to freenode. You may need to update your configuration for a successful automatic nickserv identification. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 5c8b3785bc6..cce3b2508fb 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4046,16 +4046,42 @@ this function from interpreting the line as a command." ;; Input commands handlers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun erc-cmd-AMSG (line) - "Send LINE to all channels of the current server that you are on." - (interactive "sSend to all channels you're on: ") - (setq line (erc-trim-string line)) +(defun erc--connected-and-joined-p () + (and (erc--current-buffer-joined-p) + erc-server-connected)) + +(defun erc-cmd-GMSG (line) + "Send LINE to all channels on all networks you are on." + (setq line (string-remove-prefix " " line)) (erc-with-all-buffers-of-server nil - (lambda () - (erc-channel-p (erc-default-target))) + #'erc--connected-and-joined-p + (erc-send-message line))) +(put 'erc-cmd-GMSG 'do-not-parse-args t) + +(defun erc-cmd-AMSG (line) + "Send LINE to all channels of the current network. +Interactively, prompt for the line of text to send." + (interactive "sSend to all channels on this network: ") + (setq line (string-remove-prefix " " line)) + (erc-with-all-buffers-of-server erc-server-process + #'erc--connected-and-joined-p (erc-send-message line))) (put 'erc-cmd-AMSG 'do-not-parse-args t) +(defun erc-cmd-GME (line) + "Send LINE as an action to all channels on all networks you are on." + (erc-with-all-buffers-of-server nil + #'erc--connected-and-joined-p + (erc-cmd-ME line))) +(put 'erc-cmd-GME 'do-not-parse-args t) + +(defun erc-cmd-AME (line) + "Send LINE as an action to all channels on the current network." + (erc-with-all-buffers-of-server erc-server-process + #'erc--connected-and-joined-p + (erc-cmd-ME line))) +(put 'erc-cmd-AME 'do-not-parse-args t) + (defun erc-cmd-SAY (line) "Send LINE to the current query or channel as a message, not a command. diff --git a/test/lisp/erc/erc-scenarios-misc-commands.el b/test/lisp/erc/erc-scenarios-misc-commands.el index d6ed53b5358..da6855caf57 100644 --- a/test/lisp/erc/erc-scenarios-misc-commands.el +++ b/test/lisp/erc/erc-scenarios-misc-commands.el @@ -123,4 +123,94 @@ (should (string= (erc-server-user-host (erc-get-server-user "tester")) "some.host.test.cc")))))) +;; This tests four related slash commands, /AMSG, /GMSG, /AME, /GME, +;; the latter three introduced by bug#68401. It mainly asserts +;; correct routing behavior, especially not sending or inserting +;; messages in buffers belonging to disconnected sessions. Left +;; unaddressed are interactions with the `command-indicator' module +;; (`erc-noncommands-list') and whatever future `echo-message' +;; implementation manifests out of bug#49860. +(ert-deftest erc-scenarios-misc-commands--AMSG-GMSG-AME-GME () + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "commands") + (erc-server-flood-penalty 0.1) + (dumb-server-foonet (erc-d-run "localhost" t "srv-foonet" 'amsg-foonet)) + (dumb-server-barnet (erc-d-run "localhost" t "srv-barnet" 'amsg-barnet)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to foonet and join #foo") + (with-current-buffer + (erc :server "127.0.0.1" + :port (process-contact dumb-server-foonet :service) + :nick "tester") + (funcall expect 10 "debug mode") + (erc-cmd-JOIN "#foo"))) + + (ert-info ("Connect to barnet and join #bar") + (with-current-buffer + (erc :server "127.0.0.1" + :port (process-contact dumb-server-barnet :service) + :nick "tester") + (funcall expect 10 "debug mode") + (erc-cmd-JOIN "#bar"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#foo")) + (funcall expect 10 "welcome")) + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#bar")) + (funcall expect 10 "welcome")) + + (ert-info ("/AMSG only sent to issuing context's server") + (with-current-buffer "foonet" + (erc-scenarios-common-say "/amsg 1 foonet only")) + (with-current-buffer "barnet" + (erc-scenarios-common-say "/amsg 2 barnet only")) + (with-current-buffer "#foo" + (funcall expect 10 " 1 foonet only") + (funcall expect 10 " bob: Our queen and all")) + (with-current-buffer "#bar" + (funcall expect 10 " 2 barnet only") + (funcall expect 10 " mike: And secretly to greet"))) + + (ert-info ("/AME only sent to issuing context's server") + (with-current-buffer "foonet" + (erc-scenarios-common-say "/ame 3 foonet only")) + (with-current-buffer "barnet" + (erc-scenarios-common-say "/ame 4 barnet only")) + (with-current-buffer "#foo" + (funcall expect 10 "* tester 3 foonet only") + (funcall expect 10 " bob: You have discharged this")) + (with-current-buffer "#bar" + (funcall expect 10 "* tester 4 barnet only") + (funcall expect 10 " mike: That same Berowne"))) + + (ert-info ("/GMSG and /GME sent to all servers") + (with-current-buffer "foonet" + (erc-scenarios-common-say "/gmsg 5 all nets") + (erc-scenarios-common-say "/gme 6 all nets")) + (with-current-buffer "#bar" + (funcall expect 10 " 5 all nets") + (funcall expect 10 "* tester 6 all nets") + (funcall expect 10 " mike: Mehercle! if their sons"))) + + (ert-info ("/GMSG and /GME only sent to connected servers") + (with-current-buffer "barnet" + (erc-cmd-QUIT "") + (funcall expect 10 "ERC finished")) + (with-current-buffer "#foo" + (funcall expect 10 " 5 all nets") + (funcall expect 10 "* tester 6 all nets") + (funcall expect 10 " bob: Stand you!")) + (with-current-buffer "foonet" + (erc-scenarios-common-say "/gmsg 7 all live nets") + (erc-scenarios-common-say "/gme 8 all live nets")) + ;; Message *not* inserted in disconnected buffer. + (with-current-buffer "#bar" + (funcall expect -0.1 " 7 all live nets") + (funcall expect -0.1 "* tester 8 all live nets"))) + + (with-current-buffer "#foo" + (funcall expect 10 " 7 all live nets") + (funcall expect 10 "* tester 8 all live nets") + (funcall expect 10 " alice: Live, and be prosperous;")))) + ;;; erc-scenarios-misc-commands.el ends here diff --git a/test/lisp/erc/resources/commands/amsg-barnet.eld b/test/lisp/erc/resources/commands/amsg-barnet.eld new file mode 100644 index 00000000000..53b3e18651a --- /dev/null +++ b/test/lisp/erc/resources/commands/amsg-barnet.eld @@ -0,0 +1,54 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :unknown") + (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester") + (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16") + (0 ":irc.barnet.org 003 tester :This server was created Tue, 04 May 2021 05:06:19 UTC") + (0 ":irc.barnet.org 004 tester irc.barnet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0 ":irc.barnet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") + (0 ":irc.barnet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server") + (0 ":irc.barnet.org 005 tester draft/CHATHISTORY=100 :are supported by this server") + (0 ":irc.barnet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0 ":irc.barnet.org 252 tester 0 :IRC Operators online") + (0 ":irc.barnet.org 253 tester 0 :unregistered connections") + (0 ":irc.barnet.org 254 tester 1 :channels formed") + (0 ":irc.barnet.org 255 tester :I have 3 clients and 0 servers") + (0 ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3") + (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3") + (0 ":irc.barnet.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0 ":irc.barnet.org 221 tester +i") + (0 ":irc.barnet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((join 10 "JOIN #bar") + (0 ":tester!~u@jnu48g2wrycbw.irc JOIN #bar") + (0 ":irc.barnet.org 353 tester = #bar :@mike joe tester") + (0 ":irc.barnet.org 366 tester #bar :End of NAMES list")) + +((mode-bar 10 "MODE #bar") + (0 ":irc.barnet.org 324 tester #bar +nt") + (0 ":irc.barnet.org 329 tester #bar 1620104779") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :tester, welcome!") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :tester, welcome!") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: Whipp'd first, sir, and hang'd after.") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: We have yet many among us can gripe as hard as Cassibelan; I do not say I am one, but I have a hand. Why tribute ? why should we pay tribute ? If C sar can hide the sun from us with a blanket, or put the moon in his pocket, we will pay him tribute for light; else, sir, no more tribute, pray you now.")) + +((privmsg-2 10 "PRIVMSG #bar :2 barnet only") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: Double and treble admonition, and still forfeit in the same kind ? This would make mercy swear, and play the tyrant.") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: And secretly to greet the empress' friends.")) + +((privmsg-4 10 "PRIVMSG #bar :\1ACTION 4 barnet only\1") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: You have not been inquired after: I have sat here all day.") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: That same Berowne I'll torture ere I go.")) + +((privmsg-5 10 "PRIVMSG #bar :5 all nets")) + +((privmsg-6 10 "PRIVMSG #bar :\1ACTION 6 all nets\1") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: For mine own part,no offence to the general, nor any man of quality,I hope to be saved.") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: Mehercle! if their sons be ingenuous, they shall want no instruction; if their daughters be capable, I will put it to them. But, vir sapit qui pauca loquitur. A soul feminine saluteth us.")) + +((quit 5 "QUIT :\2ERC\2") + (0 ":tester!~u@jnu48g2wrycbw.irc QUIT :Quit")) + +((drop 0 DROP)) diff --git a/test/lisp/erc/resources/commands/amsg-foonet.eld b/test/lisp/erc/resources/commands/amsg-foonet.eld new file mode 100644 index 00000000000..eb3d84d646a --- /dev/null +++ b/test/lisp/erc/resources/commands/amsg-foonet.eld @@ -0,0 +1,56 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :unknown") + (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16") + (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC") + (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") + (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server") + (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server") + (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0 ":irc.foonet.org 254 tester 1 :channels formed") + (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0 ":irc.foonet.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0 ":irc.foonet.org 221 tester +i") + (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((join 10 "JOIN #foo") + (0 ":tester!~u@9g6b728983yd2.irc JOIN #foo") + (0 ":irc.foonet.org 353 tester = #foo :alice tester @bob") + (0 ":irc.foonet.org 366 tester #foo :End of NAMES list")) + +((mode-foo 10 "MODE #foo") + (0 ":irc.foonet.org 324 tester #foo +nt") + (0 ":irc.foonet.org 329 tester #foo 1620104779") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :tester, welcome!") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :tester, welcome!") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: But, as it seems, did violence on herself.") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Well, this is the forest of Arden.")) + +((privmsg-1 10 "PRIVMSG #foo :1 foonet only") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Signior Iachimo will not from it. Pray, let us follow 'em.") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Our queen and all her elves come here anon.")) + +((privmsg-3 10 "PRIVMSG #foo :\1ACTION 3 foonet only\1") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: The ground is bloody; search about the churchyard.") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: You have discharged this honestly: keep it to yourself. Many likelihoods informed me of this before, which hung so tottering in the balance that I could neither believe nor misdoubt. Pray you, leave me: stall this in your bosom; and I thank you for your honest care. I will speak with you further anon.")) + +((privmsg-5 10 "PRIVMSG #foo :5 all nets")) + +((privmsg-6 10 "PRIVMSG #foo :\1ACTION 6 all nets\1") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Give me that mattock, and the wrenching iron.") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Stand you! You have land enough of your own; but he added to your having, gave you some ground.")) + +((privmsg-6 10 "PRIVMSG #foo :7 all live nets") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Excellent workman! Thou canst not paint a man so bad as is thyself.")) + +((privmsg-6 10 "PRIVMSG #foo :\1ACTION 8 all live nets\1") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: And will you, being a man of your breeding, be married under a bush, like a beggar ? Get you to church, and have a good priest that can tell you what marriage is: this fellow will but join you together as they join wainscot; then one of you will prove a shrunk panel, and like green timber, warp, warp.") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Live, and be prosperous; and farewell, good fellow.")) -- cgit v1.2.3 From c7a2b7d023dfef78f6cb6f00fc8194ce8eaaf8a4 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 24 Feb 2024 11:09:05 +0800 Subject: * configure.ac: Detect renameat2 with gl_CHECK_FUNCS_ANDROID. --- configure.ac | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 71a899f5f40..452aa0838f1 100644 --- a/configure.ac +++ b/configure.ac @@ -5907,13 +5907,15 @@ pthread_sigmask strsignal setitimer \ sendto recvfrom getsockname getifaddrs freeifaddrs \ gai_strerror sync \ endpwent getgrent endgrent \ -renameat2 \ cfmakeraw cfsetspeed __executable_start log2 pthread_setname_np \ pthread_set_name_np]) # getpwent is not present in older versions of Android. (bug#65319) gl_CHECK_FUNCS_ANDROID([getpwent], [[#include ]]) +# renameat2 is not present in older versions of Android. +gl_CHECK_FUNCS_ANDROID([renameat2], [[#include ]]) + if test "$ac_cv_func_cfmakeraw" != "yes"; then # On some systems (Android), cfmakeraw is inline, so AC_CHECK_FUNCS # cannot find it. Check if some code including termios.h and using -- cgit v1.2.3 From 15b6d72599b961ebe23e820e44ba2ffc12e49c31 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Feb 2024 09:21:35 +0200 Subject: ; * etc/NEWS: How to fix old code that uses vectors as obarrays. --- etc/NEWS | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 5653b51784f..6acafe6ea4a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2025,6 +2025,14 @@ The old vector representation is still accepted by functions operating on obarrays, but 'obarrayp' only returns 't' for obarray objects. 'type-of' now returns 'obarray' for obarray objects. +If you have code which creates obarrays as a simple Lisp vector: + + (make-vector N nil) + +and then calls 'intern' using such an obarray as second argument, this +will now signal a wrong-type-argument error; replace nil with zero to +make it work again. + +++ *** New function 'obarray-clear' removes all symbols from an obarray. -- cgit v1.2.3 From 8b1f10f8cf473cdc57e780845393d8681ee2ed4c Mon Sep 17 00:00:00 2001 From: Morgan Smith Date: Fri, 23 Feb 2024 19:03:13 -0500 Subject: ; Normalize Morgan Smith's attributions. --- .mailmap | 2 +- admin/authors.el | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/.mailmap b/.mailmap index 5e733728b5a..32f56c07e1e 100644 --- a/.mailmap +++ b/.mailmap @@ -126,7 +126,7 @@ Maxim Nikulin Michael Albinus Michalis V Miha Rihtaršič -Morgan J. Smith +Morgan Smith Nick Drozd Nicolas Petton Nitish Chandra diff --git a/admin/authors.el b/admin/authors.el index 083023a3dad..78a047f14a4 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -199,6 +199,7 @@ files.") ("Mikio Nakajima" "Nakajima Mikio") (nil "montag451@laposte\\.net") (nil "na@aisrntairetnraoitn") + ("Morgan Smith" "Morgan J. Smith") ("Nelson Jose dos Santos Ferreira" "Nelson Ferreira") ("Noah Peart" "noah\\.v\\.peart@gmail\\.com") ("Noorul Islam" "Noorul Islam K M") -- cgit v1.2.3 From afe49c7e2a2340432418df264f93d8ac88bca95f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Feb 2024 09:32:06 +0200 Subject: ; * admin/authors.el (authors-aliases): Fix last change. --- admin/authors.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/admin/authors.el b/admin/authors.el index 78a047f14a4..3764c16adf0 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -199,7 +199,7 @@ files.") ("Mikio Nakajima" "Nakajima Mikio") (nil "montag451@laposte\\.net") (nil "na@aisrntairetnraoitn") - ("Morgan Smith" "Morgan J. Smith") + ("Morgan Smith" "Morgan J\\. Smith") ("Nelson Jose dos Santos Ferreira" "Nelson Ferreira") ("Noah Peart" "noah\\.v\\.peart@gmail\\.com") ("Noorul Islam" "Noorul Islam K M") -- cgit v1.2.3 From d1fe392f93ce7e71cd378326814ec4e3a4143f0c Mon Sep 17 00:00:00 2001 From: Arash Esbati Date: Sat, 24 Feb 2024 09:30:16 +0100 Subject: ; Fix compiler warning * lisp/textmodes/reftex-vars.el (reftex-cite-format-builtin): Fix character escaping in the docstring. (bug#69341) --- lisp/textmodes/reftex-vars.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index a0bc5c11ece..791b10412c9 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -235,11 +235,10 @@ distribution. Mixed-case symbols are convenience aliases.") "ConTeXt bib module" ((?\C-m . "\\cite[%l]") (?s . "\\cite[][%l]") - (?n . "\\nocite[%l]"))) - ) + (?n . "\\nocite[%l]")))) "Builtin versions of the citation format. The following conventions are valid for all alist entries: -`?\C-m' should always point to a straight \\cite{%l} macro. +`?\\C-m' should always point to a straight \\cite{%l} macro. `?t' should point to a textual citation (citation as a noun). `?p' should point to a parenthetical citation.") -- cgit v1.2.3 From 0bdd2eb9af171fa9d825bc6d09e0ad5d114684c4 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Wed, 14 Feb 2024 11:09:33 -0500 Subject: Add context to errors thrown by server-start during startup When server-start errors during startup, the error is printed to the terminal without context. To help the user understand better what went wrong, that printed error now mentions that the error came from starting up the daemon. * lisp/startup.el (command-line): Catch and annotate errors thrown by server-start. (bug#68799) --- lisp/startup.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/startup.el b/lisp/startup.el index 1c21b5de857..33e1124b998 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1639,7 +1639,9 @@ Consider using a subdirectory instead, e.g.: %s" (let ((dn (daemonp))) (when dn (when (stringp dn) (setq server-name dn)) - (server-start) + (condition-case err + (server-start) + (error (error "Unable to start daemon: %s; exiting" (error-message-string err)))) (if server-process (daemon-initialized) (if (stringp dn) -- cgit v1.2.3 From 526c262149839702b94253d5eff195054ac5cd9e Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Tue, 13 Feb 2024 12:20:39 -0500 Subject: Check daemon is initialized before suppressing its init errors Previously, the default error handler would correctly suppress unhandled errors raised when IS_DAEMON and the initial frame was current, since this is the normal state of operation for a daemon-mode Emacs. However, this also incorrectly suppressed errors raised while a daemon-mode Emacs was starting up. Now, errors raised while a daemon-mode Emacs is starting up will be handled just like errors when a non-daemon Emacs is starting up. This was previously the case before changes for bug#1310 and bug#1836, which added the suppression of errors when IS_DAEMON. DAEMON_RUNNING didn't exist at the time of those changes, but now it does, so we can do better. * src/keyboard.c (Fcommand_error_default_function): Check !DAEMON_RUNNING in addition to IS_DAEMON. (Bug#68799) * src/lisp.h (DAEMON_RUNNING): Add a clarifying comment about what this #define means. --- src/keyboard.c | 5 +++-- src/lisp.h | 1 + 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/keyboard.c b/src/keyboard.c index 4b5e20fb24c..eb0de98bad1 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1076,8 +1076,9 @@ Default value of `command-error-function'. */) write to stderr and quit. In daemon mode, there are many other potential errors that do not prevent frames from being created, so continuing as normal is better in - that case. */ - || (!IS_DAEMON && FRAME_INITIAL_P (sf)) + that case, as long as the daemon has actually finished + initialization. */ + || (!(IS_DAEMON && !DAEMON_RUNNING) && FRAME_INITIAL_P (sf)) || noninteractive)) { print_error_message (data, Qexternal_debugging_output, diff --git a/src/lisp.h b/src/lisp.h index 5fbbef80e8e..309bea02238 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -5153,6 +5153,7 @@ extern bool build_details; /* 0 not a daemon, 1 foreground daemon, 2 background daemon. */ extern int daemon_type; #define IS_DAEMON (daemon_type != 0) +/* True means daemon-initialized has not yet been called. */ #define DAEMON_RUNNING (daemon_type >= 0) #else /* WINDOWSNT */ extern void *w32_daemon_event; -- cgit v1.2.3 From 03fce8401639a1d60bb66bf374d3d44b3331ac8a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Feb 2024 11:27:12 +0200 Subject: ; Fix last change in lisp.h. --- src/lisp.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lisp.h b/src/lisp.h index 309bea02238..f353e4956eb 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -5153,7 +5153,7 @@ extern bool build_details; /* 0 not a daemon, 1 foreground daemon, 2 background daemon. */ extern int daemon_type; #define IS_DAEMON (daemon_type != 0) -/* True means daemon-initialized has not yet been called. */ +/* Non-zero means daemon-initialized has not yet been called. */ #define DAEMON_RUNNING (daemon_type >= 0) #else /* WINDOWSNT */ extern void *w32_daemon_event; -- cgit v1.2.3 From 01ebc95114fe89ef623bc7ebdd3c3e1b9ef06b4e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Feb 2024 11:59:30 +0200 Subject: Fix 'help-quick-toggle' * lisp/help.el (help-quick-sections): Fix "kill-region" command. Add a doc string. (Bug#69345) --- lisp/help.el | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/lisp/help.el b/lisp/help.el index accd01e56f5..24e4b9890a7 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -151,7 +151,7 @@ buffer.") ("Mark & Kill" (set-mark-command . "mark") (kill-line . "kill line") - (kill-ring-save . "kill region") + (kill-region . "kill region") (yank . "yank") (exchange-point-and-mark . "swap")) ("Projects" @@ -165,7 +165,15 @@ buffer.") (isearch-forward . "search") (isearch-backward . "reverse search") (query-replace . "search & replace") - (fill-paragraph . "reformat")))) + (fill-paragraph . "reformat"))) + "Data structure for `help-quick'. +Value should be a list of elements, each element should of the form + + (GROUP-NAME (COMMAND . DESCRIPTION) (COMMAND . DESCRIPTION)...) + +where GROUP-NAME is the name of the group of the commands, +COMMAND is the symbol of a command and DESCRIPTION is its short +description, 10 to 15 char5acters at most.") (declare-function prop-match-value "text-property-search" (match)) -- cgit v1.2.3 From 477eb882b57b3defd43ea8dd9510cfdf5fd9ee79 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 13 Feb 2024 10:38:48 +0100 Subject: Add sml-mode entry to 'eglot-server-programs' * lisp/progmodes/eglot.el (eglot-server-programs): Use the "millet" LSP server (https://github.com/azdavis/millet). --- lisp/progmodes/eglot.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 2f32a8e6eda..f341428cac3 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -310,7 +310,10 @@ automatically)." ("vscode-markdown-language-server" "--stdio")))) (graphviz-dot-mode . ("dot-language-server" "--stdio")) (terraform-mode . ("terraform-ls" "serve")) - ((uiua-ts-mode uiua-mode) . ("uiua" "lsp"))) + ((uiua-ts-mode uiua-mode) . ("uiua" "lsp")) + (sml-mode + . ,(lambda (_interactive project) + (list "millet-ls" (project-root project))))) "How the command `eglot' guesses the server to start. An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE identifies the buffers that are to be managed by a specific -- cgit v1.2.3 From 1972beda6de3d6895cc197dc292721ca963b234c Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 24 Feb 2024 11:43:28 +0100 Subject: ; * etc/NEWS: Recommend obarray-make as correct replacement. --- etc/NEWS | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 6acafe6ea4a..a47376f7f02 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2025,13 +2025,9 @@ The old vector representation is still accepted by functions operating on obarrays, but 'obarrayp' only returns 't' for obarray objects. 'type-of' now returns 'obarray' for obarray objects. -If you have code which creates obarrays as a simple Lisp vector: - - (make-vector N nil) - -and then calls 'intern' using such an obarray as second argument, this -will now signal a wrong-type-argument error; replace nil with zero to -make it work again. +Old code which incorrectly created "obarrays" as Lisp vectors filled +with something other than 0, as in '(make-vector N nil)', will no longer +work at all and should be rewritten to use 'obarray-make'. +++ *** New function 'obarray-clear' removes all symbols from an obarray. -- cgit v1.2.3 From 4eed2768b10d074612853b68248a4b255a5c7d58 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Feb 2024 13:03:11 +0200 Subject: ; Fix last change. --- etc/NEWS | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index a47376f7f02..0578da899bb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2025,9 +2025,10 @@ The old vector representation is still accepted by functions operating on obarrays, but 'obarrayp' only returns 't' for obarray objects. 'type-of' now returns 'obarray' for obarray objects. -Old code which incorrectly created "obarrays" as Lisp vectors filled +Old code which (incorrectly) created "obarrays" as Lisp vectors filled with something other than 0, as in '(make-vector N nil)', will no longer -work at all and should be rewritten to use 'obarray-make'. +work, and should be rewritten to use 'obarray-make'. Alternatively, you +can fill the vector with 0. +++ *** New function 'obarray-clear' removes all symbols from an obarray. -- cgit v1.2.3 From eeb89a5cb292bffe40ba7d0b0cf81f82f8452bf8 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 24 Feb 2024 12:08:09 +0100 Subject: Suppress docstring control char warning in macro-generated function * lisp/progmodes/cc-defs.el (c-lang-defconst): Make sure that `val` won't be treated as a docstring. --- lisp/progmodes/cc-defs.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index e45ab76ec07..2c793c8a99d 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -2579,7 +2579,8 @@ constant. A file is identified by its base name." ;; dependencies on the `c-lang-const's in VAL.) (setq val (c--macroexpand-all val)) - (setq bindings `(cons (cons ',assigned-mode (lambda () ,val)) ,bindings) + (setq bindings `(cons (cons ',assigned-mode (lambda () nil ,val)) + ,bindings) args (cdr args)))) ;; Compile in the other files that have provided source -- cgit v1.2.3 From 0530800175913769cb55ae7997ee4487a755a0a4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Feb 2024 15:12:57 +0200 Subject: Fix infinite recursion in gdb-mi.el * lisp/progmodes/gdb-mi.el: (gdb-clear-partial-output) (gdb-clear-inferior-io): Set inhibit-read-only, to avoid signaling errors in process filter. (Bug#69327) --- lisp/progmodes/gdb-mi.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index d119eeb74ac..312b71ba640 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1849,7 +1849,8 @@ this trigger is subscribed to `gdb-buf-publisher' and called with (defun gdb-clear-inferior-io () (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io) - (erase-buffer))) + (let ((inhibit-read-only t)) + (erase-buffer)))) (defconst breakpoint-xpm-data @@ -2819,7 +2820,8 @@ current thread and update GDB buffers." (defun gdb-clear-partial-output () (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) - (erase-buffer))) + (let ((inhibit-read-only t)) + (erase-buffer)))) ;; Parse GDB/MI result records: this process converts ;; list [...] -> list -- cgit v1.2.3 From 3076e79a6a11f9df33c5bcaa7aa58955550aeef0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Feb 2024 17:13:47 +0200 Subject: ; Fix a recent change in diff-mode.el * lisp/vc/diff-mode.el (diff-refine-nonmodified): Doc fix. * etc/NEWS: Improve wording. --- etc/NEWS | 7 +++++-- lisp/vc/diff-mode.el | 10 ++++++++-- 2 files changed, 13 insertions(+), 4 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 0578da899bb..882d97ec423 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -598,8 +598,11 @@ It allows tweaking the thresholds for rename and copy detection. --- *** New user option 'diff-refine-nonmodified'. -Makes 'diff-refine' highlight added and removed whole lines with the -same faces as the words added and removed within modified lines. +When this is non-nil, 'diff-refine' will highlight lines that were added +or removed in their entirety (as opposed to modified lines, where some +parts of the line were modified), using the same faces as for +highlighting the words added and removed within modified lines. The +default value is nil. +++ *** 'diff-ignore-whitespace-hunk' can now be applied to all hunks. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index f914cc76790..14a401667e9 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2283,8 +2283,14 @@ Return new point, if it was moved." (overlay-put ol 'face face))) (defcustom diff-refine-nonmodified nil - "If non-nil also highlight as \"refined\" the added/removed lines. -This is currently only implemented for `unified' diffs." + "If non-nil, also highlight the added/removed lines as \"refined\". +The lines highlighted when this is non-nil are those that were +added or removed in their entirety, as opposed to lines some +parts of which were modified. The added lines are highlighted +using the `diff-refine-added' face, while the removed lines are +highlighted using the `diff-refine-removed' face. +This is currently implemented only for diff formats supported +by `diff-refine-hunk'." :version "30.1" :type 'boolean) -- cgit v1.2.3 From 68096a716bfe3c212a68b3d285a0386ea0867130 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 24 Feb 2024 11:02:37 -0500 Subject: (diff-refine-nonmodified): Complete the implementation * lisp/vc/diff-mode.el (diff--refine-hunk): Implement `diff-refine-nonmodified` for old-style-context and "normal" diffs. --- lisp/vc/diff-mode.el | 47 ++++++++++++++++++++++++++++++++--------------- 1 file changed, 32 insertions(+), 15 deletions(-) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 14a401667e9..99ac50c155a 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2333,26 +2333,43 @@ by `diff-refine-hunk'." ('context (let* ((middle (save-excursion (re-search-forward "^---" end t))) (other middle)) - (while (and middle - (re-search-forward "^\\(?:!.*\n\\)+" middle t)) - (smerge-refine-regions (match-beginning 0) (match-end 0) - (save-excursion - (goto-char other) - (re-search-forward "^\\(?:!.*\n\\)+" end) - (setq other (match-end 0)) - (match-beginning 0)) - other - (if diff-use-changed-face props-c) - #'diff-refine-preproc - (unless diff-use-changed-face props-r) - (unless diff-use-changed-face props-a))))) + (when middle + (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) + (smerge-refine-regions (match-beginning 0) (match-end 0) + (save-excursion + (goto-char other) + (re-search-forward "^\\(?:!.*\n\\)+" end) + (setq other (match-end 0)) + (match-beginning 0)) + other + (if diff-use-changed-face props-c) + #'diff-refine-preproc + (unless diff-use-changed-face props-r) + (unless diff-use-changed-face props-a))) + (when diff-refine-nonmodified + (goto-char beg) + (while (re-search-forward "^\\(?:-.*\n\\)+" middle t) + (diff--refine-propertize (match-beginning 0) + (match-end 0) + 'diff-refine-removed)) + (goto-char middle) + (while (re-search-forward "^\\(?:+.*\n\\)+" end t) + (diff--refine-propertize (match-beginning 0) + (match-end 0) + 'diff-refine-added)))))) (_ ;; Normal diffs. (let ((beg1 (1+ (point)))) - (when (re-search-forward "^---.*\n" end t) + (cond + ((re-search-forward "^---.*\n" end t) ;; It's a combined add&remove, so there's something to do. (smerge-refine-regions beg1 (match-beginning 0) (match-end 0) end - nil #'diff-refine-preproc props-r props-a))))))) + nil #'diff-refine-preproc props-r props-a)) + (diff-refine-nonmodified + (diff--refine-propertize + beg1 end + (if (eq (char-after beg1) ?<) + 'diff-refine-removed 'diff-refine-added))))))))) (defun diff--iterate-hunks (max fun) "Iterate over all hunks between point and MAX. -- cgit v1.2.3 From 56beeff14365d8e802ab7b4888aa7e95b2cf9509 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 24 Feb 2024 12:23:41 -0500 Subject: * src/editfns.c (Fget_pos_property): Fix thinko (bug#69358) --- src/editfns.c | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/editfns.c b/src/editfns.c index cce52cddbf8..4ccf765bd4b 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -301,8 +301,8 @@ at POSITION. */) struct buffer *obuf = current_buffer; struct itree_node *node; struct sortvec items[2]; - struct sortvec *result = NULL; struct buffer *b = XBUFFER (object); + struct sortvec *result = NULL; Lisp_Object res = Qnil; set_buffer_temp (b); @@ -326,7 +326,10 @@ at POSITION. */) if (NILP (res) || (make_sortvec_item (this, node->data), compare_overlays (result, this) < 0)) - res = tem; + { + result = this; + res = tem; + } } set_buffer_temp (obuf); -- cgit v1.2.3 From de6b1e1efb1a36c69e7a6e09297e1de5b1477121 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 24 Feb 2024 17:47:37 +0100 Subject: Replace XSETSYMBOL with make_lisp_symbol * src/lisp.h (XSETSYMBOL): Remove. All callers changed to use make_lisp_symbol. --- src/alloc.c | 12 ++++-------- src/buffer.c | 4 ++-- src/data.c | 33 ++++++++++++++------------------- src/eval.c | 2 +- src/lisp.h | 1 - 5 files changed, 21 insertions(+), 31 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 2ffd2415447..16257469aa6 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3960,7 +3960,7 @@ Its value is void, and its function definition and property list are nil. */) if (symbol_free_list) { ASAN_UNPOISON_SYMBOL (symbol_free_list); - XSETSYMBOL (val, symbol_free_list); + val = make_lisp_symbol (symbol_free_list); symbol_free_list = symbol_free_list->u.s.next; } else @@ -3976,7 +3976,7 @@ Its value is void, and its function definition and property list are nil. */) } ASAN_UNPOISON_SYMBOL (&symbol_block->symbols[symbol_block_index]); - XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]); + val = make_lisp_symbol (&symbol_block->symbols[symbol_block_index]); symbol_block_index++; } @@ -7398,12 +7398,8 @@ process_mark_stack (ptrdiff_t base_sp) mark_stack_push_value (SYMBOL_VAL (ptr)); break; case SYMBOL_VARALIAS: - { - Lisp_Object tem; - XSETSYMBOL (tem, SYMBOL_ALIAS (ptr)); - mark_stack_push_value (tem); - break; - } + mark_stack_push_value (make_lisp_symbol (SYMBOL_ALIAS (ptr))); + break; case SYMBOL_LOCALIZED: { struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (ptr); diff --git a/src/buffer.c b/src/buffer.c index d67e1d67cd6..e235ff8f9f8 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1334,7 +1334,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer) case SYMBOL_LOCALIZED: { /* Look in local_var_alist. */ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); - XSETSYMBOL (variable, sym); /* Update In case of aliasing. */ + variable = make_lisp_symbol (sym); /* Update In case of aliasing. */ result = assq_no_quit (variable, BVAR (buf, local_var_alist)); if (!NILP (result)) { @@ -4971,7 +4971,7 @@ defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring, sym->u.s.declared_special = true; sym->u.s.redirect = SYMBOL_FORWARDED; SET_SYMBOL_FWD (sym, bo_fwd); - XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym); + PER_BUFFER_SYMBOL (offset) = make_lisp_symbol (sym); if (PER_BUFFER_IDX (offset) == 0) /* Did a DEFVAR_PER_BUFFER without initializing the corresponding diff --git a/src/data.c b/src/data.c index bb4cdd62d66..da507901b76 100644 --- a/src/data.c +++ b/src/data.c @@ -1256,7 +1256,7 @@ If OBJECT is not a symbol, just return it. */) struct Lisp_Symbol *sym = XSYMBOL (object); while (sym->u.s.redirect == SYMBOL_VARALIAS) sym = SYMBOL_ALIAS (sym); - XSETSYMBOL (object, sym); + object = make_lisp_symbol (sym); } return object; } @@ -1506,12 +1506,9 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_ if (blv->fwd.fwdptr) set_blv_value (blv, do_symval_forwarding (blv->fwd)); /* Choose the new binding. */ - { - Lisp_Object var; - XSETSYMBOL (var, symbol); - tem1 = assq_no_quit (var, BVAR (current_buffer, local_var_alist)); - set_blv_where (blv, Fcurrent_buffer ()); - } + tem1 = assq_no_quit (make_lisp_symbol (symbol), + BVAR (current_buffer, local_var_alist)); + set_blv_where (blv, Fcurrent_buffer ()); if (!(blv->found = !NILP (tem1))) tem1 = blv->defcell; @@ -1655,7 +1652,8 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, set_blv_value (blv, do_symval_forwarding (blv->fwd)); /* Find the new binding. */ - XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */ + /* May have changed via aliasing. */ + symbol = make_lisp_symbol (sym); Lisp_Object tem1 = assq_no_quit (symbol, BVAR (XBUFFER (where), local_var_alist)); @@ -2059,13 +2057,10 @@ make_blv (struct Lisp_Symbol *sym, bool forwarded, union Lisp_Val_Fwd valcontents) { struct Lisp_Buffer_Local_Value *blv = xmalloc (sizeof *blv); - Lisp_Object symbol; - Lisp_Object tem; - - XSETSYMBOL (symbol, sym); - tem = Fcons (symbol, (forwarded - ? do_symval_forwarding (valcontents.fwd) - : valcontents.value)); + Lisp_Object tem = Fcons (make_lisp_symbol (sym), + forwarded + ? do_symval_forwarding (valcontents.fwd) + : valcontents.value); /* Buffer_Local_Values cannot have as realval a buffer-local or keyboard-local forwarding. */ @@ -2221,7 +2216,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) } /* Make sure this buffer has its own value of symbol. */ - XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ + variable = make_lisp_symbol (sym); /* Update in case of aliasing. */ tem = assq_no_quit (variable, BVAR (current_buffer, local_var_alist)); if (NILP (tem)) { @@ -2301,7 +2296,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) notify_variable_watchers (variable, Qnil, Qmakunbound, Fcurrent_buffer ()); /* Get rid of this buffer's alist element, if any. */ - XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ + variable = make_lisp_symbol (sym); /* Propagate variable indirection. */ tem = assq_no_quit (variable, BVAR (current_buffer, local_var_alist)); if (!NILP (tem)) bset_local_var_alist @@ -2346,7 +2341,7 @@ Also see `buffer-local-boundp'.*/) Lisp_Object tmp; struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); XSETBUFFER (tmp, buf); - XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ + variable = make_lisp_symbol (sym); /* Update in case of aliasing. */ if (EQ (blv->where, tmp)) /* The binding is already loaded. */ return blv_found (blv) ? Qt : Qnil; @@ -2396,7 +2391,7 @@ value in BUFFER, or if VARIABLE is automatically buffer-local (see struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); if (blv->local_if_set) return Qt; - XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ + variable = make_lisp_symbol (sym); /* Update in case of aliasing. */ return Flocal_variable_p (variable, buffer); } case SYMBOL_FORWARDED: diff --git a/src/eval.c b/src/eval.c index 95eb21909d2..9d3b98eb359 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3475,7 +3475,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) switch (sym->u.s.redirect) { case SYMBOL_VARALIAS: - sym = SYMBOL_ALIAS (sym); XSETSYMBOL (symbol, sym); goto start; + sym = SYMBOL_ALIAS (sym); symbol = make_lisp_symbol (sym); goto start; case SYMBOL_PLAINVAL: /* The most common case is that of a non-constant symbol with a trivial value. Make that as fast as we can. */ diff --git a/src/lisp.h b/src/lisp.h index f353e4956eb..4fc44745211 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1380,7 +1380,6 @@ make_lisp_ptr (void *ptr, enum Lisp_Type type) #define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons)) #define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike)) #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String)) -#define XSETSYMBOL(a, b) ((a) = make_lisp_symbol (b)) #define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float)) /* Return a Lisp_Object value that does not correspond to any object. -- cgit v1.2.3 From 5fa6042c739b2b0abb320964d5391704c8fbb5a6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 24 Feb 2024 12:49:20 -0500 Subject: * etc/NEWS.25: Add missing announcement of 'obarray' package --- etc/NEWS.25 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/etc/NEWS.25 b/etc/NEWS.25 index 3c5e9569b49..1f26e7705d9 100644 --- a/etc/NEWS.25 +++ b/etc/NEWS.25 @@ -1158,6 +1158,11 @@ few or no entries have changed. * New Modes and Packages in Emacs 25.1 +** New preloaded package 'obarray' + +Provides obarray operations under the 'obarray-' prefix, such as +'obarray-make' and 'obarray-map'. + ** pinentry.el allows GnuPG passphrase to be prompted through the minibuffer instead of a graphical dialog, depending on whether the gpg command is called from Emacs (i.e., INSIDE_EMACS environment variable -- cgit v1.2.3 From 0503657a9cffbe3a5fc4f0023ee9985073e62d2c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 24 Feb 2024 13:12:20 -0500 Subject: * etc/NEWS.25: Add 'obarrayp' as well --- etc/NEWS.25 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etc/NEWS.25 b/etc/NEWS.25 index 1f26e7705d9..f647809074b 100644 --- a/etc/NEWS.25 +++ b/etc/NEWS.25 @@ -1161,7 +1161,7 @@ few or no entries have changed. ** New preloaded package 'obarray' Provides obarray operations under the 'obarray-' prefix, such as -'obarray-make' and 'obarray-map'. +'obarray-make', 'obarrayp', and 'obarray-map'. ** pinentry.el allows GnuPG passphrase to be prompted through the minibuffer instead of a graphical dialog, depending on whether the gpg -- cgit v1.2.3 From 9a801f0b4621a46149ccf650ed1dc27942157562 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 24 Feb 2024 17:52:14 -0500 Subject: * lisp/progmodes/elisp-mode.el (eval-last-sexp, eval-defun): Fix thinko --- lisp/progmodes/elisp-mode.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 4b1f8022f81..8a713bd19a2 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1630,7 +1630,8 @@ If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger." (interactive "P") (values--store-value - (handler-bind ((error (if #'eval-expression--debug #'ignore))) + (handler-bind ((error (if eval-expression-debug-on-error + #'eval-expression--debug #'ignore))) (elisp--eval-last-sexp eval-last-sexp-arg-internal)))) (defun elisp--eval-defun-1 (form) @@ -1769,7 +1770,8 @@ which see." (defvar edebug-all-defs) (eval-defun (not edebug-all-defs))) (t - (handler-bind ((error (if #'eval-expression--debug #'ignore))) + (handler-bind ((error (if eval-expression-debug-on-error + #'eval-expression--debug #'ignore))) (elisp--eval-defun))))) ;;; ElDoc Support -- cgit v1.2.3 From 05116eac0c199b0c8409a32b349a42a21b5a0fb0 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 25 Feb 2024 11:41:02 +0800 Subject: Arrange for dialog boxes during emacsclient requests on Android * lisp/server.el (server-execute): Bind use-dialog-box-override if (featurep 'android). * lisp/subr.el (use-dialog-box-override): New option. (use-dialog-box-p): Always display dialog boxes if variable is set. --- lisp/server.el | 6 +++++- lisp/subr.el | 22 ++++++++++++++-------- 2 files changed, 19 insertions(+), 9 deletions(-) diff --git a/lisp/server.el b/lisp/server.el index 66e6d729f8a..b65053267a6 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1439,7 +1439,11 @@ invocations of \"emacs\".") ;; including code that needs to wait. (with-local-quit (condition-case err - (let ((buffers (server-visit-files files proc nowait))) + (let ((buffers (server-visit-files files proc nowait)) + ;; On Android, the Emacs server generally can't provide + ;; feedback to the user except by means of dialog boxes, + ;; which are displayed in the GUI emacsclient wrapper. + (use-dialog-box-override (featurep 'android))) (mapc 'funcall (nreverse commands)) (let ((server-eval-args-left (nreverse evalexprs))) (while server-eval-args-left diff --git a/lisp/subr.el b/lisp/subr.el index c317d558e24..30314343650 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3832,16 +3832,22 @@ confusing to some users.") (declare-function android-detect-keyboard "androidfns.c") +(defvar use-dialog-box-override nil + "Whether `use-dialog-box-p' should always return t.") + (defun use-dialog-box-p () "Return non-nil if the current command should prompt the user via a dialog box." - (and last-input-event ; not during startup - (or (consp last-nonmenu-event) ; invoked by a mouse event - (and (null last-nonmenu-event) - (consp last-input-event)) - (and (featurep 'android) ; Prefer dialog boxes on Android. - (not (android-detect-keyboard))) ; If no keyboard is connected. - from--tty-menu-p) ; invoked via TTY menu - use-dialog-box)) + (or use-dialog-box-override + (and last-input-event ; not during startup + (or (consp last-nonmenu-event) ; invoked by a mouse event + (and (null last-nonmenu-event) + (consp last-input-event)) + (and (featurep 'android) ; Prefer dialog boxes on + ; Android. + (not (android-detect-keyboard))) ; If no keyboard is + ; connected. + from--tty-menu-p) ; invoked via TTY menu + use-dialog-box))) ;; Actually in textconv.c. (defvar overriding-text-conversion-style) -- cgit v1.2.3 From 782ff2f826e2fde75f6491f3a6cf0d7fcd5510b2 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 25 Feb 2024 08:20:44 +0200 Subject: * nt/cmdproxy.c (_snprintf) [_UCRT]: Redirect to 'snprintf'. --- nt/cmdproxy.c | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/nt/cmdproxy.c b/nt/cmdproxy.c index 0500b653bb2..c012151cf96 100644 --- a/nt/cmdproxy.c +++ b/nt/cmdproxy.c @@ -38,6 +38,14 @@ along with GNU Emacs. If not, see . */ #include /* strlen */ #include /* isspace, isalpha */ +/* UCRT has a C99-compatible snprintf, and _snprintf is defined inline + in stdio.h, which we don't want to include here. Since the + differences in behavior between snprintf and _snprintf don't matter + in this file, we take the easy way out. */ +#ifdef _UCRT +# define _snprintf snprintf +#endif + /* We don't want to include stdio.h because we are already duplicating lots of it here */ extern int _snprintf (char *buffer, size_t count, const char *format, ...); -- cgit v1.2.3 From 6b800f9adf3506bf113539cf22cd07c7cda9f7b8 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 25 Feb 2024 09:32:45 +0200 Subject: * lisp/progmodes/project.el (project-any-command): Allow local keymaps. Use overriding-terminal-local-map instead of overriding-local-map. This allows using keys from local maps (bug#69242). --- lisp/progmodes/project.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index aa92a73336e..9622b1b6768 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1866,12 +1866,12 @@ Otherwise, `default-directory' is temporarily set to the current project's root. If OVERRIDING-MAP is non-nil, it will be used as -`overriding-local-map' to provide shorter bindings from that map -which will take priority over the global ones." +`overriding-terminal-local-map' to provide shorter bindings +from that map which will take priority over the global ones." (interactive) (let* ((pr (project-current t)) (prompt-format (or prompt-format "[execute in %s]:")) - (command (let ((overriding-local-map overriding-map)) + (command (let ((overriding-terminal-local-map overriding-map)) (key-binding (read-key-sequence (format prompt-format (project-root pr))) t))) -- cgit v1.2.3 From e680827e814e155cf79175d87ff7c6ee3a08b69a Mon Sep 17 00:00:00 2001 From: Michael Heerdegen Date: Fri, 16 Feb 2024 22:07:18 +0100 Subject: Don't warn about _ not left unused in if-let and alike The macro expansions did not leave a variable _ unused; this triggered an irritating compiler warning (bug#69108). * lisp/subr.el (internal--build-binding): Handle bindings of the form (_ EXPR) separately. --- lisp/subr.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/subr.el b/lisp/subr.el index 30314343650..301e2e42566 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2580,6 +2580,8 @@ Affects only hooks run in the current buffer." (list binding binding)) ((null (cdr binding)) (list (make-symbol "s") (car binding))) + ((eq '_ (car binding)) + (list (make-symbol "s") (cadr binding))) (t binding))) (when (> (length binding) 2) (signal 'error -- cgit v1.2.3 From 67ba629a91aee3db39f3c81744e88c02ee710bdc Mon Sep 17 00:00:00 2001 From: Michael Heerdegen Date: Sun, 18 Feb 2024 02:27:56 +0100 Subject: ; * lisp/subr.el (if-let, and-let*): Tweak doc strings. (Bug#69108) --- lisp/subr.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index 301e2e42566..e2279170297 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2622,7 +2622,7 @@ This is like `when-let' but doesn't handle a VARLIST of the form (defmacro and-let* (varlist &rest body) "Bind variables according to VARLIST and conditionally evaluate BODY. Like `when-let*', except if BODY is empty and all the bindings -are non-nil, then the result is non-nil." +are non-nil, then the result is the value of the last binding." (declare (indent 1) (debug if-let*)) (let (res) (if varlist @@ -2635,7 +2635,8 @@ are non-nil, then the result is non-nil." "Bind variables according to SPEC and evaluate THEN or ELSE. Evaluate each binding in turn, as in `let*', stopping if a binding value is nil. If all are non-nil return the value of -THEN, otherwise the last form in ELSE. +THEN, otherwise the value of the last form in ELSE, or nil if +there are none. Each element of SPEC is a list (SYMBOL VALUEFORM) that binds SYMBOL to the value of VALUEFORM. An element can additionally be -- cgit v1.2.3 From 39e3fce0d5e0f5db00e44905bcd2590170098d63 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 25 Feb 2024 10:06:09 +0100 Subject: 'read-passwd' can toggle the visibility of passwords * doc/lispref/minibuf.texi (Reading a Password): * etc/NEWS: 'read-passwd' can toggle the visibility of passwords. * etc/images/README: Mention the new images below. * etc/images/conceal.pbm: * etc/images/conceal.svg: * etc/images/reveal.pbm: * etc/images/reveal.svg: New images. * lisp/simple.el (read-passwd--mode-line-buffer) (read-passwd--mode-line-icon): New defvars. (read-passwd--toggle-visibility, read-passwd-mode): New defuns. * lisp/subr.el (read-passwd-map): Add 'TAB' binding. (read-passwd--hide-password): New defvar. (read-passwd--hide-password): Rename function from `read-password--hide-password'. Adapt callees. Implement both hiding and showing the password. (Bug#69237) (read-passwd): Call `read-passwd-mode'. --- doc/lispref/minibuf.texi | 8 +++++ etc/NEWS | 11 +++++-- etc/images/README | 7 +++- etc/images/conceal.pbm | Bin 0 -> 41 bytes etc/images/conceal.svg | 4 +++ etc/images/reveal.pbm | Bin 0 -> 41 bytes etc/images/reveal.svg | 4 +++ lisp/simple.el | 81 +++++++++++++++++++++++++++++++++++++++++++++++ lisp/subr.el | 21 +++++++++--- 9 files changed, 128 insertions(+), 8 deletions(-) create mode 100644 etc/images/conceal.pbm create mode 100644 etc/images/conceal.svg create mode 100644 etc/images/reveal.pbm create mode 100644 etc/images/reveal.svg diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index aa27de72ba0..0247c93f7b8 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -2562,6 +2562,14 @@ times match. The optional argument @var{default} specifies the default password to return if the user enters empty input. If @var{default} is @code{nil}, then @code{read-passwd} returns the null string in that case. + +This function uses @code{read-passwd-mode}, a minor mode. It binds two +keys in the minbuffer: @kbd{C-u} (@code{delete-minibuffer-contents}) +deletes the password, and @kbd{TAB} +(@code{read-passwd--toggle-visibility}) toggles the visibility of the +password. There is also an additional icon in the mode-line. Clicking +on this icon with @key{mouse-1} toggles the visibility of the password +as well. @end defun @node Minibuffer Commands diff --git a/etc/NEWS b/etc/NEWS index 882d97ec423..6d444daf152 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -322,6 +322,12 @@ Previously, it was set to t but this broke remote file name detection. ** Multi-character key echo now ends with a suggestion to use Help. Customize 'echo-keystrokes-help' to nil to prevent that. ++++ +** 'read-passwd' can toggle the visibility of passwords. +Use 'TAB' in the minibuffer to show or hide the password. Likewise, +there is an icon on the mode-line, which toggles the visibility of the +password when clicking with 'mouse-1'. + * Editing Changes in Emacs 30.1 @@ -1939,7 +1945,8 @@ Example: "Uses c:\remote\dir\files and the key \C-x." ...) -where the doc string contains four control characters CR, DEL, FF and ^X. +where the docstring contains four control characters 'CR', 'DEL', 'FF' +and 'C-x'. The warning name is 'docstrings-control-chars'. @@ -2025,7 +2032,7 @@ automatically, which means that the size parameter to 'obarray-make' can safely be omitted. That is, they do not become slower as they fill up. The old vector representation is still accepted by functions operating -on obarrays, but 'obarrayp' only returns 't' for obarray objects. +on obarrays, but 'obarrayp' only returns t for obarray objects. 'type-of' now returns 'obarray' for obarray objects. Old code which (incorrectly) created "obarrays" as Lisp vectors filled diff --git a/etc/images/README b/etc/images/README index a778d9ce6c3..8e112448373 100644 --- a/etc/images/README +++ b/etc/images/README @@ -125,7 +125,7 @@ For more information see the adwaita-icon-theme repository at: https://gitlab.gnome.org/GNOME/adwaita-icon-theme -Emacs images and their source in the Adwaita/scalable directory: +Emacs images and their source in the Adwaita/symbolic directory: checked.svg ui/checkbox-checked-symbolic.svg unchecked.svg ui/checkbox-symbolic.svg @@ -137,3 +137,8 @@ Emacs images and their source in the Adwaita/scalable directory: left.svg ui/pan-start-symbolic.svg right.svg ui/pan-end-symbolic.svg up.svg ui/pan-up-symbolic.svg + conceal.svg actions/view-conceal-symbolic.svg + reveal.svg actions/view-reveal-symbolic.svg + +conceal.pbm and reveal.pbm are generated from the respective *.svg +files, using the ImageMagick converter tool. diff --git a/etc/images/conceal.pbm b/etc/images/conceal.pbm new file mode 100644 index 00000000000..3df787d6fd6 Binary files /dev/null and b/etc/images/conceal.pbm differ diff --git a/etc/images/conceal.svg b/etc/images/conceal.svg new file mode 100644 index 00000000000..172b73ed3d3 --- /dev/null +++ b/etc/images/conceal.svg @@ -0,0 +1,4 @@ + + + + diff --git a/etc/images/reveal.pbm b/etc/images/reveal.pbm new file mode 100644 index 00000000000..79d2f1f3307 Binary files /dev/null and b/etc/images/reveal.pbm differ diff --git a/etc/images/reveal.svg b/etc/images/reveal.svg new file mode 100644 index 00000000000..41ae3733a53 --- /dev/null +++ b/etc/images/reveal.svg @@ -0,0 +1,4 @@ + + + + diff --git a/lisp/simple.el b/lisp/simple.el index 9a33049f4ca..5992afec255 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10858,6 +10858,87 @@ and setting it to nil." (setq-local vis-mode-saved-buffer-invisibility-spec buffer-invisibility-spec) (setq buffer-invisibility-spec nil))) + + +(defvar read-passwd--mode-line-buffer nil + "Buffer to modify `mode-line-format' for showing/hiding passwords.") + +(defvar read-passwd--mode-line-icon nil + "Propertized mode line icon for showing/hiding passwords.") + +(defun read-passwd--toggle-visibility () + "Toggle minibuffer contents visibility. +Adapt also mode line." + (interactive) + (setq read-passwd--hide-password (not read-passwd--hide-password)) + (with-current-buffer read-passwd--mode-line-buffer + (setq read-passwd--mode-line-icon + `(:propertize + ,(if icon-preference + (icon-string + (if read-passwd--hide-password + 'read-passwd--show-password-icon + 'read-passwd--hide-password-icon)) + "") + mouse-face mode-line-highlight + local-map + (keymap + (mode-line keymap (mouse-1 . read-passwd--toggle-visibility))))) + (force-mode-line-update)) + (read-passwd--hide-password)) + +(define-minor-mode read-passwd-mode + "Toggle visibility of password in minibuffer." + :group 'mode-line + :group 'minibuffer + :keymap read-passwd-map + :version "30.1" + + (require 'icons) + ;; It would be preferable to use "👁" ("\N{EYE}"). However, there is + ;; no corresponding Unicode char with a slash. So we use symbols as + ;; fallback only, with "⦵" ("\N{CIRCLE WITH HORIZONTAL BAR}") for + ;; hiding the password. + (define-icon read-passwd--show-password-icon nil + '((image "reveal.svg" "reveal.pbm" :height (0.8 . em)) + (symbol "👁") + (text "o")) + "Mode line icon to show a hidden password." + :group mode-line-faces + :version "30.1" + :help-echo "mouse-1: Toggle password visibility") + (define-icon read-passwd--hide-password-icon nil + '((image "conceal.svg" "conceal.pbm" :height (0.8 . em)) + (symbol "⦵") + (text "x")) + "Mode line icon to hide a visible password." + :group mode-line-faces + :version "30.1" + :help-echo "mouse-1: Toggle password visibility") + + (setq read-passwd--hide-password nil + ;; Stolen from `eldoc-minibuffer-message'. + read-passwd--mode-line-buffer + (window-buffer + (or (window-in-direction 'above (minibuffer-window)) + (minibuffer-selected-window) + (get-largest-window)))) + + (if read-passwd-mode + (with-current-buffer read-passwd--mode-line-buffer + ;; Add `read-passwd--mode-line-icon'. + (when (listp mode-line-format) + (setq mode-line-format + (cons '(:eval read-passwd--mode-line-icon) + mode-line-format)))) + (with-current-buffer read-passwd--mode-line-buffer + ;; Remove `read-passwd--mode-line-icon'. + (when (listp mode-line-format) + (setq mode-line-format (cdr mode-line-format))))) + + (when read-passwd-mode + (read-passwd--toggle-visibility))) + (defvar messages-buffer-mode-map (let ((map (make-sparse-keymap))) diff --git a/lisp/subr.el b/lisp/subr.el index e2279170297..d89c69976e4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3378,14 +3378,23 @@ with Emacs. Do not call it directly in your own packages." (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) (define-key map "\C-u" #'delete-minibuffer-contents) ;bug#12570 + (define-key map "\t" #'read-passwd--toggle-visibility) map) "Keymap used while reading passwords.") -(defun read-password--hide-password () +(defvar read-passwd--hide-password t) + +(defun read-passwd--hide-password () + "Make password in minibuffer hidden or visible." (let ((beg (minibuffer-prompt-end))) (dotimes (i (1+ (- (buffer-size) beg))) - (put-text-property (+ i beg) (+ 1 i beg) - 'display (string (or read-hide-char ?*)))))) + (if read-passwd--hide-password + (put-text-property + (+ i beg) (+ 1 i beg) 'display (string (or read-hide-char ?*))) + (remove-list-of-text-properties (+ i beg) (+ 1 i beg) '(display))) + (put-text-property + (+ i beg) (+ 1 i beg) + 'help-echo "C-u: Clear password\nTAB: Toggle password visibility")))) (defun read-passwd (prompt &optional confirm default) "Read a password, prompting with PROMPT, and return it. @@ -3423,18 +3432,20 @@ by doing (clear-string STRING)." (setq-local inhibit-modification-hooks nil) ;bug#15501. (setq-local show-paren-mode nil) ;bug#16091. (setq-local inhibit--record-char t) - (add-hook 'post-command-hook #'read-password--hide-password nil t)) + (read-passwd-mode 1) + (add-hook 'post-command-hook #'read-passwd--hide-password nil t)) (unwind-protect (let ((enable-recursive-minibuffers t) (read-hide-char (or read-hide-char ?*))) (read-string prompt nil t default)) ; t = "no history" (when (buffer-live-p minibuf) (with-current-buffer minibuf + (read-passwd-mode -1) ;; Not sure why but it seems that there might be cases where the ;; minibuffer is not always properly reset later on, so undo ;; whatever we've done here (bug#11392). (remove-hook 'after-change-functions - #'read-password--hide-password 'local) + #'read-passwd--hide-password 'local) (kill-local-variable 'post-self-insert-hook) ;; And of course, don't keep the sensitive data around. (erase-buffer)))))))) -- cgit v1.2.3 From e02c4a864f02787f0e194c9e8a6d4ab0b18ca39f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 25 Feb 2024 15:37:06 +0100 Subject: Modify last change acc to comments * lisp/simple.el (read-passwd-mode): Change `text' entry of icons. (read-passwd-toggle-visibility): Rename. (read-passwd-mode): * lisp/subr.el (read-passwd-map): Adapt callees. --- lisp/simple.el | 10 +++++----- lisp/subr.el | 2 +- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index 5992afec255..f127290231b 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10866,7 +10866,7 @@ and setting it to nil." (defvar read-passwd--mode-line-icon nil "Propertized mode line icon for showing/hiding passwords.") -(defun read-passwd--toggle-visibility () +(defun read-passwd-toggle-visibility () "Toggle minibuffer contents visibility. Adapt also mode line." (interactive) @@ -10883,7 +10883,7 @@ Adapt also mode line." mouse-face mode-line-highlight local-map (keymap - (mode-line keymap (mouse-1 . read-passwd--toggle-visibility))))) + (mode-line keymap (mouse-1 . read-passwd-toggle-visibility))))) (force-mode-line-update)) (read-passwd--hide-password)) @@ -10902,7 +10902,7 @@ Adapt also mode line." (define-icon read-passwd--show-password-icon nil '((image "reveal.svg" "reveal.pbm" :height (0.8 . em)) (symbol "👁") - (text "o")) + (text "")) "Mode line icon to show a hidden password." :group mode-line-faces :version "30.1" @@ -10910,7 +10910,7 @@ Adapt also mode line." (define-icon read-passwd--hide-password-icon nil '((image "conceal.svg" "conceal.pbm" :height (0.8 . em)) (symbol "⦵") - (text "x")) + (text "<\\>")) "Mode line icon to hide a visible password." :group mode-line-faces :version "30.1" @@ -10937,7 +10937,7 @@ Adapt also mode line." (setq mode-line-format (cdr mode-line-format))))) (when read-passwd-mode - (read-passwd--toggle-visibility))) + (read-passwd-toggle-visibility))) (defvar messages-buffer-mode-map diff --git a/lisp/subr.el b/lisp/subr.el index d89c69976e4..d58f8ba3b27 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3378,7 +3378,7 @@ with Emacs. Do not call it directly in your own packages." (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) (define-key map "\C-u" #'delete-minibuffer-contents) ;bug#12570 - (define-key map "\t" #'read-passwd--toggle-visibility) + (define-key map "\t" #'read-passwd-toggle-visibility) map) "Keymap used while reading passwords.") -- cgit v1.2.3 From b7cef701cb587ecb66f192e4d41aa202645560e0 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 25 Feb 2024 11:35:44 -0500 Subject: * lisp/files.el (hack-one-local-variable): Use `set-auto-mode-0` This fixes bug#69373. --- lisp/files.el | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index 1e7f00e4254..c0d26b2343c 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4238,10 +4238,8 @@ already the major mode." (pcase var ('mode (let ((mode (intern (concat (downcase (symbol-name val)) - "-mode")))) - (unless (eq (indirect-function mode) - (indirect-function major-mode)) - (funcall mode)))) + "-mode")))) + (set-auto-mode-0 mode t))) ('eval (pcase val (`(add-hook ',hook . ,_) (hack-one-local-variable--obsolete hook))) -- cgit v1.2.3 From c6f2add964ce1ac69ba6705bc869ee2f447da3cb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 25 Feb 2024 13:18:08 -0500 Subject: * lisp/vc/vc-hooks.el (vc-mode): Give a body to the function (bug#69387) --- lisp/vc/vc-hooks.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index a95cc732dab..75f68dd80d1 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -186,7 +186,8 @@ revision number and lock status." This minor mode is automatically activated whenever you visit a file under control of one of the revision control systems in `vc-handled-backends'. VC commands are globally reachable under the prefix \\[vc-prefix-map]: -\\{vc-prefix-map}") +\\{vc-prefix-map}" + nil) (defmacro vc-error-occurred (&rest body) `(condition-case nil (progn ,@body nil) (error t))) -- cgit v1.2.3 From babe6a5e948985f961ffd36f64323950abd98b7f Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 26 Feb 2024 14:13:14 +0800 Subject: Introduce a new TRAMP method `androidsu' * doc/misc/tramp.texi (Quick Start Guide): Document the new method. * etc/NEWS (Tramp): Announce new method. * lisp/net/tramp-adb.el (tramp-adb-handle-file-attributes) (tramp-adb-handle-directory-files-and-attributes) (tramp-adb-handle-file-name-all-completions): Properly print ls's exit status in the presence of a pipe. (tramp-adb-handle-copy-file): If the androidsu backend is in use, call cp rather than adb push. (tramp-adb-send-command): Disable ADB-specific code under androidsu. (tramp-adb-send-command-and-check): New argument COMMAND-AUGMENTED-P. * lisp/net/tramp-androidsu.el (tramp, tramp-adb, tramp-sh) (tramp-androidsu-method, add-to-list) (tramp-androidsu-maybe-open-connection) (tramp-androidsu-generate-wrapper) (tramp-androidsu-handle-access-file) (tramp-androidsu-handle-add-name-to-file) (tramp-androidsu-handle-copy-directory) (tramp-androidsu-adb-handle-copy-file) (tramp-androidsu-adb-handle-delete-directory) (tramp-androidsu-adb-handle-delete-file) (tramp-androidsu-handle-directory-file-name) (tramp-androidsu-handle-directory-files) (tramp-androidsu-adb-handle-directory-files-and-attributes) (tramp-androidsu-handle-dired-uncache) (tramp-androidsu-adb-handle-exec-path) (tramp-androidsu-handle-expand-file-name) (tramp-androidsu-handle-file-accessible-directory-p) (tramp-androidsu-adb-handle-file-attributes) (tramp-androidsu-handle-file-directory-p) (tramp-androidsu-handle-file-equal-p) (tramp-androidsu-adb-handle-file-executable-p) (tramp-androidsu-adb-handle-file-exists-p) (tramp-androidsu-handle-file-group-gid) (tramp-androidsu-handle-file-in-directory-p) (tramp-androidsu-sh-handle-file-local-copy) (tramp-androidsu-handle-file-locked-p) (tramp-androidsu-handle-file-modes) (tramp-androidsu-adb-handle-file-name-all-completions) (tramp-androidsu-handle-file-name-as-directory) (tramp-androidsu-handle-file-name-case-insensitive-p) (tramp-androidsu-handle-file-name-completion) (tramp-androidsu-handle-file-name-directory) (tramp-androidsu-handle-file-name-nondirectory) (tramp-androidsu-handle-file-newer-than-file-p) (tramp-androidsu-handle-file-notify-add-watch) (tramp-androidsu-handle-file-notify-rm-watch) (tramp-androidsu-handle-file-notify-valid-p) (tramp-androidsu-adb-handle-file-readable-p) (tramp-androidsu-handle-file-regular-p) (tramp-androidsu-handle-file-remote-p) (tramp-androidsu-handle-file-selinux-context) (tramp-androidsu-handle-file-symlink-p) (tramp-androidsu-adb-handle-file-system-info) (tramp-androidsu-handle-file-truename) (tramp-androidsu-handle-file-user-uid) (tramp-androidsu-adb-handle-file-writable-p) (tramp-androidsu-handle-find-backup-file-name) (tramp-androidsu-handle-insert-directory) (tramp-androidsu-handle-insert-file-contents) (tramp-androidsu-handle-list-system-processes) (tramp-androidsu-handle-load, tramp-androidsu-handle-lock-file) (tramp-androidsu-handle-make-auto-save-file-name) (tramp-androidsu-adb-handle-make-directory) (tramp-androidsu-handle-make-lock-file-name) (tramp-androidsu-handle-make-nearby-temp-file) (tramp-androidsu-adb-handle-make-process) (tramp-androidsu-sh-handle-make-symbolic-link) (tramp-androidsu-handle-memory-info) (tramp-androidsu-handle-process-attributes) (tramp-androidsu-adb-handle-process-file) (tramp-androidsu-adb-handle-rename-file) (tramp-androidsu-adb-handle-set-file-modes) (tramp-androidsu-adb-handle-set-file-times) (tramp-androidsu-handle-set-visited-file-modtime) (tramp-androidsu-handle-shell-command) (tramp-androidsu-handle-start-file-process) (tramp-androidsu-handle-substitute-in-file-name) (tramp-androidsu-handle-temporary-file-directory) (tramp-androidsu-adb-handle-get-remote-gid) (tramp-androidsu-adb-handle-get-remote-groups) (tramp-androidsu-adb-handle-get-remote-uid) (tramp-androidsu-handle-unlock-file) (tramp-androidsu-handle-verify-visited-file-modtime) (tramp-androidsu-handle-write-region) (tramp-androidsu-file-name-handler-alist) (tramp-androidsu-file-name-p, tramp-androidsu-file-name-handler) (tramp-register-foreign-file-name-handler) (tramp-adb-connection-local-default-ps-profile, shell) (tramp-unload-hook, tramp-androidsu): New file. --- doc/misc/tramp.texi | 7 + etc/NEWS | 6 + lisp/net/tramp-adb.el | 54 +++-- lisp/net/tramp-androidsu.el | 537 ++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 589 insertions(+), 15 deletions(-) create mode 100644 lisp/net/tramp-androidsu.el diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 6d4654f1a8a..09b875ad3fa 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -523,6 +523,8 @@ is used as the group to change to. The default host name is the same. @cindex @option{sudo} method @cindex method @option{doas} @cindex @option{doas} method +@cindex method @option{androidsu} +@cindex @option{androidsu} method If the @option{su}, @option{sudo} or @option{doas} option should be performed on another host, it can be combined with a leading @@ -533,6 +535,11 @@ a simple case, the syntax looks like @file{@trampfn{ssh@value{postfixhop}user@@host|sudo,,/path/to/file}}. @xref{Ad-hoc multi-hops}. +The @option{su} method and other shell-based methods conflict with +non-standard @command{su} implementations popular among Android users +and the restricted command-line utilities distributed with that system. +The @option{androidsu} method enables accessing files through +@command{su} on such systems, but multi-hops are not supported. @anchor{Quick Start Guide sudoedit method} @section Using @command{sudoedit} diff --git a/etc/NEWS b/etc/NEWS index 6d444daf152..b4a1c887f2e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -902,6 +902,12 @@ mode line. 'header' will display in the header line; ** Tramp ++++ +*** New connection method "androidsu". +This provides access to system files with elevated privileges granted by +the idiosyncratic 'su' implementations and system utilities customary on +Android. + +++ *** New connection methods "dockercp" and "podmancp". These are the external methods counterparts of "docker" and "podman". diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 96625fc5680..4f04912c032 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -263,9 +263,10 @@ arguments to pass to the OPERATION." (tramp-convert-file-attributes v localname id-format (and (tramp-adb-send-command-and-check - v (format "%s -d -l %s | cat" + v (format "(%s -d -l %s; echo tramp_exit_status $?) | cat" (tramp-adb-get-ls-command v) - (tramp-shell-quote-argument localname))) + (tramp-shell-quote-argument localname)) + nil t) (with-current-buffer (tramp-get-buffer v) (tramp-adb-sh-fix-ls-output) (cdar (tramp-do-parse-file-attributes-with-ls v))))))) @@ -316,9 +317,10 @@ arguments to pass to the OPERATION." directory full match nosort id-format count (with-current-buffer (tramp-get-buffer v) (when (tramp-adb-send-command-and-check - v (format "%s -a -l %s | cat" + v (format "(%s -a -l %s; echo tramp_exit_status $?) | cat" (tramp-adb-get-ls-command v) - (tramp-shell-quote-argument localname))) + (tramp-shell-quote-argument localname)) + nil t) ;; We insert also filename/. and filename/.., because "ls" ;; doesn't on some file systems, like "sdcard". (unless (search-backward-regexp (rx "." eol) nil t) @@ -440,10 +442,12 @@ Emacs dired can't find files." filename (with-parsed-tramp-file-name (expand-file-name directory) nil (with-tramp-file-property v localname "file-name-all-completions" - (tramp-adb-send-command - v (format "%s -a %s | cat" - (tramp-adb-get-ls-command v) - (tramp-shell-quote-argument localname))) + (unless (tramp-adb-send-command-and-check + v (format "(%s -a %s; echo tramp_exit_status $?) | cat" + (tramp-adb-get-ls-command v) + (tramp-shell-quote-argument localname)) + nil t) + (erase-buffer)) (mapcar (lambda (f) (if (file-directory-p (expand-file-name f directory)) @@ -637,10 +641,23 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; because `file-attributes' reads the values from ;; there. (tramp-flush-file-properties v localname) - (unless (tramp-adb-execute-adb-command - v "push" - (file-name-unquote filename) - (file-name-unquote localname)) + (unless (if (tramp-adb-file-name-p v) + (tramp-adb-execute-adb-command + v "push" + (file-name-unquote filename) + (file-name-unquote localname)) + ;; Otherwise, this operation was initiated + ;; by the androidsu backend, so both files + ;; must be present on the local machine and + ;; transferable with a simple local copy. + (tramp-adb-send-command-and-check + v + (format + "cp -f %s %s" + (tramp-shell-quote-argument + (file-name-unquote filename)) + (tramp-shell-quote-argument + (file-name-unquote localname))))) (tramp-error v 'file-error "Cannot copy `%s' `%s'" filename newname))))))))) @@ -1110,7 +1127,9 @@ error and non-nil on success." (defun tramp-adb-send-command (vec command &optional neveropen nooutput) "Send the COMMAND to connection VEC." - (if (string-match-p (rx multibyte) command) + (if (and (equal (tramp-file-name-method vec) + tramp-androidsu-method) + (string-match-p (rx multibyte) command)) ;; Multibyte codepoints with four bytes are not supported at ;; least by toybox. @@ -1142,17 +1161,22 @@ error and non-nil on success." (while (search-forward-regexp (rx (+ "\r") eol) nil t) (replace-match "" nil nil))))))) -(defun tramp-adb-send-command-and-check (vec command &optional exit-status) +(defun tramp-adb-send-command-and-check (vec command &optional exit-status + command-augmented-p) "Run COMMAND and check its exit status. Sends `echo $?' along with the COMMAND for checking the exit status. If COMMAND is nil, just sends `echo $?'. Returns nil if the exit status is not equal 0, and t otherwise. +If COMMAND-AUGMENTED-P, COMMAND is already configured to print exit +status upon completion and need not be modified. + Optional argument EXIT-STATUS, if non-nil, triggers the return of the exit status." (tramp-adb-send-command vec (if command - (format "%s; echo tramp_exit_status $?" command) + (if command-augmented-p command + (format "%s; echo tramp_exit_status $?" command)) "echo tramp_exit_status $?")) (with-current-buffer (tramp-get-connection-buffer vec) (unless (tramp-search-regexp (rx "tramp_exit_status " (+ digit))) diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el new file mode 100644 index 00000000000..417ef25ed8a --- /dev/null +++ b/lisp/net/tramp-androidsu.el @@ -0,0 +1,537 @@ +;;; tramp-androidsu.el --- TRAMP method for Android superuser shells -*- lexical-binding:t -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; Keywords: comm, processes +;; Package: tramp + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; The `su' method struggles (as do other shell-based methods) with the +;; crippled versions of many Unix utilities installed on Android, +;; workarounds for which are implemented in the `adb' method. This +;; method defines a shell-based method that is identical in function to +;; `su', but reuses such code from the `adb' method where applicable and +;; also provides for certain mannerisms of popular Android `su' +;; implementations. + +;;; Code: + +(require 'tramp) +(require 'tramp-adb) +(require 'tramp-sh) + +;;;###tramp-autoload +(defconst tramp-androidsu-method "androidsu" + "When this method name is used, forward all calls to su.") + +;;;###tramp-autoload +(tramp--with-startup + (add-to-list 'tramp-methods + `(,tramp-androidsu-method + (tramp-login-program "su") + (tramp-login-args (("-") ("%u"))) + (tramp-remote-shell "/system/bin/sh") + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-c")) + (tramp-tmpdir "/data/local/tmp") + (tramp-connection-timeout 10))) + + (add-to-list 'tramp-default-host-alist + `(,tramp-androidsu-method nil "localhost"))) + +(defun tramp-androidsu-maybe-open-connection (vec) + "Open a connection VEC if not already open. +Mostly identical to `tramp-adb-maybe-open-connection', but also disables +multibyte mode and waits for the shell prompt to appear." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + + (with-tramp-debug-message vec "Opening connection" + (let ((p (tramp-get-connection-process vec)) + (process-name (tramp-get-connection-property vec "process-name")) + (process-environment (copy-sequence process-environment))) + ;; Open a new connection. + (condition-case err + (unless (process-live-p p) + (with-tramp-progress-reporter + vec 3 + (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec)) + (format "Opening connection %s for %s using %s" + process-name + (tramp-file-name-host vec) + (tramp-file-name-method vec)) + (format "Opening connection %s for %s@%s using %s" + process-name + (tramp-file-name-user vec) + (tramp-file-name-host vec) + (tramp-file-name-method vec))) + (let* ((coding-system-for-read 'utf-8-unix) + (process-connection-type tramp-process-connection-type) + (p (apply + #'start-process + (tramp-get-connection-name vec) + (tramp-get-connection-buffer vec) + (append + `(,tramp-encoding-shell) + (and tramp-encoding-command-interactive + `(,tramp-encoding-command-interactive))))) + (user (tramp-file-name-user vec)) + command) + ;; Set sentinel. Initialize variables. + (set-process-sentinel p #'tramp-process-sentinel) + (tramp-post-process-creation p vec) + + ;; Replace `login-args' place holders. + (setq command (format "exec su - %s || exit" + (or user "root"))) + ;; Send the command. + (tramp-message vec 3 "Sending command `%s'" command) + (tramp-adb-send-command vec command t t) + + ;; Android su binaries contact a background service to + ;; obtain authentication; during this process, input + ;; received is discarded, so input cannot be + ;; guaranteed to reach the root shell until its prompt + ;; is displayed. + (with-current-buffer (process-buffer p) + (tramp-wait-for-regexp p tramp-connection-timeout + "#[[:space:]]*$")) + + ;; Set connection-local variables. + (tramp-set-connection-local-variables vec) + + ;; Change prompt. + (tramp-adb-send-command + vec (format "PS1=%s" + (tramp-shell-quote-argument tramp-end-of-output))) + + ;; Disable line editing. + (tramp-adb-send-command + vec "set +o vi +o vi-esccomplete +o vi-tabcomplete +o emacs") + + ;; Dump option settings in the traces. + (when (>= tramp-verbose 9) + (tramp-adb-send-command vec "set -o")) + + ;; Disable Unicode. + (tramp-adb-send-command vec "set +U") + + ;; Disable echo expansion. + (tramp-adb-send-command + vec "stty -inlcr -onlcr -echo kill '^U' erase '^H'" t) + + ;; Check whether the echo has really been disabled. + ;; Some implementations, like busybox, don't support + ;; disabling. + (tramp-adb-send-command vec "echo foo" t) + (with-current-buffer (process-buffer p) + (goto-char (point-min)) + (when (looking-at-p "echo foo") + (tramp-set-connection-property p "remote-echo" t) + (tramp-message vec 5 "Remote echo still on. Ok.") + ;; Make sure backspaces and their echo are enabled + ;; and no line width magic interferes with them. + (tramp-adb-send-command vec + "stty icanon erase ^H cols 32767" + t))) + + ;; Set the remote PATH to a suitable value. + (tramp-set-connection-property vec "remote-path" + "/system/bin:/system/xbin") + + ;; Mark it as connected. + (tramp-set-connection-property p "connected" t)))) + + ;; Cleanup, and propagate the signal. + ((error quit) + (tramp-cleanup-connection vec t) + (signal (car err) (cdr err))))))) + +(defun tramp-androidsu-generate-wrapper (function) + "Return connection wrapper function for FUNCTION. +Return a function which temporarily substitutes local replacements for +the `adb' method's connection management functions around a call to +FUNCTION." + (lambda (&rest args) + (let ((tramp-adb-wait-for-output + (symbol-function #'tramp-adb-wait-for-output)) + (tramp-adb-maybe-open-connection + (symbol-function #'tramp-adb-maybe-open-connection))) + (unwind-protect + (progn + ;; tramp-adb-wait-for-output addresses problems introduced + ;; by the adb utility itself, not Android utilities, so + ;; replace it with the regular TRAMP function. + (fset 'tramp-adb-wait-for-output #'tramp-wait-for-output) + ;; Likewise, except some special treatment is necessary on + ;; account of flaws in Android's su implementation. + (fset 'tramp-adb-maybe-open-connection + #'tramp-androidsu-maybe-open-connection) + (apply function args)) + ;; Restore the original definitions of the functions overridden + ;; above. + (fset 'tramp-adb-wait-for-output tramp-adb-wait-for-output) + (fset 'tramp-adb-maybe-open-connection tramp-adb-maybe-open-connection))))) + +(defalias 'tramp-androidsu-handle-access-file + (tramp-androidsu-generate-wrapper #'tramp-handle-access-file)) + +(defalias 'tramp-androidsu-handle-add-name-to-file + (tramp-androidsu-generate-wrapper #'tramp-handle-add-name-to-file)) + +(defalias 'tramp-androidsu-handle-copy-directory + (tramp-androidsu-generate-wrapper #'tramp-handle-copy-directory)) + +(defalias 'tramp-androidsu-adb-handle-copy-file + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-copy-file)) + +(defalias 'tramp-androidsu-adb-handle-delete-directory + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-directory)) + +(defalias 'tramp-androidsu-adb-handle-delete-file + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-file)) + +(defalias 'tramp-androidsu-handle-directory-file-name + (tramp-androidsu-generate-wrapper #'tramp-handle-directory-file-name)) + +(defalias 'tramp-androidsu-handle-directory-files + (tramp-androidsu-generate-wrapper #'tramp-handle-directory-files)) + +(defalias 'tramp-androidsu-adb-handle-directory-files-and-attributes + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-directory-files-and-attributes)) + +(defalias 'tramp-androidsu-handle-dired-uncache + (tramp-androidsu-generate-wrapper #'tramp-handle-dired-uncache)) + +(defalias 'tramp-androidsu-adb-handle-exec-path + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-exec-path)) + +(defalias 'tramp-androidsu-handle-expand-file-name + (tramp-androidsu-generate-wrapper #'tramp-handle-expand-file-name)) + +(defalias 'tramp-androidsu-handle-file-accessible-directory-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-accessible-directory-p)) + +(defalias 'tramp-androidsu-adb-handle-file-attributes + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-attributes)) + +(defalias 'tramp-androidsu-handle-file-directory-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-directory-p)) + +(defalias 'tramp-androidsu-handle-file-equal-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-equal-p)) + +(defalias 'tramp-androidsu-adb-handle-file-executable-p + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-executable-p)) + +(defalias 'tramp-androidsu-adb-handle-file-exists-p + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-exists-p)) + +(defalias 'tramp-androidsu-handle-file-group-gid + (tramp-androidsu-generate-wrapper #'tramp-handle-file-group-gid)) + +(defalias 'tramp-androidsu-handle-file-in-directory-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-in-directory-p)) + +(defalias 'tramp-androidsu-sh-handle-file-local-copy + (tramp-androidsu-generate-wrapper #'tramp-sh-handle-file-local-copy)) + +(defalias 'tramp-androidsu-handle-file-locked-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-locked-p)) + +(defalias 'tramp-androidsu-handle-file-modes + (tramp-androidsu-generate-wrapper #'tramp-handle-file-modes)) + +(defalias 'tramp-androidsu-adb-handle-file-name-all-completions + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-name-all-completions)) + +(defalias 'tramp-androidsu-handle-file-name-as-directory + (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-as-directory)) + +(defalias 'tramp-androidsu-handle-file-name-case-insensitive-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-case-insensitive-p)) + +(defalias 'tramp-androidsu-handle-file-name-completion + (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-completion)) + +(defalias 'tramp-androidsu-handle-file-name-directory + (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-directory)) + +(defalias 'tramp-androidsu-handle-file-name-nondirectory + (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-nondirectory)) + +(defalias 'tramp-androidsu-handle-file-newer-than-file-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-newer-than-file-p)) + +(defalias 'tramp-androidsu-handle-file-notify-add-watch + (tramp-androidsu-generate-wrapper #'tramp-handle-file-notify-add-watch)) + +(defalias 'tramp-androidsu-handle-file-notify-rm-watch + (tramp-androidsu-generate-wrapper #'tramp-handle-file-notify-rm-watch)) + +(defalias 'tramp-androidsu-handle-file-notify-valid-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-notify-valid-p)) + +(defalias 'tramp-androidsu-adb-handle-file-readable-p + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-readable-p)) + +(defalias 'tramp-androidsu-handle-file-regular-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-regular-p)) + +(defalias 'tramp-androidsu-handle-file-remote-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-remote-p)) + +(defalias 'tramp-androidsu-handle-file-selinux-context + (tramp-androidsu-generate-wrapper #'tramp-handle-file-selinux-context)) + +(defalias 'tramp-androidsu-handle-file-symlink-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-symlink-p)) + +(defalias 'tramp-androidsu-adb-handle-file-system-info + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-system-info)) + +(defalias 'tramp-androidsu-handle-file-truename + (tramp-androidsu-generate-wrapper #'tramp-handle-file-truename)) + +(defalias 'tramp-androidsu-handle-file-user-uid + (tramp-androidsu-generate-wrapper #'tramp-handle-file-user-uid)) + +(defalias 'tramp-androidsu-adb-handle-file-writable-p + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-writable-p)) + +(defalias 'tramp-androidsu-handle-find-backup-file-name + (tramp-androidsu-generate-wrapper #'tramp-handle-find-backup-file-name)) + +(defalias 'tramp-androidsu-handle-insert-directory + (tramp-androidsu-generate-wrapper #'tramp-handle-insert-directory)) + +(defalias 'tramp-androidsu-handle-insert-file-contents + (tramp-androidsu-generate-wrapper #'tramp-handle-insert-file-contents)) + +(defalias 'tramp-androidsu-handle-list-system-processes + (tramp-androidsu-generate-wrapper #'tramp-handle-list-system-processes)) + +(defalias 'tramp-androidsu-handle-load + (tramp-androidsu-generate-wrapper #'tramp-handle-load)) + +(defalias 'tramp-androidsu-handle-lock-file + (tramp-androidsu-generate-wrapper #'tramp-handle-lock-file)) + +(defalias 'tramp-androidsu-handle-make-auto-save-file-name + (tramp-androidsu-generate-wrapper #'tramp-handle-make-auto-save-file-name)) + +(defalias 'tramp-androidsu-adb-handle-make-directory + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-make-directory)) + +(defalias 'tramp-androidsu-handle-make-lock-file-name + (tramp-androidsu-generate-wrapper #'tramp-handle-make-lock-file-name)) + +(defalias 'tramp-androidsu-handle-make-nearby-temp-file + (tramp-androidsu-generate-wrapper #'tramp-handle-make-nearby-temp-file)) + +(defalias 'tramp-androidsu-adb-handle-make-process + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-make-process)) + +(defalias 'tramp-androidsu-sh-handle-make-symbolic-link + (tramp-androidsu-generate-wrapper + #'tramp-sh-handle-make-symbolic-link)) + +(defalias 'tramp-androidsu-handle-memory-info + (tramp-androidsu-generate-wrapper #'tramp-handle-memory-info)) + +(defalias 'tramp-androidsu-handle-process-attributes + (tramp-androidsu-generate-wrapper #'tramp-handle-process-attributes)) + +(defalias 'tramp-androidsu-adb-handle-process-file + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-process-file)) + +(defalias 'tramp-androidsu-adb-handle-rename-file + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-rename-file)) + +(defalias 'tramp-androidsu-adb-handle-set-file-modes + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-modes)) + +(defalias 'tramp-androidsu-adb-handle-set-file-times + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-times)) + +(defalias 'tramp-androidsu-handle-set-visited-file-modtime + (tramp-androidsu-generate-wrapper #'tramp-handle-set-visited-file-modtime)) + +(defalias 'tramp-androidsu-handle-shell-command + (tramp-androidsu-generate-wrapper #'tramp-handle-shell-command)) + +(defalias 'tramp-androidsu-handle-start-file-process + (tramp-androidsu-generate-wrapper #'tramp-handle-start-file-process)) + +(defalias 'tramp-androidsu-handle-substitute-in-file-name + (tramp-androidsu-generate-wrapper #'tramp-handle-substitute-in-file-name)) + +(defalias 'tramp-androidsu-handle-temporary-file-directory + (tramp-androidsu-generate-wrapper #'tramp-handle-temporary-file-directory)) + +(defalias 'tramp-androidsu-adb-handle-get-remote-gid + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-gid)) + +(defalias 'tramp-androidsu-adb-handle-get-remote-groups + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-groups)) + +(defalias 'tramp-androidsu-adb-handle-get-remote-uid + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-uid)) + +(defalias 'tramp-androidsu-handle-unlock-file + (tramp-androidsu-generate-wrapper #'tramp-handle-unlock-file)) + +(defalias 'tramp-androidsu-handle-verify-visited-file-modtime + (tramp-androidsu-generate-wrapper #'tramp-handle-verify-visited-file-modtime)) + +(defalias 'tramp-androidsu-handle-write-region + (tramp-androidsu-generate-wrapper #'tramp-handle-write-region)) + +;;;###tramp-autoload +(defconst tramp-androidsu-file-name-handler-alist + '(;; `abbreviate-file-name' performed by default handler. + (access-file . tramp-androidsu-handle-access-file) + (add-name-to-file . tramp-androidsu-handle-add-name-to-file) + ;; `byte-compiler-base-file-name' performed by default handler. + (copy-directory . tramp-androidsu-handle-copy-directory) + (copy-file . tramp-androidsu-adb-handle-copy-file) + (delete-directory . tramp-androidsu-adb-handle-delete-directory) + (delete-file . tramp-androidsu-adb-handle-delete-file) + ;; `diff-latest-backup-file' performed by default handler. + (directory-file-name . tramp-androidsu-handle-directory-file-name) + (directory-files . tramp-androidsu-handle-directory-files) + (directory-files-and-attributes + . tramp-androidsu-adb-handle-directory-files-and-attributes) + (dired-compress-file . ignore) + (dired-uncache . tramp-androidsu-handle-dired-uncache) + (exec-path . tramp-androidsu-adb-handle-exec-path) + (expand-file-name . tramp-androidsu-handle-expand-file-name) + (file-accessible-directory-p . tramp-androidsu-handle-file-accessible-directory-p) + (file-acl . ignore) + (file-attributes . tramp-androidsu-adb-handle-file-attributes) + (file-directory-p . tramp-androidsu-handle-file-directory-p) + (file-equal-p . tramp-androidsu-handle-file-equal-p) + (file-executable-p . tramp-androidsu-adb-handle-file-executable-p) + (file-exists-p . tramp-androidsu-adb-handle-file-exists-p) + (file-group-gid . tramp-androidsu-handle-file-group-gid) + (file-in-directory-p . tramp-androidsu-handle-file-in-directory-p) + (file-local-copy . tramp-androidsu-sh-handle-file-local-copy) + (file-locked-p . tramp-androidsu-handle-file-locked-p) + (file-modes . tramp-androidsu-handle-file-modes) + (file-name-all-completions . tramp-androidsu-adb-handle-file-name-all-completions) + (file-name-as-directory . tramp-androidsu-handle-file-name-as-directory) + (file-name-case-insensitive-p . tramp-androidsu-handle-file-name-case-insensitive-p) + (file-name-completion . tramp-androidsu-handle-file-name-completion) + (file-name-directory . tramp-androidsu-handle-file-name-directory) + (file-name-nondirectory . tramp-androidsu-handle-file-name-nondirectory) + ;; `file-name-sans-versions' performed by default handler. + (file-newer-than-file-p . tramp-androidsu-handle-file-newer-than-file-p) + (file-notify-add-watch . tramp-androidsu-handle-file-notify-add-watch) + (file-notify-rm-watch . tramp-androidsu-handle-file-notify-rm-watch) + (file-notify-valid-p . tramp-androidsu-handle-file-notify-valid-p) + (file-ownership-preserved-p . ignore) + (file-readable-p . tramp-androidsu-adb-handle-file-readable-p) + (file-regular-p . tramp-androidsu-handle-file-regular-p) + (file-remote-p . tramp-androidsu-handle-file-remote-p) + (file-selinux-context . tramp-androidsu-handle-file-selinux-context) + (file-symlink-p . tramp-androidsu-handle-file-symlink-p) + (file-system-info . tramp-androidsu-adb-handle-file-system-info) + (file-truename . tramp-androidsu-handle-file-truename) + (file-user-uid . tramp-androidsu-handle-file-user-uid) + (file-writable-p . tramp-androidsu-adb-handle-file-writable-p) + (find-backup-file-name . tramp-androidsu-handle-find-backup-file-name) + ;; `get-file-buffer' performed by default handler. + (insert-directory . tramp-androidsu-handle-insert-directory) + (insert-file-contents . tramp-androidsu-handle-insert-file-contents) + (list-system-processes . tramp-androidsu-handle-list-system-processes) + (load . tramp-androidsu-handle-load) + (lock-file . tramp-androidsu-handle-lock-file) + (make-auto-save-file-name . tramp-androidsu-handle-make-auto-save-file-name) + (make-directory . tramp-androidsu-adb-handle-make-directory) + (make-directory-internal . ignore) + (make-lock-file-name . tramp-androidsu-handle-make-lock-file-name) + (make-nearby-temp-file . tramp-androidsu-handle-make-nearby-temp-file) + (make-process . tramp-androidsu-adb-handle-make-process) + (make-symbolic-link . tramp-androidsu-sh-handle-make-symbolic-link) + (memory-info . tramp-androidsu-handle-memory-info) + (process-attributes . tramp-androidsu-handle-process-attributes) + (process-file . tramp-androidsu-adb-handle-process-file) + (rename-file . tramp-androidsu-adb-handle-rename-file) + (set-file-acl . ignore) + (set-file-modes . tramp-androidsu-adb-handle-set-file-modes) + (set-file-selinux-context . ignore) + (set-file-times . tramp-androidsu-adb-handle-set-file-times) + (set-visited-file-modtime . tramp-androidsu-handle-set-visited-file-modtime) + (shell-command . tramp-androidsu-handle-shell-command) + (start-file-process . tramp-androidsu-handle-start-file-process) + (substitute-in-file-name . tramp-androidsu-handle-substitute-in-file-name) + (temporary-file-directory . tramp-androidsu-handle-temporary-file-directory) + (tramp-get-home-directory . ignore) + (tramp-get-remote-gid . tramp-androidsu-adb-handle-get-remote-gid) + (tramp-get-remote-groups . tramp-androidsu-adb-handle-get-remote-groups) + (tramp-get-remote-uid . tramp-androidsu-adb-handle-get-remote-uid) + (tramp-set-file-uid-gid . ignore) + (unhandled-file-name-directory . ignore) + (unlock-file . tramp-androidsu-handle-unlock-file) + (vc-registered . ignore) + (verify-visited-file-modtime . tramp-androidsu-handle-verify-visited-file-modtime) + (write-region . tramp-androidsu-handle-write-region)) + "Alist of TRAMP handler functions for superuser sessions on Android.") + +;; It must be a `defsubst' in order to push the whole code into +;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading. +;;;###tramp-autoload +(defsubst tramp-androidsu-file-name-p (vec-or-filename) + "Check whether VEC-OR-FILENAME is for the `androidsu' method." + (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))) + (equal (tramp-file-name-method vec) tramp-androidsu-method))) + +;;;###tramp-autoload +(defun tramp-androidsu-file-name-handler (operation &rest args) + "Invoke the `androidsu' handler for OPERATION. +First arg specifies the OPERATION, second arg is a list of +arguments to pass to the OPERATION." + (if-let ((fn (assoc operation tramp-androidsu-file-name-handler-alist))) + (prog1 (save-match-data (apply (cdr fn) args)) + (setq tramp-debug-message-fnh-function (cdr fn))) + (prog1 (tramp-run-real-handler operation args) + (setq tramp-debug-message-fnh-function operation)))) + +;;;###tramp-autoload +(tramp--with-startup + (tramp-register-foreign-file-name-handler + #'tramp-androidsu-file-name-p #'tramp-androidsu-file-name-handler)) + +(connection-local-set-profile-variables + 'tramp-adb-connection-local-default-ps-profile + tramp-adb-connection-local-default-ps-variables) + +(with-eval-after-load 'shell + (connection-local-set-profiles + `(:application tramp :protocol ,tramp-adb-method) + 'tramp-adb-connection-local-default-shell-profile + 'tramp-adb-connection-local-default-ps-profile)) + +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-androidsu 'force))) + +(provide 'tramp-androidsu) +;;; tramp-androidsu.el ends here -- cgit v1.2.3 From 1687adcb5c93b490e2e7edcd14615af295e791ed Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 26 Feb 2024 14:13:49 +0800 Subject: ; Delete trailing whitespace * lisp/net/tramp-androidsu.el (tramp-androidsu-maybe-open-connection): Delete trailing whitespace. --- lisp/net/tramp-androidsu.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index 417ef25ed8a..06800205f2e 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -158,7 +158,7 @@ multibyte mode and waits for the shell prompt to appear." ;; Mark it as connected. (tramp-set-connection-property p "connected" t)))) - + ;; Cleanup, and propagate the signal. ((error quit) (tramp-cleanup-connection vec t) -- cgit v1.2.3 From 76fa7f1f2fb7fbc3dcbd0be7928d0ec112e532e7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 26 Feb 2024 19:26:04 +0200 Subject: Fix display of reordered Arabic text * src/xdisp.c (compute_stop_pos): Fix a year-old thinko in handling auto-composed characters. It was introduced as part of solving bug#62780, which optimized the search for composable characters. (Bug#69384) --- src/xdisp.c | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 4d60915f31c..d03769e2a31 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -4345,10 +4345,7 @@ compute_stop_pos (struct it *it) } } - if (it->cmp_it.id < 0 - && (STRINGP (it->string) - || ((!it->bidi_p || it->bidi_it.scan_dir >= 0) - && it->cmp_it.stop_pos <= IT_CHARPOS (*it)))) + if (it->cmp_it.id < 0) { ptrdiff_t stoppos = it->end_charpos; @@ -4357,7 +4354,9 @@ compute_stop_pos (struct it *it) characters to that position. */ if (it->bidi_p && it->bidi_it.scan_dir < 0) stoppos = -1; - else if (cmp_limit_pos > 0) + else if (!STRINGP (it->string) + && it->cmp_it.stop_pos <= IT_CHARPOS (*it) + && cmp_limit_pos > 0) stoppos = cmp_limit_pos; /* Force composition_compute_stop_pos avoid the costly search for static compositions, since those were already found by -- cgit v1.2.3 From 25cfccfb8b5bced05d5547f3eabb4d0508a575c8 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 26 Feb 2024 12:33:35 -0500 Subject: (edebug-tests-trivial-comma): Avoid interaction (bug#69406) * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-trivial-backquote): Don't use obsolete `edebug-eval-defun`. (edebug-tests-trivial-comma): Use `inhibit-read-only`; don't use obsolete `edebug-eval-defun`; and fix bug#69406 by binding `eval-expression-debug-on-error`. --- test/lisp/emacs-lisp/edebug-tests.el | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 8c0f729dc39..29adbcff947 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -860,8 +860,7 @@ test and possibly others should be updated." (let ((inhibit-read-only t)) (delete-region (point-min) (point-max)) (insert "`1")) - (with-suppressed-warnings ((obsolete edebug-eval-defun)) - (edebug-eval-defun nil)) + (eval-defun nil) ;; `eval-defun' outputs its message to the echo area in a rather ;; funny way, so the "1" and the " (#o1, #x1, ?\C-a)" end up placed ;; there in separate pieces (via `print' rather than via `message'). @@ -871,18 +870,21 @@ test and possibly others should be updated." (setq edebug-initial-mode 'go) ;; In Bug#23651 Edebug would hang reading `1. - (with-suppressed-warnings ((obsolete edebug-eval-defun)) - (edebug-eval-defun t)))) + (eval-defun t) + (should (string-match-p (regexp-quote " (#o1, #x1, ?\\C-a)") + edebug-tests-messages)))) (ert-deftest edebug-tests-trivial-comma () "Edebug can read a trivial comma expression (Bug#23651)." (edebug-tests-with-normal-env - (read-only-mode -1) - (delete-region (point-min) (point-max)) - (insert ",1") - (read-only-mode) - (with-suppressed-warnings ((obsolete edebug-eval-defun)) - (should-error (edebug-eval-defun t))))) + (let ((inhibit-read-only t)) + (delete-region (point-min) (point-max)) + (insert ",1")) + ;; FIXME: This currently signals a "Source has changed" error, which is + ;; itself a bug (the source hasn't changed). All we're testing here + ;; is that the Edebug gets past the step of reading the sexp. + (should-error (let ((eval-expression-debug-on-error nil)) + (eval-defun t))))) (ert-deftest edebug-tests-circular-read-syntax () "Edebug can instrument code using circular read object syntax (Bug#23660)." -- cgit v1.2.3 From a67b8d7f448804d34bce85d2b6ab8d022f14161f Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 26 Feb 2024 18:42:44 +0100 Subject: Make tree-sitter tests work installed in .emacs.d/tree-sitter * test/Makefile.in (ert_opts): Set treesit-extra-load-path, because HOME is not valid when running tests from the Makefile (bug#69405). --- test/Makefile.in | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/test/Makefile.in b/test/Makefile.in index 720f5c7ff8c..3cbdbec4414 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -92,6 +92,10 @@ export TEST_LOAD_EL ?= \ # Additional settings for ert. ert_opts = +# Supply a path to local tree-sitter installations, as we run tests +# without a valid HOME. +ert_opts += --eval "(setq treesit-extra-load-path '(\"$(HOME)/.emacs.d/tree-sitter\"))" + # Maximum length of lines in ert backtraces; nil for no limit. # (if empty, use the default ert-batch-backtrace-right-margin). TEST_BACKTRACE_LINE_LENGTH = -- cgit v1.2.3 From b3eb49a4661e31306555e82bdf24db6c36d67ad2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 26 Feb 2024 14:32:08 -0500 Subject: tex-mode.el: Increase depth of braces highlighted in $...$ blocks * lisp/textmodes/tex-mode.el (tex-font-lock-keywords-1): Increase depth of braces supported in $...$ blocks. (tex-font-lock-keywords-2, tex-font-lock-syntactic-face-function): Refer directly to font-lock faces. --- lisp/textmodes/tex-mode.el | 32 ++++++++++++++++++-------------- 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 5c5ca573f38..616b8871090 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -511,9 +511,14 @@ An alternative value is \" . \", if you use a font with a narrow period." ;; This would allow highlighting \newcommand\CMD but requires ;; adapting subgroup numbers below. ;; (arg "\\(?:{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)\\|\\\\[a-z*]+\\)")) - (inbraces-re (lambda (re) - (concat "\\(?:[^{}\\]\\|\\\\.\\|" re "\\)"))) - (arg (concat "{\\(" (funcall inbraces-re "{[^}]*}") "+\\)"))) + (inbraces-re + (lambda (n) ;; Level of nesting of braces we should support. + (let ((re "[^}]")) + (dotimes (_ n) + (setq re + (concat "\\(?:[^{}\\]\\|\\\\.\\|{" re "*}\\)"))) + re))) + (arg (concat "{\\(" (funcall inbraces-re 2) "+\\)"))) `(;; Verbatim-like args. ;; Do it first, because we don't want to highlight them ;; in comments (bug#68827), but we do want to highlight them @@ -523,8 +528,7 @@ An alternative value is \" . \", if you use a font with a narrow period." ;; This is done at the very beginning so as to interact with the other ;; keywords in the same way as comments and strings. (,(concat "\\$\\$?\\(?:[^$\\{}]\\|\\\\.\\|{" - (funcall inbraces-re - (concat "{" (funcall inbraces-re "{[^}]*}") "*}")) + (funcall inbraces-re 6) "*}\\)+\\$?\\$") (0 'tex-math keep)) ;; Heading args. @@ -605,14 +609,14 @@ An alternative value is \" . \", if you use a font with a narrow period." (list (concat (regexp-opt '("``" "\"<" "\"`" "<<" "«") t) "\\(\\(.\\|\n\\)+?\\)" (regexp-opt `("''" "\">" "\"'" ">>" "»") t)) - '(1 font-lock-keyword-face) - '(2 font-lock-string-face) - '(4 font-lock-keyword-face)) + '(1 'font-lock-keyword-face) + '(2 'font-lock-string-face) + '(4 'font-lock-keyword-face)) ;; ;; Command names, special and general. (cons (concat slash specials-1) 'font-lock-warning-face) (list (concat "\\(" slash specials-2 "\\)\\([^a-zA-Z@]\\|\\'\\)") - 1 'font-lock-warning-face) + '(1 'font-lock-warning-face)) (concat slash general) ;; ;; Font environments. It seems a bit dubious to use `bold' etc. faces @@ -680,7 +684,7 @@ An alternative value is \" . \", if you use a font with a narrow period." (eval-when-compile (defconst tex-syntax-propertize-rules (syntax-propertize-precompile-rules - ("\\\\verb\\**\\([^a-z@*]\\)" + ("\\\\verb\\**\\([^a-z@*]\\)" (1 (prog1 "\"" (tex-font-lock-verb (match-beginning 0) (char-after (match-beginning 1)))))))) @@ -764,7 +768,7 @@ automatically inserts its partner." (regexp-quote (buffer-substring arg-start arg-end))) (text-clone-create arg-start arg-end)))))))) (scan-error nil) - (error (message "Error in latex-env-before-change: %s" err))))) + (error (message "Error in latex-env-before-change: %S" err))))) (defun tex-font-lock-unfontify-region (beg end) (font-lock-default-unfontify-region beg end) @@ -852,7 +856,7 @@ START is the position of the \\ and DELIM is the delimiter char." (let ((char (nth 3 state))) (cond ((not char) - (if (eq 2 (nth 7 state)) 'tex-verbatim font-lock-comment-face)) + (if (eq 2 (nth 7 state)) 'tex-verbatim 'font-lock-comment-face)) ((eq char ?$) 'tex-math) ;; A \verb element. (t 'tex-verbatim)))) @@ -1265,8 +1269,8 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook (setq-local facemenu-end-add-face "}") (setq-local facemenu-remove-face-function t) (setq-local font-lock-defaults - '((tex-font-lock-keywords tex-font-lock-keywords-1 - tex-font-lock-keywords-2 tex-font-lock-keywords-3) + '(( tex-font-lock-keywords tex-font-lock-keywords-1 + tex-font-lock-keywords-2 tex-font-lock-keywords-3) nil nil nil nil ;; Who ever uses that anyway ??? (font-lock-mark-block-function . mark-paragraph) -- cgit v1.2.3 From 32b4f9d21b14190f1ed1611515751abe4b90fa68 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 27 Feb 2024 10:05:56 +0800 Subject: Disable process tracing before launching /system/bin/su * lisp/net/tramp-androidsu.el (tramp-androidsu-maybe-open-connection): Disable process tracing around start-process, that the setuid su binary may be started regardless of its status. --- lisp/net/tramp-androidsu.el | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index 06800205f2e..cf6b0d7202c 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -55,6 +55,8 @@ (add-to-list 'tramp-default-host-alist `(,tramp-androidsu-method nil "localhost"))) +(defvar android-use-exec-loader) ; androidfns.c. + (defun tramp-androidsu-maybe-open-connection (vec) "Open a connection VEC if not already open. Mostly identical to `tramp-adb-maybe-open-connection', but also disables @@ -84,14 +86,17 @@ multibyte mode and waits for the shell prompt to appear." (tramp-file-name-method vec))) (let* ((coding-system-for-read 'utf-8-unix) (process-connection-type tramp-process-connection-type) - (p (apply - #'start-process - (tramp-get-connection-name vec) - (tramp-get-connection-buffer vec) - (append - `(,tramp-encoding-shell) - (and tramp-encoding-command-interactive - `(,tramp-encoding-command-interactive))))) + ;; The executable loader cannot execute setuid + ;; binaries, such as su. + (android-use-exec-loader nil) + (p (start-process (tramp-get-connection-name vec) + (tramp-get-connection-buffer vec) + ;; Disregard + ;; tramp-encoding-shell, as + ;; there's no guarantee that it's + ;; possible to execute with + ;; `android-use-exec-loader' off. + "/system/bin/sh" "-i")) (user (tramp-file-name-user vec)) command) ;; Set sentinel. Initialize variables. -- cgit v1.2.3 From b59d7094b6cb1a09f46f933807e9cd00a8bd1547 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 27 Feb 2024 10:32:08 +0100 Subject: Allow vc-git-clone to check-out arbitrary revisions * lisp/vc/vc-git.el (vc-git-clone): If "git clone --branch" fails, then clone the repository regularly and checkout the requested revision. --- lisp/vc/vc-git.el | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 456417e566e..18b4a8691e9 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1411,9 +1411,16 @@ This prompts for a branch to merge from." (vc-message-unresolved-conflicts buffer-file-name))) (defun vc-git-clone (remote directory rev) - (if rev - (vc-git--out-ok "clone" "--branch" rev remote directory) + "Attempt to clone REMOTE repository into DIRECTORY at revision REV." + (cond + ((null rev) (vc-git--out-ok "clone" remote directory)) + ((ignore-errors + (vc-git--out-ok "clone" "--branch" rev remote directory))) + ((vc-git--out-ok "clone" remote directory) + (let ((default-directory directory)) + (vc-git--out-ok "checkout" rev))) + ((error "Failed to check out %s at %s" remote rev))) directory) ;;; HISTORY FUNCTIONS -- cgit v1.2.3 From 383ccf6d51fd7af65dbcc1ce159a03369a48d27f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 27 Feb 2024 13:12:15 +0200 Subject: Avoid assertion violations in bidi.c * src/bidi.c (bidi_resolve_brackets): Move assertion about 'resolved_level' to where it belongs. This avoids unnecessary aborts when the character is not a bracket type and doesn't need BPA resolution. (Bug#69421) --- src/bidi.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/bidi.c b/src/bidi.c index 93bb061ac32..90c0061549a 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -2908,7 +2908,6 @@ bidi_resolve_brackets (struct bidi_it *bidi_it) } else if (bidi_it->bracket_pairing_pos != eob) { - eassert (bidi_it->resolved_level == -1); /* If the cached state shows an increase of embedding level due to an isolate initiator, we need to update the 1st cached state of the next run of the current isolating sequence with @@ -2917,6 +2916,7 @@ bidi_resolve_brackets (struct bidi_it *bidi_it) if (bidi_it->level_stack[bidi_it->stack_idx].level > prev_level && ISOLATE_STATUS (bidi_it, bidi_it->stack_idx)) { + eassert (bidi_it->resolved_level == -1); bidi_record_type_for_neutral (&prev_for_neutral, prev_level, 0); bidi_record_type_for_neutral (&next_for_neutral, prev_level, 1); } @@ -2931,6 +2931,7 @@ bidi_resolve_brackets (struct bidi_it *bidi_it) } else if (bidi_it->bracket_pairing_pos == -1) { + eassert (bidi_it->resolved_level == -1); /* Higher levels were not BPA-resolved yet, even if cached by bidi_find_bracket_pairs. Force application of BPA to the new level now. */ -- cgit v1.2.3 From 6de60f33ed5cc438e20400aee83e1e2032773811 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 27 Feb 2024 12:20:31 +0100 Subject: ; * src/data.c (Ftype_of): Update comment. --- src/data.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/data.c b/src/data.c index 0c47750cb75..fd4b1fe4e44 100644 --- a/src/data.c +++ b/src/data.c @@ -211,7 +211,7 @@ for example, (type-of 1) returns `integer'. */) return Qcons; case Lisp_Vectorlike: - /* WARNING!! Keep 'cl--typeof-types' in sync with this code!! */ + /* WARNING!! Keep 'cl--type-hierarchy' in sync with this code!! */ switch (PSEUDOVECTOR_TYPE (XVECTOR (object))) { case PVEC_NORMAL_VECTOR: return Qvector; -- cgit v1.2.3 From 647cecc853e53a3be0bb2cf5328cd19e677217c9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 27 Feb 2024 15:11:58 +0200 Subject: ; * lisp/vc/vc.el (vc-clone): Fix wording of doc string. --- lisp/vc/vc.el | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 549eae6e663..25540406b4e 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3676,11 +3676,16 @@ to provide the `find-revision' operation instead." (vc-call-backend (vc-backend buffer-file-name) 'check-headers)) (defun vc-clone (remote &optional backend directory rev) - "Use BACKEND to clone REMOTE into DIRECTORY. -If successful, returns the string with the directory of the -checkout. If BACKEND is nil, iterate through every known backend -in `vc-handled-backends' until one succeeds. If REV is non-nil, -it indicates a specific revision to check out." + "Clone repository REMOTE using version-control BACKEND, into DIRECTORY. +If successful, return the string with the directory of the checkout; +otherwise return nil. +REMOTE should be a string, the URL of the remote repository or the name +of a directory (if the repository is local). +If DIRECTORY is nil or omitted, it defaults to `default-directory'. +If BACKEND is nil or omitted, the function iterates through every known +backend in `vc-handled-backends' until one succeeds to clone REMOTE. +If REV is non-nil, it indicates a specific revision to check out after +cloning; the syntax of REV depends on what BACKEND accepts." (unless directory (setq directory default-directory)) (if backend -- cgit v1.2.3 From 6a77355527b2f7f1dca9c2296c2684033c9aa875 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 27 Feb 2024 08:24:45 -0500 Subject: vhdl-mode.el: Reduce use of `eval` * lisp/progmodes/vhdl-mode.el (vhdl--re2-region): New function. (vhdl--signal-regions-functions): New constant, extracted from `vhdl-update-sensitivity-list`. (vhdl-update-sensitivity-list): Use it. --- lisp/progmodes/vhdl-mode.el | 76 ++++++++++++++++++++++++--------------------- 1 file changed, 41 insertions(+), 35 deletions(-) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index f52baf049aa..144bfa944d3 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -8398,6 +8398,44 @@ buffer." (message "Updating sensitivity lists...done"))) (when noninteractive (save-buffer))) +(defun vhdl--re2-region (beg-re end-re) + "Return a function searching for a region delimited by a pair of regexps. +BEG-RE and END-RE are the regexps delimiting the region to search for." + (lambda (proc-end) + (when (vhdl-re-search-forward beg-re proc-end t) + (save-excursion + (vhdl-re-search-forward end-re proc-end t))))) + +(defconst vhdl--signal-regions-functions + (list + ;; right-hand side of signal/variable assignment + ;; (special case: "<=" is relational operator in a condition) + (vhdl--re2-region "[<:]=" + ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>") + ;; if condition + (vhdl--re2-region "^\\s-*if\\>" "\\") + ;; elsif condition + (vhdl--re2-region "\\" "\\") + ;; while loop condition + (vhdl--re2-region "^\\s-*while\\>" "\\") + ;; exit/next condition + (vhdl--re2-region "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" ";") + ;; assert condition + (vhdl--re2-region "\\" "\\(\\\\|\\\\|;\\)") + ;; case expression + (vhdl--re2-region "^\\s-*case\\>" "\\") + ;; parameter list of procedure call, array index + (lambda (proc-end) + (when (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t) + (forward-char -1) + (save-excursion + (forward-sexp) + (while (looking-at "(") (forward-sexp)) (point))))) + "Define syntactic regions where signals are read. +Each function is called with one arg (a limit for the (forward) search) and +should return either nil or the end position of the region (in which case +point will be set to its beginning).") + (defun vhdl-update-sensitivity-list () "Update sensitivity list." (let ((proc-beg (point)) @@ -8418,35 +8456,6 @@ buffer." (let ;; scan for visible signals ((visible-list (vhdl-get-visible-signals)) - ;; define syntactic regions where signals are read - (scan-regions-list - `(;; right-hand side of signal/variable assignment - ;; (special case: "<=" is relational operator in a condition) - ((vhdl-re-search-forward "[<:]=" ,proc-end t) - (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" ,proc-end t)) - ;; if condition - ((vhdl-re-search-forward "^\\s-*if\\>" ,proc-end t) - (vhdl-re-search-forward "\\" ,proc-end t)) - ;; elsif condition - ((vhdl-re-search-forward "\\" ,proc-end t) - (vhdl-re-search-forward "\\" ,proc-end t)) - ;; while loop condition - ((vhdl-re-search-forward "^\\s-*while\\>" ,proc-end t) - (vhdl-re-search-forward "\\" ,proc-end t)) - ;; exit/next condition - ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" ,proc-end t) - (vhdl-re-search-forward ";" ,proc-end t)) - ;; assert condition - ((vhdl-re-search-forward "\\" ,proc-end t) - (vhdl-re-search-forward "\\(\\\\|\\\\|;\\)" ,proc-end t)) - ;; case expression - ((vhdl-re-search-forward "^\\s-*case\\>" ,proc-end t) - (vhdl-re-search-forward "\\" ,proc-end t)) - ;; parameter list of procedure call, array index - ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" ,proc-end t) - (1- (point))) - (progn (backward-char) (forward-sexp) - (while (looking-at "(") (forward-sexp)) (point))))) name field read-list sens-list signal-list tmp-list sens-beg sens-end beg end margin) ;; scan for signals in old sensitivity list @@ -8475,11 +8484,9 @@ buffer." (push (cons end (point)) seq-region-list) (beginning-of-line))) ;; scan for signals read in process - (while scan-regions-list + (dolist (scan-fun vhdl--signal-regions-functions) (goto-char proc-mid) - (while (and (setq beg (eval (nth 0 (car scan-regions-list)))) - (setq end (eval (nth 1 (car scan-regions-list))))) - (goto-char beg) + (while (setq end (funcall scan-fun proc-end)) (unless (or (vhdl-in-literal) (and seq-region-list (let ((tmp-list seq-region-list)) @@ -8518,8 +8525,7 @@ buffer." (car tmp-list)) (setq read-list (delete (car tmp-list) read-list))) (setq tmp-list (cdr tmp-list))))) - (goto-char (match-end 1))))) - (setq scan-regions-list (cdr scan-regions-list))) + (goto-char (match-end 1)))))) ;; update sensitivity list (goto-char sens-beg) (if sens-end -- cgit v1.2.3 From f1db8cf9a0595f7db29b548b38ce98196f36e09b Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 28 Feb 2024 12:05:59 +0800 Subject: Lift restrictions on `tramp-androidsu's app data access * lisp/net/tramp-adb.el (tramp-adb-handle-copy-file): Remove code now unnecessary. * lisp/net/tramp-androidsu.el (tramp-androidsu-mount-global-namespace): New user option. (tramp-androidsu-su-mm-supported): New variable. (tramp-androidsu-maybe-open-connection): Detect whether su supports the -mm option, and provide it if so. (tramp-androidsu-adb-handle-copy-file) (tramp-androidsu-adb-handle-rename-file): Delete functions. (tramp-androidsu-sh-handle-copy-file) (tramp-androidsu-sh-handle-rename-file): New functions. (tramp-androidsu-file-name-handler-alist): Switch to tramp-sh's copy and rename handlers. --- lisp/net/tramp-adb.el | 21 ++++------------- lisp/net/tramp-androidsu.el | 55 ++++++++++++++++++++++++++++++++++++--------- 2 files changed, 49 insertions(+), 27 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 4f04912c032..3f216ba403a 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -641,23 +641,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; because `file-attributes' reads the values from ;; there. (tramp-flush-file-properties v localname) - (unless (if (tramp-adb-file-name-p v) - (tramp-adb-execute-adb-command - v "push" - (file-name-unquote filename) - (file-name-unquote localname)) - ;; Otherwise, this operation was initiated - ;; by the androidsu backend, so both files - ;; must be present on the local machine and - ;; transferable with a simple local copy. - (tramp-adb-send-command-and-check - v - (format - "cp -f %s %s" - (tramp-shell-quote-argument - (file-name-unquote filename)) - (tramp-shell-quote-argument - (file-name-unquote localname))))) + (unless (tramp-adb-execute-adb-command + v "push" + (file-name-unquote filename) + (file-name-unquote localname)) (tramp-error v 'file-error "Cannot copy `%s' `%s'" filename newname))))))))) diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index cf6b0d7202c..6d4ac2c17f1 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -40,6 +40,22 @@ (defconst tramp-androidsu-method "androidsu" "When this method name is used, forward all calls to su.") +;;;###tramp-autoload +(defcustom tramp-androidsu-mount-global-namespace t + "When non-nil, browse files from within the global mount namespace. +On systems that assign each application a unique view of the filesystem +by executing them within individual mount namespaces and thus conceal +each application's data directories from others, invoke `su' with the +option `-mm' in order for the shell launched to run within the global +mount namespace, so that TRAMP may edit files belonging to any and all +applications." + :group 'tramp + :version "30.1" + :type 'boolean) + +(defvar tramp-androidsu-su-mm-supported 'unknown + "Whether `su -mm' is supported on this system.") + ;;;###tramp-autoload (tramp--with-startup (add-to-list 'tramp-methods @@ -94,7 +110,7 @@ multibyte mode and waits for the shell prompt to appear." ;; Disregard ;; tramp-encoding-shell, as ;; there's no guarantee that it's - ;; possible to execute with + ;; possible to execute it with ;; `android-use-exec-loader' off. "/system/bin/sh" "-i")) (user (tramp-file-name-user vec)) @@ -103,13 +119,32 @@ multibyte mode and waits for the shell prompt to appear." (set-process-sentinel p #'tramp-process-sentinel) (tramp-post-process-creation p vec) - ;; Replace `login-args' place holders. + ;; Replace `login-args' place holders. (setq command (format "exec su - %s || exit" (or user "root"))) - ;; Send the command. + + ;; Attempt to execute the shell inside the global mount + ;; namespace if requested. + (when tramp-androidsu-mount-global-namespace + (progn + (when (eq tramp-androidsu-su-mm-supported 'unknown) + ;; Change the prompt in advance so that + ;; tramp-adb-send-command-and-check can call + ;; tramp-search-regexp. + (tramp-adb-send-command + vec (format "PS1=%s" + (tramp-shell-quote-argument + tramp-end-of-output))) + (setq tramp-androidsu-su-mm-supported + ;; Detect support for `su -mm'. + (tramp-adb-send-command-and-check + vec "su -mm -c 'exit 24'" 24))) + (when tramp-androidsu-su-mm-supported + (setq command (format "exec su -mm - %s || exit" + (or user "root")))))) + ;; Send the command. (tramp-message vec 3 "Sending command `%s'" command) (tramp-adb-send-command vec command t t) - ;; Android su binaries contact a background service to ;; obtain authentication; during this process, input ;; received is discarded, so input cannot be @@ -204,8 +239,8 @@ FUNCTION." (defalias 'tramp-androidsu-handle-copy-directory (tramp-androidsu-generate-wrapper #'tramp-handle-copy-directory)) -(defalias 'tramp-androidsu-adb-handle-copy-file - (tramp-androidsu-generate-wrapper #'tramp-adb-handle-copy-file)) +(defalias 'tramp-androidsu-sh-handle-copy-file + (tramp-androidsu-generate-wrapper #'tramp-sh-handle-copy-file)) (defalias 'tramp-androidsu-adb-handle-delete-directory (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-directory)) @@ -367,8 +402,8 @@ FUNCTION." (defalias 'tramp-androidsu-adb-handle-process-file (tramp-androidsu-generate-wrapper #'tramp-adb-handle-process-file)) -(defalias 'tramp-androidsu-adb-handle-rename-file - (tramp-androidsu-generate-wrapper #'tramp-adb-handle-rename-file)) +(defalias 'tramp-androidsu-sh-handle-rename-file + (tramp-androidsu-generate-wrapper #'tramp-sh-handle-rename-file)) (defalias 'tramp-androidsu-adb-handle-set-file-modes (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-modes)) @@ -416,7 +451,7 @@ FUNCTION." (add-name-to-file . tramp-androidsu-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. (copy-directory . tramp-androidsu-handle-copy-directory) - (copy-file . tramp-androidsu-adb-handle-copy-file) + (copy-file . tramp-androidsu-sh-handle-copy-file) (delete-directory . tramp-androidsu-adb-handle-delete-directory) (delete-file . tramp-androidsu-adb-handle-delete-file) ;; `diff-latest-backup-file' performed by default handler. @@ -478,7 +513,7 @@ FUNCTION." (memory-info . tramp-androidsu-handle-memory-info) (process-attributes . tramp-androidsu-handle-process-attributes) (process-file . tramp-androidsu-adb-handle-process-file) - (rename-file . tramp-androidsu-adb-handle-rename-file) + (rename-file . tramp-androidsu-sh-handle-rename-file) (set-file-acl . ignore) (set-file-modes . tramp-androidsu-adb-handle-set-file-modes) (set-file-selinux-context . ignore) -- cgit v1.2.3 From 977a56d5c7d71b958767dbae05b75c5e5cb87571 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 28 Feb 2024 12:23:32 +0800 Subject: ; Fix last change * lisp/net/tramp-androidsu.el (tramp-androidsu-handle-write-region): Delete function. (tramp-androidsu-sh-handle-write-region): New function. (tramp-androidsu-file-name-handler-alist): Avoid infinite recursion by replacing handle-write-region with the tramp-sh implementation. --- lisp/net/tramp-androidsu.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index 6d4ac2c17f1..fd9edb6a92e 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -441,8 +441,8 @@ FUNCTION." (defalias 'tramp-androidsu-handle-verify-visited-file-modtime (tramp-androidsu-generate-wrapper #'tramp-handle-verify-visited-file-modtime)) -(defalias 'tramp-androidsu-handle-write-region - (tramp-androidsu-generate-wrapper #'tramp-handle-write-region)) +(defalias 'tramp-androidsu-sh-handle-write-region + (tramp-androidsu-generate-wrapper #'tramp-sh-handle-write-region)) ;;;###tramp-autoload (defconst tramp-androidsu-file-name-handler-alist @@ -532,7 +532,7 @@ FUNCTION." (unlock-file . tramp-androidsu-handle-unlock-file) (vc-registered . ignore) (verify-visited-file-modtime . tramp-androidsu-handle-verify-visited-file-modtime) - (write-region . tramp-androidsu-handle-write-region)) + (write-region . tramp-androidsu-sh-handle-write-region)) "Alist of TRAMP handler functions for superuser sessions on Android.") ;; It must be a `defsubst' in order to push the whole code into -- cgit v1.2.3 From 3412b64ac8851a0fa8e55c6319d2e710ae27a74c Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 28 Feb 2024 11:35:04 +0100 Subject: ; Update Lisp_Obarray hash for CHECK_STRUCTS This follows commit 462d8ba813 of 2024-02-23 "Add a proper type for obarrays". --- src/pdumper.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/pdumper.c b/src/pdumper.c index ca457858219..f0bce09cbde 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2774,8 +2774,8 @@ dump_obarray_buckets (struct dump_context *ctx, const struct Lisp_Obarray *o) static dump_off dump_obarray (struct dump_context *ctx, Lisp_Object object) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Obarray_XXXXXXXXXX -# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h." +#if CHECK_STRUCTS && !defined HASH_Lisp_Obarray_D2757E61AD +# error "Lisp_Obarray changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Obarray *in_oa = XOBARRAY (object); struct Lisp_Obarray munged_oa = *in_oa; @@ -3049,7 +3049,7 @@ dump_vectorlike (struct dump_context *ctx, Lisp_Object lv, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_pvec_type_D8A254BC70 +#if CHECK_STRUCTS && !defined HASH_pvec_type_2D583AC566 # error "pvec_type changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Vector *v = XVECTOR (lv); -- cgit v1.2.3 From 8a2d013be37d8c3d3a25cfe1da505cd2e27dda5c Mon Sep 17 00:00:00 2001 From: Liu Hui Date: Wed, 21 Feb 2024 12:40:06 +0800 Subject: Fix Python shell completion test failures * test/lisp/progmodes/python-tests.el (python-tests-with-temp-buffer-with-shell): Set XDG_CACHE_HOME to a temporary directory. (python-tests--pythonstartup-file): New function. (python-shell-completion-at-point-jedi-completer) (python-shell-completion-at-point-ipython): Use Jedi as the native completion backend when possible. (bug#68559) --- test/lisp/progmodes/python-tests.el | 87 ++++++++++++++++++++++--------------- 1 file changed, 53 insertions(+), 34 deletions(-) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 6c6cd9eee2b..1ceee690cfb 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -55,21 +55,27 @@ BODY is code to be executed within the temp buffer. Point is always located at the beginning of buffer. Native completion is turned off. Shell buffer will be killed on exit." (declare (indent 1) (debug t)) - `(with-temp-buffer - (let ((python-indent-guess-indent-offset nil) - (python-shell-completion-native-enable nil)) - (python-mode) - (unwind-protect - (progn - (run-python nil t) - (insert ,contents) - (goto-char (point-min)) - (python-tests-shell-wait-for-prompt) - ,@body) - (when (python-shell-get-buffer) - (python-shell-with-shell-buffer - (let (kill-buffer-hook kill-buffer-query-functions) - (kill-buffer)))))))) + (let ((dir (make-symbol "dir"))) + `(with-temp-buffer + (let ((python-indent-guess-indent-offset nil) + (python-shell-completion-native-enable nil)) + (python-mode) + (unwind-protect + ;; Prevent test failures when Jedi is used as a completion + ;; backend, either directly or indirectly (e.g., via + ;; IPython). Jedi needs to store cache, but the + ;; "/nonexistent" HOME directory is not writable. + (ert-with-temp-directory ,dir + (with-environment-variables (("XDG_CACHE_HOME" ,dir)) + (run-python nil t) + (insert ,contents) + (goto-char (point-min)) + (python-tests-shell-wait-for-prompt) + ,@body)) + (when (python-shell-get-buffer) + (python-shell-with-shell-buffer + (let (kill-buffer-hook kill-buffer-query-functions) + (kill-buffer))))))))) (defmacro python-tests-with-temp-file (contents &rest body) "Create a `python-mode' enabled file with CONTENTS. @@ -4860,17 +4866,28 @@ def foo(): (should (string= "IGNORECASE" (buffer-substring (line-beginning-position) (point))))) +(defun python-tests--pythonstartup-file () + "Return Jedi readline setup file if PYTHONSTARTUP is not set." + (or (getenv "PYTHONSTARTUP") + (with-temp-buffer + (if (eql 0 (call-process python-tests-shell-interpreter + nil t nil "-m" "jedi" "repl")) + (string-trim (buffer-string)) + "")))) + (ert-deftest python-shell-completion-at-point-jedi-completer () "Check if Python shell completion works when Jedi completer is used." (skip-unless (executable-find python-tests-shell-interpreter)) - (python-tests-with-temp-buffer-with-shell - "" - (python-shell-with-shell-buffer - (python-shell-completion-native-turn-on) - (skip-unless (string= python-shell-readline-completer-delims "")) - (python-tests--completion-module) - (python-tests--completion-parameters) - (python-tests--completion-extra-context)))) + (with-environment-variables + (("PYTHONSTARTUP" (python-tests--pythonstartup-file))) + (python-tests-with-temp-buffer-with-shell + "" + (python-shell-with-shell-buffer + (python-shell-completion-native-turn-on) + (skip-unless (string= python-shell-readline-completer-delims "")) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-tests--completion-extra-context))))) (ert-deftest python-shell-completion-at-point-ipython () "Check if Python shell completion works for IPython." @@ -4880,17 +4897,19 @@ def foo(): (and (executable-find python-shell-interpreter) (eql (call-process python-shell-interpreter nil nil nil "--version") 0))) - (python-tests-with-temp-buffer-with-shell - "" - (python-shell-with-shell-buffer - (python-shell-completion-native-turn-off) - (python-tests--completion-module) - (python-tests--completion-parameters) - (python-shell-completion-native-turn-on) - (skip-unless (string= python-shell-readline-completer-delims "")) - (python-tests--completion-module) - (python-tests--completion-parameters) - (python-tests--completion-extra-context))))) + (with-environment-variables + (("PYTHONSTARTUP" (python-tests--pythonstartup-file))) + (python-tests-with-temp-buffer-with-shell + "" + (python-shell-with-shell-buffer + (python-shell-completion-native-turn-off) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-shell-completion-native-turn-on) + (skip-unless (string= python-shell-readline-completer-delims "")) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-tests--completion-extra-context)))))) ;;; PDB Track integration -- cgit v1.2.3 From 1ddd9c8e29f721fcf6fcb17ef7a07fac0421c4f7 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 28 Feb 2024 15:30:41 +0100 Subject: ; * .mailmap: Fix GitHub address (bug#68559#170). --- .mailmap | 1 + 1 file changed, 1 insertion(+) diff --git a/.mailmap b/.mailmap index 7c474fcdaf6..c9bdede6c73 100644 --- a/.mailmap +++ b/.mailmap @@ -116,6 +116,7 @@ Lars Ingebrigtsen Lars Ingebrigtsen Laurence Warne Lin Sun +Liu Hui Ludovic Courtès Luke Lee Martin Rudalics -- cgit v1.2.3 From e490d2f8724c5e47d83c40c388f60e84f541dae5 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 28 Feb 2024 16:31:25 +0100 Subject: Revert change in tramp-adb-send-command * lisp/net/tramp-adb.el (tramp-adb-send-command): Revert check for `tramp-androidsu-method'. There is no need to restrict the check. --- lisp/net/tramp-adb.el | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 3f216ba403a..8ad7c271b4f 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -1114,9 +1114,7 @@ error and non-nil on success." (defun tramp-adb-send-command (vec command &optional neveropen nooutput) "Send the COMMAND to connection VEC." - (if (and (equal (tramp-file-name-method vec) - tramp-androidsu-method) - (string-match-p (rx multibyte) command)) + (if (string-match-p (rx multibyte) command) ;; Multibyte codepoints with four bytes are not supported at ;; least by toybox. @@ -1148,8 +1146,8 @@ error and non-nil on success." (while (search-forward-regexp (rx (+ "\r") eol) nil t) (replace-match "" nil nil))))))) -(defun tramp-adb-send-command-and-check (vec command &optional exit-status - command-augmented-p) +(defun tramp-adb-send-command-and-check + (vec command &optional exit-status command-augmented-p) "Run COMMAND and check its exit status. Sends `echo $?' along with the COMMAND for checking the exit status. If COMMAND is nil, just sends `echo $?'. Returns nil if @@ -1162,7 +1160,8 @@ Optional argument EXIT-STATUS, if non-nil, triggers the return of the exit status." (tramp-adb-send-command vec (if command - (if command-augmented-p command + (if command-augmented-p + command (format "%s; echo tramp_exit_status $?" command)) "echo tramp_exit_status $?")) (with-current-buffer (tramp-get-connection-buffer vec) -- cgit v1.2.3 From f7c2fe3337bb5e5721d17f40f79dbc1275e17b0d Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 28 Feb 2024 16:38:21 +0100 Subject: Pacify some docstring control char warnings Other instances are discussed in the following thread: https://lists.gnu.org/r/emacs-devel/2024-02/msg00797.html * lisp/allout.el (allout-command-prefix): Declare :type as key-sequence. Mark up key sequences in docstring. * lisp/auth-source.el (auth-source--decode-octal-string): * lisp/ffap.el (ffap-search-backward-file-end): * lisp/gnus/gnus-art.el (gnus-page-delimiter): * lisp/gnus/nnheader.el (nnheader-strip-cr): * lisp/proced.el (proced-log): * lisp/progmodes/idlw-shell.el (idlwave-shell-prompt-pattern): * lisp/url/url-http.el (url-http-clean-headers): * lisp/vcursor.el (vcursor-interpret-input): Quote control characters in docstrings. --- lisp/allout.el | 6 +++--- lisp/auth-source.el | 2 +- lisp/ffap.el | 4 ++-- lisp/gnus/gnus-art.el | 2 +- lisp/gnus/nnheader.el | 2 +- lisp/proced.el | 2 +- lisp/progmodes/idlw-shell.el | 4 ++-- lisp/url/url-http.el | 2 +- lisp/vcursor.el | 2 +- 9 files changed, 13 insertions(+), 13 deletions(-) diff --git a/lisp/allout.el b/lisp/allout.el index a7121efb14a..e3fe8d08841 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -161,9 +161,9 @@ respective `allout-mode' keybinding variables, `allout-command-prefix', (defcustom allout-command-prefix "\C-c " "Key sequence to be used as prefix for outline mode command key bindings. -Default is `\C-c'; just `\C-c' is more short-and-sweet, if you're -willing to let allout use a bunch of \C-c keybindings." - :type 'string +Default is \\`C-c SPC'; just \\`C-c' is more short-and-sweet, if you're +willing to let allout use a bunch of \\`C-c' keybindings." + :type 'key-sequence :group 'allout-keybindings :set #'allout-compose-and-institute-keymap) ;;;_ = allout-keybindings-binding diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 1f233f9f60f..5f5629d9cfc 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -1985,7 +1985,7 @@ entries for git.gnus.org: (defun auth-source--decode-octal-string (string) - "Convert octal STRING to utf-8 string. E.g: \"a\134b\" to \"a\b\"." + "Convert octal STRING to utf-8 string. E.g.: \"a\\134b\" to \"a\\b\"." (let ((list (string-to-list string)) (size (length string))) (decode-coding-string diff --git a/lisp/ffap.el b/lisp/ffap.el index 3492dcbf17a..5383f743878 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1098,12 +1098,12 @@ Suppose the cursor is somewhere that might be near end of file, the guessing would position point before punctuation (like comma) after the file extension: - C:\temp\file.log, which contain .... + C:\\temp\\file.log, which contain .... =============================== (before) ---------------- (after) - C:\temp\file.log on Windows or /tmp/file.log on Unix + C:\\temp\\file.log on Windows or /tmp/file.log on Unix =============================== (before) ---------------- (after) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index c3c5eab7d89..9f313108089 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -694,7 +694,7 @@ used as possible file names." (defcustom gnus-page-delimiter "^\^L" "Regexp describing what to use as article page delimiters. -The default value is \"^\^L\", which is a form linefeed at the +The default value is \"^\\^L\", which is a form linefeed at the beginning of a line." :type 'regexp :group 'gnus-article-various) diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 97821894b48..ea679759f3e 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -1016,7 +1016,7 @@ See `find-file-noselect' for the arguments." (nnheader-skeleton-replace from to t)) (defun nnheader-strip-cr () - "Strip all \r's from the current buffer." + "Strip all \\r's from the current buffer." (nnheader-skeleton-replace "\r")) (define-obsolete-function-alias 'nnheader-cancel-timer 'cancel-timer "27.1") diff --git a/lisp/proced.el b/lisp/proced.el index 3435f1ab8cd..7d7de1e2ce3 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -2261,7 +2261,7 @@ If LOG is a string and there are more args, it is formatted with those ARGS. Usually the LOG string ends with a \\n. End each bunch of errors with (proced-log t signal): this inserts the current time, buffer and signal at the start of the page, -and \f (formfeed) at the end." +and \\f (formfeed) at the end." (let ((obuf (current-buffer))) (with-current-buffer (get-buffer-create proced-log-buffer) (goto-char (point-max)) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 0f11103cf02..b5d91f46b17 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -96,8 +96,8 @@ (defcustom idlwave-shell-prompt-pattern "^\r? ?IDL> " "Regexp to match IDL prompt at beginning of a line. -For example, \"^\r?IDL> \" or \"^\r?WAVE> \". -The \"^\r?\" is needed, to indicate the beginning of the line, with +For example, \"^\\r?IDL> \" or \"^\\r?WAVE> \". +The \"^\\r?\" is needed, to indicate the beginning of the line, with optional return character (which IDL seems to output randomly). This variable is used to initialize `comint-prompt-regexp' in the process buffer." diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index d6a1d0eade8..184c1278072 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -427,7 +427,7 @@ Use `url-http-referer' as the Referer-header (subject to `url-privacy-level')." ;; Parsing routines (defun url-http-clean-headers () - "Remove trailing \r from header lines. + "Remove trailing \\r from header lines. This allows us to use `mail-fetch-field', etc. Return the number of characters removed." (let ((end (marker-position url-http-end-of-headers))) diff --git a/lisp/vcursor.el b/lisp/vcursor.el index ec5adbd832c..15791285b13 100644 --- a/lisp/vcursor.el +++ b/lisp/vcursor.el @@ -433,7 +433,7 @@ Default is nil." (defcustom vcursor-interpret-input nil "If non-nil, input from the vcursor is treated as interactive input. This will cause text insertion to be much slower. Note that no special -interpretation of strings is done: \"\C-x\" is a string of four +interpretation of strings is done: \"\\C-x\" is a string of four characters. The default is simply to copy strings." :type 'boolean :version "20.3") -- cgit v1.2.3 From bca3c9b466e24aacd561c818f2d19665af6efc11 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 28 Feb 2024 17:02:41 +0100 Subject: ; Fix :type of text-mode-ispell-word-completion. --- lisp/textmodes/text-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index 87f6668cecb..e8e1f4898ce 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -88,7 +88,7 @@ nor does it extend `completion-at-point-functions'. This user option only takes effect when you customize it in Custom or with `setopt', not with `setq'." :group 'text - :type 'boolean + :type '(choice (const completion-at-point) boolean) :version "30.1" :set (lambda (sym val) (if (and (set sym val) -- cgit v1.2.3 From 91b90885aca17b5140b56fa3b5c4960baf8672a1 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 28 Feb 2024 20:38:02 +0100 Subject: * lisp/emacs-lisp/comp.el (comp-known-predicates): Add 'symbol-with-pos-p'. --- lisp/emacs-lisp/comp.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index ae964b041d0..21e2bb01ed0 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -220,6 +220,7 @@ Useful to hook into pass checkers.") (sequencep . sequence) (stringp . string) (subrp . subr) + (symbol-with-pos-p . symbol-with-pos) (symbolp . symbol) (vectorp . vector) (windowp . window)) -- cgit v1.2.3 From 05195e129fc933db32c9e08a155a94bfa4d75b54 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 28 Feb 2024 20:38:30 +0100 Subject: * lisp/emacs-lisp/cl-macs.el (cl-deftype-satisfies): Add 'symbol-with-pos'. --- lisp/emacs-lisp/cl-macs.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index ddc9775bcce..be477b7a6df 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3496,6 +3496,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." (subr . subrp) (string . stringp) (symbol . symbolp) + (symbol-with-pos . symbol-with-pos-p) (vector . vectorp) (window . windowp) ;; FIXME: Do we really want to consider these types? -- cgit v1.2.3 From f8311e8b4491b5658b9d5d1bebad29478c7b95b7 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 28 Feb 2024 20:48:49 +0100 Subject: Run syncdoc-type-hierarchy.el to follow obarray type introduction * doc/lispref/type_hierarchy.jpg: Update. * doc/lispref/type_hierarchy.txt: Likewise. --- doc/lispref/type_hierarchy.jpg | Bin 217931 -> 223501 bytes doc/lispref/type_hierarchy.txt | 2 +- 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lispref/type_hierarchy.jpg b/doc/lispref/type_hierarchy.jpg index 72996897165..b7eba7d1cf7 100644 Binary files a/doc/lispref/type_hierarchy.jpg and b/doc/lispref/type_hierarchy.jpg differ diff --git a/doc/lispref/type_hierarchy.txt b/doc/lispref/type_hierarchy.txt index f68218b507a..c74bc45635b 100644 --- a/doc/lispref/type_hierarchy.txt +++ b/doc/lispref/type_hierarchy.txt @@ -7,7 +7,7 @@ | | font-entity font-spec condvar mutex thread terminal | | | hash-table frame buffer function window process | | | window-configuration overlay integer-or-marker | -| | number-or-marker symbol array | +| | number-or-marker symbol array obarray | | number | float integer | | number-or-marker | marker number | | integer | bignum fixnum | -- cgit v1.2.3 From 15ed441fd53ddb476a2a21c8717697a74cf094e1 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 29 Feb 2024 10:59:09 +0800 Subject: Fix subprocess creation in directories managed by tramp-androidsu * lisp/net/tramp-androidsu.el (tramp-androidsu-maybe-open-connection): Set connection property remote-namespace to t or nil subject to whether su runs in the global mount namespace. (tramp-androidsu-adb-handle-make-process): Delete function. (tramp-androidsu-make-process): New function. (tramp-androidsu-file-name-handler-alist): Switch to tramp-androidsu-make-process. --- lisp/net/tramp-androidsu.el | 134 +++++++++++++++++++++++++++++++++++++++----- 1 file changed, 119 insertions(+), 15 deletions(-) diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index fd9edb6a92e..1623a0341b2 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -118,11 +118,10 @@ multibyte mode and waits for the shell prompt to appear." ;; Set sentinel. Initialize variables. (set-process-sentinel p #'tramp-process-sentinel) (tramp-post-process-creation p vec) - ;; Replace `login-args' place holders. (setq command (format "exec su - %s || exit" (or user "root"))) - + (tramp-set-connection-property vec "remote-namespace" nil) ;; Attempt to execute the shell inside the global mount ;; namespace if requested. (when tramp-androidsu-mount-global-namespace @@ -140,6 +139,8 @@ multibyte mode and waits for the shell prompt to appear." (tramp-adb-send-command-and-check vec "su -mm -c 'exit 24'" 24))) (when tramp-androidsu-su-mm-supported + (tramp-set-connection-property + vec "remote-namespace" t) (setq command (format "exec su -mm - %s || exit" (or user "root")))))) ;; Send the command. @@ -156,27 +157,21 @@ multibyte mode and waits for the shell prompt to appear." ;; Set connection-local variables. (tramp-set-connection-local-variables vec) - ;; Change prompt. (tramp-adb-send-command vec (format "PS1=%s" (tramp-shell-quote-argument tramp-end-of-output))) - ;; Disable line editing. (tramp-adb-send-command vec "set +o vi +o vi-esccomplete +o vi-tabcomplete +o emacs") - ;; Dump option settings in the traces. (when (>= tramp-verbose 9) (tramp-adb-send-command vec "set -o")) - ;; Disable Unicode. (tramp-adb-send-command vec "set +U") - ;; Disable echo expansion. (tramp-adb-send-command vec "stty -inlcr -onlcr -echo kill '^U' erase '^H'" t) - ;; Check whether the echo has really been disabled. ;; Some implementations, like busybox, don't support ;; disabling. @@ -191,14 +186,12 @@ multibyte mode and waits for the shell prompt to appear." (tramp-adb-send-command vec "stty icanon erase ^H cols 32767" t))) - ;; Set the remote PATH to a suitable value. (tramp-set-connection-property vec "remote-path" - "/system/bin:/system/xbin") - + '("/system/bin" + "/system/xbin")) ;; Mark it as connected. (tramp-set-connection-property p "connected" t)))) - ;; Cleanup, and propagate the signal. ((error quit) (tramp-cleanup-connection vec t) @@ -386,8 +379,119 @@ FUNCTION." (defalias 'tramp-androidsu-handle-make-nearby-temp-file (tramp-androidsu-generate-wrapper #'tramp-handle-make-nearby-temp-file)) -(defalias 'tramp-androidsu-adb-handle-make-process - (tramp-androidsu-generate-wrapper #'tramp-adb-handle-make-process)) +(defun tramp-androidsu-make-process (&rest args) + "Like `tramp-handle-make-process', but modified for Android." + (when args + (with-parsed-tramp-file-name (expand-file-name default-directory) nil + (let ((default-directory tramp-compat-temporary-file-directory) + (name (plist-get args :name)) + (buffer (plist-get args :buffer)) + (command (plist-get args :command)) + (coding (plist-get args :coding)) + (noquery (plist-get args :noquery)) + (connection-type + (or (plist-get args :connection-type) process-connection-type)) + (filter (plist-get args :filter)) + (sentinel (plist-get args :sentinel)) + (stderr (plist-get args :stderr))) + (unless (stringp name) + (signal 'wrong-type-argument (list #'stringp name))) + (unless (or (bufferp buffer) (string-or-null-p buffer)) + (signal 'wrong-type-argument (list #'bufferp buffer))) + (unless (consp command) + (signal 'wrong-type-argument (list #'consp command))) + (unless (or (null coding) + (and (symbolp coding) (memq coding coding-system-list)) + (and (consp coding) + (memq (car coding) coding-system-list) + (memq (cdr coding) coding-system-list))) + (signal 'wrong-type-argument (list #'symbolp coding))) + (when (eq connection-type t) + (setq connection-type 'pty)) + (unless (or (and (consp connection-type) + (memq (car connection-type) '(nil pipe pty)) + (memq (cdr connection-type) '(nil pipe pty))) + (memq connection-type '(nil pipe pty))) + (signal 'wrong-type-argument (list #'symbolp connection-type))) + (unless (or (null filter) (eq filter t) (functionp filter)) + (signal 'wrong-type-argument (list #'functionp filter))) + (unless (or (null sentinel) (functionp sentinel)) + (signal 'wrong-type-argument (list #'functionp sentinel))) + (unless (or (null stderr) (bufferp stderr)) + (signal 'wrong-type-argument (list #'bufferp stderr))) + (let* ((buffer + (if buffer + (get-buffer-create buffer) + ;; BUFFER can be nil. We use a temporary buffer. + (generate-new-buffer tramp-temp-buffer-name))) + (orig-command command) + (env (mapcar + (lambda (elt) + (when (tramp-compat-string-search "=" elt) elt)) + tramp-remote-process-environment)) + ;; We use as environment the difference to toplevel + ;; `process-environment'. + (env (dolist (elt process-environment env) + (when + (and + (tramp-compat-string-search "=" elt) + (not + (member + elt (default-toplevel-value 'process-environment)))) + (setq env (cons elt env))))) + ;; Add remote path if exists. + (env (let ((remote-path + (string-join (tramp-get-remote-path v) ":"))) + (setenv-internal env "PATH" remote-path 'keep))) + (env (setenv-internal + env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)) + (env (mapcar #'tramp-shell-quote-argument (delq nil env))) + ;; Quote command. + (command (mapconcat #'tramp-shell-quote-argument command " ")) + ;; Set cwd and environment variables. + (command + (append + `("cd" ,(tramp-shell-quote-argument localname) "&&" "(" "env") + env `(,command ")"))) + ;; Add remote shell if needed. + (command + (if (consp (tramp-get-method-parameter v 'tramp-direct-async)) + (append + (tramp-get-method-parameter v 'tramp-direct-async) + `(,(string-join command " "))) + command)) + p) + ;; Generate a command to start the process using `su' with + ;; suitable options for specifying the mount namespace and + ;; suchlike. + (setq + p (make-process + :name name :buffer buffer + :command (if (tramp-get-connection-property v "remote-namespace") + (append (list "su" "-mm" "-" (or user "root") "-c") + command) + (append (list "su" "-" (or user "root") "-c") + command)) + :coding coding :noquery noquery :connection-type connection-type + :sentinel sentinel :stderr stderr)) + ;; Set filter. Prior Emacs 29.1, it doesn't work reliably + ;; to provide it as `make-process' argument when filter is + ;; t. See Bug#51177. + (when filter + (set-process-filter p filter)) + (tramp-post-process-creation p v) + ;; Query flag is overwritten in `tramp-post-process-creation', + ;; so we reset it. + (set-process-query-on-exit-flag p (null noquery)) + ;; This is needed for ssh or PuTTY based processes, and + ;; only if the respective options are set. Perhaps, the + ;; setting could be more fine-grained. + ;; (process-put p 'tramp-shared-socket t) + (process-put p 'remote-command orig-command) + (tramp-set-connection-property p "remote-command" orig-command) + (when (bufferp stderr) + (tramp-taint-remote-process-buffer stderr)) + p))))) (defalias 'tramp-androidsu-sh-handle-make-symbolic-link (tramp-androidsu-generate-wrapper @@ -508,7 +612,7 @@ FUNCTION." (make-directory-internal . ignore) (make-lock-file-name . tramp-androidsu-handle-make-lock-file-name) (make-nearby-temp-file . tramp-androidsu-handle-make-nearby-temp-file) - (make-process . tramp-androidsu-adb-handle-make-process) + (make-process . tramp-androidsu-make-process) (make-symbolic-link . tramp-androidsu-sh-handle-make-symbolic-link) (memory-info . tramp-androidsu-handle-memory-info) (process-attributes . tramp-androidsu-handle-process-attributes) -- cgit v1.2.3 From 862dfef88d8e62d12bac3ca2e44e035a2ff5b298 Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Thu, 29 Feb 2024 09:29:04 +0100 Subject: Pacify more docstring control char warnings * lisp/org/org-macs.el (org-split-string): Escape control chars. * lisp/org/ox-latex.el (org-latex-guess-babel-language): And here. --- lisp/org/org-macs.el | 2 +- lisp/org/ox-latex.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 2332c0c927c..aafbdf0e0aa 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -982,7 +982,7 @@ Otherwise, return nil." "Splits STRING into substrings at SEPARATORS. SEPARATORS is a regular expression. When nil, it defaults to -\"[ \f\t\n\r\v]+\". +\"[ \\f\\t\\n\\r\\v]+\". Unlike `split-string', matching SEPARATORS at the beginning and end of string are ignored." diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index b409f552a2b..bca387e5935 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -1632,7 +1632,7 @@ explicitly been loaded. Then it is added to the rest of package's options. The optional argument to Babel or the mandatory argument to -`\babelprovide' command may be \"AUTO\" which is then replaced +`\\babelprovide' command may be \"AUTO\" which is then replaced with the language of the document or `org-export-default-language' unless language in question is already loaded. -- cgit v1.2.3 From b8ba3cb7f00504ec58fda867a44631cc14b3343d Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 29 Feb 2024 11:04:07 +0100 Subject: * Improve 'native-comp-async-report-warnings-errors' tag * lisp/emacs-lisp/comp-run.el (native-comp-async-report-warnings-errors): Improve tag. --- lisp/emacs-lisp/comp-run.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index 8fcbe31cf0b..c78b5ece9bd 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -72,9 +72,9 @@ Set this variable to nil to suppress warnings altogether, or to the symbol `silent' to log warnings but not pop up the *Warnings* buffer." :type '(choice - (const :tag "Do not report warnings" nil) - (const :tag "Report and display warnings" t) - (const :tag "Report but do not display warnings" silent)) + (const :tag "Do not report warnings/errors" nil) + (const :tag "Report and display warnings/errors" t) + (const :tag "Report but do not display warnings/errors" silent)) :version "28.1") (defcustom native-comp-always-compile nil -- cgit v1.2.3 From 8e5baaddec2d6a7f48ca0a08e0a95a51c6cbb151 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 29 Feb 2024 11:25:00 +0100 Subject: * Add 'native-comp-async-report-warnings-errors-kind' * lisp/emacs-lisp/comp-run.el (native-comp-async-report-warnings-errors-kind): Add new customize. --- lisp/emacs-lisp/comp-run.el | 27 ++++++++++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index c78b5ece9bd..eec50c39c68 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -77,6 +77,19 @@ buffer." (const :tag "Report but do not display warnings/errors" silent)) :version "28.1") +(defcustom native-comp-async-report-warnings-errors-kind 'importants + "Select which kind of warnings and errors to report. + +Set this variable to `importants' to have only important warnings and +all errors to be reported. + +Set this variable to `all' to have all warnings and errors to be +reported." + :type '(choice + (const :tag "Report all warnings/errors" all) + (const :tag "Report only important warnings and errors" importants)) + :version "30.1") + (defcustom native-comp-always-compile nil "Non-nil means unconditionally (re-)compile all files." :type 'boolean @@ -184,13 +197,21 @@ processes from `comp-async-compilations'" (let ((warning-suppress-types (if (eq native-comp-async-report-warnings-errors 'silent) (cons '(comp) warning-suppress-types) - warning-suppress-types))) + warning-suppress-types)) + (regexp (if (eq native-comp-async-report-warnings-errors-kind 'all) + "^.*?\\(?:Error\\|Warning\\): .*$" + (rx bol + (*? nonl) + (or + (seq "Error: " (*? nonl)) + (seq "Warning: the function ‘" (1+ (not "’")) + "’ is not known to be defined.")) + eol)))) (with-current-buffer (process-buffer process) (save-excursion (accept-process-output process) (goto-char (or comp-last-scanned-async-output (point-min))) - (while (re-search-forward "^.*?\\(?:Error\\|Warning\\): .*$" - nil t) + (while (re-search-forward regexp nil t) (display-warning 'comp (match-string 0))) (setq comp-last-scanned-async-output (point-max))))) (accept-process-output process))) -- cgit v1.2.3 From 62bdd307a7fd6c319529b7b20425b993a2945043 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 29 Feb 2024 14:15:30 +0100 Subject: * etc/TODO (Native compiler improvements): Remove an entry as completed. --- etc/TODO | 16 ---------------- 1 file changed, 16 deletions(-) diff --git a/etc/TODO b/etc/TODO index 0152cf9303e..52c77ccc28d 100644 --- a/etc/TODO +++ b/etc/TODO @@ -910,22 +910,6 @@ restore the redirection through funcall. *** Features to be improved or missing -**** Diagnostic - -***** Filtering async warnings - -Add a new 'native-comp-async-report-warnings-errors' value such that -we filter out all the uninteresting warnings (that the programmer -already got during byte compilation) but we still report the important -ones ('the function ‘xxx’ is not known to be defined.'). - -This way even if the package developer doesn't use native compilation -it can get the bug report for the issue and -'*Async-native-compile-log*' is not too crowded. - -This new value for 'native-comp-async-report-warnings-errors' should -be default. - **** Fix portable dumping so that you can redump without using -batch ***** Redumps and native compiler "preloaded" sub-folder. -- cgit v1.2.3 From 39239982403f01a37d42d1cd8db0b2ed0b48b50c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 29 Feb 2024 15:37:19 +0200 Subject: Improve documentation of recent changes in comp-run.el * lisp/emacs-lisp/comp-run.el (native-comp-async-warnings-errors-kind): Rename from 'native-comp-async-report-warnings-errors-kind', and rename 'importants' to 'important'; all users changed. Doc fix. * etc/NEWS: Announce the new option. --- etc/NEWS | 6 ++++++ lisp/emacs-lisp/comp-run.el | 17 ++++++++--------- 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index b4a1c887f2e..b1e3130ab79 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1960,6 +1960,12 @@ The warning name is 'docstrings-control-chars'. *** The warning about wide docstrings can now be disabled separately. Its warning name is 'docstrings-wide'. +--- +** New user option 'native-comp-async-warnings-errors-kind'. +It allows control of what kinds of warnings and errors from asynchronous +native compilation are reported to the parent Emacs process. The +default is to report all errors and only important warnings. + +++ ** New function declaration and property 'important-return-value'. The declaration '(important-return-value t)' sets the diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index eec50c39c68..057760322ab 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -77,17 +77,16 @@ buffer." (const :tag "Report but do not display warnings/errors" silent)) :version "28.1") -(defcustom native-comp-async-report-warnings-errors-kind 'importants - "Select which kind of warnings and errors to report. +(defcustom native-comp-async-warnings-errors-kind 'important + "Which kind of warnings and errors to report from async native compilation. -Set this variable to `importants' to have only important warnings and -all errors to be reported. - -Set this variable to `all' to have all warnings and errors to be -reported." +Setting this variable to `important' (the default) will report +only important warnings and all errors. +Setting this variable to `all' will report all warnings and +errors." :type '(choice (const :tag "Report all warnings/errors" all) - (const :tag "Report only important warnings and errors" importants)) + (const :tag "Report important warnings and all errors" important)) :version "30.1") (defcustom native-comp-always-compile nil @@ -198,7 +197,7 @@ processes from `comp-async-compilations'" (if (eq native-comp-async-report-warnings-errors 'silent) (cons '(comp) warning-suppress-types) warning-suppress-types)) - (regexp (if (eq native-comp-async-report-warnings-errors-kind 'all) + (regexp (if (eq native-comp-async-warnings-errors-kind 'all) "^.*?\\(?:Error\\|Warning\\): .*$" (rx bol (*? nonl) -- cgit v1.2.3 From 093c2e1ab9db5e0309bf9bbb5deb9a7dcbad6267 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Thu, 29 Feb 2024 16:21:05 +0100 Subject: ; Fix some wording in recent obarray changes. --- doc/lispref/symbols.texi | 2 +- lisp/obarray.el | 9 +++++---- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 5207ea4ea7b..6f9b1ef0ec7 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -231,7 +231,7 @@ Emacs Lisp provides a different namespacing system called This function creates and returns a new obarray. The optional @var{size} may be used to specify the number of symbols that it is expected to hold, but since obarrays grow automatically -as needed, this rarely provide any benefit. +as needed, this rarely provides any benefit. @end defun @defun obarrayp object diff --git a/lisp/obarray.el b/lisp/obarray.el index e6e51c1382a..5e646db9ab7 100644 --- a/lisp/obarray.el +++ b/lisp/obarray.el @@ -29,10 +29,11 @@ (defconst obarray-default-size 4) (make-obsolete-variable 'obarray-default-size - "obarrays now grow automatically" "30.1") + "obarrays now grow automatically." "30.1") -(defun obarray-size (_ob) obarray-default-size) -(make-obsolete 'obarray-size "obarrays now grow automatically" "30.1") +(defun obarray-size (_ob) + (declare (obsolete "obarrays now grow automatically." "30.1")) + obarray-default-size) ;; Don’t use obarray as a variable name to avoid shadowing. (defun obarray-get (ob name) @@ -42,7 +43,7 @@ Return nil otherwise." (defun obarray-put (ob name) "Return symbol named NAME from obarray OB. -Creates and adds the symbol if doesn't exist." +Creates and adds the symbol if it doesn't exist." (intern name ob)) (defun obarray-remove (ob name) -- cgit v1.2.3 From e18a6fbb44ac48998a1aebe25136a59e5a419b57 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 29 Feb 2024 18:25:12 +0200 Subject: ; Tweak recently-added NEWS entry. --- etc/NEWS | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index b1e3130ab79..198563e0fc0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1964,7 +1964,10 @@ Its warning name is 'docstrings-wide'. ** New user option 'native-comp-async-warnings-errors-kind'. It allows control of what kinds of warnings and errors from asynchronous native compilation are reported to the parent Emacs process. The -default is to report all errors and only important warnings. +default is to report all errors and only important warnings. If you +were used to customizing 'native-comp-async-report-warnings-errors' to +nil or 'silent', we suggest that you now leave it at its default value, +and see if you get only warnings that matter. +++ ** New function declaration and property 'important-return-value'. -- cgit v1.2.3 From 8305d0e0c909a5dd91a21cc1daea6298aae9eda7 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 29 Feb 2024 19:50:04 +0200 Subject: Add tabulated-list-groups and Buffer-menu-group-by (bug#69305) * doc/lispref/modes.texi (Tabulated List Mode): Add defvar tabulated-list-groups. * lisp/buff-menu.el (Buffer-menu-group-by): New defcustom. (Buffer-menu-unmark-all-buffers): Use tabulated-list-get-entry to check whether the current line contains an entry. (list-buffers-noselect): Enable outline-minor-mode for tabulated-list-groups. (list-buffers--refresh): When Buffer-menu-group-by is non-nil, set tabulated-list-groups. (Buffer-menu-group-by-mode, Buffer-menu-group-by-root): New functions. * lisp/emacs-lisp/tabulated-list.el (tabulated-list-groups): New buffer-local variable. (tabulated-list-print-fake-header): Add distinct overlay property 'fake-header'. (tabulated-list-header-overlay-p): Filter out overlays that don't have the property 'fake-header'. (tabulated-list-print): Use the variable 'tabulated-list-groups' to sort entries in groups separately. (tabulated-list-print-entries): New function factored out from 'tabulated-list-print'. * test/lisp/emacs-lisp/tabulated-list-tests.el (tabulated-list-groups): New test. --- doc/lispref/modes.texi | 35 ++++++++++++++ etc/NEWS | 9 ++++ lisp/buff-menu.el | 54 ++++++++++++++++++---- lisp/emacs-lisp/tabulated-list.el | 68 ++++++++++++++++++++++------ test/lisp/emacs-lisp/tabulated-list-tests.el | 41 +++++++++++++++++ 5 files changed, 185 insertions(+), 22 deletions(-) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 630e42e6878..7a4a722d595 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1246,6 +1246,41 @@ Otherwise, the value should be a function which returns a list of the above form when called with no arguments. @end defvar +@defvar tabulated-list-groups +This buffer-local variable specifies the groups of entries displayed in +the Tabulated List buffer. Its value should be either a list, or a +function. + +If the value is a list, each list element corresponds to one group, and +should have the form @w{@code{(@var{group-name} @var{entries})}}, where +@var{group-name} is a string inserted before all group entries, and +@var{entries} have the same format as @code{tabulated-list-entries} +(see above). + +Otherwise, the value should be a function which returns a list of the +above form when called with no arguments. + +You can use @code{seq-group-by} to create @code{tabulated-list-groups} +from @code{tabulated-list-entries}. For example: + +@smallexample +@group + (setq tabulated-list-groups + (seq-group-by 'Buffer-menu-group-by-mode + tabulated-list-entries)) +@end group +@end smallexample + +where you can define @code{Buffer-menu-group-by-mode} like this: + +@smallexample +@group +(defun Buffer-menu-group-by-mode (entry) + (concat "* " (aref (cadr entry) 5))) +@end group +@end smallexample +@end defvar + @defvar tabulated-list-revert-hook This normal hook is run prior to reverting a Tabulated List buffer. A derived mode can add a function to this hook to recompute diff --git a/etc/NEWS b/etc/NEWS index 198563e0fc0..72757622958 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1356,6 +1356,11 @@ will return the URL for that bug. This allows for rcirc logs to use a custom timestamp format, than the chat buffers use by default. +--- +*** New user option 'Buffer-menu-group-by'. +It splits buffers by groups that are displayed with headings +in Outline minor mode. + --- *** New command 'Buffer-menu-toggle-internal'. This command toggles the display of internal buffers in Buffer Menu mode; @@ -2070,6 +2075,10 @@ inside 'treesit-language-source-alist', so that calling It may be useful, for example, for the purposes of bisecting a treesitter grammar. ++++ +** New buffer-local variable 'tabulated-list-groups'. +It prints and sorts the groups of entries separately. + * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index e13c3b56b4e..1d52feb5733 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -95,6 +95,25 @@ as it is by default." :group 'Buffer-menu :version "22.1") +(defcustom Buffer-menu-group-by nil + "If non-nil, buffers are grouped by function. +This function takes one argument: a list of entries in the same format +as in `tabulated-list-entries', and should return a list in the format +suitable for `tabulated-list-groups'. Also when this variable is non-nil, +then `outline-minor-mode' is enabled in the Buffer Menu. Then with the +default value of `outline-regexp' you can use Outline minor mode commands +to show/hide groups of buffers. +The default options can group by a mode, and by a root directory of +a project or just `default-directory'." + :type '(choice (const :tag "No grouping" nil) + (function-item :tag "Group by mode" + Buffer-menu-group-by-mode) + (function-item :tag "Group by project root or directory" + Buffer-menu-group-by-root) + (function :tag "Custom function")) + :group 'Buffer-menu + :version "30.1") + (defvar-local Buffer-menu-files-only nil "Non-nil if the current Buffer Menu lists only file buffers. This is set by the prefix argument to `buffer-menu' and related @@ -408,14 +427,12 @@ When called interactively prompt for MARK; RET remove all marks." (interactive "cRemove marks (RET means all):" Buffer-menu-mode) (save-excursion (goto-char (point-min)) - (when (tabulated-list-header-overlay-p) - (forward-line)) (while (not (eobp)) - (let ((xmarks (list (aref (tabulated-list-get-entry) 0) - (aref (tabulated-list-get-entry) 2)))) - (when (or (char-equal mark ?\r) - (member (char-to-string mark) xmarks)) - (Buffer-menu--unmark))) + (when-let ((entry (tabulated-list-get-entry))) + (let ((xmarks (list (aref entry 0) (aref entry 2)))) + (when (or (char-equal mark ?\r) + (member (char-to-string mark) xmarks)) + (Buffer-menu--unmark)))) (forward-line)))) (defun Buffer-menu-unmark-all () @@ -674,7 +691,12 @@ See more at `Buffer-menu-filter-predicate'." (setq Buffer-menu-buffer-list buffer-list) (setq Buffer-menu-filter-predicate filter-predicate) (list-buffers--refresh buffer-list old-buffer) - (tabulated-list-print)) + (tabulated-list-print) + (when tabulated-list-groups + (setq-local outline-minor-mode-cycle t + outline-minor-mode-highlight t + outline-minor-mode-use-buttons 'in-margins) + (outline-minor-mode 1))) buffer)) (defun Buffer-menu-mouse-select (event) @@ -750,7 +772,11 @@ See more at `Buffer-menu-filter-predicate'." `("Mode" ,Buffer-menu-mode-width t) '("File" 1 t))) (setq tabulated-list-use-header-line Buffer-menu-use-header-line) - (setq tabulated-list-entries (nreverse entries))) + (setq tabulated-list-entries (nreverse entries)) + (when Buffer-menu-group-by + (setq tabulated-list-groups + (seq-group-by Buffer-menu-group-by + tabulated-list-entries)))) (tabulated-list-init-header)) (defun tabulated-list-entry-size-> (entry1 entry2) @@ -769,4 +795,14 @@ See more at `Buffer-menu-filter-predicate'." (abbreviate-file-name list-buffers-directory)) (t ""))) +(defun Buffer-menu-group-by-mode (entry) + (concat "* " (aref (cadr entry) 5))) + +(declare-function project-root "project" (project)) +(defun Buffer-menu-group-by-root (entry) + (concat "* " (with-current-buffer (car entry) + (if-let ((project (project-current))) + (project-root project) + default-directory)))) + ;;; buff-menu.el ends here diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 9884a2fc24b..c86e3f9c5df 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -139,6 +139,21 @@ If `tabulated-list-entries' is a function, it is called with no arguments and must return a list of the above form.") (put 'tabulated-list-entries 'permanent-local t) +(defvar-local tabulated-list-groups nil + "Groups displayed in the current Tabulated List buffer. +This should be either a function, or a list. +If a list, each element has the form (GROUP-NAME ENTRIES), +where: + + - GROUP-NAME is a group name as a string, which is displayed + at the top line of each group. + + - ENTRIES is a list described in `tabulated-list-entries'. + +If `tabulated-list-groups' is a function, it is called with no +arguments and must return a list of the above form.") +(put 'tabulated-list-groups 'permanent-local t) + (defvar-local tabulated-list-padding 0 "Number of characters preceding each Tabulated List mode entry. By default, lines are padded with spaces, but you can use the @@ -362,15 +377,17 @@ Do nothing if `tabulated-list--header-string' is nil." (if tabulated-list--header-overlay (move-overlay tabulated-list--header-overlay (point-min) (point)) (setq-local tabulated-list--header-overlay - (make-overlay (point-min) (point)))) - (overlay-put tabulated-list--header-overlay - 'face 'tabulated-list-fake-header)))) + (make-overlay (point-min) (point))) + (overlay-put tabulated-list--header-overlay 'fake-header t) + (overlay-put tabulated-list--header-overlay + 'face 'tabulated-list-fake-header))))) (defsubst tabulated-list-header-overlay-p (&optional pos) "Return non-nil if there is a fake header. Optional arg POS is a buffer position where to look for a fake header; defaults to `point-min'." - (overlays-at (or pos (point-min)))) + (seq-find (lambda (o) (overlay-get o 'fake-header)) + (overlays-at (or pos (point-min))))) (defun tabulated-list-revert (&rest _ignored) "The `revert-buffer-function' for `tabulated-list-mode'. @@ -427,6 +444,9 @@ This sorts the `tabulated-list-entries' list if sorting is specified by `tabulated-list-sort-key'. It then erases the buffer and inserts the entries with `tabulated-list-printer'. +If `tabulated-list-groups' is non-nil, each group of entries +is printed and sorted separately. + Optional argument REMEMBER-POS, if non-nil, means to move point to the entry with the same ID element as the current line. @@ -437,6 +457,9 @@ be removed from entries that haven't changed (see `tabulated-list-put-tag'). Don't use this immediately after changing `tabulated-list-sort-key'." (let ((inhibit-read-only t) + (groups (if (functionp tabulated-list-groups) + (funcall tabulated-list-groups) + tabulated-list-groups)) (entries (if (functionp tabulated-list-entries) (funcall tabulated-list-entries) tabulated-list-entries)) @@ -447,7 +470,14 @@ changing `tabulated-list-sort-key'." (setq saved-col (current-column))) ;; Sort the entries, if necessary. (when sorter - (setq entries (sort entries sorter))) + (if groups + (setq groups + (mapcar (lambda (group) + (cons (car group) (sort (cdr group) sorter))) + groups)) + (setq entries (sort entries sorter)))) + (unless (functionp tabulated-list-groups) + (setq tabulated-list-groups groups)) (unless (functionp tabulated-list-entries) (setq tabulated-list-entries entries)) ;; Without a sorter, we have no way to just update. @@ -459,6 +489,25 @@ changing `tabulated-list-sort-key'." (unless tabulated-list-use-header-line (tabulated-list-print-fake-header))) ;; Finally, print the resulting list. + (if groups + (dolist (group groups) + (insert (car group) ?\n) + (when-let ((saved-pt-new (tabulated-list-print-entries + (cdr group) sorter update entry-id))) + (setq saved-pt saved-pt-new))) + (setq saved-pt (tabulated-list-print-entries + entries sorter update entry-id))) + (when update + (delete-region (point) (point-max))) + (set-buffer-modified-p nil) + ;; If REMEMBER-POS was specified, move to the "old" location. + (if saved-pt + (progn (goto-char saved-pt) + (move-to-column saved-col)) + (goto-char (point-min))))) + +(defun tabulated-list-print-entries (entries sorter update entry-id) + (let (saved-pt) (while entries (let* ((elt (car entries)) (tabulated-list--near-rows @@ -495,14 +544,7 @@ changing `tabulated-list-sort-key'." (forward-line 1) (delete-region old (point)))))) (setq entries (cdr entries))) - (when update - (delete-region (point) (point-max))) - (set-buffer-modified-p nil) - ;; If REMEMBER-POS was specified, move to the "old" location. - (if saved-pt - (progn (goto-char saved-pt) - (move-to-column saved-col)) - (goto-char (point-min))))) + saved-pt)) (defun tabulated-list-print-entry (id cols) "Insert a Tabulated List entry at point. diff --git a/test/lisp/emacs-lisp/tabulated-list-tests.el b/test/lisp/emacs-lisp/tabulated-list-tests.el index 8be2be3139e..e53268b3f14 100644 --- a/test/lisp/emacs-lisp/tabulated-list-tests.el +++ b/test/lisp/emacs-lisp/tabulated-list-tests.el @@ -130,4 +130,45 @@ (should-error (tabulated-list-sort) :type 'user-error) (should-error (tabulated-list-sort 4) :type 'user-error))) +(ert-deftest tabulated-list-groups () + (with-temp-buffer + (tabulated-list-mode) + (setq tabulated-list-groups + (reverse + (seq-group-by (lambda (b) (concat "* " (aref (cadr b) 3))) + tabulated-list--test-entries))) + (setq tabulated-list-format tabulated-list--test-format) + (setq tabulated-list-padding 7) + (tabulated-list-init-header) + (tabulated-list-print) + ;; Basic printing. + (should (string-equal + (buffer-substring-no-properties (point-min) (point-max)) + "\ +* installed + zzzz-game zzzz-game 2113 installed play zzzz in Emacs + mode mode 1128 installed A simple mode for editing Actionscript 3 files +* available + abc-mode abc-mode 944 available Major mode for editing abc music files +* obsolete + 4clojure 4clojure 1507 obsolete Open and evaluate 4clojure.com questions +")) + ;; Sort and preserve position. + (forward-line 2) + (let ((pos (thing-at-point 'line))) + (tabulated-list-next-column 2) + (tabulated-list-sort) + (should (equal (thing-at-point 'line) pos)) + (should (string-equal + (buffer-substring-no-properties (point-min) (point-max)) + "\ +* installed + mode mode 1128 installed A simple mode for editing Actionscript 3 files + zzzz-game zzzz-game 2113 installed play zzzz in Emacs +* available + abc-mode abc-mode 944 available Major mode for editing abc music files +* obsolete + 4clojure 4clojure 1507 obsolete Open and evaluate 4clojure.com questions +"))))) + ;;; tabulated-list-tests.el ends here -- cgit v1.2.3 From 4dd4f145b8528d5a742af4268073c24d629801d8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 29 Feb 2024 20:57:12 +0200 Subject: ; Improve documentation of last changeset (bug#69305) * etc/NEWS (Example): * doc/lispref/modes.texi (Tabulated List Mode): Improve documentation of 'Buffer-menu-group-by' and 'tabulated-list-groups'. * lisp/buff-menu.el (Buffer-menu-group-by): Doc fix. --- doc/lispref/modes.texi | 3 ++- etc/NEWS | 6 +++--- lisp/buff-menu.el | 17 +++++++++-------- 3 files changed, 14 insertions(+), 12 deletions(-) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 7a4a722d595..8bdf596bf9e 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1248,7 +1248,7 @@ above form when called with no arguments. @defvar tabulated-list-groups This buffer-local variable specifies the groups of entries displayed in -the Tabulated List buffer. Its value should be either a list, or a +the Tabulated List buffer. Its value should be either a list or a function. If the value is a list, each list element corresponds to one group, and @@ -1271,6 +1271,7 @@ from @code{tabulated-list-entries}. For example: @end group @end smallexample +@noindent where you can define @code{Buffer-menu-group-by-mode} like this: @smallexample diff --git a/etc/NEWS b/etc/NEWS index 72757622958..df07b2a9d79 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1358,8 +1358,8 @@ chat buffers use by default. --- *** New user option 'Buffer-menu-group-by'. -It splits buffers by groups that are displayed with headings -in Outline minor mode. +It controls how buffers are divided into groups that are displayed with +headings using Outline minor mode. --- *** New command 'Buffer-menu-toggle-internal'. @@ -2077,7 +2077,7 @@ treesitter grammar. +++ ** New buffer-local variable 'tabulated-list-groups'. -It prints and sorts the groups of entries separately. +It controls display and separate sorting of groups of entries. * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 1d52feb5733..ca417290018 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -96,15 +96,16 @@ as it is by default." :version "22.1") (defcustom Buffer-menu-group-by nil - "If non-nil, buffers are grouped by function. -This function takes one argument: a list of entries in the same format -as in `tabulated-list-entries', and should return a list in the format -suitable for `tabulated-list-groups'. Also when this variable is non-nil, -then `outline-minor-mode' is enabled in the Buffer Menu. Then with the -default value of `outline-regexp' you can use Outline minor mode commands -to show/hide groups of buffers. + "If non-nil, a function to call to divide buffer-menu buffers into groups. +This function is called with one argument: a list of entries in the same +format as in `tabulated-list-entries', and should return a list in the +format suitable for `tabulated-list-groups'. Also, when this variable +is non-nil, `outline-minor-mode' is enabled in the Buffer Menu and you +can use Outline minor mode commands to show/hide groups of buffers, +according to the value of `outline-regexp'. The default options can group by a mode, and by a root directory of -a project or just `default-directory'." +a project or just `default-directory'. +If this is nil, buffers are not divided into groups." :type '(choice (const :tag "No grouping" nil) (function-item :tag "Group by mode" Buffer-menu-group-by-mode) -- cgit v1.2.3 From 2549eabc97f191ecea65d88d59cf21e5e0c81be8 Mon Sep 17 00:00:00 2001 From: Dan Jacobson Date: Fri, 1 Mar 2024 12:44:44 +0800 Subject: Fix typos in vnvni.el. * lisp/leim/quail/vnvni.el ("vietnamese-vni"): Fix typos. (Bug#69485) Copyright-paperwork-exempt: yes --- lisp/leim/quail/vnvni.el | 54 ++++++++++++++++++++++++------------------------ 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/lisp/leim/quail/vnvni.el b/lisp/leim/quail/vnvni.el index 59d1a82eb21..ae5941cbfc7 100644 --- a/lisp/leim/quail/vnvni.el +++ b/lisp/leim/quail/vnvni.el @@ -125,8 +125,8 @@ and postfix: E66 -> E6, a55 -> a5, etc. ("A61" ?Ấ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND ACUTE ("a62" ?ầ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE ("A62" ?Ầ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND GRAVE - ("a63" ?ẩ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND HO6K ABOVE - ("A63" ?Ẩ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HO6K ABOVE + ("a63" ?ẩ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE + ("A63" ?Ẩ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE ("a64" ?ẫ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE ("A64" ?Ẫ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND TILDE ("a65" ?ậ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW @@ -135,42 +135,42 @@ and postfix: E66 -> E6, a55 -> a5, etc. ("A81" ?Ắ) ; LATIN CAPITAL LETTER A WITH BREVE AND ACUTE ("a82" ?ằ) ; LATIN SMALL LETTER A WITH BREVE AND GRAVE ("A82" ?Ằ) ; LATIN CAPITAL LETTER A WITH BREVE AND GRAVE - ("a83" ?ẳ) ; LATIN SMALL LETTER A WITH BREVE AND HO6K ABOVE - ("A83" ?Ẳ) ; LATIN CAPITAL LETTER A WITH BREVE AND HO6K ABOVE + ("a83" ?ẳ) ; LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE + ("A83" ?Ẳ) ; LATIN CAPITAL LETTER A WITH BREVE AND HOOK ABOVE ("a84" ?ẵ) ; LATIN SMALL LETTER A WITH BREVE AND TILDE ("A84" ?Ẵ) ; LATIN CAPITAL LETTER A WITH BREVE AND TILDE ("a85" ?ặ) ; LATIN SMALL LETTER A WITH BREVE AND DOT BELOW ("A85" ?Ặ) ; LATIN CAPITAL LETTER A WITH BREVE AND DOT BELOW ("e5" ?ẹ) ; LATIN SMALL LETTER E WITH DOT BELOW ("E5" ?Ẹ) ; LATIN CAPITAL LETTER E WITH DOT BELOW - ("e3" ?ẻ) ; LATIN SMALL LETTER E WITH HO6K ABOVE - ("E3" ?Ẻ) ; LATIN CAPITAL LETTER E WITH HO6K ABOVE + ("e3" ?ẻ) ; LATIN SMALL LETTER E WITH HOOK ABOVE + ("E3" ?Ẻ) ; LATIN CAPITAL LETTER E WITH HOOK ABOVE ("e4" ?ẽ) ; LATIN SMALL LETTER E WITH TILDE ("E4" ?Ẽ) ; LATIN CAPITAL LETTER E WITH TILDE ("e61" ?ế) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE ("E61" ?Ế) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND ACUTE ("e62" ?ề) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE ("E62" ?Ề) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND GRAVE - ("e63" ?ể) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND HO6K ABOVE - ("E63" ?Ể) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HO6K ABOVE + ("e63" ?ể) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE + ("E63" ?Ể) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE ("e64" ?ễ) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE ("E64" ?Ễ) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND TILDE ("e65" ?ệ) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW ("E65" ?Ệ) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND DOT BELOW - ("i3" ?ỉ) ; LATIN SMALL LETTER I WITH HO6K ABOVE - ("I3" ?Ỉ) ; LATIN CAPITAL LETTER I WITH HO6K ABOVE + ("i3" ?ỉ) ; LATIN SMALL LETTER I WITH HOOK ABOVE + ("I3" ?Ỉ) ; LATIN CAPITAL LETTER I WITH HOOK ABOVE ("i5" ?ị) ; LATIN SMALL LETTER I WITH DOT BELOW ("I5" ?Ị) ; LATIN CAPITAL LETTER I WITH DOT BELOW ("o5" ?ọ) ; LATIN SMALL LETTER O WITH DOT BELOW ("O5" ?Ọ) ; LATIN CAPITAL LETTER O WITH DOT BELOW - ("o3" ?ỏ) ; LATIN SMALL LETTER O WITH HO6K ABOVE - ("O3" ?Ỏ) ; LATIN CAPITAL LETTER O WITH HO6K ABOVE + ("o3" ?ỏ) ; LATIN SMALL LETTER O WITH HOOK ABOVE + ("O3" ?Ỏ) ; LATIN CAPITAL LETTER O WITH HOOK ABOVE ("o61" ?ố) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE ("O61" ?Ố) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND ACUTE ("o62" ?ồ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE ("O62" ?Ồ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND GRAVE - ("o63" ?ổ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND HO6K ABOVE - ("O63" ?Ổ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HO6K ABOVE + ("o63" ?ổ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE + ("O63" ?Ổ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE ("o64" ?ỗ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE ("O64" ?Ỗ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND TILDE ("o65" ?ộ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELO7 @@ -179,22 +179,22 @@ and postfix: E66 -> E6, a55 -> a5, etc. ("O71" ?Ớ) ; LATIN CAPITAL LETTER O WITH HORN AND ACUTE ("o72" ?ờ) ; LATIN SMALL LETTER O WITH HORN AND GRAVE ("O72" ?Ờ) ; LATIN CAPITAL LETTER O WITH HORN AND GRAVE - ("o73" ?ở) ; LATIN SMALL LETTER O WITH HORN AND HO6K ABOVE - ("O73" ?Ở) ; LATIN CAPITAL LETTER O WITH HORN AND HO6K ABOVE + ("o73" ?ở) ; LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE + ("O73" ?Ở) ; LATIN CAPITAL LETTER O WITH HORN AND HOOK ABOVE ("o74" ?ỡ) ; LATIN SMALL LETTER O WITH HORN AND TILDE ("O74" ?Ỡ) ; LATIN CAPITAL LETTER O WITH HORN AND TILDE ("o75" ?ợ) ; LATIN SMALL LETTER O WITH HORN AND DOT BELO7 ("O75" ?Ợ) ; LATIN CAPITAL LETTER O WITH HORN AND DOT BELO7 ("u5" ?ụ) ; LATIN SMALL LETTER U WITH DOT BELO7 ("U5" ?Ụ) ; LATIN CAPITAL LETTER U WITH DOT BELO7 - ("u3" ?ủ) ; LATIN SMALL LETTER U WITH HO6K ABOVE - ("U3" ?Ủ) ; LATIN CAPITAL LETTER U WITH HO6K ABOVE + ("u3" ?ủ) ; LATIN SMALL LETTER U WITH HOOK ABOVE + ("U3" ?Ủ) ; LATIN CAPITAL LETTER U WITH HOOK ABOVE ("u71" ?ứ) ; LATIN SMALL LETTER U WITH HORN AND ACUTE ("U71" ?Ứ) ; LATIN CAPITAL LETTER U WITH HORN AND ACUTE ("u72" ?ừ) ; LATIN SMALL LETTER U WITH HORN AND GRAVE ("U72" ?Ừ) ; LATIN CAPITAL LETTER U WITH HORN AND GRAVE - ("u73" ?ử) ; LATIN SMALL LETTER U WITH HORN AND HO6K ABOVE - ("U73" ?Ử) ; LATIN CAPITAL LETTER U WITH HORN AND HO6K ABOVE + ("u73" ?ử) ; LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE + ("U73" ?Ử) ; LATIN CAPITAL LETTER U WITH HORN AND HOOK ABOVE ("u74" ?ữ) ; LATIN SMALL LETTER U WITH HORN AND TILDE ("U74" ?Ữ) ; LATIN CAPITAL LETTER U WITH HORN AND TILDE ("u75" ?ự) ; LATIN SMALL LETTER U WITH HORN AND DOT BELO7 @@ -203,20 +203,20 @@ and postfix: E66 -> E6, a55 -> a5, etc. ("Y2" ?Ỳ) ; LATIN CAPITAL LETTER Y WITH GRAVE ("y5" ?ỵ) ; LATIN SMALL LETTER Y WITH DOT BELO7 ("Y5" ?Ỵ) ; LATIN CAPITAL LETTER Y WITH DOT BELO7 - ("y3" ?ỷ) ; LATIN SMALL LETTER Y WITH HO6K ABOVE - ("Y3" ?Ỷ) ; LATIN CAPITAL LETTER Y WITH HO6K ABOVE + ("y3" ?ỷ) ; LATIN SMALL LETTER Y WITH HOOK ABOVE + ("Y3" ?Ỷ) ; LATIN CAPITAL LETTER Y WITH HOOK ABOVE ("y4" ?ỹ) ; LATIN SMALL LETTER Y WITH TILDE ("Y4" ?Ỹ) ; LATIN CAPITAL LETTER Y WITH TILDE ("d9" ?đ) ; LATIN SMALL LETTER D WITH STROKE ("D9" ?Đ) ; LATIN CAPITAL LETTER D WITH STROKE ;("$$" ?₫) ; U+20AB DONG SIGN (#### check) - ("a22" ["a22"]) + ("a22" ["a2"]) ("A22" ["A2"]) ("a11" ["a1"]) ("A11" ["A1"]) - ("a66"' ["a6"]) - ("A66"' ["A6"]) + ("a66" ["a6"]) + ("A66" ["A6"]) ("a44" ["a4"]) ("A44" ["A4"]) ("e22" ["e2"]) @@ -248,7 +248,7 @@ and postfix: E66 -> E6, a55 -> a5, etc. ("i44" ["i4"]) ("I44" ["I4"]) ("u44" ["u4"]) - ("U44" ["u4"]) + ("U44" ["U4"]) ("o77" ["o7"]) ("O77" ["O7"]) ("u77" ["u7"]) @@ -283,7 +283,7 @@ and postfix: E66 -> E6, a55 -> a5, etc. ("Y33" ["Y3"]) ("y44" ["y4"]) ("Y44" ["Y4"]) - ("d9" ["d9"]) + ("d99" ["d9"]) ("D99" ["D9"]) ;("$$$" ["$$"]) -- cgit v1.2.3 From 0567f3b817ba25c8e216347cc7118fa7786039d9 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 1 Mar 2024 09:16:38 +0100 Subject: * Fix compilation warning in 'cl--supertypes-for-typeof-types' * lisp/emacs-lisp/cl-preloaded.el (cl--supertypes-for-typeof-types): Fix warning. --- lisp/emacs-lisp/cl-preloaded.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index fb06b127676..30753bcd5c5 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -99,8 +99,7 @@ the symbols returned by `type-of', and SUPERTYPES is the list of its supertypes from the most specific to least specific.") (defun cl--supertypes-for-typeof-types (type) - (cl-loop with res = () - with agenda = (list type) + (cl-loop with agenda = (list type) while agenda for element = (car agenda) unless (or (eq element t) ;; no t in `cl--typeof-types'. -- cgit v1.2.3 From 4372a056fef90e5927d1a627fe0eb2bb01eb0dfb Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 1 Mar 2024 09:27:22 +0100 Subject: * doc/lispref/objects.texi (Type Hierarchy): Small improvements --- doc/lispref/objects.texi | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 01f82d56528..9a4c1473d75 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -2501,9 +2501,9 @@ regardless of whether this optimization is in use. @node Type Hierarchy Lisp types are organized in a hierarchy, this means that types can -derive from other types. Objects of a type A (which derives from type -B) inherite all the charateristics of type B. This also means that -every objects of type A is at the same time of type B. +derive from other types. Objects of a type B (which derives from type +A) inherite all the charateristics of type A. This also means that +every objects of type B is at the same time of type A. Every type derives from type @code{t}. @@ -2516,4 +2516,4 @@ follow: @image{type_hierarchy,,,,png} For example type @code{list} derives from (is a special kind of) type -@code{sequence} wich on itself derives from @code{t}. +@code{sequence} which on itself derives from @code{t}. -- cgit v1.2.3 From ae80192d97b8d0e54a9429091cd84190bdbeb49e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 1 Mar 2024 10:32:32 +0200 Subject: ; * src/buffer.c (Fmake_indirect_buffer): Doc fix. --- src/buffer.c | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/buffer.c b/src/buffer.c index 2d3e04f78cd..32a05010311 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -774,14 +774,20 @@ DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer, BASE-BUFFER should be a live buffer, or the name of an existing buffer. NAME should be a string which is not the name of an existing buffer. + +Interactively, prompt for BASE-BUFFER (offering the current buffer as +the default), and for NAME (offering as default the name of a recently +used buffer). + Optional argument CLONE non-nil means preserve BASE-BUFFER's state, such as major and minor modes, in the indirect buffer. - CLONE nil means the indirect buffer's state is reset to default values. If optional argument INHIBIT-BUFFER-HOOKS is non-nil, the new buffer does not run the hooks `kill-buffer-hook', -`kill-buffer-query-functions', and `buffer-list-update-hook'. */) +`kill-buffer-query-functions', and `buffer-list-update-hook'. + +Interactively, CLONE and INHIBIT-BUFFER-HOOKS are nil. */) (Lisp_Object base_buffer, Lisp_Object name, Lisp_Object clone, Lisp_Object inhibit_buffer_hooks) { -- cgit v1.2.3 From 31a4bec609578afd453caf232f78e275c3a075bc Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 1 Mar 2024 10:52:50 +0200 Subject: Fix documentation of last change * doc/lispref/objects.texi (Type Hierarchy): Fix wording and markup. * doc/lispref/elisp.texi (Top): Add new node to @detailmenu. --- doc/lispref/elisp.texi | 1 + doc/lispref/objects.texi | 19 +++++++++++-------- 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index ed254795d90..71139db4359 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -300,6 +300,7 @@ Lisp Data Types * Type Predicates:: Tests related to types. * Equality Predicates:: Tests of equality between any two objects. * Mutability:: Some objects should not be modified. +* Type Hierarchy:: Type Hierarchy of Emacs Lisp objects. Programming Types diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 9a4c1473d75..dd212ef700c 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -60,7 +60,7 @@ to use these types can be found in later chapters. * Type Predicates:: Tests related to types. * Equality Predicates:: Tests of equality between any two objects. * Mutability:: Some objects should not be modified. -* Type Hierarchy:: Type Hierarchy. +* Type Hierarchy:: Type Hierarchy of Emacs Lisp objects. @end menu @node Printed Representation @@ -2499,11 +2499,13 @@ instances. Lisp programs should be written so that they work regardless of whether this optimization is in use. @node Type Hierarchy +@section Type Hierarchy of Emacs Lisp Objects -Lisp types are organized in a hierarchy, this means that types can -derive from other types. Objects of a type B (which derives from type -A) inherite all the charateristics of type A. This also means that -every objects of type B is at the same time of type A. +Lisp object types are organized in a hierarchy, which means that types +can derive from other types. Objects of type B (which derives from type +A) inherit all the characteristics of type A@. This also means that +every object of type B is at the same time an object of type A from +which it derives. Every type derives from type @code{t}. @@ -2511,9 +2513,10 @@ New types can be defined by the user through @code{defclass} or @code{cl-defstruct}. The Lisp Type Hierarchy for primitive types can be represented as -follow: +follows: -@image{type_hierarchy,,,,png} +@noindent +@image{type_hierarchy,,,,.jpg} For example type @code{list} derives from (is a special kind of) type -@code{sequence} which on itself derives from @code{t}. +@code{sequence} which itself derives from @code{t}. -- cgit v1.2.3 From b2d18ff944ae374fa03579ca2574f1fba8ae2e4b Mon Sep 17 00:00:00 2001 From: Wilson Snyder Date: Fri, 1 Mar 2024 12:11:07 -0500 Subject: Verilog-mode update from upstream https://github.com/veripool/verilog-mode MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/progmodes/verilog-mode.el (verilog-auto-inst) (verilog-auto-inst-param): Remove intended formfeeds. Our ability to detect unintended formfeeds elsewhere outweighs their limited utility here. Contributed by Mattias Engdegård. (verilog-at-constraint-p) (verilog-at-struct-mv-p, verilog-at-struct-p, verilog-calc-1) (verilog-in-case-region-p, verilog-in-fork-region-p) (verilog-in-generate-region-p, verilog-set-auto-endcomments): Fix indentation problem when there is a signal named "module_something" (#1861). Cleanup RexEx groupings. (verilog-read-sub-decls-expr): Fix apostrophe parser in AUTOWIRE (#1854) (#1855). (verilog-auto-inst-port): Fix AUTOINST multi-dimensional array [] substitution. Reported by Caleb Begly. (verilog-property-re, verilog-beg-of-statement, verilog-calc-1): Concurrent SVA statement pattern-matching learns 'restrict property' and 'cover sequence' expression for proper indentation around those constructs. This addresses more patterns in IEEE 1800-2017's 'concurrent_sasertion_statement' grammar. (verilog-read-sub-decls-line): Fix `verilog-auto-ignore-concat' with parenthesis signals. Reported by Dmitri Sorkin. (verilog-simplify-range-expression): Fix `verilog-auto-inst-param-value' confusing structure selects. Reported by Mike Bertone. --- lisp/progmodes/verilog-mode.el | 114 +++++++++++++++++++++++++---------------- 1 file changed, 69 insertions(+), 45 deletions(-) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 6081372af33..7af78f2229a 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -9,7 +9,7 @@ ;; Keywords: languages ;; The "Version" is the date followed by the decimal rendition of the Git ;; commit hex. -;; Version: 2023.06.06.141322628 +;; Version: 2024.03.01.121933719 ;; Yoni Rabkin contacted the maintainer of this ;; file on 19/3/2008, and the maintainer agreed that when a bug is @@ -124,7 +124,7 @@ ;; ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2023-06-06-86c6984-vpo-GNU" +(defconst verilog-mode-version "2024-03-01-7448f97-vpo-GNU" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -2556,11 +2556,13 @@ find the errors." (defconst verilog-assignment-operation-re-2 (concat "\\(.*?\\)" verilog-assignment-operator-re)) +;; Loosely related to IEEE 1800's concurrent_assertion_statement +(defconst verilog-concurrent-assertion-statement-re + "\\(\\<\\(assert\\|assume\\|cover\\|restrict\\)\\>\\s-+\\<\\(property\\|sequence\\)\\>\\)\\|\\(\\\\)") + (defconst verilog-label-re (concat verilog-identifier-sym-re "\\s-*:\\s-*")) (defconst verilog-property-re - (concat "\\(" verilog-label-re "\\)?" - ;; "\\(assert\\|assume\\|cover\\)\\s-+property\\>" - "\\(\\(assert\\|assume\\|cover\\)\\>\\s-+\\\\)\\|\\(assert\\)")) + (concat "\\(" verilog-label-re "\\)?" verilog-concurrent-assertion-statement-re)) (defconst verilog-no-indent-begin-re (eval-when-compile @@ -2715,7 +2717,6 @@ find the errors." "\\(\\\\)\\|" ; 7 "\\(\\\\)\\|" verilog-property-re "\\|" - "\\(\\(" verilog-label-re "\\)?\\\\)\\|" "\\(\\\\)\\|" "\\(\\\\)\\|" "\\(\\\\)\\|" @@ -4843,7 +4844,7 @@ Uses `verilog-scan' cache." (not (or (looking-at "\\<") (forward-word-strictly -1))) ;; stop if we see an assertion (perhaps labeled) (and - (looking-at "\\(\\w+\\W*:\\W*\\)?\\(\\<\\(assert\\|assume\\|cover\\)\\>\\s-+\\\\)\\|\\(\\\\)") + (looking-at (concat "\\(\\w+\\W*:\\W*\\)?" verilog-concurrent-assertion-statement-re)) (progn (setq h (point)) (save-excursion @@ -4970,7 +4971,7 @@ More specifically, point @ in the line foo : @ begin" (while t (verilog-re-search-backward (concat "\\(\\\\)\\|\\(\\\\)\\|\\(\\\\|\\[^:]\\)\\|" - "\\(\\\\)\\>") + "\\(\\\\)") nil 'move) (cond ((match-end 4) @@ -5010,7 +5011,7 @@ More specifically, after a generate and before an endgenerate." (while (and (/= nest 0) (verilog-re-search-backward - "\\<\\(module\\)\\|\\(connectmodule\\)\\|\\(endmodule\\)\\|\\(generate\\)\\|\\(endgenerate\\)\\|\\(if\\)\\|\\(case\\)\\|\\(for\\)\\>" nil 'move) + "\\<\\(?:\\(module\\)\\|\\(connectmodule\\)\\|\\(endmodule\\)\\|\\(generate\\)\\|\\(endgenerate\\)\\|\\(if\\)\\|\\(case\\)\\|\\(for\\)\\)\\>" nil 'move) (cond ((match-end 1) ; module - we have crawled out (throw 'done 1)) @@ -5038,7 +5039,7 @@ More specifically, after a generate and before an endgenerate." (save-excursion (while (and (/= nest 0) - (verilog-re-search-backward "\\<\\(fork\\)\\|\\(join\\(_any\\|_none\\)?\\)\\>" lim 'move) + (verilog-re-search-backward "\\<\\(?:\\(fork\\)\\|\\(join\\(_any\\|_none\\)?\\)\\)\\>" lim 'move) (cond ((match-end 1) ; fork (setq nest (1- nest))) @@ -5335,7 +5336,7 @@ primitive or interface named NAME." (match-end 3) (goto-char there) (let ((nest 0) - (reg "\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)\\|\\(assert\\)")) + (reg "\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)")) (catch 'skip (while (verilog-re-search-backward reg nil 'move) (cond @@ -6244,7 +6245,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (match-end 22)) (throw 'continue 'foo)) - ((looking-at "\\") + ((looking-at "\\<\\(?:class\\|struct\\|function\\|task\\)\\>") ;; *sigh* These words have an optional prefix: ;; extern {virtual|protected}? function a(); ;; and we don't want to confuse this with @@ -6268,12 +6269,16 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (throw 'nesting 'defun)))) ;; - ((looking-at "\\") + ((looking-at "\\<\\(property\\|sequence\\)\\>") ;; *sigh* - ;; {assert|assume|cover} property (); are complete - ;; and could also be labeled: - foo: assert property - ;; but - ;; property ID () ... needs endproperty + ;; - {assert|assume|cover|restrict} property (); are complete + ;; - cover sequence (); is complete + ;; and could also be labeled: + ;; - foo: assert property + ;; - bar: cover sequence + ;; but: + ;; - property ID () ... needs endproperty + ;; - sequence ID () ... needs endsequence (verilog-beg-of-statement) (if (looking-at verilog-property-re) (throw 'continue 'statement) ; We don't need an endproperty for these @@ -6940,7 +6945,7 @@ Also move point to constraint." (let ( (pt (point)) (pass 0)) (verilog-backward-ws&directives) (verilog-backward-token) - (if (looking-at (concat "\\\\|" verilog-in-constraint-re)) + (if (looking-at (concat "\\<\\(?:constraint\\|coverpoint\\|cross\\|with\\)\\>\\|" verilog-in-constraint-re)) (progn (setq pass 1) (if (looking-at "\\") (progn (verilog-backward-ws&directives) @@ -6981,7 +6986,7 @@ Also move point to constraint." (save-excursion (if (and (equal (char-after) ?\{) (verilog-backward-token)) - (looking-at "\\") + (looking-at "\\<\\(?:struct\\|union\\|packed\\|\\(un\\)?signed\\)\\>") nil))) (defun verilog-at-struct-mv-p () @@ -6989,7 +6994,7 @@ Also move point to constraint." (let ((pt (point))) (if (and (equal (char-after) ?\{) (verilog-backward-token)) - (if (looking-at "\\") + (if (looking-at "\\<\\(?:struct\\|union\\|packed\\|\\(un\\)?signed\\)\\>") (progn (verilog-beg-of-statement) (point)) (progn (goto-char pt) nil)) (progn (goto-char pt) nil)))) @@ -9675,7 +9680,7 @@ Return an array of [outputs inouts inputs wire reg assign const gparam intf]." (cond ;; {..., a, b} requires us to recurse on a,b ;; To support {#{},{#{a,b}} we'll just split everything on [{},] - ((string-match "^\\s-*{\\(.*\\)}\\s-*$" expr) + ((string-match "^\\s-*'?{\\(.*\\)}\\s-*$" expr) (let ((mlst (split-string (match-string 1 expr) "[{},]")) mstr) (while (setq mstr (pop mlst)) @@ -9755,7 +9760,10 @@ Inserts the list of signals found, using submodi to look up each port." ;; We intentionally ignore (non-escaped) signals with .s in them ;; this prevents AUTOWIRE etc from noticing hierarchical sigs. (when port - (cond ((looking-at "[^\n]*AUTONOHOOKUP")) + (cond ((and verilog-auto-ignore-concat + (looking-at "[({]")) + nil) ; {...} or (...) historically ignored with auto-ignore-concat + ((looking-at "[^\n]*AUTONOHOOKUP")) ((looking-at "\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\s-*)") (verilog-read-sub-decls-sig submoddecls par-values comment port @@ -11436,7 +11444,7 @@ This repairs those mis-inserted by an AUTOARG." (while (string-match (concat "\\([[({:*/<>+-]\\)" ; - must be last "(\\<\\([0-9A-Za-z_]+\\))" - "\\([])}:*/<>+-]\\)") + "\\([])}:*/<>.+-]\\)") out) (setq out (replace-match "\\1\\2\\3" nil nil out))) (while (string-match @@ -11531,7 +11539,8 @@ This repairs those mis-inserted by an AUTOARG." ;;(verilog-simplify-range-expression "[(TEST[1])-1:0]") ;;(verilog-simplify-range-expression "[1<<2:8>>2]") ; [4:2] ;;(verilog-simplify-range-expression "[2*4/(4-2) +2+4 <<4 >>2]") -;;(verilog-simplify-range-expression "[WIDTH*2/8-1:0]") +;;(verilog-simplify-range-expression "[WIDTH*2/8-1:0]") ; "[WIDTH*2/8-1:0]" +;;(verilog-simplify-range-expression "[(FOO).size:0]") ; "[FOO.size:0]" (defun verilog-clog2 (value) "Compute $clog2 - ceiling log2 of VALUE." @@ -12247,18 +12256,12 @@ If PAR-VALUES replace final strings with these parameter values." (vl-memory (verilog-sig-memory port-st)) (vl-mbits (if (verilog-sig-multidim port-st) (verilog-sig-multidim-string port-st) "")) - (vl-bits (if (or (eq verilog-auto-inst-vector t) - (and (eq verilog-auto-inst-vector `unsigned) - (not (verilog-sig-signed port-st))) - (not (assoc port (verilog-decls-get-signals moddecls))) - (not (equal (verilog-sig-bits port-st) - (verilog-sig-bits - (assoc port (verilog-decls-get-signals moddecls)))))) - (or (verilog-sig-bits port-st) "") - "")) + (vl-bits (or (verilog-sig-bits port-st) "")) (case-fold-search nil) (check-values par-values) - tpl-net dflt-bits) + auto-inst-vector + auto-inst-vector-tpl + tpl-net dflt-bits) ;; Replace parameters in bit-width (when (and check-values (not (equal vl-bits ""))) @@ -12281,6 +12284,16 @@ If PAR-VALUES replace final strings with these parameter values." vl-mbits (verilog-simplify-range-expression vl-mbits) vl-memory (when vl-memory (verilog-simplify-range-expression vl-memory)) vl-width (verilog-make-width-expression vl-bits))) ; Not in the loop for speed + (setq auto-inst-vector + (if (or (eq verilog-auto-inst-vector t) + (and (eq verilog-auto-inst-vector `unsigned) + (not (verilog-sig-signed port-st))) + (not (assoc port (verilog-decls-get-signals moddecls))) + (not (equal (verilog-sig-bits port-st) + (verilog-sig-bits + (assoc port (verilog-decls-get-signals moddecls)))))) + vl-bits + "")) ;; Default net value if not found (setq dflt-bits (if (or (and (verilog-sig-bits port-st) (verilog-sig-multidim port-st)) @@ -12290,7 +12303,7 @@ If PAR-VALUES replace final strings with these parameter values." (if vl-memory "." "") (if vl-memory vl-memory "") "*/") - (concat vl-bits)) + (concat auto-inst-vector)) tpl-net (concat port (if (and vl-modport ;; .modport cannot be added if attachment is @@ -12329,10 +12342,21 @@ If PAR-VALUES replace final strings with these parameter values." (if (numberp value) (setq value (number-to-string value))) value)) (substring tpl-net (match-end 0)))))) + ;; Get range based off template net + (setq auto-inst-vector-tpl + (if (or (eq verilog-auto-inst-vector t) + (and (eq verilog-auto-inst-vector `unsigned) + (not (verilog-sig-signed port-st))) + (not (assoc tpl-net (verilog-decls-get-signals moddecls))) + (not (equal (verilog-sig-bits port-st) + (verilog-sig-bits + (assoc tpl-net (verilog-decls-get-signals moddecls)))))) + vl-bits + "")) ;; Replace @ and [] magic variables in final output (setq tpl-net (verilog-string-replace-matches "@" tpl-num nil nil tpl-net)) (setq tpl-net (verilog-string-replace-matches "\\[\\]\\[\\]" dflt-bits nil nil tpl-net)) - (setq tpl-net (verilog-string-replace-matches "\\[\\]" vl-bits nil nil tpl-net))) + (setq tpl-net (verilog-string-replace-matches "\\[\\]" auto-inst-vector-tpl nil nil tpl-net))) ;; Insert it (when (or tpl-ass (not verilog-auto-inst-template-required)) (verilog--auto-inst-first indent-pt section) @@ -12502,7 +12526,7 @@ Typing \\[verilog-auto] will make this into: endmodule Where the list of inputs and outputs came from the inst module. - + Exceptions: Unless you are instantiating a module multiple times, or the module is @@ -12527,7 +12551,7 @@ Exceptions: // Outputs .o (o[31:0])); - + Templates: For multiple instantiations based upon a single template, create a @@ -12598,7 +12622,7 @@ Templates: .ptl_bus (ptl_busnew[3:0]), .... - + Multiple Module Templates: The same template lines can be applied to multiple modules with @@ -12613,7 +12637,7 @@ Multiple Module Templates: */ Note there is only one AUTO_TEMPLATE opening parenthesis. - + @ Templates: It is common to instantiate a cell multiple times, so templates make it @@ -12678,7 +12702,7 @@ Multiple Module Templates: .ptl_mapvalidx (BAR_ptl_mapvalid), .ptl_mapvalidp1x (ptl_mapvalid_BAR)); - + Regexp Templates: A template entry of the form @@ -12702,7 +12726,7 @@ Regexp Templates: subscript: .\\(.*\\)_l (\\1_[]), - + Lisp Templates: First any regular expression template is expanded. @@ -12747,7 +12771,7 @@ Lisp Templates: After the evaluation is completed, @ substitution and [] substitution occur. - + Ignoring Hookup: AUTOWIRE and related AUTOs will read the signals created by a template. @@ -12756,7 +12780,7 @@ Ignoring Hookup: .pci_req_l (pci_req_not_to_wire), //AUTONOHOOKUP - + For more information see the \\[verilog-faq] and forums at URL `https://www.veripool.org'." (save-excursion @@ -12910,7 +12934,7 @@ Typing \\[verilog-auto] will make this into: endmodule Where the list of parameter connections come from the inst module. - + Templates: You can customize the parameter connections using AUTO_TEMPLATEs, -- cgit v1.2.3 From 8b96503b6e8514f1f9f92895a0707c78b1bbd1fd Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 1 Mar 2024 18:56:02 +0100 Subject: * lisp/emacs-lisp/cl-preloaded.el (cl--typeof-types): Define as var. --- lisp/emacs-lisp/cl-preloaded.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 30753bcd5c5..b2b921192ff 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -92,7 +92,7 @@ Each sublist is in the form (TYPE . DIRECT_SUBTYPES)" for child in children do (cl-pushnew parent (gethash child cl--direct-supertypes-of-type)))) -(defconst cl--typeof-types nil +(defvar cl--typeof-types nil "Alist of supertypes. Each element has the form (TYPE . SUPERTYPES) where TYPE is one of the symbols returned by `type-of', and SUPERTYPES is the list of its -- cgit v1.2.3 From 5e20b114ef32d504f4429fd35ecd0d5dcf3bd8db Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 2 Mar 2024 14:04:56 +0800 Subject: Implement dead key combination on Android * src/android.c (android_init_key_character_map) (android_get_dead_char): New functions. (android_wc_lookup_string): New argument COMPOSE_STATE. Ignore key events with the COMBINING_ACCENT flag set while recording their character values there, and combine such characters with the key event when processing a subsequent key event. * src/androidgui.h (struct android_compose_status): New structure. * src/androidterm.c (handle_one_android_event): Port dead key combination code from X. (bug#69321) --- src/android.c | 122 ++++++++++++++++++++++++++++++++++++++++++++++++++++-- src/androidgui.h | 12 +++++- src/androidterm.c | 19 ++++++++- 3 files changed, 148 insertions(+), 5 deletions(-) diff --git a/src/android.c b/src/android.c index 41481afa475..eb6981093be 100644 --- a/src/android.c +++ b/src/android.c @@ -123,6 +123,12 @@ struct android_emacs_cursor jmethodID constructor; }; +struct android_key_character_map +{ + jclass class; + jmethodID get_dead_char; +}; + /* The API level of the current device. */ static int android_api_level; @@ -203,6 +209,9 @@ static struct android_emacs_window window_class; /* Various methods associated with the EmacsCursor class. */ static struct android_emacs_cursor cursor_class; +/* Various methods associated with the KeyCharacterMap class. */ +static struct android_key_character_map key_character_map_class; + /* The time at which Emacs was installed, which also supplies the mtime of asset files. */ struct timespec emacs_installation_time; @@ -1865,6 +1874,32 @@ android_init_emacs_cursor (void) #undef FIND_METHOD } +static void +android_init_key_character_map (void) +{ + jclass old; + + key_character_map_class.class + = (*android_java_env)->FindClass (android_java_env, + "android/view/KeyCharacterMap"); + eassert (key_character_map_class.class); + + old = key_character_map_class.class; + key_character_map_class.class + = (jclass) (*android_java_env)->NewGlobalRef (android_java_env, + (jobject) old); + ANDROID_DELETE_LOCAL_REF (old); + + if (!key_character_map_class.class) + emacs_abort (); + + key_character_map_class.get_dead_char + = (*android_java_env)->GetStaticMethodID (android_java_env, + key_character_map_class.class, + "getDeadChar", "(II)I"); + eassert (key_character_map_class.get_dead_char); +} + JNIEXPORT void JNICALL NATIVE_NAME (initEmacs) (JNIEnv *env, jobject object, jarray argv, jobject dump_file_object) @@ -1913,6 +1948,7 @@ NATIVE_NAME (initEmacs) (JNIEnv *env, jobject object, jarray argv, android_init_emacs_drawable (); android_init_emacs_window (); android_init_emacs_cursor (); + android_init_key_character_map (); /* Set HOME to the app data directory. */ setenv ("HOME", android_files_dir, 1); @@ -5376,11 +5412,51 @@ android_translate_coordinates (android_window src, int x, ANDROID_DELETE_LOCAL_REF (coordinates); } +/* Return the character produced by combining the diacritic character + DCHAR with the key-producing character C in *VALUE. Value is 1 if + there is no character for this combination, 0 otherwise. */ + +static int +android_get_dead_char (unsigned int dchar, unsigned int c, + unsigned int *value) +{ + jmethodID method; + jclass class; + jint result; + + /* Call getDeadChar. */ + class = key_character_map_class.class; + method = key_character_map_class.get_dead_char; + result = (*android_java_env)->CallStaticIntMethod (android_java_env, + class, method, + (jint) dchar, + (jint) c); + + if (result) + { + *value = result; + return 0; + } + + return 1; +} + +/* Return a Unicode string in BUFFER_RETURN, a buffer of size + WCHARS_BUFFER, from the key press event EVENT, much like + XmbLookupString. If EVENT represents a key press without a + corresponding Unicode character, return its keysym in *KEYSYM_RETURN. + Return the action taken in *STATUS_RETURN. + + COMPOSE_STATUS, if non-NULL, should point to a structure for + temporary information to be stored in during dead key + composition. */ + int android_wc_lookup_string (android_key_pressed_event *event, wchar_t *buffer_return, int wchars_buffer, int *keysym_return, - enum android_lookup_status *status_return) + enum android_lookup_status *status_return, + struct android_compose_status *compose_status) { enum android_lookup_status status; int rc; @@ -5389,6 +5465,7 @@ android_wc_lookup_string (android_key_pressed_event *event, jsize size; size_t i; JNIEnv *env; + unsigned int unicode_char; env = android_java_env; status = ANDROID_LOOKUP_NONE; @@ -5402,6 +5479,13 @@ android_wc_lookup_string (android_key_pressed_event *event, { if (event->unicode_char) { + /* KeyCharacterMap.COMBINING_ACCENT. */ + if ((event->unicode_char & 0x80000000) && compose_status) + goto dead_key; + + /* Remove combining accent bits. */ + unicode_char = event->unicode_char & ~0x80000000; + if (wchars_buffer < 1) { *status_return = ANDROID_BUFFER_OVERFLOW; @@ -5409,7 +5493,31 @@ android_wc_lookup_string (android_key_pressed_event *event, } else { - buffer_return[0] = event->unicode_char; + /* If COMPOSE_STATUS holds a diacritic mark unicode_char + ought to be combined with, and this combination is + valid, return the result alone with no keysym. */ + + if (compose_status + && compose_status->chars_matched + && !android_get_dead_char (compose_status->accent, + unicode_char, + &unicode_char)) + { + buffer_return[0] = unicode_char; + *status_return = ANDROID_LOOKUP_CHARS; + compose_status->chars_matched = 0; + return 1; + } + else if (compose_status && compose_status->chars_matched) + { + /* If the combination is valid the compose status must + be reset and no character returned. */ + compose_status->chars_matched = 0; + status = ANDROID_LOOKUP_NONE; + return 0; + } + + buffer_return[0] = unicode_char; status = ANDROID_LOOKUP_CHARS; rc = 1; } @@ -5426,7 +5534,6 @@ android_wc_lookup_string (android_key_pressed_event *event, } *status_return = status; - return rc; } @@ -5482,6 +5589,15 @@ android_wc_lookup_string (android_key_pressed_event *event, *status_return = status; return rc; + + dead_key: + /* event->unicode_char is a dead key, which are diacritic marks that + should not be directly inserted but instead be combined with a + subsequent character before insertion. */ + *status_return = ANDROID_LOOKUP_NONE; + compose_status->chars_matched = 1; + compose_status->accent = event->unicode_char & ~0x80000000; + return 0; } diff --git a/src/androidgui.h b/src/androidgui.h index 89317581191..73b60c483d3 100644 --- a/src/androidgui.h +++ b/src/androidgui.h @@ -612,6 +612,15 @@ struct android_window_changes enum android_stack_mode stack_mode; }; +struct android_compose_status +{ + /* Accent character to be combined with another. */ + unsigned int accent; + + /* Number of characters matched. */ + int chars_matched; +}; + extern int android_pending (void); extern void android_next_event (union android_event *); extern bool android_check_if_event (union android_event *, @@ -707,7 +716,8 @@ extern void android_translate_coordinates (android_window, int, int, int *, int *); extern int android_wc_lookup_string (android_key_pressed_event *, wchar_t *, int, int *, - enum android_lookup_status *); + enum android_lookup_status *, + struct android_compose_status *); extern void android_recreate_activity (android_window); extern void android_update_ic (android_window, ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t); diff --git a/src/androidterm.c b/src/androidterm.c index 2bd2b45743d..baf26abe322 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -811,6 +811,7 @@ handle_one_android_event (struct android_display_info *dpyinfo, int keysym; ptrdiff_t nchars, i; struct window *w; + static struct android_compose_status compose_status; /* It is okay for this to not resemble handle_one_xevent so much. Differences in event handling code are much less nasty than @@ -947,6 +948,14 @@ handle_one_android_event (struct android_display_info *dpyinfo, extra_keyboard_modifiers); modifiers = event->xkey.state; + /* In case Meta is ComposeCharacter, clear its status. According + to Markus Ehrnsperger + Markus.Ehrnsperger@lehrstuhl-bross.physik.uni-muenchen.de this + enables ComposeCharacter to work whether or not it is combined + with Meta. */ + if (modifiers & ANDROID_ALT_MASK) + memset (&compose_status, 0, sizeof (compose_status)); + /* Common for all keysym input events. */ XSETFRAME (inev.ie.frame_or_window, any); inev.ie.modifiers @@ -960,7 +969,8 @@ handle_one_android_event (struct android_display_info *dpyinfo, nchars = android_wc_lookup_string (&event->xkey, copy_bufptr, copy_bufsiz, &keysym, - &status_return); + &status_return, + &compose_status); /* android_lookup_string can't be called twice, so there's no way to recover from buffer overflow. */ @@ -1000,6 +1010,13 @@ handle_one_android_event (struct android_display_info *dpyinfo, } } + /* If a compose sequence is in progress, we break here. + Otherwise, chars_matched is always 0. */ + if (compose_status.chars_matched > 0 && nchars == 0) + break; + + memset (&compose_status, 0, sizeof (compose_status)); + if (nchars == 1 && copy_bufptr[0] >= 32) { /* Deal with characters. */ -- cgit v1.2.3 From f89cb6b63612a3dce113fa454fece82953fb5d5c Mon Sep 17 00:00:00 2001 From: Kazuhiro Ito Date: Sat, 2 Mar 2024 08:44:56 +0900 Subject: Fix Japanese language environment on Cygwin and MS-Windows * lisp/language/japan-util.el (setup-japanese-environment-internal): Prefer UTF-8 for Cygwin and other Posix hosts; prefer Codepage 932 on DOS/Windows. (Bug#69493) --- lisp/language/japan-util.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el index 93e8ab24971..b058eab7029 100644 --- a/lisp/language/japan-util.el +++ b/lisp/language/japan-util.el @@ -29,8 +29,8 @@ ;;;###autoload (defun setup-japanese-environment-internal () - (prefer-coding-system (if (memq system-type '(windows-nt ms-dos cygwin)) - 'japanese-shift-jis + (prefer-coding-system (if (memq system-type '(windows-nt ms-dos)) + 'japanese-cp932 'utf-8)) (use-cjk-char-width-table 'ja_JP)) -- cgit v1.2.3 From e581c111165c4d138b72b6493717ed22fcb68a8e Mon Sep 17 00:00:00 2001 From: Kazuhiro Ito Date: Sat, 2 Mar 2024 08:49:15 +0900 Subject: * lisp/language/japanese.el (map): Fix typo (bug#69494). --- lisp/language/japanese.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/language/japanese.el b/lisp/language/japanese.el index dd65409c839..8957d1a49af 100644 --- a/lisp/language/japanese.el +++ b/lisp/language/japanese.el @@ -79,7 +79,7 @@ (#x00A2 . #xFFE0) ; CENT SIGN FULLWIDTH CENT SIGN (#x00A3 . #xFFE1) ; POUND SIGN FULLWIDTH POUND SIGN (#x00AC . #xFFE2) ; NOT SIGN FULLWIDTH NOT SIGN - (#x00A6 . #xFFE4) ; BROKEN LINE FULLWIDTH BROKEN LINE + (#x00A6 . #xFFE4) ; BROKEN BAR FULLWIDTH BROKEN BAR ))) (define-translation-table 'japanese-ucs-jis-to-cp932-map map) (setq map (mapcar (lambda (x) (cons (cdr x) (car x))) map)) -- cgit v1.2.3 From c3dc64a1071acc1f622094f91d8f046afedb7b45 Mon Sep 17 00:00:00 2001 From: Yoshiku Onu Date: Thu, 29 Feb 2024 13:29:44 +0500 Subject: Add new input method "english-colemak" * lisp/leim/quail/latin-post.el ("english-colemak"): New input method. (Bug#69471) * etc/NEWS: Announce it. Copyright-paperwork-exempt: yes --- etc/NEWS | 4 ++++ lisp/leim/quail/latin-post.el | 50 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 54 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index df07b2a9d79..792e178c3b6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -432,6 +432,10 @@ functions in CJK locales. *** New input methods for the Urdu, Pashto, and Sindhi languages. These languages are spoken in Pakistan and Afghanistan. +--- +*** New input method "english-colemak". +This input method supports the Colemak keyboard layout. + *** Additional 'C-x 8' key translations for "æ" and "Æ". These characters can now be input with 'C-x 8 a e' and 'C-x 8 A E', respectively, in addition to the existing translations 'C-x 8 / e' and diff --git a/lisp/leim/quail/latin-post.el b/lisp/leim/quail/latin-post.el index 0d2c1888426..25e7c4a64a8 100644 --- a/lisp/leim/quail/latin-post.el +++ b/lisp/leim/quail/latin-post.el @@ -1616,6 +1616,7 @@ Doubling the postfix separates the letter and postfix: e.g. a^^ -> a^ ;; Italian (itln) ;; Spanish (spnsh) ;; Dvorak (dvorak) +;; Colemak (colemak) ;; ;;; 92.12.15 created for Mule Ver.0.9.6 by Takahashi N. ;;; 92.12.29 modified by Takahashi N. @@ -2224,6 +2225,55 @@ Dead accent is right to æ." nil t t t t nil nil nil nil nil t) ("?" ?Z) ) +;; +(quail-define-package + "english-colemak" "English" "CM@" t + "English (ASCII) input method simulating Colemak keyboard" + nil t t t t nil nil nil nil nil t) + +;; 1! 2@ 3# 4$ 5% 6^ 7& 8* 9( 0) -_ =+ `~ +;; qQ wW fF pP gG jJ lL uU yY ;: [{ ]} +;; aA rR sS tT dD hH nN eE iI oO '" \| +;; zZ xX cC vV bB kK mM ,< .> /? + +(quail-define-rules + ("e" ?f) + ("r" ?p) + ("t" ?g) + ("y" ?j) + ("u" ?l) + ("i" ?u) + ("o" ?y) + ("p" ?\;) + ("s" ?r) + ("d" ?s) + ("f" ?t) + ("g" ?d) + ("j" ?n) + ("k" ?e) + ("l" ?i) + (";" ?o) + ("n" ?k) + + ("E" ?F) + ("R" ?P) + ("T" ?G) + ("Y" ?J) + ("U" ?L) + ("I" ?U) + ("O" ?Y) + ("P" ?\:) + ("S" ?R) + ("D" ?S) + ("F" ?T) + ("G" ?D) + ("J" ?N) + ("K" ?E) + ("L" ?I) + (":" ?O) + ("N" ?K) + ) + (quail-define-package "latin-postfix" "Latin" "L<" t "Latin character input method with postfix modifiers. -- cgit v1.2.3 From 51b560b45b0653e126d17cfe278aa46e6604c867 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 2 Mar 2024 19:12:29 +0200 Subject: * doc/lispref/modes.texi (Tabulated List Mode): Unindent example. --- doc/lispref/modes.texi | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 8bdf596bf9e..a2e8f42cf1d 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1265,9 +1265,9 @@ from @code{tabulated-list-entries}. For example: @smallexample @group - (setq tabulated-list-groups - (seq-group-by 'Buffer-menu-group-by-mode - tabulated-list-entries)) +(setq tabulated-list-groups + (seq-group-by 'Buffer-menu-group-by-mode + tabulated-list-entries)) @end group @end smallexample -- cgit v1.2.3 From 7b4c4e68464272cc7941cb53b4421cf0e3d3c3cd Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 2 Mar 2024 19:15:14 +0200 Subject: * lisp/buff-menu.el (Buffer-menu-marked-buffers): Add save-excursion. --- lisp/buff-menu.el | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index ca417290018..ec5337e3fda 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -556,15 +556,16 @@ in the selected frame, and will remove any marks." (defun Buffer-menu-marked-buffers (&optional unmark) "Return the list of buffers marked with `Buffer-menu-mark'. If UNMARK is non-nil, unmark them." - (let (buffers) - (Buffer-menu-beginning) - (while (re-search-forward "^>" nil t) - (let ((buffer (Buffer-menu-buffer))) - (if (and buffer unmark) - (tabulated-list-set-col 0 " " t)) - (if (buffer-live-p buffer) - (push buffer buffers)))) - (nreverse buffers))) + (save-excursion + (let (buffers) + (Buffer-menu-beginning) + (while (re-search-forward "^>" nil t) + (let ((buffer (Buffer-menu-buffer))) + (if (and buffer unmark) + (tabulated-list-set-col 0 " " t)) + (if (buffer-live-p buffer) + (push buffer buffers)))) + (nreverse buffers)))) (defun Buffer-menu-isearch-buffers () "Search for a string through all marked buffers using Isearch." -- cgit v1.2.3 From ebab7276139888266ae0f27bd3b2874e2ed8c077 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 2 Mar 2024 19:22:30 +0200 Subject: * lisp/replace.el (perform-replace): Accept default bindings in lookup-key. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Set ACCEPT-DEFAULT arg of lookup-key to t (bug#69342). This will allow the users to ignore unbound keys with ‘(define-key query-replace-map [t] 'ignore)’. --- lisp/replace.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/replace.el b/lisp/replace.el index fa460a16063..49e7c85c487 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2916,7 +2916,7 @@ characters." ;; If last typed key in previous call of multi-buffer perform-replace ;; was `automatic-all', don't ask more questions in next files - (when (eq (lookup-key map (vector last-input-event)) 'automatic-all) + (when (eq (lookup-key map (vector last-input-event) t) 'automatic-all) (setq query-flag nil multi-buffer t)) (cond @@ -3100,7 +3100,7 @@ characters." ;; read-event that clobbers the match data. (set-match-data real-match-data) (setq key (vector key)) - (setq def (lookup-key map key)) + (setq def (lookup-key map key t)) ;; Restore the match data while we process the command. (cond ((eq def 'help) (let ((display-buffer-overriding-action -- cgit v1.2.3 From 5f543fb4b2f24639c7a6215991b14fca24daf194 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 2 Mar 2024 19:31:07 +0200 Subject: * lisp/net/dictionary.el: Better handling of messages and errors. (dictionary-do-search, dictionary-do-matching): Insert formatted messages to the top of the output buffer instead of displaying transient messages in the echo area (bug#69312). (dictionary-do-matching, dictionary-lookup-definition) (dictionary-popup-matching-words): Use 'user-error' instead of 'error' for non-technical errors. --- lisp/net/dictionary.el | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 1981b757017..e8ac9b679a0 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -787,7 +787,7 @@ FUNCTION is the callback which is called for each search result." Optional argument NOMATCHING controls whether to suppress the display of matching words." - (message "Searching for %s in %s" word dictionary) + (insert (format-message "Searching for `%s' in `%s'\n" word dictionary)) (dictionary-send-command (concat "define " (dictionary-encode-charset dictionary "") " \"" @@ -799,13 +799,13 @@ of matching words." (if (dictionary-check-reply reply 552) (progn (unless nomatching - (insert "Word not found") + (insert (format-message "Word `%s' not found\n" word)) (dictionary-do-matching word dictionary "." (lambda (reply) - (insert ", maybe you are looking for one of these words\n\n") + (insert "Maybe you are looking for one of these words\n") (dictionary-display-only-match-result reply))) (dictionary-post-buffer))) (if (dictionary-check-reply reply 550) @@ -1128,8 +1128,8 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (defun dictionary-do-matching (word dictionary strategy function) "Search for WORD with STRATEGY in DICTIONARY and display them with FUNCTION." - (message "Lookup matching words for %s in %s using %s" - word dictionary strategy) + (insert (format-message "Lookup matching words for `%s' in `%s' using `%s'\n" + word dictionary strategy)) (dictionary-send-command (concat "match " (dictionary-encode-charset dictionary "") " " (dictionary-encode-charset strategy "") " \"" @@ -1141,10 +1141,13 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (if (dictionary-check-reply reply 551) (error "Strategy \"%s\" is invalid" strategy)) (if (dictionary-check-reply reply 552) - (error (concat - "No match for \"%s\" with strategy \"%s\" in " - "dictionary \"%s\".") - word strategy dictionary)) + (let ((errmsg (format-message + (concat + "No match for `%s' with strategy `%s' in " + "dictionary `%s'.") + word strategy dictionary))) + (insert errmsg "\n") + (user-error errmsg))) (unless (dictionary-check-reply reply 152) (error "Unknown server answer: %s" (dictionary-reply reply))) (funcall function reply))) @@ -1271,7 +1274,7 @@ prompt for DICTIONARY." (interactive) (let ((word (current-word))) (unless word - (error "No word at point")) + (user-error "No word at point")) (dictionary-new-search (cons word dictionary-default-dictionary)))) (defun dictionary-previous () @@ -1311,7 +1314,8 @@ prompt for DICTIONARY." (defun dictionary-popup-matching-words (&optional word) "Display entries matching WORD or the current word if not given." (interactive) - (dictionary-do-matching (or word (current-word) (error "Nothing to search for")) + (dictionary-do-matching (or word (current-word) + (user-error "Nothing to search for")) dictionary-default-dictionary dictionary-default-popup-strategy 'dictionary-process-popup-replies)) -- cgit v1.2.3 From 7f8717c6fd3e19b41048ce9a391d59540886cdee Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sat, 2 Mar 2024 18:07:36 -0800 Subject: Use funcall on function values in gnus-agent.el See bug#68931 * lisp/gnus/gnus-agent.el (gnus-category-make-function-1): Don't just pass function values in to be byte compiled, wrap them in funcall first. --- lisp/gnus/gnus-agent.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 1726b806913..0928b179787 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -2920,8 +2920,9 @@ The following commands are available: ;; Functions are just returned as is. ((or (symbolp predicate) (functionp predicate)) - `(,(or (cdr (assq predicate gnus-category-predicate-alist)) - predicate))) + (let ((fun (or (cdr (assq predicate gnus-category-predicate-alist)) + predicate))) + (if (symbolp fun) `(,fun) `(funcall ',fun)))) ;; More complex predicate. ((consp predicate) `(,(cond -- cgit v1.2.3 From 8d11b7e4275affdf66f28ec4a719fc8124252a3d Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 3 Mar 2024 16:33:53 +0100 Subject: * Fix 'cl--typeof-types' computation * lisp/emacs-lisp/cl-preloaded.el (cl--supertypes-lane) (cl--supertypes-lanes-res): Define vars. (cl--supertypes-for-typeof-types-rec): Define function. (cl--supertypes-for-typeof-types): Reimplement. --- lisp/emacs-lisp/cl-preloaded.el | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index b2b921192ff..512cf31ead5 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -98,17 +98,24 @@ Each element has the form (TYPE . SUPERTYPES) where TYPE is one of the symbols returned by `type-of', and SUPERTYPES is the list of its supertypes from the most specific to least specific.") +(defvar cl--supertypes-lane nil) +(defvar cl--supertypes-lanes-res nil) + +(defun cl--supertypes-for-typeof-types-rec (type) + ;; Walk recursively the DAG upwards, when the top is reached collect + ;; the current lane in `cl--supertypes-lanes-res'. + (push type cl--supertypes-lane) + (if-let ((parents (gethash type cl--direct-supertypes-of-type))) + (dolist (parent parents) + (cl--supertypes-for-typeof-types-rec parent)) + (push (reverse (cdr cl--supertypes-lane)) ;; Don't include `t'. + cl--supertypes-lanes-res )) + (pop cl--supertypes-lane)) + (defun cl--supertypes-for-typeof-types (type) - (cl-loop with agenda = (list type) - while agenda - for element = (car agenda) - unless (or (eq element t) ;; no t in `cl--typeof-types'. - (memq element res)) - append (list element) into res - do (cl-loop for c in (gethash element cl--direct-supertypes-of-type) - do (setq agenda (append agenda (list c)))) - do (setq agenda (cdr agenda)) - finally (cl-return res))) + (let (cl--supertypes-lane cl--supertypes-lanes-res) + (cl--supertypes-for-typeof-types-rec type) + (merge-ordered-lists cl--supertypes-lanes-res))) (maphash (lambda (type _) (push (cl--supertypes-for-typeof-types type) cl--typeof-types)) -- cgit v1.2.3 From f677b4499964c9449d760c4c6e60130b103ed5a8 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 3 Mar 2024 16:58:25 +0100 Subject: * test/lisp/emacs-lisp/comp-cstr-tests.el (comp-cstr-test-62): Revert change. --- test/lisp/emacs-lisp/comp-cstr-tests.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el b/test/lisp/emacs-lisp/comp-cstr-tests.el index c3a7092819d..955a99ced57 100644 --- a/test/lisp/emacs-lisp/comp-cstr-tests.el +++ b/test/lisp/emacs-lisp/comp-cstr-tests.el @@ -169,8 +169,8 @@ The arg is an alist of: type specifier -> expected type specifier." ((and symbol (not symbol)) . nil) ;; 61 ((and atom (not symbol)) . atom) - ;; 62 - ((and atom (not string)) . (or array atom)) + ;; 62 Conservative FIXME + ((and atom (not string)) . (or array sequence atom)) ;; 63 Conservative ((and symbol (not (member foo))) . symbol) ;; 64 Conservative -- cgit v1.2.3 From 23c984a7dea950e15b969fe5b7ca0395315f207a Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 3 Mar 2024 18:58:47 +0200 Subject: * lisp/net/dictionary.el (dictionary-new-matching): Add dictionary-pre-buffer. This is necessary to prepare the dictionary buffer for further processing that also includes setting buffer-read-only to nil to be able to insert text. (bug#69312) --- lisp/net/dictionary.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index e8ac9b679a0..e9e6b1292b5 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1118,6 +1118,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." "Run a new matching search on WORD." (dictionary-ensure-buffer) (dictionary-store-positions) + (dictionary-pre-buffer) (dictionary-do-matching word dictionary-default-dictionary dictionary-default-strategy 'dictionary-display-match-result) -- cgit v1.2.3 From db7b87867b3002d72444f06110e3625aa8de680e Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 3 Mar 2024 19:49:36 +0200 Subject: * lisp/net/dictionary.el (dictionary-display-match-result): More fixes. Remove 'dictionary-pre-buffer' that was moved to 'dictionary-new-matching' in the previous commit (bug#69312). --- lisp/net/dictionary.el | 2 -- 1 file changed, 2 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index e9e6b1292b5..7967c650999 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1176,8 +1176,6 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (defun dictionary-display-match-result (reply) "Display the results in REPLY from a match operation." - (dictionary-pre-buffer) - (let ((number (nth 1 (dictionary-reply-list reply))) (list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) (insert number " matching word" (if (equal number "1") "" "s") -- cgit v1.2.3 From 5254c582efb3e7171e955dde653e7530d2d3ffef Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 2 Mar 2024 14:48:29 -0500 Subject: ox-texinfo:: Require only TEXINFO_DIR_CATEGORY Until now @dircategory/@direntry entries were added only if both TEXINFO_DIR_CATEGORY and TEXINFO_DIR_TITLE were set. And the setting of TEXINFO_DIR_TITLE had to be careful to provide exactly the right syntax. This patch changes various things in this regard: - Only require TEXINFO_DIR_CATEGORY in order to generate `@dircategory` and `@direntry`. - Use the document title by default if TEXINFO_DIR_DESC is missing. - Use the filename by default when TEXINFO_DIR_TITLE is missing. - Try and make it harder to provide a direntry that does not have the right format or refers to a different filename than the one we're outputting to. * lisp/org/ox-texinfo.el: Remove redundant `:group` arguments. Prefer #' to quote function names. (org-texinfo-template): Use sane defaults for `@direntry`. * doc/misc/org.org (Texinfo specific export settings): Adjust accordingly. --- doc/misc/org.org | 11 ++++++++-- lisp/org/ox-texinfo.el | 58 ++++++++++++++++++++++++-------------------------- 2 files changed, 37 insertions(+), 32 deletions(-) diff --git a/doc/misc/org.org b/doc/misc/org.org index 05ab5b36ca0..f4590525892 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -15322,11 +15322,18 @@ the general options (see [[*Export Settings]]). #+cindex: @samp{TEXINFO_DIR_TITLE}, keyword The directory title of the document. + This is the short name under which the ~m~ command will find your + manual in the main Info directory. It defaults to the base name of + the Texinfo file. + + If you need more control, it can also be the full entry using the + syntax ~* TITLE: (FILENAME).~. - =TEXINFO_DIR_DESC= :: #+cindex: @samp{TEXINFO_DIR_DESC}, keyword The directory description of the document. + Defaults to the title of the document. - =TEXINFO_PRINTED_TITLE= :: @@ -15422,7 +15429,7 @@ Here is an example that writes to the Info directory file: #+begin_example ,#+TEXINFO_DIR_CATEGORY: Emacs -,#+TEXINFO_DIR_TITLE: Org Mode: (org) +,#+TEXINFO_DIR_TITLE: Org Mode ,#+TEXINFO_DIR_DESC: Outline-based notes management and organizer #+end_example @@ -15830,7 +15837,7 @@ Texinfo code. ,#+TEXINFO_HEADER: @syncodeindex pg cp ,#+TEXINFO_DIR_CATEGORY: Texinfo documentation system -,#+TEXINFO_DIR_TITLE: sample: (sample) +,#+TEXINFO_DIR_TITLE: sample ,#+TEXINFO_DIR_DESC: Invoking sample ,#+TEXINFO_PRINTED_TITLE: GNU Sample diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el index 84313645e6e..5065c3fb63c 100644 --- a/lisp/org/ox-texinfo.el +++ b/lisp/org/ox-texinfo.el @@ -110,6 +110,10 @@ (:subtitle "SUBTITLE" nil nil parse) (:subauthor "SUBAUTHOR" nil nil newline) (:texinfo-dircat "TEXINFO_DIR_CATEGORY" nil nil t) + ;; FIXME: The naming of these options is unsatisfactory: + ;; TEXINFO_DIR_DESC corresponds (and defaults) to the document's + ;; title, whereas TEXINFO_DIR_TITLE corresponds (and defaults) to + ;; its filename. (:texinfo-dirtitle "TEXINFO_DIR_TITLE" nil nil t) (:texinfo-dirdesc "TEXINFO_DIR_DESC" nil nil t) (:texinfo-printed-title "TEXINFO_PRINTED_TITLE" nil nil t) @@ -147,12 +151,10 @@ "Default document encoding for Texinfo output. If nil it will default to `buffer-file-coding-system'." - :group 'org-export-texinfo :type 'coding-system) (defcustom org-texinfo-default-class "info" "The default Texinfo class." - :group 'org-export-texinfo :type '(string :tag "Texinfo class")) (defcustom org-texinfo-classes @@ -205,7 +207,6 @@ The sectioning structure of the class is given by the elements following the header string. For each sectioning level, a number of strings is specified. A %s formatter is mandatory in each section string and will be replaced by the title of the section." - :group 'org-export-texinfo :version "27.1" :package-version '(Org . "9.2") :type '(repeat @@ -233,7 +234,6 @@ TEXT the main headline text (string). TAGS the tags as a list of strings (list of strings or nil). The function result will be used in the section format string." - :group 'org-export-texinfo :type 'function :version "26.1" :package-version '(Org . "8.3")) @@ -244,38 +244,32 @@ The function result will be used in the section format string." "Column at which to start the description in the node listings. If a node title is greater than this length, the description will be placed after the end of the title." - :group 'org-export-texinfo :type 'integer) ;;;; Timestamps (defcustom org-texinfo-active-timestamp-format "@emph{%s}" "A printf format string to be applied to active timestamps." - :group 'org-export-texinfo :type 'string) (defcustom org-texinfo-inactive-timestamp-format "@emph{%s}" "A printf format string to be applied to inactive timestamps." - :group 'org-export-texinfo :type 'string) (defcustom org-texinfo-diary-timestamp-format "@emph{%s}" "A printf format string to be applied to diary timestamps." - :group 'org-export-texinfo :type 'string) ;;;; Links (defcustom org-texinfo-link-with-unknown-path-format "@indicateurl{%s}" "Format string for links with unknown path type." - :group 'org-export-texinfo :type 'string) ;;;; Tables (defcustom org-texinfo-tables-verbatim nil "When non-nil, tables are exported verbatim." - :group 'org-export-texinfo :type 'boolean) (defcustom org-texinfo-table-scientific-notation nil @@ -285,7 +279,6 @@ The format should have \"%s\" twice, for mantissa and exponent \(i.e. \"%s\\\\times10^{%s}\"). When nil, no transformation is made." - :group 'org-export-texinfo :type '(choice (string :tag "Format string") (const :tag "No formatting" nil))) @@ -297,7 +290,6 @@ This should an indicating command, e.g., \"@code\", \"@kbd\" or \"@samp\". It can be overridden locally using the \":indic\" attribute." - :group 'org-export-texinfo :type 'string :version "26.1" :package-version '(Org . "9.1") @@ -323,7 +315,6 @@ to typeset and protects special characters. When no association is found for a given markup, text is returned as-is." - :group 'org-export-texinfo :version "26.1" :package-version '(Org . "9.1") :type 'alist @@ -341,7 +332,6 @@ The function must accept two parameters: The function should return the string to be exported. The default function simply returns the value of CONTENTS." - :group 'org-export-texinfo :version "24.4" :package-version '(Org . "8.2") :type 'function) @@ -361,7 +351,6 @@ The function must accept six parameters: CONTENTS the contents of the inlinetask, as a string. The function should return the string to be exported." - :group 'org-export-texinfo :type 'function) ;;;; LaTeX @@ -374,7 +363,6 @@ fragments as Texinfo \"@displaymath\" and \"@math\" commands respectively. Alternatively, when set to `detect', the exporter does so only if the installed version of Texinfo supports the necessary commands." - :group 'org-export-texinfo :package-version '(Org . "9.6") :type '(choice (const :tag "Detect" detect) @@ -391,7 +379,6 @@ body but is followed by another item, then the second item is transcoded to `@itemx'. See info node `(org)Plain lists in Texinfo export' for how to enable this for individual lists." :package-version '(Org . "9.6") - :group 'org-export-texinfo :type 'boolean :safe t) @@ -406,7 +393,6 @@ relative file name, %F by the absolute file name, %b by the file base name (i.e. without directory and extension parts), %o by the base directory of the file and %O by the absolute file name of the output file." - :group 'org-export-texinfo :version "26.1" :package-version '(Org . "9.1") :type '(repeat :tag "Shell command sequence" @@ -416,8 +402,8 @@ the output file." '("aux" "toc" "cp" "fn" "ky" "pg" "tp" "vr") "The list of file extensions to consider as Texinfo logfiles. The logfiles will be remove if `org-texinfo-remove-logfiles' is + non-nil." - :group 'org-export-texinfo :type '(repeat (string :tag "Extension"))) (defcustom org-texinfo-remove-logfiles t @@ -815,19 +801,31 @@ holding export options." (format "@copying\n%s@end copying\n\n" (org-element-normalize-string (org-export-data copying info)))) - ;; Info directory information. Only supply if both title and - ;; category are provided. - (let ((dircat (plist-get info :texinfo-dircat)) - (dirtitle - (let ((title (plist-get info :texinfo-dirtitle))) - (and title - (string-match "^\\(?:\\* \\)?\\(.*?\\)\\(\\.\\)?$" title) - (format "* %s." (match-string 1 title)))))) - (when (and dircat dirtitle) + ;; Info directory information. Only supply if category is provided. + ;; FIXME: A Texinfo doc without a direntry is significantly less useful + ;; since it won't appear in the main Info-directory, so maybe we should + ;; use a default category like "misc"? + (let* ((dircat (plist-get info :texinfo-dircat)) + (dt (plist-get info :texinfo-dirtitle)) + (file (file-name-sans-extension + (or (org-strip-quotes (plist-get info :texinfo-filename)) + (plist-get info :output-file)))) + (dirtitle + (cond + ((and dt + (or (string-match "\\`\\* \\(.*?\\)\\(\\.\\)?\\'" dt) + (string-match "\\`\\(.*(.*)\\)\\(\\.\\)?\\'" dt))) + ;; `dt' is already "complete". + (format "* %s." (match-string 1 dt))) + ((and dt (not (equal dt file))) + (format "* %s: (%s)." dt file)) + (t (format "* %s." file))))) + (when dircat (concat "@dircategory " dircat "\n" "@direntry\n" (let ((dirdesc - (let ((desc (plist-get info :texinfo-dirdesc))) + (let ((desc (or (plist-get info :texinfo-dirdesc) + title))) (cond ((not desc) nil) ((string-suffix-p "." desc) desc) (t (concat desc ".")))))) @@ -1590,7 +1588,7 @@ information." (concat "@noindent" (mapconcat - 'identity + #'identity (delq nil (list (let ((closed (org-element-property :closed planning))) -- cgit v1.2.3 From 99483e214fdafa76e8001c7009dff13a76c33f32 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 2 Mar 2024 15:23:17 -0500 Subject: Set org-macro-templates more lazily --- lisp/org/org-macro.el | 8 +++++--- lisp/org/org-macs.el | 4 +++- lisp/org/org.el | 21 ++++++++++----------- 3 files changed, 18 insertions(+), 15 deletions(-) diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el index 737eab5d2bb..acc8f5e593b 100644 --- a/lisp/org/org-macro.el +++ b/lisp/org/org-macro.el @@ -78,12 +78,14 @@ ;;; Variables -(defvar-local org-macro-templates nil +(defvar-local org-macro-templates t "Alist containing all macro templates in current buffer. Associations are in the shape of (NAME . TEMPLATE) where NAME stands for macro's name and template for its replacement value, -both as strings. This is an internal variable. Do not set it -directly, use instead: +both as strings. +`t' means that it has not yet been initialized. + +This is an internal variable. Do not set it directly, use instead: #+MACRO: name template") diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index aafbdf0e0aa..53943d343d8 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -132,6 +132,8 @@ Version mismatch is commonly encountered in the following situations: ;; Use `with-silent-modifications' to ignore cosmetic changes and ;; `org-unmodified' to ignore real text modifications. +;; FIXME: Won't "real text modifications" break the undo data if +;; `buffer-undo-list' is let-bound to t? (defmacro org-unmodified (&rest body) "Run BODY while preserving the buffer's `buffer-modified-p' state." (declare (debug (body))) @@ -141,7 +143,7 @@ Version mismatch is commonly encountered in the following situations: (let ((buffer-undo-list t) (inhibit-modification-hooks t)) ,@body) - (set-buffer-modified-p ,was-modified))))) + (restore-buffer-modified-p ,was-modified))))) (defmacro org-with-base-buffer (buffer &rest body) "Run BODY in base buffer for BUFFER. diff --git a/lisp/org/org.el b/lisp/org/org.el index d361408eaca..3fb8fce78d3 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -716,8 +716,9 @@ defined in org-duration.el.") "Load all extensions listed in `org-modules'." (when (or force (not org-modules-loaded)) (dolist (ext org-modules) - (condition-case nil (require ext) - (error (message "Problems while trying to load feature `%s'" ext)))) + (condition-case err (require ext) + (error (message "Problems while trying to load feature `%s':\n%S" + ext err)))) (setq org-modules-loaded t))) (defun org-set-modules (var value) @@ -855,7 +856,7 @@ depends on, if any." :group 'org-export :version "26.1" :package-version '(Org . "9.0") - :initialize 'custom-initialize-set + :initialize #'custom-initialize-set :set (lambda (var val) (if (not (featurep 'ox)) (set-default-toplevel-value var val) ;; Any back-end not required anymore (not present in VAL and not @@ -905,9 +906,9 @@ depends on, if any." (eval-after-load 'ox '(dolist (backend org-export-backends) - (condition-case nil (require (intern (format "ox-%s" backend))) - (error (message "Problems while trying to load export back-end `%s'" - backend))))) + (condition-case err (require (intern (format "ox-%s" backend))) + (error (message "Problems while trying to load export back-end `%s':\n%S" + backend err))))) (defcustom org-support-shift-select nil "Non-nil means make shift-cursor commands select text when possible. @@ -4772,7 +4773,7 @@ This is for getting out of special buffers like capture.") (require 'org-pcomplete) (require 'org-src) (require 'org-footnote) -(require 'org-macro) +;; (require 'org-macro) ;; babel (require 'ob) @@ -4852,8 +4853,6 @@ The following commands are available: (when (and org-element-cache-persistent org-element-use-cache) (org-persist-load 'org-element--cache (current-buffer) t)) - ;; Initialize macros templates. - (org-macro-initialize-templates) ;; Initialize radio targets. (org-update-radio-target-regexp) ;; Indentation. @@ -10459,7 +10458,7 @@ EXTRA is additional text that will be inserted into the notes buffer." org-log-note-this-command this-command org-log-note-recursion-depth (recursion-depth) org-log-setup t) - (add-hook 'post-command-hook 'org-add-log-note 'append)) + (add-hook 'post-command-hook #'org-add-log-note 'append)) (defun org-skip-over-state-notes () "Skip past the list of State notes in an entry." @@ -10488,7 +10487,7 @@ EXTRA is additional text that will be inserted into the notes buffer." "Pop up a window for taking a note, and add this note later." (when (and (equal org-log-note-this-command this-command) (= org-log-note-recursion-depth (recursion-depth))) - (remove-hook 'post-command-hook 'org-add-log-note) + (remove-hook 'post-command-hook #'org-add-log-note) (setq org-log-setup nil) (setq org-log-note-window-configuration (current-window-configuration)) (delete-other-windows) -- cgit v1.2.3 From 1d9d07fb00e6b62641c07af68f986e700b5f6cee Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 3 Mar 2024 18:08:50 -0500 Subject: (cl--typeof-types): Rework to fix some regressions Initialize the variables directly in their declaration, so there no time where they exist but aren't yet initialized. This also allows us to mark `cl--typeof-types` as a `defconst` again. More importantly, specify the DAG by direct supertypes rather than direct subtypes. This is slightly less compact, but it's necessary to let us specify the *order* of the supertypes, which is necessary for example to preserve the desired ordering of methods when several methods can be applied. Fix a few more regressions, such as removing `atom` from the parents of `function` since some lists are considered as functions, adding `number-or-marker` as supertype of `integer-or-marker`, and re-adding `native-comp-unit`. I carefully compared all elements of `cl--typeof-types` to make sure they are the same as before (with one exception for `null`). * lisp/emacs-lisp/cl-preloaded.el (cl--type-hierarchy): Delete var. (cl--direct-supertypes-of-type, cl--typeof-types): Initialize directly in the declaration. (cl--supertypes-lane, cl--supertypes-lanes-res): Delete vars. (cl--supertypes-for-typeof-types-rec) (cl--supertypes-for-typeof-types): Delete functions. --- lisp/emacs-lisp/cl-preloaded.el | 117 +++++++++++++++++++--------------------- 1 file changed, 54 insertions(+), 63 deletions(-) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 512cf31ead5..a4ddc55b257 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -50,77 +50,68 @@ (apply #'error string (append sargs args)) (signal 'cl-assertion-failed `(,form ,@sargs))))) - -(defconst cl--type-hierarchy - ;; Please run `sycdoc-update-type-hierarchy' in - ;; etc/syncdoc-type-hierarchy.el each time this is updated to - ;; reflect in the documentation. - '((t sequence atom) - (sequence list array) - (atom - class structure tree-sitter-compiled-query tree-sitter-node - tree-sitter-parser user-ptr font-object font-entity font-spec - condvar mutex thread terminal hash-table frame buffer function - window process window-configuration overlay integer-or-marker - number-or-marker symbol array obarray) - (number float integer) - (number-or-marker marker number) - (integer bignum fixnum) - (symbol keyword boolean symbol-with-pos) - (array vector bool-vector char-table string) - (list null cons) - (integer-or-marker integer marker) - (compiled-function byte-code-function) - (function subr module-function compiled-function) - (boolean null) - (subr subr-native-elisp subr-primitive) - (symbol-with-pos keyword)) - "List of lists describing all the edges of the builtin type -hierarchy. -Each sublist is in the form (TYPE . DIRECT_SUBTYPES)" - ;; Given type hierarchy is a DAG (but mostly a tree) I believe this - ;; is the most compact way to express it. - ) - (defconst cl--direct-supertypes-of-type - (make-hash-table :test #'eq) + (let ((table (make-hash-table :test #'eq))) + (dolist (x '((sequence t) + (atom t) + (list sequence) + (array sequence atom) + (float number) + (integer number integer-or-marker) + (marker integer-or-marker number-or-marker) + (integer-or-marker number-or-marker) + (number number-or-marker) + (bignum integer) + (fixnum integer) + (keyword symbol) + (boolean symbol) + (symbol-with-pos symbol) + (vector array) + (bool-vector array) + (char-table array) + (string array) + ;; FIXME: This results in `atom' coming before `list' :-( + (null boolean list) + (cons list) + (byte-code-function compiled-function) + (subr compiled-function) + (module-function function atom) + (compiled-function function atom) + (subr-native-elisp subr) + (subr-primitive subr))) + (puthash (car x) (cdr x) table)) + ;; And here's the flat part of the hierarchy. + (dolist (atom '( tree-sitter-compiled-query tree-sitter-node + tree-sitter-parser user-ptr + font-object font-entity font-spec + condvar mutex thread terminal hash-table frame + ;; function ;; FIXME: can be a list as well. + buffer window process window-configuration + overlay number-or-marker + symbol obarray native-comp-unit)) + (cl-assert (null (gethash atom table))) + (puthash atom '(atom) table)) + table) "Hash table TYPE -> SUPERTYPES.") -(cl-loop - for (parent . children) in cl--type-hierarchy - do (cl-loop - for child in children - do (cl-pushnew parent (gethash child cl--direct-supertypes-of-type)))) - -(defvar cl--typeof-types nil +(defconst cl--typeof-types + (letrec ((alist nil) + (allparents + (lambda (type) + ;; FIXME: copy&pasted from `cl--class-allparents'. + (let ((parents (gethash type cl--direct-supertypes-of-type))) + (cons type + (merge-ordered-lists + (mapcar allparents (remq t parents)))))))) + (maphash (lambda (type _) + (push (funcall allparents type) alist)) + cl--direct-supertypes-of-type) + alist) "Alist of supertypes. Each element has the form (TYPE . SUPERTYPES) where TYPE is one of the symbols returned by `type-of', and SUPERTYPES is the list of its supertypes from the most specific to least specific.") -(defvar cl--supertypes-lane nil) -(defvar cl--supertypes-lanes-res nil) - -(defun cl--supertypes-for-typeof-types-rec (type) - ;; Walk recursively the DAG upwards, when the top is reached collect - ;; the current lane in `cl--supertypes-lanes-res'. - (push type cl--supertypes-lane) - (if-let ((parents (gethash type cl--direct-supertypes-of-type))) - (dolist (parent parents) - (cl--supertypes-for-typeof-types-rec parent)) - (push (reverse (cdr cl--supertypes-lane)) ;; Don't include `t'. - cl--supertypes-lanes-res )) - (pop cl--supertypes-lane)) - -(defun cl--supertypes-for-typeof-types (type) - (let (cl--supertypes-lane cl--supertypes-lanes-res) - (cl--supertypes-for-typeof-types-rec type) - (merge-ordered-lists cl--supertypes-lanes-res))) - -(maphash (lambda (type _) - (push (cl--supertypes-for-typeof-types type) cl--typeof-types)) - cl--direct-supertypes-of-type) - (defconst cl--all-builtin-types (delete-dups (copy-sequence (apply #'append cl--typeof-types)))) -- cgit v1.2.3 From 1a37fe3a66930bb8151a29c722dbe3bebc20d033 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 3 Mar 2024 22:09:19 -0500 Subject: Revert "Set org-macro-templates more lazily" This reverts commit 99483e214fdafa76e8001c7009dff13a76c33f32. --- lisp/org/org-macro.el | 8 +++----- lisp/org/org-macs.el | 4 +--- lisp/org/org.el | 21 +++++++++++---------- 3 files changed, 15 insertions(+), 18 deletions(-) diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el index acc8f5e593b..737eab5d2bb 100644 --- a/lisp/org/org-macro.el +++ b/lisp/org/org-macro.el @@ -78,14 +78,12 @@ ;;; Variables -(defvar-local org-macro-templates t +(defvar-local org-macro-templates nil "Alist containing all macro templates in current buffer. Associations are in the shape of (NAME . TEMPLATE) where NAME stands for macro's name and template for its replacement value, -both as strings. -`t' means that it has not yet been initialized. - -This is an internal variable. Do not set it directly, use instead: +both as strings. This is an internal variable. Do not set it +directly, use instead: #+MACRO: name template") diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 53943d343d8..aafbdf0e0aa 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -132,8 +132,6 @@ Version mismatch is commonly encountered in the following situations: ;; Use `with-silent-modifications' to ignore cosmetic changes and ;; `org-unmodified' to ignore real text modifications. -;; FIXME: Won't "real text modifications" break the undo data if -;; `buffer-undo-list' is let-bound to t? (defmacro org-unmodified (&rest body) "Run BODY while preserving the buffer's `buffer-modified-p' state." (declare (debug (body))) @@ -143,7 +141,7 @@ Version mismatch is commonly encountered in the following situations: (let ((buffer-undo-list t) (inhibit-modification-hooks t)) ,@body) - (restore-buffer-modified-p ,was-modified))))) + (set-buffer-modified-p ,was-modified))))) (defmacro org-with-base-buffer (buffer &rest body) "Run BODY in base buffer for BUFFER. diff --git a/lisp/org/org.el b/lisp/org/org.el index 3fb8fce78d3..d361408eaca 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -716,9 +716,8 @@ defined in org-duration.el.") "Load all extensions listed in `org-modules'." (when (or force (not org-modules-loaded)) (dolist (ext org-modules) - (condition-case err (require ext) - (error (message "Problems while trying to load feature `%s':\n%S" - ext err)))) + (condition-case nil (require ext) + (error (message "Problems while trying to load feature `%s'" ext)))) (setq org-modules-loaded t))) (defun org-set-modules (var value) @@ -856,7 +855,7 @@ depends on, if any." :group 'org-export :version "26.1" :package-version '(Org . "9.0") - :initialize #'custom-initialize-set + :initialize 'custom-initialize-set :set (lambda (var val) (if (not (featurep 'ox)) (set-default-toplevel-value var val) ;; Any back-end not required anymore (not present in VAL and not @@ -906,9 +905,9 @@ depends on, if any." (eval-after-load 'ox '(dolist (backend org-export-backends) - (condition-case err (require (intern (format "ox-%s" backend))) - (error (message "Problems while trying to load export back-end `%s':\n%S" - backend err))))) + (condition-case nil (require (intern (format "ox-%s" backend))) + (error (message "Problems while trying to load export back-end `%s'" + backend))))) (defcustom org-support-shift-select nil "Non-nil means make shift-cursor commands select text when possible. @@ -4773,7 +4772,7 @@ This is for getting out of special buffers like capture.") (require 'org-pcomplete) (require 'org-src) (require 'org-footnote) -;; (require 'org-macro) +(require 'org-macro) ;; babel (require 'ob) @@ -4853,6 +4852,8 @@ The following commands are available: (when (and org-element-cache-persistent org-element-use-cache) (org-persist-load 'org-element--cache (current-buffer) t)) + ;; Initialize macros templates. + (org-macro-initialize-templates) ;; Initialize radio targets. (org-update-radio-target-regexp) ;; Indentation. @@ -10458,7 +10459,7 @@ EXTRA is additional text that will be inserted into the notes buffer." org-log-note-this-command this-command org-log-note-recursion-depth (recursion-depth) org-log-setup t) - (add-hook 'post-command-hook #'org-add-log-note 'append)) + (add-hook 'post-command-hook 'org-add-log-note 'append)) (defun org-skip-over-state-notes () "Skip past the list of State notes in an entry." @@ -10487,7 +10488,7 @@ EXTRA is additional text that will be inserted into the notes buffer." "Pop up a window for taking a note, and add this note later." (when (and (equal org-log-note-this-command this-command) (= org-log-note-recursion-depth (recursion-depth))) - (remove-hook 'post-command-hook #'org-add-log-note) + (remove-hook 'post-command-hook 'org-add-log-note) (setq org-log-setup nil) (setq org-log-note-window-configuration (current-window-configuration)) (delete-other-windows) -- cgit v1.2.3 From 445f376e4e613ebee94d2844926269bfa8793858 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 3 Mar 2024 22:09:24 -0500 Subject: Revert "ox-texinfo:: Require only TEXINFO_DIR_CATEGORY" This reverts commit 5254c582efb3e7171e955dde653e7530d2d3ffef. --- doc/misc/org.org | 11 ++-------- lisp/org/ox-texinfo.el | 58 ++++++++++++++++++++++++++------------------------ 2 files changed, 32 insertions(+), 37 deletions(-) diff --git a/doc/misc/org.org b/doc/misc/org.org index f4590525892..05ab5b36ca0 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -15322,18 +15322,11 @@ the general options (see [[*Export Settings]]). #+cindex: @samp{TEXINFO_DIR_TITLE}, keyword The directory title of the document. - This is the short name under which the ~m~ command will find your - manual in the main Info directory. It defaults to the base name of - the Texinfo file. - - If you need more control, it can also be the full entry using the - syntax ~* TITLE: (FILENAME).~. - =TEXINFO_DIR_DESC= :: #+cindex: @samp{TEXINFO_DIR_DESC}, keyword The directory description of the document. - Defaults to the title of the document. - =TEXINFO_PRINTED_TITLE= :: @@ -15429,7 +15422,7 @@ Here is an example that writes to the Info directory file: #+begin_example ,#+TEXINFO_DIR_CATEGORY: Emacs -,#+TEXINFO_DIR_TITLE: Org Mode +,#+TEXINFO_DIR_TITLE: Org Mode: (org) ,#+TEXINFO_DIR_DESC: Outline-based notes management and organizer #+end_example @@ -15837,7 +15830,7 @@ Texinfo code. ,#+TEXINFO_HEADER: @syncodeindex pg cp ,#+TEXINFO_DIR_CATEGORY: Texinfo documentation system -,#+TEXINFO_DIR_TITLE: sample +,#+TEXINFO_DIR_TITLE: sample: (sample) ,#+TEXINFO_DIR_DESC: Invoking sample ,#+TEXINFO_PRINTED_TITLE: GNU Sample diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el index 5065c3fb63c..84313645e6e 100644 --- a/lisp/org/ox-texinfo.el +++ b/lisp/org/ox-texinfo.el @@ -110,10 +110,6 @@ (:subtitle "SUBTITLE" nil nil parse) (:subauthor "SUBAUTHOR" nil nil newline) (:texinfo-dircat "TEXINFO_DIR_CATEGORY" nil nil t) - ;; FIXME: The naming of these options is unsatisfactory: - ;; TEXINFO_DIR_DESC corresponds (and defaults) to the document's - ;; title, whereas TEXINFO_DIR_TITLE corresponds (and defaults) to - ;; its filename. (:texinfo-dirtitle "TEXINFO_DIR_TITLE" nil nil t) (:texinfo-dirdesc "TEXINFO_DIR_DESC" nil nil t) (:texinfo-printed-title "TEXINFO_PRINTED_TITLE" nil nil t) @@ -151,10 +147,12 @@ "Default document encoding for Texinfo output. If nil it will default to `buffer-file-coding-system'." + :group 'org-export-texinfo :type 'coding-system) (defcustom org-texinfo-default-class "info" "The default Texinfo class." + :group 'org-export-texinfo :type '(string :tag "Texinfo class")) (defcustom org-texinfo-classes @@ -207,6 +205,7 @@ The sectioning structure of the class is given by the elements following the header string. For each sectioning level, a number of strings is specified. A %s formatter is mandatory in each section string and will be replaced by the title of the section." + :group 'org-export-texinfo :version "27.1" :package-version '(Org . "9.2") :type '(repeat @@ -234,6 +233,7 @@ TEXT the main headline text (string). TAGS the tags as a list of strings (list of strings or nil). The function result will be used in the section format string." + :group 'org-export-texinfo :type 'function :version "26.1" :package-version '(Org . "8.3")) @@ -244,32 +244,38 @@ The function result will be used in the section format string." "Column at which to start the description in the node listings. If a node title is greater than this length, the description will be placed after the end of the title." + :group 'org-export-texinfo :type 'integer) ;;;; Timestamps (defcustom org-texinfo-active-timestamp-format "@emph{%s}" "A printf format string to be applied to active timestamps." + :group 'org-export-texinfo :type 'string) (defcustom org-texinfo-inactive-timestamp-format "@emph{%s}" "A printf format string to be applied to inactive timestamps." + :group 'org-export-texinfo :type 'string) (defcustom org-texinfo-diary-timestamp-format "@emph{%s}" "A printf format string to be applied to diary timestamps." + :group 'org-export-texinfo :type 'string) ;;;; Links (defcustom org-texinfo-link-with-unknown-path-format "@indicateurl{%s}" "Format string for links with unknown path type." + :group 'org-export-texinfo :type 'string) ;;;; Tables (defcustom org-texinfo-tables-verbatim nil "When non-nil, tables are exported verbatim." + :group 'org-export-texinfo :type 'boolean) (defcustom org-texinfo-table-scientific-notation nil @@ -279,6 +285,7 @@ The format should have \"%s\" twice, for mantissa and exponent \(i.e. \"%s\\\\times10^{%s}\"). When nil, no transformation is made." + :group 'org-export-texinfo :type '(choice (string :tag "Format string") (const :tag "No formatting" nil))) @@ -290,6 +297,7 @@ This should an indicating command, e.g., \"@code\", \"@kbd\" or \"@samp\". It can be overridden locally using the \":indic\" attribute." + :group 'org-export-texinfo :type 'string :version "26.1" :package-version '(Org . "9.1") @@ -315,6 +323,7 @@ to typeset and protects special characters. When no association is found for a given markup, text is returned as-is." + :group 'org-export-texinfo :version "26.1" :package-version '(Org . "9.1") :type 'alist @@ -332,6 +341,7 @@ The function must accept two parameters: The function should return the string to be exported. The default function simply returns the value of CONTENTS." + :group 'org-export-texinfo :version "24.4" :package-version '(Org . "8.2") :type 'function) @@ -351,6 +361,7 @@ The function must accept six parameters: CONTENTS the contents of the inlinetask, as a string. The function should return the string to be exported." + :group 'org-export-texinfo :type 'function) ;;;; LaTeX @@ -363,6 +374,7 @@ fragments as Texinfo \"@displaymath\" and \"@math\" commands respectively. Alternatively, when set to `detect', the exporter does so only if the installed version of Texinfo supports the necessary commands." + :group 'org-export-texinfo :package-version '(Org . "9.6") :type '(choice (const :tag "Detect" detect) @@ -379,6 +391,7 @@ body but is followed by another item, then the second item is transcoded to `@itemx'. See info node `(org)Plain lists in Texinfo export' for how to enable this for individual lists." :package-version '(Org . "9.6") + :group 'org-export-texinfo :type 'boolean :safe t) @@ -393,6 +406,7 @@ relative file name, %F by the absolute file name, %b by the file base name (i.e. without directory and extension parts), %o by the base directory of the file and %O by the absolute file name of the output file." + :group 'org-export-texinfo :version "26.1" :package-version '(Org . "9.1") :type '(repeat :tag "Shell command sequence" @@ -402,8 +416,8 @@ the output file." '("aux" "toc" "cp" "fn" "ky" "pg" "tp" "vr") "The list of file extensions to consider as Texinfo logfiles. The logfiles will be remove if `org-texinfo-remove-logfiles' is - non-nil." + :group 'org-export-texinfo :type '(repeat (string :tag "Extension"))) (defcustom org-texinfo-remove-logfiles t @@ -801,31 +815,19 @@ holding export options." (format "@copying\n%s@end copying\n\n" (org-element-normalize-string (org-export-data copying info)))) - ;; Info directory information. Only supply if category is provided. - ;; FIXME: A Texinfo doc without a direntry is significantly less useful - ;; since it won't appear in the main Info-directory, so maybe we should - ;; use a default category like "misc"? - (let* ((dircat (plist-get info :texinfo-dircat)) - (dt (plist-get info :texinfo-dirtitle)) - (file (file-name-sans-extension - (or (org-strip-quotes (plist-get info :texinfo-filename)) - (plist-get info :output-file)))) - (dirtitle - (cond - ((and dt - (or (string-match "\\`\\* \\(.*?\\)\\(\\.\\)?\\'" dt) - (string-match "\\`\\(.*(.*)\\)\\(\\.\\)?\\'" dt))) - ;; `dt' is already "complete". - (format "* %s." (match-string 1 dt))) - ((and dt (not (equal dt file))) - (format "* %s: (%s)." dt file)) - (t (format "* %s." file))))) - (when dircat + ;; Info directory information. Only supply if both title and + ;; category are provided. + (let ((dircat (plist-get info :texinfo-dircat)) + (dirtitle + (let ((title (plist-get info :texinfo-dirtitle))) + (and title + (string-match "^\\(?:\\* \\)?\\(.*?\\)\\(\\.\\)?$" title) + (format "* %s." (match-string 1 title)))))) + (when (and dircat dirtitle) (concat "@dircategory " dircat "\n" "@direntry\n" (let ((dirdesc - (let ((desc (or (plist-get info :texinfo-dirdesc) - title))) + (let ((desc (plist-get info :texinfo-dirdesc))) (cond ((not desc) nil) ((string-suffix-p "." desc) desc) (t (concat desc ".")))))) @@ -1588,7 +1590,7 @@ information." (concat "@noindent" (mapconcat - #'identity + 'identity (delq nil (list (let ((closed (org-element-property :closed planning))) -- cgit v1.2.3 From f5c65dae099485f4df128b61d36ae9e5af8518a8 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 4 Mar 2024 11:21:53 +0800 Subject: Update tramp-androidsu * doc/misc/tramp.texi (Quick Start Guide): Remove documentation pertaining to tramp-androidsu.el. (Inline methods): Document it here instead. * lisp/net/tramp-androidsu.el (tramp-androidsu-mount-global-namespace) (tramp-androidsu-remote-path, tramp-androidsu-local-shell-name) (tramp-androidsu-local-tmp-directory, add-to-list) (tramp-androidsu-maybe-open-connection) (tramp-androidsu-handle-access-file) (tramp-androidsu-handle-add-name-to-file) (tramp-androidsu-handle-copy-directory) (tramp-androidsu-sh-handle-copy-file) (tramp-androidsu-handle-copy-file) (tramp-androidsu-adb-handle-delete-directory) (tramp-androidsu-handle-delete-directory) (tramp-androidsu-adb-handle-delete-file) (tramp-androidsu-handle-delete-file) (tramp-androidsu-handle-directory-file-name) (tramp-androidsu-handle-directory-files) (tramp-androidsu-adb-handle-directory-files-and-attributes) (tramp-androidsu-handle-directory-files-and-attributes) (tramp-androidsu-handle-dired-uncache) (tramp-androidsu-adb-handle-exec-path) (tramp-androidsu-handle-exec-path) (tramp-androidsu-handle-expand-file-name) (tramp-androidsu-handle-file-accessible-directory-p) (tramp-androidsu-adb-handle-file-attributes) (tramp-androidsu-handle-file-attributes) (tramp-androidsu-handle-file-directory-p) (tramp-androidsu-handle-file-equal-p) (tramp-androidsu-adb-handle-file-executable-p) (tramp-androidsu-handle-file-executable-p) (tramp-androidsu-adb-handle-file-exists-p) (tramp-androidsu-handle-file-exists-p) (tramp-androidsu-handle-file-group-gid) (tramp-androidsu-handle-file-in-directory-p) (tramp-androidsu-sh-handle-file-local-copy) (tramp-androidsu-handle-file-local-copy) (tramp-androidsu-handle-file-locked-p) (tramp-androidsu-handle-file-modes) (tramp-androidsu-adb-handle-file-name-all-completions) (tramp-androidsu-handle-file-name-all-completions) (tramp-androidsu-handle-file-name-as-directory) (tramp-androidsu-handle-file-name-case-insensitive-p) (tramp-androidsu-handle-file-name-completion) (tramp-androidsu-handle-file-name-directory) (tramp-androidsu-handle-file-name-nondirectory) (tramp-androidsu-handle-file-newer-than-file-p) (tramp-androidsu-handle-file-notify-add-watch) (tramp-androidsu-handle-file-notify-rm-watch) (tramp-androidsu-handle-file-notify-valid-p) (tramp-androidsu-adb-handle-file-readable-p) (tramp-androidsu-handle-file-readable-p) (tramp-androidsu-handle-file-regular-p) (tramp-androidsu-handle-file-remote-p) (tramp-androidsu-handle-file-selinux-context) (tramp-androidsu-handle-file-symlink-p) (tramp-androidsu-adb-handle-file-system-info) (tramp-androidsu-handle-file-system-info) (tramp-androidsu-handle-file-truename) (tramp-androidsu-handle-file-user-uid) (tramp-androidsu-adb-handle-file-writable-p) (tramp-androidsu-handle-file-writable-p) (tramp-androidsu-handle-find-backup-file-name) (tramp-androidsu-handle-insert-directory) (tramp-androidsu-handle-insert-file-contents) (tramp-androidsu-handle-list-system-processes) (tramp-androidsu-handle-load, tramp-androidsu-handle-lock-file) (tramp-androidsu-handle-make-auto-save-file-name) (tramp-androidsu-adb-handle-make-directory) (tramp-androidsu-handle-make-directory) (tramp-androidsu-handle-make-lock-file-name) (tramp-androidsu-handle-make-nearby-temp-file) (tramp-androidsu-make-process) (tramp-androidsu-sh-handle-make-symbolic-link) (tramp-androidsu-handle-make-symbolic-link) (tramp-androidsu-handle-memory-info) (tramp-androidsu-handle-process-attributes) (tramp-androidsu-adb-handle-process-file) (tramp-androidsu-handle-process-file) (tramp-androidsu-sh-handle-rename-file) (tramp-androidsu-handle-rename-file) (tramp-androidsu-adb-handle-set-file-modes) (tramp-androidsu-handle-set-file-modes) (tramp-androidsu-adb-handle-set-file-times) (tramp-androidsu-handle-set-file-times) (tramp-androidsu-handle-set-visited-file-modtime) (tramp-androidsu-handle-shell-command) (tramp-androidsu-handle-start-file-process) (tramp-androidsu-handle-substitute-in-file-name) (tramp-androidsu-handle-temporary-file-directory) (tramp-androidsu-adb-handle-get-remote-gid) (tramp-androidsu-handle-get-remote-gid) (tramp-androidsu-adb-handle-get-remote-groups) (tramp-androidsu-handle-get-remote-groups) (tramp-androidsu-adb-handle-get-remote-uid) (tramp-androidsu-handle-get-remote-uid) (tramp-androidsu-handle-unlock-file) (tramp-androidsu-handle-verify-visited-file-modtime) (tramp-androidsu-sh-handle-write-region) (tramp-androidsu-handle-write-region) (tramp-androidsu-file-name-handler-alist): Make hard-coded executable and file names defconsts, remove redundant wrapper functions and remove names of wrapped functions from their wrappers. --- doc/misc/tramp.texi | 19 ++- lisp/net/tramp-androidsu.el | 405 ++++++++++++++++---------------------------- 2 files changed, 152 insertions(+), 272 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 09b875ad3fa..d67e2fcb64c 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -510,7 +510,6 @@ default host name. Therefore, it is convenient to open a file as The method @option{sg} stands for ``switch group''; here the user name is used as the group to change to. The default host name is the same. - @anchor{Quick Start Guide Combining ssh, plink, su, sudo and doas methods} @section Combining @option{ssh} or @option{plink} with @option{su}, @option{sudo} or @option{doas} @cindex method @option{ssh} @@ -523,8 +522,6 @@ is used as the group to change to. The default host name is the same. @cindex @option{sudo} method @cindex method @option{doas} @cindex @option{doas} method -@cindex method @option{androidsu} -@cindex @option{androidsu} method If the @option{su}, @option{sudo} or @option{doas} option should be performed on another host, it can be combined with a leading @@ -535,12 +532,6 @@ a simple case, the syntax looks like @file{@trampfn{ssh@value{postfixhop}user@@host|sudo,,/path/to/file}}. @xref{Ad-hoc multi-hops}. -The @option{su} method and other shell-based methods conflict with -non-standard @command{su} implementations popular among Android users -and the restricted command-line utilities distributed with that system. -The @option{androidsu} method enables accessing files through -@command{su} on such systems, but multi-hops are not supported. - @anchor{Quick Start Guide sudoedit method} @section Using @command{sudoedit} @cindex method @option{sudoedit} @@ -826,6 +817,16 @@ editing as another user. The host can be either @samp{localhost} or the host returned by the function @command{(system-name)}. See @ref{Multi-hops} for an exception to this behavior. +@cindex method @option{androidsu} +@cindex @option{androidsu} method +Because the default implementation of the @option{su} method and other +shell-based methods conflict with non-standard @command{su} +implementations popular among Android users and the restricted +command-line utilities distributed with that system, a largely +equivalent @option{androidsu} method is provided for that system with +workarounds for its many idiosyncrasies, with the exception that +multi-hops are unsupported. + @item @option{sudo} @cindex method @option{sudo} @cindex @option{sudo} method diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index 1623a0341b2..12453d40acd 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -1,7 +1,8 @@ -;;; tramp-androidsu.el --- TRAMP method for Android superuser shells -*- lexical-binding:t -*- +;;; tramp-androidsu.el --- Tramp method for Android superuser shells -*- lexical-binding:t -*- ;; Copyright (C) 2024 Free Software Foundation, Inc. +;; Author: Po Lu ;; Keywords: comm, processes ;; Package: tramp @@ -22,12 +23,15 @@ ;;; Commentary: +;; `su' method implementation for Android. +;; ;; The `su' method struggles (as do other shell-based methods) with the ;; crippled versions of many Unix utilities installed on Android, ;; workarounds for which are implemented in the `adb' method. This ;; method defines a shell-based method that is identical in function to -;; `su', but reuses such code from the `adb' method where applicable and -;; also provides for certain mannerisms of popular Android `su' +;; and replaces if connecting to a local Android machine `su', but +;; reuses such code from the `adb' method where applicable and also +;; provides for certain mannerisms of popular Android `su' ;; implementations. ;;; Code: @@ -43,33 +47,51 @@ ;;;###tramp-autoload (defcustom tramp-androidsu-mount-global-namespace t "When non-nil, browse files from within the global mount namespace. -On systems that assign each application a unique view of the filesystem -by executing them within individual mount namespaces and thus conceal -each application's data directories from others, invoke `su' with the -option `-mm' in order for the shell launched to run within the global -mount namespace, so that TRAMP may edit files belonging to any and all -applications." +On systems that assign each application a unique view of the +filesystem by executing them within individual mount namespaces +and thus conceal each application's data directories from +others, invoke `su' with the option `-mm' in order for the shell +launched to run within the global mount namespace, so that Tramp +may edit files belonging to any and all applications." :group 'tramp :version "30.1" :type 'boolean) +;;;###tramp-autoload +(defcustom tramp-androidsu-remote-path '("/system/bin" + "/system/xbin") + "Directories in which to search for transfer programs and the like." + :group 'tramp + :version "30.1" + :type '(list string)) + (defvar tramp-androidsu-su-mm-supported 'unknown "Whether `su -mm' is supported on this system.") +;;;###tramp-autoload +(defconst tramp-androidsu-local-shell-name "/system/bin/sh" + "Name of the local shell on Android.") + +;;;###tramp-autoload +(defconst tramp-androidsu-local-tmp-directory "/data/local/tmp" + "Name of the local temporary directory on Android.") + ;;;###tramp-autoload (tramp--with-startup (add-to-list 'tramp-methods `(,tramp-androidsu-method - (tramp-login-program "su") - (tramp-login-args (("-") ("%u"))) - (tramp-remote-shell "/system/bin/sh") - (tramp-remote-shell-login ("-l")) - (tramp-remote-shell-args ("-c")) - (tramp-tmpdir "/data/local/tmp") - (tramp-connection-timeout 10))) - + (tramp-login-program "su") + (tramp-login-args (("-") ("%u"))) + (tramp-remote-shell ,tramp-androidsu-local-shell-name) + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-c")) + (tramp-tmpdir ,tramp-androidsu-local-tmp-directory) + (tramp-connection-timeout 10) + (tramp-shell-name ,tramp-androidsu-local-shell-name))) (add-to-list 'tramp-default-host-alist - `(,tramp-androidsu-method nil "localhost"))) + `(,tramp-androidsu-method nil "localhost")) + (add-to-list 'tramp-default-user-alist + `(,tramp-androidsu-method nil ,tramp-root-id-string))) (defvar android-use-exec-loader) ; androidfns.c. @@ -112,15 +134,14 @@ multibyte mode and waits for the shell prompt to appear." ;; there's no guarantee that it's ;; possible to execute it with ;; `android-use-exec-loader' off. - "/system/bin/sh" "-i")) + tramp-androidsu-local-shell-name "-i")) (user (tramp-file-name-user vec)) command) ;; Set sentinel. Initialize variables. (set-process-sentinel p #'tramp-process-sentinel) (tramp-post-process-creation p vec) ;; Replace `login-args' place holders. - (setq command (format "exec su - %s || exit" - (or user "root"))) + (setq command (format "exec su - %s || exit" user)) (tramp-set-connection-property vec "remote-namespace" nil) ;; Attempt to execute the shell inside the global mount ;; namespace if requested. @@ -142,7 +163,7 @@ multibyte mode and waits for the shell prompt to appear." (tramp-set-connection-property vec "remote-namespace" t) (setq command (format "exec su -mm - %s || exit" - (or user "root")))))) + user))))) ;; Send the command. (tramp-message vec 3 "Sending command `%s'" command) (tramp-adb-send-command vec command t t) @@ -154,7 +175,6 @@ multibyte mode and waits for the shell prompt to appear." (with-current-buffer (process-buffer p) (tramp-wait-for-regexp p tramp-connection-timeout "#[[:space:]]*$")) - ;; Set connection-local variables. (tramp-set-connection-local-variables vec) ;; Change prompt. @@ -167,7 +187,8 @@ multibyte mode and waits for the shell prompt to appear." ;; Dump option settings in the traces. (when (>= tramp-verbose 9) (tramp-adb-send-command vec "set -o")) - ;; Disable Unicode. + ;; Disable Unicode, for otherwise Unicode filenames will + ;; not be decoded correctly. (tramp-adb-send-command vec "set +U") ;; Disable echo expansion. (tramp-adb-send-command @@ -188,8 +209,7 @@ multibyte mode and waits for the shell prompt to appear." t))) ;; Set the remote PATH to a suitable value. (tramp-set-connection-property vec "remote-path" - '("/system/bin" - "/system/xbin")) + tramp-androidsu-remote-path) ;; Mark it as connected. (tramp-set-connection-property p "connected" t)))) ;; Cleanup, and propagate the signal. @@ -223,163 +243,49 @@ FUNCTION." (fset 'tramp-adb-wait-for-output tramp-adb-wait-for-output) (fset 'tramp-adb-maybe-open-connection tramp-adb-maybe-open-connection))))) -(defalias 'tramp-androidsu-handle-access-file - (tramp-androidsu-generate-wrapper #'tramp-handle-access-file)) - -(defalias 'tramp-androidsu-handle-add-name-to-file - (tramp-androidsu-generate-wrapper #'tramp-handle-add-name-to-file)) - -(defalias 'tramp-androidsu-handle-copy-directory - (tramp-androidsu-generate-wrapper #'tramp-handle-copy-directory)) - -(defalias 'tramp-androidsu-sh-handle-copy-file +(defalias 'tramp-androidsu-handle-copy-file (tramp-androidsu-generate-wrapper #'tramp-sh-handle-copy-file)) -(defalias 'tramp-androidsu-adb-handle-delete-directory +(defalias 'tramp-androidsu-handle-delete-directory (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-directory)) -(defalias 'tramp-androidsu-adb-handle-delete-file +(defalias 'tramp-androidsu-handle-delete-file (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-file)) -(defalias 'tramp-androidsu-handle-directory-file-name - (tramp-androidsu-generate-wrapper #'tramp-handle-directory-file-name)) - -(defalias 'tramp-androidsu-handle-directory-files - (tramp-androidsu-generate-wrapper #'tramp-handle-directory-files)) - -(defalias 'tramp-androidsu-adb-handle-directory-files-and-attributes +(defalias 'tramp-androidsu-handle-directory-files-and-attributes (tramp-androidsu-generate-wrapper #'tramp-adb-handle-directory-files-and-attributes)) -(defalias 'tramp-androidsu-handle-dired-uncache - (tramp-androidsu-generate-wrapper #'tramp-handle-dired-uncache)) - -(defalias 'tramp-androidsu-adb-handle-exec-path +(defalias 'tramp-androidsu-handle-exec-path (tramp-androidsu-generate-wrapper #'tramp-adb-handle-exec-path)) -(defalias 'tramp-androidsu-handle-expand-file-name - (tramp-androidsu-generate-wrapper #'tramp-handle-expand-file-name)) - -(defalias 'tramp-androidsu-handle-file-accessible-directory-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-accessible-directory-p)) - -(defalias 'tramp-androidsu-adb-handle-file-attributes +(defalias 'tramp-androidsu-handle-file-attributes (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-attributes)) -(defalias 'tramp-androidsu-handle-file-directory-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-directory-p)) - -(defalias 'tramp-androidsu-handle-file-equal-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-equal-p)) - -(defalias 'tramp-androidsu-adb-handle-file-executable-p +(defalias 'tramp-androidsu-handle-file-executable-p (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-executable-p)) -(defalias 'tramp-androidsu-adb-handle-file-exists-p +(defalias 'tramp-androidsu-handle-file-exists-p (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-exists-p)) -(defalias 'tramp-androidsu-handle-file-group-gid - (tramp-androidsu-generate-wrapper #'tramp-handle-file-group-gid)) - -(defalias 'tramp-androidsu-handle-file-in-directory-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-in-directory-p)) - -(defalias 'tramp-androidsu-sh-handle-file-local-copy +(defalias 'tramp-androidsu-handle-file-local-copy (tramp-androidsu-generate-wrapper #'tramp-sh-handle-file-local-copy)) -(defalias 'tramp-androidsu-handle-file-locked-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-locked-p)) - -(defalias 'tramp-androidsu-handle-file-modes - (tramp-androidsu-generate-wrapper #'tramp-handle-file-modes)) - -(defalias 'tramp-androidsu-adb-handle-file-name-all-completions +(defalias 'tramp-androidsu-handle-file-name-all-completions (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-name-all-completions)) -(defalias 'tramp-androidsu-handle-file-name-as-directory - (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-as-directory)) - -(defalias 'tramp-androidsu-handle-file-name-case-insensitive-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-case-insensitive-p)) - -(defalias 'tramp-androidsu-handle-file-name-completion - (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-completion)) - -(defalias 'tramp-androidsu-handle-file-name-directory - (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-directory)) - -(defalias 'tramp-androidsu-handle-file-name-nondirectory - (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-nondirectory)) - -(defalias 'tramp-androidsu-handle-file-newer-than-file-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-newer-than-file-p)) - -(defalias 'tramp-androidsu-handle-file-notify-add-watch - (tramp-androidsu-generate-wrapper #'tramp-handle-file-notify-add-watch)) - -(defalias 'tramp-androidsu-handle-file-notify-rm-watch - (tramp-androidsu-generate-wrapper #'tramp-handle-file-notify-rm-watch)) - -(defalias 'tramp-androidsu-handle-file-notify-valid-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-notify-valid-p)) - -(defalias 'tramp-androidsu-adb-handle-file-readable-p +(defalias 'tramp-androidsu-handle-file-readable-p (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-readable-p)) -(defalias 'tramp-androidsu-handle-file-regular-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-regular-p)) - -(defalias 'tramp-androidsu-handle-file-remote-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-remote-p)) - -(defalias 'tramp-androidsu-handle-file-selinux-context - (tramp-androidsu-generate-wrapper #'tramp-handle-file-selinux-context)) - -(defalias 'tramp-androidsu-handle-file-symlink-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-symlink-p)) - -(defalias 'tramp-androidsu-adb-handle-file-system-info +(defalias 'tramp-androidsu-handle-file-system-info (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-system-info)) -(defalias 'tramp-androidsu-handle-file-truename - (tramp-androidsu-generate-wrapper #'tramp-handle-file-truename)) - -(defalias 'tramp-androidsu-handle-file-user-uid - (tramp-androidsu-generate-wrapper #'tramp-handle-file-user-uid)) - -(defalias 'tramp-androidsu-adb-handle-file-writable-p +(defalias 'tramp-androidsu-handle-file-writable-p (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-writable-p)) -(defalias 'tramp-androidsu-handle-find-backup-file-name - (tramp-androidsu-generate-wrapper #'tramp-handle-find-backup-file-name)) - -(defalias 'tramp-androidsu-handle-insert-directory - (tramp-androidsu-generate-wrapper #'tramp-handle-insert-directory)) - -(defalias 'tramp-androidsu-handle-insert-file-contents - (tramp-androidsu-generate-wrapper #'tramp-handle-insert-file-contents)) - -(defalias 'tramp-androidsu-handle-list-system-processes - (tramp-androidsu-generate-wrapper #'tramp-handle-list-system-processes)) - -(defalias 'tramp-androidsu-handle-load - (tramp-androidsu-generate-wrapper #'tramp-handle-load)) - -(defalias 'tramp-androidsu-handle-lock-file - (tramp-androidsu-generate-wrapper #'tramp-handle-lock-file)) - -(defalias 'tramp-androidsu-handle-make-auto-save-file-name - (tramp-androidsu-generate-wrapper #'tramp-handle-make-auto-save-file-name)) - -(defalias 'tramp-androidsu-adb-handle-make-directory +(defalias 'tramp-androidsu-handle-make-directory (tramp-androidsu-generate-wrapper #'tramp-adb-handle-make-directory)) -(defalias 'tramp-androidsu-handle-make-lock-file-name - (tramp-androidsu-generate-wrapper #'tramp-handle-make-lock-file-name)) - -(defalias 'tramp-androidsu-handle-make-nearby-temp-file - (tramp-androidsu-generate-wrapper #'tramp-handle-make-nearby-temp-file)) - -(defun tramp-androidsu-make-process (&rest args) +(defun tramp-androidsu-handle-make-process (&rest args) "Like `tramp-handle-make-process', but modified for Android." (when args (with-parsed-tramp-file-name (expand-file-name default-directory) nil @@ -493,150 +399,123 @@ FUNCTION." (tramp-taint-remote-process-buffer stderr)) p))))) -(defalias 'tramp-androidsu-sh-handle-make-symbolic-link +(defalias 'tramp-androidsu-handle-make-symbolic-link (tramp-androidsu-generate-wrapper #'tramp-sh-handle-make-symbolic-link)) -(defalias 'tramp-androidsu-handle-memory-info - (tramp-androidsu-generate-wrapper #'tramp-handle-memory-info)) - -(defalias 'tramp-androidsu-handle-process-attributes - (tramp-androidsu-generate-wrapper #'tramp-handle-process-attributes)) - -(defalias 'tramp-androidsu-adb-handle-process-file +(defalias 'tramp-androidsu-handle-process-file (tramp-androidsu-generate-wrapper #'tramp-adb-handle-process-file)) -(defalias 'tramp-androidsu-sh-handle-rename-file +(defalias 'tramp-androidsu-handle-rename-file (tramp-androidsu-generate-wrapper #'tramp-sh-handle-rename-file)) -(defalias 'tramp-androidsu-adb-handle-set-file-modes +(defalias 'tramp-androidsu-handle-set-file-modes (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-modes)) -(defalias 'tramp-androidsu-adb-handle-set-file-times +(defalias 'tramp-androidsu-handle-set-file-times (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-times)) -(defalias 'tramp-androidsu-handle-set-visited-file-modtime - (tramp-androidsu-generate-wrapper #'tramp-handle-set-visited-file-modtime)) - -(defalias 'tramp-androidsu-handle-shell-command - (tramp-androidsu-generate-wrapper #'tramp-handle-shell-command)) - -(defalias 'tramp-androidsu-handle-start-file-process - (tramp-androidsu-generate-wrapper #'tramp-handle-start-file-process)) - -(defalias 'tramp-androidsu-handle-substitute-in-file-name - (tramp-androidsu-generate-wrapper #'tramp-handle-substitute-in-file-name)) - -(defalias 'tramp-androidsu-handle-temporary-file-directory - (tramp-androidsu-generate-wrapper #'tramp-handle-temporary-file-directory)) - -(defalias 'tramp-androidsu-adb-handle-get-remote-gid +(defalias 'tramp-androidsu-handle-get-remote-gid (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-gid)) -(defalias 'tramp-androidsu-adb-handle-get-remote-groups +(defalias 'tramp-androidsu-handle-get-remote-groups (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-groups)) -(defalias 'tramp-androidsu-adb-handle-get-remote-uid +(defalias 'tramp-androidsu-handle-get-remote-uid (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-uid)) -(defalias 'tramp-androidsu-handle-unlock-file - (tramp-androidsu-generate-wrapper #'tramp-handle-unlock-file)) - -(defalias 'tramp-androidsu-handle-verify-visited-file-modtime - (tramp-androidsu-generate-wrapper #'tramp-handle-verify-visited-file-modtime)) - -(defalias 'tramp-androidsu-sh-handle-write-region +(defalias 'tramp-androidsu-handle-write-region (tramp-androidsu-generate-wrapper #'tramp-sh-handle-write-region)) ;;;###tramp-autoload (defconst tramp-androidsu-file-name-handler-alist '(;; `abbreviate-file-name' performed by default handler. - (access-file . tramp-androidsu-handle-access-file) - (add-name-to-file . tramp-androidsu-handle-add-name-to-file) + (access-file . tramp-handle-access-file) + (add-name-to-file . tramp-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. - (copy-directory . tramp-androidsu-handle-copy-directory) - (copy-file . tramp-androidsu-sh-handle-copy-file) - (delete-directory . tramp-androidsu-adb-handle-delete-directory) - (delete-file . tramp-androidsu-adb-handle-delete-file) + (copy-directory . tramp-handle-copy-directory) + (copy-file . tramp-androidsu-handle-copy-file) + (delete-directory . tramp-androidsu-handle-delete-directory) + (delete-file . tramp-androidsu-handle-delete-file) ;; `diff-latest-backup-file' performed by default handler. - (directory-file-name . tramp-androidsu-handle-directory-file-name) - (directory-files . tramp-androidsu-handle-directory-files) + (directory-file-name . tramp-handle-directory-file-name) + (directory-files . tramp-handle-directory-files) (directory-files-and-attributes - . tramp-androidsu-adb-handle-directory-files-and-attributes) + . tramp-androidsu-handle-directory-files-and-attributes) (dired-compress-file . ignore) - (dired-uncache . tramp-androidsu-handle-dired-uncache) - (exec-path . tramp-androidsu-adb-handle-exec-path) - (expand-file-name . tramp-androidsu-handle-expand-file-name) - (file-accessible-directory-p . tramp-androidsu-handle-file-accessible-directory-p) + (dired-uncache . tramp-handle-dired-uncache) + (exec-path . tramp-androidsu-handle-exec-path) + (expand-file-name . tramp-handle-expand-file-name) + (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) (file-acl . ignore) - (file-attributes . tramp-androidsu-adb-handle-file-attributes) - (file-directory-p . tramp-androidsu-handle-file-directory-p) - (file-equal-p . tramp-androidsu-handle-file-equal-p) - (file-executable-p . tramp-androidsu-adb-handle-file-executable-p) - (file-exists-p . tramp-androidsu-adb-handle-file-exists-p) - (file-group-gid . tramp-androidsu-handle-file-group-gid) - (file-in-directory-p . tramp-androidsu-handle-file-in-directory-p) - (file-local-copy . tramp-androidsu-sh-handle-file-local-copy) - (file-locked-p . tramp-androidsu-handle-file-locked-p) - (file-modes . tramp-androidsu-handle-file-modes) - (file-name-all-completions . tramp-androidsu-adb-handle-file-name-all-completions) - (file-name-as-directory . tramp-androidsu-handle-file-name-as-directory) - (file-name-case-insensitive-p . tramp-androidsu-handle-file-name-case-insensitive-p) - (file-name-completion . tramp-androidsu-handle-file-name-completion) - (file-name-directory . tramp-androidsu-handle-file-name-directory) - (file-name-nondirectory . tramp-androidsu-handle-file-name-nondirectory) + (file-attributes . tramp-androidsu-handle-file-attributes) + (file-directory-p . tramp-handle-file-directory-p) + (file-equal-p . tramp-handle-file-equal-p) + (file-executable-p . tramp-androidsu-handle-file-executable-p) + (file-exists-p . tramp-androidsu-handle-file-exists-p) + (file-group-gid . tramp-handle-file-group-gid) + (file-in-directory-p . tramp-handle-file-in-directory-p) + (file-local-copy . tramp-androidsu-handle-file-local-copy) + (file-locked-p . tramp-handle-file-locked-p) + (file-modes . tramp-handle-file-modes) + (file-name-all-completions . tramp-androidsu-handle-file-name-all-completions) + (file-name-as-directory . tramp-handle-file-name-as-directory) + (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p) + (file-name-completion . tramp-handle-file-name-completion) + (file-name-directory . tramp-handle-file-name-directory) + (file-name-nondirectory . tramp-handle-file-name-nondirectory) ;; `file-name-sans-versions' performed by default handler. - (file-newer-than-file-p . tramp-androidsu-handle-file-newer-than-file-p) - (file-notify-add-watch . tramp-androidsu-handle-file-notify-add-watch) - (file-notify-rm-watch . tramp-androidsu-handle-file-notify-rm-watch) - (file-notify-valid-p . tramp-androidsu-handle-file-notify-valid-p) + (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) + (file-notify-add-watch . tramp-handle-file-notify-add-watch) + (file-notify-rm-watch . tramp-handle-file-notify-rm-watch) + (file-notify-valid-p . tramp-handle-file-notify-valid-p) (file-ownership-preserved-p . ignore) - (file-readable-p . tramp-androidsu-adb-handle-file-readable-p) - (file-regular-p . tramp-androidsu-handle-file-regular-p) - (file-remote-p . tramp-androidsu-handle-file-remote-p) - (file-selinux-context . tramp-androidsu-handle-file-selinux-context) - (file-symlink-p . tramp-androidsu-handle-file-symlink-p) - (file-system-info . tramp-androidsu-adb-handle-file-system-info) - (file-truename . tramp-androidsu-handle-file-truename) - (file-user-uid . tramp-androidsu-handle-file-user-uid) - (file-writable-p . tramp-androidsu-adb-handle-file-writable-p) - (find-backup-file-name . tramp-androidsu-handle-find-backup-file-name) + (file-readable-p . tramp-androidsu-handle-file-readable-p) + (file-regular-p . tramp-handle-file-regular-p) + (file-remote-p . tramp-handle-file-remote-p) + (file-selinux-context . tramp-handle-file-selinux-context) + (file-symlink-p . tramp-handle-file-symlink-p) + (file-system-info . tramp-androidsu-handle-file-system-info) + (file-truename . tramp-handle-file-truename) + (file-user-uid . tramp-handle-file-user-uid) + (file-writable-p . tramp-androidsu-handle-file-writable-p) + (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. - (insert-directory . tramp-androidsu-handle-insert-directory) - (insert-file-contents . tramp-androidsu-handle-insert-file-contents) - (list-system-processes . tramp-androidsu-handle-list-system-processes) - (load . tramp-androidsu-handle-load) - (lock-file . tramp-androidsu-handle-lock-file) - (make-auto-save-file-name . tramp-androidsu-handle-make-auto-save-file-name) - (make-directory . tramp-androidsu-adb-handle-make-directory) + (insert-directory . tramp-handle-insert-directory) + (insert-file-contents . tramp-handle-insert-file-contents) + (list-system-processes . tramp-handle-list-system-processes) + (load . tramp-handle-load) + (lock-file . tramp-handle-lock-file) + (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) + (make-directory . tramp-androidsu-handle-make-directory) (make-directory-internal . ignore) - (make-lock-file-name . tramp-androidsu-handle-make-lock-file-name) - (make-nearby-temp-file . tramp-androidsu-handle-make-nearby-temp-file) - (make-process . tramp-androidsu-make-process) - (make-symbolic-link . tramp-androidsu-sh-handle-make-symbolic-link) - (memory-info . tramp-androidsu-handle-memory-info) - (process-attributes . tramp-androidsu-handle-process-attributes) - (process-file . tramp-androidsu-adb-handle-process-file) - (rename-file . tramp-androidsu-sh-handle-rename-file) + (make-lock-file-name . tramp-handle-make-lock-file-name) + (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) + (make-process . tramp-androidsu-handle-make-process) + (make-symbolic-link . tramp-androidsu-handle-make-symbolic-link) + (memory-info . tramp-handle-memory-info) + (process-attributes . tramp-handle-process-attributes) + (process-file . tramp-androidsu-handle-process-file) + (rename-file . tramp-androidsu-handle-rename-file) (set-file-acl . ignore) - (set-file-modes . tramp-androidsu-adb-handle-set-file-modes) + (set-file-modes . tramp-androidsu-handle-set-file-modes) (set-file-selinux-context . ignore) - (set-file-times . tramp-androidsu-adb-handle-set-file-times) - (set-visited-file-modtime . tramp-androidsu-handle-set-visited-file-modtime) - (shell-command . tramp-androidsu-handle-shell-command) - (start-file-process . tramp-androidsu-handle-start-file-process) - (substitute-in-file-name . tramp-androidsu-handle-substitute-in-file-name) - (temporary-file-directory . tramp-androidsu-handle-temporary-file-directory) + (set-file-times . tramp-androidsu-handle-set-file-times) + (set-visited-file-modtime . tramp-handle-set-visited-file-modtime) + (shell-command . tramp-handle-shell-command) + (start-file-process . tramp-handle-start-file-process) + (substitute-in-file-name . tramp-handle-substitute-in-file-name) + (temporary-file-directory . tramp-handle-temporary-file-directory) (tramp-get-home-directory . ignore) - (tramp-get-remote-gid . tramp-androidsu-adb-handle-get-remote-gid) - (tramp-get-remote-groups . tramp-androidsu-adb-handle-get-remote-groups) - (tramp-get-remote-uid . tramp-androidsu-adb-handle-get-remote-uid) + (tramp-get-remote-gid . tramp-androidsu-handle-get-remote-gid) + (tramp-get-remote-groups . tramp-androidsu-handle-get-remote-groups) + (tramp-get-remote-uid . tramp-androidsu-handle-get-remote-uid) (tramp-set-file-uid-gid . ignore) (unhandled-file-name-directory . ignore) - (unlock-file . tramp-androidsu-handle-unlock-file) + (unlock-file . tramp-handle-unlock-file) (vc-registered . ignore) - (verify-visited-file-modtime . tramp-androidsu-handle-verify-visited-file-modtime) - (write-region . tramp-androidsu-sh-handle-write-region)) + (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) + (write-region . tramp-androidsu-handle-write-region)) "Alist of TRAMP handler functions for superuser sessions on Android.") ;; It must be a `defsubst' in order to push the whole code into @@ -669,7 +548,7 @@ arguments to pass to the OPERATION." (with-eval-after-load 'shell (connection-local-set-profiles - `(:application tramp :protocol ,tramp-adb-method) + `(:application tramp :protocol ,tramp-androidsu-method) 'tramp-adb-connection-local-default-shell-profile 'tramp-adb-connection-local-default-ps-profile)) -- cgit v1.2.3 From 2b5d43081a30f816dd38a16c7b5bfbad712a779b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 3 Mar 2024 23:08:16 -0500 Subject: (major-mode-remap(-defaults)): New var and function (bug#69191) While `major-mode-remap-alist` provides a way for users to indicate the major mode of their choice, we need a similar variable for the use of packages. This patch adds a new `major-mode-remap-defaults` and changes various packages to obey it or make use of it. I think it nicely cleans the regexp duplication between CC-mode and `c-ts-mode.el` and also makes it easier/cleaner for users to override the changes made by `*-ts-mode.el`. * lisp/files.el (major-mode-remap-defaults): New variable. (major-mode-remap): New function. (set-auto-mode-0): Use it. * doc/lispref/modes.texi (Auto Major Mode): Document them. * lisp/textmodes/tex-mode.el (tex--redirect-to-submode): Use `major-mode-remap`. (major-mode-remap-defaults): Set it to remap AUCTeX modes by default. * lisp/progmodes/ruby-ts-mode.el (auto-mode-alist): Leave it alone. (major-mode-remap-defaults): Set this one instead. * lisp/progmodes/c-ts-mode.el (c-or-c++-ts-mode): Use `major-mode-remap`. (auto-mode-alist): Leave it alone. (major-mode-remap-defaults): Set this one instead. * lisp/org/ox.el (org-export-to-buffer): Modernize docstring accordingly. * lisp/progmodes/cc-mode.el (c-or-c++-mode): * lisp/org/ox-latex.el (org-latex-export-as-latex): * lisp/org/ox-koma-letter.el (org-koma-letter-export-as-latex): * lisp/org/ox-beamer.el (org-beamer-export-as-latex): Use `major-mode-remap` when available. --- doc/lispref/modes.texi | 33 +++++++++++++++++++++++++++++++ etc/NEWS | 4 ++++ lisp/files.el | 19 +++++++++++++++--- lisp/org/ox-beamer.el | 5 ++++- lisp/org/ox-koma-letter.el | 4 +++- lisp/org/ox-latex.el | 5 ++++- lisp/org/ox.el | 2 +- lisp/progmodes/c-ts-mode.el | 44 +++++++++++++++++++----------------------- lisp/progmodes/cc-mode.el | 22 ++++++++++++--------- lisp/progmodes/go-ts-mode.el | 2 ++ lisp/progmodes/ruby-ts-mode.el | 14 ++------------ lisp/textmodes/tex-mode.el | 18 +++++++++++------ 12 files changed, 114 insertions(+), 58 deletions(-) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index a2e8f42cf1d..b034fecd77b 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -791,6 +791,39 @@ init file.) @end smallexample @end defvar +@defvar major-mode-remap-defaults +This variable contains an association list indicating which function +to call to activate a given major mode. This is used for file formats +that can be supported by various major modes, where this variable can be +used to indicate which alternative should be used by default. + +For example, a third-party package providing a much improved Pascal +major mode, can use the following to tell @code{normal-mode} to use +@code{spiffy-pascal-mode} for all the files that would normally use @code{pascal-mode}: + +@smallexample +@group +(add-to-list 'major-mode-remap-defaults '(pascal-mode . spiffy-pascal-mode)) +@end group +@end smallexample + +This variable has the same format as @code{major-mode-remap-alist}. +If both lists match a major mode, the entry in +@code{major-mode-remap-alist} takes precedence. +@end defvar + +@defun major-mode-remap mode +This function returns the major mode to use instead of @var{mode} +according to @code{major-mode-remap-alist} and +@code{major-mode-remap-defaults}. It returns @var{mode} if the mode +is not remapped by those variables. + +When a package wants to activate a major mode for a particular file +format, it should use this function, passing as @code{mode} argument the +canonical major mode for that file format, to find which specific major +mode to activate, so as to take into account the user's preferences. +@end defun + @node Mode Help @subsection Getting Help about a Major Mode @cindex mode help diff --git a/etc/NEWS b/etc/NEWS index 792e178c3b6..41bff184676 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1595,6 +1595,10 @@ values. * Lisp Changes in Emacs 30.1 +** New var 'major-mode-remap-defaults' and function 'major-mode-remap'. +The first is like Emacs-29's 'major-mode-remap-alist' but to be set by +packages (instead of users). The second looks up those two variables. + +++ ** Pcase's functions (in 'pred' and 'app') can specify the argument position. For example, instead of '(pred (< 5))' you can write '(pred (> _ 5))'. diff --git a/lisp/files.el b/lisp/files.el index ed18bc5841e..dd7580b6580 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3413,7 +3413,7 @@ checks if it uses an interpreter listed in `interpreter-mode-alist', matches the buffer beginning against `magic-mode-alist', compares the file name against the entries in `auto-mode-alist', then matches the buffer beginning against `magic-fallback-mode-alist'. -It also obeys `major-mode-remap-alist'. +It also obeys `major-mode-remap-alist' and `major-mode-remap-defaults'. If `enable-local-variables' is nil, or if the file name matches `inhibit-local-variables-regexps', this function does not check @@ -3559,9 +3559,22 @@ we don't actually set it to the same mode the buffer already has." Every entry is of the form (MODE . FUNCTION) which means that in order to activate the major mode MODE (specified via something like `auto-mode-alist', file-local variables, ...) we should actually call -FUNCTION instead." +FUNCTION instead. +FUNCTION can be nil to hide other entries (either in this var or in +`major-mode-remap-defaults') and means that we should call MODE." :type '(alist (symbol) (function))) +(defvar major-mode-remap-defaults nil + "Alist mapping file-specified mode to actual mode. +This works like `major-mode-remap-alist' except it has lower priority +and it is meant to be modified by packages rather than users.") + +(defun major-mode-remap (mode) + "Return the function to use to enable MODE." + (or (cdr (or (assq mode major-mode-remap-alist) + (assq mode major-mode-remap-defaults))) + mode)) + ;; When `keep-mode-if-same' is set, we are working on behalf of ;; set-visited-file-name. In that case, if the major mode specified is the ;; same one we already have, don't actually reset it. We don't want to lose @@ -3578,7 +3591,7 @@ same, do nothing and return nil." (eq mode (car set-auto-mode--last)) (eq major-mode (cdr set-auto-mode--last))))) (when mode - (funcall (alist-get mode major-mode-remap-alist mode)) + (funcall (major-mode-remap mode)) (unless (eq mode major-mode) (setq set-auto-mode--last (cons mode major-mode))) mode))) diff --git a/lisp/org/ox-beamer.el b/lisp/org/ox-beamer.el index 3d4d998432d..d3a90179d73 100644 --- a/lisp/org/ox-beamer.el +++ b/lisp/org/ox-beamer.el @@ -1008,7 +1008,10 @@ will be displayed when `org-export-show-temporary-export-buffer' is non-nil." (interactive) (org-export-to-buffer 'beamer "*Org BEAMER Export*" - async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) + async subtreep visible-only body-only ext-plist + (if (fboundp 'major-mode-remap) + (major-mode-remap 'latex-mode) + #'LaTeX-mode))) ;;;###autoload (defun org-beamer-export-to-latex diff --git a/lisp/org/ox-koma-letter.el b/lisp/org/ox-koma-letter.el index aef25232c20..38460d1749e 100644 --- a/lisp/org/ox-koma-letter.el +++ b/lisp/org/ox-koma-letter.el @@ -911,7 +911,9 @@ non-nil." (let (org-koma-letter-special-contents) (org-export-to-buffer 'koma-letter "*Org KOMA-LETTER Export*" async subtreep visible-only body-only ext-plist - (lambda () (LaTeX-mode))))) + (if (fboundp 'major-mode-remap) + (major-mode-remap 'latex-mode) + #'LaTeX-mode)))) ;;;###autoload (defun org-koma-letter-export-to-latex diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index bca387e5935..98b388081ea 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -4160,7 +4160,10 @@ will be displayed when `org-export-show-temporary-export-buffer' is non-nil." (interactive) (org-export-to-buffer 'latex "*Org LATEX Export*" - async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) + async subtreep visible-only body-only ext-plist + (if (fboundp 'major-mode-remap) + (major-mode-remap 'latex-mode) + #'LaTeX-mode))) ;;;###autoload (defun org-latex-convert-region-to-latex () diff --git a/lisp/org/ox.el b/lisp/org/ox.el index 19bf559c9e7..8e2fdd22acd 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -6608,7 +6608,7 @@ use it to set a major mode there, e.g., (interactive) (org-export-to-buffer \\='latex \"*Org LATEX Export*\" async subtreep visible-only body-only ext-plist - #\\='LaTeX-mode)) + (major-mode-remap 'latex-mode))) When expressed as an anonymous function, using `lambda', POST-PROCESS needs to be quoted. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 4ef17daf876..315bb68699e 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -1190,7 +1190,6 @@ BEG and END are described in `treesit-range-rules'." "C-c C-c" #'comment-region "C-c C-k" #'c-ts-mode-toggle-comment-style) -;;;###autoload (define-derived-mode c-ts-base-mode prog-mode "C" "Major mode for editing C, powered by tree-sitter. @@ -1439,36 +1438,33 @@ should be used. This function attempts to use file contents to determine whether the code is C or C++ and based on that chooses whether to enable `c-ts-mode' or `c++-ts-mode'." + (declare (obsolete c-or-c++-mode "30.1"))? (interactive) - (if (save-excursion - (save-restriction - (save-match-data ; Why `save-match-data'? - (widen) - (goto-char (point-min)) - (re-search-forward c-ts-mode--c-or-c++-regexp nil t)))) - (c++-ts-mode) - (c-ts-mode))) + (let ((mode + (if (save-excursion + (save-restriction + (save-match-data ; Why `save-match-data'? + (widen) + (goto-char (point-min)) + (re-search-forward c-ts-mode--c-or-c++-regexp nil t)))) + 'c++-ts-mode) + 'c-ts-mode)) + (funcall (major-mode-remap mode)))) + ;; The entries for C++ must come first to prevent *.c files be taken ;; as C++ on case-insensitive filesystems, since *.C files are C++, ;; not C. (if (treesit-ready-p 'cpp) - (add-to-list 'auto-mode-alist - '("\\(\\.ii\\|\\.\\(CC?\\|HH?\\)\\|\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\|\\.\\(cc\\|hh\\)\\)\\'" - . c++-ts-mode))) + (add-to-list 'major-mode-remap-defaults + '(c++-mode . c++-ts-mode))) (when (treesit-ready-p 'c) - (add-to-list 'auto-mode-alist - '("\\(\\.[chi]\\|\\.lex\\|\\.y\\(acc\\)?\\)\\'" . c-ts-mode)) - (add-to-list 'auto-mode-alist '("\\.x[pb]m\\'" . c-ts-mode)) - ;; image-mode's association must be before the C mode, otherwise XPM - ;; images will be initially visited as C files. Also note that the - ;; regexp must be different from what files.el does, or else - ;; add-to-list will not add the association where we want it. - (add-to-list 'auto-mode-alist '("\\.x[pb]m\\'" . image-mode))) - -(if (and (treesit-ready-p 'cpp) - (treesit-ready-p 'c)) - (add-to-list 'auto-mode-alist '("\\.h\\'" . c-or-c++-ts-mode))) + (add-to-list 'major-mode-remap-defaults '(c++-mode . c++-ts-mode)) + (add-to-list 'major-mode-remap-defaults '(c-mode . c-ts-mode))) + +(when (and (treesit-ready-p 'cpp) + (treesit-ready-p 'c)) + (add-to-list 'major-mode-remap-defaults '(c-or-c++-mode . c-or-c++-ts-mode))) (provide 'c-ts-mode) (provide 'c++-ts-mode) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 64a679eacc7..e46ac2e2178 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -2902,15 +2902,19 @@ This function attempts to use file contents to determine whether the code is C or C++ and based on that chooses whether to enable `c-mode' or `c++-mode'." (interactive) - (if (save-excursion - (save-restriction - (save-match-data - (widen) - (goto-char (point-min)) - (re-search-forward c-or-c++-mode--regexp - (+ (point) c-guess-region-max) t)))) - (c++-mode) - (c-mode))) + (let ((mode + (if (save-excursion + (save-restriction + (save-match-data + (widen) + (goto-char (point-min)) + (re-search-forward c-or-c++-mode--regexp + (+ (point) c-guess-region-max) t)))) + 'c++-mode) + 'c-mode)) + (funcall (if (fboundp 'major-mode-remap) + (major-mode-remap mode) + mode)))) ;; Support for C++ diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index 65adc1c55ea..296e4d0037d 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -262,6 +262,8 @@ (treesit-major-mode-setup))) (if (treesit-ready-p 'go) + ;; FIXME: Should we instead put `go-mode' in `auto-mode-alist' + ;; and then use `major-mode-remap-defaults' to map it to `go-ts-mode'? (add-to-list 'auto-mode-alist '("\\.go\\'" . go-ts-mode))) (defun go-ts-mode--defun-name (node &optional skip-prefix) diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 426ae248cac..cdfa3dca498 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -1211,18 +1211,8 @@ leading double colon is not added." (setq-local syntax-propertize-function #'ruby-ts--syntax-propertize)) (if (treesit-ready-p 'ruby) - ;; Copied from ruby-mode.el. - (add-to-list 'auto-mode-alist - (cons (concat "\\(?:\\.\\(?:" - "rbw?\\|ru\\|rake\\|thor" - "\\|jbuilder\\|rabl\\|gemspec\\|podspec" - "\\)" - "\\|/" - "\\(?:Gem\\|Rake\\|Cap\\|Thor" - "\\|Puppet\\|Berks\\|Brew" - "\\|Vagrant\\|Guard\\|Pod\\)file" - "\\)\\'") - 'ruby-ts-mode))) + (add-to-list 'major-mode-remap-defaults + '(ruby-mode . ruby-ts-mode))) (provide 'ruby-ts-mode) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 616b8871090..02ee1242c72 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1036,14 +1036,20 @@ says which mode to use." ;; `tex--guess-mode' really tries to guess the *type* of file, ;; so we still need to consult `major-mode-remap-alist' ;; to see which mode to use for that type. - (alist-get mode major-mode-remap-alist mode)))))) + (major-mode-remap mode)))))) -;; The following three autoloaded aliases appear to conflict with -;; AUCTeX. We keep those confusing aliases for those users who may -;; have files annotated with -*- LaTeX -*- (e.g. because they received +;; Support files annotated with -*- LaTeX -*- (e.g. because they received ;; them from someone using AUCTeX). -;; FIXME: Turn them into autoloads so that AUCTeX can override them -;; with its own autoloads? Or maybe rely on `major-mode-remap-alist'? +;;;###autoload (add-to-list 'major-mode-remap-defaults '(TeX-mode . tex-mode)) +;;;###autoload (add-to-list 'major-mode-remap-defaults '(plain-TeX-mode . plain-tex-mode)) +;;;###autoload (add-to-list 'major-mode-remap-defaults '(LaTeX-mode . latex-mode)) + +;; FIXME: These aliases conflict with AUCTeX, but we still need them +;; because of packages out there which call these functions directly. +;; They should be patched to use `major-mode-remap'. +;; It would be nice to mark them obsolete somehow to encourage using +;; something else, but the obsolete declaration would become invalid +;; and confusing when AUCTeX *is* installed. ;;;###autoload (defalias 'TeX-mode #'tex-mode) ;;;###autoload (defalias 'plain-TeX-mode #'plain-tex-mode) ;;;###autoload (defalias 'LaTeX-mode #'latex-mode) -- cgit v1.2.3 From 6dacb60bb135dbb002c2ce1c70f70430c5d1bbff Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Mon, 4 Mar 2024 07:19:22 +0100 Subject: ; Fix last major-mode-remap-defaults change. --- lisp/org/ox.el | 2 +- lisp/progmodes/c-ts-mode.el | 6 +++--- lisp/progmodes/cc-mode.el | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/org/ox.el b/lisp/org/ox.el index 8e2fdd22acd..bf2d9b569af 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -6608,7 +6608,7 @@ use it to set a major mode there, e.g., (interactive) (org-export-to-buffer \\='latex \"*Org LATEX Export*\" async subtreep visible-only body-only ext-plist - (major-mode-remap 'latex-mode))) + (major-mode-remap \\='latex-mode))) When expressed as an anonymous function, using `lambda', POST-PROCESS needs to be quoted. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 315bb68699e..38b72e59388 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -1438,7 +1438,7 @@ should be used. This function attempts to use file contents to determine whether the code is C or C++ and based on that chooses whether to enable `c-ts-mode' or `c++-ts-mode'." - (declare (obsolete c-or-c++-mode "30.1"))? + (declare (obsolete c-or-c++-mode "30.1")) (interactive) (let ((mode (if (save-excursion @@ -1447,8 +1447,8 @@ the code is C or C++ and based on that chooses whether to enable (widen) (goto-char (point-min)) (re-search-forward c-ts-mode--c-or-c++-regexp nil t)))) - 'c++-ts-mode) - 'c-ts-mode)) + 'c++-ts-mode + 'c-ts-mode))) (funcall (major-mode-remap mode)))) ;; The entries for C++ must come first to prevent *.c files be taken diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index e46ac2e2178..1a9d0907bd0 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -2910,8 +2910,8 @@ the code is C or C++ and based on that chooses whether to enable (goto-char (point-min)) (re-search-forward c-or-c++-mode--regexp (+ (point) c-guess-region-max) t)))) - 'c++-mode) - 'c-mode)) + 'c++-mode + 'c-mode))) (funcall (if (fboundp 'major-mode-remap) (major-mode-remap mode) mode)))) -- cgit v1.2.3 From 912e37b811107768e0cb3bc95184177f817dbdb2 Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Mon, 4 Mar 2024 10:33:49 +0100 Subject: Fix 'set-window-configuration' and 'window-state-put' Fix some bugs with 'window-state-put' (Bug#69093). Add new hook 'window-kept-windows-functions' (Bug#68235). * doc/lispref/windows.texi (Window Configurations): Mention 'window-kept-windows-functions'. (Window Hooks): Describe new abnormal hook 'window-kept-windows-functions'. * src/marker.c (Fmarker_last_position): New function to return the last position of a marker even if its buffer is now dead. * src/window.c (Fset_window_configuration): If 'window-kept-windows-functions' is non-nil, do not delete any window whose buffer is now dead but remember all such windows in a list to pass to 'window-kept-windows-functions'. Run 'window-kept-windows-functions' if it is non-nil. (Vwindow_kept_windows_functions): New abnormal hook run by Fset_window_configuration and 'window-state-put' with two arguments - the frame whose configuration is restored and a list of entries for each window whose buffer was found dead during restoration. Each entry is a list of four elements, the window, the dead buffer, and the last know positions of the start and point of that window. * lisp/window.el (window-state-put-kept-windows) (window-state-put-selected-window): New variables. (window--state-put-2): Make sure buffer is live before restoring its state. Set 'window-state-put-selected-window' to state's selected window. If 'window-kept-windows-functions' is non-nil, do not delete any windows whose buffer is found dead but remember all such windows in a list to pass to 'window-kept-windows-functions'. (window-state-put): Run 'window-kept-windows-functions' if it is non-nil. Select window recorded in 'window-state-put-selected-window'. --- doc/lispref/windows.texi | 40 +++++++++++++++++++++++++-- lisp/window.el | 65 +++++++++++++++++++++++++++++++++++++++----- src/marker.c | 13 +++++++++ src/window.c | 71 ++++++++++++++++++++++++++++++++++++++++++++---- 4 files changed, 173 insertions(+), 16 deletions(-) diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index f14e74bc785..fe3dc573df5 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -6266,9 +6266,13 @@ this function does is to restore the value of the variable If the buffer of a window of @var{configuration} has been killed since @var{configuration} was made, that window is, as a rule, removed from -the restored configuration. However, if that window is the last -window remaining in the restored configuration, another live buffer is -shown in it. +the restored configuration. However, if that window is the last window +remaining in the restored configuration, another live buffer is shown in +it. Also, if the variable @var{window-kept-windows-functions} is +non-@code{nil}, any window whose buffer is now dead is not deleted. +Rather, this function will show another live buffer in that window and +include an entry for that window when calling any function in +@var{window-kept-windows-functions} (@pxref{Window Hooks}). Here is a way of using this function to get the same effect as @code{save-window-excursion}: @@ -6357,6 +6361,15 @@ a live window, it is replaced by a new live window created on the same frame before putting @var{state} into it. If @var{window} is @code{nil}, it puts the window state into a new window. +If the buffer of any window recorded in @var{state} has been killed +since @var{state} was made, that window is, as a rule, not restored. +However, if that window is the only window in @var{state}, another live +buffer will be shown in it. Also, if the variable +@var{window-kept-windows-functions} is non-@code{nil}, any window whose +buffer is now dead is restored. This function will show another live +buffer in it and include an entry for that window when calling a +function in @var{window-kept-windows-functions} (@pxref{Window Hooks}). + If the optional argument @var{ignore} is non-@code{nil}, it means to ignore minimum window sizes and fixed-size restrictions. If @var{ignore} is @code{safe}, this means windows can get as small as one line @@ -6623,6 +6636,27 @@ Lock fontification function, which will be called whenever parts of a buffer are (re)fontified because a window was scrolled or its size changed. @xref{Other Font Lock Variables}. +@cindex window kept windows functions +@defvar window-kept-windows-functions + This variable holds a list of functions that Emacs will call after +restoring a window configuration via @code{set-window-configuration} or +state via @code{window-state-put} (@pxref{Window Configurations}). When +the value of this variable is non-@code{nil}, these functions will not +delete any window whose buffer has been killed since the corresponding +configuration or state was saved, but show some live buffer in it. + +The value should be a list of functions that take two arguments. The +first argument specifies the frame whose windows have been restored. +The second argument specifies a list of entries for each window whose +buffer has been found dead at the time @code{set-window-configuration} +or @code{window-state-put} tried to restore it. Each entry is a list of +four values - the window whose buffer was found dead, the dead buffer, +and the last known positions of start and point of the buffer in that +window. Any function run by this hook should check that the window is +live since another function run by this hook may have deleted it in the +meantime. +@end defvar + @cindex window change functions The remainder of this section covers six hooks that are called during redisplay provided a significant, non-scrolling change of a diff --git a/lisp/window.el b/lisp/window.el index 6df20353b5e..29336f573f8 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -6174,6 +6174,12 @@ value can be also stored on disk and read back in a new session." (defvar window-state-put-stale-windows nil "Helper variable for `window-state-put'.") +(defvar window-state-put-kept-windows nil + "Helper variable for `window-state-put'.") + +(defvar window-state-put-selected-window nil + "Helper variable for `window-state-put'.") + (defun window--state-put-1 (state &optional window ignore totals pixelwise) "Helper function for `window-state-put'." (let ((type (car state))) @@ -6278,9 +6284,10 @@ value can be also stored on disk and read back in a new session." (set-window-parameter window (car parameter) (cdr parameter)))) ;; Process buffer related state. (when state - (let ((buffer (get-buffer (car state))) - (state (cdr state))) - (if buffer + (let* ((old-buffer-or-name (car state)) + (buffer (get-buffer old-buffer-or-name)) + (state (cdr state))) + (if (buffer-live-p buffer) (with-current-buffer buffer (set-window-buffer window buffer) (set-window-hscroll window (cdr (assq 'hscroll state))) @@ -6348,7 +6355,18 @@ value can be also stored on disk and read back in a new session." (set-window-point window (cdr (assq 'point state)))) ;; Select window if it's the selected one. (when (cdr (assq 'selected state)) - (select-window window)) + ;; This used to call 'select-window' which, however, + ;; can be partially undone because the current buffer + ;; may subsequently change twice: When leaving the + ;; present 'with-current-buffer' and when leaving the + ;; containing 'with-temp-buffer' form (Bug#69093). + ;; 'window-state-put-selected-window' should now work + ;; around that bug but we leave this 'select-window' + ;; in since some code run before the part that fixed + ;; it might still refer to this window as the selected + ;; one. + (select-window window) + (setq window-state-put-selected-window window)) (set-window-next-buffers window (delq nil (mapcar (lambda (buffer) @@ -6375,7 +6393,20 @@ value can be also stored on disk and read back in a new session." ;; save the window with the intention of deleting it later ;; if possible. (switch-to-prev-buffer window) - (push window window-state-put-stale-windows))))))) + (if window-kept-windows-functions + (let* ((start (cdr (assq 'start state))) + ;; Handle both - marker positions from writable + ;; states and markers from non-writable states. + (start-pos (if (markerp start) + (marker-last-position start) + start)) + (point (cdr (assq 'point state))) + (point-pos (if (markerp point) + (marker-last-position point) + point))) + (push (list window old-buffer-or-name start-pos point-pos) + window-state-put-kept-windows)) + (push window window-state-put-stale-windows)))))))) (defun window-state-put (state &optional window ignore) "Put window state STATE into WINDOW. @@ -6388,8 +6419,20 @@ If WINDOW is nil, create a new window before putting STATE into it. Optional argument IGNORE non-nil means ignore minimum window sizes and fixed size restrictions. IGNORE equal `safe' means windows can get as small as `window-safe-min-height' and -`window-safe-min-width'." +`window-safe-min-width'. + +If the abnormal hook `window-kept-windows-functions' is non-nil, +do not delete any windows saved by STATE whose buffers were +deleted since STATE was saved. Rather, show some live buffer in +them and call the functions in `window-kept-windows-functions' +with a list of two arguments: the frame where STATE was put and a +list of entries for each such window. Each entry contains four +elements - the window, its old buffer and the last positions of +`window-start' and `window-point' for the buffer in that window. +Always check the window for liveness because another function run +by this hook may have deleted it." (setq window-state-put-stale-windows nil) + (setq window-state-put-kept-windows nil) ;; When WINDOW is internal or nil, reduce it to a live one, ;; then create a new window on the same frame to put STATE into. @@ -6482,6 +6525,7 @@ windows can get as small as `window-safe-min-height' and (error "Window %s too small to accommodate state" window) (setq state (cdr state)) (setq window-state-put-list nil) + (setq window-state-put-selected-window nil) ;; Work on the windows of a temporary buffer to make sure that ;; splitting proceeds regardless of any buffer local values of ;; `window-size-fixed'. Release that buffer after the buffers of @@ -6490,14 +6534,21 @@ windows can get as small as `window-safe-min-height' and (set-window-buffer window (current-buffer)) (window--state-put-1 state window nil totals pixelwise) (window--state-put-2 ignore pixelwise)) + (when (window-live-p window-state-put-selected-window) + (select-window window-state-put-selected-window)) (while window-state-put-stale-windows (let ((window (pop window-state-put-stale-windows))) - ;; Avoid that 'window-deletable-p' throws an error if window + ;; Avoid that 'window-deletable-p' throws an error if window ;; was already deleted when exiting 'with-temp-buffer' above ;; (Bug#54028). (when (and (window-valid-p window) (eq (window-deletable-p window) t)) (delete-window window)))) + (when window-kept-windows-functions + (run-hook-with-args + 'window-kept-windows-functions + frame window-state-put-kept-windows) + (setq window-state-put-kept-windows nil)) (window--check frame)))) (defun window-state-buffers (state) diff --git a/src/marker.c b/src/marker.c index 1559dd52719..2abc951fc76 100644 --- a/src/marker.c +++ b/src/marker.c @@ -463,6 +463,18 @@ DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0, return Qnil; } +DEFUN ("marker-last-position", Fmarker_last_position, Smarker_last_position, 1, 1, 0, + doc: /* Return last position of MARKER in its buffer. +This is like `marker-position' with one exception: If the buffer of +MARKER is dead, it returns the last position of MARKER in that buffer +before it was killed. */) + (Lisp_Object marker) +{ + CHECK_MARKER (marker); + + return make_fixnum (XMARKER (marker)->charpos); +} + /* Change M so it points to B at CHARPOS and BYTEPOS. */ static void @@ -830,6 +842,7 @@ void syms_of_marker (void) { defsubr (&Smarker_position); + defsubr (&Smarker_last_position); defsubr (&Smarker_buffer); defsubr (&Sset_marker); defsubr (&Scopy_marker); diff --git a/src/window.c b/src/window.c index 0c84b4f4bf3..ea761fad8bc 100644 --- a/src/window.c +++ b/src/window.c @@ -7109,6 +7109,24 @@ current at the start of the function. If DONT-SET-MINIWINDOW is non-nil, the mini-window of the frame doesn't get set to the corresponding element of CONFIGURATION. +Normally, this function will try to delete any dead window in +CONFIGURATION whose buffer has been deleted since CONFIGURATION was +made. However, if the abnormal hook `window-kept-windows-functions' is +non-nil, it will preserve such a window in the restored layout and show +another buffer in it. + +After restoring the frame layout, this function runs the abnormal hook +`window-kept-windows-functions' with two arguments - the frame whose +layout it has restored and a list of entries for each window whose +buffer has been found dead when it tried to restore CONFIGURATION: Each +entry is a list of four elements where +`window' denotes the window whose buffer was found dead, `buffer' +denotes the dead buffer, and `start' and `point' denote the last known +positions of `window-start' and `window-point' of the buffer in that +window. Any function run by this hook should check such a window for +liveness because another function run by this hook may have deleted it +in the meantime." + If CONFIGURATION was made from a frame that is now deleted, only frame-independent values can be restored. In this case, the return value is nil. Otherwise the value is t. */) @@ -7119,6 +7137,7 @@ the return value is nil. Otherwise the value is t. */) struct Lisp_Vector *saved_windows; Lisp_Object new_current_buffer; Lisp_Object frame; + Lisp_Object kept_windows = Qnil; Lisp_Object old_frame = selected_frame; struct frame *f; ptrdiff_t old_point = -1; @@ -7359,6 +7378,11 @@ the return value is nil. Otherwise the value is t. */) BUF_PT (XBUFFER (w->contents)), BUF_PT_BYTE (XBUFFER (w->contents))); w->start_at_line_beg = true; + if (!NILP (Vwindow_kept_windows_functions)) + kept_windows = Fcons (list4 (window, p->buffer, + Fmarker_last_position (p->start), + Fmarker_last_position (p->pointm)), + kept_windows); } else if (!NILP (w->start)) /* Leaf window has no live buffer, get one. */ @@ -7379,6 +7403,11 @@ the return value is nil. Otherwise the value is t. */) dead_windows = Fcons (window, dead_windows); /* Make sure window is no more dedicated. */ wset_dedicated (w, Qnil); + if (!NILP (Vwindow_kept_windows_functions)) + kept_windows = Fcons (list4 (window, p->buffer, + Fmarker_last_position (p->start), + Fmarker_last_position (p->pointm)), + kept_windows); } } @@ -7430,12 +7459,13 @@ the return value is nil. Otherwise the value is t. */) unblock_input (); /* Scan dead buffer windows. */ - for (; CONSP (dead_windows); dead_windows = XCDR (dead_windows)) - { - window = XCAR (dead_windows); - if (WINDOW_LIVE_P (window) && !EQ (window, FRAME_ROOT_WINDOW (f))) - delete_deletable_window (window); - } + if (!NILP (Vwindow_kept_windows_functions)) + for (; CONSP (dead_windows); dead_windows = XCDR (dead_windows)) + { + window = XCAR (dead_windows); + if (WINDOW_LIVE_P (window) && !EQ (window, FRAME_ROOT_WINDOW (f))) + delete_deletable_window (window); + } /* Record the selected window's buffer here. The window should already be the selected one from the call above. */ @@ -7482,6 +7512,11 @@ the return value is nil. Otherwise the value is t. */) minibuf_selected_window = data->minibuf_selected_window; SAFE_FREE (); + + if (!NILP (Vrun_hooks) && !NILP (Vwindow_kept_windows_functions)) + run_hook_with_args_2 (Qwindow_kept_windows_functions, frame, + kept_windows); + return FRAME_LIVE_P (f) ? Qt : Qnil; } @@ -8479,6 +8514,8 @@ syms_of_window (void) DEFSYM (Qheader_line_format, "header-line-format"); DEFSYM (Qtab_line_format, "tab-line-format"); DEFSYM (Qno_other_window, "no-other-window"); + DEFSYM (Qwindow_kept_windows_functions, + "window-kept-windows-functions"); DEFVAR_LISP ("temp-buffer-show-function", Vtemp_buffer_show_function, doc: /* Non-nil means call as function to display a help buffer. @@ -8636,6 +8673,28 @@ its buffer or its total or body size since the last redisplay. Each call is performed with the frame temporarily selected. */); Vwindow_configuration_change_hook = Qnil; + DEFVAR_LISP ("window-kept-windows-functions", + Vwindow_kept_windows_functions, + doc: /* Functions run after restoring a window configuration or state. +These functions are called by `set-window-configuration' and +`window-state-put'. When the value of this variable is non-nil, these +functions restore any window whose buffer has been deleted since the +corresponding configuration or state was saved. Rather than deleting +such a window, `set-window-configuration' and `window-state-put' show +some live buffer in it. + +The value should be a list of functions that take two arguments. The +first argument specifies the frame whose configuration has been +restored. The second argument, if non-nil, specifies a list of entries +for each window whose buffer has been found dead at the time +'set-window-configuration' or `window-state-put' tried to restore it in +that window. Each entry is a list of four values - the window whose +buffer was found dead, the dead buffer, and the positions of start and +point of the buffer in that window. Note that the window may be already +dead since another function on this list may have deleted it in the +meantime. */); + Vwindow_kept_windows_functions = Qnil; + DEFVAR_LISP ("recenter-redisplay", Vrecenter_redisplay, doc: /* Non-nil means `recenter' redraws entire frame. If this option is non-nil, then the `recenter' command with a nil -- cgit v1.2.3 From 0df3dc3d46fe7848aabb3ca5ff7085ca59799f43 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 4 Mar 2024 14:59:27 +0200 Subject: Avoid crashes due to base-less indirect buffer * src/buffer.c (Fkill_buffer): Prevent killing a buffer if its indirect buffer refuses to be killed. (Bug#69529) --- src/buffer.c | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/buffer.c b/src/buffer.c index 126f3eb055a..9f55a8813fa 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1971,8 +1971,16 @@ cleaning up all windows currently displaying the buffer to be killed. */) Lisp_Object tail, other; FOR_EACH_LIVE_BUFFER (tail, other) - if (XBUFFER (other)->base_buffer == b) - Fkill_buffer (other); + { + struct buffer *obuf = XBUFFER (other); + if (obuf->base_buffer == b) + { + Fkill_buffer (other); + if (BUFFER_LIVE_P (obuf)) + error ("Unable to kill buffer whose indirect buffer `%s' cannot be killed", + SDATA (BVAR (obuf, name))); + } + } /* Exit if we now have killed the base buffer (Bug#11665). */ if (!BUFFER_LIVE_P (b)) -- cgit v1.2.3 From 3b7cb55e5bec692fc1055e0b70a95afb4fac107f Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Tue, 27 Feb 2024 12:31:57 +0100 Subject: ; * etc/NEWS: add missing definite article --- etc/NEWS | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 41bff184676..06856602ea8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1964,8 +1964,8 @@ Example: "Uses c:\remote\dir\files and the key \C-x." ...) -where the docstring contains four control characters 'CR', 'DEL', 'FF' -and 'C-x'. +where the docstring contains the four control characters 'CR', 'DEL', +'FF' and 'C-x'. The warning name is 'docstrings-control-chars'. -- cgit v1.2.3 From 2c2a15bd171ecbf87fdac4405c7ea5f567fcf38a Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 3 Mar 2024 15:55:30 +0100 Subject: ; * lisp/vc/diff-mode.el (diff--refine-hunk): Escape literal `+`. --- lisp/vc/diff-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 99ac50c155a..ac7d55c8a46 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2353,7 +2353,7 @@ by `diff-refine-hunk'." (match-end 0) 'diff-refine-removed)) (goto-char middle) - (while (re-search-forward "^\\(?:+.*\n\\)+" end t) + (while (re-search-forward "^\\(?:\\+.*\n\\)+" end t) (diff--refine-propertize (match-beginning 0) (match-end 0) 'diff-refine-added)))))) -- cgit v1.2.3 From b9e8474a4470f71c30a4b89651fd3c5f2ef92ba2 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 4 Mar 2024 10:44:19 +0100 Subject: Repair miscompilation of single-arg `apply` (bug#69533) * lisp/emacs-lisp/byte-opt.el (byte-optimize-apply): Don't optimise single-argument `apply`; it's a legacy construct. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases): Add test case. --- lisp/emacs-lisp/byte-opt.el | 3 ++- test/lisp/emacs-lisp/bytecomp-tests.el | 3 +++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index add13a5c312..f75be3f71ad 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1448,7 +1448,8 @@ See Info node `(elisp) Integer Basics'." (defun byte-optimize-apply (form) (let ((len (length form))) - (if (>= len 2) + ;; Single-arg `apply' is an abomination that we don't bother optimizing. + (if (> len 2) (let ((fn (nth 1 form)) (last (nth (1- len) form))) (cond diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 8ccac492141..26408e8685a 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -800,6 +800,9 @@ inner loops respectively." ;; Aristotelian identity optimization (let ((x (bytecomp-test-identity 1))) (list (eq x x) (eql x x) (equal x x))) + + ;; Legacy single-arg `apply' call + (apply '(* 2 3)) ) "List of expressions for cross-testing interpreted and compiled code.") -- cgit v1.2.3 From 11ffb4656d768b09e1f7dfacc091d85eef4a403a Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 4 Mar 2024 14:14:05 +0100 Subject: Revert "Replace XSETSYMBOL with make_lisp_symbol" This reverts commit de6b1e1efb1a36c69e7a6e09297e1de5b1477121. While it did simplify code, there aren't much in the way of technical benefits the change at this time, and there were protest against the unwarranted style change. --- src/alloc.c | 12 ++++++++---- src/buffer.c | 4 ++-- src/data.c | 33 +++++++++++++++++++-------------- src/eval.c | 2 +- src/lisp.h | 1 + 5 files changed, 31 insertions(+), 21 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 16257469aa6..2ffd2415447 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3960,7 +3960,7 @@ Its value is void, and its function definition and property list are nil. */) if (symbol_free_list) { ASAN_UNPOISON_SYMBOL (symbol_free_list); - val = make_lisp_symbol (symbol_free_list); + XSETSYMBOL (val, symbol_free_list); symbol_free_list = symbol_free_list->u.s.next; } else @@ -3976,7 +3976,7 @@ Its value is void, and its function definition and property list are nil. */) } ASAN_UNPOISON_SYMBOL (&symbol_block->symbols[symbol_block_index]); - val = make_lisp_symbol (&symbol_block->symbols[symbol_block_index]); + XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]); symbol_block_index++; } @@ -7398,8 +7398,12 @@ process_mark_stack (ptrdiff_t base_sp) mark_stack_push_value (SYMBOL_VAL (ptr)); break; case SYMBOL_VARALIAS: - mark_stack_push_value (make_lisp_symbol (SYMBOL_ALIAS (ptr))); - break; + { + Lisp_Object tem; + XSETSYMBOL (tem, SYMBOL_ALIAS (ptr)); + mark_stack_push_value (tem); + break; + } case SYMBOL_LOCALIZED: { struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (ptr); diff --git a/src/buffer.c b/src/buffer.c index 9f55a8813fa..43a9249528c 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1340,7 +1340,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer) case SYMBOL_LOCALIZED: { /* Look in local_var_alist. */ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); - variable = make_lisp_symbol (sym); /* Update In case of aliasing. */ + XSETSYMBOL (variable, sym); /* Update In case of aliasing. */ result = assq_no_quit (variable, BVAR (buf, local_var_alist)); if (!NILP (result)) { @@ -4985,7 +4985,7 @@ defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring, sym->u.s.declared_special = true; sym->u.s.redirect = SYMBOL_FORWARDED; SET_SYMBOL_FWD (sym, bo_fwd); - PER_BUFFER_SYMBOL (offset) = make_lisp_symbol (sym); + XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym); if (PER_BUFFER_IDX (offset) == 0) /* Did a DEFVAR_PER_BUFFER without initializing the corresponding diff --git a/src/data.c b/src/data.c index c87b5317618..df08eaf8102 100644 --- a/src/data.c +++ b/src/data.c @@ -1256,7 +1256,7 @@ If OBJECT is not a symbol, just return it. */) struct Lisp_Symbol *sym = XSYMBOL (object); while (sym->u.s.redirect == SYMBOL_VARALIAS) sym = SYMBOL_ALIAS (sym); - object = make_lisp_symbol (sym); + XSETSYMBOL (object, sym); } return object; } @@ -1506,9 +1506,12 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_ if (blv->fwd.fwdptr) set_blv_value (blv, do_symval_forwarding (blv->fwd)); /* Choose the new binding. */ - tem1 = assq_no_quit (make_lisp_symbol (symbol), - BVAR (current_buffer, local_var_alist)); - set_blv_where (blv, Fcurrent_buffer ()); + { + Lisp_Object var; + XSETSYMBOL (var, symbol); + tem1 = assq_no_quit (var, BVAR (current_buffer, local_var_alist)); + set_blv_where (blv, Fcurrent_buffer ()); + } if (!(blv->found = !NILP (tem1))) tem1 = blv->defcell; @@ -1652,8 +1655,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, set_blv_value (blv, do_symval_forwarding (blv->fwd)); /* Find the new binding. */ - /* May have changed via aliasing. */ - symbol = make_lisp_symbol (sym); + XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */ Lisp_Object tem1 = assq_no_quit (symbol, BVAR (XBUFFER (where), local_var_alist)); @@ -2057,10 +2059,13 @@ make_blv (struct Lisp_Symbol *sym, bool forwarded, union Lisp_Val_Fwd valcontents) { struct Lisp_Buffer_Local_Value *blv = xmalloc (sizeof *blv); - Lisp_Object tem = Fcons (make_lisp_symbol (sym), - forwarded - ? do_symval_forwarding (valcontents.fwd) - : valcontents.value); + Lisp_Object symbol; + Lisp_Object tem; + + XSETSYMBOL (symbol, sym); + tem = Fcons (symbol, (forwarded + ? do_symval_forwarding (valcontents.fwd) + : valcontents.value)); /* Buffer_Local_Values cannot have as realval a buffer-local or keyboard-local forwarding. */ @@ -2216,7 +2221,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) } /* Make sure this buffer has its own value of symbol. */ - variable = make_lisp_symbol (sym); /* Update in case of aliasing. */ + XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ tem = assq_no_quit (variable, BVAR (current_buffer, local_var_alist)); if (NILP (tem)) { @@ -2296,7 +2301,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) notify_variable_watchers (variable, Qnil, Qmakunbound, Fcurrent_buffer ()); /* Get rid of this buffer's alist element, if any. */ - variable = make_lisp_symbol (sym); /* Propagate variable indirection. */ + XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ tem = assq_no_quit (variable, BVAR (current_buffer, local_var_alist)); if (!NILP (tem)) bset_local_var_alist @@ -2341,7 +2346,7 @@ Also see `buffer-local-boundp'.*/) Lisp_Object tmp; struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); XSETBUFFER (tmp, buf); - variable = make_lisp_symbol (sym); /* Update in case of aliasing. */ + XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ if (EQ (blv->where, tmp)) /* The binding is already loaded. */ return blv_found (blv) ? Qt : Qnil; @@ -2391,7 +2396,7 @@ value in BUFFER, or if VARIABLE is automatically buffer-local (see struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); if (blv->local_if_set) return Qt; - variable = make_lisp_symbol (sym); /* Update in case of aliasing. */ + XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ return Flocal_variable_p (variable, buffer); } case SYMBOL_FORWARDED: diff --git a/src/eval.c b/src/eval.c index 9d3b98eb359..95eb21909d2 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3475,7 +3475,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) switch (sym->u.s.redirect) { case SYMBOL_VARALIAS: - sym = SYMBOL_ALIAS (sym); symbol = make_lisp_symbol (sym); goto start; + sym = SYMBOL_ALIAS (sym); XSETSYMBOL (symbol, sym); goto start; case SYMBOL_PLAINVAL: /* The most common case is that of a non-constant symbol with a trivial value. Make that as fast as we can. */ diff --git a/src/lisp.h b/src/lisp.h index 4fc44745211..f353e4956eb 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1380,6 +1380,7 @@ make_lisp_ptr (void *ptr, enum Lisp_Type type) #define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons)) #define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike)) #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String)) +#define XSETSYMBOL(a, b) ((a) = make_lisp_symbol (b)) #define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float)) /* Return a Lisp_Object value that does not correspond to any object. -- cgit v1.2.3 From 5b49a38d1b37707bbbc8c069ed20ce7cd18fb2ac Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 4 Mar 2024 15:44:24 +0100 Subject: tramp-androidsu.el code cleanup * lisp/net/tramp-androidsu.el (tramp-androidsu-generate-wrapper): Prefer #' notation for function names. (tramp-androidsu-handle-copy-file) (tramp-androidsu-handle-file-local-copy) (tramp-androidsu-handle-make-symbolic-link) (tramp-androidsu-handle-rename-file) (tramp-androidsu-handle-write-region): Don't use a wrapper. (tramp-adb-connection-local-default-ps-profile): Don't initialize, this happens in tramp-db.el. --- lisp/net/tramp-androidsu.el | 36 ++++++++++++++++-------------------- 1 file changed, 16 insertions(+), 20 deletions(-) diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index 12453d40acd..c7fb67d4081 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -232,19 +232,19 @@ FUNCTION." ;; tramp-adb-wait-for-output addresses problems introduced ;; by the adb utility itself, not Android utilities, so ;; replace it with the regular TRAMP function. - (fset 'tramp-adb-wait-for-output #'tramp-wait-for-output) + (fset #'tramp-adb-wait-for-output #'tramp-wait-for-output) ;; Likewise, except some special treatment is necessary on ;; account of flaws in Android's su implementation. - (fset 'tramp-adb-maybe-open-connection + (fset #'tramp-adb-maybe-open-connection #'tramp-androidsu-maybe-open-connection) (apply function args)) ;; Restore the original definitions of the functions overridden ;; above. - (fset 'tramp-adb-wait-for-output tramp-adb-wait-for-output) - (fset 'tramp-adb-maybe-open-connection tramp-adb-maybe-open-connection))))) + (fset #'tramp-adb-wait-for-output tramp-adb-wait-for-output) + (fset #'tramp-adb-maybe-open-connection + tramp-adb-maybe-open-connection))))) -(defalias 'tramp-androidsu-handle-copy-file - (tramp-androidsu-generate-wrapper #'tramp-sh-handle-copy-file)) +(defalias 'tramp-androidsu-handle-copy-file #'tramp-sh-handle-copy-file) (defalias 'tramp-androidsu-handle-delete-directory (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-directory)) @@ -253,7 +253,8 @@ FUNCTION." (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-file)) (defalias 'tramp-androidsu-handle-directory-files-and-attributes - (tramp-androidsu-generate-wrapper #'tramp-adb-handle-directory-files-and-attributes)) + (tramp-androidsu-generate-wrapper + #'tramp-adb-handle-directory-files-and-attributes)) (defalias 'tramp-androidsu-handle-exec-path (tramp-androidsu-generate-wrapper #'tramp-adb-handle-exec-path)) @@ -268,10 +269,11 @@ FUNCTION." (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-exists-p)) (defalias 'tramp-androidsu-handle-file-local-copy - (tramp-androidsu-generate-wrapper #'tramp-sh-handle-file-local-copy)) + #'tramp-sh-handle-file-local-copy) (defalias 'tramp-androidsu-handle-file-name-all-completions - (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-name-all-completions)) + (tramp-androidsu-generate-wrapper + #'tramp-adb-handle-file-name-all-completions)) (defalias 'tramp-androidsu-handle-file-readable-p (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-readable-p)) @@ -400,14 +402,12 @@ FUNCTION." p))))) (defalias 'tramp-androidsu-handle-make-symbolic-link - (tramp-androidsu-generate-wrapper - #'tramp-sh-handle-make-symbolic-link)) + #'tramp-sh-handle-make-symbolic-link) (defalias 'tramp-androidsu-handle-process-file (tramp-androidsu-generate-wrapper #'tramp-adb-handle-process-file)) -(defalias 'tramp-androidsu-handle-rename-file - (tramp-androidsu-generate-wrapper #'tramp-sh-handle-rename-file)) +(defalias 'tramp-androidsu-handle-rename-file #'tramp-sh-handle-rename-file) (defalias 'tramp-androidsu-handle-set-file-modes (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-modes)) @@ -424,8 +424,7 @@ FUNCTION." (defalias 'tramp-androidsu-handle-get-remote-uid (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-uid)) -(defalias 'tramp-androidsu-handle-write-region - (tramp-androidsu-generate-wrapper #'tramp-sh-handle-write-region)) +(defalias 'tramp-androidsu-handle-write-region #'tramp-sh-handle-write-region) ;;;###tramp-autoload (defconst tramp-androidsu-file-name-handler-alist @@ -458,7 +457,8 @@ FUNCTION." (file-local-copy . tramp-androidsu-handle-file-local-copy) (file-locked-p . tramp-handle-file-locked-p) (file-modes . tramp-handle-file-modes) - (file-name-all-completions . tramp-androidsu-handle-file-name-all-completions) + (file-name-all-completions + . tramp-androidsu-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p) (file-name-completion . tramp-handle-file-name-completion) @@ -542,10 +542,6 @@ arguments to pass to the OPERATION." (tramp-register-foreign-file-name-handler #'tramp-androidsu-file-name-p #'tramp-androidsu-file-name-handler)) -(connection-local-set-profile-variables - 'tramp-adb-connection-local-default-ps-profile - tramp-adb-connection-local-default-ps-variables) - (with-eval-after-load 'shell (connection-local-set-profiles `(:application tramp :protocol ,tramp-androidsu-method) -- cgit v1.2.3 From 6e801077ae88e72dbad32015a083602062c4efe3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 4 Mar 2024 17:09:29 +0200 Subject: ; * src/composite.c (composition_compute_stop_pos): Add comment. --- src/composite.c | 26 +++++++++++++++++++++----- 1 file changed, 21 insertions(+), 5 deletions(-) diff --git a/src/composite.c b/src/composite.c index a9b037f4a4a..84cea8bcad6 100644 --- a/src/composite.c +++ b/src/composite.c @@ -1153,12 +1153,12 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, } else if (charpos > endpos) { - /* Search backward for a pattern that may be composed and the - position of (possibly) the last character of the match is + /* Search backward for a pattern that may be composed such that + the position of (possibly) the last character of the match is closest to (but not after) START. The reason for the last - character is that set_iterator_to_next works in reverse order, - and thus we must stop at the last character for composition - check. */ + character is that set_iterator_to_next works in reverse + order, and thus we must stop at the last character for + composition check. */ unsigned char *p; int len; /* Limit byte position used in fast_looking_at. This is the @@ -1171,6 +1171,22 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, p = SDATA (string) + bytepos; c = string_char_and_length (p, &len); limit = bytepos + len; + /* The algorithmic idea behind the loop below is somewhat tricky + and subtle. Keep in mind that any arbitrarily long sequence + of composable characters can potentially be composed to end + at or before START. So the fact that we find a character C + before START that can be composed with several following + characters does not mean we can exit the loop, because some + character before C could also be composed, yielding a longer + composed sequence which ends closer to START. And since a + composition can be arbitrarily long, it is very important to + know where to stop the search back, because the default -- + BEGV -- could be VERY far away. Since searching back is only + needed when delivering bidirectional text reordered for + display, and since no character composition can ever cross + into another embedding level, the search could end when it + gets to the end of the current embedding level, but this + limit should be imposed by the caller. */ while (char_composable_p (c)) { val = CHAR_TABLE_REF (Vcomposition_function_table, c); -- cgit v1.2.3 From 94632c611e6ba5607a1039a8939d5ab173ee5bfb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 4 Mar 2024 11:19:08 -0500 Subject: Revert "Update some native comp tests" This reverts commit 4a0d430bdc3650ca3dfd8bdd14781764fbcbdc7e. AFAICT that commit was made to accomodate regressions introduced in the new `cl-preloaded.el` code and these have been fixed. --- test/lisp/emacs-lisp/comp-cstr-tests.el | 2 +- test/src/comp-tests.el | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el b/test/lisp/emacs-lisp/comp-cstr-tests.el index 955a99ced57..991ab1f40eb 100644 --- a/test/lisp/emacs-lisp/comp-cstr-tests.el +++ b/test/lisp/emacs-lisp/comp-cstr-tests.el @@ -196,7 +196,7 @@ The arg is an alist of: type specifier -> expected type specifier." ;; 74 ((and boolean (or number marker)) . nil) ;; 75 - ((and atom (or number marker)) . (or integer-or-marker number-or-marker)) + ((and atom (or number marker)) . number-or-marker) ;; 76 ((and symbol (or number marker)) . nil) ;; 77 diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 67d632823b2..fbcb6ca9560 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -1029,7 +1029,7 @@ Return a list of results." (if (= x y) x 'foo)) - '(or (member foo) number-or-marker integer-or-marker)) + '(or (member foo) number-or-marker)) ;; 14 ((defun comp-tests-ret-type-spec-f (x) @@ -1169,7 +1169,7 @@ Return a list of results." ((defun comp-tests-ret-type-spec-f (x) (when (> x 1.0) x)) - '(or null number-or-marker integer-or-marker)) + '(or null number-or-marker)) ;; 36 ((defun comp-tests-ret-type-spec-f (x y) -- cgit v1.2.3 From 167c17c1ad740b35ed1c875b57817784655851d9 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 4 Mar 2024 12:02:45 -0500 Subject: admin/syncdoc-type-hierarchy.el: Move from `etc` AFAICT `admin` is where we keep these kinds of files. --- admin/syncdoc-type-hierarchy.el | 86 +++++++++++++++++++++++++++++++++++++++++ etc/syncdoc-type-hierarchy.el | 86 ----------------------------------------- 2 files changed, 86 insertions(+), 86 deletions(-) create mode 100644 admin/syncdoc-type-hierarchy.el delete mode 100644 etc/syncdoc-type-hierarchy.el diff --git a/admin/syncdoc-type-hierarchy.el b/admin/syncdoc-type-hierarchy.el new file mode 100644 index 00000000000..b3dfe63406a --- /dev/null +++ b/admin/syncdoc-type-hierarchy.el @@ -0,0 +1,86 @@ +;;; syncdoc-type-hierarchy.el--- -*- lexical-binding: t -*- + +;; Copyright (C) 2023-2024 Free Software Foundation, Inc. + +;; Author: Andrea Corallo +;; Keywords: documentation + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This file is used to keep the type hierarchy representation present +;; in the elisp manual in sync with the current type hierarchy. This +;; is specified in `cl--type-hierarchy' in cl-preloaded.el, so each +;; time `cl--type-hierarchy' is modified +;; `syncdoc-update-type-hierarchy' must be run before the +;; documentation is regenerated. + +;; We do not call this directly from make docs in order not to add a +;; dependency on the tool "dot". + +;;; Code: + +(require 'cl-lib) +(require 'org-table) + +(defconst syncdoc-lispref-dir (concat (file-name-directory + (or load-file-name + buffer-file-name)) + "../doc/lispref/")) + +(defun syncdoc-insert-dot-content (rankdir) + (maphash (lambda (child parents) + (cl-loop for parent in parents + do (insert " \"" (symbol-name child) "\" -> \"" + (symbol-name parent) "\";\n"))) + cl--direct-supertypes-of-type) + (sort-lines nil (point-min) (point-max)) + + (goto-char (point-min)) + (insert "digraph {\n rankdir=\"" rankdir "\";\n") + (goto-char (point-max)) + (insert "}\n")) + +(defun syncdoc-make-type-table (file) + (with-temp-file file + (insert "|Type| Derived Types|\n|-\n") + (cl-loop for (type . children) in cl--type-hierarchy + do (insert "|" (symbol-name type) " |") + do (cl-loop with x = 0 + for child in children + for child-len = (length (symbol-name child)) + when (> (+ x child-len 2) 60) + do (progn + (insert "|\n||") + (setq x 0)) + do (insert (symbol-name child) " ") + do (cl-incf x (1+ child-len)) ) + do (insert "\n")) + (org-table-align))) + +(defun syncdoc-update-type-hierarchy () + "Update the type hierarchy representation used by the elisp manual." + (interactive) + (with-temp-buffer + (syncdoc-insert-dot-content "LR") + (call-process-region nil nil "dot" t (current-buffer) nil "-Tjpg" "-o" + (expand-file-name "type_hierarchy.jpg" + syncdoc-lispref-dir))) + (syncdoc-make-type-table (expand-file-name "type_hierarchy.txt" + syncdoc-lispref-dir))) + +;;; syncdoc-type-hierarchy.el ends here diff --git a/etc/syncdoc-type-hierarchy.el b/etc/syncdoc-type-hierarchy.el deleted file mode 100644 index b3dfe63406a..00000000000 --- a/etc/syncdoc-type-hierarchy.el +++ /dev/null @@ -1,86 +0,0 @@ -;;; syncdoc-type-hierarchy.el--- -*- lexical-binding: t -*- - -;; Copyright (C) 2023-2024 Free Software Foundation, Inc. - -;; Author: Andrea Corallo -;; Keywords: documentation - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This file is used to keep the type hierarchy representation present -;; in the elisp manual in sync with the current type hierarchy. This -;; is specified in `cl--type-hierarchy' in cl-preloaded.el, so each -;; time `cl--type-hierarchy' is modified -;; `syncdoc-update-type-hierarchy' must be run before the -;; documentation is regenerated. - -;; We do not call this directly from make docs in order not to add a -;; dependency on the tool "dot". - -;;; Code: - -(require 'cl-lib) -(require 'org-table) - -(defconst syncdoc-lispref-dir (concat (file-name-directory - (or load-file-name - buffer-file-name)) - "../doc/lispref/")) - -(defun syncdoc-insert-dot-content (rankdir) - (maphash (lambda (child parents) - (cl-loop for parent in parents - do (insert " \"" (symbol-name child) "\" -> \"" - (symbol-name parent) "\";\n"))) - cl--direct-supertypes-of-type) - (sort-lines nil (point-min) (point-max)) - - (goto-char (point-min)) - (insert "digraph {\n rankdir=\"" rankdir "\";\n") - (goto-char (point-max)) - (insert "}\n")) - -(defun syncdoc-make-type-table (file) - (with-temp-file file - (insert "|Type| Derived Types|\n|-\n") - (cl-loop for (type . children) in cl--type-hierarchy - do (insert "|" (symbol-name type) " |") - do (cl-loop with x = 0 - for child in children - for child-len = (length (symbol-name child)) - when (> (+ x child-len 2) 60) - do (progn - (insert "|\n||") - (setq x 0)) - do (insert (symbol-name child) " ") - do (cl-incf x (1+ child-len)) ) - do (insert "\n")) - (org-table-align))) - -(defun syncdoc-update-type-hierarchy () - "Update the type hierarchy representation used by the elisp manual." - (interactive) - (with-temp-buffer - (syncdoc-insert-dot-content "LR") - (call-process-region nil nil "dot" t (current-buffer) nil "-Tjpg" "-o" - (expand-file-name "type_hierarchy.jpg" - syncdoc-lispref-dir))) - (syncdoc-make-type-table (expand-file-name "type_hierarchy.txt" - syncdoc-lispref-dir))) - -;;; syncdoc-type-hierarchy.el ends here -- cgit v1.2.3 From b06916cb218b133a4ebc9d7fa87b370fc2c2ed02 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 4 Mar 2024 13:24:34 -0500 Subject: syncdoc-type-hierarchy.el: Adjust to changes in `cl-preloaded.el` * admin/syncdoc-type-hierarchy.el (syncdoc-lispref-dir): Use `macroexp-file-name`. (syncdoc-hierarchy): New var. (syncdoc-insert-dot-content, syncdoc-make-type-table): Use it. (syncdoc-update-type-hierarchy): Don't crash if `dot` is absent. --- admin/syncdoc-type-hierarchy.el | 83 ++++++++++++++++++++++++++++++----------- 1 file changed, 61 insertions(+), 22 deletions(-) diff --git a/admin/syncdoc-type-hierarchy.el b/admin/syncdoc-type-hierarchy.el index b3dfe63406a..cb4df63a312 100644 --- a/admin/syncdoc-type-hierarchy.el +++ b/admin/syncdoc-type-hierarchy.el @@ -24,8 +24,8 @@ ;; This file is used to keep the type hierarchy representation present ;; in the elisp manual in sync with the current type hierarchy. This -;; is specified in `cl--type-hierarchy' in cl-preloaded.el, so each -;; time `cl--type-hierarchy' is modified +;; is specified in `cl--direct-supertypes-of-type' in cl-preloaded.el, so each +;; time `cl--direct-supertypes-of-type' is modified ;; `syncdoc-update-type-hierarchy' must be run before the ;; documentation is regenerated. @@ -37,17 +37,49 @@ (require 'cl-lib) (require 'org-table) -(defconst syncdoc-lispref-dir (concat (file-name-directory - (or load-file-name - buffer-file-name)) - "../doc/lispref/")) +(defconst syncdoc-lispref-dir + (expand-file-name "../doc/lispref/" + (file-name-directory + (or (macroexp-file-name) + buffer-file-name)))) + +(defconst syncdoc-hierarchy + (let ((ht (copy-hash-table cl--direct-supertypes-of-type))) + ;; Include info about "representative" other structure types, + ;; to illustrate how they fit. + (mapc #'require '(kmacro eieio-base elisp-mode frameset transient)) + (let ((extra-types '(advice kmacro cl-structure-object cl-structure-class + eieio-default-superclass eieio-named transient-infix + xref-elisp-location frameset-register)) + (seen ())) + (while extra-types + (let* ((type (pop extra-types)) + (class (get type 'cl--class)) + (parents (cl--class-parents class))) + (unless (member type seen) + (push type seen) + (push (type-of class) extra-types) + (puthash type (cond + (parents + (let ((ps (mapcar #'cl--class-name parents))) + (setq extra-types (append ps extra-types)) + ps)) + ;; EIEIO's parents don't mention the default. + ((and (eq (type-of class) 'eieio--class) + (not (eq type 'eieio-default-superclass))) + '(eieio-default-superclass)) + ;; OClosures can still be lists :-( + ((eq 'oclosure type) '(t)) + (t '(atom))) + ht))))) + ht)) (defun syncdoc-insert-dot-content (rankdir) (maphash (lambda (child parents) (cl-loop for parent in parents do (insert " \"" (symbol-name child) "\" -> \"" (symbol-name parent) "\";\n"))) - cl--direct-supertypes-of-type) + syncdoc-hierarchy) (sort-lines nil (point-min) (point-max)) (goto-char (point-min)) @@ -58,18 +90,24 @@ (defun syncdoc-make-type-table (file) (with-temp-file file (insert "|Type| Derived Types|\n|-\n") - (cl-loop for (type . children) in cl--type-hierarchy - do (insert "|" (symbol-name type) " |") - do (cl-loop with x = 0 - for child in children - for child-len = (length (symbol-name child)) - when (> (+ x child-len 2) 60) - do (progn - (insert "|\n||") - (setq x 0)) - do (insert (symbol-name child) " ") - do (cl-incf x (1+ child-len)) ) - do (insert "\n")) + (let ((subtypes ())) + ;; First collect info from the "builtin" types. + (maphash (lambda (type parents) + (dolist (parent parents) + (push type (alist-get parent subtypes)))) + syncdoc-hierarchy) + (cl-loop for (type . children) in (reverse subtypes) + do (insert "|" (symbol-name type) " |") + do (cl-loop with x = 0 + for child in (reverse children) + for child-len = (length (symbol-name child)) + when (> (+ x child-len 2) 60) + do (progn + (insert "|\n||") + (setq x 0)) + do (insert (symbol-name child) " ") + do (cl-incf x (1+ child-len)) ) + do (insert "\n"))) (org-table-align))) (defun syncdoc-update-type-hierarchy () @@ -77,9 +115,10 @@ (interactive) (with-temp-buffer (syncdoc-insert-dot-content "LR") - (call-process-region nil nil "dot" t (current-buffer) nil "-Tjpg" "-o" - (expand-file-name "type_hierarchy.jpg" - syncdoc-lispref-dir))) + (with-demoted-errors "%S" ;In case "dot" is not found! + (call-process-region nil nil "dot" t (current-buffer) nil "-Tjpg" "-o" + (expand-file-name "type_hierarchy.jpg" + syncdoc-lispref-dir)))) (syncdoc-make-type-table (expand-file-name "type_hierarchy.txt" syncdoc-lispref-dir))) -- cgit v1.2.3 From 1a35eb86b8cb75ce390525dd3394a52376b622a6 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 5 Mar 2024 11:23:27 +0800 Subject: Rearrange Android splash screen messages * lisp/startup.el (fancy-startup-tail, fancy-startup-screen) (normal-splash-screen): Adjust for function renaming; move the storage permissions notice to the top of the splash screen. * lisp/term/android-win.el (android-after-splash-screen): Rename from android-before-splash-screen and adjust layout lightly. * src/android.c (android_wc_lookup_string): Terminate character composition after a character is returned, whether it contain a Unicode character or not. --- lisp/startup.el | 19 ++++++++----------- lisp/term/android-win.el | 14 +++++++------- src/android.c | 4 ++++ 3 files changed, 19 insertions(+), 18 deletions(-) diff --git a/lisp/startup.el b/lisp/startup.el index 33e1124b998..357a4154e4c 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -2040,10 +2040,6 @@ a face or button specification." (call-interactively 'recover-session))) " to recover the files you were editing.")))) - ;; Insert the permissions notice if the user has yet to grant Emacs - ;; storage permissions. - (when (fboundp 'android-after-splash-screen) - (funcall 'android-after-splash-screen t)) (when concise (fancy-splash-insert :face 'variable-pitch "\n" @@ -2096,6 +2092,10 @@ splash screen in another window." (make-local-variable 'startup-screen-inhibit-startup-screen) (if pure-space-overflow (insert pure-space-overflow-message)) + ;; Insert the permissions notice if the user has yet to grant Emacs + ;; storage permissions. + (when (fboundp 'android-before-splash-screen) + (funcall 'android-before-splash-screen t)) (unless concise (fancy-splash-head)) (dolist (text fancy-startup-text) @@ -2202,7 +2202,10 @@ splash screen in another window." (if pure-space-overflow (insert pure-space-overflow-message)) - + ;; Insert the permissions notice if the user has yet to grant + ;; Emacs storage permissions. + (when (fboundp 'android-before-splash-screen) + (funcall 'android-before-splash-screen nil)) ;; The convention for this piece of code is that ;; each piece of output starts with one or two newlines ;; and does not end with any newlines. @@ -2244,12 +2247,6 @@ splash screen in another window." (insert "\n\nIf an Emacs session crashed recently, " "type M-x recover-session RET\nto recover" " the files you were editing.\n")) - - ;; Insert the permissions notice if the user has yet to grant - ;; Emacs storage permissions. - (when (fboundp 'android-after-splash-screen) - (funcall 'android-after-splash-screen nil)) - (use-local-map splash-screen-keymap) ;; Display the input that we set up in the buffer. diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index b7b0920626e..1d10402b15d 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -398,7 +398,7 @@ directory /content/storage. (inhibit-read-only t)) (fill-region (point-min) (point-max)))))))) -(defun android-after-splash-screen (fancy-p) +(defun android-before-splash-screen (fancy-p) "Insert a brief notice on the absence of storage permissions. If storage permissions are as yet denied to Emacs, insert a short notice to that effect, followed by a button that enables the user @@ -412,14 +412,14 @@ screen display; see `fancy-splash-insert'." (fancy-splash-insert :face '(variable-pitch font-lock-function-call-face) - "\nPermissions necessary to access external storage directories have -been denied. Click " + "Permissions necessary to access external storage directories have" + "\nbeen denied. Click " :link '("here" android-display-storage-permission-popup) - " to grant them.") + " to grant them.\n") (insert - "\nPermissions necessary to access external storage directories have been -denied. ") - (insert-button "Click here to grant them." + "Permissions necessary to access external storage directories" + "\nhave been denied. ") + (insert-button "Click here to grant them.\n" 'action #'android-display-storage-permission-popup 'follow-link t) (newline)))) diff --git a/src/android.c b/src/android.c index eb6981093be..5b3fbb25373 100644 --- a/src/android.c +++ b/src/android.c @@ -5533,6 +5533,10 @@ android_wc_lookup_string (android_key_pressed_event *event, rc = 0; } + /* Terminate any ongoing character composition after a key is + registered. */ + if (compose_status) + compose_status->chars_matched = 0; *status_return = status; return rc; } -- cgit v1.2.3 From 418ad866bf846a6a3328d91df28c958be75337be Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 4 Mar 2024 23:12:29 -0500 Subject: cl-preloaded.el: Further fine-tuning * lisp/emacs-lisp/cl-preloaded.el (cl--direct-supertypes-of-type): Fix some left over issues: - Remove redundant `number-or-marker` from `marker`s parents. - Add `function` to the types, since it was missing. (cl--typeof-types): Add a warning for missing type info. * admin/syncdoc-type-hierarchy.el (syncdoc-hierarchy): Fix parent of `oclosure`. * doc/lispref/type_hierarchy.txt: * doc/lispref/type_hierarchy.jpg: Update. --- admin/syncdoc-type-hierarchy.el | 2 +- doc/lispref/type_hierarchy.jpg | Bin 223501 -> 237291 bytes doc/lispref/type_hierarchy.txt | 49 ++++++++++++++++++++++------------------ lisp/emacs-lisp/cl-preloaded.el | 21 ++++++++++++++--- 4 files changed, 46 insertions(+), 26 deletions(-) diff --git a/admin/syncdoc-type-hierarchy.el b/admin/syncdoc-type-hierarchy.el index cb4df63a312..6448369625b 100644 --- a/admin/syncdoc-type-hierarchy.el +++ b/admin/syncdoc-type-hierarchy.el @@ -69,7 +69,7 @@ (not (eq type 'eieio-default-superclass))) '(eieio-default-superclass)) ;; OClosures can still be lists :-( - ((eq 'oclosure type) '(t)) + ((eq 'oclosure type) '(function)) (t '(atom))) ht))))) ht)) diff --git a/doc/lispref/type_hierarchy.jpg b/doc/lispref/type_hierarchy.jpg index b7eba7d1cf7..6b9be985817 100644 Binary files a/doc/lispref/type_hierarchy.jpg and b/doc/lispref/type_hierarchy.jpg differ diff --git a/doc/lispref/type_hierarchy.txt b/doc/lispref/type_hierarchy.txt index c74bc45635b..6827bbbc580 100644 --- a/doc/lispref/type_hierarchy.txt +++ b/doc/lispref/type_hierarchy.txt @@ -1,22 +1,27 @@ -| Type | Derived Types | -|-------------------+----------------------------------------------------------| -| t | sequence atom | -| sequence | list array | -| atom | class structure tree-sitter-compiled-query | -| | tree-sitter-node tree-sitter-parser user-ptr font-object | -| | font-entity font-spec condvar mutex thread terminal | -| | hash-table frame buffer function window process | -| | window-configuration overlay integer-or-marker | -| | number-or-marker symbol array obarray | -| number | float integer | -| number-or-marker | marker number | -| integer | bignum fixnum | -| symbol | keyword boolean symbol-with-pos | -| array | vector bool-vector char-table string | -| list | null cons | -| integer-or-marker | integer marker | -| compiled-function | byte-code-function | -| function | subr module-function compiled-function | -| boolean | null | -| subr | subr-native-elisp subr-primitive | -| symbol-with-pos | keyword | +| Type | Derived Types | +|--------------------------+------------------------------------------------------------| +| t | sequence atom | +| sequence | list array | +| atom | array function tree-sitter-compiled-query tree-sitter-node | +| | tree-sitter-parser user-ptr font-object font-entity | +| | font-spec condvar mutex thread terminal hash-table frame | +| | buffer window process window-configuration overlay | +| | number-or-marker symbol obarray native-comp-unit | +| | cl-structure-object eieio-default-superclass | +| number | float integer | +| integer-or-marker | integer marker | +| number-or-marker | integer-or-marker number | +| integer | bignum fixnum | +| symbol | keyword boolean symbol-with-pos | +| array | vector bool-vector char-table string | +| boolean | null | +| list | null cons | +| compiled-function | byte-code-function subr | +| function | module-function compiled-function oclosure | +| subr | subr-native-elisp subr-primitive | +| oclosure | advice kmacro | +| cl--class | oclosure--class cl-structure-class eieio--class | +| cl-structure-object | cl--class xref-elisp-location frameset-register | +| eieio-default-superclass | eieio-named transient-child | +| transient-suffix | transient-infix | +| transient-child | transient-suffix | diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index a4ddc55b257..ea08d35ecec 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -51,14 +51,25 @@ (signal 'cl-assertion-failed `(,form ,@sargs))))) (defconst cl--direct-supertypes-of-type + ;; Please run `sycdoc-update-type-hierarchy' in + ;; `admin/syncdoc-type-hierarchy.el' each time this is modified to + ;; reflect the change in the documentation. (let ((table (make-hash-table :test #'eq))) + ;; FIXME: Our type DAG has various quirks: + ;; - `subr' says it's a `compiled-function' but that's not true + ;; for those subrs that are special forms! + ;; - Some `keyword's are also `symbol-with-pos' but that's not reflected + ;; in the DAG. + ;; - An OClosure can be an interpreted function or a `byte-code-function', + ;; so the DAG of OClosure types is "orthogonal" to the distinction + ;; between interpreted and compiled functions. (dolist (x '((sequence t) (atom t) (list sequence) (array sequence atom) (float number) (integer number integer-or-marker) - (marker integer-or-marker number-or-marker) + (marker integer-or-marker) (integer-or-marker number-or-marker) (number number-or-marker) (bignum integer) @@ -73,10 +84,11 @@ ;; FIXME: This results in `atom' coming before `list' :-( (null boolean list) (cons list) + (function atom) (byte-code-function compiled-function) (subr compiled-function) - (module-function function atom) - (compiled-function function atom) + (module-function function) + (compiled-function function) (subr-native-elisp subr) (subr-primitive subr))) (puthash (car x) (cdr x) table)) @@ -100,8 +112,11 @@ (lambda (type) ;; FIXME: copy&pasted from `cl--class-allparents'. (let ((parents (gethash type cl--direct-supertypes-of-type))) + (unless parents + (message "Warning: Type without parent: %S!" type)) (cons type (merge-ordered-lists + ;; FIXME: Can't remember why `t' is excluded. (mapcar allparents (remq t parents)))))))) (maphash (lambda (type _) (push (funcall allparents type) alist)) -- cgit v1.2.3 From 218748c26287ae865229fe8a3c520facfa12fede Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 4 Mar 2024 23:42:50 -0500 Subject: disass.el (disassemble-1): Minor simplification * lisp/emacs-lisp/disass.el (disassemble-1): Remove code for functions of the form (lambda ARGS (byte-code ...)) which we don't use any more nowadays. --- lisp/emacs-lisp/disass.el | 39 ++++++++++++++++----------------------- 1 file changed, 16 insertions(+), 23 deletions(-) diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index b7db2adde59..850cc2085f7 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -54,7 +54,7 @@ (defun disassemble (object &optional buffer indent interactive-p) "Print disassembled code for OBJECT in (optional) BUFFER. OBJECT can be a symbol defined as a function, or a function itself -\(a lambda expression or a compiled-function object). +\(a lambda expression or a byte-code-function object). If OBJECT is not already compiled, we compile it, but do not redefine OBJECT if it is a symbol." (interactive @@ -70,7 +70,7 @@ redefine OBJECT if it is a symbol." (save-excursion (if (or interactive-p (null buffer)) (with-output-to-temp-buffer "*Disassemble*" - (set-buffer "*Disassemble*") + (set-buffer standard-output) (let ((lexical-binding lb)) (disassemble-internal object indent (not interactive-p)))) (set-buffer buffer) @@ -250,29 +250,22 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler." ;; if the succeeding op is byte-switch, display the jump table ;; used (cond ((eq (car-safe (car-safe (cdr lap))) 'byte-switch) - (insert (format "")) - ;; if the value of the constant is compiled code, then - ;; recursively disassemble it. - ((or (byte-code-function-p arg) - (and (consp arg) (functionp arg) - (assq 'byte-code arg)) + (insert (format "")) + ;; if the value of the constant is compiled code, then + ;; recursively disassemble it. + ((or (byte-code-function-p arg) (and (eq (car-safe arg) 'macro) - (or (byte-code-function-p (cdr arg)) - (and (consp (cdr arg)) - (functionp (cdr arg)) - (assq 'byte-code (cdr arg)))))) + (byte-code-function-p (cdr arg)))) (cond ((byte-code-function-p arg) (insert "\n")) - ((functionp arg) - (insert "")) (t (insert "\n"))) (disassemble-internal arg @@ -285,7 +278,7 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler." (+ indent disassemble-recursive-indent))) ((eq (car-safe (car-safe arg)) 'byte-code) (insert "(...)\n") - (mapc ;recurse on list of byte-code objects + (mapc ;Recurse on list of byte-code objects. (lambda (obj) (disassemble-1 obj -- cgit v1.2.3 From dcdb066025ca7ed813fa832bf931d411a9d109a0 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 5 Mar 2024 11:17:48 +0100 Subject: Adapt tramp.texi * doc/misc/tramp.texi (Quick Start Guide): Add androidsu. (Inline methods): Make androidsu an own item. --- doc/misc/tramp.texi | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index d67e2fcb64c..131a23b7423 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -488,28 +488,33 @@ an @command{ssh} server: @file{@trampfn{plink,user@@host,/path/to/file}}. -@anchor{Quick Start Guide su, sudo, doas and sg methods} -@section Using @option{su}, @option{sudo}, @option{doas} and @option{sg} +@anchor{Quick Start Guide su, sudo, doas, androidsu and sg methods} +@section Using @option{su}, @option{sudo}, @option{doas}, @option{androidsu} and @option{sg} @cindex method @option{su} @cindex @option{su} method @cindex method @option{sudo} @cindex @option{sudo} method @cindex method @option{doas} @cindex @option{doas} method +@cindex method @option{androidsu} +@cindex @option{androidsu} method @cindex method @option{sg} @cindex @option{sg} method Sometimes, it is necessary to work on your local host under different permissions. For this, you can use the @option{su} or @option{sudo} connection method. On OpenBSD systems, the @option{doas} connection -method offers the same functionality. These methods use @samp{root} -as default user name and the return value of @code{(system-name)} as -default host name. Therefore, it is convenient to open a file as -@file{@trampfn{sudo,,/path/to/file}}. +method offers the same functionality. If your local system is +Android, use the method @option{androidsu} instead of @option{su}. + +These methods use @samp{root} as default user name and the return +value of @code{(system-name)} as default host name. Therefore, it is +convenient to open a file as @file{@trampfn{sudo,,/path/to/file}}. The method @option{sg} stands for ``switch group''; here the user name is used as the group to change to. The default host name is the same. + @anchor{Quick Start Guide Combining ssh, plink, su, sudo and doas methods} @section Combining @option{ssh} or @option{plink} with @option{su}, @option{sudo} or @option{doas} @cindex method @option{ssh} @@ -532,6 +537,7 @@ a simple case, the syntax looks like @file{@trampfn{ssh@value{postfixhop}user@@host|sudo,,/path/to/file}}. @xref{Ad-hoc multi-hops}. + @anchor{Quick Start Guide sudoedit method} @section Using @command{sudoedit} @cindex method @option{sudoedit} @@ -817,6 +823,7 @@ editing as another user. The host can be either @samp{localhost} or the host returned by the function @command{(system-name)}. See @ref{Multi-hops} for an exception to this behavior. +@item @option{androidsu} @cindex method @option{androidsu} @cindex @option{androidsu} method Because the default implementation of the @option{su} method and other @@ -2058,7 +2065,7 @@ machine @var{host} port sudo login @var{user} password secret @var{user} and @var{host} are the strings returned by @code{(user-login-name)} and @code{(system-name)}. If one of these -methods is connected via a multi hop (@pxref{Multi-hops}), the +methods is connected via a multi-hop (@pxref{Multi-hops}), the credentials of the previous hop are used. @vindex auth-source-save-behavior -- cgit v1.2.3 From 3023976b484e52f756ac9fc4c87cc7c6c5192b05 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 5 Mar 2024 11:48:08 +0100 Subject: * Copy type hierarchy representation to the info dir * doc/lispref/Makefile.in (auxfiles) ($(buildinfodir)/type_hierarchy.txt) ($(buildinfodir)/type_hierarchy.jpg): New targets. ($(buildinfodir)/elisp.info): Add dependecy. --- doc/lispref/Makefile.in | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in index 476b8cf8fe6..4c6b14593ff 100644 --- a/doc/lispref/Makefile.in +++ b/doc/lispref/Makefile.in @@ -144,7 +144,15 @@ ps: $(PS_TARGETS) ${buildinfodir}: ${MKDIR_P} $@ -$(buildinfodir)/elisp.info: $(srcs) | ${buildinfodir} +auxfiles: $(buildinfodir)/type_hierarchy.txt $(buildinfodir)/type_hierarchy.jpg + +$(buildinfodir)/type_hierarchy.txt: $(srcdir)/type_hierarchy.txt | ${buildinfodir} + cp $< $@ + +$(buildinfodir)/type_hierarchy.jpg: $(srcdir)/type_hierarchy.jpg | ${buildinfodir} + cp $< $@ + +$(buildinfodir)/elisp.info: $(srcs) auxfiles | ${buildinfodir} $(AM_V_GEN)$(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ $< elisp.dvi: $(srcs) -- cgit v1.2.3 From 4673b99071399bf43329741d3f5ab56eb6854572 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 5 Mar 2024 15:07:05 +0100 Subject: * Makefile.in (install-info): Install type_hierarchy* files as well. --- Makefile.in | 1 + 1 file changed, 1 insertion(+) diff --git a/Makefile.in b/Makefile.in index 5f3227a9ad5..e7fc19e6494 100644 --- a/Makefile.in +++ b/Makefile.in @@ -812,6 +812,7 @@ install-info: info done; \ (cd "$${thisdir}"; \ ${INSTALL_INFO} --info-dir="$(DESTDIR)${infodir}" "$(DESTDIR)${infodir}/$$elt"); \ + cp type_hierarchy* $(DESTDIR)${infodir}/; \ # Used by elisp.info. done; \ fi -- cgit v1.2.3 From 5155f5b1cc0a48566d0f419de8cffd845638e567 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 5 Mar 2024 15:21:44 +0100 Subject: * Makefile.in (uninstall): Clean-up type_hierarchy* files. --- Makefile.in | 1 + 1 file changed, 1 insertion(+) diff --git a/Makefile.in b/Makefile.in index e7fc19e6494..d54583399d0 100644 --- a/Makefile.in +++ b/Makefile.in @@ -955,6 +955,7 @@ uninstall: uninstall-$(NTDIR) uninstall-doc uninstall-gsettings-schemas ext=.gz; else ext=; fi; \ rm -f $$elt$$ext $$elt-[1-9]$$ext $$elt-[1-9][0-9]$$ext; \ done; \ + rm -f type_hierarchy.jpg type_hierarchy.txt; \ fi) (if [ -n "${GZIP_PROG}" ]; then \ ext=.gz; else ext=; fi; \ -- cgit v1.2.3 From 9cf0f254bae79f6b6cda01e7a4b77fabec9f3f8f Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 5 Mar 2024 18:42:49 +0200 Subject: * lisp/net/dictionary.el: More fixes for dictionary-new-matching (bug#69312) (dictionary-new-matching): Change the order of standard calls to be the same as in 'dictionary-new-search'. Use new function 'dictionary-new-matching-internal'. (dictionary-new-matching-internal): New function based on 'dictionary-new-search-internal'. --- lisp/net/dictionary.el | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 7967c650999..d4dfa33716c 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1116,17 +1116,22 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (defun dictionary-new-matching (word) "Run a new matching search on WORD." - (dictionary-ensure-buffer) (dictionary-store-positions) - (dictionary-pre-buffer) - (dictionary-do-matching word dictionary-default-dictionary - dictionary-default-strategy - 'dictionary-display-match-result) - (dictionary-store-state 'dictionary-do-matching + (dictionary-ensure-buffer) + (dictionary-new-matching-internal word dictionary-default-dictionary + dictionary-default-strategy + 'dictionary-display-match-result) + (dictionary-store-state 'dictionary-new-matching-internal (list word dictionary-default-dictionary dictionary-default-strategy 'dictionary-display-match-result))) +(defun dictionary-new-matching-internal (word dictionary strategy function) + "Start a new matching for WORD in DICTIONARY after preparing the buffer. +FUNCTION is the callback which is called for each search result." + (dictionary-pre-buffer) + (dictionary-do-matching word dictionary strategy function)) + (defun dictionary-do-matching (word dictionary strategy function) "Search for WORD with STRATEGY in DICTIONARY and display them with FUNCTION." (insert (format-message "Lookup matching words for `%s' in `%s' using `%s'\n" -- cgit v1.2.3 From f16a85e317d940aa2e0f0375ec5d1917cb04ade3 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 5 Mar 2024 18:50:51 +0200 Subject: New property 'context-menu-functions' (bug#62250) * lisp/iimage.el (iimage-mode-buffer): Set context-menu-functions text property to '(image-context-menu)'. * lisp/image.el (image-context-menu): New function. (put-image): Set context-menu-functions overlay property to '(image-context-menu)'. (insert-image, insert-sliced-image): Set context-menu-functions text property to '(image-context-menu)'. * lisp/mouse.el (context-menu-map): Use mouse-posn-property 'context-menu-functions' and call its funs at the end. --- etc/NEWS | 4 ++++ lisp/iimage.el | 1 + lisp/image.el | 33 ++++++++++++++++++++++++++++++--- lisp/mouse.el | 14 ++++++++++---- 4 files changed, 45 insertions(+), 7 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 06856602ea8..a4b42263c36 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2087,6 +2087,10 @@ treesitter grammar. ** New buffer-local variable 'tabulated-list-groups'. It controls display and separate sorting of groups of entries. +--- +** New property 'context-menu-functions'. +Like the variable with the same name it adds a list of context menus. + * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/lisp/iimage.el b/lisp/iimage.el index 205141577c9..0f2297465fe 100644 --- a/lisp/iimage.el +++ b/lisp/iimage.el @@ -134,6 +134,7 @@ Examples of image filename patterns to match: :max-width (- (nth 2 edges) (nth 0 edges)) :max-height (- (nth 3 edges) (nth 1 edges))) keymap ,image-map + context-menu-functions (image-context-menu) modification-hooks (iimage-modification-hook))) (remove-list-of-text-properties diff --git a/lisp/image.el b/lisp/image.el index 2ebce59a98c..662e7eaf25d 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -193,6 +193,29 @@ or \"ffmpeg\") is installed." "h" #'image-flip-horizontally "v" #'image-flip-vertically)) +(defun image-context-menu (menu click) + "Populate MENU with image-related commands at CLICK." + (when (mouse-posn-property (event-start click) 'display) + (define-key menu [image-separator] menu-bar-separator) + (let ((easy-menu (make-sparse-keymap "Image"))) + (easy-menu-define nil easy-menu nil + '("Image" + ["Zoom In" image-increase-size + :help "Enlarge the image"] + ["Zoom Out" image-decrease-size + :help "Shrink the image"] + ["Rotate Clockwise" image-rotate + :help "Rotate the image"] + ["Flip horizontally" image-flip-horizontally + :help "Flip horizontally"] + ["Flip vertically" image-flip-vertically + :help "Flip vertically"])) + (dolist (item (reverse (lookup-key easy-menu [menu-bar image]))) + (when (consp item) + (define-key menu (vector (car item)) (cdr item)))))) + + menu) + (defun image-load-path-for-library (library image &optional path no-error) "Return a suitable search path for images used by LIBRARY. @@ -620,6 +643,7 @@ means display it in the right marginal area." (overlay-put overlay 'put-image t) (overlay-put overlay 'before-string string) (overlay-put overlay 'keymap image-map) + (overlay-put overlay 'context-menu-functions '(image-context-menu)) overlay))) @@ -672,8 +696,9 @@ is non-nil, this is inhibited." inhibit-isearch ,inhibit-isearch keymap ,(if slice image-slice-map - image-map))))) - + image-map) + context-menu-functions + (image-context-menu))))) ;;;###autoload (defun insert-sliced-image (image &optional string area rows cols) @@ -709,7 +734,9 @@ The image is automatically split into ROWS x COLS slices." (add-text-properties start (point) `(display ,(list (list 'slice x y dx dy) image) rear-nonsticky (display keymap) - keymap ,image-slice-map)) + keymap ,image-slice-map + context-menu-functions + (image-context-menu))) (setq x (+ x dx)))) (setq x 0.0 y (+ y dy)) diff --git a/lisp/mouse.el b/lisp/mouse.el index d1b06c2040d..26835437c08 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -414,13 +414,17 @@ Each function receives the menu and the mouse click event and returns the same menu after adding own menu items to the composite menu. When there is a text property `context-menu-function' at CLICK, it overrides all functions from `context-menu-functions'. +Whereas the property `context-menu-functions' doesn't override +the variable `context-menu-functions', but adds menus from the +list in the property after adding menus from the variable. At the end, it's possible to modify the final menu by specifying the function `context-menu-filter-function'." (let* ((menu (make-sparse-keymap (propertize "Context Menu" 'hide t))) (click (or click last-input-event)) - (window (posn-window (event-start click))) - (fun (mouse-posn-property (event-start click) - 'context-menu-function))) + (start (event-start click)) + (window (posn-window start)) + (fun (mouse-posn-property start 'context-menu-function)) + (funs (mouse-posn-property start 'context-menu-functions))) (unless (eq (selected-window) window) (select-window window)) @@ -430,7 +434,9 @@ the function `context-menu-filter-function'." (run-hook-wrapped 'context-menu-functions (lambda (fun) (setq menu (funcall fun menu click)) - nil))) + nil)) + (dolist (fun funs) + (setq menu (funcall fun menu click)))) ;; Remove duplicate separators as well as ones at the beginning or ;; end of the menu. -- cgit v1.2.3 From 3cb06145070ff5d4a220f1144434f1ba6c1976f7 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 5 Mar 2024 19:14:28 +0200 Subject: * lisp/tab-bar.el (tab-bar-tab-post-select-functions): New hook (bug#69093). (tab-bar-select-tab): Call tab-bar-tab-post-select-functions at the end. --- etc/NEWS | 4 ++++ lisp/tab-bar.el | 13 ++++++++++++- 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index a4b42263c36..b4343a7941b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -275,10 +275,14 @@ selected or deselected at the end of executing the current command. ** Tab Bars and Tab Lines +--- *** New user option 'tab-bar-tab-name-format-functions'. It can be used to add, remove and reorder functions that change the appearance of every tab on the tab bar. +--- +*** New hook 'tab-bar-tab-post-select-functions'. + +++ ** New optional argument for modifying directory-local variables. The commands 'add-dir-local-variable', 'delete-dir-local-variable' and diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 3e1d8278b04..61efa332e0b 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1385,6 +1385,14 @@ inherits the current tab's `explicit-name' parameter." tabs)))) +(defcustom tab-bar-tab-post-select-functions nil + "List of functions to call after selecting a tab. +Two arguments are supplied: the previous tab that was selected before, +and the newly selected tab." + :type '(repeat function) + :group 'tab-bar + :version "30.1") + (defvar tab-bar-minibuffer-restore-tab nil "Tab number for `tab-bar-minibuffer-restore-tab'.") @@ -1499,7 +1507,10 @@ Negative TAB-NUMBER counts tabs from the end of the tab bar." (tab-bar--current-tab-make (nth to-index tabs))) (unless tab-bar-mode - (message "Selected tab '%s'" (alist-get 'name to-tab)))) + (message "Selected tab '%s'" (alist-get 'name to-tab))) + + (run-hook-with-args 'tab-bar-tab-post-select-functions + from-tab to-tab)) (force-mode-line-update)))) -- cgit v1.2.3 From 33976ecf244082346cbc71ff1102ef7de1ed36fe Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 5 Mar 2024 19:32:29 +0200 Subject: ; * etc/NEWS: Fix wording and punctuation of a recently added entry. --- etc/NEWS | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index b4343a7941b..fd957fdb115 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2092,8 +2092,10 @@ treesitter grammar. It controls display and separate sorting of groups of entries. --- -** New property 'context-menu-functions'. -Like the variable with the same name it adds a list of context menus. +** New text property 'context-menu-functions'. +Like the variable with the same name, it adds menus from the list that +is the value of the property to context menus shown when clicking on the +text which as this property. * Changes in Emacs 30.1 on Non-Free Operating Systems -- cgit v1.2.3 From d5f11e890c598cd2e15cb2fd93e604ed100ce355 Mon Sep 17 00:00:00 2001 From: Vincenzo Pupillo Date: Tue, 5 Mar 2024 22:36:34 +0100 Subject: * Makefile.in (install-info): Fix target (bug#69569). --- Makefile.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile.in b/Makefile.in index d54583399d0..6f014909307 100644 --- a/Makefile.in +++ b/Makefile.in @@ -812,7 +812,7 @@ install-info: info done; \ (cd "$${thisdir}"; \ ${INSTALL_INFO} --info-dir="$(DESTDIR)${infodir}" "$(DESTDIR)${infodir}/$$elt"); \ - cp type_hierarchy* $(DESTDIR)${infodir}/; \ # Used by elisp.info. + cp type_hierarchy* $(DESTDIR)${infodir}/; \ done; \ fi -- cgit v1.2.3 From 845d334c10ab8a12ac5eead90abfa9cae1f4b67c Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 6 Mar 2024 10:20:36 +0800 Subject: ; Fix last change * lisp/net/tramp-androidsu.el (tramp-androidsu-generate-wrapper): Arguments to fset must be symbols rather than functions. --- lisp/net/tramp-androidsu.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index c7fb67d4081..c24ac079022 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -232,16 +232,16 @@ FUNCTION." ;; tramp-adb-wait-for-output addresses problems introduced ;; by the adb utility itself, not Android utilities, so ;; replace it with the regular TRAMP function. - (fset #'tramp-adb-wait-for-output #'tramp-wait-for-output) + (fset 'tramp-adb-wait-for-output #'tramp-wait-for-output) ;; Likewise, except some special treatment is necessary on ;; account of flaws in Android's su implementation. - (fset #'tramp-adb-maybe-open-connection + (fset 'tramp-adb-maybe-open-connection #'tramp-androidsu-maybe-open-connection) (apply function args)) ;; Restore the original definitions of the functions overridden ;; above. - (fset #'tramp-adb-wait-for-output tramp-adb-wait-for-output) - (fset #'tramp-adb-maybe-open-connection + (fset 'tramp-adb-wait-for-output tramp-adb-wait-for-output) + (fset 'tramp-adb-maybe-open-connection tramp-adb-maybe-open-connection))))) (defalias 'tramp-androidsu-handle-copy-file #'tramp-sh-handle-copy-file) -- cgit v1.2.3 From 1a5850a3af0693f022bb0a62e36bb84f762287c7 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 6 Mar 2024 10:48:28 +0800 Subject: Don't report files from read-only adb partitions as writable * lisp/net/tramp-adb.el (tramp-adb-handle-file-writable-p): Ignore the file-attributes cache, since file mode is not a reliable indicator of writability. --- lisp/net/tramp-adb.el | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 8ad7c271b4f..aaeb5fabb80 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -508,12 +508,11 @@ Emacs dired can't find files." (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-writable-p" (if (file-exists-p filename) - ;; Examine `file-attributes' cache to see if request can be - ;; satisfied without remote operation. - (if (tramp-file-property-p v localname "file-attributes") - (tramp-check-cached-permissions v ?w) - (tramp-adb-send-command-and-check - v (format "test -w %s" (tramp-shell-quote-argument localname)))) + ;; The file-attributes cache is unreliable since its + ;; information does not take partition writability into + ;; account, so a call to test must never be skipped. + (tramp-adb-send-command-and-check + v (format "test -w %s" (tramp-shell-quote-argument localname))) ;; If file doesn't exist, check if directory is writable. (and (file-directory-p (file-name-directory filename)) -- cgit v1.2.3 From 9526bd3cf8eb5e5ed78c7fb8eb03d9e7dac9b941 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 6 Mar 2024 15:41:37 +0100 Subject: * Update syncdoc to dump all preloaded type hierarchy * admin/syncdoc-type-hierarchy.el (syncdoc-file) (syncdoc-emacs-repo-dir): New constants. (syncdoc-lispref-dir): Make use of. (syncdoc-all-types): New function. (comp--direct-supertypes): Declare. (syncdoc-hierarchy): Update. (syncdoc-update-type-hierarchy0): Rename from 'syncdoc-update-type-hierarchy' and make non interactive. (syncdoc-update-type-hierarchy): New function. --- admin/syncdoc-type-hierarchy.el | 74 ++++++++++++++++++++++------------------- 1 file changed, 39 insertions(+), 35 deletions(-) diff --git a/admin/syncdoc-type-hierarchy.el b/admin/syncdoc-type-hierarchy.el index 6448369625b..b8cd71fe84e 100644 --- a/admin/syncdoc-type-hierarchy.el +++ b/admin/syncdoc-type-hierarchy.el @@ -37,42 +37,40 @@ (require 'cl-lib) (require 'org-table) +(defconst syncdoc-file (or (macroexp-file-name) buffer-file-name)) + +(defconst syncdoc-emacs-repo-dir + (expand-file-name "../" (file-name-directory syncdoc-file))) + (defconst syncdoc-lispref-dir - (expand-file-name "../doc/lispref/" - (file-name-directory - (or (macroexp-file-name) - buffer-file-name)))) + (expand-file-name "doc/lispref/" syncdoc-emacs-repo-dir)) + +(defconst syncdoc-all-types + (let (res) + (maphash (lambda (type _) + (push type res)) + cl--direct-supertypes-of-type) + + (mapatoms (lambda (type) + (when (cl-find-class type) + (push type res))) + obarray) + res) + "List of all types.") + +(declare-function 'comp--direct-supertypes "comp-cstr.el") (defconst syncdoc-hierarchy - (let ((ht (copy-hash-table cl--direct-supertypes-of-type))) - ;; Include info about "representative" other structure types, - ;; to illustrate how they fit. - (mapc #'require '(kmacro eieio-base elisp-mode frameset transient)) - (let ((extra-types '(advice kmacro cl-structure-object cl-structure-class - eieio-default-superclass eieio-named transient-infix - xref-elisp-location frameset-register)) - (seen ())) - (while extra-types - (let* ((type (pop extra-types)) - (class (get type 'cl--class)) - (parents (cl--class-parents class))) - (unless (member type seen) - (push type seen) - (push (type-of class) extra-types) - (puthash type (cond - (parents - (let ((ps (mapcar #'cl--class-name parents))) - (setq extra-types (append ps extra-types)) - ps)) - ;; EIEIO's parents don't mention the default. - ((and (eq (type-of class) 'eieio--class) - (not (eq type 'eieio-default-superclass))) - '(eieio-default-superclass)) - ;; OClosures can still be lists :-( - ((eq 'oclosure type) '(function)) - (t '(atom))) - ht))))) - ht)) + (progn + ;; Require it here so we don't load it before `syncdoc-all-types' is + ;; computed. + (require 'comp-cstr) + (cl-loop + with comp-ctxt = (make-comp-cstr-ctxt) + with h = (make-hash-table :test #'eq) + for type in syncdoc-all-types + do (puthash type (comp--direct-supertypes type) h) + finally return h))) (defun syncdoc-insert-dot-content (rankdir) (maphash (lambda (child parents) @@ -110,9 +108,8 @@ do (insert "\n"))) (org-table-align))) -(defun syncdoc-update-type-hierarchy () +(defun syncdoc-update-type-hierarchy0 () "Update the type hierarchy representation used by the elisp manual." - (interactive) (with-temp-buffer (syncdoc-insert-dot-content "LR") (with-demoted-errors "%S" ;In case "dot" is not found! @@ -122,4 +119,11 @@ (syncdoc-make-type-table (expand-file-name "type_hierarchy.txt" syncdoc-lispref-dir))) +(defun syncdoc-update-type-hierarchy () + "Update the type hierarchy representation used by the elisp manual." + (interactive) + (call-process (expand-file-name "src/emacs" syncdoc-emacs-repo-dir) + nil t t "-Q" "--batch" "-l" syncdoc-file + "-f" "syncdoc-update-type-hierarchy0")) + ;;; syncdoc-type-hierarchy.el ends here -- cgit v1.2.3 From a5d3ce38fa77296f12bf15a9451d4c151f10d766 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 6 Mar 2024 15:50:33 +0100 Subject: Re-generate type_hierarchy.* * doc/lispref/type_hierarchy.txt: Update. * doc/lispref/type_hierarchy.jpg: Likewise. --- doc/lispref/type_hierarchy.jpg | Bin 237291 -> 358752 bytes doc/lispref/type_hierarchy.txt | 56 +++++++++++++++++++++-------------------- 2 files changed, 29 insertions(+), 27 deletions(-) diff --git a/doc/lispref/type_hierarchy.jpg b/doc/lispref/type_hierarchy.jpg index 6b9be985817..518255566b9 100644 Binary files a/doc/lispref/type_hierarchy.jpg and b/doc/lispref/type_hierarchy.jpg differ diff --git a/doc/lispref/type_hierarchy.txt b/doc/lispref/type_hierarchy.txt index 6827bbbc580..00b6bb91458 100644 --- a/doc/lispref/type_hierarchy.txt +++ b/doc/lispref/type_hierarchy.txt @@ -1,27 +1,29 @@ -| Type | Derived Types | -|--------------------------+------------------------------------------------------------| -| t | sequence atom | -| sequence | list array | -| atom | array function tree-sitter-compiled-query tree-sitter-node | -| | tree-sitter-parser user-ptr font-object font-entity | -| | font-spec condvar mutex thread terminal hash-table frame | -| | buffer window process window-configuration overlay | -| | number-or-marker symbol obarray native-comp-unit | -| | cl-structure-object eieio-default-superclass | -| number | float integer | -| integer-or-marker | integer marker | -| number-or-marker | integer-or-marker number | -| integer | bignum fixnum | -| symbol | keyword boolean symbol-with-pos | -| array | vector bool-vector char-table string | -| boolean | null | -| list | null cons | -| compiled-function | byte-code-function subr | -| function | module-function compiled-function oclosure | -| subr | subr-native-elisp subr-primitive | -| oclosure | advice kmacro | -| cl--class | oclosure--class cl-structure-class eieio--class | -| cl-structure-object | cl--class xref-elisp-location frameset-register | -| eieio-default-superclass | eieio-named transient-child | -| transient-suffix | transient-infix | -| transient-child | transient-suffix | +| Type | Derived Types | +|---------------------+------------------------------------------------------------| +| cl-structure-object | xref-elisp-location org-cite-processor cl--generic-method | +| | cl--random-state register-preview-info cl--generic | +| | cl--class cl-slot-descriptor uniquify-item registerv | +| | isearch--state cl--generic-generalizer lisp-indent-state | +| accessor | oclosure-accessor | +| oclosure | advice cconv--interactive-helper advice--forward accessor | +| | save-some-buffers-function cl--generic-nnm | +| atom | ppss decoded-time oclosure cl-structure-object timer | +| | native-comp-unit obarray symbol number-or-marker overlay | +| | window-configuration process window buffer frame | +| | hash-table terminal thread mutex condvar font-spec | +| | font-entity font-object user-ptr tree-sitter-parser | +| | tree-sitter-node tree-sitter-compiled-query function array | +| cl--class | cl-structure-class oclosure--class | +| subr | subr-primitive subr-native-elisp | +| function | compiled-function module-function | +| compiled-function | subr byte-code-function | +| list | cons null | +| boolean | null | +| array | string char-table bool-vector vector | +| symbol | symbol-with-pos boolean keyword | +| integer | fixnum bignum | +| number-or-marker | number integer-or-marker | +| integer-or-marker | marker integer | +| number | integer float | +| sequence | array list | +| t | atom sequence | -- cgit v1.2.3 From 415604c7a77205d91254a271f0112f69729eb3a9 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 6 Mar 2024 16:43:45 +0100 Subject: Rename type_hierarchy.* -> elisp_type_hierarchy.* * doc/lispref/elisp_type_hierarchy.txt: Renamed. * doc/lispref/elisp_type_hierarchy.jpg: Likewise. * doc/lispref/Makefile.in (auxfiles) ($(buildinfodir)/elisp_type_hierarchy.txt) ($(buildinfodir)/elisp_type_hierarchy.jpg): Update. * admin/syncdoc-type-hierarchy.el (syncdoc-update-type-hierarchy0): Likewise. * Makefile.in (install-info, uninstall): Likewise. --- Makefile.in | 4 ++-- admin/syncdoc-type-hierarchy.el | 4 ++-- doc/lispref/Makefile.in | 6 +++--- doc/lispref/elisp_type_hierarchy.jpg | Bin 0 -> 358752 bytes doc/lispref/elisp_type_hierarchy.txt | 29 +++++++++++++++++++++++++++++ doc/lispref/objects.texi | 2 +- doc/lispref/type_hierarchy.jpg | Bin 358752 -> 0 bytes doc/lispref/type_hierarchy.txt | 29 ----------------------------- 8 files changed, 37 insertions(+), 37 deletions(-) create mode 100644 doc/lispref/elisp_type_hierarchy.jpg create mode 100644 doc/lispref/elisp_type_hierarchy.txt delete mode 100644 doc/lispref/type_hierarchy.jpg delete mode 100644 doc/lispref/type_hierarchy.txt diff --git a/Makefile.in b/Makefile.in index 6f014909307..20394cb333d 100644 --- a/Makefile.in +++ b/Makefile.in @@ -812,7 +812,7 @@ install-info: info done; \ (cd "$${thisdir}"; \ ${INSTALL_INFO} --info-dir="$(DESTDIR)${infodir}" "$(DESTDIR)${infodir}/$$elt"); \ - cp type_hierarchy* $(DESTDIR)${infodir}/; \ + cp elisp_type_hierarchy* $(DESTDIR)${infodir}/; \ done; \ fi @@ -955,7 +955,7 @@ uninstall: uninstall-$(NTDIR) uninstall-doc uninstall-gsettings-schemas ext=.gz; else ext=; fi; \ rm -f $$elt$$ext $$elt-[1-9]$$ext $$elt-[1-9][0-9]$$ext; \ done; \ - rm -f type_hierarchy.jpg type_hierarchy.txt; \ + rm -f elisp_type_hierarchy.jpg elisp_type_hierarchy.txt; \ fi) (if [ -n "${GZIP_PROG}" ]; then \ ext=.gz; else ext=; fi; \ diff --git a/admin/syncdoc-type-hierarchy.el b/admin/syncdoc-type-hierarchy.el index b8cd71fe84e..b5cfdfd8e74 100644 --- a/admin/syncdoc-type-hierarchy.el +++ b/admin/syncdoc-type-hierarchy.el @@ -114,9 +114,9 @@ (syncdoc-insert-dot-content "LR") (with-demoted-errors "%S" ;In case "dot" is not found! (call-process-region nil nil "dot" t (current-buffer) nil "-Tjpg" "-o" - (expand-file-name "type_hierarchy.jpg" + (expand-file-name "elisp_type_hierarchy.jpg" syncdoc-lispref-dir)))) - (syncdoc-make-type-table (expand-file-name "type_hierarchy.txt" + (syncdoc-make-type-table (expand-file-name "elisp_type_hierarchy.txt" syncdoc-lispref-dir))) (defun syncdoc-update-type-hierarchy () diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in index 4c6b14593ff..9b7b6d8ea9d 100644 --- a/doc/lispref/Makefile.in +++ b/doc/lispref/Makefile.in @@ -144,12 +144,12 @@ ps: $(PS_TARGETS) ${buildinfodir}: ${MKDIR_P} $@ -auxfiles: $(buildinfodir)/type_hierarchy.txt $(buildinfodir)/type_hierarchy.jpg +auxfiles: $(buildinfodir)/elisp_type_hierarchy.txt $(buildinfodir)/elisp_type_hierarchy.jpg -$(buildinfodir)/type_hierarchy.txt: $(srcdir)/type_hierarchy.txt | ${buildinfodir} +$(buildinfodir)/elisp_type_hierarchy.txt: $(srcdir)/elisp_type_hierarchy.txt | ${buildinfodir} cp $< $@ -$(buildinfodir)/type_hierarchy.jpg: $(srcdir)/type_hierarchy.jpg | ${buildinfodir} +$(buildinfodir)/elisp_type_hierarchy.jpg: $(srcdir)/elisp_type_hierarchy.jpg | ${buildinfodir} cp $< $@ $(buildinfodir)/elisp.info: $(srcs) auxfiles | ${buildinfodir} diff --git a/doc/lispref/elisp_type_hierarchy.jpg b/doc/lispref/elisp_type_hierarchy.jpg new file mode 100644 index 00000000000..518255566b9 Binary files /dev/null and b/doc/lispref/elisp_type_hierarchy.jpg differ diff --git a/doc/lispref/elisp_type_hierarchy.txt b/doc/lispref/elisp_type_hierarchy.txt new file mode 100644 index 00000000000..00b6bb91458 --- /dev/null +++ b/doc/lispref/elisp_type_hierarchy.txt @@ -0,0 +1,29 @@ +| Type | Derived Types | +|---------------------+------------------------------------------------------------| +| cl-structure-object | xref-elisp-location org-cite-processor cl--generic-method | +| | cl--random-state register-preview-info cl--generic | +| | cl--class cl-slot-descriptor uniquify-item registerv | +| | isearch--state cl--generic-generalizer lisp-indent-state | +| accessor | oclosure-accessor | +| oclosure | advice cconv--interactive-helper advice--forward accessor | +| | save-some-buffers-function cl--generic-nnm | +| atom | ppss decoded-time oclosure cl-structure-object timer | +| | native-comp-unit obarray symbol number-or-marker overlay | +| | window-configuration process window buffer frame | +| | hash-table terminal thread mutex condvar font-spec | +| | font-entity font-object user-ptr tree-sitter-parser | +| | tree-sitter-node tree-sitter-compiled-query function array | +| cl--class | cl-structure-class oclosure--class | +| subr | subr-primitive subr-native-elisp | +| function | compiled-function module-function | +| compiled-function | subr byte-code-function | +| list | cons null | +| boolean | null | +| array | string char-table bool-vector vector | +| symbol | symbol-with-pos boolean keyword | +| integer | fixnum bignum | +| number-or-marker | number integer-or-marker | +| integer-or-marker | marker integer | +| number | integer float | +| sequence | array list | +| t | atom sequence | diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index dd212ef700c..41171bcaafc 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -2516,7 +2516,7 @@ The Lisp Type Hierarchy for primitive types can be represented as follows: @noindent -@image{type_hierarchy,,,,.jpg} +@image{elisp_type_hierarchy,,,,.jpg} For example type @code{list} derives from (is a special kind of) type @code{sequence} which itself derives from @code{t}. diff --git a/doc/lispref/type_hierarchy.jpg b/doc/lispref/type_hierarchy.jpg deleted file mode 100644 index 518255566b9..00000000000 Binary files a/doc/lispref/type_hierarchy.jpg and /dev/null differ diff --git a/doc/lispref/type_hierarchy.txt b/doc/lispref/type_hierarchy.txt deleted file mode 100644 index 00b6bb91458..00000000000 --- a/doc/lispref/type_hierarchy.txt +++ /dev/null @@ -1,29 +0,0 @@ -| Type | Derived Types | -|---------------------+------------------------------------------------------------| -| cl-structure-object | xref-elisp-location org-cite-processor cl--generic-method | -| | cl--random-state register-preview-info cl--generic | -| | cl--class cl-slot-descriptor uniquify-item registerv | -| | isearch--state cl--generic-generalizer lisp-indent-state | -| accessor | oclosure-accessor | -| oclosure | advice cconv--interactive-helper advice--forward accessor | -| | save-some-buffers-function cl--generic-nnm | -| atom | ppss decoded-time oclosure cl-structure-object timer | -| | native-comp-unit obarray symbol number-or-marker overlay | -| | window-configuration process window buffer frame | -| | hash-table terminal thread mutex condvar font-spec | -| | font-entity font-object user-ptr tree-sitter-parser | -| | tree-sitter-node tree-sitter-compiled-query function array | -| cl--class | cl-structure-class oclosure--class | -| subr | subr-primitive subr-native-elisp | -| function | compiled-function module-function | -| compiled-function | subr byte-code-function | -| list | cons null | -| boolean | null | -| array | string char-table bool-vector vector | -| symbol | symbol-with-pos boolean keyword | -| integer | fixnum bignum | -| number-or-marker | number integer-or-marker | -| integer-or-marker | marker integer | -| number | integer float | -| sequence | array list | -| t | atom sequence | -- cgit v1.2.3 From b12059e4c320f374735a9c00975ef12cb964043f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 6 Mar 2024 17:51:42 +0100 Subject: Tramp fixes after running regression tests on Android * lisp/net/tramp-adb.el (tramp-adb-maybe-open-connection): Unset environment variable PS2. * lisp/net/tramp-androidsu.el (tramp-default-host-alist): Don't add an entry; `tramp-default-host' is set properly. (tramp-androidsu-maybe-open-connection): Don't set connection property "remote-namespace" to nil, this is the default anyway. Don't set connection property "remote-path", we use connection-local values instead. Unset environment variable PS2. Dump shell options after setting all of them. (tramp-androidsu-handle-make-process): Don't use hard-coded user "root". (tramp-androidsu-connection-local-default-variables): New defvar. Add it to connection-local profiles. --- lisp/net/tramp-adb.el | 2 +- lisp/net/tramp-androidsu.el | 53 +++++++++++++++++++++++++-------------------- 2 files changed, 30 insertions(+), 25 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index aaeb5fabb80..da23d062c2e 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -1266,7 +1266,7 @@ connection if a previous connection has died for some reason." (tramp-set-connection-property p "prompt" (rx "///" (literal prompt) "#$")) (tramp-adb-send-command - vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt)) + vec (format "PS1=\"///\"\"%s\"\"#$\" PS2=''" prompt)) ;; Disable line editing. (tramp-adb-send-command diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index c24ac079022..09bee323f5e 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -88,8 +88,6 @@ may edit files belonging to any and all applications." (tramp-tmpdir ,tramp-androidsu-local-tmp-directory) (tramp-connection-timeout 10) (tramp-shell-name ,tramp-androidsu-local-shell-name))) - (add-to-list 'tramp-default-host-alist - `(,tramp-androidsu-method nil "localhost")) (add-to-list 'tramp-default-user-alist `(,tramp-androidsu-method nil ,tramp-root-id-string))) @@ -130,7 +128,7 @@ multibyte mode and waits for the shell prompt to appear." (p (start-process (tramp-get-connection-name vec) (tramp-get-connection-buffer vec) ;; Disregard - ;; tramp-encoding-shell, as + ;; `tramp-encoding-shell', as ;; there's no guarantee that it's ;; possible to execute it with ;; `android-use-exec-loader' off. @@ -142,17 +140,16 @@ multibyte mode and waits for the shell prompt to appear." (tramp-post-process-creation p vec) ;; Replace `login-args' place holders. (setq command (format "exec su - %s || exit" user)) - (tramp-set-connection-property vec "remote-namespace" nil) ;; Attempt to execute the shell inside the global mount ;; namespace if requested. (when tramp-androidsu-mount-global-namespace (progn (when (eq tramp-androidsu-su-mm-supported 'unknown) ;; Change the prompt in advance so that - ;; tramp-adb-send-command-and-check can call - ;; tramp-search-regexp. + ;; `tramp-adb-send-command-and-check' can call + ;; `tramp-search-regexp'. (tramp-adb-send-command - vec (format "PS1=%s" + vec (format "PS1=%s PS2=''" (tramp-shell-quote-argument tramp-end-of-output))) (setq tramp-androidsu-su-mm-supported @@ -179,17 +176,17 @@ multibyte mode and waits for the shell prompt to appear." (tramp-set-connection-local-variables vec) ;; Change prompt. (tramp-adb-send-command - vec (format "PS1=%s" + vec (format "PS1=%s PS2=''" (tramp-shell-quote-argument tramp-end-of-output))) ;; Disable line editing. (tramp-adb-send-command vec "set +o vi +o vi-esccomplete +o vi-tabcomplete +o emacs") - ;; Dump option settings in the traces. - (when (>= tramp-verbose 9) - (tramp-adb-send-command vec "set -o")) ;; Disable Unicode, for otherwise Unicode filenames will ;; not be decoded correctly. (tramp-adb-send-command vec "set +U") + ;; Dump option settings in the traces. + (when (>= tramp-verbose 9) + (tramp-adb-send-command vec "set -o")) ;; Disable echo expansion. (tramp-adb-send-command vec "stty -inlcr -onlcr -echo kill '^U' erase '^H'" t) @@ -204,12 +201,8 @@ multibyte mode and waits for the shell prompt to appear." (tramp-message vec 5 "Remote echo still on. Ok.") ;; Make sure backspaces and their echo are enabled ;; and no line width magic interferes with them. - (tramp-adb-send-command vec - "stty icanon erase ^H cols 32767" - t))) - ;; Set the remote PATH to a suitable value. - (tramp-set-connection-property vec "remote-path" - tramp-androidsu-remote-path) + (tramp-adb-send-command + vec "stty icanon erase ^H cols 32767" t))) ;; Mark it as connected. (tramp-set-connection-property p "connected" t)))) ;; Cleanup, and propagate the signal. @@ -229,9 +222,9 @@ FUNCTION." (symbol-function #'tramp-adb-maybe-open-connection))) (unwind-protect (progn - ;; tramp-adb-wait-for-output addresses problems introduced + ;; `tramp-adb-wait-for-output' addresses problems introduced ;; by the adb utility itself, not Android utilities, so - ;; replace it with the regular TRAMP function. + ;; replace it with the regular Tramp function. (fset 'tramp-adb-wait-for-output #'tramp-wait-for-output) ;; Likewise, except some special treatment is necessary on ;; account of flaws in Android's su implementation. @@ -376,10 +369,8 @@ FUNCTION." p (make-process :name name :buffer buffer :command (if (tramp-get-connection-property v "remote-namespace") - (append (list "su" "-mm" "-" (or user "root") "-c") - command) - (append (list "su" "-" (or user "root") "-c") - command)) + (append (list "su" "-mm" "-" user "-c") command) + (append (list "su" "-" user "-c") command)) :coding coding :noquery noquery :connection-type connection-type :sentinel sentinel :stderr stderr)) ;; Set filter. Prior Emacs 29.1, it doesn't work reliably @@ -516,7 +507,7 @@ FUNCTION." (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (write-region . tramp-androidsu-handle-write-region)) - "Alist of TRAMP handler functions for superuser sessions on Android.") + "Alist of Tramp handler functions for superuser sessions on Android.") ;; It must be a `defsubst' in order to push the whole code into ;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading. @@ -542,6 +533,20 @@ arguments to pass to the OPERATION." (tramp-register-foreign-file-name-handler #'tramp-androidsu-file-name-p #'tramp-androidsu-file-name-handler)) +;;; Default connection-local variables for Tramp. + +(defconst tramp-androidsu-connection-local-default-variables + `((tramp-remote-path . ,tramp-androidsu-remote-path)) + "Default connection-local variables for remote androidsu connections.") + +(connection-local-set-profile-variables + 'tramp-androidsu-connection-local-default-profile + tramp-androidsu-connection-local-default-variables) + +(connection-local-set-profiles + `(:application tramp :protocol ,tramp-androidsu-method) + 'tramp-androidsu-connection-local-default-profile) + (with-eval-after-load 'shell (connection-local-set-profiles `(:application tramp :protocol ,tramp-androidsu-method) -- cgit v1.2.3 From 59e470dd5de6e75c4d3bb91c876c8540faf33fdb Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Sat, 17 Feb 2024 20:49:15 -0800 Subject: When navigating through history in EWW, don't keep adding to 'eww-history' This resolves an issue where navigating back and then forward kept adding new history entries so you could never hit the "end" (bug#69232). * lisp/net/eww.el (eww-before-browse-history-function): New option. (eww-history-position): Add docstring. (eww-mode-map, eww-context-menu): Use correct predicates for when to enable back/forward. (eww-save-history): Save history entry in its original place when viewing a historical page. (eww--before-browse): New function... (eww, eww-follow-link, eww-readable): ... call it. (eww-render): Don't set 'eww-history-position' here... (eww--before-browse): ... instead, set it here. (eww-back-url): Set 'eww-history-position' based on the result of 'eww-save-history'. (eww-forward-url): Set 'eww-history-position' directly, since 'eww-save-history' no longer adds a new entry in this case. (eww-delete-future-history, eww-clone-previous-history): New functions. * test/lisp/net/eww-tests.el: New file. * etc/NEWS: Announce this change. --- doc/misc/eww.texi | 9 +++ etc/NEWS | 13 ++++ lisp/net/eww.el | 123 ++++++++++++++++++++++++++++--- test/lisp/net/eww-tests.el | 179 +++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 312 insertions(+), 12 deletions(-) create mode 100644 test/lisp/net/eww-tests.el diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index 5e69b11d347..d31fcf1802b 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -192,6 +192,15 @@ history press @kbd{H} (@code{eww-list-histories}) to open the history buffer @file{*eww history*}. The history is lost when EWW is quit. If you want to remember websites you can use bookmarks. +@vindex eww-before-browse-history-function + By default, when browsing to a new page from a ``historical'' one +(i.e.@: a page loaded by navigating back via @code{eww-back-url}), EWW +will first delete any history entries newer than the current page. This +is the same behavior as most other web browsers. You can change this by +customizing @code{eww-before-browse-history-function} to another value. +For example, setting it to @code{ignore} will preserve the existing +history entries and simply prepend the new page to the history list. + @vindex eww-history-limit Along with the URLs visited, EWW also remembers both the rendered page (as it appears in the buffer) and its source. This can take a diff --git a/etc/NEWS b/etc/NEWS index fd957fdb115..745b3b12936 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1018,6 +1018,19 @@ When invoked with the prefix argument ('C-u'), This is useful for continuing reading the URL in the current buffer when the new URL is fetched. +--- +*** History navigation in EWW now works like other browsers. +Previously, when navigating back and forward through page history, EWW +would add a duplicate entry to the end of the history list each time. +This made it impossible to navigate to the "end" of the history list. +Now, navigating through history in EWW simply changes your position in +the history list, allowing you to reach the end as expected. In +addition, when browsing to a new page from a "historical" one (i.e. a +page loaded by navigating back through history), EWW deletes the history +entries newer than the current page. To change the behavior when +browsing from "historical" pages, you can customize +'eww-before-browse-history-function'. + ** go-ts-mode +++ diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 5a25eef9e3c..2936bc8f099 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -182,6 +182,33 @@ the tab bar is enabled." (const :tag "Open new tab when tab bar is enabled" tab-bar) (const :tag "Never open URL in new tab" nil))) +(defcustom eww-before-browse-history-function #'eww-delete-future-history + "A function to call to update history before browsing to a new page. +EWW provides the following values for this option: + +* `eww-delete-future-history': Delete any history entries after the + currently-shown one. This is the default behavior, and works the same + as in most other web browsers. + +* `eww-clone-previous-history': Clone and prepend any history entries up + to the currently-shown one. This is like `eww-delete-future-history', + except that it preserves the previous contents of the history list at + the end. + +* `ignore': Preserve the current history unchanged. This will result in + the new page simply being prepended to the existing history list. + +You can also set this to any other function you wish." + :version "30.1" + :group 'eww + :type '(choice (function-item :tag "Delete future history" + eww-delete-future-history) + (function-item :tag "Clone previous history" + eww-clone-previous-history) + (function-item :tag "Preserve history" + ignore) + (function :tag "Custom function"))) + (defcustom eww-after-render-hook nil "A hook called after eww has finished rendering the buffer." :version "25.1" @@ -312,7 +339,10 @@ parameter, and should return the (possibly) transformed URL." (defvar eww-data nil) (defvar eww-history nil) -(defvar eww-history-position 0) +(defvar eww-history-position 0 + "The 1-indexed position in `eww-history'. +If zero, EWW is at the newest page, which isn't yet present in +`eww-history'.") (defvar eww-prompt-history nil) (defvar eww-local-regex "localhost" @@ -402,6 +432,7 @@ For more information, see Info node `(eww) Top'." (t (get-buffer-create "*eww*")))) (eww-setup-buffer) + (eww--before-browse) ;; Check whether the domain only uses "Highly Restricted" Unicode ;; IDNA characters. If not, transform to punycode to indicate that ;; there may be funny business going on. @@ -654,7 +685,6 @@ The renaming scheme is performed in accordance with (with-current-buffer buffer (plist-put eww-data :url url) (eww--after-page-change) - (setq eww-history-position 0) (and last-coding-system-used (set-buffer-file-coding-system last-coding-system-used)) (unless shr-fill-text @@ -905,6 +935,11 @@ The renaming scheme is performed in accordance with `((?u . ,(or url "")) (?t . ,title)))))))) +(defun eww--before-browse () + (funcall eww-before-browse-history-function) + (setq eww-history-position 0 + eww-data (list :title ""))) + (defun eww--after-page-change () (eww-update-header-line-format) (eww--rename-buffer)) @@ -1037,6 +1072,7 @@ the like." (base (plist-get eww-data :url))) (eww-score-readability dom) (eww-save-history) + (eww--before-browse) (eww-display-html nil nil (list 'base (list (cons 'href base)) (eww-highest-readability dom)) @@ -1129,9 +1165,9 @@ the like." ["Reload" eww-reload t] ["Follow URL in new buffer" eww-open-in-new-buffer] ["Back to previous page" eww-back-url - :active (not (zerop (length eww-history)))] + :active (< eww-history-position (length eww-history))] ["Forward to next page" eww-forward-url - :active (not (zerop eww-history-position))] + :active (> eww-history-position 1)] ["Browse with external browser" eww-browse-with-external-browser t] ["Download" eww-download t] ["View page source" eww-view-source] @@ -1155,9 +1191,9 @@ the like." (easy-menu-define nil easy-menu nil '("Eww" ["Back to previous page" eww-back-url - :visible (not (zerop (length eww-history)))] + :active (< eww-history-position (length eww-history))] ["Forward to next page" eww-forward-url - :visible (not (zerop eww-history-position))] + :active (> eww-history-position 1)] ["Reload" eww-reload t])) (dolist (item (reverse (lookup-key easy-menu [menu-bar eww]))) (when (consp item) @@ -1280,16 +1316,20 @@ instead of `browse-url-new-window-flag'." (interactive nil eww-mode) (when (>= eww-history-position (length eww-history)) (user-error "No previous page")) - (eww-save-history) - (setq eww-history-position (+ eww-history-position 2)) + (if (eww-save-history) + ;; We were at the latest page (which was just added to the + ;; history), so go back two entries. + (setq eww-history-position 2) + (setq eww-history-position (1+ eww-history-position))) (eww-restore-history (elt eww-history (1- eww-history-position)))) (defun eww-forward-url () "Go to the next displayed page." (interactive nil eww-mode) - (when (zerop eww-history-position) + (when (<= eww-history-position 1) (user-error "No next page")) (eww-save-history) + (setq eww-history-position (1- eww-history-position)) (eww-restore-history (elt eww-history (1- eww-history-position)))) (defun eww-restore-history (elem) @@ -1959,6 +1999,7 @@ If EXTERNAL is double prefix, browse in new buffer." (eww-same-page-p url (plist-get eww-data :url))) (let ((point (point))) (eww-save-history) + (eww--before-browse) (plist-put eww-data :url url) (goto-char (point-min)) (if-let ((match (text-property-search-forward 'shr-target-id target #'member))) @@ -2289,11 +2330,69 @@ If ERROR-OUT, signal user-error if there are no bookmarks." ;;; History code (defun eww-save-history () + "Save the current page's data to the history. +If the current page is a historial one loaded from +`eww-history' (e.g. by calling `eww-back-url'), this will update the +page's entry in `eww-history' and return nil. Otherwise, add a new +entry to `eww-history' and return t." (plist-put eww-data :point (point)) (plist-put eww-data :text (buffer-string)) - (let ((history-delete-duplicates nil)) - (add-to-history 'eww-history eww-data eww-history-limit t)) - (setq eww-data (list :title ""))) + (if (zerop eww-history-position) + (let ((history-delete-duplicates nil)) + (add-to-history 'eww-history eww-data eww-history-limit t) + (setq eww-history-position 1) + t) + (setf (elt eww-history (1- eww-history-position)) eww-data) + nil)) + +(defun eww-delete-future-history () + "Remove any entries in `eww-history' after the currently-shown one. +This is useful for `eww-before-browse-history-function' to make EWW's +navigation to a new page from a historical one work like other web +browsers: it will delete any \"future\" history elements before adding +the new page to the end of the history. + +For example, if `eww-history' looks like this (going from newest to +oldest, with \"*\" marking the current page): + + E D C* B A + +then calling this function updates `eww-history' to: + + C* B A" + (when (> eww-history-position 1) + (setq eww-history (nthcdr (1- eww-history-position) eww-history) + ;; We don't really need to set this since `eww--before-browse' + ;; sets it too, but this ensures that other callers can use + ;; this function and get the expected results. + eww-history-position 1))) + +(defun eww-clone-previous-history () + "Clone and prepend entries in `eww-history' up to the currently-shown one. +These cloned entries get added to the beginning of `eww-history' so that +it's possible to navigate back to the very first page for this EWW +without deleting any history entries. + +For example, if `eww-history' looks like this (going from newest to +oldest, with \"*\" marking the current page): + + E D C* B A + +then calling this function updates `eww-history' to: + + C* B A E D C B A + +This is useful for setting `eww-before-browse-history-function' (which +see)." + (when (> eww-history-position 1) + (setq eww-history (take eww-history-limit + (append (nthcdr (1- eww-history-position) + eww-history) + eww-history)) + ;; As with `eww-delete-future-history', we don't really need + ;; to set this since `eww--before-browse' sets it too, but + ;; let's be thorough. + eww-history-position 1))) (defvar eww-current-buffer) diff --git a/test/lisp/net/eww-tests.el b/test/lisp/net/eww-tests.el new file mode 100644 index 00000000000..ced84322e3a --- /dev/null +++ b/test/lisp/net/eww-tests.el @@ -0,0 +1,179 @@ +;;; eww-tests.el --- tests for eww.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'eww) + +(defvar eww-test--response-function (lambda (url) (concat "\n" url)) + "A function for returning a mock response for URL. +The default just returns an empty list of headers URL as the body.") + +(defmacro eww-test--with-mock-retrieve (&rest body) + "Evaluate BODY with a mock implementation of `eww-retrieve'. +This avoids network requests during our tests. Additionally, prepare a +temporary EWW buffer for our tests." + (declare (indent 1)) + `(cl-letf (((symbol-function 'eww-retrieve) + (lambda (url callback args) + (with-temp-buffer + (insert (funcall eww-test--response-function url)) + (apply callback nil args))))) + (with-temp-buffer + (eww-mode) + ,@body))) + +(defun eww-test--history-urls () + (mapcar (lambda (elem) (plist-get elem :url)) eww-history)) + +;;; Tests: + +(ert-deftest eww-test/history/new-page () + "Test that when visiting a new page, the previous one goes into the history." + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (should (equal (eww-test--history-urls) + '("http://one.invalid/"))) + (eww "three.invalid") + (should (equal (eww-test--history-urls) + '("http://two.invalid/" + "http://one.invalid/"))))) + +(ert-deftest eww-test/history/back-forward () + "Test that navigating through history just changes our history position. +See bug#69232." + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (let ((url-history '("http://three.invalid/" + "http://two.invalid/" + "http://one.invalid/"))) + ;; Go back one page. This should add "three.invalid" to the + ;; history, making our position in the list 2. + (eww-back-url) + (should (equal (eww-test--history-urls) url-history)) + (should (= eww-history-position 2)) + ;; Go back again. + (eww-back-url) + (should (equal (eww-test--history-urls) url-history)) + (should (= eww-history-position 3)) + ;; At the beginning of the history, so trying to go back should + ;; signal an error. + (should-error (eww-back-url)) + ;; Go forward once. + (eww-forward-url) + (should (equal (eww-test--history-urls) url-history)) + (should (= eww-history-position 2)) + ;; Go forward again. + (eww-forward-url) + (should (equal (eww-test--history-urls) url-history)) + (should (= eww-history-position 1)) + ;; At the end of the history, so trying to go forward should + ;; signal an error. + (should-error (eww-forward-url))))) + +(ert-deftest eww-test/history/reload-in-place () + "Test that reloading historical pages updates their history entry in-place. +See bug#69232." + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (eww-back-url) + ;; Make sure our history has the original page text. + (should (equal (plist-get (nth 1 eww-history) :text) + "http://two.invalid/")) + (should (= eww-history-position 2)) + ;; Reload the page. + (let ((eww-test--response-function + (lambda (url) (concat "\nreloaded " url)))) + (eww-reload) + (should (= eww-history-position 2))) + ;; Go to another page, and make sure the history is correct, + ;; including the reloaded page text. + (eww "four.invalid") + (should (equal (eww-test--history-urls) '("http://two.invalid/" + "http://one.invalid/"))) + (should (equal (plist-get (nth 0 eww-history) :text) + "reloaded http://two.invalid/")) + (should (= eww-history-position 0)))) + +(ert-deftest eww-test/history/before-navigate/delete-future-history () + "Test that going to a new page from a historical one deletes future history. +See bug#69232." + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (eww-back-url) + (eww "four.invalid") + (eww "five.invalid") + (should (equal (eww-test--history-urls) '("http://four.invalid/" + "http://two.invalid/" + "http://one.invalid/"))) + (should (= eww-history-position 0)))) + +(ert-deftest eww-test/history/before-navigate/ignore-history () + "Test that going to a new page from a historical one preserves history. +This sets `eww-before-browse-history-function' to `ignore' to preserve +history. See bug#69232." + (let ((eww-before-browse-history-function #'ignore)) + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (eww-back-url) + (eww "four.invalid") + (eww "five.invalid") + (should (equal (eww-test--history-urls) '("http://four.invalid/" + "http://three.invalid/" + "http://two.invalid/" + "http://one.invalid/"))) + (should (= eww-history-position 0))))) + +(ert-deftest eww-test/history/before-navigate/clone-previous () + "Test that going to a new page from a historical one clones prior history. +This sets `eww-before-browse-history-function' to +`eww-clone-previous-history' to clone the history. See bug#69232." + (let ((eww-before-browse-history-function #'eww-clone-previous-history)) + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (eww-back-url) + (eww "four.invalid") + (eww "five.invalid") + (should (equal (eww-test--history-urls) + '(;; New page and cloned history. + "http://four.invalid/" + "http://two.invalid/" + "http://one.invalid/" + ;; Original history. + "http://three.invalid/" + "http://two.invalid/" + "http://one.invalid/"))) + (should (= eww-history-position 0))))) + +(provide 'eww-tests) +;; eww-tests.el ends here -- cgit v1.2.3 From 8aabd835747297818d538cc16b3f53fcc1dd67f6 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 7 Mar 2024 09:56:02 +0200 Subject: * lisp/follow.el: Put property 'isearch-scroll' on 'follow-recenter'. --- lisp/follow.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/follow.el b/lisp/follow.el index ce40317ca59..874e546bd6d 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -874,6 +874,7 @@ from the bottom." (when (< dest win-s) (setq follow-internal-force-redisplay t)))))) +(put 'follow-recenter 'isearch-scroll t) (defun follow-redraw () "Arrange windows displaying the same buffer in successor order. -- cgit v1.2.3 From 5ffcca121bb79b97c6a0f941c71a61505032d8f8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 7 Mar 2024 10:11:44 +0200 Subject: ; Improve documentation of image properties * lisp/image.el (create-image, image-property): Add to do strings link to description of image properties in ELisp manual. * doc/lispref/display.texi (Defining Images): Fix example and add cross-reference to where image properties are described. (Image Descriptors): Add index entry. --- doc/lispref/display.texi | 9 +++++++-- lisp/image.el | 16 ++++++++++++---- 2 files changed, 19 insertions(+), 6 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 34f215820ed..c6b29e87b3a 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -6041,6 +6041,7 @@ event is composed by combining the @var{id} of the hot-spot with the mouse event; for instance, @code{[area4 mouse-1]} if the hot-spot's @var{id} is @code{area4}. +@findex image-compute-scaling-factor Note that the map's coordinates should reflect the displayed image after all transforms have been done (rotation, scaling and so on), and also note that Emacs (by default) performs auto-scaling of images, so @@ -6759,11 +6760,15 @@ from the file's name. The remaining arguments, @var{props}, specify additional image properties---for example, -@c ':heuristic-mask' is not documented? @example -(create-image "foo.xpm" 'xpm nil :heuristic-mask t) +(create-image "foo.xpm" 'xpm nil :mask 'heuristic) @end example +@noindent +@xref{Image Descriptors}, for the list of supported properties. Some +properties are specific to certain image types, and are described in +subsections specific to those types. + The function returns @code{nil} if images of this type are not supported. Otherwise it returns an image descriptor. @end defun diff --git a/lisp/image.el b/lisp/image.el index ef29698f647..4e50f678433 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -494,9 +494,13 @@ use its file extension as image type. Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data. Optional PROPS are additional image attributes to assign to the image, -like, e.g. `:mask MASK'. If the property `:scale' is not given and the -display has a high resolution (more exactly, when the average width of a -character in the default font is more than 10 pixels), the image is +like, e.g. `:mask MASK'. See Info node `(elisp)Image Descriptors' for +the list of supported properties; see the nodes following that node +for properties specific to certain image types. + +If the property `:scale' is not given and the display has a high +resolution (more exactly, when the average width of a character +in the default font is more than 10 pixels), the image is automatically scaled up in proportion to the default font. Value is the image created, or nil if images of type TYPE are not supported. @@ -571,7 +575,11 @@ Internal use only." Properties can be set with (setf (image-property IMAGE PROPERTY) VALUE) -If VALUE is nil, PROPERTY is removed from IMAGE." +If VALUE is nil, PROPERTY is removed from IMAGE. + +See Info node `(elisp)Image Descriptors' for the list of +supported properties; see the nodes following that node for +properties specific to certain image types." (declare (gv-setter image--set-property)) (plist-get (cdr image) property)) -- cgit v1.2.3 From 61b2f5f96b1d9dfd2fd908e09fac0d4163049c42 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Wed, 6 Mar 2024 12:03:06 +0100 Subject: Single string literal in body is return value only, not doc string A function or macro body consisting of a single string literal now only uses it as a return value. Previously, it had the dual uses as return value and doc string, which was never what the programmer wanted and had some inconvenient consequences (bug#69387). This change applies to `lambda`, `defun`, `defsubst` and `defmacro` forms; most other defining forms already worked in the sensible way. * lisp/emacs-lisp/bytecomp.el (byte-compile-lambda): Don't use a lone string literal as doc string. * test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el (foo): Update docstring warning test. * doc/lispref/functions.texi (Function Documentation): Update. * etc/NEWS: Announce. --- doc/lispref/functions.texi | 13 ++++++------- etc/NEWS | 16 ++++++++++++++++ lisp/emacs-lisp/bytecomp.el | 9 ++++----- .../bytecomp-resources/warn-wide-docstring-defun.el | 3 ++- 4 files changed, 28 insertions(+), 13 deletions(-) diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 344b3ff3a50..ff635fc54b2 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -498,13 +498,12 @@ indentation of the following lines is inside the string; what looks nice in the source code will look ugly when displayed by the help commands. - You may wonder how the documentation string could be optional, since -there are required components of the function that follow it (the body). -Since evaluation of a string returns that string, without any side effects, -it has no effect if it is not the last form in the body. Thus, in -practice, there is no confusion between the first form of the body and the -documentation string; if the only body form is a string then it serves both -as the return value and as the documentation. + A documentation string must always be followed by at least one Lisp +expression; otherwise, it is not a documentation string at all but the +single expression of the body and used as the return value. +When there is no meaningful value to return from a function, it is +standard practice to return @code{nil} by adding it after the +documentation string. The last line of the documentation string can specify calling conventions different from the actual function arguments. Write diff --git a/etc/NEWS b/etc/NEWS index 745b3b12936..3a57084688d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1818,6 +1818,22 @@ Tree-sitter conditionally sets 'forward-sexp-function' for major modes that have defined 'sexp' in 'treesit-thing-settings' to enable sexp-related motion commands. ++++ +** Returned strings are never docstrings. +Functions and macros whose bodies consist of a single string literal now +only return that string; it is not used as a docstring. Example: + + (defun sing-a-song () + "Sing a song.") + +The above function returns the string '"Sing a song."' but has no +docstring. Previously, that string was used as both a docstring and +return value, which was never what the programmer wanted. If you want +the string to be a docstring, add an explicit return value. + +This change applies to 'defun', 'defsubst', 'defmacro' and 'lambda' +forms; other defining forms such as 'cl-defun' already worked this way. + ** New or changed byte-compilation warnings --- diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index c3355eedd75..cf0e6d600dd 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3061,12 +3061,11 @@ lambda-expression." (append (if (not lexical-binding) arglistvars) byte-compile-bound-variables)) (body (cdr (cdr fun))) - (doc (if (stringp (car body)) + ;; Treat a final string literal as a value, not a doc string. + (doc (if (and (cdr body) (stringp (car body))) (prog1 (car body) - ;; Discard the doc string from the body - ;; unless it is the last element of the body. - (if (cdr body) - (setq body (cdr body)))))) + ;; Discard the doc string from the body. + (setq body (cdr body))))) (int (assq 'interactive body)) command-modes) (when lexical-binding diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el index 94b0e80c979..571f7f6f095 100644 --- a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el @@ -1,3 +1,4 @@ ;;; -*- lexical-binding: t -*- (defun foo () - "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") + "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" + nil) -- cgit v1.2.3 From 90c2e287b7654c22b66012059c953c976c1596c1 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 7 Mar 2024 14:29:36 +0100 Subject: Revert "Suppress docstring control char warning in macro-generated function" This reverts commit eeb89a5cb292bffe40ba7d0b0cf81f82f8452bf8. It is no longer needed now that (lambda (...) "string") does not have a doc string (bug#69387). --- lisp/progmodes/cc-defs.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 2c793c8a99d..e45ab76ec07 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -2579,8 +2579,7 @@ constant. A file is identified by its base name." ;; dependencies on the `c-lang-const's in VAL.) (setq val (c--macroexpand-all val)) - (setq bindings `(cons (cons ',assigned-mode (lambda () nil ,val)) - ,bindings) + (setq bindings `(cons (cons ',assigned-mode (lambda () ,val)) ,bindings) args (cdr args)))) ;; Compile in the other files that have provided source -- cgit v1.2.3 From aec0f610cb5aace1301cd230e57844a93d40cccd Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Thu, 7 Mar 2024 12:19:28 -0800 Subject: ; * test/lisp/net/eww-tests.el (eww-test--response-function): Fix typo. --- test/lisp/net/eww-tests.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/lisp/net/eww-tests.el b/test/lisp/net/eww-tests.el index ced84322e3a..bd00893d503 100644 --- a/test/lisp/net/eww-tests.el +++ b/test/lisp/net/eww-tests.el @@ -26,7 +26,8 @@ (defvar eww-test--response-function (lambda (url) (concat "\n" url)) "A function for returning a mock response for URL. -The default just returns an empty list of headers URL as the body.") +The default just returns an empty list of headers and the URL as the +body.") (defmacro eww-test--with-mock-retrieve (&rest body) "Evaluate BODY with a mock implementation of `eww-retrieve'. -- cgit v1.2.3 From e42f14f0e034d0b20c6b9fd0fea23686699e7df0 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Wed, 6 Mar 2024 13:27:07 -0800 Subject: Support expanding Eshell globs for remote file names * lisp/eshell/em-glob.el (eshell-glob-chars-regexp): New function... (eshell-glob-regexp): ... use it. (eshell-glob-p): New function... (eshell-glob-convert): ... use it, and return the deepest start directory possible. * lisp/eshell/esh-util.el (eshell-split-path): Rename to... (eshell-split-path): ... this, and account for remote file names. * test/lisp/eshell/em-glob-tests.el (em-glob-test/convert/current-start-directory) (em-glob-test/convert/relative-start-directory) (em-glob-test/convert/absolute-start-directory) (em-glob-test/convert/remote-start-directory): New tests (bug#69592). --- lisp/eshell/em-glob.el | 36 +++++++++++++++++---------- lisp/eshell/esh-util.el | 51 +++++++++++++++++++++------------------ test/lisp/eshell/em-glob-tests.el | 30 +++++++++++++++++++++++ 3 files changed, 81 insertions(+), 36 deletions(-) diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index b0c3e6e7a11..7fc6958a00f 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -190,6 +190,12 @@ interpretation." '(("**/" . recurse) ("***/" . recurse-symlink))) +(defsubst eshell-glob-chars-regexp () + "Return the lazily-created value for `eshell-glob-chars-regexp'." + (or eshell-glob-chars-regexp + (setq-local eshell-glob-chars-regexp + (format "[%s]+" (apply 'string eshell-glob-chars-list))))) + (defun eshell-glob-regexp (pattern) "Convert glob-pattern PATTERN to a regular expression. The basic syntax is: @@ -210,11 +216,8 @@ set to true, then these characters will match themselves in the resulting regular expression." (let ((matched-in-pattern 0) ; How much of PATTERN handled regexp) - (while (string-match - (or eshell-glob-chars-regexp - (setq-local eshell-glob-chars-regexp - (format "[%s]+" (apply 'string eshell-glob-chars-list)))) - pattern matched-in-pattern) + (while (string-match (eshell-glob-chars-regexp) + pattern matched-in-pattern) (let* ((op-begin (match-beginning 0)) (op-char (aref pattern op-begin))) (setq regexp @@ -239,6 +242,10 @@ resulting regular expression." (regexp-quote (substring pattern matched-in-pattern)) "\\'"))) +(defun eshell-glob-p (pattern) + "Return non-nil if PATTERN has any special glob characters." + (string-match (eshell-glob-chars-regexp) pattern)) + (defun eshell-glob-convert-1 (glob &optional last) "Convert a GLOB matching a single element of a file name to regexps. If LAST is non-nil, this glob is the last element of a file name. @@ -291,14 +298,13 @@ The result is a list of three elements: symlinks. 3. A boolean indicating whether to match directories only." - (let ((globs (eshell-split-path glob)) - (isdir (eq (aref glob (1- (length glob))) ?/)) + (let ((globs (eshell-split-filename glob)) + (isdir (string-suffix-p "/" glob)) start-dir result last-saw-recursion) (if (and (cdr globs) (file-name-absolute-p (car globs))) - (setq start-dir (car globs) - globs (cdr globs)) - (setq start-dir ".")) + (setq start-dir (pop globs)) + (setq start-dir (file-name-as-directory "."))) (while globs (if-let ((recurse (cdr (assoc (car globs) eshell-glob-recursive-alist)))) @@ -306,11 +312,15 @@ The result is a list of three elements: (setcar result recurse) (push recurse result) (setq last-saw-recursion t)) - (push (eshell-glob-convert-1 (car globs) (null (cdr globs))) - result) + (if (or result (eshell-glob-p (car globs))) + (push (eshell-glob-convert-1 (car globs) (null (cdr globs))) + result) + ;; We haven't seen a glob yet, so instead append to the start + ;; directory. + (setq start-dir (file-name-concat start-dir (car globs)))) (setq last-saw-recursion nil)) (setq globs (cdr globs))) - (list (file-name-as-directory start-dir) + (list start-dir (nreverse result) isdir))) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index f0acfecb701..129134814e3 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -447,29 +447,34 @@ Prepend remote identification of `default-directory', if any." (parse-colon-path path-env)) (parse-colon-path path-env)))) -(defun eshell-split-path (path) - "Split a path into multiple subparts." - (let ((len (length path)) - (i 0) (li 0) - parts) - (if (and (eshell-under-windows-p) - (> len 2) - (eq (aref path 0) ?/) - (eq (aref path 1) ?/)) - (setq i 2)) - (while (< i len) - (if (and (eq (aref path i) ?/) - (not (get-text-property i 'escaped path))) - (setq parts (cons (if (= li i) "/" - (substring path li (1+ i))) parts) - li (1+ i))) - (setq i (1+ i))) - (if (< li i) - (setq parts (cons (substring path li i) parts))) - (if (and (eshell-under-windows-p) - (string-match "\\`[A-Za-z]:\\'" (car (last parts)))) - (setcar (last parts) (concat (car (last parts)) "/"))) - (nreverse parts))) +(defun eshell-split-filename (filename) + "Split a FILENAME into a list of file/directory components." + (let* ((remote (file-remote-p filename)) + (filename (file-local-name filename)) + (len (length filename)) + (index 0) (curr-start 0) + parts) + (when (and (eshell-under-windows-p) + (string-prefix-p "//" filename)) + (setq index 2)) + (while (< index len) + (when (and (eq (aref filename index) ?/) + (not (get-text-property index 'escaped filename))) + (push (if (= curr-start index) "/" + (substring filename curr-start (1+ index))) + parts) + (setq curr-start (1+ index))) + (setq index (1+ index))) + (when (< curr-start len) + (push (substring filename curr-start) parts)) + (setq parts (nreverse parts)) + (when (and (eshell-under-windows-p) + (string-match "\\`[A-Za-z]:\\'" (car parts))) + (setcar parts (concat (car parts) "/"))) + (if remote (cons remote parts) parts))) + +(define-obsolete-function-alias 'eshell-split-path + 'eshell-split-filename "30.1") (defun eshell-to-flat-string (value) "Make value a string. If separated by newlines change them to spaces." diff --git a/test/lisp/eshell/em-glob-tests.el b/test/lisp/eshell/em-glob-tests.el index 6d922666ea3..fc460a59eed 100644 --- a/test/lisp/eshell/em-glob-tests.el +++ b/test/lisp/eshell/em-glob-tests.el @@ -61,6 +61,9 @@ component ending in \"symlink\" is treated as a symbolic link." ;;; Tests: + +;; Glob expansion + (ert-deftest em-glob-test/expand/splice-results () "Test that globs are spliced into the argument list when `eshell-glob-splice-results' is non-nil." @@ -115,6 +118,33 @@ value of `eshell-glob-splice-results'." (eshell-command-result-equal "list ${listify *.no}" '(("*.no")))))))) + +;; Glob conversion + +(ert-deftest em-glob-test/convert/current-start-directory () + "Test converting a glob starting in the current directory." + (should (equal (eshell-glob-convert "*.el") + '("./" (("\\`.*\\.el\\'" . "\\`\\.")) nil)))) + +(ert-deftest em-glob-test/convert/relative-start-directory () + "Test converting a glob starting in a relative directory." + (should (equal (eshell-glob-convert "some/where/*.el") + '("./some/where/" (("\\`.*\\.el\\'" . "\\`\\.")) nil)))) + +(ert-deftest em-glob-test/convert/absolute-start-directory () + "Test converting a glob starting in an absolute directory." + (should (equal (eshell-glob-convert "/some/where/*.el") + '("/some/where/" (("\\`.*\\.el\\'" . "\\`\\.")) nil)))) + +(ert-deftest em-glob-test/convert/remote-start-directory () + "Test converting a glob starting in a remote directory." + (should (equal (eshell-glob-convert "/ssh:nowhere.invalid:some/where/*.el") + '("/ssh:nowhere.invalid:/some/where/" + (("\\`.*\\.el\\'" . "\\`\\.")) nil)))) + + +;; Glob matching + (ert-deftest em-glob-test/match-any-string () "Test that \"*\" pattern matches any string." (with-fake-files '("a.el" "b.el" "c.txt" "dir/a.el") -- cgit v1.2.3 From 00f86833ac5423d57825213ef8b611978be0a3eb Mon Sep 17 00:00:00 2001 From: Harald Jörg Date: Fri, 8 Mar 2024 00:37:36 +0100 Subject: ; perl-mode, cperl-mode: Fix $\" in strings (Bug#69604) * lisp/progmodes/perl-mode.el (perl-syntax-propertize-function): Add to syntax-propertize-rules that $ is punctuation in strings. * lisp/progmodes/cperl-mode.el (cperl-find-pods-heres): capture $\ to catch the edge case of "$\"". Make $ a punctuation char in strings and comments. * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-bug-69604): New testcases with various combinations of $ " \ --- lisp/progmodes/cperl-mode.el | 12 ++++++++++-- lisp/progmodes/perl-mode.el | 11 ++++++++++- test/lisp/progmodes/cperl-mode-tests.el | 19 +++++++++++++++++++ 3 files changed, 39 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 113eed64917..10ac80dffd5 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -4014,7 +4014,10 @@ recursive calls in starting lines of here-documents." ;; 1+6+2+1+1+6+1+1+1=20 extra () before this: "\\|" ;; -------- backslash-escaped stuff, don't interpret it - "\\\\\\(['`\"($]\\)") ; BACKWACKED something-hairy + "\\\\\\(['`\"($]\\)" ; BACKWACKED something-hairy + "\\|" + ;; -------- $\ is a variable in code, but not in a string + "\\(\\$\\\\\\)") ""))) warning-message) (unwind-protect @@ -4068,7 +4071,12 @@ recursive calls in starting lines of here-documents." (cperl-modify-syntax-type bb cperl-st-punct))) ;; No processing in strings/comments beyond this point: ((or (nth 3 state) (nth 4 state)) - t) ; Do nothing in comment/string + ;; Edge case: In a double-quoted string, $\ is not the + ;; punctuation variable, $ must not quote \ here. We + ;; generally make $ a punctuation character in strings + ;; and comments (Bug#69604). + (when (match-beginning 22) + (cperl-modify-syntax-type (match-beginning 22) cperl-st-punct))) ((match-beginning 1) ; POD section ;; "\\(\\`\n?\\|^\n\\)=" (setq b (match-beginning 0) diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index f74390841fe..f6c4dbed1e2 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -251,7 +251,16 @@ ;; correctly the \() construct (Bug#11996) as well as references ;; to string values. ("\\(\\\\\\)['`\"($]" (1 (unless (nth 3 (syntax-ppss)) - (string-to-syntax ".")))) + (string-to-syntax ".")))) + ;; A "$" in Perl code must escape the next char to protect against + ;; misinterpreting Perl's punctuation variables as unbalanced + ;; quotes or parens. This is not needed in strings and broken in + ;; the special case of "$\"" (Bug#69604). Make "$" a punctuation + ;; char in strings. + ("\\$" (0 (if (save-excursion + (nth 3 (syntax-ppss (match-beginning 0)))) + (string-to-syntax ".") + (string-to-syntax "/")))) ;; Handle funny names like $DB'stop. ("\\$ ?{?\\^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_")) ;; format statements diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 62b7fdab7f7..9d9718f719c 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -1431,6 +1431,25 @@ cperl-mode fontifies text after the delimiter as Perl code." (should (equal (get-text-property (point) 'face) font-lock-comment-face)))) +(ert-deftest cperl-test-bug-69604 () + "Verify that $\" in a double-quoted string does not end the string. +Both `perl-mode' and `cperl-mode' treat ?$ as a quoting/escaping char to +avoid issues with punctuation variables. In a string, however, this is +not appropriate." + (let ((strings + '("\"$\\\" in string ---\"; # \"" ; $ must not quote \ + "$\" . \" in string ---\"; # \"" ; $ must quote \ + "\"\\$\" . \" in string ---\"; # \""))) ; \$ must not quote + (dolist (string strings) + (with-temp-buffer + (insert string) + (funcall cperl-test-mode) + (font-lock-ensure) + (goto-char (point-min)) + (search-forward "in string") + (should (equal (get-text-property (point) 'face) + font-lock-string-face)))))) + (ert-deftest test-indentation () (ert-test-erts-file (ert-resource-file "cperl-indents.erts"))) -- cgit v1.2.3 From e4d1739a2917a1b2ab279f4765f015e667e07db0 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 8 Mar 2024 10:58:17 +0800 Subject: Declare 124 new Android permissions * doc/emacs/android.texi (Android Environment): Document new permissions and delete recently introduced permissions from the list for Android 5.1 and earlier. * java/AndroidManifest.xml.in: Declare 124 new permissions to enable invoking features they protect from code running inside Emacs. --- doc/emacs/android.texi | 309 +++++++++++++++++++++++++++++++++++++++----- java/AndroidManifest.xml.in | 126 ++++++++++++++++++ 2 files changed, 404 insertions(+), 31 deletions(-) diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi index 0ea96d91492..a45ec84f3f0 100644 --- a/doc/emacs/android.texi +++ b/doc/emacs/android.texi @@ -474,33 +474,200 @@ version of Android being used: @itemize @bullet @item Under more or less recent releases of Android, such as Android 6.0 and -later, Emacs only receives the following permissions upon -installation: +later, Emacs only receives the following permissions upon installation, +subject to the presence or absence of individual permissions in the +version of Android installed: @itemize @minus @item -@code{android.permission.VIBRATE} +@code{android.permission.ACCESS_ADSERVICES_AD_ID} +@item +@code{android.permission.ACCESS_ADSERVICES_ATTRIBUTION} +@item +@code{android.permission.ACCESS_ADSERVICES_CUSTOM_AUDIENCE} +@item +@code{android.permission.ACCESS_ADSERVICES_TOPICS} +@item +@code{android.permission.ACCESS_LOCATION_EXTRA_COMMANDS} @item @code{android.permission.ACCESS_NETWORK_STATE} @item +@code{android.permission.ACCESS_NOTIFICATION_POLICY} +@item +@code{android.permission.ACCESS_WIFI_STATE} +@item +@code{android.permission.AUTHENTICATE_ACCOUNTS} +@item +@code{android.permission.BLUETOOTH} +@item +@code{android.permission.BLUETOOTH_ADMIN} +@item +@code{android.permission.BROADCAST_STICKY} +@item +@code{android.permission.CALL_COMPANION_APP} +@item +@code{android.permission.CHANGE_NETWORK_STATE} +@item +@code{android.permission.CHANGE_WIFI_MULTICAST_STATE} +@item +@code{android.permission.CHANGE_WIFI_STATE} +@item +@code{android.permission.CREDENTIAL_MANAGER_QUERY_CANDIDATE_CREDENTIALS} +@item +@code{android.permission.CREDENTIAL_MANAGER_SET_ALLOWED_PROVIDERS} +@item +@code{android.permission.CREDENTIAL_MANAGER_SET_ORIGIN} +@item +@code{android.permission.DELIVER_COMPANION_MESSAGES} +@item +@code{android.permission.DETECT_SCREEN_CAPTURE} +@item +@code{android.permission.DISABLE_KEYGUARD} +@item +@code{android.permission.ENFORCE_UPDATE_OWNERSHIP} +@item +@code{android.permission.EXPAND_STATUS_BAR} +@item +@code{android.permission.FLASHLIGHT} +@item +@code{android.permission.FOREGROUND_SERVICE} +@item +@code{android.permission.FOREGROUND_SERVICE_CAMERA} +@item +@code{android.permission.FOREGROUND_SERVICE_CONNECTED_DEVICE} +@item +@code{android.permission.FOREGROUND_SERVICE_DATA_SYNC} +@item +@code{android.permission.FOREGROUND_SERVICE_FILE_MANAGEMENT} +@item +@code{android.permission.FOREGROUND_SERVICE_HEALTH} +@item +@code{android.permission.FOREGROUND_SERVICE_LOCATION} +@item +@code{android.permission.FOREGROUND_SERVICE_MEDIA_PLAYBACK} +@item +@code{android.permission.FOREGROUND_SERVICE_MEDIA_PROJECTION} +@item +@code{android.permission.FOREGROUND_SERVICE_MICROPHONE} +@item +@code{android.permission.FOREGROUND_SERVICE_PHONE_CALL} +@item +@code{android.permission.FOREGROUND_SERVICE_REMOTE_MESSAGING} +@item +@code{android.permission.FOREGROUND_SERVICE_SPECIAL_USE} +@item +@code{android.permission.FOREGROUND_SERVICE_SYSTEM_EXEMPTED} +@item +@code{android.permission.GET_PACKAGE_SIZE} +@item +@code{android.permission.GET_TASKS} +@item +@code{android.permission.HIDE_OVERLAY_WINDOWS} +@item +@code{android.permission.HIGH_SAMPLING_RATE_SENSORS} +@item @code{android.permission.INTERNET} @item -@code{android.permission.SET_WALLPAPER} +@code{android.permission.KILL_BACKGROUND_PROCESSES} +@item +@code{android.permission.MANAGE_ACCOUNTS} +@item +@code{android.permission.MANAGE_OWN_CALLS} +@item +@code{android.permission.MODIFY_AUDIO_SETTINGS} @item @code{android.permission.NFC} @item +@code{android.permission.NFC_PREFERRED_PAYMENT_INFO} +@item +@code{android.permission.NFC_TRANSACTION_EVENT} +@item +@code{android.permission.PERSISTENT_ACTIVITY} +@item +@code{android.permission.QUERY_ALL_PACKAGES} +@item +@code{android.permission.READ_BASIC_PHONE_STATE} +@item +@code{android.permission.READ_INSTALL_SESSIONS} +@item +@code{android.permission.READ_NEARBY_STREAMING_POLICY} +@item +@code{android.permission.READ_PROFILE} +@item +@code{android.permission.READ_SOCIAL_STREAM} +@item +@code{android.permission.READ_SYNC_SETTINGS} +@item +@code{android.permission.READ_SYNC_STATS} +@item +@code{android.permission.READ_USER_DICTIONARY} +@item +@code{android.permission.RECEIVE_BOOT_COMPLETED} +@item +@code{android.permission.REORDER_TASKS} +@item +@code{android.permission.REQUEST_COMPANION_PROFILE_GLASSES} +@item +@code{android.permission.REQUEST_COMPANION_PROFILE_WATCH} +@item +@code{android.permission.REQUEST_COMPANION_RUN_IN_BACKGROUND} +@item +@code{android.permission.REQUEST_COMPANION_START_FOREGROUND_SERVICES_FROM_BACKGROUND} +@item +@code{android.permission.REQUEST_COMPANION_USE_DATA_IN_BACKGROUND} +@item +@code{android.permission.REQUEST_DELETE_PACKAGES} +@item +@code{android.permission.REQUEST_IGNORE_BATTERY_OPTIMIZATIONS} +@item +@code{android.permission.REQUEST_OBSERVE_COMPANION_DEVICE_PRESENCE} +@item +@code{android.permission.REQUEST_PASSWORD_COMPLEXITY} +@item +@code{android.permission.RESTART_PACKAGES} +@item +@code{android.permission.RUN_USER_INITIATED_JOBS} +@item +@code{android.permission.SET_WALLPAPER} +@item +@code{android.permission.SET_WALLPAPER_HINTS} +@item +@code{android.permission.SUBSCRIBED_FEEDS_READ} +@item +@code{android.permission.SUBSCRIBED_FEEDS_WRITE} +@item @code{android.permission.TRANSMIT_IR} @item +@code{android.permission.UPDATE_PACKAGES_WITHOUT_USER_ACTION} +@item +@code{android.permission.USE_BIOMETRIC} +@item +@code{android.permission.USE_CREDENTIALS} +@item +@code{android.permission.USE_EXACT_ALARM} +@item +@code{android.permission.USE_FINGERPRINT} +@item +@code{android.permission.USE_FULL_SCREEN_INTENT} +@item +@code{android.permission.VIBRATE} +@item @code{android.permission.WAKE_LOCK} @item -@code{android.permission.FOREGROUND_SERVICE} +@code{android.permission.WRITE_PROFILE} @item -@code{android.permission.FOREGROUND_SERVICE_SPECIAL_USE} +@code{android.permission.WRITE_SMS} +@item +@code{android.permission.WRITE_SOCIAL_STREAM} +@item +@code{android.permission.WRITE_SYNC_SETTINGS} +@item +@code{android.permission.WRITE_USER_DICTIONARY} @end itemize -Other permissions must be granted by the user through the system -settings application. Consult the manufacturer of your device for -more details, as how to do this varies by device. +Other permissions must be granted by the user from the system settings +application. Consult the manufacturer of your device for more details, +as how to do this varies by device. @item On Android 5.1 and earlier, Emacs automatically receives the following @@ -508,59 +675,139 @@ permissions it has requested upon being installed: @itemize @minus @item -@code{android.permission.READ_CONTACTS} +@code{android.permission.ACCESS_COARSE_LOCATION} @item -@code{android.permission.WRITE_CONTACTS} +@code{android.permission.ACCESS_FINE_LOCATION} @item -@code{android.permission.VIBRATE} +@code{android.permission.BODY_SENSORS} @item -@code{android.permission.ACCESS_COARSE_LOCATION} +@code{android.permission.CALL_PHONE} @item -@code{android.permission.ACCESS_NETWORK_STATE} +@code{android.permission.CAMERA} @item -@code{android.permission.INTERNET} +@code{android.permission.CAPTURE_CONSENTLESS_BUGREPORT_ON_USERDEBUG_BUILD} @item -@code{android.permission.SET_WALLPAPER} +@code{android.permission.GET_ACCOUNTS} +@item +@code{android.permission.POST_NOTIFICATIONS} +@item +@code{android.permission.PROCESS_OUTGOING_CALLS} @item @code{android.permission.READ_CALENDAR} @item -@code{android.permission.WRITE_CALENDAR} +@code{android.permission.READ_CALL_LOG} +@item +@code{android.permission.READ_CELL_BROADCASTS} +@item +@code{android.permission.READ_CONTACTS} @item @code{android.permission.READ_EXTERNAL_STORAGE} @item -@code{android.permission.WRITE_EXTERNAL_STORAGE} +@code{android.permission.READ_PHONE_NUMBERS} @item -@code{android.permission.SEND_SMS} +@code{android.permission.READ_PHONE_STATE} @item -@code{android.permission.RECEIVE_SMS} +@code{android.permission.READ_SMS} @item @code{android.permission.RECEIVE_MMS} @item -@code{android.permission.WRITE_SMS} +@code{android.permission.RECEIVE_SMS} @item -@code{android.permission.READ_SMS} +@code{android.permission.RECEIVE_WAP_PUSH} +@item +@code{android.permission.RECORD_AUDIO} +@item +@code{android.permission.REQUEST_INSTALL_PACKAGES} +@item +@code{android.permission.SEND_SMS} +@item +@code{android.permission.SMS_FINANCIAL_TRANSACTIONS} +@item +@code{android.permission.SYSTEM_ALERT_WINDOW} +@item +@code{android.permission.WRITE_CALENDAR} +@item +@code{android.permission.WRITE_CALL_LOG} +@item +@code{android.permission.WRITE_CONTACTS} +@item +@code{android.permission.WRITE_EXTERNAL_STORAGE} +@item +@code{android.permission.WRITE_SETTINGS} +@item +@code{android.permission.ACCESS_LOCATION_EXTRA_COMMANDS} +@item +@code{android.permission.ACCESS_NETWORK_STATE} +@item +@code{android.permission.ACCESS_WIFI_STATE} +@item +@code{android.permission.BLUETOOTH} +@item +@code{android.permission.BLUETOOTH_ADMIN} +@item +@code{android.permission.BROADCAST_STICKY} +@item +@code{android.permission.CHANGE_NETWORK_STATE} +@item +@code{android.permission.CHANGE_WIFI_MULTICAST_STATE} +@item +@code{android.permission.CHANGE_WIFI_STATE} +@item +@code{android.permission.DISABLE_KEYGUARD} +@item +@code{android.permission.EXPAND_STATUS_BAR} +@item +@code{android.permission.FLASHLIGHT} +@item +@code{android.permission.GET_PACKAGE_SIZE} +@item +@code{android.permission.GET_TASKS} +@item +@code{android.permission.INTERNET} +@item +@code{android.permission.KILL_BACKGROUND_PROCESSES} +@item +@code{android.permission.MODIFY_AUDIO_SETTINGS} @item @code{android.permission.NFC} @item -@code{android.permission.TRANSMIT_IR} +@code{android.permission.PERSISTENT_ACTIVITY} @item -@code{android.permission.READ_PHONE_STATE} +@code{android.permission.QUERY_ALL_PACKAGES} @item -@code{android.permission.WAKE_LOCK} +@code{android.permission.READ_BASIC_PHONE_STATE} @item -@code{android.permission.FOREGROUND_SEVICE} +@code{android.permission.READ_SYNC_SETTINGS} @item -@code{android.permission.REQUEST_INSTALL_PACKAGES} +@code{android.permission.READ_SYNC_STATS} +@item +@code{android.permission.READ_USER_DICTIONARY} +@item +@code{android.permission.RECEIVE_BOOT_COMPLETED} +@item +@code{android.permission.REORDER_TASKS} @item @code{android.permission.REQUEST_DELETE_PACKAGES} @item -@code{android.permission.SYSTEM_ALERT_WINDOW} +@code{android.permission.REQUEST_IGNORE_BATTERY_OPTIMIZATIONS} @item -@code{android.permission.RECORD_AUDIO} +@code{android.permission.REQUEST_OBSERVE_COMPANION_DEVICE_PRESENCE} @item -@code{android.permission.CAMERA} +@code{android.permission.RESTART_PACKAGES} @item -@code{android.permission.POST_NOTIFICATIONS} +@code{android.permission.SET_WALLPAPER} +@item +@code{android.permission.SET_WALLPAPER_HINTS} +@item +@code{android.permission.TRANSMIT_IR} +@item +@code{android.permission.VIBRATE} +@item +@code{android.permission.WAKE_LOCK} +@item +@code{android.permission.WRITE_SYNC_SETTINGS} +@item +@code{android.permission.WRITE_USER_DICTIONARY} @end itemize While most of these permissions are left unused by Emacs itself, they diff --git a/java/AndroidManifest.xml.in b/java/AndroidManifest.xml.in index b18446bece0..27af9c912fe 100644 --- a/java/AndroidManifest.xml.in +++ b/java/AndroidManifest.xml.in @@ -64,6 +64,132 @@ along with GNU Emacs. If not, see . --> + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -- cgit v1.2.3 From 9830421e964cfb39077b69efd38d122e3bacf5d4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 7 Mar 2024 16:56:42 -0500 Subject: comp-cstr.el: Fix a minor error and prepare for upcoming changes * lisp/emacs-lisp/comp-cstr.el (comp--cl-class-hierarchy): Add `atom` and `t` only to those types whose "allparents" is clearly not complete. (comp--compute--pred-type-h): Store the cstr rather than the type in the hash-table, as expected by `comp--pred-to-cstr`. --- lisp/emacs-lisp/comp-cstr.el | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 55d92841cd5..1c6acaa6385 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -89,12 +89,15 @@ Integer values are handled in the `range' slot.") (defun comp--cl-class-hierarchy (x) "Given a class name `x' return its hierarchy." - `(,@(cl--class-allparents (cl--struct-get-class x)) - ;; FIXME: AFAICT, `comp--all-classes' will also find those struct types - ;; which use :type and can thus be either `vector' or `cons' (the latter - ;; isn't `atom'). - atom - t)) + (let ((parents (cl--class-allparents (cl--struct-get-class x)))) + (if (memq t parents) + parents + `(,@parents + ;; FIXME: AFAICT, `comp--all-classes' will also find those struct types + ;; which use :type and can thus be either `vector' or `cons' (the latter + ;; isn't `atom'). + atom + t)))) (defun comp--all-classes () "Return all non built-in type names currently defined." @@ -114,7 +117,7 @@ Integer values are handled in the `range' slot.") for class-name in (comp--all-classes) for pred = (get class-name 'cl-deftype-satisfies) when pred - do (puthash pred class-name h) + do (puthash pred (comp--type-to-cstr class-name) h) finally return h)) (cl-defstruct comp-cstr-ctxt -- cgit v1.2.3 From 4fdcbd09af29e72456c9ca4cfbc9f6e97a88f8b8 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 6 Mar 2024 16:32:35 -0500 Subject: cl-preloaded.el (built-in-class): New type Add classes describing the built-in types. * lisp/emacs-lisp/cl-preloaded.el (built-in-class): New type. (cl--define-built-in-type): New aux macro. (all built-in types): "Define" them with it. (cl--builtin-type-p): New aux function. (cl--struct-name-p): Use it. (cl--direct-supertypes-of-type, cl--typeof-types, cl--all-builtin-types): Move the definitions to after the built-in classes are defined, and rewrite to make use of those classes. * lisp/emacs-lisp/cl-extra.el (cl-describe-type): Accept two (unused) optional args, for use with `describe-symbol-backends`. (describe-symbol-backends): Simplify accordingly and add ourselves at the end. (cl--class-children): New function. (cl--describe-class): Use it. Also don't show a silly empty list of slots for the built-in types. --- etc/NEWS | 5 + lisp/emacs-lisp/cl-extra.el | 56 ++++++---- lisp/emacs-lisp/cl-preloaded.el | 241 +++++++++++++++++++++++++++------------- 3 files changed, 200 insertions(+), 102 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 3a57084688d..2aa669be344 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1612,6 +1612,11 @@ values. * Lisp Changes in Emacs 30.1 +** Built-in types have now corresponding classes. +At the Lisp level, this means that things like (cl-find-class 'integer) +will now return a class object, and at the UI level it means that +things like 'C-h o integer RET' will show some information about that type. + ** New var 'major-mode-remap-defaults' and function 'major-mode-remap'. The first is like Emacs-29's 'major-mode-remap-alist' but to be set by packages (instead of users). The second looks up those two variables. diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 9281cd9821e..c8eaca9a77c 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -714,7 +714,9 @@ PROPLIST is a list of the sort returned by `symbol-plist'. ;; FIXME: We could go crazy and add another entry so describe-symbol can be ;; used with the slot names of CL structs (and/or EIEIO objects). (add-to-list 'describe-symbol-backends - `(nil ,#'cl-find-class ,(lambda (s _b _f) (cl-describe-type s)))) + `(nil ,#'cl-find-class ,#'cl-describe-type) + ;; Document the `cons` function before the `cons` type. + t) (defconst cl--typedef-regexp (concat "(" (regexp-opt '("defclass" "defstruct" "cl-defstruct" @@ -744,7 +746,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'" (cl--find-class type)) ;;;###autoload -(defun cl-describe-type (type) +(defun cl-describe-type (type &optional _buf _frame) "Display the documentation for type TYPE (a symbol)." (interactive (let ((str (completing-read "Describe type: " obarray #'cl-find-class t))) @@ -766,6 +768,15 @@ Call `cl--find-class' to get TYPE's propname `cl--class'" ;; Return the text we displayed. (buffer-string))))) +(defun cl--class-children (class) + (let ((children '())) + (mapatoms + (lambda (sym) + (let ((sym-class (cl--find-class sym))) + (and sym-class (memq class (cl--class-parents sym-class)) + (push sym children))))) + children)) + (defun cl--describe-class (type &optional class) (unless class (setq class (cl--find-class type))) (let ((location (find-lisp-object-file-name type 'define-type)) @@ -796,10 +807,8 @@ Call `cl--find-class' to get TYPE's propname `cl--class'" (insert (substitute-command-keys (if pl "', " "'")))) (insert ".\n"))) - ;; Children, if available. ¡For EIEIO! - (let ((ch (condition-case nil - (cl-struct-slot-value metatype 'children class) - (cl-struct-unknown-slot nil))) + ;; Children. + (let ((ch (cl--class-children class)) cur) (when ch (insert " Children ") @@ -903,22 +912,25 @@ Outputs to the current buffer." (cslots (condition-case nil (cl-struct-slot-value metatype 'class-slots class) (cl-struct-unknown-slot nil)))) - (insert (propertize "Instance Allocated Slots:\n\n" - 'face 'bold)) - (let* ((has-doc nil) - (slots-strings - (mapcar - (lambda (slot) - (list (cl-prin1-to-string (cl--slot-descriptor-name slot)) - (cl-prin1-to-string (cl--slot-descriptor-type slot)) - (cl-prin1-to-string (cl--slot-descriptor-initform slot)) - (let ((doc (alist-get :documentation - (cl--slot-descriptor-props slot)))) - (if (not doc) "" - (setq has-doc t) - (substitute-command-keys doc))))) - slots))) - (cl--print-table `("Name" "Type" "Default") slots-strings has-doc)) + (if (and (null slots) (eq metatype 'built-in-class)) + (insert "This is a built-in type.\n") + + (insert (propertize "Instance Allocated Slots:\n\n" + 'face 'bold)) + (let* ((has-doc nil) + (slots-strings + (mapcar + (lambda (slot) + (list (cl-prin1-to-string (cl--slot-descriptor-name slot)) + (cl-prin1-to-string (cl--slot-descriptor-type slot)) + (cl-prin1-to-string (cl--slot-descriptor-initform slot)) + (let ((doc (alist-get :documentation + (cl--slot-descriptor-props slot)))) + (if (not doc) "" + (setq has-doc t) + (substitute-command-keys doc))))) + slots))) + (cl--print-table `("Name" "Type" "Default") slots-strings has-doc))) (insert "\n") (when (> (length cslots) 0) (insert (propertize "\nClass Allocated Slots:\n\n" 'face 'bold)) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index ea08d35ecec..882b4b5939b 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -50,90 +50,16 @@ (apply #'error string (append sargs args)) (signal 'cl-assertion-failed `(,form ,@sargs))))) -(defconst cl--direct-supertypes-of-type - ;; Please run `sycdoc-update-type-hierarchy' in - ;; `admin/syncdoc-type-hierarchy.el' each time this is modified to - ;; reflect the change in the documentation. - (let ((table (make-hash-table :test #'eq))) - ;; FIXME: Our type DAG has various quirks: - ;; - `subr' says it's a `compiled-function' but that's not true - ;; for those subrs that are special forms! - ;; - Some `keyword's are also `symbol-with-pos' but that's not reflected - ;; in the DAG. - ;; - An OClosure can be an interpreted function or a `byte-code-function', - ;; so the DAG of OClosure types is "orthogonal" to the distinction - ;; between interpreted and compiled functions. - (dolist (x '((sequence t) - (atom t) - (list sequence) - (array sequence atom) - (float number) - (integer number integer-or-marker) - (marker integer-or-marker) - (integer-or-marker number-or-marker) - (number number-or-marker) - (bignum integer) - (fixnum integer) - (keyword symbol) - (boolean symbol) - (symbol-with-pos symbol) - (vector array) - (bool-vector array) - (char-table array) - (string array) - ;; FIXME: This results in `atom' coming before `list' :-( - (null boolean list) - (cons list) - (function atom) - (byte-code-function compiled-function) - (subr compiled-function) - (module-function function) - (compiled-function function) - (subr-native-elisp subr) - (subr-primitive subr))) - (puthash (car x) (cdr x) table)) - ;; And here's the flat part of the hierarchy. - (dolist (atom '( tree-sitter-compiled-query tree-sitter-node - tree-sitter-parser user-ptr - font-object font-entity font-spec - condvar mutex thread terminal hash-table frame - ;; function ;; FIXME: can be a list as well. - buffer window process window-configuration - overlay number-or-marker - symbol obarray native-comp-unit)) - (cl-assert (null (gethash atom table))) - (puthash atom '(atom) table)) - table) - "Hash table TYPE -> SUPERTYPES.") - -(defconst cl--typeof-types - (letrec ((alist nil) - (allparents - (lambda (type) - ;; FIXME: copy&pasted from `cl--class-allparents'. - (let ((parents (gethash type cl--direct-supertypes-of-type))) - (unless parents - (message "Warning: Type without parent: %S!" type)) - (cons type - (merge-ordered-lists - ;; FIXME: Can't remember why `t' is excluded. - (mapcar allparents (remq t parents)))))))) - (maphash (lambda (type _) - (push (funcall allparents type) alist)) - cl--direct-supertypes-of-type) - alist) - "Alist of supertypes. -Each element has the form (TYPE . SUPERTYPES) where TYPE is one of -the symbols returned by `type-of', and SUPERTYPES is the list of its -supertypes from the most specific to least specific.") - -(defconst cl--all-builtin-types - (delete-dups (copy-sequence (apply #'append cl--typeof-types)))) +(defun cl--builtin-type-p (name) + (if (not (fboundp 'built-in-class-p)) ;; Early bootstrap + nil + (let ((class (and (symbolp name) (get name 'cl--class)))) + (and class (built-in-class-p class))))) (defun cl--struct-name-p (name) "Return t if NAME is a valid structure name for `cl-defstruct'." (and name (symbolp name) (not (keywordp name)) - (not (memq name cl--all-builtin-types)))) + (not (cl--builtin-type-p name)))) ;; When we load this (compiled) file during pre-loading, the cl--struct-class ;; code below will need to access the `cl-struct' info, since it's considered @@ -366,6 +292,161 @@ supertypes from the most specific to least specific.") (merge-ordered-lists (mapcar #'cl--class-allparents (cl--class-parents class))))) +(cl-defstruct (built-in-class + (:include cl--class) + (:constructor nil) + (:constructor built-in-class--make (name docstring parents)) + (:copier nil)) + ) + +(defmacro cl--define-built-in-type (name parents &optional docstring &rest _slots) + ;; `slots' is currently unused, but we could make it take + ;; a list of "slot like properties" together with the corresponding + ;; accessor, and then we could maybe even make `slot-value' work + ;; on some built-in types :-) + (declare (indent 2) (doc-string 3)) + (unless (listp parents) (setq parents (list parents))) + (unless (or parents (eq name t)) + (error "Missing parents for %S: %S" name parents)) + `(progn + (put ',name 'cl--class + (built-in-class--make ',name ,docstring + (mapcar (lambda (type) + (let ((class (get type 'cl--class))) + (unless class + (error "Unknown type: %S" type)) + class)) + ',parents))))) + +;; FIXME: Our type DAG has various quirks: +;; - `subr' says it's a `compiled-function' but that's not true +;; for those subrs that are special forms! +;; - Some `keyword's are also `symbol-with-pos' but that's not reflected +;; in the DAG. +;; - An OClosure can be an interpreted function or a `byte-code-function', +;; so the DAG of OClosure types is "orthogonal" to the distinction +;; between interpreted and compiled functions. + +(cl--define-built-in-type t nil "The type of everything.") +(cl--define-built-in-type atom t "The type of anything but cons cells.") + +(cl--define-built-in-type tree-sitter-compiled-query atom) +(cl--define-built-in-type tree-sitter-node atom) +(cl--define-built-in-type tree-sitter-parser atom) +(cl--define-built-in-type user-ptr atom) +(cl--define-built-in-type font-object atom) +(cl--define-built-in-type font-entity atom) +(cl--define-built-in-type font-spec atom) +(cl--define-built-in-type condvar atom) +(cl--define-built-in-type mutex atom) +(cl--define-built-in-type thread atom) +(cl--define-built-in-type terminal atom) +(cl--define-built-in-type hash-table atom) +(cl--define-built-in-type frame atom) +(cl--define-built-in-type buffer atom) +(cl--define-built-in-type window atom) +(cl--define-built-in-type process atom) +(cl--define-built-in-type window-configuration atom) +(cl--define-built-in-type overlay atom) +(cl--define-built-in-type number-or-marker atom + "Abstract super type of both `number's and `marker's.") +(cl--define-built-in-type symbol atom + "Type of symbols." + ;; Example of slots we could document. It would be desirable to + ;; have some way to extract this from the C code, or somehow keep it + ;; in sync (probably not for `cons' and `symbol' but for things like + ;; `font-entity'). + (name symbol-name) + (value symbol-value) + (function symbol-function) + (plist symbol-plist)) + +(cl--define-built-in-type obarray atom) +(cl--define-built-in-type native-comp-unit atom) + +(cl--define-built-in-type sequence t "Abstract super type of sequences.") +(cl--define-built-in-type list sequence) +(cl--define-built-in-type array (sequence atom) "Abstract super type of arrays.") +(cl--define-built-in-type number (number-or-marker) + "Abstract super type of numbers.") +(cl--define-built-in-type float (number)) +(cl--define-built-in-type integer-or-marker (number-or-marker) + "Abstract super type of both `integer's and `marker's.") +(cl--define-built-in-type integer (number integer-or-marker)) +(cl--define-built-in-type marker (integer-or-marker)) +(cl--define-built-in-type bignum (integer) + "Type of those integers too large to fit in a `fixnum'.") +(cl--define-built-in-type fixnum (integer) + (format "Type of small (fixed-size) integers. +The size depends on the Emacs version and compilation options. +For this build of Emacs it's %dbit." + (1+ (logb (1+ most-positive-fixnum))))) +(cl--define-built-in-type keyword (symbol) + "Type of those symbols whose first char is `:'.") +(cl--define-built-in-type boolean (symbol) + "Type of the canonical boolean values, i.e. either nil or t.") +(cl--define-built-in-type symbol-with-pos (symbol) + "Type of symbols augmented with source-position information.") +(cl--define-built-in-type vector (array)) +(cl--define-built-in-type record (atom) + "Abstract type of objects with slots.") +(cl--define-built-in-type bool-vector (array) "Type of bitvectors.") +(cl--define-built-in-type char-table (array) + "Type of special arrays that are indexed by characters.") +(cl--define-built-in-type string (array)) +(cl--define-built-in-type null (boolean list) ;FIXME: `atom' comes before `list'? + "Type of the nil value.") +(cl--define-built-in-type cons (list) + "Type of cons cells." + ;; Example of slots we could document. + (car car) (cdr cdr)) +(cl--define-built-in-type function (atom) + "Abstract super type of function values.") +(cl--define-built-in-type compiled-function (function) + "Abstract type of functions that have been compiled.") +(cl--define-built-in-type byte-code-function (compiled-function) + "Type of functions that have been byte-compiled.") +(cl--define-built-in-type subr (compiled-function) + "Abstract type of functions compiled to machine code.") +(cl--define-built-in-type module-function (function) + "Type of functions provided via the module API.") +(cl--define-built-in-type interpreted-function (function) + "Type of functions that have not been compiled.") +(cl--define-built-in-type subr-native-elisp (subr) + "Type of function that have been compiled by the native compiler.") +(cl--define-built-in-type subr-primitive (subr) + "Type of functions hand written in C.") + +(defconst cl--direct-supertypes-of-type + ;; Please run `sycdoc-update-type-hierarchy' in + ;; `admin/syncdoc-type-hierarchy.el' each time this is modified to + ;; reflect the change in the documentation. + (let ((table (make-hash-table :test #'eq))) + (mapatoms + (lambda (type) + (let ((class (get type 'cl--class))) + (when (built-in-class-p class) + (puthash type (mapcar #'cl--class-name (cl--class-parents class)) + table))))) + table) + "Hash table TYPE -> SUPERTYPES.") + +(defconst cl--typeof-types + (letrec ((alist nil)) + (maphash (lambda (type _) + (let ((class (get type 'cl--class))) + ;; FIXME: Can't remember why `t' is excluded. + (push (remq t (cl--class-allparents class)) alist))) + cl--direct-supertypes-of-type) + alist) + "Alist of supertypes. +Each element has the form (TYPE . SUPERTYPES) where TYPE is one of +the symbols returned by `type-of', and SUPERTYPES is the list of its +supertypes from the most specific to least specific.") + +(defconst cl--all-builtin-types + (delete-dups (copy-sequence (apply #'append cl--typeof-types)))) + (eval-and-compile (cl-assert (null (cl--class-parents (cl--find-class 'cl-structure-object))))) -- cgit v1.2.3 From 76e9c761a45e0157a8ca43eaaf928385d8e0c228 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 7 Mar 2024 15:26:12 -0500 Subject: * lisp/emacs-lisp/oclosure.el (oclosure): Make it a subtype of `function` --- lisp/emacs-lisp/oclosure.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index 26cd8594dfc..977d5735171 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -139,12 +139,15 @@ (:include cl--class) (:copier nil)) "Metaclass for OClosure classes." + ;; The `allparents' slot is used for the predicate that checks if a given + ;; object is an OClosure of a particular type. (allparents nil :read-only t :type (list-of symbol))) (setf (cl--find-class 'oclosure) (oclosure--class-make 'oclosure - "The root parent of all OClosure classes" - nil nil '(oclosure))) + "The root parent of all OClosure types" + nil (list (cl--find-class 'function)) + '(oclosure))) (defun oclosure--p (oclosure) (not (not (oclosure-type oclosure)))) -- cgit v1.2.3 From 7c127fc965fbe781141a6bccbe0b620dc7862b1d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 7 Mar 2024 16:58:15 -0500 Subject: Make "parentless" structs inherit from their builtin type * lisp/emacs-lisp/cl-preloaded.el (cl--struct-register-child): Register child only in struct parents. (cl-struct-define): Put the "type" as parent of parentless :type structs. Copy slots only from struct parent classes. (cl-structure-object): Set (manually) its parent to `record` and remove assertion that it has no parents. --- lisp/emacs-lisp/cl-preloaded.el | 31 ++++++++++++++++++++++--------- 1 file changed, 22 insertions(+), 9 deletions(-) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 882b4b5939b..1b330e7f761 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -112,7 +112,7 @@ (defun cl--struct-register-child (parent tag) ;; Can't use (cl-typep parent 'cl-structure-class) at this stage ;; because `cl-structure-class' is defined later. - (while (recordp parent) + (while (cl--struct-class-p parent) (add-to-list (cl--struct-class-children-sym parent) tag) ;; Only register ourselves as a child of the leftmost parent since structs ;; can only have one parent. @@ -127,9 +127,14 @@ (with-suppressed-warnings ((obsolete cl-old-struct-compat-mode)) (message "cl-old-struct-compat-mode is obsolete!") (cl-old-struct-compat-mode 1))) - (if (eq type 'record) - ;; Defstruct using record objects. - (setq type nil)) + (when (eq type 'record) + ;; Defstruct using record objects. + (setq type nil) + ;; `cl-structure-class' and `cl-structure-object' are allowed to be + ;; defined without specifying the parent, because their parent + ;; doesn't exist yet when they're defined. + (cl-assert (or parent (memq name '(cl-structure-class + cl-structure-object))))) (cl-assert (or type (not named))) (if (boundp children-sym) (add-to-list children-sym tag) @@ -137,7 +142,9 @@ (and (null type) (eq (caar slots) 'cl-tag-slot) ;; Hide the tag slot from "standard" (i.e. non-`type'd) structs. (setq slots (cdr slots))) - (let* ((parent-class (when parent (cl--struct-get-class parent))) + (let* ((parent-class (if parent (cl--struct-get-class parent) + (cl--find-class (if (eq type 'list) 'cons + (or type 'record))))) (n (length slots)) (index-table (make-hash-table :test 'eq :size n)) (vslots (let ((v (make-vector n nil)) @@ -160,7 +167,9 @@ name docstring (unless (symbolp parent-class) (list parent-class)) type named vslots index-table children-sym tag print))) - (unless (symbolp parent-class) + (cl-assert (or (not (symbolp parent-class)) + (memq name '(cl-structure-class cl-structure-object)))) + (when (cl--struct-class-p parent-class) (let ((pslots (cl--struct-class-slots parent-class))) (or (>= n (length pslots)) (let ((ok t)) @@ -417,6 +426,13 @@ For this build of Emacs it's %dbit." (cl--define-built-in-type subr-primitive (subr) "Type of functions hand written in C.") +(unless (cl--class-parents (cl--find-class 'cl-structure-object)) + ;; When `cl-structure-object' is created, built-in classes didn't exist + ;; yet, so we couldn't put `record' as the parent. + ;; Fix it now to close the recursion. + (setf (cl--class-parents (cl--find-class 'cl-structure-object)) + (list (cl--find-class 'record)))) + (defconst cl--direct-supertypes-of-type ;; Please run `sycdoc-update-type-hierarchy' in ;; `admin/syncdoc-type-hierarchy.el' each time this is modified to @@ -447,9 +463,6 @@ supertypes from the most specific to least specific.") (defconst cl--all-builtin-types (delete-dups (copy-sequence (apply #'append cl--typeof-types)))) -(eval-and-compile - (cl-assert (null (cl--class-parents (cl--find-class 'cl-structure-object))))) - ;; Make sure functions defined with cl-defsubst can be inlined even in ;; packages which do not require CL. We don't put an autoload cookie ;; directly on that function, since those cookies only go to cl-loaddefs. -- cgit v1.2.3 From 945af4d9d11192d262f4fabbc66ee83f5beefc86 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 7 Mar 2024 17:45:41 -0500 Subject: eieio-core.el: Always put a parent in the parents of a class * lisp/emacs-lisp/eieio-core.el (eieio-defclass-internal): Always put a parent in the `parents` slot of the class. * lisp/emacs-lisp/eieio.el (eieio-class-parents): Remove the `eieio-default-superclass` if it's the only parent. (child-of-class-p): Handle all classes in the parents. (eieio-default-superclass): Adjust docstring. --- lisp/emacs-lisp/eieio-core.el | 31 +++++++++++-------------------- lisp/emacs-lisp/eieio.el | 12 ++++++++---- 2 files changed, 19 insertions(+), 24 deletions(-) diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 9c526f67204..9945e19c65c 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -293,8 +293,7 @@ See `defclass' for more information." ;; reloading the file that does the `defclass', we don't ;; want to create a new class object. (eieio--class-make cname))) - (groups nil) ;; list of groups id'd from slots - (clearparent nil)) + (groups nil)) ;; list of groups id'd from slots ;; If this class already existed, and we are updating its structure, ;; make sure we keep the old child list. This can cause bugs, but @@ -317,6 +316,9 @@ See `defclass' for more information." (setf (eieio--class-children newc) children) (remhash cname eieio-defclass-autoload-map)))) + (unless (or superclasses (eq cname 'eieio-default-superclass)) + (setq superclasses '(eieio-default-superclass))) + (if superclasses (progn (dolist (p superclasses) @@ -336,16 +338,13 @@ See `defclass' for more information." (push c (eieio--class-parents newc)))))) ;; Reverse the list of our parents so that they are prioritized in ;; the same order as specified in the code. - (cl-callf nreverse (eieio--class-parents newc))) - ;; If there is nothing to loop over, then inherit from the - ;; default superclass. - (unless (eq cname 'eieio-default-superclass) - ;; adopt the default parent here, but clear it later... - (setq clearparent t) - ;; save new child in parent - (cl-pushnew cname (eieio--class-children eieio-default-superclass)) - ;; save parent in child - (setf (eieio--class-parents newc) (list eieio-default-superclass)))) + (cl-callf nreverse (eieio--class-parents newc)) + ;; Before adding new slots, let's add all the methods and classes + ;; in from the parent class. + (eieio-copy-parents-into-subclass newc)) + + (cl-assert (eq cname 'eieio-default-superclass)) + (setf (eieio--class-parents newc) (list (cl--find-class 'record)))) ;; turn this into a usable self-pointing symbol; FIXME: Why? (when eieio-backward-compatibility @@ -376,10 +375,6 @@ See `defclass' for more information." cname) "25.1"))) - ;; Before adding new slots, let's add all the methods and classes - ;; in from the parent class. - (eieio-copy-parents-into-subclass newc) - ;; Store the new class vector definition into the symbol. We need to ;; do this first so that we can call defmethod for the accessor. ;; The vector will be updated by the following while loop and will not @@ -512,10 +507,6 @@ See `defclass' for more information." ;; Set up the options we have collected. (setf (eieio--class-options newc) options) - ;; if this is a superclass, clear out parent (which was set to the - ;; default superclass eieio-default-superclass) - (if clearparent (setf (eieio--class-parents newc) nil)) - ;; Create the cached default object. (let ((cache (make-record newc (+ (length (eieio--class-slots newc)) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index fba69a36a97..74f5e21db7d 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -449,7 +449,12 @@ If EXTRA, include that in the string returned to represent the symbol." (defun eieio-class-parents (class) ;; FIXME: What does "(overload of variable)" mean here? "Return parent classes to CLASS. (overload of variable)." - (eieio--class-parents (eieio--full-class-object class))) + ;; (declare (obsolete cl--class-parents "30.1")) + (let ((parents (eieio--class-parents (eieio--full-class-object class)))) + (if (and (null (cdr parents)) + (eq (car parents) (cl--find-class 'eieio-default-superclass))) + nil + parents))) (define-obsolete-function-alias 'class-parents #'eieio-class-parents "24.4") @@ -497,7 +502,7 @@ If EXTRA, include that in the string returned to represent the symbol." (setq class (eieio--class-object class)) (cl-check-type class eieio--class) (while (and child (not (eq child class))) - (setq p (append p (eieio--class-parents child)) + (setq p (append p (cl--class-parents child)) child (pop p))) (if child t)))) @@ -680,8 +685,7 @@ If SLOT is unbound, do nothing." (defclass eieio-default-superclass nil nil "Default parent class for classes with no specified parent class. -Its slots are automatically adopted by classes with no specified parents. -This class is not stored in the `parent' slot of a class vector." +Its slots are automatically adopted by classes with no specified parents." :abstract t) (setq eieio-default-superclass (cl--find-class 'eieio-default-superclass)) -- cgit v1.2.3 From bd017175d4571e24ef1fdf84676136af1d36002d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 8 Mar 2024 01:48:59 -0500 Subject: Simplify type hierarchy operations Now that built-in types have classes that describe their relationships exactly like struct/eieio/oclosure classes, we can the code that navigates that DAG. * lisp/emacs-lisp/cl-generic.el (cl--generic-struct-tag): Move to `eieio-core.el`. (cl--generic-type-specializers): Rename from `cl--generic-struct-specializers`. Make it work for any class. (cl--generic-typeof-generalizer, cl--generic-oclosure-generalizer): Use it. (cl--generic-struct-generalizer): Delete generalizer. (cl-generic-generalizers :extra "cl-struct"): Delete method. (prefill 0 cl--generic-generalizer): Move to after the typeof. (cl-generic-generalizers :extra "typeof"): Rewrite to use classes rather than `cl--all-builtin-types`. (cl-generic--oclosure-specializers): Delete function. * lisp/emacs-lisp/cl-preloaded.el (cl--direct-supertypes-of-type) (cl--typeof-types, cl--all-builtin-types): Delete constants. * lisp/emacs-lisp/comp-cstr.el (comp--typeof-builtin-types): Delete constant. (comp--cl-class-hierarchy): Simplify. (comp--compute-typeof-types): Simplify now that `comp--cl-class-hierarchy` and `comp--all-classes` work for built-in types as well. (comp--direct-supertypes): Just use `cl--class-parents`. (comp-supertypes): Simplify since typeof-types should now be complete. * lisp/emacs-lisp/eieio-core.el (eieio-defclass-autoload): Use `superclasses` argument, so we can find parents before it's loaded. (eieio--class-precedence-c3, eieio--class-precedence-dfs): Don't add a `eieio-default-superclass` parent any more. (eieio--class/struct-parents): Delete function. (eieio--class-precedence-bfs): Use `eieio--class-parents` instead. Don't stop when reaching `eieio-default-superclass`. (cl--generic-struct-tag): Move from `cl-generic.el`. --- lisp/emacs-lisp/cl-generic.el | 67 ++++++++++------------------------------- lisp/emacs-lisp/cl-preloaded.el | 30 ------------------ lisp/emacs-lisp/comp-cstr.el | 55 +++++---------------------------- lisp/emacs-lisp/eieio-core.el | 51 +++++++++++++++---------------- 4 files changed, 49 insertions(+), 154 deletions(-) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index f439a97f88c..84eb800ec24 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1330,62 +1330,31 @@ These match if the argument is `eql' to VAL." (cl--generic-prefill-dispatchers (terminal-parameter nil 'xterm--set-selection) (eql nil)) -;;; Support for cl-defstructs specializers. +;;; Dispatch on "normal types". -(defun cl--generic-struct-tag (name &rest _) - ;; Use exactly the same code as for `typeof'. - `(if ,name (type-of ,name) 'null)) - -(defun cl--generic-struct-specializers (tag &rest _) +(defun cl--generic-type-specializers (tag &rest _) (and (symbolp tag) - (let ((class (get tag 'cl--class))) - (when (cl-typep class 'cl-structure-class) + (let ((class (cl--find-class tag))) + (when class (cl--class-allparents class))))) -(cl-generic-define-generalizer cl--generic-struct-generalizer - 50 #'cl--generic-struct-tag - #'cl--generic-struct-specializers) - -(cl-defmethod cl-generic-generalizers :extra "cl-struct" (type) - "Support for dispatch on types defined by `cl-defstruct'." - (or - (when (symbolp type) - ;; Use the "cl--struct-class*" (inlinable) functions/macros rather than - ;; the "cl-struct-*" variants which aren't inlined, so that dispatch can - ;; take place without requiring cl-lib. - (let ((class (cl--find-class type))) - (and (cl-typep class 'cl-structure-class) - (or (null (cl--struct-class-type class)) - (error "Can't dispatch on cl-struct %S: type is %S" - type (cl--struct-class-type class))) - (progn (cl-assert (null (cl--struct-class-named class))) t) - (list cl--generic-struct-generalizer)))) - (cl-call-next-method))) - -(cl--generic-prefill-dispatchers 0 cl--generic-generalizer) - -;;; Dispatch on "system types". - (cl-generic-define-generalizer cl--generic-typeof-generalizer ;; FIXME: We could also change `type-of' to return `null' for nil. 10 (lambda (name &rest _) `(if ,name (type-of ,name) 'null)) - (lambda (tag &rest _) - (and (symbolp tag) (assq tag cl--typeof-types)))) + #'cl--generic-type-specializers) (cl-defmethod cl-generic-generalizers :extra "typeof" (type) - "Support for dispatch on builtin types. -See the full list and their hierarchy in `cl--typeof-types'." + "Support for dispatch on types. +This currently works for built-in types and types built on top of records." ;; FIXME: Add support for other types accepted by `cl-typep' such ;; as `character', `face', `function', ... (or - (and (memq type cl--all-builtin-types) - (progn - ;; FIXME: While this wrinkle in the semantics can be occasionally - ;; problematic, this warning is more often annoying than helpful. - ;;(if (memq type '(vector array sequence)) - ;; (message "`%S' also matches CL structs and EIEIO classes" - ;; type)) - (list cl--generic-typeof-generalizer))) + (and (symbolp type) + (not (eq type t)) ;; Handled by the `t-generalizer'. + (let ((class (cl--find-class type))) + (memq (type-of class) + '(built-in-class cl-structure-class eieio--class))) + (list cl--generic-typeof-generalizer)) (cl-call-next-method))) (cl--generic-prefill-dispatchers 0 integer) @@ -1393,6 +1362,8 @@ See the full list and their hierarchy in `cl--typeof-types'." (cl--generic-prefill-dispatchers 0 cl--generic-generalizer integer) (cl--generic-prefill-dispatchers 0 (eql 'x) integer) +(cl--generic-prefill-dispatchers 0 cl--generic-generalizer) + ;;; Dispatch on major mode. ;; Two parts: @@ -1430,19 +1401,13 @@ Used internally for the (major-mode MODE) context specializers." (defun cl--generic-oclosure-tag (name &rest _) `(oclosure-type ,name)) -(defun cl-generic--oclosure-specializers (tag &rest _) - (and (symbolp tag) - (let ((class (cl--find-class tag))) - (when (cl-typep class 'oclosure--class) - (oclosure--class-allparents class))))) - (cl-generic-define-generalizer cl--generic-oclosure-generalizer ;; Give slightly higher priority than the struct specializer, so that ;; for a generic function with methods dispatching structs and on OClosures, ;; we first try `oclosure-type' before `type-of' since `type-of' will return ;; non-nil for an OClosure as well. 51 #'cl--generic-oclosure-tag - #'cl-generic--oclosure-specializers) + #'cl--generic-type-specializers) (cl-defmethod cl-generic-generalizers :extra "oclosure-struct" (type) "Support for dispatch on types defined by `oclosure-define'." diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 1b330e7f761..5743684fa89 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -433,36 +433,6 @@ For this build of Emacs it's %dbit." (setf (cl--class-parents (cl--find-class 'cl-structure-object)) (list (cl--find-class 'record)))) -(defconst cl--direct-supertypes-of-type - ;; Please run `sycdoc-update-type-hierarchy' in - ;; `admin/syncdoc-type-hierarchy.el' each time this is modified to - ;; reflect the change in the documentation. - (let ((table (make-hash-table :test #'eq))) - (mapatoms - (lambda (type) - (let ((class (get type 'cl--class))) - (when (built-in-class-p class) - (puthash type (mapcar #'cl--class-name (cl--class-parents class)) - table))))) - table) - "Hash table TYPE -> SUPERTYPES.") - -(defconst cl--typeof-types - (letrec ((alist nil)) - (maphash (lambda (type _) - (let ((class (get type 'cl--class))) - ;; FIXME: Can't remember why `t' is excluded. - (push (remq t (cl--class-allparents class)) alist))) - cl--direct-supertypes-of-type) - alist) - "Alist of supertypes. -Each element has the form (TYPE . SUPERTYPES) where TYPE is one of -the symbols returned by `type-of', and SUPERTYPES is the list of its -supertypes from the most specific to least specific.") - -(defconst cl--all-builtin-types - (delete-dups (copy-sequence (apply #'append cl--typeof-types)))) - ;; Make sure functions defined with cl-defsubst can be inlined even in ;; packages which do not require CL. We don't put an autoload cookie ;; directly on that function, since those cookies only go to cl-loaddefs. diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 1c6acaa6385..5922a8caf12 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -38,12 +38,6 @@ (require 'cl-lib) (require 'cl-extra) ;HACK: For `cl-find-class' when `cl-loaddefs' is missing. -(defconst comp--typeof-builtin-types (mapcar (lambda (x) - (append x '(t))) - cl--typeof-types) - ;; TODO can we just add t in `cl--typeof-types'? - "Like `cl--typeof-types' but with t as common supertype.") - (cl-defstruct (comp-cstr (:constructor comp--type-to-cstr (type &aux (null (eq type 'null)) @@ -89,15 +83,7 @@ Integer values are handled in the `range' slot.") (defun comp--cl-class-hierarchy (x) "Given a class name `x' return its hierarchy." - (let ((parents (cl--class-allparents (cl--struct-get-class x)))) - (if (memq t parents) - parents - `(,@parents - ;; FIXME: AFAICT, `comp--all-classes' will also find those struct types - ;; which use :type and can thus be either `vector' or `cons' (the latter - ;; isn't `atom'). - atom - t)))) + (cl--class-allparents (cl--find-class x))) (defun comp--all-classes () "Return all non built-in type names currently defined." @@ -109,8 +95,7 @@ Integer values are handled in the `range' slot.") res)) (defun comp--compute-typeof-types () - (append comp--typeof-builtin-types - (mapcar #'comp--cl-class-hierarchy (comp--all-classes)))) + (mapcar #'comp--cl-class-hierarchy (comp--all-classes))) (defun comp--compute--pred-type-h () (cl-loop with h = (make-hash-table :test #'eq) @@ -275,19 +260,10 @@ Return them as multiple value." (symbol-name y))) (defun comp--direct-supertypes (type) - (or - (gethash type cl--direct-supertypes-of-type) - (let ((supers (comp-supertypes type))) - (cl-assert (eq type (car supers))) - (cl-loop - with notdirect = nil - with direct = nil - for parent in (cdr supers) - unless (memq parent notdirect) - do (progn - (push parent direct) - (setq notdirect (append notdirect (comp-supertypes parent)))) - finally return direct)))) + (when (symbolp type) ;; FIXME: Can this test ever fail? + (let* ((class (cl--find-class type)) + (parents (if class (cl--class-parents class)))) + (mapcar #'cl--class-name parents)))) (defsubst comp-subtype-p (type1 type2) "Return t if TYPE1 is a subtype of TYPE2 or nil otherwise." @@ -359,23 +335,8 @@ Return them as multiple value." (defun comp-supertypes (type) "Return the ordered list of supertypes of TYPE." - ;; FIXME: We should probably keep the results in - ;; `comp-cstr-ctxt-typeof-types' (or maybe even precompute them - ;; and maybe turn `comp-cstr-ctxt-typeof-types' into a hash-table). - ;; Or maybe we shouldn't keep structs and defclasses in it, - ;; and just use `cl--class-allparents' when needed (and refuse to - ;; compute their direct subtypes since we can't know them). - (cl-loop - named loop - with above - for lane in (comp-cstr-ctxt-typeof-types comp-ctxt) - do (let ((x (memq type lane))) - (cond - ((null x) nil) - ((eq x lane) (cl-return-from loop x)) ;A base type: easy case. - (t (setq above - (if above (comp--intersection x above) x))))) - finally return above)) + (or (assq type (comp-cstr-ctxt-typeof-types comp-ctxt)) + (error "Type %S missing from typeof-types!" type))) (defun comp-union-typesets (&rest typesets) "Union types present into TYPESETS." diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 9945e19c65c..5418f53be35 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -191,7 +191,7 @@ Abstract classes cannot be instantiated." ;; We autoload this because it's used in `make-autoload'. ;;;###autoload -(defun eieio-defclass-autoload (cname _superclasses filename doc) +(defun eieio-defclass-autoload (cname superclasses filename doc) "Create autoload symbols for the EIEIO class CNAME. SUPERCLASSES are the superclasses that CNAME inherits from. DOC is the docstring for CNAME. @@ -199,15 +199,9 @@ This function creates a mock-class for CNAME and adds it into SUPERCLASSES as children. It creates an autoload function for CNAME's constructor." ;; Assume we've already debugged inputs. - - ;; We used to store the list of superclasses in the `parent' slot (as a list - ;; of class names). But now this slot holds a list of class objects, and - ;; those parents may not exist yet, so the corresponding class objects may - ;; simply not exist yet. So instead we just don't store the list of parents - ;; here in eieio-defclass-autoload at all, since it seems that they're just - ;; not needed before the class is actually loaded. (let* ((oldc (cl--find-class cname)) - (newc (eieio--class-make cname))) + (newc (eieio--class-make cname)) + (parents (mapcar #'cl-find-class superclasses))) (if (eieio--class-p oldc) nil ;; Do nothing if we already have this class. @@ -218,6 +212,12 @@ It creates an autoload function for CNAME's constructor." use '%s or turn off `eieio-backward-compatibility' instead" cname) "25.1")) + (when (memq nil parents) + ;; If some parents aren't yet fully defined, just ignore them for now. + (setq parents (delq nil parents))) + (unless parents + (setq parents (list (cl--find-class 'eieio-default-superclass)))) + (setf (cl--class-parents newc) parents) (setf (cl--find-class cname) newc) ;; Create an autoload on top of our constructor function. @@ -958,19 +958,13 @@ need be... May remove that later...)" (cdr tuple) nil))) -(defsubst eieio--class/struct-parents (class) - (or (eieio--class-parents class) - `(,eieio-default-superclass))) - (defun eieio--class-precedence-c3 (class) "Return all parents of CLASS in c3 order." (let ((parents (eieio--class-parents class))) (cons class (merge-ordered-lists (append - (or - (mapcar #'eieio--class-precedence-c3 parents) - `((,eieio-default-superclass))) + (mapcar #'eieio--class-precedence-c3 parents) (list parents)) (lambda (remaining-inputs) (signal 'inconsistent-class-hierarchy @@ -984,13 +978,11 @@ need be... May remove that later...)" (classes (copy-sequence (apply #'append (list class) - (or - (mapcar - (lambda (parent) - (cons parent - (eieio--class-precedence-dfs parent))) - parents) - `((,eieio-default-superclass)))))) + (mapcar + (lambda (parent) + (cons parent + (eieio--class-precedence-dfs parent))) + parents)))) (tail classes)) ;; Remove duplicates. (while tail @@ -1003,13 +995,12 @@ need be... May remove that later...)" (defun eieio--class-precedence-bfs (class) "Return all parents of CLASS in breadth-first order." (let* ((result) - (queue (eieio--class/struct-parents class))) + (queue (eieio--class-parents class))) (while queue (let ((head (pop queue))) (unless (member head result) (push head result) - (unless (eq head eieio-default-superclass) - (setq queue (append queue (eieio--class/struct-parents head))))))) + (setq queue (append queue (eieio--class-parents head)))))) (cons class (nreverse result))) ) @@ -1049,6 +1040,14 @@ method invocation orders of the involved classes." ;;;; General support to dispatch based on the type of the argument. +;; FIXME: We could almost use the typeof-generalizer (i.e. the same as +;; used for cl-structs), except that that generalizer doesn't support +;; `:method-invocation-order' :-( + +(defun cl--generic-struct-tag (name &rest _) + ;; Use exactly the same code as for `typeof'. + `(if ,name (type-of ,name) 'null)) + (cl-generic-define-generalizer eieio--generic-generalizer ;; Use the exact same tagcode as for cl-struct, so that methods ;; that dispatch on both kinds of objects get to share this -- cgit v1.2.3 From cc75e103dd2a9d47f29addcc724812162c1a2626 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 8 Mar 2024 20:47:23 +0800 Subject: Update android_wc_lookup_string * src/android.c (android_wc_lookup_string): Don't clear compose state upon modifier key depress. --- src/android.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/android.c b/src/android.c index 5b3fbb25373..d7bd06f1f34 100644 --- a/src/android.c +++ b/src/android.c @@ -5535,7 +5535,10 @@ android_wc_lookup_string (android_key_pressed_event *event, /* Terminate any ongoing character composition after a key is registered. */ - if (compose_status) + if (compose_status + /* Provided that a modifier key is not the key being + depressed. */ + && !ANDROID_IS_MODIFIER_KEY (event->keycode)) compose_status->chars_matched = 0; *status_return = status; return rc; -- cgit v1.2.3 From b9f7a2274f6a8352085d01c15bf9086ffe25f437 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 8 Mar 2024 15:06:37 +0200 Subject: ; Improve documentation of 'minibuffer-allow-text-properties' * doc/lispref/minibuf.texi (Text from Minibuffer): Document the default value of 'minibuffer-allow-text-properties'. --- doc/lispref/minibuf.texi | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 8c610018745..65a9dca52f4 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -187,7 +187,8 @@ History}. If the variable @code{minibuffer-allow-text-properties} is non-@code{nil}, then the string that is returned includes whatever text properties were present in the minibuffer. Otherwise all the text -properties are stripped when the value is returned. +properties are stripped when the value is returned. (By default this +variable is @code{nil}.) @vindex minibuffer-prompt-properties The text properties in @code{minibuffer-prompt-properties} are applied @@ -350,14 +351,15 @@ See @code{read-regexp} above for details of how these values are used. @end defopt @defvar minibuffer-allow-text-properties -If this variable is @code{nil}, then @code{read-from-minibuffer} -and @code{read-string} strip all text properties from the minibuffer -input before returning it. However, +If this variable is @code{nil}, the default, then +@code{read-from-minibuffer} and @code{read-string} strip all text +properties from the minibuffer input before returning it. However, @code{read-no-blanks-input} (see below), as well as @code{read-minibuffer} and related functions (@pxref{Object from Minibuffer,, Reading Lisp Objects With the Minibuffer}), and all -functions that do minibuffer input with completion, remove the @code{face} -property unconditionally, regardless of the value of this variable. +functions that do minibuffer input with completion, remove the +@code{face} property unconditionally, regardless of the value of this +variable. If this variable is non-@code{nil}, most text properties on strings from the completion table are preserved---but only on the part of the -- cgit v1.2.3 From 966d0a62a1a13a3df5155476d36eafe17999497e Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 8 Mar 2024 14:26:14 +0100 Subject: * Fix `capitalize` entry in `comp-known-type-specifiers` (bug#69631) * lisp/emacs-lisp/comp-common.el (comp-known-type-specifiers): Fix 'capitalize' entry. --- lisp/emacs-lisp/comp-common.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index 221f819e474..4edfe811586 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -119,7 +119,7 @@ Used to modify the compiler environment." (function ((or integer marker) (or integer marker)) string)) (bufferp (function (t) boolean)) (byte-code-function-p (function (t) boolean)) - (capitalize (function (or integer string) (or integer string))) + (capitalize (function ((or integer string)) (or integer string))) (car (function (list) t)) (car-less-than-car (function (list list) boolean)) (car-safe (function (t) t)) -- cgit v1.2.3 From 055e31f1d021ef2c8ac5cca505b5f73118736cff Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 8 Mar 2024 10:47:01 -0500 Subject: eieio-core.el: Try and fix bug#69631 * lisp/emacs-lisp/eieio-core.el (eieio--class-precedence-c3) (eieio--class-precedence-dfs, eieio--class-precedence-bfs): Use `cl--class-parents` since some of the parents aren't EIEIO classes. --- lisp/emacs-lisp/eieio-core.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 5418f53be35..7af6e9ff1bb 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -960,7 +960,7 @@ need be... May remove that later...)" (defun eieio--class-precedence-c3 (class) "Return all parents of CLASS in c3 order." - (let ((parents (eieio--class-parents class))) + (let ((parents (cl--class-parents class))) (cons class (merge-ordered-lists (append @@ -974,7 +974,7 @@ need be... May remove that later...)" (defun eieio--class-precedence-dfs (class) "Return all parents of CLASS in depth-first order." - (let* ((parents (eieio--class-parents class)) + (let* ((parents (cl--class-parents class)) (classes (copy-sequence (apply #'append (list class) @@ -995,12 +995,12 @@ need be... May remove that later...)" (defun eieio--class-precedence-bfs (class) "Return all parents of CLASS in breadth-first order." (let* ((result) - (queue (eieio--class-parents class))) + (queue (cl--class-parents class))) (while queue (let ((head (pop queue))) (unless (member head result) (push head result) - (setq queue (append queue (eieio--class-parents head)))))) + (setq queue (append queue (cl--class-parents head)))))) (cons class (nreverse result))) ) -- cgit v1.2.3 From 5beb56fb53b2d6ee9d5ad621b7fc2c9d1d0ec9c5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 8 Mar 2024 11:24:18 -0500 Subject: EIEIO: Fix regession (bug#69631) Not sure why earlier tests did not catch it, but there are more places where we bump into problems because `eieio--class-precedence-list` now returns also non-EIEIO classes. * lisp/obsolete/eieio-compat.el (eieio--generic-static-object-generalizer): * lisp/emacs-lisp/eieio-core.el (eieio--generic-generalizer) (eieio--generic-subclass-specializers): Handle non-EIEIO parents. * test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el (eieio-test-method-order-list-7): Adjust test. --- lisp/emacs-lisp/eieio-core.el | 10 ++++------ lisp/obsolete/eieio-compat.el | 5 ++--- test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el | 2 +- 3 files changed, 7 insertions(+), 10 deletions(-) diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 7af6e9ff1bb..9a73e7c7441 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -1056,8 +1056,7 @@ method invocation orders of the involved classes." (lambda (tag &rest _) (let ((class (cl--find-class tag))) (and (eieio--class-p class) - (mapcar #'eieio--class-name - (eieio--class-precedence-list class)))))) + (cl--class-allparents class))))) (cl-defmethod cl-generic-generalizers :extra "class" (specializer) "Support for dispatch on types defined by EIEIO's `defclass'." @@ -1079,10 +1078,9 @@ method invocation orders of the involved classes." ;; Instead, we add a new "subclass" specializer. (defun eieio--generic-subclass-specializers (tag &rest _) - (when (eieio--class-p tag) - (mapcar (lambda (class) - `(subclass ,(eieio--class-name class))) - (eieio--class-precedence-list tag)))) + (when (cl--class-p tag) + (mapcar (lambda (class) `(subclass ,class)) + (cl--class-allparents tag)))) (cl-generic-define-generalizer eieio--generic-subclass-generalizer 60 (lambda (name &rest _) `(and (symbolp ,name) (cl--find-class ,name))) diff --git a/lisp/obsolete/eieio-compat.el b/lisp/obsolete/eieio-compat.el index 26648a4d7bb..8fdcebbd1c4 100644 --- a/lisp/obsolete/eieio-compat.el +++ b/lisp/obsolete/eieio-compat.el @@ -150,10 +150,9 @@ Summary: (lambda (tag &rest _) (and (symbolp tag) (setq tag (cl--find-class tag)) (eieio--class-p tag) - (let ((superclasses (eieio--class-precedence-list tag)) + (let ((superclasses (cl--class-allparents tag)) (specializers ())) (dolist (superclass superclasses) - (setq superclass (eieio--class-name superclass)) (push superclass specializers) (push `(eieio--static ,superclass) specializers)) (nreverse specializers))))) @@ -240,7 +239,7 @@ Summary: (declare (obsolete cl-no-applicable-method "25.1")) (apply #'cl-no-applicable-method method object args)) -(define-obsolete-function-alias 'call-next-method 'cl-call-next-method "25.1") +(define-obsolete-function-alias 'call-next-method #'cl-call-next-method "25.1") (defun next-method-p () (declare (obsolete cl-next-method-p "25.1")) ;; EIEIO's `next-method-p' just returned nil when called in an diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el index b244a56779a..fb2c6ea3b68 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el @@ -259,7 +259,7 @@ (ans '( (:PRIMARY D) (:PRIMARY D-base1) - ;; (:PRIMARY D-base2) + (:PRIMARY D-base2) (:PRIMARY D-base0) ))) (eitest-F (D nil)) -- cgit v1.2.3 From 345cdd7a70558cd47c2ab3e124e2352debaa57cb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 8 Mar 2024 11:57:22 -0500 Subject: (eieio--generic-subclass-specializers): Autoload class * lisp/emacs-lisp/eieio-core.el (eieio--generic-subclass-specializers): Don't forget to handle autoloaded classes. --- lisp/emacs-lisp/eieio-core.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 9a73e7c7441..a2f7c4172a3 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -1079,6 +1079,8 @@ method invocation orders of the involved classes." (defun eieio--generic-subclass-specializers (tag &rest _) (when (cl--class-p tag) + (when (eieio--class-p tag) + (setq tag (eieio--full-class-object tag))) ;Autoload, if applicable. (mapcar (lambda (class) `(subclass ,class)) (cl--class-allparents tag)))) -- cgit v1.2.3 From 966e1be5b337cf71f404a509cae4057b73f3f381 Mon Sep 17 00:00:00 2001 From: Charalampos Mitrodimas Date: Thu, 7 Mar 2024 18:38:15 +0000 Subject: Do interactive mode tagging for locate.el * lisp/locate.el (locate-tags, locate-find-directory) (locate-find-directory-other-window): Do interactive mode tagging. (Bug#69619) Copyright-paperwork-exempt: yes --- lisp/locate.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/locate.el b/lisp/locate.el index d86e7fa678f..70328d5184e 100644 --- a/lisp/locate.el +++ b/lisp/locate.el @@ -559,7 +559,7 @@ do not work in subdirectories. (defun locate-tags () "Visit a tags table in `*Locate*' mode." - (interactive) + (interactive nil locate-mode) (if (locate-main-listing-line-p) (let ((tags-table (locate-get-filename))) (and (y-or-n-p (format "Visit tags table %s? " tags-table)) @@ -589,7 +589,7 @@ locate database using the shell command in `locate-update-command'." (defun locate-find-directory () "Visit the directory of the file mentioned on this line." - (interactive) + (interactive nil locate-mode) (if (locate-main-listing-line-p) (let ((directory-name (locate-get-dirname))) (if (file-directory-p directory-name) @@ -601,7 +601,7 @@ locate database using the shell command in `locate-update-command'." (defun locate-find-directory-other-window () "Visit the directory of the file named on this line in other window." - (interactive) + (interactive nil locate-mode) (if (locate-main-listing-line-p) (find-file-other-window (locate-get-dirname)) (message "This command only works inside main listing."))) -- cgit v1.2.3 From a4473afefe1a0f171ac6e811853836dd675f93d2 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 9 Mar 2024 10:09:36 +0200 Subject: Fix case-sensitivity in 'complete-tag' * lisp/progmodes/etags.el (complete-tag): Bind 'completion-ignore-case', so that 'completion-in-region' is affected by it. This fixes a bug made in 30 Apr 2010, when this function was refactored to use 'tags-completion-at-point-function'. Reported by Morgan Willcock . --- lisp/progmodes/etags.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 476037eb8bd..597612196fd 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -2065,7 +2065,8 @@ for \\[find-tag] (which see)." (user-error "%s" (substitute-command-keys "No tags table loaded; try \\[visit-tags-table]"))) - (let ((comp-data (tags-completion-at-point-function))) + (let ((comp-data (tags-completion-at-point-function)) + (completion-ignore-case (find-tag--completion-ignore-case))) (if (null comp-data) (user-error "Nothing to complete") (completion-in-region (car comp-data) (cadr comp-data) -- cgit v1.2.3 From 5d9a8c3704c156cccea90a46362e6bfae0de87f2 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 9 Mar 2024 16:12:40 +0800 Subject: Enable stack overflow recovery on Android * src/sysdep.c (handle_sigsegv): Return after restoring the original signal handler, which should proceed to call debuggerd to generate a tombstone. (init_sigsegv): Save the original signal handler on Android, to be restored after a signal is received. (init_signals): Call init_sigsegv on Android. --- src/sysdep.c | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/src/sysdep.c b/src/sysdep.c index 3a6829dd27a..cf2985b4b89 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -1853,11 +1853,7 @@ init_sigbus (void) #endif -/* This does not work on Android and interferes with the system - tombstone generation. */ - -#if defined HAVE_STACK_OVERFLOW_HANDLING && !defined WINDOWSNT \ - && (!defined HAVE_ANDROID || defined ANDROID_STUBIFY) +#if defined HAVE_STACK_OVERFLOW_HANDLING && !defined WINDOWSNT /* Alternate stack used by SIGSEGV handler below. */ @@ -1921,6 +1917,8 @@ stack_overflow (siginfo_t *siginfo) return 0 <= top - addr && top - addr < (bot - top) >> LG_STACK_HEURISTIC; } +/* Signal handler for SIGSEGV before our new handler was installed. */ +static struct sigaction old_sigsegv_handler; /* Attempt to recover from SIGSEGV caused by C stack overflow. */ @@ -1939,6 +1937,15 @@ handle_sigsegv (int sig, siginfo_t *siginfo, void *arg) if (!fatal && stack_overflow (siginfo)) siglongjmp (return_to_command_loop, 1); +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY + /* Tombstones (crash reports with stack traces) won't be generated on + Android unless the original SIGSEGV handler is installed and the + signal is resent, such as by returning from the first signal + handler called. */ + sigaction (SIGSEGV, &old_sigsegv_handler, NULL); + return; +#endif /* HAVE_ANDROID && ANDROID_STUBIFY */ + /* Otherwise we can't do anything with this. */ deliver_fatal_thread_signal (sig); } @@ -1961,7 +1968,7 @@ init_sigsegv (void) sigfillset (&sa.sa_mask); sa.sa_sigaction = handle_sigsegv; sa.sa_flags = SA_SIGINFO | SA_ONSTACK | emacs_sigaction_flags (); - if (sigaction (SIGSEGV, &sa, NULL) < 0) + if (sigaction (SIGSEGV, &sa, &old_sigsegv_handler) < 0) return 0; return 1; @@ -1969,16 +1976,12 @@ init_sigsegv (void) #else /* not HAVE_STACK_OVERFLOW_HANDLING or WINDOWSNT */ -#if !defined HAVE_ANDROID || defined ANDROID_STUBIFY - static bool init_sigsegv (void) { return 0; } -#endif - #endif /* HAVE_STACK_OVERFLOW_HANDLING && !WINDOWSNT */ static void @@ -2125,10 +2128,8 @@ init_signals (void) #endif sigaction (SIGBUS, &thread_fatal_action, 0); #endif -#if !defined HAVE_ANDROID || defined ANDROID_STUBIFY if (!init_sigsegv ()) sigaction (SIGSEGV, &thread_fatal_action, 0); -#endif #ifdef SIGSYS sigaction (SIGSYS, &thread_fatal_action, 0); #endif -- cgit v1.2.3 From 1ea3b369021c90701c634c512426f75ce1291d77 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 9 Mar 2024 04:24:30 -0500 Subject: Auto-commit of loaddefs files. --- lisp/ldefs-boot.el | 2466 +++++++++++++++++++++++++++------------------------- 1 file changed, 1275 insertions(+), 1191 deletions(-) diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index ef672d6c2e5..b434ee0e37f 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -729,19 +729,19 @@ CONCEALED: CLOSED: A TOPIC whose immediate OFFSPRING and body-text is CONCEALED. OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be. -This is a minor mode. If called interactively, toggle the -`Allout mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Allout mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `allout-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (define-obsolete-function-alias 'outlinify-sticky #'allout-outlinify-sticky "29.1") @@ -803,18 +803,18 @@ bindings for easy outline navigation and exposure control, extending outline hot-spot navigation (see `allout-mode'). This is a minor mode. If called interactively, toggle the -`Allout-Widgets mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Allout-Widgets mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `allout-widgets-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "allout-widgets" '("allout-")) @@ -1389,19 +1389,19 @@ Keymap summary \\{artist-mode-map} -This is a minor mode. If called interactively, toggle the -`Artist mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Artist mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `artist-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "artist" '("artist-")) @@ -1534,18 +1534,18 @@ When Auto-insert mode is enabled, when new files are created you can insert a template for the file depending on the mode of the buffer. This is a global minor mode. If called interactively, toggle the -`Auto-Insert mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Auto-Insert mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='auto-insert-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "autoinsert" '("auto-insert")) @@ -1571,19 +1571,19 @@ Use `global-auto-revert-mode' to automatically revert all buffers. Use `auto-revert-tail-mode' if you know that the file will only grow without being changed in the part that is already in the buffer. -This is a minor mode. If called interactively, toggle the -`Auto-Revert mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Auto-Revert +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `auto-revert-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'turn-on-auto-revert-mode "autorevert" "\ @@ -1610,19 +1610,18 @@ suppressed by setting `auto-revert-verbose' to nil. Use `auto-revert-mode' for changes other than appends! This is a minor mode. If called interactively, toggle the -`Auto-Revert-Tail mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Auto-Revert-Tail mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `auto-revert-tail-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'turn-on-auto-revert-tail-mode "autorevert" "\ @@ -1659,19 +1658,18 @@ It displays the text that `global-auto-revert-mode-text' specifies in the mode line. This is a global minor mode. If called interactively, toggle the -`Global Auto-Revert mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Global Auto-Revert mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='global-auto-revert-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "autorevert" '("auto-revert-" "global-auto-revert-")) @@ -1774,18 +1772,18 @@ functions in `battery-update-functions', which can be used to trigger actions based on battery-related events. This is a global minor mode. If called interactively, toggle the -`Display-Battery mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Display-Battery mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='display-battery-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "battery" '("battery-")) @@ -1949,6 +1947,10 @@ Major mode for editing BibTeX style files. ;;; Generated autoloads from bind-key.el (push (purecopy '(bind-key 2 4 1)) package--builtin-versions) +(defvar personal-keybindings nil "\ +List of bindings performed by `bind-key'. + +Elements have the form ((KEY . [MAP]) CMD ORIGINAL-CMD)") (autoload 'bind-key "bind-key" "\ Bind KEY-NAME to COMMAND in KEYMAP (`global-map' if not passed). @@ -2022,7 +2024,7 @@ other modes. See `override-global-mode'. (fn &rest ARGS)" nil t) (autoload 'describe-personal-keybindings "bind-key" "\ Display all the personal keybindings defined by `bind-key'." t) -(register-definition-prefixes "bind-key" '("bind-key" "override-global-m" "personal-keybindings")) +(register-definition-prefixes "bind-key" '("bind-key" "override-global-m")) ;;; Generated autoloads from emacs-lisp/bindat.el @@ -2755,37 +2757,36 @@ columns on its right towards the left. Toggle hyperlinking bug references in the buffer (Bug Reference mode). This is a minor mode. If called interactively, toggle the -`Bug-Reference mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Bug-Reference mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `bug-reference-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'bug-reference-prog-mode "bug-reference" "\ Like `bug-reference-mode', but only buttonize in comments and strings. This is a minor mode. If called interactively, toggle the -`Bug-Reference-Prog mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Bug-Reference-Prog mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `bug-reference-prog-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "bug-reference" '("bug-reference-")) @@ -2939,12 +2940,6 @@ and corresponding effects. ;;; Generated autoloads from progmodes/c-ts-mode.el -(autoload 'c-ts-base-mode "c-ts-mode" "\ -Major mode for editing C, powered by tree-sitter. - -\\{c-ts-base-mode-map} - -(fn)" t) (autoload 'c-ts-mode "c-ts-mode" "\ Major mode for editing C, powered by tree-sitter. @@ -2994,6 +2989,7 @@ should be used. This function attempts to use file contents to determine whether the code is C or C++ and based on that chooses whether to enable `c-ts-mode' or `c++-ts-mode'." t) +(make-obsolete 'c-or-c++-ts-mode 'c-or-c++-mode "30.1") (register-definition-prefixes "c-ts-mode" '("c-ts-")) @@ -4380,19 +4376,19 @@ checking of documentation strings. \\{checkdoc-minor-mode-map} -This is a minor mode. If called interactively, toggle the -`Checkdoc minor mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Checkdoc +minor mode' mode. If the prefix argument is positive, enable the mode, +and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `checkdoc-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'checkdoc-package-keywords "checkdoc" "\ @@ -4478,19 +4474,18 @@ or call the function `cl-font-lock-built-in-mode'.") Highlight built-in functions, variables, and types in `lisp-mode'. This is a global minor mode. If called interactively, toggle the -`Cl-Font-Lock-Built-In mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Cl-Font-Lock-Built-In mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='cl-font-lock-built-in-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "cl-font-lock" '("cl-font-lock-")) @@ -4620,19 +4615,18 @@ macro-expansion of `cl-defstruct' that used vectors objects instead of record objects. This is a global minor mode. If called interactively, toggle the -`Cl-Old-Struct-Compat mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Cl-Old-Struct-Compat mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='cl-old-struct-compat-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "cl-lib" '("cl-")) @@ -5031,6 +5025,16 @@ on third call it again advances points to the next difference and so on. (fn IGNORE-WHITESPACE)" t) (register-definition-prefixes "compare-w" '("compare-")) + +;;; Generated autoloads from emacs-lisp/compat.el + + (push (list 'compat + emacs-major-version + emacs-minor-version + 9999) + package--builtin-versions) +(register-definition-prefixes "compat" '("compat-")) + ;;; Generated autoloads from image/compface.el @@ -5180,18 +5184,18 @@ See `compilation-mode'. This is a minor mode. If called interactively, toggle the `Compilation-Shell minor mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +positive, enable the mode, and if it is zero or negative, disable the +mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `compilation-shell-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'compilation-minor-mode "compile" "\ @@ -5201,20 +5205,19 @@ When Compilation minor mode is enabled, all the error-parsing commands of Compilation major mode are available. See `compilation-mode'. -This is a minor mode. If called interactively, toggle the -`Compilation minor mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Compilation +minor mode' mode. If the prefix argument is positive, enable the mode, +and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `compilation-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'compilation-next-error-function "compile" "\ @@ -5272,19 +5275,18 @@ this mode: `enable-completion', `save-completions-flag', and options can be found in the `completion' group. This is a global minor mode. If called interactively, toggle the -`Dynamic-Completion mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Dynamic-Completion mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='dynamic-completion-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "completion" '("*c-def-regexp*" "*lisp-def-regexp*" "accept-completion" "add-" "cdabbrev-" "check-completion-length" "clear-all-completions" "cmpl-" "complet" "current-completion-source" "delete-completion" "enable-completion" "find-" "inside-locate-completion-entry" "interactive-completion-string-reader" "kill-" "list-all-completions" "load-completions-from-file" "make-c" "next-cdabbrev" "num-cmpl-sources" "reset-cdabbrev" "save" "set-c" "symbol-" "use-completion-")) @@ -5304,19 +5306,18 @@ completion suggestion, and \\[completion-preview-prev-candidate] cycles backward. This is a minor mode. If called interactively, toggle the -`Completion-Preview mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Completion-Preview mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `completion-preview-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "completion-preview" '("completion-preview-")) @@ -5543,6 +5544,7 @@ If FIX is non-nil, run `copyright-fix-years' instead. ;;; Generated autoloads from progmodes/cperl-mode.el +(put 'cperl-file-style 'safe-local-variable 'stringp) (put 'cperl-indent-level 'safe-local-variable 'integerp) (put 'cperl-brace-offset 'safe-local-variable 'integerp) (put 'cperl-continued-brace-offset 'safe-local-variable 'integerp) @@ -5550,7 +5552,6 @@ If FIX is non-nil, run `copyright-fix-years' instead. (put 'cperl-continued-statement-offset 'safe-local-variable 'integerp) (put 'cperl-extra-newline-before-brace 'safe-local-variable 'booleanp) (put 'cperl-merge-trailing-else 'safe-local-variable 'booleanp) -(put 'cperl-file-style 'safe-local-variable 'stringp) (autoload 'cperl-mode "cperl-mode" "\ Major mode for editing Perl code. Expression and list commands understand all C brackets. @@ -5903,19 +5904,19 @@ You can customize `cua-enable-cua-keys' to completely disable the CUA bindings, or `cua-prefix-override-inhibit-delay' to change the prefix fallback behavior. -This is a global minor mode. If called interactively, toggle the -`Cua mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. +This is a global minor mode. If called interactively, toggle the `Cua +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='cua-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'cua-selection-mode "cua-base" "\ @@ -5938,19 +5939,18 @@ Toggle the region as rectangular. Activates the region if needed. Only lasts until the region is deactivated. This is a minor mode. If called interactively, toggle the -`Cua-Rectangle-Mark mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Cua-Rectangle-Mark mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `cua-rectangle-mark-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "cua-rect" '("cua-")) @@ -5966,19 +5966,18 @@ By convention, this is a list of symbols where each symbol stands for the Keep cursor outside of any `cursor-intangible' text property. This is a minor mode. If called interactively, toggle the -`Cursor-Intangible mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Cursor-Intangible mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `cursor-intangible-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'cursor-sensor-mode "cursor-sensor" "\ @@ -5991,18 +5990,18 @@ the cursor and DIR can be `entered' or `left' depending on whether the cursor is entering the area covered by the text-property property or leaving it. This is a minor mode. If called interactively, toggle the -`Cursor-Sensor mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Cursor-Sensor mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `cursor-sensor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "cursor-sensor" '("cursor-sensor-")) @@ -6115,6 +6114,11 @@ Customize GROUP, which must be a customization group, in another window. Customize SYMBOL, which must be a user option. (fn SYMBOL)" t) +(autoload 'customize-toggle-option "cus-edit" "\ +Toggle the value of boolean option SYMBOL for this session. + +(fn SYMBOL)" t) +(defalias 'toggle-option #'customize-toggle-option) (defalias 'customize-variable-other-window 'customize-option-other-window) (autoload 'customize-option-other-window "cus-edit" "\ Customize SYMBOL, which must be a user option. @@ -6368,19 +6372,19 @@ Note, in addition to enabling this minor mode, the major mode must be included in the variable `cwarn-configuration'. By default C and C++ modes are included. -This is a minor mode. If called interactively, toggle the `Cwarn -mode' mode. If the prefix argument is positive, enable the mode, -and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Cwarn mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `cwarn-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (put 'global-cwarn-mode 'globalized-minor-mode t) @@ -6871,19 +6875,18 @@ See `delete-selection-helper' and `delete-selection-pre-hook' for information on adapting behavior of commands in Delete Selection mode. This is a global minor mode. If called interactively, toggle the -`Delete-Selection mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Delete-Selection mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='delete-selection-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'delete-active-region "delsel" "\ @@ -6964,13 +6967,6 @@ See Info node `(elisp)Derived Modes' for more details. (fn CHILD PARENT NAME [DOCSTRING] [KEYWORD-ARGS...] &rest BODY)" nil t) (function-put 'define-derived-mode 'doc-string-elt 4) (function-put 'define-derived-mode 'lisp-indent-function 'defun) -(autoload 'derived-mode-init-mode-variables "derived" "\ -Initialize variables for a new MODE. -Right now, if they don't already exist, set up a blank keymap, an -empty syntax table, and an empty abbrev table -- these will be merged -the first time the mode is used. - -(fn MODE)") (register-definition-prefixes "derived" '("derived-mode-")) @@ -7042,13 +7038,22 @@ or call the function `desktop-save-mode'.") (autoload 'desktop-save-mode "desktop" "\ Toggle desktop saving (Desktop Save mode). -When Desktop Save mode is enabled, the state of Emacs is saved from -one session to another. In particular, Emacs will save the desktop when -it exits (this may prompt you; see the option `desktop-save'). The next -time Emacs starts, if this mode is active it will restore the desktop. +When Desktop Save mode is enabled, the state of Emacs is saved from one +session to another. The saved Emacs \"desktop configuration\" includes the +buffers, their file names, major modes, buffer positions, window and frame +configuration, and some important global variables. + +To enable this feature for future sessions, customize `desktop-save-mode' +to t, or add this line in your init file: -To manually save the desktop at any time, use the command `\\[desktop-save]'. -To load it, use `\\[desktop-read]'. + (desktop-save-mode 1) + +When this mode is enabled, Emacs will save the desktop when it exits +(this may prompt you, see the option `desktop-save'). The next time +Emacs starts, if this mode is active it will restore the desktop. + +To manually save the desktop at any time, use the command \\[desktop-save]. +To load it, use \\[desktop-read]. Once a desktop file exists, Emacs will auto-save it according to the option `desktop-auto-save-timeout'. @@ -7058,18 +7063,18 @@ To see all the options you can set, browse the `desktop' customization group. For further details, see info node `(emacs)Saving Emacs Sessions'. This is a global minor mode. If called interactively, toggle the -`Desktop-Save mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Desktop-Save mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='desktop-save-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (defvar desktop-locals-to-save '(desktop-locals-to-save truncate-lines case-fold-search case-replace fill-column overwrite-mode change-log-default-name line-number-mode column-number-mode size-indication-mode buffer-file-coding-system buffer-display-time indent-tabs-mode tab-width indicate-buffer-boundaries indicate-empty-lines show-trailing-whitespace) "\ @@ -7503,19 +7508,19 @@ Toggle Diff minor mode. \\{diff-minor-mode-map} -This is a minor mode. If called interactively, toggle the `Diff -minor mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Diff minor +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `diff-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (defvar diff-add-log-use-relative-names nil "\ @@ -7719,19 +7724,19 @@ This is an alternative to `shell-dirtrack-mode', which works by tracking `cd' and similar commands which change the shell working directory. -This is a minor mode. If called interactively, toggle the -`Dirtrack mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Dirtrack +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `dirtrack-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'dirtrack "dirtrack" "\ @@ -7750,7 +7755,7 @@ from `default-directory'. (autoload 'disassemble "disass" "\ Print disassembled code for OBJECT in (optional) BUFFER. OBJECT can be a symbol defined as a function, or a function itself -(a lambda expression or a compiled-function object). +(a lambda expression or a byte-code-function object). If OBJECT is not already compiled, we compile it, but do not redefine OBJECT if it is a symbol. @@ -7905,19 +7910,19 @@ not appear aligned. See Info node `Displaying Boundaries' for details. This is a minor mode. If called interactively, toggle the -`Display-Fill-Column-Indicator mode' mode. If the prefix -argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +`Display-Fill-Column-Indicator mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable the +mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `display-fill-column-indicator-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (put 'global-display-fill-column-indicator-mode 'globalized-minor-mode t) @@ -7977,19 +7982,18 @@ customize `display-line-numbers-type'. To change the type while the mode is on, set `display-line-numbers' directly. This is a minor mode. If called interactively, toggle the -`Display-Line-Numbers mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Display-Line-Numbers mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `display-line-numbers-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (put 'global-display-line-numbers-mode 'globalized-minor-mode t) @@ -8066,19 +8070,18 @@ of `header-line-format', like this: See also `line-number-display-width'. This is a minor mode. If called interactively, toggle the -`Header-Line-Indent mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Header-Line-Indent mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `header-line-indent-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "display-line-numbers" '("display-line-numbers-" "header-line-indent--")) @@ -8179,19 +8182,19 @@ Toggle displaying buffer via Doc View (Doc View minor mode). See the command `doc-view-mode' for more information on this mode. -This is a minor mode. If called interactively, toggle the -`Doc-View minor mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Doc-View +minor mode' mode. If the prefix argument is positive, enable the mode, +and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `doc-view-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'doc-view-bookmark-jump "doc-view" "\ @@ -8250,19 +8253,19 @@ Toggle special insertion on double keypresses (Double mode). When Double mode is enabled, some keys will insert different strings when pressed twice. See `double-map' for details. -This is a minor mode. If called interactively, toggle the -`Double mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Double mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `double-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "double" '("double-")) @@ -8870,18 +8873,18 @@ This global minor mode enables `ede-minor-mode' in all buffers in an EDE controlled project. This is a global minor mode. If called interactively, toggle the -`Global Ede mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Global Ede mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='global-ede-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "ede" '("ede" "global-ede-mode-map" "project-try-ede")) @@ -8919,7 +8922,7 @@ An extant spec symbol is a symbol that is not a function and has a `edebug-form-spec' property. (fn SPEC)") -(defalias 'edebug-defun 'edebug-eval-top-level-form) +(defalias 'edebug-defun #'edebug-eval-top-level-form) (autoload 'edebug-eval-top-level-form "edebug" "\ Evaluate the top level form point is in, stepping through with Edebug. This is like `eval-defun' except that it steps the code for Edebug @@ -9285,9 +9288,9 @@ To change the default, set the variable `ediff-use-toolbar-p', which see." t) (autoload 'edit-kbd-macro "edmacro" "\ Edit a keyboard macro. At the prompt, type any key sequence which is bound to a keyboard macro. -Or, type `\\[kmacro-end-and-call-macro]' or \\`RET' to edit the last -keyboard macro, `\\[view-lossage]' to edit the last 300 -keystrokes as a keyboard macro, or `\\[execute-extended-command]' +Or, type \\[kmacro-end-and-call-macro] or \\`RET' to edit the last +keyboard macro, \\[view-lossage] to edit the last 300 +keystrokes as a keyboard macro, or \\[execute-extended-command] to edit a macro by its command name. With a prefix argument, format the macro in a more concise way. @@ -9359,7 +9362,7 @@ Turn on EDT Emulation." t) ;;; Generated autoloads from progmodes/eglot.el -(push (purecopy '(eglot 1 16)) package--builtin-versions) +(push (purecopy '(eglot 1 17)) package--builtin-versions) (define-obsolete-function-alias 'eglot-update #'eglot-upgrade-eglot "29.1") (autoload 'eglot "eglot" "\ Start LSP server for PROJECT's buffers under MANAGED-MAJOR-MODES. @@ -9494,7 +9497,7 @@ SUPERCLASSES as children. It creates an autoload function for CNAME's constructor. (fn CNAME SUPERCLASSES FILENAME DOC)") -(register-definition-prefixes "eieio-core" '("class-" "eieio-" "inconsistent-class-hierarchy" "invalid-slot-" "unbound-slot")) +(register-definition-prefixes "eieio-core" '("cl--generic-struct-tag" "class-" "eieio-" "inconsistent-class-hierarchy" "invalid-slot-" "unbound-slot")) ;;; Generated autoloads from emacs-lisp/eieio-custom.el @@ -9571,37 +9574,36 @@ inserted around the region instead. To toggle the mode in a single buffer, use `electric-pair-local-mode'. This is a global minor mode. If called interactively, toggle the -`Electric-Pair mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Electric-Pair mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='electric-pair-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'electric-pair-local-mode "elec-pair" "\ Toggle `electric-pair-mode' only in this buffer. This is a minor mode. If called interactively, toggle the -`Electric-Pair-Local mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Electric-Pair-Local mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `electric-pair-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "elec-pair" '("electric-pair-")) @@ -9618,19 +9620,19 @@ to `elide-head-headers-to-hide'. This is suitable as an entry on `find-file-hook' or appropriate mode hooks. -This is a minor mode. If called interactively, toggle the -`Elide-Head mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Elide-Head +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `elide-head-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'elide-head "elide-head" "\ @@ -9998,19 +10000,19 @@ Commands: \\{enriched-mode-map} -This is a minor mode. If called interactively, toggle the -`Enriched mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Enriched +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `enriched-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'enriched-encode "enriched" "\ @@ -10231,19 +10233,19 @@ enough, since keyservers have strict timeout settings. (autoload 'epa-mail-mode "epa-mail" "\ A minor-mode for composing encrypted/clearsigned mails. -This is a minor mode. If called interactively, toggle the -`epa-mail mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `epa-mail +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `epa-mail-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'epa-mail-decrypt "epa-mail" "\ @@ -10293,18 +10295,18 @@ or call the function `epa-global-mail-mode'.") Minor mode to hook EasyPG into Mail mode. This is a global minor mode. If called interactively, toggle the -`Epa-Global-Mail mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Epa-Global-Mail mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='epa-global-mail-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "epa-mail" '("epa-mail-")) @@ -10356,84 +10358,77 @@ Look at CONFIG and try to expand GROUP. ;;; Generated autoloads from erc/erc.el (push (purecopy '(erc 5 6 -4)) package--builtin-versions) +(dolist (symbol '( erc-sasl erc-spelling ; 29 + erc-imenu erc-nicks)) ; 30 + (custom-add-load symbol symbol)) +(custom-autoload 'erc-modules "erc") (autoload 'erc-select-read-args "erc" "\ -Prompt the user for values of nick, server, port, and password. -With prefix arg, also prompt for user and full name.") +Prompt for connection parameters and return them in a plist. +By default, collect `:server', `:port', `:nickname', and +`:password'. With a non-nil prefix argument, also prompt for +`:user' and `:full-name'. Also return various environmental +properties needed by entry-point commands, like `erc-tls'.") (autoload 'erc-server-select "erc" "\ Interactively connect to a server from `erc-server-alist'." t) (make-obsolete 'erc-server-select 'erc-tls "30.1") (autoload 'erc "erc" "\ -ERC is a powerful, modular, and extensible IRC client. -This function is the main entry point for ERC. - -It allows selecting connection parameters, and then starts ERC. - -Non-interactively, it takes the keyword arguments - (server (erc-compute-server)) - (port (erc-compute-port)) - (nick (erc-compute-nick)) - (user (erc-compute-user)) - password - (full-name (erc-compute-full-name)) - id - -That is, if called with +Connect to an Internet Relay Chat SERVER on a non-TLS PORT. +Use NICK and USER, when non-nil, to inform the IRC commands of +the same name, possibly factoring in a non-nil FULL-NAME as well. +When PASSWORD is non-nil, also send an opening server password +via the \"PASS\" command. Interactively, prompt for SERVER, +PORT, NICK, and PASSWORD, along with USER and FULL-NAME when +given a prefix argument. Non-interactively, expect the rarely +needed ID parameter, when non-nil, to be a symbol or a string for +naming the server buffer and identifying the connection +unequivocally. Once connected, return the server buffer. (See +Info node `(erc) Connecting' for details about all mentioned +parameters.) + +Together with `erc-tls', this command serves as the main entry +point for ERC, the powerful, modular, and extensible IRC client. +Non-interactively, both commands accept the following keyword +arguments, with their defaults supplied by the indicated +\"compute\" functions: + + :server `erc-compute-server' + :port `erc-compute-port' + :nick `erc-compute-nick' + :user `erc-compute-user' + :password N/A + :full-name `erc-compute-full-name' + :id' N/A + +For example, when called in the following manner (erc :server \"irc.libera.chat\" :full-name \"J. Random Hacker\") -then the server and full-name will be set to those values, -whereas `erc-compute-port' and `erc-compute-nick' will be invoked -for the values of the other parameters. - -See `erc-tls' for the meaning of ID. +ERC assigns SERVER and FULL-NAME the associated keyword values +and defers to `erc-compute-port', `erc-compute-user', and +`erc-compute-nick' for those respective parameters. (fn &key SERVER PORT NICK USER PASSWORD FULL-NAME ID)" '((let ((erc--display-context `((erc-interactive-display . erc) ,@erc--display-context))) (erc-select-read-args)))) (defalias 'erc-select #'erc) (autoload 'erc-tls "erc" "\ -ERC is a powerful, modular, and extensible IRC client. -This function is the main entry point for ERC over TLS. - -It allows selecting connection parameters, and then starts ERC -over TLS. - -Non-interactively, it takes the keyword arguments - (server (erc-compute-server)) - (port (erc-compute-port)) - (nick (erc-compute-nick)) - (user (erc-compute-user)) - password - (full-name (erc-compute-full-name)) - client-certificate - id +Connect to an IRC server over a TLS-encrypted connection. +Interactively, prompt for SERVER, PORT, NICK, and PASSWORD, along +with USER and FULL-NAME when given a prefix argument. +Non-interactively, also accept a CLIENT-CERTIFICATE, which should +be a list containing the file name of the certificate's key +followed by that of the certificate itself. Alternatively, +accept a value of t instead of a list, to tell ERC to query +`auth-source' for the certificate's details. -That is, if called with - - (erc-tls :server \"irc.libera.chat\" :full-name \"J. Random Hacker\") - -then the server and full-name will be set to those values, -whereas `erc-compute-port' and `erc-compute-nick' will be invoked -for the values of their respective parameters. - -CLIENT-CERTIFICATE, if non-nil, should either be a list where the -first element is the certificate key file name, and the second -element is the certificate file name itself, or t, which means -that `auth-source' will be queried for the key and the -certificate. Authenticating using a TLS client certificate is -also referred to as \"CertFP\" (Certificate Fingerprint) -authentication by various IRC networks. - -Example usage: +Example client certificate (CertFP) usage: (erc-tls :server \"irc.libera.chat\" :port 6697 :client-certificate \\='(\"/home/bandali/my-cert.key\" \"/home/bandali/my-cert.crt\")) -When present, ID should be a symbol or a string to use for naming -the server buffer and identifying the connection unequivocally. -See Info node `(erc) Network Identifier' for details. Like -CLIENT-CERTIFICATE, this parameter cannot be specified -interactively. +See the alternative entry-point command `erc' as well as Info +node `(erc) Connecting' for a fuller description of the various +parameters, like ID. (fn &key SERVER PORT NICK USER PASSWORD FULL-NAME CLIENT-CERTIFICATE ID)" '((let ((erc-default-port erc-default-port-tls) (erc--display-context `((erc-interactive-display . erc-tls) ,@erc--display-context))) (erc-select-read-args)))) (autoload 'erc-handle-irc-url "erc" "\ @@ -10701,6 +10696,46 @@ Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test). (fn TEST-OR-TEST-NAME)" t) (register-definition-prefixes "ert" '("ert-")) + +;;; Generated autoloads from emacs-lisp/ert-font-lock.el + +(autoload 'ert-font-lock-deftest "ert-font-lock" "\ +Define test NAME (a symbol) using assertions from TEST-STR. + +Other than MAJOR-MODE and TEST-STR parameters, this macro accepts +the same parameters and keywords as `ert-deftest' and is intended +to be used through `ert'. + +(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)] MAJOR-MODE TEST-STR)" nil t) +(function-put 'ert-font-lock-deftest 'doc-string-elt 3) +(function-put 'ert-font-lock-deftest 'lisp-indent-function 2) +(autoload 'ert-font-lock-deftest-file "ert-font-lock" "\ +Define test NAME (a symbol) using assertions from FILE. + +FILE - path to a file with assertions in ERT resource director as +return by `ert-resource-directory'. + +Other than MAJOR-MODE and FILE parameters, this macro accepts the +same parameters and keywords as `ert-deftest' and is intended to +be used through `ert'. + +(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)] MAJOR-MODE FILE)" nil t) +(function-put 'ert-font-lock-deftest-file 'doc-string-elt 3) +(function-put 'ert-font-lock-deftest-file 'lisp-indent-function 2) +(autoload 'ert-font-lock-test-string "ert-font-lock" "\ +Check font faces in TEST-STRING set by MODE. + +The function is meant to be run from within an ERT test. + +(fn TEST-STRING MODE)") +(autoload 'ert-font-lock-test-file "ert-font-lock" "\ +Check font faces in FILENAME set by MODE. + +The function is meant to be run from within an ERT test. + +(fn FILENAME MODE)") +(register-definition-prefixes "ert-font-lock" '("ert-font-lock--")) + ;;; Generated autoloads from emacs-lisp/ert-x.el @@ -11086,6 +11121,49 @@ for \\[find-tag] (which see)." t) (autoload 'etags--xref-backend "etags") (register-definition-prefixes "etags" '("default-tags-table-function" "etags-" "file-of-tag" "find-tag-" "goto-tag-location-function" "initialize-new-tags-table" "last-tag" "list-tags-function" "select-tags-table-" "snarf-tag-function" "tag" "verify-tags-table-function")) + +;;; Generated autoloads from progmodes/etags-regen.el + +(put 'etags-regen-regexp-alist 'safe-local-variable (lambda (value) (and (listp value) (seq-every-p (lambda (group) (and (consp group) (listp (car group)) (listp (cdr group)) (seq-every-p #'stringp (car group)) (seq-every-p #'stringp (cdr group)))) value)))) +(put 'etags-regen-file-extensions 'safe-local-variable (lambda (value) (and (listp value) (seq-every-p #'stringp value)))) +(put 'etags-regen-ignores 'safe-local-variable (lambda (value) (and (listp value) (seq-every-p #'stringp value)))) +(defvar etags-regen-mode nil "\ +Non-nil if Etags-Regen mode is enabled. +See the `etags-regen-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `etags-regen-mode'.") +(custom-autoload 'etags-regen-mode "etags-regen" nil) +(autoload 'etags-regen-mode "etags-regen" "\ +Minor mode to automatically generate and update tags tables. + +This minor mode generates the tags table automatically based on +the current project configuration, and later updates it as you +edit the files and save the changes. + +If you select a tags table manually (for example, using +\\[visit-tags-table]), then this mode will be effectively +disabled for the entire session. Use \\[tags-reset-tags-tables] +to countermand the effect of a previous \\[visit-tags-table]. + +This is a global minor mode. If called interactively, toggle the +`Etags-Regen mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='etags-regen-mode)'. + +The mode's hook is called both when the mode is enabled and when it is +disabled. + +(fn &optional ARG)" t) +(register-definition-prefixes "etags-regen" '("etags-regen-")) + ;;; Generated autoloads from language/ethio-util.el @@ -11892,19 +11970,19 @@ Minor mode for a buffer-specific default face. When enabled, the face specified by the variable `buffer-face-mode-face' is used to display the buffer text. -This is a minor mode. If called interactively, toggle the -`Buffer-Face mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Buffer-Face +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `buffer-face-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'buffer-face-set "face-remap" "\ @@ -12377,12 +12455,14 @@ earlier in the `setq-connection-local'. The return value of the (fn [VARIABLE VALUE]...)" nil t) (autoload 'connection-local-p "files-x" "\ Non-nil if VARIABLE has a connection-local binding in `default-directory'. +`default-directory' must be a remote file name. If APPLICATION is nil, the value of `connection-local-default-application' is used. (fn VARIABLE &optional APPLICATION)" nil t) (autoload 'connection-local-value "files-x" "\ Return connection-local VARIABLE for APPLICATION in `default-directory'. +`default-directory' must be a remote file name. If APPLICATION is nil, the value of `connection-local-default-application' is used. If VARIABLE does not have a connection-local binding, the return @@ -12900,19 +12980,19 @@ suitable for the current buffer. The commands `flymake-reporting-backends' summarize the situation, as does the special *Flymake log* buffer. -This is a minor mode. If called interactively, toggle the -`Flymake mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Flymake +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `flymake-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'flymake-mode-on "flymake" "\ @@ -12977,19 +13057,19 @@ in your init file. \\[flyspell-region] checks all words inside a region. \\[flyspell-buffer] checks the whole buffer. -This is a minor mode. If called interactively, toggle the -`Flyspell mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Flyspell +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `flyspell-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'turn-on-flyspell "flyspell" "\ @@ -13045,7 +13125,7 @@ being able to use 144 or 216 lines instead of the normal 72... (your mileage may vary). To split one large window into two side-by-side windows, the commands -`\\[split-window-right]' or `\\[follow-delete-other-windows-and-split]' can be used. +\\[split-window-right] or \\[follow-delete-other-windows-and-split] can be used. Only windows displayed in the same frame follow each other. @@ -13054,19 +13134,19 @@ This command runs the normal hook `follow-mode-hook'. Keys specific to Follow mode: \\{follow-mode-map} -This is a minor mode. If called interactively, toggle the -`Follow mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Follow mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `follow-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'follow-scroll-up-window "follow" "\ @@ -13152,19 +13232,19 @@ provides footnote support for `message-mode'. To get started, play around with the following keys: \\{footnote-minor-mode-map} -This is a minor mode. If called interactively, toggle the -`Footnote mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Footnote +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `footnote-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "footnote" '("footnote-")) @@ -13618,19 +13698,18 @@ being transferred. This list may grow up to a size of the list) is deleted every time a new one is added (at the front). This is a global minor mode. If called interactively, toggle the -`Gdb-Enable-Debug mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Gdb-Enable-Debug mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='gdb-enable-debug)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'gdb "gdb-mi" "\ @@ -13794,19 +13873,19 @@ Minor mode for making identifiers likeThis readable. When this mode is active, it tries to add virtual separators (like underscores) at places they belong to. -This is a minor mode. If called interactively, toggle the -`Glasses mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Glasses +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `glasses-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "glasses" '("glasses-")) @@ -13826,19 +13905,18 @@ If enabled, all glyphless characters will be displayed as boxes that display their acronyms. This is a minor mode. If called interactively, toggle the -`Glyphless-Display mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Glyphless-Display mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `glyphless-display-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "glyphless-mode" '("glyphless-mode-")) @@ -14319,19 +14397,18 @@ Minor mode for providing mailing-list commands. \\{gnus-mailing-list-mode-map} This is a minor mode. If called interactively, toggle the -`Gnus-Mailing-List mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Gnus-Mailing-List mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `gnus-mailing-list-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "gnus-ml" '("gnus-mailing-list-")) @@ -14718,19 +14795,19 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and (autoload 'goto-address-mode "goto-addr" "\ Minor mode to buttonize URLs and e-mail addresses in the current buffer. -This is a minor mode. If called interactively, toggle the -`Goto-Address mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Goto-Address +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `goto-address-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (put 'global-goto-address-mode 'globalized-minor-mode t) @@ -14761,19 +14838,18 @@ See `goto-address-mode' for more information on Goto-Address mode. Like `goto-address-mode', but only for comments and strings. This is a minor mode. If called interactively, toggle the -`Goto-Address-Prog mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Goto-Address-Prog mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `goto-address-prog-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "goto-addr" '("goto-addr")) @@ -15129,18 +15205,18 @@ or call the function `gud-tooltip-mode'.") Toggle the display of GUD tooltips. This is a global minor mode. If called interactively, toggle the -`Gud-Tooltip mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Gud-Tooltip mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='gud-tooltip-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'lldb "gud" "\ @@ -15582,6 +15658,9 @@ whose documentation describes the minor mode. If called from Lisp with a non-nil BUFFER argument, display documentation for the major and minor modes of that buffer. +When `describe-mode-outline' is non-nil, Outline minor mode +is enabled in the Help buffer. + (fn &optional BUFFER)" t) (autoload 'describe-widget "help-fns" "\ Display a buffer with information about a widget. @@ -15907,19 +15986,19 @@ position (number of characters into buffer) Hi-lock: end is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'. -This is a minor mode. If called interactively, toggle the -`Hi-Lock mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Hi-Lock +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `hi-lock-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (put 'global-hi-lock-mode 'globalized-minor-mode t) @@ -16083,22 +16162,22 @@ Several variables affect how the hiding is done: \\{hide-ifdef-mode-map} -This is a minor mode. If called interactively, toggle the -`Hide-Ifdef mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Hide-Ifdef +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `hide-ifdef-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) -(register-definition-prefixes "hideif" '("backward-ifdef" "down-ifdef" "forward-ifdef" "hide-ifdef" "hif-" "intern-safe" "next-ifdef" "previous-ifdef" "show-ifdef" "up-ifdef")) +(register-definition-prefixes "hideif" '("backward-ifdef" "down-ifdef" "forward-ifdef" "hide-ifdef" "hif-" "next-ifdef" "previous-ifdef" "show-ifdef" "up-ifdef")) ;;; Generated autoloads from progmodes/hideshow.el @@ -16160,19 +16239,19 @@ Lastly, the normal hook `hs-minor-mode-hook' is run using `run-hooks'. Key bindings: \\{hs-minor-mode-map} -This is a minor mode. If called interactively, toggle the `hs -minor mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `hs minor +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `hs-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'turn-off-hideshow "hideshow" "\ @@ -16206,19 +16285,18 @@ buffer with the contents of a file \\[highlight-compare-buffers] highlights differences between two buffers. This is a minor mode. If called interactively, toggle the -`Highlight-Changes mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Highlight-Changes mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `highlight-changes-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'highlight-changes-visible-mode "hilit-chg" "\ @@ -16235,18 +16313,18 @@ This command does not itself set Highlight Changes mode. This is a minor mode. If called interactively, toggle the `Highlight-Changes-Visible mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +positive, enable the mode, and if it is zero or negative, disable the +mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `highlight-changes-visible-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'highlight-changes-remove-highlight "hilit-chg" "\ @@ -16372,19 +16450,19 @@ non-selected window. Hl-Line mode uses the function When `hl-line-sticky-flag' is nil, Hl-Line mode highlights the line about point in the selected window only. -This is a minor mode. If called interactively, toggle the -`Hl-Line mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Hl-Line +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `hl-line-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (defvar global-hl-line-mode nil "\ @@ -16406,18 +16484,18 @@ Global-Hl-Line mode uses the function `global-hl-line-highlight' on `post-command-hook'. This is a global minor mode. If called interactively, toggle the -`Global Hl-Line mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Global Hl-Line mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='global-hl-line-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "hl-line" '("global-hl-line-" "hl-line-")) @@ -16777,19 +16855,19 @@ An enhanced `icomplete-mode' that emulates `ido-mode'. This global minor mode makes minibuffer completion behave more like `ido-mode' than regular `icomplete-mode'. -This is a global minor mode. If called interactively, toggle the -`Fido mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. +This is a global minor mode. If called interactively, toggle the `Fido +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='fido-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (defvar icomplete-mode nil "\ @@ -16817,18 +16895,18 @@ completions: \\{icomplete-minibuffer-map} This is a global minor mode. If called interactively, toggle the -`Icomplete mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Icomplete mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='icomplete-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (defvar icomplete-vertical-mode nil "\ @@ -16849,19 +16927,18 @@ the value of `max-mini-window-height', and the way the mini-window is resized depends on `resize-mini-windows'. This is a global minor mode. If called interactively, toggle the -`Icomplete-Vertical mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Icomplete-Vertical mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='icomplete-vertical-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (defvar fido-vertical-mode nil "\ @@ -16879,18 +16956,18 @@ When turning on, if non-vertical `fido-mode' is off, turn it on. If it's on, just add the vertical display. This is a global minor mode. If called interactively, toggle the -`Fido-Vertical mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Fido-Vertical mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='fido-vertical-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (when (locate-library "obsolete/iswitchb") @@ -17380,19 +17457,19 @@ See `inferior-emacs-lisp-mode' for details. (autoload 'iimage-mode "iimage" "\ Toggle Iimage mode on or off. -This is a minor mode. If called interactively, toggle the -`Iimage mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Iimage mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `iimage-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "iimage" '("iimage-" "turn-off-iimage-mode")) @@ -17464,9 +17541,13 @@ use its file extension as image type. Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data. Optional PROPS are additional image attributes to assign to the image, -like, e.g. `:mask MASK'. If the property `:scale' is not given and the -display has a high resolution (more exactly, when the average width of a -character in the default font is more than 10 pixels), the image is +like, e.g. `:mask MASK'. See Info node `(elisp)Image Descriptors' for +the list of supported properties; see the nodes following that node +for properties specific to certain image types. + +If the property `:scale' is not given and the display has a high +resolution (more exactly, when the average width of a character +in the default font is more than 10 pixels), the image is automatically scaled up in proportion to the default font. Value is the image created, or nil if images of type TYPE are not supported. @@ -17531,21 +17612,25 @@ BUFFER nil or omitted means use the current buffer. (fn START END &optional BUFFER)") (autoload 'find-image "image" "\ -Find an image, choosing one of a list of image specifications. +Find an image that satisfies one of a list of image specifications. SPECS is a list of image specifications. -Each image specification in SPECS is a property list. The contents of -a specification are image type dependent. All specifications must at -least contain either the property `:file FILE' or `:data DATA', -where FILE is the file to load the image from, and DATA is a string -containing the actual image data. If the property `:type TYPE' is -omitted or nil, try to determine the image type from its first few +Each image specification in SPECS is a property list. The +contents of a specification are image type dependent; see the +info node `(elisp)Image Descriptors' for details. All specifications +must at least contain either the property `:file FILE' or `:data DATA', +where FILE is the file from which to load the image, and DATA is a +string containing the actual image data. If the property `:type TYPE' +is omitted or nil, try to determine the image type from its first few bytes of image data. If that doesn't work, and the property `:file -FILE' provide a file name, use its file extension as image type. -If `:type TYPE' is provided, it must match the actual type -determined for FILE or DATA by `create-image'. Return nil if no -specification is satisfied. +FILE' provide a file name, use its file extension as idication of the +image type. If `:type TYPE' is provided, it must match the actual type +determined for FILE or DATA by `create-image'. + +The function returns the image specification for the first specification +in the list whose TYPE is supported and FILE, if specified, exists. It +returns nil if no specification in the list can be satisfied. If CACHE is non-nil, results are cached and returned on subsequent calls. @@ -17762,20 +17847,19 @@ are always available in Dired: \\[image-dired-dired-toggle-marked-thumbs] Toggle thumbnails in front of file names. \\[image-dired-dired-edit-comment-and-tags] Edit comment and tags of marked images. -This is a minor mode. If called interactively, toggle the -`Image-Dired minor mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Image-Dired +minor mode' mode. If the prefix argument is positive, enable the mode, +and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `image-dired-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'image-dired-display-thumbs-append "image-dired-dired" "\ @@ -17881,18 +17965,18 @@ An image file is one whose name has an extension in `image-file-name-regexps'. This is a global minor mode. If called interactively, toggle the -`Auto-Image-File mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Auto-Image-File mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='auto-image-file-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "image-file" '("image-file-")) @@ -17913,19 +17997,19 @@ Toggle Image minor mode in this buffer. Image minor mode provides the key \\\\[image-toggle-display], to switch back to `image-mode' and display an image file as the actual image. -This is a minor mode. If called interactively, toggle the `Image -minor mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Image minor +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `image-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'image-mode-to-text "image-mode" "\ @@ -18126,19 +18210,18 @@ indented towards the left by the column number at the start of that text. This is a global minor mode. If called interactively, toggle the -`Kill-Ring-Deindent mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Kill-Ring-Deindent mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='kill-ring-deindent-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "indent-aux" '("kill-ring-deindent-buffer-substring-function")) @@ -18831,19 +18914,19 @@ SPC. For spell-checking \"on the fly\", not just after typing SPC or RET, use `flyspell-mode'. -This is a minor mode. If called interactively, toggle the -`ISpell minor mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `ISpell minor +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `ispell-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'ispell-message "ispell" "\ @@ -19049,7 +19132,7 @@ Major mode for editing JSON, powered by tree-sitter. ;;; Generated autoloads from jsonrpc.el -(push (purecopy '(jsonrpc 1 0 23)) package--builtin-versions) +(push (purecopy '(jsonrpc 1 0 24)) package--builtin-versions) (register-definition-prefixes "jsonrpc" '("jsonrpc-")) @@ -19849,7 +19932,7 @@ For example, in Usenet articles, sections of text quoted from another author are indented, or have each line start with `>'. To quote a section of text, define a keyboard macro which inserts `>', put point and mark at opposite ends of the quoted section, and use -`\\[apply-macro-to-region-lines]' to mark the entire section. +\\[apply-macro-to-region-lines] to mark the entire section. Suppose you wanted to build a keyword table in C where each entry looked like this: @@ -19871,7 +19954,7 @@ and write a macro to massage a word into a table entry: \\C-x ) and then select the region of un-tablified names and use -`\\[apply-macro-to-region-lines]' to build the table from the names. +\\[apply-macro-to-region-lines] to build the table from the names. (fn TOP BOTTOM &optional MACRO)" t) (define-key ctl-x-map "q" 'kbd-macro-query) @@ -20033,18 +20116,18 @@ headers (those specified by `mail-abbrev-mode-regexp'), based on the entries in your `mail-personal-alias-file'. This is a global minor mode. If called interactively, toggle the -`Mail-Abbrevs mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Mail-Abbrevs mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='mail-abbrevs-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'mail-abbrevs-setup "mailabbrev" "\ @@ -20360,19 +20443,19 @@ The slave buffer is stored in the buffer-local variable `master-of'. You can set this variable using `master-set-slave'. You can show yourself the value of `master-of' by calling `master-show-slave'. -This is a minor mode. If called interactively, toggle the -`Master mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Master mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `master-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "master" '("master-")) @@ -20398,18 +20481,18 @@ recursion depth in the minibuffer prompt. This is only useful if This is a global minor mode. If called interactively, toggle the `Minibuffer-Depth-Indicate mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +positive, enable the mode, and if it is zero or negative, disable the +mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='minibuffer-depth-indicate-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "mb-depth" '("minibuffer-depth-")) @@ -20565,7 +20648,7 @@ Major mode for editing MetaPost sources. ;;; Generated autoloads from mh-e/mh-acros.el -(register-definition-prefixes "mh-acros" '("defmacro-mh" "defun-mh" "mh-" "with-mh-folder-updating")) +(register-definition-prefixes "mh-acros" '("mh-" "with-mh-folder-updating")) ;;; Generated autoloads from mh-e/mh-alias.el @@ -20855,18 +20938,18 @@ or call the function `midnight-mode'.") Non-nil means run `midnight-hook' at midnight. This is a global minor mode. If called interactively, toggle the -`Midnight mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Midnight mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='midnight-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'clean-buffer-list "midnight" "\ @@ -20910,19 +20993,19 @@ such that hitting RET would enter a non-default value, the prompt is modified to remove the default indication. This is a global minor mode. If called interactively, toggle the -`Minibuffer-Electric-Default mode' mode. If the prefix argument -is positive, enable the mode, and if it is zero or negative, -disable the mode. +`Minibuffer-Electric-Default mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable the +mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='minibuffer-electric-default-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "minibuf-eldef" '("minibuf")) @@ -21440,19 +21523,19 @@ Toggle Msb mode. This mode overrides the binding(s) of `mouse-buffer-menu' to provide a different buffer menu using the function `msb'. -This is a global minor mode. If called interactively, toggle the -`Msb mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. +This is a global minor mode. If called interactively, toggle the `Msb +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='msb-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "msb" '("mouse-select-buffer" "msb")) @@ -21741,18 +21824,18 @@ or call the function `mouse-wheel-mode'.") Toggle mouse wheel support (Mouse Wheel mode). This is a global minor mode. If called interactively, toggle the -`Mouse-Wheel mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Mouse-Wheel mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='mouse-wheel-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "mwheel" '("mouse-wheel-" "mwheel-")) @@ -22763,7 +22846,7 @@ Coloring: ;;; Generated autoloads from org/org.el -(push (purecopy '(org 9 6 13)) package--builtin-versions) +(push (purecopy '(org 9 6 15)) package--builtin-versions) (autoload 'org-babel-do-load-languages "org" "\ Load the languages defined in `org-babel-load-languages'. @@ -23495,19 +23578,19 @@ Toggle Outline minor mode. See the command `outline-mode' for more information on this mode. -This is a minor mode. If called interactively, toggle the -`Outline minor mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Outline +minor mode' mode. If the prefix argument is positive, enable the mode, +and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `outline-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'outline-search-level "outline" "\ @@ -24118,6 +24201,8 @@ FUN in `pred' and `app' can take one of the forms: call it with one argument (F ARG1 .. ARGn) call F with ARG1..ARGn and EXPVAL as n+1'th argument + (F ARG1 .. _ .. ARGn) + call F, passing EXPVAL at the _ position. FUN, BOOLEXP, and subsequent PAT can refer to variables bound earlier in the pattern by a SYMBOL pattern. @@ -24156,8 +24241,8 @@ As with `pcase-let', BINDINGS are of the form (PATTERN EXP), but the EXP in each binding in BINDINGS can use the results of the destructuring bindings that precede it in BINDINGS' order. -Each EXP should match (i.e. be of compatible structure) to its -respective PATTERN; a mismatch may signal an error or may go +Each EXP should match its respective PATTERN (i.e. be of structure +compatible to PATTERN); a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil. (fn BINDINGS &rest BODY)" nil t) @@ -24170,8 +24255,8 @@ All EXPs are evaluated first, and then used to perform destructuring bindings by matching each EXP against its respective PATTERN. Then BODY is evaluated with those bindings in effect. -Each EXP should match (i.e. be of compatible structure) to its -respective PATTERN; a mismatch may signal an error or may go +Each EXP should match its respective PATTERN (i.e. be of structure +compatible to PATTERN); a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil. (fn BINDINGS &rest BODY)" nil t) @@ -24772,11 +24857,6 @@ they are not by default assigned to keys." t) (defalias 'edit-picture 'picture-mode) (register-definition-prefixes "picture" '("picture-")) - -;;; Generated autoloads from language/pinyin.el - -(register-definition-prefixes "pinyin" '("pinyin-character-map")) - ;;; Generated autoloads from textmodes/pixel-fill.el @@ -24797,18 +24877,18 @@ or call the function `pixel-scroll-mode'.") A minor mode to scroll text pixel-by-pixel. This is a global minor mode. If called interactively, toggle the -`Pixel-Scroll mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Pixel-Scroll mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='pixel-scroll-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'pixel-scroll-precision-scroll-down-page "pixel-scroll" "\ @@ -24838,19 +24918,18 @@ When enabled, this minor mode allows you to scroll the display precisely, according to the turning of the mouse wheel. This is a global minor mode. If called interactively, toggle the -`Pixel-Scroll-Precision mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Pixel-Scroll-Precision mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='pixel-scroll-precision-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "pixel-scroll" '("pixel-")) @@ -25614,8 +25693,6 @@ requires quoting, e.g. `\\[quoted-insert]'. (fn REGEXP)" t) (autoload 'project-or-external-find-regexp "project" "\ Find all matches for REGEXP in the project roots or external roots. -With \\[universal-argument] prefix, you can specify the file name -pattern to search for. (fn REGEXP)" t) (autoload 'project-find-file "project" "\ @@ -25771,8 +25848,8 @@ Otherwise, `default-directory' is temporarily set to the current project's root. If OVERRIDING-MAP is non-nil, it will be used as -`overriding-local-map' to provide shorter bindings from that map -which will take priority over the global ones. +`overriding-terminal-local-map' to provide shorter bindings +from that map which will take priority over the global ones. (fn &optional OVERRIDING-MAP PROMPT-FORMAT)" t) (autoload 'project-prefix-or-any-command "project" "\ @@ -25822,7 +25899,7 @@ line and comments can also be enclosed in /* ... */. If an optional argument SYSTEM is non-nil, set up mode for the given system. To find out what version of Prolog mode you are running, enter -`\\[prolog-mode-version]'. +\\[prolog-mode-version]. Commands: \\{prolog-mode-map} @@ -26452,19 +26529,18 @@ or call the function `rcirc-track-minor-mode'.") Global minor mode for tracking activity in rcirc buffers. This is a global minor mode. If called interactively, toggle the -`Rcirc-Track minor mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Rcirc-Track minor mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='rcirc-track-minor-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "rcirc" '("rcirc-" "with-rcirc-")) @@ -26527,18 +26603,18 @@ buffers you switch to a lot, you can say something like the following: (add-hook \\='buffer-list-update-hook #\\='recentf-track-opened-file) This is a global minor mode. If called interactively, toggle the -`Recentf mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Recentf mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='recentf-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "recentf" '("recentf-")) @@ -26669,18 +26745,18 @@ Activates the region if it's inactive and Transient Mark mode is on. Only lasts until the region is next deactivated. This is a minor mode. If called interactively, toggle the -`Rectangle-Mark mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Rectangle-Mark mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `rectangle-mark-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "rect" '("apply-on-rectangle" "clear-rectangle-line" "delete-" "extract-rectangle-" "killed-rectangle" "ope" "rectangle-" "spaces-string" "string-rectangle-")) @@ -26708,19 +26784,19 @@ auto-filling. For true \"word wrap\" behavior, use `visual-line-mode' instead. -This is a minor mode. If called interactively, toggle the -`Refill mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Refill mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `refill-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "refill" '("refill-")) @@ -26770,19 +26846,19 @@ on the menu bar. ------------------------------------------------------------------------------ -This is a minor mode. If called interactively, toggle the -`Reftex mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Reftex mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `reftex-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'reftex-reset-scanning-information "reftex" "\ @@ -27004,18 +27080,18 @@ keys for repeating. See `describe-repeat-maps' for a list of all repeatable commands. This is a global minor mode. If called interactively, toggle the -`Repeat mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Repeat mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='repeat-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'repeat-exit "repeat" "\ @@ -27091,19 +27167,19 @@ reveals invisible text around point. Also see the `reveal-auto-hide' variable. -This is a minor mode. If called interactively, toggle the -`Reveal mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Reveal mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `reveal-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (defvar global-reveal-mode nil "\ @@ -27120,18 +27196,18 @@ Toggle Reveal mode in all buffers (Global Reveal mode). Reveal mode renders invisible text around point visible again. This is a global minor mode. If called interactively, toggle the -`Global Reveal mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Global Reveal mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='global-reveal-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "reveal" '("reveal-")) @@ -27674,19 +27750,19 @@ conventionally have a suffix of `.rnc'). The variable `rng-schema-locating-files' specifies files containing rules to use for finding the schema. -This is a minor mode. If called interactively, toggle the -`Rng-Validate mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Rng-Validate +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `rng-validate-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "rng-valid" '("rng-")) @@ -27800,19 +27876,19 @@ When ReST minor mode is enabled, the ReST mode keybindings are installed on top of the major mode bindings. Use this for modes derived from Text mode, like Mail mode. -This is a minor mode. If called interactively, toggle the `Rst -minor mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Rst minor +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `rst-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "rst" '("rst-")) @@ -27860,19 +27936,19 @@ Use the command `ruler-mode' to change this variable.") (autoload 'ruler-mode "ruler-mode" "\ Toggle display of ruler in header line (Ruler mode). -This is a minor mode. If called interactively, toggle the `Ruler -mode' mode. If the prefix argument is positive, enable the mode, -and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Ruler mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `ruler-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "ruler-mode" '("ruler-")) @@ -28070,7 +28146,8 @@ For more details, see Info node `(elisp) Extending Rx'. (fn NAME [(ARGS...)] RX)" nil t) (function-put 'rx-define 'lisp-indent-function 'defun) -(eval-and-compile (defun rx--pcase-macroexpander (&rest regexps) "A pattern that matches strings against `rx' REGEXPS in sexp form. +(autoload 'rx--pcase-macroexpander "rx" "\ +A pattern that matches strings against `rx' REGEXPS in sexp form. REGEXPS are interpreted as in `rx'. The pattern matches any string that is a match for REGEXPS, as if by `string-match'. @@ -28084,7 +28161,9 @@ following constructs: (backref REF) matches whatever the submatch REF matched. REF can be a number, as usual, or a name introduced by a previous (let REF ...) - construct." (rx--pcase-expand regexps))) + construct. + +(fn &rest REGEXPS)") (define-symbol-prop 'rx--pcase-macroexpander 'edebug-form-spec 'nil) (define-symbol-prop 'rx 'pcase-macroexpander #'rx--pcase-macroexpander) (autoload 'rx--pcase-expand "rx" "\ @@ -28164,18 +28243,18 @@ Calling it at any other time replaces your current minibuffer histories, which is probably undesirable. This is a global minor mode. If called interactively, toggle the -`Savehist mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Savehist mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='savehist-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "savehist" '("savehist-")) @@ -28198,18 +28277,18 @@ This means when you visit a file, point goes to the last place where it was when you previously visited the same file. This is a global minor mode. If called interactively, toggle the -`Save-Place mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Save-Place mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='save-place-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'save-place-local-mode "saveplace" "\ @@ -28225,19 +28304,18 @@ file: (save-place-mode 1) This is a minor mode. If called interactively, toggle the -`Save-Place-Local mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Save-Place-Local mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `save-place-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "saveplace" '("save-place")) @@ -28324,18 +28402,18 @@ When Scroll-All mode is enabled, scrolling commands invoked in one window apply to all visible windows in the same frame. This is a global minor mode. If called interactively, toggle the -`Scroll-All mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Scroll-All mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='scroll-all-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "scroll-all" '("scroll-all-")) @@ -28359,19 +28437,19 @@ boundaries during scrolling. Note that the default key binding to `scroll' will not work on MS-Windows systems if `w32-scroll-lock-modifier' is non-nil. -This is a minor mode. If called interactively, toggle the -`Scroll-Lock mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Scroll-Lock +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `scroll-lock-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "scroll-lock" '("scroll-lock-")) @@ -28435,18 +28513,18 @@ Semantic mode. \\{semantic-mode-map} This is a global minor mode. If called interactively, toggle the -`Semantic mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Semantic mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='semantic-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "semantic" '("bovinate" "semantic-")) @@ -28755,18 +28833,18 @@ Server mode runs a process that accepts commands from the `server-start' for details. This is a global minor mode. If called interactively, toggle the -`Server mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Server mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='server-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'server-save-buffers-kill-terminal "server" "\ @@ -29107,6 +29185,10 @@ Make the shell buffer the current buffer, and return it. ;;; Generated autoloads from emacs-lisp/shortdoc.el +(autoload 'shortdoc--check "shortdoc" "\ + + +(fn GROUP FUNCTIONS)") (defvar shortdoc--groups nil) (defmacro define-short-documentation-group (group &rest functions) "\ Add GROUP to the list of defined documentation groups. @@ -29170,7 +29252,7 @@ execution of the documented form depends on some conditions. A FUNC form can have any number of `:no-eval' (or `:no-value'), `:no-eval*', `:result', `:result-string', `:eg-result' and -`:eg-result-string' properties." (declare (indent defun)) `(progn (setq shortdoc--groups (delq (assq ',group shortdoc--groups) shortdoc--groups)) (push (cons ',group ',functions) shortdoc--groups))) +`:eg-result-string' properties." (declare (indent defun)) (shortdoc--check group functions) `(progn (setq shortdoc--groups (delq (assq ',group shortdoc--groups) shortdoc--groups)) (push (cons ',group ',functions) shortdoc--groups))) (autoload 'shortdoc-display-group "shortdoc" "\ Pop to a buffer with short documentation summary for functions in GROUP. If FUNCTION is non-nil, place point on the entry for FUNCTION (if any). @@ -29435,19 +29517,19 @@ Minor mode to simplify editing output from the diff3 program. \\{smerge-mode-map} -This is a minor mode. If called interactively, toggle the -`SMerge mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `SMerge mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `smerge-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'smerge-start-session "smerge-mode" "\ @@ -29550,19 +29632,19 @@ with `so-long-variable-overrides'. This minor mode is a standard `so-long-action' option. -This is a minor mode. If called interactively, toggle the -`So-Long minor mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `So-Long +minor mode' mode. If the prefix argument is positive, enable the mode, +and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `so-long-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'so-long-mode "so-long" "\ @@ -29640,18 +29722,18 @@ Use \\[so-long-customize] to open the customization group `so-long' to configure the behavior. This is a global minor mode. If called interactively, toggle the -`Global So-Long mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Global So-Long mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='global-so-long-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "so-long" '("so-long-" "turn-o")) @@ -29888,6 +29970,24 @@ For example: to sort lines in the region by the first word on each line RECORD-REGEXP would be \"^.*$\" and KEY would be \"\\\\=\\\" (fn REVERSE RECORD-REGEXP KEY-REGEXP BEG END)" t) +(autoload 'sort-on "sort" "\ +Sort SEQUENCE by calling PREDICATE on sort keys produced by ACCESSOR. +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 +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 +expensive operation. This is known as the \"decorate-sort-undecorate\" +paradigm, or the Schwartzian transform. + +(fn SEQUENCE PREDICATE ACCESSOR)") (autoload 'sort-columns "sort" "\ Sort lines in region alphabetically by a certain range of columns. For the purpose of this command, the region BEG...END includes @@ -30667,18 +30767,18 @@ Encode/decode your strokes with \\[strokes-encode-buffer], \\{strokes-mode-map} This is a global minor mode. If called interactively, toggle the -`Strokes mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Strokes mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='strokes-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'strokes-decode-buffer "strokes" "\ @@ -30798,19 +30898,19 @@ called a `subword'. Here are some examples: This mode changes the definition of a word so that word commands treat nomenclature boundaries as word boundaries. -This is a minor mode. If called interactively, toggle the -`Subword mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Subword +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `subword-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (put 'global-subword-mode 'globalized-minor-mode t) @@ -30847,19 +30947,19 @@ syntax are treated as parts of words: e.g., in `superword-mode', \\{superword-mode-map} -This is a minor mode. If called interactively, toggle the -`Superword mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Superword +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `superword-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (put 'global-superword-mode 'globalized-minor-mode t) @@ -30951,18 +31051,18 @@ mouse to transfer text between Emacs and other programs which use GPM. This is due to limitations in GPM and the Linux kernel. This is a global minor mode. If called interactively, toggle the -`Gpm-Mouse mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Gpm-Mouse mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='gpm-mouse-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "t-mouse" '("gpm-mouse-")) @@ -30973,19 +31073,19 @@ it is disabled. (autoload 'tab-line-mode "tab-line" "\ Toggle display of tab line in the windows displaying the current buffer. -This is a minor mode. If called interactively, toggle the -`Tab-Line mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Tab-Line +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `tab-line-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (defvar-local tab-line-exclude nil) @@ -31057,19 +31157,18 @@ variable's value can be toggled by \\[table-fixed-width-mode] at run-time. This is a minor mode. If called interactively, toggle the -`Table-Fixed-Width mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Table-Fixed-Width mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `table-fixed-width-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'table-insert "table" "\ @@ -31926,6 +32025,9 @@ such as if there are no commands in the file, the value of `tex-default-mode' says which mode to use. (fn)" t) + (add-to-list 'major-mode-remap-defaults '(TeX-mode . tex-mode)) + (add-to-list 'major-mode-remap-defaults '(plain-TeX-mode . plain-tex-mode)) + (add-to-list 'major-mode-remap-defaults '(LaTeX-mode . latex-mode)) (defalias 'TeX-mode #'tex-mode) (defalias 'plain-TeX-mode #'plain-tex-mode) (defalias 'LaTeX-mode #'latex-mode) @@ -32475,19 +32577,19 @@ When `tildify-mode' is enabled, if `tildify-string-alist' specifies a hard space representation for current major mode, the `tildify-space-string' buffer-local variable will be set to the representation. -This is a minor mode. If called interactively, toggle the -`Tildify mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Tildify +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `tildify-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "tildify" '("tildify-")) @@ -32523,25 +32625,25 @@ non-nil, the current day and date are displayed as well. This runs the normal hook `display-time-hook' after each update. This is a global minor mode. If called interactively, toggle the -`Display-Time mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Display-Time mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='display-time-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (define-obsolete-function-alias 'display-time-world #'world-clock "28.1") (autoload 'world-clock "time" "\ Display a world clock buffer with times in various time zones. The variable `world-clock-list' specifies which time zones to use. -To turn off the world time display, go to the window and type `\\[quit-window]'." t) +To turn off the world time display, go to the window and type \\[quit-window]." t) (autoload 'emacs-uptime "time" "\ Return a string giving the uptime of this instance of Emacs. FORMAT is a string to format the result, using `format-seconds'. @@ -32822,21 +32924,16 @@ List all timers in a buffer. ;;; Generated autoloads from international/titdic-cnv.el (autoload 'titdic-convert "titdic-cnv" "\ -Convert a TIT dictionary of FILENAME into a Quail package. -Optional argument DIRNAME if specified is the directory name under which -the generated Quail package is saved. -(fn FILENAME &optional DIRNAME)" t) + +(fn FILENAME &optional DIRNAME)") +(make-obsolete 'titdic-convert 'tit-dic-convert "30.1") (autoload 'batch-titdic-convert "titdic-cnv" "\ -Run `titdic-convert' on the files remaining on the command line. -Use this from the command line, with `-batch'; -it won't work in an interactive Emacs. -For example, invoke \"emacs -batch -f batch-titdic-convert XXX.tit\" to - generate Quail package file \"xxx.el\" from TIT dictionary file \"XXX.tit\". -To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\". + (fn &optional FORCE)") -(register-definition-prefixes "titdic-cnv" '("batch-miscdic-convert" "ctlau-" "miscdic-convert" "pinyin-convert" "py-converter" "quail-" "quick-" "tit-" "tsang-" "ziranma-converter")) +(make-obsolete 'batch-titdic-convert 'batch-tit-dic-convert "30.1") +(register-definition-prefixes "titdic-cnv" '("batch-tit-" "tit-")) ;;; Generated autoloads from tmm.el @@ -32914,7 +33011,7 @@ current (i.e., last displayed) category. In Todo mode just the category's unfinished todo items are shown by default. The done items are hidden, but typing -`\\[todo-toggle-view-done-items]' displays them below the todo +\\[todo-toggle-view-done-items] displays them below the todo items. With non-nil user option `todo-show-with-done' both todo and done items are always shown on visiting a category. @@ -33012,6 +33109,61 @@ holds a keymap. (register-definition-prefixes "tooltip" '("tooltip-")) + +;;; Generated autoloads from touch-screen.el + +(autoload 'touch-screen-hold "touch-screen" "\ +Handle a long press EVENT. +Ding and select the window at EVENT, then activate the mark. If +`touch-screen-word-select' is enabled, try to select the whole +word around EVENT; otherwise, set point to the location of EVENT. + +(fn EVENT)" t) +(autoload 'touch-screen-track-tap "touch-screen" "\ +Track a single tap starting from EVENT. +EVENT should be a `touchscreen-begin' event. + +Read touch screen events until a `touchscreen-end' event is +received with the same ID as in EVENT. If UPDATE is non-nil and +a `touchscreen-update' event is received in the mean time and +contains a touch point with the same ID as in EVENT, call UPDATE +with that event and DATA. + +If THRESHOLD is non-nil, enforce a threshold of movement that is +either itself or 10 pixels when it is not a number. If the +aforementioned touch point moves beyond that threshold on any +axis, return nil immediately, and further resume mouse event +translation for the touch point at hand. + +Return nil immediately if any other kind of event is received; +otherwise, return t once the `touchscreen-end' event arrives. + +(fn EVENT &optional UPDATE DATA THRESHOLD)") +(autoload 'touch-screen-track-drag "touch-screen" "\ +Track a single drag starting from EVENT. +EVENT should be a `touchscreen-begin' event. + +Read touch screen events until a `touchscreen-end' event is +received with the same ID as in EVENT. For each +`touchscreen-update' event received in the mean time containing a +touch point with the same ID as in EVENT, call UPDATE with the +touch point in event and DATA, once the touch point has moved +significantly by at least 5 pixels from where it was in EVENT. + +Return nil immediately if any other kind of event is received; +otherwise, return either t or `no-drag' once the +`touchscreen-end' event arrives; return `no-drag' returned if the +touch point in EVENT did not move significantly, and t otherwise. + +(fn EVENT UPDATE &optional DATA)") +(autoload 'touch-screen-inhibit-drag "touch-screen" "\ +Inhibit subsequent `touchscreen-drag' events from being sent. +Prevent `touchscreen-drag' and translated mouse events from being +sent until the touch sequence currently being translated ends. +Must be called from a command bound to a `touchscreen-hold' or +`touchscreen-drag' event.") +(register-definition-prefixes "touch-screen" '("touch-screen-")) + ;;; Generated autoloads from emacs-lisp/tq.el @@ -33224,55 +33376,13 @@ Add archive file name handler to `file-name-handler-alist'." (when (and tramp-ar ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 7 0 -1)) package--builtin-versions) +(push (purecopy '(tramp 2 7 1 -1)) package--builtin-versions) (register-definition-prefixes "trampver" '("tramp-")) ;;; Generated autoloads from transient.el (push (purecopy '(transient 0 5 2)) package--builtin-versions) -(autoload 'transient-define-prefix "transient" "\ -Define NAME as a transient prefix command. - -ARGLIST are the arguments that command takes. -DOCSTRING is the documentation string and is optional. - -These arguments can optionally be followed by key-value pairs. -Each key has to be a keyword symbol, either `:class' or a keyword -argument supported by the constructor of that class. The -`transient-prefix' class is used if the class is not specified -explicitly. - -GROUPs add key bindings for infix and suffix commands and specify -how these bindings are presented in the popup buffer. At least -one GROUP has to be specified. See info node `(transient)Binding -Suffix and Infix Commands'. - -The BODY is optional. If it is omitted, then ARGLIST is also -ignored and the function definition becomes: - - (lambda () - (interactive) - (transient-setup \\='NAME)) - -If BODY is specified, then it must begin with an `interactive' -form that matches ARGLIST, and it must call `transient-setup'. -It may however call that function only when some condition is -satisfied; that is one of the reason why you might want to use -an explicit BODY. - -All transients have a (possibly nil) value, which is exported -when suffix commands are called, so that they can consume that -value. For some transients it might be necessary to have a sort -of secondary value, called a scope. Such a scope would usually -be set in the commands `interactive' form and has to be passed -to the setup function: - - (transient-setup \\='NAME nil nil :scope SCOPE) - -(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... GROUP... [BODY...])" nil t) -(function-put 'transient-define-prefix 'lisp-indent-function 'defun) -(function-put 'transient-define-prefix 'doc-string-elt 3) (autoload 'transient-insert-suffix "transient" "\ Insert a SUFFIX into PREFIX before LOC. PREFIX is a prefix command, a symbol. @@ -33517,18 +33627,18 @@ sessions and after a crash. Manual changes to the file may result in problems. This is a global minor mode. If called interactively, toggle the -`Type-Break mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Type-Break mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='type-break-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'type-break "type-break" "\ @@ -33914,18 +34024,18 @@ and `C-x C-f https://www.gnu.org/ RET' will give you the HTML at that URL in a buffer. This is a global minor mode. If called interactively, toggle the -`Url-Handler mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Url-Handler mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='url-handler-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'url-file-handler "url-handlers" "\ @@ -34012,10 +34122,7 @@ URL can be a URL string, or a URL record of the type returned by ;;; Generated autoloads from url/url-mailto.el -(autoload 'url-mail "url-mailto" "\ - - -(fn &rest ARGS)" t) +(defalias 'url-mail #'message-mail) (autoload 'url-mailto "url-mailto" "\ Handle the mailto: URL syntax. @@ -34478,7 +34585,6 @@ Normalize arguments to delight. ;;; Generated autoloads from use-package/use-package-ensure-system-package.el -(push (purecopy '(use-package-ensure-system-package 0 2)) package--builtin-versions) (autoload 'use-package-normalize/:ensure-system-package "use-package-ensure-system-package" "\ Turn ARGS into a list of conses of the form (PACKAGE-NAME . INSTALL-COMMAND). @@ -35192,6 +35298,25 @@ case, and the process object in the asynchronous case. (progn (load "vc-git" nil t) (vc-git-registered file)))) +(autoload 'vc-git-grep "vc-git" "\ +Run git grep, searching for REGEXP in FILES in directory DIR. +The search is limited to file names matching shell pattern FILES. +FILES may use abbreviations defined in `grep-files-aliases', e.g. +entering `ch' is equivalent to `*.[ch]'. As whitespace triggers +completion when entering a pattern, including it requires +quoting, e.g. `\\[quoted-insert]'. + +With \\[universal-argument] prefix, you can edit the constructed shell command line +before it is executed. +With two \\[universal-argument] prefixes, directly edit and run `grep-command'. + +Collect output in a buffer. While git grep runs asynchronously, you +can use \\[next-error] (`next-error'), or \\\\[compile-goto-error] in the grep output buffer, +to go to the lines where grep found matches. + +This command shares argument histories with \\[rgrep] and \\[grep]. + +(fn REGEXP &optional FILES DIR)" t) (register-definition-prefixes "vc-git" '("vc-")) @@ -35317,7 +35442,7 @@ Key bindings: ;;; Generated autoloads from progmodes/verilog-mode.el -(push (purecopy '(verilog-mode 2023 6 6 141322628)) package--builtin-versions) +(push (purecopy '(verilog-mode 2024 3 1 121933719)) package--builtin-versions) (autoload 'verilog-mode "verilog-mode" "\ Major mode for editing Verilog code. \\ @@ -35592,7 +35717,7 @@ Usage: according to option `vhdl-argument-list-indent'. If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of - tabs. `\\[tabify]' and `\\[untabify]' allow the conversion of spaces to + tabs. \\[tabify] and \\[untabify] allow the conversion of spaces to tabs and vice versa. Syntax-based indentation can be very slow in large files. Option @@ -35903,7 +36028,7 @@ Usage: `vhdl-highlight-translate-off' is non-nil. For documentation and customization of the used colors see - customization group `vhdl-highlight-faces' (`\\[customize-group]'). For + customization group `vhdl-highlight-faces' (\\[customize-group]). For highlighting of matching parenthesis, see customization group `paren-showing'. Automatic buffer highlighting is turned on/off by option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs). @@ -35963,14 +36088,14 @@ Usage: sessions using the \"Save Options\" menu entry. Options and their detailed descriptions can also be accessed by using - the \"Customize\" menu entry or the command `\\[customize-option]' - (`\\[customize-group]' for groups). Some customizations only take effect + the \"Customize\" menu entry or the command \\[customize-option] + (\\[customize-group] for groups). Some customizations only take effect after some action (read the NOTE in the option documentation). Customization can also be done globally (i.e. site-wide, read the INSTALL file). Not all options are described in this documentation, so go and see - what other useful user options there are (`\\[vhdl-customize]' or menu)! + what other useful user options there are (\\[vhdl-customize] or menu)! FILE EXTENSIONS: @@ -35999,7 +36124,7 @@ Usage: Maintenance: ------------ -To submit a bug report, enter `\\[vhdl-submit-bug-report]' within VHDL Mode. +To submit a bug report, enter \\[vhdl-submit-bug-report] within VHDL Mode. Add a description of the problem and include a reproducible test case. Questions and enhancement requests can be sent to . @@ -36264,19 +36389,19 @@ then \\[View-leave], \\[View-quit] and \\[View-kill-and-leave] will return to th Entry to view-mode runs the normal hook `view-mode-hook'. -This is a minor mode. If called interactively, toggle the `View -mode' mode. If the prefix argument is positive, enable the mode, -and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `View mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `view-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'view-mode-enter "view" "\ @@ -36350,6 +36475,57 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t) (register-definition-prefixes "quail/viqr" '("viet-quail-define-rules")) + +;;; Generated autoloads from visual-wrap.el + +(autoload 'visual-wrap-prefix-mode "visual-wrap" "\ +Display continuation lines with prefixes from surrounding context. + +To enable this minor mode across all buffers, enable +`global-visual-wrap-prefix-mode'. + +This is a minor mode. If called interactively, toggle the +`Visual-Wrap-Prefix mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `visual-wrap-prefix-mode'. + +The mode's hook is called both when the mode is enabled and when it is +disabled. + +(fn &optional ARG)" t) +(put 'global-visual-wrap-prefix-mode 'globalized-minor-mode t) +(defvar global-visual-wrap-prefix-mode nil "\ +Non-nil if Global Visual-Wrap-Prefix mode is enabled. +See the `global-visual-wrap-prefix-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `global-visual-wrap-prefix-mode'.") +(custom-autoload 'global-visual-wrap-prefix-mode "visual-wrap" nil) +(autoload 'global-visual-wrap-prefix-mode "visual-wrap" "\ +Toggle Visual-Wrap-Prefix mode in all buffers. +With prefix ARG, enable Global Visual-Wrap-Prefix mode if ARG is +positive; otherwise, disable it. + +If called from Lisp, toggle the mode if ARG is `toggle'. +Enable the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +Visual-Wrap-Prefix mode is enabled in all buffers where +`visual-wrap-prefix-mode' would do it. + +See `visual-wrap-prefix-mode' for more information on +Visual-Wrap-Prefix mode. + +(fn &optional ARG)" t) +(register-definition-prefixes "visual-wrap" '("visual-wrap-")) + ;;; Generated autoloads from emacs-lisp/vtable.el @@ -36532,18 +36708,18 @@ current function name is continuously displayed in the mode line, in certain major modes. This is a global minor mode. If called interactively, toggle the -`Which-Function mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Which-Function mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='which-function-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "which-func" '("which-func")) @@ -36561,19 +36737,19 @@ See also `whitespace-style', `whitespace-newline' and This mode uses a number of faces to visualize the whitespace; see the customization group `whitespace' for details. -This is a minor mode. If called interactively, toggle the -`Whitespace mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Whitespace +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `whitespace-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'whitespace-newline-mode "whitespace" "\ @@ -36587,19 +36763,18 @@ use `whitespace-mode'. See also `whitespace-newline' and `whitespace-display-mappings'. This is a minor mode. If called interactively, toggle the -`Whitespace-Newline mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Whitespace-Newline mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `whitespace-newline-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (put 'global-whitespace-mode 'globalized-minor-mode t) @@ -36646,18 +36821,18 @@ See also `whitespace-newline' and `whitespace-display-mappings'. This is a global minor mode. If called interactively, toggle the `Global Whitespace-Newline mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +positive, enable the mode, and if it is zero or negative, disable the +mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='global-whitespace-newline-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'whitespace-toggle-options "whitespace" "\ @@ -36961,19 +37136,19 @@ Show widget browser for WIDGET in other window. (autoload 'widget-minor-mode "wid-browse" "\ Minor mode for traversing widgets. -This is a minor mode. If called interactively, toggle the -`Widget minor mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Widget minor +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `widget-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "wid-browse" '("widget-")) @@ -37068,18 +37243,18 @@ for a description of this minor mode.") Global minor mode for default windmove commands. This is a global minor mode. If called interactively, toggle the -`Windmove mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Windmove mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='windmove-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'windmove-default-keybindings "windmove" "\ @@ -37215,18 +37390,18 @@ sequence \\`C-c '. If you change your mind (while undoing), you can press \\`C-c ' (calling `winner-redo'). This is a global minor mode. If called interactively, toggle the -`Winner mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Winner mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='winner-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "winner" '("winner-")) @@ -37294,19 +37469,18 @@ Allow `word-wrap' to fold on all breaking whitespace characters. The characters to break on are defined by `word-wrap-whitespace-characters'. This is a minor mode. If called interactively, toggle the -`Word-Wrap-Whitespace mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Word-Wrap-Whitespace mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `word-wrap-whitespace-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (put 'global-word-wrap-whitespace-mode 'globalized-minor-mode t) @@ -37557,18 +37731,18 @@ mouse functionality for such clicks is still available by holding down the SHIFT key while pressing the mouse button. This is a global minor mode. If called interactively, toggle the -`Xterm-Mouse mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Xterm-Mouse mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='xterm-mouse-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "xt-mouse" '("turn-o" "xt-mouse-epoch" "xterm-mouse-")) @@ -37652,99 +37826,9 @@ run a specific program. The program must be a member of (register-definition-prefixes "zone" '("zone-")) -;;; Generated autoloads from emacs-lisp/ert-font-lock.el - -(autoload 'ert-font-lock-deftest "ert-font-lock" "\ -Define test NAME (a symbol) using assertions from TEST-STR. - -Other than MAJOR-MODE and TEST-STR parameters, this macro accepts -the same parameters and keywords as `ert-deftest' and is intended -to be used through `ert'. - -(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)] MAJOR-MODE TEST-STR)" nil t) -(function-put 'ert-font-lock-deftest 'doc-string-elt 3) -(function-put 'ert-font-lock-deftest 'lisp-indent-function 2) -(autoload 'ert-font-lock-deftest-file "ert-font-lock" "\ -Define test NAME (a symbol) using assertions from FILE. - -FILE - path to a file with assertions in ERT resource director as -return by `ert-resource-directory'. - -Other than MAJOR-MODE and FILE parameters, this macro accepts the -same parameters and keywords as `ert-deftest' and is intended to -be used through `ert'. - -(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)] MAJOR-MODE FILE)" nil t) -(function-put 'ert-font-lock-deftest-file 'doc-string-elt 3) -(function-put 'ert-font-lock-deftest-file 'lisp-indent-function 2) -(autoload 'ert-font-lock-test-string "ert-font-lock" "\ -Check font faces in TEST-STRING set by MODE. - -The function is meant to be run from within an ERT test. - -(fn TEST-STRING MODE)") -(autoload 'ert-font-lock-test-file "ert-font-lock" "\ -Check font faces in FILENAME set by MODE. - -The function is meant to be run from within an ERT test. - -(fn FILENAME MODE)") -(register-definition-prefixes "ert-font-lock" '("ert-font-lock--")) - - -;;; Generated autoloads from touch-screen.el - -(autoload 'touch-screen-hold "touch-screen" "\ -Handle a long press EVENT. -Ding and select the window at EVENT, then activate the mark. If -`touch-screen-word-select' is enabled, try to select the whole -word around EVENT; otherwise, set point to the location of EVENT. - -(fn EVENT)" t) -(autoload 'touch-screen-track-tap "touch-screen" "\ -Track a single tap starting from EVENT. -EVENT should be a `touchscreen-begin' event. - -Read touch screen events until a `touchscreen-end' event is -received with the same ID as in EVENT. If UPDATE is non-nil and -a `touchscreen-update' event is received in the mean time and -contains a touch point with the same ID as in EVENT, call UPDATE -with that event and DATA. - -If THRESHOLD is non-nil, enforce a threshold of movement that is -either itself or 10 pixels when it is not a number. If the -aforementioned touch point moves beyond that threshold on any -axis, return nil immediately, and further resume mouse event -translation for the touch point at hand. - -Return nil immediately if any other kind of event is received; -otherwise, return t once the `touchscreen-end' event arrives. - -(fn EVENT &optional UPDATE DATA THRESHOLD)") -(autoload 'touch-screen-track-drag "touch-screen" "\ -Track a single drag starting from EVENT. -EVENT should be a `touchscreen-begin' event. - -Read touch screen events until a `touchscreen-end' event is -received with the same ID as in EVENT. For each -`touchscreen-update' event received in the mean time containing a -touch point with the same ID as in EVENT, call UPDATE with the -touch point in event and DATA, once the touch point has moved -significantly by at least 5 pixels from where it was in EVENT. - -Return nil immediately if any other kind of event is received; -otherwise, return either t or `no-drag' once the -`touchscreen-end' event arrives; return `no-drag' returned if the -touch point in EVENT did not move significantly, and t otherwise. +;;; Generated autoloads from net/tramp-androidsu.el -(fn EVENT UPDATE &optional DATA)") -(autoload 'touch-screen-inhibit-drag "touch-screen" "\ -Inhibit subsequent `touchscreen-drag' events from being sent. -Prevent `touchscreen-drag' and translated mouse events from being -sent until the touch sequence currently being translated ends. -Must be called from a command bound to a `touchscreen-hold' or -`touchscreen-drag' event.") -(register-definition-prefixes "touch-screen" '("touch-screen-")) +(register-definition-prefixes "tramp-androidsu" '("tramp-androidsu-")) ;;; End of scraped data @@ -37754,8 +37838,8 @@ Must be called from a command bound to a `touchscreen-hold' or ;; Local Variables: ;; version-control: never ;; no-update-autoloads: t -;; no-byte-compile: t ;; no-native-compile: t +;; no-byte-compile: t ;; coding: utf-8-emacs-unix ;; End: -- cgit v1.2.3 From fe491173e8f839653cb22eea63a7261f4aa1dca9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 9 Mar 2024 11:40:27 +0200 Subject: ; * doc/emacs/files.texi (Image Mode): Fix typo (bug#69671). --- doc/emacs/files.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 36f72d42ba2..971483a6e4c 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -2373,7 +2373,7 @@ multiply the size by the factor of @w{@code{1 + @var{n} / 10}}, so @findex image-decrease-size @kindex i - (Image mode) @item i - -Decrease the image size (@code{image-increase-size}) by 20%. Prefix +Decrease the image size (@code{image-decrease-size}) by 20%. Prefix numeric argument controls the decrement; the value of @var{n} means to multiply the size by the factor of @w{@code{1 - @var{n} / 10}}, so @w{@kbd{C-u 3 i -}} means to decrease the size by 30%. -- cgit v1.2.3 From cc2579c10bc67dc375247490bb55367ef0800435 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 9 Mar 2024 16:13:47 +0100 Subject: * 'syncdoc-type-hierarchy.el' update due to recent changes * admin/syncdoc-type-hierarchy.el (syncdoc-all-types): Update. --- admin/syncdoc-type-hierarchy.el | 4 ---- 1 file changed, 4 deletions(-) diff --git a/admin/syncdoc-type-hierarchy.el b/admin/syncdoc-type-hierarchy.el index b5cfdfd8e74..e14d7fb54e1 100644 --- a/admin/syncdoc-type-hierarchy.el +++ b/admin/syncdoc-type-hierarchy.el @@ -47,10 +47,6 @@ (defconst syncdoc-all-types (let (res) - (maphash (lambda (type _) - (push type res)) - cl--direct-supertypes-of-type) - (mapatoms (lambda (type) (when (cl-find-class type) (push type res))) -- cgit v1.2.3 From 3be70a13d7b27ccdffbd4efb44752d15376d5e57 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 9 Mar 2024 16:14:14 +0100 Subject: Run 'syncdoc-update-type-hierarchy'. * doc/lispref/elisp_type_hierarchy.jpg: Update. * doc/lispref/elisp_type_hierarchy.txt: Likewise. --- doc/lispref/elisp_type_hierarchy.jpg | Bin 358752 -> 345570 bytes doc/lispref/elisp_type_hierarchy.txt | 40 +++++++++++++++++++---------------- 2 files changed, 22 insertions(+), 18 deletions(-) diff --git a/doc/lispref/elisp_type_hierarchy.jpg b/doc/lispref/elisp_type_hierarchy.jpg index 518255566b9..a2e14490dfa 100644 Binary files a/doc/lispref/elisp_type_hierarchy.jpg and b/doc/lispref/elisp_type_hierarchy.jpg differ diff --git a/doc/lispref/elisp_type_hierarchy.txt b/doc/lispref/elisp_type_hierarchy.txt index 00b6bb91458..d1be8f56c72 100644 --- a/doc/lispref/elisp_type_hierarchy.txt +++ b/doc/lispref/elisp_type_hierarchy.txt @@ -1,29 +1,33 @@ | Type | Derived Types | |---------------------+------------------------------------------------------------| +| atom | mutex record font-spec frame number-or-marker | +| | tree-sitter-compiled-query tree-sitter-node font-entity | +| | tree-sitter-parser hash-table window-configuration | +| | function user-ptr overlay array process font-object symbol | +| | obarray condvar buffer terminal thread window | +| | native-comp-unit | | cl-structure-object | xref-elisp-location org-cite-processor cl--generic-method | | | cl--random-state register-preview-info cl--generic | | | cl--class cl-slot-descriptor uniquify-item registerv | | | isearch--state cl--generic-generalizer lisp-indent-state | +| t | sequence atom | +| compiled-function | subr byte-code-function | +| integer | fixnum bignum | +| symbol | symbol-with-pos keyword boolean | | accessor | oclosure-accessor | | oclosure | advice cconv--interactive-helper advice--forward accessor | | | save-some-buffers-function cl--generic-nnm | -| atom | ppss decoded-time oclosure cl-structure-object timer | -| | native-comp-unit obarray symbol number-or-marker overlay | -| | window-configuration process window buffer frame | -| | hash-table terminal thread mutex condvar font-spec | -| | font-entity font-object user-ptr tree-sitter-parser | -| | tree-sitter-node tree-sitter-compiled-query function array | -| cl--class | cl-structure-class oclosure--class | +| cons | ppss decoded-time | +| cl--class | cl-structure-class oclosure--class built-in-class | | subr | subr-primitive subr-native-elisp | -| function | compiled-function module-function | -| compiled-function | subr byte-code-function | -| list | cons null | +| array | string vector bool-vector char-table | +| number | float integer | +| number-or-marker | integer-or-marker number | +| function | oclosure compiled-function interpreted-function | +| | module-function | +| sequence | list array | +| integer-or-marker | integer marker | | boolean | null | -| array | string char-table bool-vector vector | -| symbol | symbol-with-pos boolean keyword | -| integer | fixnum bignum | -| number-or-marker | number integer-or-marker | -| integer-or-marker | marker integer | -| number | integer float | -| sequence | array list | -| t | atom sequence | +| list | null cons | +| record | cl-structure-object | +| vector | timer | -- cgit v1.2.3 From 454a55dbd963d4b07c0dc0f6d540cc5fd4b4faa7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 8 Mar 2024 12:44:38 -0500 Subject: (dir-locals-collect-variables): Avoid spurious safety warnings * lisp/files.el (dir-locals-collect-variables): Silence warnings for extra parents' variables. --- lisp/files.el | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lisp/files.el b/lisp/files.el index dd7580b6580..3ca4f047144 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4446,6 +4446,12 @@ to see whether it should be considered." (funcall predicate key) (or (not key) (derived-mode-p key))) + ;; If KEY is an extra parent it may remain not loaded + ;; (hence with some of its mode-specific vars missing their + ;; `safe-local-variable' property), leading to spurious + ;; prompts about unsafe vars (bug#68246). + (if (and (symbolp key) (autoloadp (indirect-function key))) + (ignore-errors (autoload-do-load (indirect-function key)))) (let* ((alist (cdr entry)) (subdirs (assq 'subdirs alist))) (if (or (not subdirs) -- cgit v1.2.3 From c79a509384d33dab6a964ef9a97cbc9a1f1b5bf7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 8 Mar 2024 12:58:11 -0500 Subject: Add non-TS modes as extra parent of TS modes (bug#68246) Record the fact that TS modes are alternatives to the non-TS modes using the new `derived-mode-add-parents` functionality. Do the same for long standing similar issues with CPerl-mode. * lisp/textmodes/yaml-ts-mode.el (yaml-ts-mode): * lisp/textmodes/toml-ts-mode.el (toml-ts-mode): * lisp/textmodes/html-ts-mode.el (html-ts-mode): * lisp/textmodes/css-mode.el (css-ts-mode): * lisp/progmodes/typescript-ts-mode.el (typescript-ts-mode, tsx-ts-mode): * lisp/progmodes/sh-script.el (bash-ts-mode): * lisp/progmodes/rust-ts-mode.el (rust-ts-mode): * lisp/progmodes/ruby-ts-mode.el (ruby-ts-mode): * lisp/progmodes/python.el (python-ts-mode): * lisp/progmodes/lua-ts-mode.el (lua-ts-mode): * lisp/progmodes/json-ts-mode.el (json-ts-mode): * lisp/progmodes/js.el (js-ts-mode): * lisp/progmodes/java-ts-mode.el (java-ts-mode): * lisp/progmodes/heex-ts-mode.el (heex-ts-mode): * lisp/progmodes/go-ts-mode.el (go-ts-mode, go-mod-ts-mode): * lisp/progmodes/elixir-ts-mode.el (elixir-ts-mode): * lisp/progmodes/dockerfile-ts-mode.el (dockerfile-ts-mode): * lisp/progmodes/csharp-mode.el (csharp-ts-mode): * lisp/progmodes/cmake-ts-mode.el (cmake-ts-mode): * lisp/progmodes/c-ts-mode.el (c-ts-mode, c++-ts-mode): Add non-TS mode as extra parent. * lisp/progmodes/cperl-mode.el (cperl-mode): Add `perl-mode` as extra parent. --- etc/NEWS | 10 ++++++++++ lisp/progmodes/c-ts-mode.el | 4 ++++ lisp/progmodes/cmake-ts-mode.el | 2 ++ lisp/progmodes/cperl-mode.el | 2 ++ lisp/progmodes/csharp-mode.el | 2 ++ lisp/progmodes/dockerfile-ts-mode.el | 2 ++ lisp/progmodes/elixir-ts-mode.el | 2 ++ lisp/progmodes/go-ts-mode.el | 4 ++++ lisp/progmodes/heex-ts-mode.el | 2 ++ lisp/progmodes/java-ts-mode.el | 2 ++ lisp/progmodes/js.el | 2 ++ lisp/progmodes/json-ts-mode.el | 2 ++ lisp/progmodes/lua-ts-mode.el | 2 ++ lisp/progmodes/python.el | 2 ++ lisp/progmodes/ruby-ts-mode.el | 2 ++ lisp/progmodes/rust-ts-mode.el | 2 ++ lisp/progmodes/sh-script.el | 2 ++ lisp/progmodes/typescript-ts-mode.el | 4 ++++ lisp/textmodes/css-mode.el | 2 ++ lisp/textmodes/html-ts-mode.el | 2 ++ lisp/textmodes/toml-ts-mode.el | 2 ++ lisp/textmodes/yaml-ts-mode.el | 2 ++ 22 files changed, 58 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 2aa669be344..2e51c0490fe 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -62,6 +62,16 @@ more details. * Incompatible Changes in Emacs 30.1 +** Tree-Sitter modes are now declared as submodes of the non-TS modes. +In order to help the use of those Tree-Sitter modes, they are now +declared to have the corresponding non-Tree-Sitter mode as an +additional parent. +This way, things like `.dir-locals.el` settings, and YASnippet +collections of snippets automatically apply to the new Tree-Sitter modes. + +Note that those modes still do not inherit from the non-TS mode, so +configuration settings installed via mode hooks are not affected. + +++ ** URL now never sends user email addresses in HTTP requests. Emacs never sent email addresses by default, but it used to be diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 38b72e59388..a2e7f6fba2e 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -1328,6 +1328,8 @@ in your configuration." (lambda (_pos) 'c)) (treesit-font-lock-recompute-features '(emacs-devel))))) +(derived-mode-add-parents 'c-ts-mode '(c-mode)) + ;;;###autoload (define-derived-mode c++-ts-mode c-ts-base-mode "C++" "Major mode for editing C++, powered by tree-sitter. @@ -1371,6 +1373,8 @@ recommended to enable `electric-pair-mode' with this mode." (setq-local add-log-current-defun-function #'c-ts-mode--emacs-current-defun-name)))) +(derived-mode-add-parents 'c++-ts-mode '(c++-mode)) + (easy-menu-define c-ts-mode-menu (list c-ts-mode-map c++-ts-mode-map) "Menu for `c-ts-mode' and `c++-ts-mode'." '("C/C++" diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el index 45c4882d873..b70806f4c30 100644 --- a/lisp/progmodes/cmake-ts-mode.el +++ b/lisp/progmodes/cmake-ts-mode.el @@ -243,6 +243,8 @@ Return nil if there is no name or if NODE is not a defun node." (treesit-major-mode-setup))) +(derived-mode-add-parents 'cmake-ts-mode '(cmake-mode)) + (if (treesit-ready-p 'cmake) (add-to-list 'auto-mode-alist '("\\(?:CMakeLists\\.txt\\|\\.cmake\\)\\'" . cmake-ts-mode))) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 10ac80dffd5..11709bfe00b 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1934,6 +1934,8 @@ or as help on variables `cperl-tips', `cperl-problems', ;; Setup Flymake (add-hook 'flymake-diagnostic-functions #'perl-flymake nil t)) +(derived-mode-add-parents 'cperl-mode '(perl-mode)) + (defun cperl--set-file-style () (when cperl-file-style (cperl-file-style cperl-file-style))) diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 7bf57bcbe21..18114d08528 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -998,6 +998,8 @@ Key bindings: (add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-ts-mode))) +(derived-mode-add-parents 'csharp-ts-mode '(csharp-mode)) + (provide 'csharp-mode) ;;; csharp-mode.el ends here diff --git a/lisp/progmodes/dockerfile-ts-mode.el b/lisp/progmodes/dockerfile-ts-mode.el index f6587018513..e31fd86bbdf 100644 --- a/lisp/progmodes/dockerfile-ts-mode.el +++ b/lisp/progmodes/dockerfile-ts-mode.el @@ -165,6 +165,8 @@ Return nil if there is no name or if NODE is not a stage node." (treesit-major-mode-setup))) +(derived-mode-add-parents 'dockerfile-ts-mode '(dockerfile-mode)) + (if (treesit-ready-p 'dockerfile) (add-to-list 'auto-mode-alist ;; NOTE: We can't use `rx' here, as it breaks bootstrap. diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el index f26c3a49203..9804152d9ab 100644 --- a/lisp/progmodes/elixir-ts-mode.el +++ b/lisp/progmodes/elixir-ts-mode.el @@ -753,6 +753,8 @@ Return nil if NODE is not a defun node or doesn't have a name." (treesit-major-mode-setup) (setq-local syntax-propertize-function #'elixir-ts--syntax-propertize))) +(derived-mode-add-parents 'elixir-ts-mode '(elixir-mode)) + (if (treesit-ready-p 'elixir) (progn (add-to-list 'auto-mode-alist '("\\.elixir\\'" . elixir-ts-mode)) diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index 296e4d0037d..cc330688dc3 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -261,6 +261,8 @@ (treesit-major-mode-setup))) +(derived-mode-add-parents 'go-ts-mode '(go-mode)) + (if (treesit-ready-p 'go) ;; FIXME: Should we instead put `go-mode' in `auto-mode-alist' ;; and then use `major-mode-remap-defaults' to map it to `go-ts-mode'? @@ -439,6 +441,8 @@ what the parent of the node would be if it were a node." (treesit-major-mode-setup))) +(derived-mode-add-parents 'go-mod-ts-mode '(go-mod-mode)) + (if (treesit-ready-p 'gomod) (add-to-list 'auto-mode-alist '("/go\\.mod\\'" . go-mod-ts-mode))) diff --git a/lisp/progmodes/heex-ts-mode.el b/lisp/progmodes/heex-ts-mode.el index 22e8956661d..07b8bfdc74f 100644 --- a/lisp/progmodes/heex-ts-mode.el +++ b/lisp/progmodes/heex-ts-mode.el @@ -187,6 +187,8 @@ With ARG, do it many times. Negative ARG means move backward." (treesit-major-mode-setup))) +(derived-mode-add-parents 'heex-ts-mode '(heex-mode)) + (if (treesit-ready-p 'heex) ;; Both .heex and the deprecated .leex files should work ;; with the tree-sitter-heex grammar. diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 00d7d0d75a1..bb4a7df3340 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -406,6 +406,8 @@ Return nil if there is no name or if NODE is not a defun node." ("Method" "\\`method_declaration\\'" nil nil))) (treesit-major-mode-setup)) +(derived-mode-add-parents 'java-ts-mode '(java-mode)) + (if (treesit-ready-p 'java) (add-to-list 'auto-mode-alist '("\\.java\\'" . java-ts-mode))) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index ebc098e6a75..6cb84592896 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3916,6 +3916,8 @@ See `treesit-thing-settings' for more information.") (add-to-list 'auto-mode-alist '("\\(\\.js[mx]\\|\\.har\\)\\'" . js-ts-mode)))) +(derived-mode-add-parents 'js-ts-mode '(js-mode)) + (defvar js-ts--s-p-query (when (treesit-available-p) (treesit-query-compile 'javascript diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el index 32bc10bbda9..1fb96555010 100644 --- a/lisp/progmodes/json-ts-mode.el +++ b/lisp/progmodes/json-ts-mode.el @@ -164,6 +164,8 @@ Return nil if there is no name or if NODE is not a defun node." (treesit-major-mode-setup)) +(derived-mode-add-parents 'json-ts-mode '(json-mode)) + (if (treesit-ready-p 'json) (add-to-list 'auto-mode-alist '("\\.json\\'" . json-ts-mode))) diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 8bd3db2b75f..25fd7792f42 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -798,6 +798,8 @@ Calls REPORT-FN directly." (add-hook 'flymake-diagnostic-functions #'lua-ts-flymake-luacheck nil 'local)) +(derived-mode-add-parents 'lua-ts-mode '(lua-mode)) + (when (treesit-ready-p 'lua) (add-to-list 'auto-mode-alist '("\\.lua\\'" . lua-ts-mode))) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index bedc61408ef..1016655cb62 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -7128,6 +7128,8 @@ implementations: `python-mode' and `python-ts-mode'." (add-to-list 'auto-mode-alist '("\\.py[iw]?\\'" . python-ts-mode)) (add-to-list 'interpreter-mode-alist '("python[0-9.]*" . python-ts-mode)))) +(derived-mode-add-parents 'python-ts-mode '(python-mode)) + ;;; Completion predicates for M-x ;; Commands that only make sense when editing Python code. (dolist (sym '(python-add-import diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index cdfa3dca498..7133cb0b5b0 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -1210,6 +1210,8 @@ leading double colon is not added." (setq-local syntax-propertize-function #'ruby-ts--syntax-propertize)) +(derived-mode-add-parents 'ruby-ts-mode '(ruby-mode)) + (if (treesit-ready-p 'ruby) (add-to-list 'major-mode-remap-defaults '(ruby-mode . ruby-ts-mode))) diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index c5fc57cc374..c67ac43e4d0 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -474,6 +474,8 @@ See `prettify-symbols-compose-predicate'." (treesit-major-mode-setup))) +(derived-mode-add-parents 'rust-ts-mode '(rust-mode)) + (if (treesit-ready-p 'rust) (add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-ts-mode))) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 43fb8a723bd..ab95dc9f924 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1639,6 +1639,8 @@ not written in Bash or sh." (setq-local treesit-defun-type-regexp "function_definition") (treesit-major-mode-setup))) +(derived-mode-add-parents 'bash-ts-mode '(sh-mode)) + (advice-add 'bash-ts-mode :around #'sh--redirect-bash-ts-mode ;; Give it lower precedence than normal advice, so other ;; advices take precedence over it. diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 9ee9432e4ee..ea4f6417c5a 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -505,6 +505,8 @@ This mode is intended to be inherited by concrete major modes." (treesit-major-mode-setup))) +(derived-mode-add-parents 'typescript-ts-mode '(typescript-mode)) + (if (treesit-ready-p 'typescript) (add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-ts-mode))) @@ -562,6 +564,8 @@ at least 3 (which is the default value)." (treesit-major-mode-setup))) +(derived-mode-add-parents 'tsx-ts-mode '(tsx-mode)) + (defvar typescript-ts--s-p-query (when (treesit-available-p) (treesit-query-compile 'typescript diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 425f3ec8a30..f5a20e0ca0e 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1830,6 +1830,8 @@ can also be used to fill comments. (add-to-list 'auto-mode-alist '("\\.css\\'" . css-ts-mode)))) +(derived-mode-add-parents 'css-ts-mode '(css-mode)) + ;;;###autoload (define-derived-mode css-mode css-base-mode "CSS" "Major mode to edit Cascading Style Sheets (CSS). diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el index 9af2aa6748f..235e1055fa9 100644 --- a/lisp/textmodes/html-ts-mode.el +++ b/lisp/textmodes/html-ts-mode.el @@ -134,6 +134,8 @@ Return nil if there is no name or if NODE is not a defun node." (treesit-major-mode-setup)) +(derived-mode-add-parents 'html-ts-mode '(html-mode)) + (if (treesit-ready-p 'html) (add-to-list 'auto-mode-alist '("\\.html\\'" . html-ts-mode))) diff --git a/lisp/textmodes/toml-ts-mode.el b/lisp/textmodes/toml-ts-mode.el index 1ba410045f5..1b621032f8a 100644 --- a/lisp/textmodes/toml-ts-mode.el +++ b/lisp/textmodes/toml-ts-mode.el @@ -153,6 +153,8 @@ Return nil if there is no name or if NODE is not a defun node." (treesit-major-mode-setup))) +(derived-mode-add-parents 'toml-ts-mode '(toml-mode)) + (if (treesit-ready-p 'toml) (add-to-list 'auto-mode-alist '("\\.toml\\'" . toml-ts-mode))) diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el index a8cb504ef03..210835585fe 100644 --- a/lisp/textmodes/yaml-ts-mode.el +++ b/lisp/textmodes/yaml-ts-mode.el @@ -169,6 +169,8 @@ boundaries. JUSTIFY is passed to `fill-paragraph'." (treesit-major-mode-setup))) +(derived-mode-add-parents 'yaml-ts-mode '(yaml-mode)) + (if (treesit-ready-p 'yaml) (add-to-list 'auto-mode-alist '("\\.ya?ml\\'" . yaml-ts-mode))) -- cgit v1.2.3 From 41de53d4a1c49ef6c6e8ac4ecb0c10cb1b6e07ce Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 8 Mar 2024 12:50:33 -0500 Subject: Simplify mode-indexed tables in packages Now that we use extra-parents to group alternative major modes, some tables can be simplified to mention only the group's leader. * lisp/align.el (align-c++-modes, align-rules-list): Don't bother listing TS alternatives. (align-perl-modes): Don't bother listing CPerl alternative. * lisp/info-look.el (perl-mode): Simplify. * lisp/cedet/semantic/symref/grep.el (semantic-symref-filepattern-alist): Don't bother listing TS alternatives. * lisp/emulation/viper.el (viper-vi-state-mode-list): Don't bother listing CPerl alternative. * lisp/progmodes/gud.el (gud-tooltip-activate-mouse-motions-if-enabled): Take into account the modes hierarchy. (gud-tooltip-modes): Don't bother listing TS alternatives. * .dir-locals.el (c-ts-mode): Simplify. --- .dir-locals.el | 4 +--- lisp/align.el | 9 ++++----- lisp/cedet/semantic/symref/grep.el | 6 ------ lisp/emulation/viper.el | 1 - lisp/htmlfontify.el | 1 + lisp/info-look.el | 5 ++--- lisp/progmodes/gud.el | 10 ++++------ lisp/progmodes/hideshow.el | 3 +++ 8 files changed, 15 insertions(+), 24 deletions(-) diff --git a/.dir-locals.el b/.dir-locals.el index 1a6acecc206..b34949ae961 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -32,9 +32,7 @@ (electric-quote-comment . nil) (electric-quote-string . nil) (mode . bug-reference-prog))) - (c-ts-mode . ((c-ts-mode-indent-style . gnu) - (indent-tabs-mode . t) - (mode . bug-reference-prog))) + (c-ts-mode . ((c-ts-mode-indent-style . gnu))) ;Inherits `c-mode' settings. (log-edit-mode . ((log-edit-font-lock-gnu-style . t) (log-edit-setup-add-author . t) (vc-git-log-edit-summary-target-len . 50) diff --git a/lisp/align.el b/lisp/align.el index fa95f24fa02..81ccc4b5e2d 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -181,13 +181,12 @@ If nil, then no messages will ever be printed to the minibuffer." :type '(choice (const :tag "Align a large region silently" nil) integer) :group 'align) -(defcustom align-c++-modes '( c++-mode c-mode java-mode - c-ts-mode c++-ts-mode) +(defcustom align-c++-modes '( c++-mode c-mode java-mode) "A list of modes whose syntax resembles C/C++." :type '(repeat symbol) :group 'align) -(defcustom align-perl-modes '(perl-mode cperl-mode) +(defcustom align-perl-modes '(perl-mode) "A list of modes where Perl syntax is to be seen." :type '(repeat symbol) :group 'align) @@ -576,13 +575,13 @@ The possible settings for `align-region-separate' are: "=" (group (zero-or-more (syntax whitespace))))) (group . (1 2)) - (modes . '(conf-toml-mode toml-ts-mode lua-mode lua-ts-mode))) + (modes . '(conf-toml-mode lua-mode))) (double-dash-comment (regexp . ,(rx (group (zero-or-more (syntax whitespace))) "--" (zero-or-more nonl))) - (modes . '(lua-mode lua-ts-mode)) + (modes . '(lua-mode)) (column . comment-column) (valid . ,(lambda () (save-excursion diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el index 83e3bc36073..cc4d1546c85 100644 --- a/lisp/cedet/semantic/symref/grep.el +++ b/lisp/cedet/semantic/symref/grep.el @@ -44,9 +44,7 @@ those hits returned.") (defvar semantic-symref-filepattern-alist '((c-mode "*.[ch]") - (c-ts-mode "*.[ch]") (c++-mode "*.[chCH]" "*.[ch]pp" "*.cc" "*.hh") - (c++-ts-mode "*.[chCH]" "*.[ch]pp" "*.cc" "*.hh") (html-mode "*.html" "*.shtml" "*.php") (mhtml-mode "*.html" "*.shtml" "*.php") ; FIXME: remove ; duplication of @@ -55,12 +53,8 @@ those hits returned.") ; major mode definition? (ruby-mode "*.r[bu]" "*.rake" "*.gemspec" "*.erb" "*.haml" "Rakefile" "Thorfile" "Capfile" "Guardfile" "Vagrantfile") - (ruby-ts-mode "*.r[bu]" "*.rake" "*.gemspec" "*.erb" "*.haml" - "Rakefile" "Thorfile" "Capfile" "Guardfile" "Vagrantfile") (python-mode "*.py" "*.pyi" "*.pyw") - (python-ts-mode "*.py" "*.pyi" "*.pyw") (perl-mode "*.pl" "*.PL") - (cperl-mode "*.pl" "*.PL") (lisp-interaction-mode "*.el" "*.ede" ".emacs" "_emacs") ) "List of major modes and file extension pattern. diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 83fcdf89375..287292a24dc 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -388,7 +388,6 @@ widget." idl-mode perl-mode - cperl-mode javascript-mode tcl-mode python-mode diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index 6b9c623f31f..89c2bee2204 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -586,6 +586,7 @@ If a window system is unavailable, calls `hfy-fallback-color-values'." (defvar hfy-cperl-mode-kludged-p nil) (defun hfy-kludge-cperl-mode () + ;; FIXME: Still? "CPerl mode does its damnedest not to do some of its fontification when not in a windowing system - try to trick it..." (declare (obsolete nil "28.1")) diff --git a/lisp/info-look.el b/lisp/info-look.el index da7beafe500..cd59fdf17d7 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -985,9 +985,8 @@ Return nil if there is nothing appropriate in the buffer near point." finally return "(python)Index"))))) (info-lookup-maybe-add-help - :mode 'cperl-mode - :regexp "[$@%][^a-zA-Z]\\|\\$\\^[A-Z]\\|[$@%]?[a-zA-Z][_a-zA-Z0-9]*" - :other-modes '(perl-mode)) + :mode 'perl-mode + :regexp "[$@%][^a-zA-Z]\\|\\$\\^[A-Z]\\|[$@%]?[a-zA-Z][_a-zA-Z0-9]*") (info-lookup-maybe-add-help :mode 'latex-mode diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index b7c85fe7f43..f10b047cc74 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3671,8 +3671,7 @@ Treats actions as defuns." (remove-hook 'after-save-hook #'gdb-create-define-alist t)))) (defcustom gud-tooltip-modes '( gud-mode c-mode c++-mode fortran-mode - python-mode c-ts-mode c++-ts-mode - python-ts-mode) + python-mode) "List of modes for which to enable GUD tooltips." :type '(repeat (symbol :tag "Major mode")) :group 'tooltip) @@ -3708,10 +3707,9 @@ only tooltips in the buffer containing the overlay arrow." #'gud-tooltip-activate-mouse-motions-if-enabled) (dolist (buffer (buffer-list)) (with-current-buffer buffer - (if (and gud-tooltip-mode - (memq major-mode gud-tooltip-modes)) - (gud-tooltip-activate-mouse-motions t) - (gud-tooltip-activate-mouse-motions nil))))) + (gud-tooltip-activate-mouse-motions + (and gud-tooltip-mode + (derived-mode-p gud-tooltip-modes)))))) (defvar gud-tooltip-mouse-motions-active nil "Locally t in a buffer if tooltip processing of mouse motion is enabled.") diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index b181b21118f..07616960565 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -254,6 +254,9 @@ This has effect only if `search-invisible' is set to `open'." ;;;###autoload (defvar hs-special-modes-alist + ;; FIXME: Currently the check is made via + ;; (assoc major-mode hs-special-modes-alist) so it doesn't pay attention + ;; to the mode hierarchy. (mapcar #'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c-ts-mode "{" "}" "/[*/]" nil nil) -- cgit v1.2.3 From 357eb52e094ee751b2ee2f736f7a5e8cc1cdc99c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 8 Mar 2024 12:39:59 -0500 Subject: (eglot-server-programs): Comment and whitespace only change * lisp/progmodes/eglot.el (eglot-server-programs): Add comment. Make the definition fit into 80 columns. --- lisp/progmodes/eglot.el | 187 +++++++++++++++++++++++++----------------------- 1 file changed, 99 insertions(+), 88 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index f341428cac3..afe3281361d 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -226,94 +226,105 @@ automatically)." when probe return (cons probe args) finally (funcall err))))))) -(defvar eglot-server-programs `(((rust-ts-mode rust-mode) . ("rust-analyzer")) - ((cmake-mode cmake-ts-mode) . ("cmake-language-server")) - (vimrc-mode . ("vim-language-server" "--stdio")) - ((python-mode python-ts-mode) - . ,(eglot-alternatives - '("pylsp" "pyls" ("pyright-langserver" "--stdio") "jedi-language-server" "ruff-lsp"))) - ((js-json-mode json-mode json-ts-mode) - . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") - ("vscode-json-languageserver" "--stdio") - ("json-languageserver" "--stdio")))) - (((js-mode :language-id "javascript") - (js-ts-mode :language-id "javascript") - (tsx-ts-mode :language-id "typescriptreact") - (typescript-ts-mode :language-id "typescript") - (typescript-mode :language-id "typescript")) - . ("typescript-language-server" "--stdio")) - ((bash-ts-mode sh-mode) . ("bash-language-server" "start")) - ((php-mode phps-mode php-ts-mode) - . ,(eglot-alternatives - '(("phpactor" "language-server") - ("php" "vendor/felixfbecker/language-server/bin/php-language-server.php")))) - ((c-mode c-ts-mode c++-mode c++-ts-mode objc-mode) - . ,(eglot-alternatives - '("clangd" "ccls"))) - (((caml-mode :language-id "ocaml") - (tuareg-mode :language-id "ocaml") reason-mode) - . ("ocamllsp")) - ((ruby-mode ruby-ts-mode) - . ("solargraph" "socket" "--port" :autoport)) - (haskell-mode - . ("haskell-language-server-wrapper" "--lsp")) - (elm-mode . ("elm-language-server")) - (mint-mode . ("mint" "ls")) - ((kotlin-mode kotlin-ts-mode) . ("kotlin-language-server")) - ((go-mode go-dot-mod-mode go-dot-work-mode go-ts-mode go-mod-ts-mode) - . ("gopls")) - ((R-mode ess-r-mode) . ("R" "--slave" "-e" - "languageserver::run()")) - ((java-mode java-ts-mode) . ("jdtls")) - ((dart-mode dart-ts-mode) - . ("dart" "language-server" - "--client-id" "emacs.eglot-dart")) - ((elixir-mode elixir-ts-mode heex-ts-mode) - . ,(if (and (fboundp 'w32-shell-dos-semantics) - (w32-shell-dos-semantics)) - '("language_server.bat") - (eglot-alternatives - '("language_server.sh" "start_lexical.sh")))) - (ada-mode . ("ada_language_server")) - (scala-mode . ,(eglot-alternatives - '("metals" "metals-emacs"))) - (racket-mode . ("racket" "-l" "racket-langserver")) - ((tex-mode context-mode texinfo-mode bibtex-mode) - . ,(eglot-alternatives '("digestif" "texlab"))) - (erlang-mode . ("erlang_ls" "--transport" "stdio")) - ((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio")) - (nix-mode . ,(eglot-alternatives '("nil" "rnix-lsp" "nixd"))) - (nickel-mode . ("nls")) - ((nushell-mode nushell-ts-mode) . ("nu" "--lsp")) - (gdscript-mode . ("localhost" 6008)) - ((fortran-mode f90-mode) . ("fortls")) - (futhark-mode . ("futhark" "lsp")) - ((lua-mode lua-ts-mode) . ,(eglot-alternatives - '("lua-language-server" "lua-lsp"))) - (zig-mode . ("zls")) - ((css-mode css-ts-mode) - . ,(eglot-alternatives '(("vscode-css-language-server" "--stdio") - ("css-languageserver" "--stdio")))) - (html-mode . ,(eglot-alternatives '(("vscode-html-language-server" "--stdio") ("html-languageserver" "--stdio")))) - ((dockerfile-mode dockerfile-ts-mode) . ("docker-langserver" "--stdio")) - ((clojure-mode clojurescript-mode clojurec-mode clojure-ts-mode) - . ("clojure-lsp")) - ((csharp-mode csharp-ts-mode) - . ,(eglot-alternatives - '(("omnisharp" "-lsp") - ("csharp-ls")))) - (purescript-mode . ("purescript-language-server" "--stdio")) - ((perl-mode cperl-mode) . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run")) - (markdown-mode - . ,(eglot-alternatives - '(("marksman" "server") - ("vscode-markdown-language-server" "--stdio")))) - (graphviz-dot-mode . ("dot-language-server" "--stdio")) - (terraform-mode . ("terraform-ls" "serve")) - ((uiua-ts-mode uiua-mode) . ("uiua" "lsp")) - (sml-mode - . ,(lambda (_interactive project) - (list "millet-ls" (project-root project))))) +(defvar eglot-server-programs + ;; FIXME: Maybe this info should be distributed into the major modes + ;; themselves where they could set a buffer-local `eglot-server-program' + ;; instead of keeping this database centralized. + ;; FIXME: With `derived-mode-add-parents' in Emacs≥30, some of + ;; those entries can be simplified, but we keep them for when + ;; `eglot.el' is installed via GNU ELPA in an older Emacs. + `(((rust-ts-mode rust-mode) . ("rust-analyzer")) + ((cmake-mode cmake-ts-mode) . ("cmake-language-server")) + (vimrc-mode . ("vim-language-server" "--stdio")) + ((python-mode python-ts-mode) + . ,(eglot-alternatives + '("pylsp" "pyls" ("pyright-langserver" "--stdio") + "jedi-language-server" "ruff-lsp"))) + ((js-json-mode json-mode json-ts-mode) + . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") + ("vscode-json-languageserver" "--stdio") + ("json-languageserver" "--stdio")))) + (((js-mode :language-id "javascript") + (js-ts-mode :language-id "javascript") + (tsx-ts-mode :language-id "typescriptreact") + (typescript-ts-mode :language-id "typescript") + (typescript-mode :language-id "typescript")) + . ("typescript-language-server" "--stdio")) + ((bash-ts-mode sh-mode) . ("bash-language-server" "start")) + ((php-mode phps-mode php-ts-mode) + . ,(eglot-alternatives + '(("phpactor" "language-server") + ("php" "vendor/felixfbecker/language-server/bin/php-language-server.php")))) + ((c-mode c-ts-mode c++-mode c++-ts-mode objc-mode) + . ,(eglot-alternatives + '("clangd" "ccls"))) + (((caml-mode :language-id "ocaml") + (tuareg-mode :language-id "ocaml") reason-mode) + . ("ocamllsp")) + ((ruby-mode ruby-ts-mode) + . ("solargraph" "socket" "--port" :autoport)) + (haskell-mode + . ("haskell-language-server-wrapper" "--lsp")) + (elm-mode . ("elm-language-server")) + (mint-mode . ("mint" "ls")) + ((kotlin-mode kotlin-ts-mode) . ("kotlin-language-server")) + ((go-mode go-dot-mod-mode go-dot-work-mode go-ts-mode go-mod-ts-mode) + . ("gopls")) + ((R-mode ess-r-mode) . ("R" "--slave" "-e" + "languageserver::run()")) + ((java-mode java-ts-mode) . ("jdtls")) + ((dart-mode dart-ts-mode) + . ("dart" "language-server" + "--client-id" "emacs.eglot-dart")) + ((elixir-mode elixir-ts-mode heex-ts-mode) + . ,(if (and (fboundp 'w32-shell-dos-semantics) + (w32-shell-dos-semantics)) + '("language_server.bat") + (eglot-alternatives + '("language_server.sh" "start_lexical.sh")))) + (ada-mode . ("ada_language_server")) + (scala-mode . ,(eglot-alternatives + '("metals" "metals-emacs"))) + (racket-mode . ("racket" "-l" "racket-langserver")) + ((tex-mode context-mode texinfo-mode bibtex-mode) + . ,(eglot-alternatives '("digestif" "texlab"))) + (erlang-mode . ("erlang_ls" "--transport" "stdio")) + ((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio")) + (nix-mode . ,(eglot-alternatives '("nil" "rnix-lsp" "nixd"))) + (nickel-mode . ("nls")) + ((nushell-mode nushell-ts-mode) . ("nu" "--lsp")) + (gdscript-mode . ("localhost" 6008)) + ((fortran-mode f90-mode) . ("fortls")) + (futhark-mode . ("futhark" "lsp")) + ((lua-mode lua-ts-mode) . ,(eglot-alternatives + '("lua-language-server" "lua-lsp"))) + (zig-mode . ("zls")) + ((css-mode css-ts-mode) + . ,(eglot-alternatives '(("vscode-css-language-server" "--stdio") + ("css-languageserver" "--stdio")))) + (html-mode . ,(eglot-alternatives + '(("vscode-html-language-server" "--stdio") + ("html-languageserver" "--stdio")))) + ((dockerfile-mode dockerfile-ts-mode) . ("docker-langserver" "--stdio")) + ((clojure-mode clojurescript-mode clojurec-mode clojure-ts-mode) + . ("clojure-lsp")) + ((csharp-mode csharp-ts-mode) + . ,(eglot-alternatives + '(("omnisharp" "-lsp") + ("csharp-ls")))) + (purescript-mode . ("purescript-language-server" "--stdio")) + ((perl-mode cperl-mode) + . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run")) + (markdown-mode + . ,(eglot-alternatives + '(("marksman" "server") + ("vscode-markdown-language-server" "--stdio")))) + (graphviz-dot-mode . ("dot-language-server" "--stdio")) + (terraform-mode . ("terraform-ls" "serve")) + ((uiua-ts-mode uiua-mode) . ("uiua" "lsp")) + (sml-mode + . ,(lambda (_interactive project) + (list "millet-ls" (project-root project))))) "How the command `eglot' guesses the server to start. An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE identifies the buffers that are to be managed by a specific -- cgit v1.2.3 From 18b6289adfd15029fbaf4a259c44f8df10b9d702 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 10 Mar 2024 10:37:14 +0800 Subject: ; * java/org/gnu/emacs/EmacsPreferencesActivity.java: Fix commentary. --- java/org/gnu/emacs/EmacsPreferencesActivity.java | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/java/org/gnu/emacs/EmacsPreferencesActivity.java b/java/org/gnu/emacs/EmacsPreferencesActivity.java index 330adbea223..766e2e11d46 100644 --- a/java/org/gnu/emacs/EmacsPreferencesActivity.java +++ b/java/org/gnu/emacs/EmacsPreferencesActivity.java @@ -38,8 +38,9 @@ import android.preference.*; option, which would not be possible otherwise, as there is no command line on Android. - Android provides a preferences activity, but it is deprecated. - Unfortunately, there is no alternative that looks the same way. */ + This file extends a deprecated preferences activity, but no suitable + alternative exists that is identical in appearance to system settings + forms. */ @SuppressWarnings ("deprecation") public class EmacsPreferencesActivity extends PreferenceActivity -- cgit v1.2.3 From 7b4ca9e609e2eadc824313053e70d7272d360b9d Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 7 Mar 2024 21:53:11 -0800 Subject: Leverage inverse-video for erc-inverse-face MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/erc/erc-goodies.el (erc-inverse-face): Specify face attribute `:inverse-video' (née :reverse-video) to swap foreground and background colors over affected intervals, as per https://modern.ircdocs.horse/formatting#reverse-color. (erc-control-default-fg erc-control-default-bg): New faces for IRC color-code number 99. Ignore the ERC convention of prefixing control-code-derived faces with "fg:" and "bg:" because it doesn't comport with modern sensibilities, which demand identifiers normally be namespaced. (erc-get-bg-color-face, erc-get-fg-color-face): Return new, dedicated faces instead of `default', and don't nest them in a list. * test/lisp/erc/erc-goodies-tests.el (erc-controls-highlight--inverse): Redo completely, asserting behavior described in the spec linked to above. (erc-controls-highlight--spoilers): New test based on the body of the old `erc-controls-highlight--inverse', except without shadowing `erc-insert-modify-hook' with an unrealistic, idealized value. Adjust expected buffer state to reflect the new role of `erc-spoiler-face'. (Bug#69597) --- lisp/erc/erc-goodies.el | 16 +++- test/lisp/erc/erc-goodies-tests.el | 153 ++++++++++++++++++++++++++----------- 2 files changed, 122 insertions(+), 47 deletions(-) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 7e30b1060fd..f19fb5ed727 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -661,7 +661,7 @@ The value `erc-interpret-controls-p' must also be t for this to work." :group 'erc-faces) (defface erc-inverse-face - '((t :foreground "White" :background "Black")) + '((t :inverse-video t)) "ERC inverse face." :group 'erc-faces) @@ -675,6 +675,16 @@ The value `erc-interpret-controls-p' must also be t for this to work." "ERC underline face." :group 'erc-faces) +(defface erc-control-default-fg '((t :inherit default)) + "ERC foreground face for the \"default\" color code." + :group 'erc-faces) + +(defface erc-control-default-bg '((t :inherit default)) + "ERC background face for the \"default\" color code." + :group 'erc-faces) + +;; FIXME rename these to something like `erc-control-color-N-fg', +;; and deprecate the old names via `define-obsolete-face-alias'. (defface fg:erc-color-face0 '((t :foreground "White")) "ERC face." :group 'erc-faces) @@ -804,7 +814,7 @@ The value `erc-interpret-controls-p' must also be t for this to work." (intern (concat "bg:erc-color-face" (number-to-string n)))) ((< 15 n 99) (list :background (aref erc--controls-additional-colors (- n 16)))) - (t (erc-log (format " Wrong color: %s" n)) '(default))))) + (t (erc-log (format " Wrong color: %s" n)) 'erc-control-default-fg)))) (defun erc-get-fg-color-face (n) "Fetches the right face for foreground color N (0-15)." @@ -820,7 +830,7 @@ The value `erc-interpret-controls-p' must also be t for this to work." (intern (concat "fg:erc-color-face" (number-to-string n)))) ((< 15 n 99) (list :foreground (aref erc--controls-additional-colors (- n 16)))) - (t (erc-log (format " Wrong color: %s" n)) '(default))))) + (t (erc-log (format " Wrong color: %s" n)) 'erc-control-default-bg)))) ;;;###autoload(autoload 'erc-irccontrols-mode "erc-goodies" nil t) (define-erc-module irccontrols nil diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index 7013ce0c8fc..c8fb0544a72 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -29,19 +29,23 @@ (defun erc-goodies-tests--assert-face (beg end-str present &optional absent) (setq beg (+ beg (point-min))) (let ((end (+ beg (1- (length end-str))))) - (while (and beg (< beg end)) - (let* ((val (get-text-property beg 'font-lock-face)) - (ft (flatten-tree (ensure-list val)))) - (dolist (p (ensure-list present)) - (if (consp p) - (should (member p val)) - (should (memq p ft)))) - (dolist (a (ensure-list absent)) - (if (consp a) - (should-not (member a val)) - (should-not (memq a ft)))) - (setq beg (text-property-not-all beg (point-max) - 'font-lock-face val)))))) + (ert-info ((format "beg: %S, end-str: %S" beg end-str)) + (while (and beg (< beg end)) + (let* ((val (get-text-property beg 'font-lock-face)) + (ft (flatten-tree (ensure-list val)))) + (ert-info ((format "looking-at: %S, val: %S" + (buffer-substring-no-properties beg end) + val)) + (dolist (p (ensure-list present)) + (if (consp p) + (should (member p val)) + (should (memq p ft)))) + (dolist (a (ensure-list absent)) + (if (consp a) + (should-not (member a val)) + (should-not (memq a ft))))) + (setq beg (text-property-not-all beg (point-max) + 'font-lock-face val))))))) ;; These are from the "Examples" section of ;; https://modern.ircdocs.horse/formatting.html @@ -129,39 +133,100 @@ ;; Hovering over the redacted area should reveal its underlying text ;; in a high-contrast face. -(ert-deftest erc-controls-highlight--inverse () +(ert-deftest erc-controls-highlight--spoilers () (should (eq t erc-interpret-controls-p)) - (let ((erc-insert-modify-hook '(erc-controls-highlight)) - erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) - (with-current-buffer (get-buffer-create "#chan") - (erc-mode) - (setq-local erc-interpret-mirc-color t) - (erc--initialize-markers (point) nil) + (erc-tests-common-make-server-buf) + (with-current-buffer (erc--open-target "#chan") + (setq-local erc-interpret-mirc-color t) + (let* ((raw (concat "BEGIN " + "\C-c0,0 WhiteOnWhite " + "\C-c1,1 BlackOnBlack " + "\C-c99,99 Default " + "\C-o END")) + (msg (erc-format-privmessage "bob" raw nil t))) + (erc-display-message nil nil (current-buffer) msg)) + (forward-line -1) + (should (search-forward " " nil t)) + (save-restriction + ;; Narrow to EOL or start of right-side stamp. + (narrow-to-region (point) (line-end-position)) + (save-excursion + (search-forward "WhiteOn") + (should (eq (get-text-property (point) 'mouse-face) + 'erc-spoiler-face)) + (search-forward "BlackOn") + (should (eq (get-text-property (point) 'mouse-face) + 'erc-spoiler-face))) + ;; Start wtih ERC default face. + (erc-goodies-tests--assert-face + 0 "BEGIN " 'erc-default-face + '(fg:erc-color-face0 bg:erc-color-face0)) + ;; Masked in all white. + (erc-goodies-tests--assert-face + 6 "WhiteOnWhite" '(fg:erc-color-face0 bg:erc-color-face0) + '(fg:erc-color-face1 bg:erc-color-face1)) + ;; Masked in all black. + (erc-goodies-tests--assert-face + 20 "BlackOnBlack" '(fg:erc-color-face1 bg:erc-color-face1) + '(erc-control-default-fg erc-control-default-bg)) + ;; Explicit "default" code ignoerd. + (erc-goodies-tests--assert-face + 34 "Default" '(erc-control-default-fg erc-control-default-bg) + '(fg:erc-color-face1 bg:erc-color-face1)) + (erc-goodies-tests--assert-face + 43 "END" 'erc-default-face + '(erc-control-default-bg erc-control-default-fg)))) + (when noninteractive + (erc-tests-common-kill-buffers))) - (let* ((m "Spoiler: \C-c0,0Hello\C-c1,1World!") - (msg (erc-format-privmessage "bob" m nil t))) - (erc-display-message nil nil (current-buffer) msg)) - (forward-line -1) - (should (search-forward " " nil t)) - (save-restriction - (narrow-to-region (point) (pos-eol)) - (should (eq (get-text-property (+ 9 (point)) 'mouse-face) - 'erc-inverse-face)) - (should (eq (get-text-property (1- (pos-eol)) 'mouse-face) - 'erc-inverse-face)) - (erc-goodies-tests--assert-face - 0 "Spoiler: " 'erc-default-face - '(fg:erc-color-face0 bg:erc-color-face0)) - (erc-goodies-tests--assert-face - 9 "Hello" '(erc-spoiler-face) - '( fg:erc-color-face0 bg:erc-color-face0 - fg:erc-color-face1 bg:erc-color-face1)) - (erc-goodies-tests--assert-face - 18 " World" '(erc-spoiler-face) - '( fg:erc-color-face0 bg:erc-color-face0 - fg:erc-color-face1 bg:erc-color-face1 ))) - (when noninteractive - (kill-buffer))))) +(ert-deftest erc-controls-highlight--inverse () + (should (eq t erc-interpret-controls-p)) + (erc-tests-common-make-server-buf) + (with-current-buffer (erc--open-target "#chan") + (setq-local erc-interpret-mirc-color t) + (defvar erc-fill-column) + (let* ((erc-fill-column 90) + (raw (concat "BEGIN " + "\C-c3,13 GreenOnPink " + "\C-v PinkOnGreen " + "\C-c99,99 ReversedDefault " + "\C-v NormalDefault " + "\C-o END")) + (msg (erc-format-privmessage "bob" raw nil t))) + (erc-display-message nil nil (current-buffer) msg)) + (forward-line -1) + (should (search-forward " " nil t)) + (save-restriction + ;; Narrow to EOL or start of right-side stamp. + (narrow-to-region (point) (line-end-position)) + ;; Baseline. + (erc-goodies-tests--assert-face + 0 "BEGIN " 'erc-default-face + '(fg:erc-color-face0 bg:erc-color-face0)) + ;; Normal fg/bg combo. + (erc-goodies-tests--assert-face + 6 "GreenOnPink" '(fg:erc-color-face3 bg:erc-color-face13) + '(erc-inverse-face)) + ;; Reverse of previous, so former-bg on former-fg. + (erc-goodies-tests--assert-face + 19 "PinkOnGreen" + '(erc-inverse-face fg:erc-color-face3 bg:erc-color-face13) + nil) + ;; The inverse of `default' because reverse still in effect. + (erc-goodies-tests--assert-face + 32 "ReversedDefault" '(erc-inverse-face erc-control-default-fg + erc-control-default-bg) + '(fg:erc-color-face3 bg:erc-color-face13)) + (erc-goodies-tests--assert-face + 49 "NormalDefault" '(erc-control-default-fg + erc-control-default-bg) + '(erc-inverse-face fg:erc-color-face1 bg:erc-color-face1)) + (erc-goodies-tests--assert-face + 64 "END" 'erc-default-face + '( erc-control-default-fg erc-control-default-bg + fg:erc-color-face0 bg:erc-color-face0)))) + (when noninteractive + (erc-tests-common-kill-buffers))) (defvar erc-goodies-tests--motd ;; This is from ergo's MOTD -- cgit v1.2.3 From e2620fd73441af19d478f7a9262de8c08a47ee2f Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 7 Mar 2024 21:53:23 -0800 Subject: Make important text props more resilient in ERC * lisp/erc/erc-button.el (erc-button-remove-old-buttons): Restore original `mouse-face' values in areas marked as important after clobbering. * lisp/erc/erc.el (erc--reserve-important-text-props): New function. (erc--restore-important-text-props): New function. * test/lisp/erc/erc-tests.el (erc--restore-important-text-props): New test. (Bug#69597) --- lisp/erc/erc-button.el | 3 ++- lisp/erc/erc.el | 34 ++++++++++++++++++++++++++++++ test/lisp/erc/erc-tests.el | 52 ++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 88 insertions(+), 1 deletion(-) diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 6b78e451b54..4b4930e5bff 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -528,7 +528,8 @@ that `erc-button-add-button' adds, except for the face." '(erc-callback nil erc-data nil mouse-face nil - keymap nil))) + keymap nil)) + (erc--restore-important-text-props '(mouse-face))) (defun erc-button-add-button (from to fun nick-p &optional data regexp) "Create a button between FROM and TO with callback FUN and data DATA. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index cce3b2508fb..3cc9bd54228 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3532,6 +3532,40 @@ repeatedly with VAL set to each of VAL's members." old (get-text-property pos prop object) end (next-single-property-change pos prop object to))))) +(defun erc--reserve-important-text-props (beg end plist &optional object) + "Record text-property pairs in PLIST as important between BEG and END. +Also mark the message being inserted as containing these important props +so modules performing destructive modifications can later restore them. +Expect to run in a narrowed buffer at message-insertion time." + (when erc--msg-props + (let ((existing (erc--check-msg-prop 'erc--important-prop-names))) + (puthash 'erc--important-prop-names (cl-union existing (map-keys plist)) + erc--msg-props))) + (erc--merge-prop beg end 'erc--important-props plist object)) + +(defun erc--restore-important-text-props (props &optional beg end) + "Restore PROPS where recorded in the accessible portion of the buffer. +Expect to run in a narrowed buffer at message-insertion time. Limit the +effect to the region between buffer positions BEG and END, when non-nil. + +Callers should be aware that this function fails if the property +`erc--important-props' has an empty value almost anywhere along the +affected region. Use the function `erc--remove-from-prop-value-list' to +ensure that props with empty values are excised completely." + (when-let ((registered (erc--check-msg-prop 'erc--important-prop-names)) + (present (seq-intersection props registered)) + (b (or beg (point-min))) + (e (or end (point-max)))) + (while-let + (((setq b (text-property-not-all b e 'erc--important-props nil))) + (val (get-text-property b 'erc--important-props)) + (q (next-single-property-change b 'erc--important-props nil e))) + (while-let ((k (pop val)) + (v (pop val))) + (when (memq k present) + (put-text-property b q k v))) + (setq b q)))) + (defvar erc-legacy-invisible-bounds-p nil "Whether to hide trailing rather than preceding newlines. Beginning in ERC 5.6, invisibility extends from a message's diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 085b063bdb2..6809d9db41d 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -2232,6 +2232,58 @@ (when noninteractive (kill-buffer)))) +(ert-deftest erc--restore-important-text-props () + (erc-mode) + (let ((erc--msg-props (map-into '((erc--important-prop-names a)) + 'hash-table))) + (insert (propertize "foo" 'a 'A 'b 'B 'erc--important-props '(a A)) + " " + (propertize "bar" 'c 'C 'a 'A 'b 'B + 'erc--important-props '(a A c C))) + + ;; Attempt to restore a and c when only a is registered. + (remove-list-of-text-properties (point-min) (point-max) '(a c)) + (erc--restore-important-text-props '(a c)) + (should (erc-tests-common-equal-with-props + (buffer-string) + #("foo bar" + 0 3 (a A b B erc--important-props (a A)) + 4 7 (a A b B erc--important-props (a A c C))))) + + ;; Add d between 3 and 6. + (erc--reserve-important-text-props 3 6 '(d D)) + (put-text-property 3 6 'd 'D) + (should (erc-tests-common-equal-with-props + (buffer-string) + #("foo bar" ; #1 + 0 2 (a A b B erc--important-props (a A)) + 2 3 (d D a A b B erc--important-props (d D a A)) + 3 4 (d D erc--important-props (d D)) + 4 5 (d D a A b B erc--important-props (d D a A c C)) + 5 7 (a A b B erc--important-props (a A c C))))) + ;; Remove a and d, and attempt to restore d. + (remove-list-of-text-properties (point-min) (point-max) '(a d)) + (erc--restore-important-text-props '(d)) + (should (erc-tests-common-equal-with-props + (buffer-string) + #("foo bar" + 0 2 (b B erc--important-props (a A)) + 2 3 (d D b B erc--important-props (d D a A)) + 3 4 (d D erc--important-props (d D)) + 4 5 (d D b B erc--important-props (d D a A c C)) + 5 7 (b B erc--important-props (a A c C))))) + + ;; Restore a only. + (erc--restore-important-text-props '(a)) + (should (erc-tests-common-equal-with-props + (buffer-string) + #("foo bar" ; same as #1 above + 0 2 (a A b B erc--important-props (a A)) + 2 3 (d D a A b B erc--important-props (d D a A)) + 3 4 (d D erc--important-props (d D)) + 4 5 (d D a A b B erc--important-props (d D a A c C)) + 5 7 (a A b B erc--important-props (a A c C))))))) + (ert-deftest erc--split-string-shell-cmd () ;; Leading and trailing space -- cgit v1.2.3 From 166c8a989491c21ea3baf96e4730a4ad9b78308f Mon Sep 17 00:00:00 2001 From: "F. Moukayed" Date: Fri, 8 Mar 2024 08:39:03 +0000 Subject: Redefine erc-spoiler-face to indicate revealed text * lisp/erc/erc-goodies.el (erc-spoiler-face): Redefine role and redo definition to inherit from `erc-control-default-face'. (erc-controls-propertize): Include `cursor-face' in the applied hover properties for spoiler text, and ensure they aren't clobbered by other built-in modules, like `button'. (Bug#69597) Copyright-paperwork-exempt: yes --- lisp/erc/erc-goodies.el | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index f19fb5ed727..da14f5bd728 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -665,9 +665,7 @@ The value `erc-interpret-controls-p' must also be t for this to work." "ERC inverse face." :group 'erc-faces) -(defface erc-spoiler-face - '((((background light)) :foreground "DimGray" :background "DimGray") - (((background dark)) :foreground "LightGray" :background "LightGray")) +(defface erc-spoiler-face '((t :inherit default)) "ERC spoiler face." :group 'erc-faces) @@ -978,13 +976,16 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'." "Prepend properties from IRC control characters between FROM and TO. If optional argument STR is provided, apply to STR, otherwise prepend properties to a region in the current buffer." - (if (and fg bg (equal fg bg)) - (progn - (setq fg 'erc-spoiler-face - bg nil) - (put-text-property from to 'mouse-face 'erc-inverse-face str)) - (when fg (setq fg (erc-get-fg-color-face fg))) - (when bg (setq bg (erc-get-bg-color-face bg)))) + (when (and fg bg (equal fg bg) (not (equal fg "99"))) + (add-text-properties from to '( mouse-face erc-spoiler-face + cursor-face erc-spoiler-face) + str) + (erc--reserve-important-text-props from to + '( mouse-face erc-spoiler-face + cursor-face erc-spoiler-face) + str)) + (when fg (setq fg (erc-get-fg-color-face fg))) + (when bg (setq bg (erc-get-bg-color-face bg))) (font-lock-prepend-text-property from to -- cgit v1.2.3 From f3da3d1c68bef60ef28d67c6d8fa5d0cba8c9f08 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 10 Mar 2024 06:08:30 -0700 Subject: Fix faulty decoded-time adjustment in erc-stamp * lisp/erc/erc-stamp.el (erc-stamp--lr-date-on-pre-modify): Remove disruptive assertion for now. (erc-stamp--time-as-day): Attempt to fix date being rewound by a whole day when daylight saving time is in effect. Do this by forcing the `dst' slot of the `decoded-time' object to -1 and the `zone' to nil. --- lisp/erc/erc-stamp.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index a8190a2c94a..44f92c5a7e2 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -723,9 +723,6 @@ inserted is a date stamp." 'hash-table)) (erc-timestamp-last-inserted-left rendered) erc-timestamp-format erc-away-timestamp-format) - ;; FIXME delete once convinced adjustment correct. - (cl-assert (string= rendered - (erc-stamp--format-date-stamp aligned))) (erc-add-timestamp)) (setq erc-timestamp-last-inserted-left rendered))))) @@ -833,7 +830,11 @@ left-sided stamps and date stamps inserted by this function." (decoded (decode-time current-time erc-stamp--tz))) (setf (decoded-time-second decoded) 0 (decoded-time-minute decoded) 0 - (decoded-time-hour decoded) 0) + (decoded-time-hour decoded) 0 + (decoded-time-dst decoded) -1 + (decoded-time-weekday decoded) nil + (decoded-time-zone decoded) + (and erc-stamp--tz (car (current-time-zone nil erc-stamp--tz)))) (encode-time decoded))) ; may return an integer (defun erc-format-timestamp (time format) -- cgit v1.2.3 From fbc5fb2561d9e1d4e5b69b349a26c49d30ffc938 Mon Sep 17 00:00:00 2001 From: Tim Ruffing Date: Wed, 27 Dec 2023 14:26:26 +0100 Subject: Extract check for end of macro to function * src/macros.h (at_end_of_macro_p): * src/macros.c (at_end_of_macro_p): New function. * src/keyboard.c (read_char): Use the new function. --- src/keyboard.c | 3 +-- src/macros.c | 12 ++++++++++++ src/macros.h | 5 +++++ 3 files changed, 18 insertions(+), 2 deletions(-) diff --git a/src/keyboard.c b/src/keyboard.c index eb0de98bad1..b6fc568cde5 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -2637,8 +2637,7 @@ read_char (int commandflag, Lisp_Object map, /* Exit the macro if we are at the end. Also, some things replace the macro with t to force an early exit. */ - if (EQ (Vexecuting_kbd_macro, Qt) - || executing_kbd_macro_index >= XFIXNAT (Flength (Vexecuting_kbd_macro))) + if (at_end_of_macro_p ()) { XSETINT (c, -1); goto exit; diff --git a/src/macros.c b/src/macros.c index 5f71bcbd361..faec9dc646d 100644 --- a/src/macros.c +++ b/src/macros.c @@ -353,6 +353,18 @@ init_macros (void) executing_kbd_macro = Qnil; } +/* Whether the execution of a macro has reached its end. + This should be called only while executing a macro. */ + +bool +at_end_of_macro_p (void) +{ + eassume (!NILP (Vexecuting_kbd_macro)); + /* Some things replace the macro with t to force an early exit. */ + return EQ (Vexecuting_kbd_macro, Qt) + || executing_kbd_macro_index >= XFIXNAT (Flength (Vexecuting_kbd_macro)); +} + void syms_of_macros (void) { diff --git a/src/macros.h b/src/macros.h index 51599a29bcd..cb6ac8aa206 100644 --- a/src/macros.h +++ b/src/macros.h @@ -47,4 +47,9 @@ extern void finalize_kbd_macro_chars (void); extern void store_kbd_macro_char (Lisp_Object); +/* Whether the execution of a macro has reached its end. + This should be called only while executing a macro. */ + +extern bool at_end_of_macro_p (void); + #endif /* EMACS_MACROS_H */ -- cgit v1.2.3 From 385a02cffde6d0fd80ff189704ad70cfebc3e8d4 Mon Sep 17 00:00:00 2001 From: Tim Ruffing Date: Wed, 27 Dec 2023 14:29:34 +0100 Subject: * src/keyboard.c (requeued_events_pending_p): Improve name and fix comment * src/keyboard.c, src/keyboard.h (requeued_events_pending_p): Rename to 'requeued_command_events_pending_p' to clarify that the function covers only command events. Fix wrong comment that claimed that the function was unused. * src/process.c (wait_reading_process_output): Update caller to use the new name. --- src/keyboard.c | 8 ++------ src/keyboard.h | 2 +- src/process.c | 8 ++++---- 3 files changed, 7 insertions(+), 11 deletions(-) diff --git a/src/keyboard.c b/src/keyboard.c index b6fc568cde5..e5efde4ef53 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -11565,14 +11565,10 @@ clear_input_pending (void) input_pending = false; } -/* Return true if there are pending requeued events. - This isn't used yet. The hope is to make wait_reading_process_output - call it, and return if it runs Lisp code that unreads something. - The problem is, kbd_buffer_get_event needs to be fixed to know what - to do in that case. It isn't trivial. */ +/* Return true if there are pending requeued command events. */ bool -requeued_events_pending_p (void) +requeued_command_events_pending_p (void) { return (CONSP (Vunread_command_events)); } diff --git a/src/keyboard.h b/src/keyboard.h index 68e68bc2ae3..600aaf11517 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -483,7 +483,7 @@ extern void set_poll_suppress_count (int); extern int gobble_input (void); extern bool input_polling_used (void); extern void clear_input_pending (void); -extern bool requeued_events_pending_p (void); +extern bool requeued_command_events_pending_p (void); extern void bind_polling_period (int); extern int make_ctrl_char (int) ATTRIBUTE_CONST; extern void stuff_buffered_input (Lisp_Object); diff --git a/src/process.c b/src/process.c index 48a2c0c8e53..6b8b483cdf7 100644 --- a/src/process.c +++ b/src/process.c @@ -5439,7 +5439,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, /* If there is unread keyboard input, also return. */ if (read_kbd != 0 - && requeued_events_pending_p ()) + && requeued_command_events_pending_p ()) break; /* This is so a breakpoint can be put here. */ @@ -5849,7 +5849,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, /* If there is unread keyboard input, also return. */ if (read_kbd != 0 - && requeued_events_pending_p ()) + && requeued_command_events_pending_p ()) break; /* If we are not checking for keyboard input now, @@ -8036,7 +8036,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, /* If there is unread keyboard input, also return. */ if (read_kbd != 0 - && requeued_events_pending_p ()) + && requeued_command_events_pending_p ()) break; if (timespec_valid_p (timer_delay)) @@ -8109,7 +8109,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, /* If there is unread keyboard input, also return. */ if (read_kbd - && requeued_events_pending_p ()) + && requeued_command_events_pending_p ()) break; /* If wait_for_cell. check for keyboard input -- cgit v1.2.3 From d6f326452ecc761498d627a365c8014a467812eb Mon Sep 17 00:00:00 2001 From: Tim Ruffing Date: Wed, 27 Dec 2023 14:29:34 +0100 Subject: * src/keyboard.c (requeued_events_pending_p): New function * src/keyboard.c, src/keyboard.h (requeued_events_pending_p): Add function 'requeued_events_pending_p' (whose name was made available in the previous commit). As opposed to the previous function with the same name, the new function covers both command and other events. * src/keyboard.c (Finput_pending_p): Use the new function. --- src/keyboard.c | 16 +++++++++++++--- src/keyboard.h | 1 + 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/src/keyboard.c b/src/keyboard.c index e5efde4ef53..bd8d3aa7ecf 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -11573,6 +11573,18 @@ requeued_command_events_pending_p (void) return (CONSP (Vunread_command_events)); } +/* Return true if there are any pending requeued events (command events + or events to be processed by other levels of the input processing + stages). */ + +bool +requeued_events_pending_p (void) +{ + return (requeued_command_events_pending_p () + || !NILP (Vunread_post_input_method_events) + || !NILP (Vunread_input_method_events)); +} + DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 1, 0, doc: /* Return t if command input is currently available with no wait. Actually, the value is nil only if we can be sure that no input is available; @@ -11581,9 +11593,7 @@ if there is a doubt, the value is t. If CHECK-TIMERS is non-nil, timers that are ready to run will do so. */) (Lisp_Object check_timers) { - if (CONSP (Vunread_command_events) - || !NILP (Vunread_post_input_method_events) - || !NILP (Vunread_input_method_events)) + if (requeued_events_pending_p ()) return (Qt); /* Process non-user-visible events (Bug#10195). */ diff --git a/src/keyboard.h b/src/keyboard.h index 600aaf11517..2ce003fd444 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -484,6 +484,7 @@ extern int gobble_input (void); extern bool input_polling_used (void); extern void clear_input_pending (void); extern bool requeued_command_events_pending_p (void); +extern bool requeued_events_pending_p (void); extern void bind_polling_period (int); extern int make_ctrl_char (int) ATTRIBUTE_CONST; extern void stuff_buffered_input (Lisp_Object); -- cgit v1.2.3 From 6f46dd516b84ad7d59b49c2e9e3fc1a2d4ef4d1c Mon Sep 17 00:00:00 2001 From: Tim Ruffing Date: Wed, 27 Dec 2023 14:32:09 +0100 Subject: Continue reading in 'read-event' etc. at the end of a keyboard macro This fixes a bug that could make 'read-event', 'read-char', and 'read-char-exclusive' erroneously return -1, an internal magic return value of 'read_char' leaked from C to lisp. Instead of returning -1, the aforementioned lisp functions now transparently continue reading available input (e.g., from the keyboard) when reaching the end of a keyboard macro. * src/keyboard.c (read_char, read_key_sequence): Move handling of the end of a keyboard macro from 'read_char' to its caller 'read_key_sequence', which is the only caller that can meaningfully deal with this case. * src/macros.c (Fexecute_kbd_macro): Document how the end of keyboard macro is processed. * etc/NEWS: Announce this change. --- etc/NEWS | 12 ++++++++++++ src/keyboard.c | 39 +++++++++++++++------------------------ src/macros.c | 42 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 69 insertions(+), 24 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 2e51c0490fe..19cd170e5c7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2141,6 +2141,18 @@ Like the variable with the same name, it adds menus from the list that is the value of the property to context menus shown when clicking on the text which as this property. +--- +** Detecting the end of an iteration of a keyboard macro +'read-event', 'read-char', and 'read-char-exclusive' no longer return -1 +when called at the end of an iteration of a the execution of a keyboard +macro. Instead, they will transparently continue reading available input +(e.g., from the keyboard). If you need to detect the end of a macro +iteration, check the following condition before calling one of the +aforementioned functions: + + (and (arrayp executing-kbd-macro) + (>= executing-kbd-macro-index (length executing-kbd-macro)))) + * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/src/keyboard.c b/src/keyboard.c index bd8d3aa7ecf..cadb376430e 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -2620,7 +2620,8 @@ read_char (int commandflag, Lisp_Object map, goto reread_for_input_method; } - if (!NILP (Vexecuting_kbd_macro)) + /* If we're executing a macro, process it unless we are at its end. */ + if (!NILP (Vexecuting_kbd_macro) && !at_end_of_macro_p ()) { /* We set this to Qmacro; since that's not a frame, nobody will try to switch frames on us, and the selected window will @@ -2634,15 +2635,6 @@ read_char (int commandflag, Lisp_Object map, selected. */ Vlast_event_frame = internal_last_event_frame = Qmacro; - /* Exit the macro if we are at the end. - Also, some things replace the macro with t - to force an early exit. */ - if (at_end_of_macro_p ()) - { - XSETINT (c, -1); - goto exit; - } - c = Faref (Vexecuting_kbd_macro, make_int (executing_kbd_macro_index)); if (STRINGP (Vexecuting_kbd_macro) && (XFIXNAT (c) & 0x80) && (XFIXNAT (c) <= 0xff)) @@ -10694,8 +10686,19 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, } used_mouse_menu = used_mouse_menu_history[t]; } - - /* If not, we should actually read a character. */ + /* If we're at the end of a macro, exit it by returning 0, + unless there are unread events pending. */ + else if (!NILP (Vexecuting_kbd_macro) + && at_end_of_macro_p () + && !requeued_events_pending_p ()) + { + t = 0; + /* The Microsoft C compiler can't handle the goto that + would go here. */ + dummyflag = true; + break; + } + /* Otherwise, we should actually read a character. */ else { { @@ -10787,18 +10790,6 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, return -1; } - /* read_char returns -1 at the end of a macro. - Emacs 18 handles this by returning immediately with a - zero, so that's what we'll do. */ - if (FIXNUMP (key) && XFIXNUM (key) == -1) - { - t = 0; - /* The Microsoft C compiler can't handle the goto that - would go here. */ - dummyflag = true; - break; - } - /* If the current buffer has been changed from under us, the keymap may have changed, so replay the sequence. */ if (BUFFERP (key)) diff --git a/src/macros.c b/src/macros.c index faec9dc646d..230195d9488 100644 --- a/src/macros.c +++ b/src/macros.c @@ -314,6 +314,48 @@ buffer before the macro is executed. */) Vreal_this_command)); record_unwind_protect (pop_kbd_macro, tem); + /* The following loop starts the execution of possibly multiple + iterations of the macro. + + The state variables that control the execution of a single + iteration are Vexecuting_kbd_macro and executing_kbd_macro_index, + which can be accessed from lisp. The purpose of the variables + executing_kbd_macro and executing_kbd_macro_iteration is to + remember the most recently started macro and its iteration count. + This makes it possible to produce a meaningful message in case of + errors during the execution of the macro. + + In a single iteration, individual characters from the macro are + read by read_char, which takes care of incrementing + executing_kbd_macro_index after each character. + + The end of a macro iteration is handled as follows: + - read_key_sequence asks at_end_of_macro_p whether the end of the + iteration has been reached. If so, it returns the magic value 0 + to command_loop_1. + - command_loop_1 returns Qnil to command_loop_2. + - command_loop_2 returns Qnil to this function + (but only the returning is relevant, not the actual value). + + Macro executions form a stack. After the last iteration of the + execution of one stack item, or in case of an error during one of + the iterations, pop_kbd_macro (invoked via unwind-protect) will + restore Vexecuting_kbd_macro and executing_kbd_macro_index, and + run 'kbd-macro-termination-hook'. + + If read_char happens to be called at the end of a macro interation, + but before read_key_sequence could handle the end (e.g., when lisp + code calls 'read-event', 'read-char', or 'read-char-exclusive'), + read_char will simply continue reading other available input + (Bug#68272). Vexecuting_kbd_macro and executing_kbd_macro remain + untouched until the end of the iteration is handled. + + This is similar (in observable behavior) to a posibly simpler + implementation of keyboard macros in which this function pushed all + characters of the macro into the incoming event queue and returned + immediately. Maybe this is the implementation that we ideally + would like to have, but switching to it will require a larger code + change. */ do { Vexecuting_kbd_macro = final; -- cgit v1.2.3 From d444390ec569afee35628e112a8d96d11f40175c Mon Sep 17 00:00:00 2001 From: Tim Ruffing Date: Wed, 27 Dec 2023 14:32:09 +0100 Subject: Remove workarounds for solved 'read-event' bug * lisp/subr.el (read-char-choice-with-read-key): * lisp/net/dbus.el (dbus-call-method): Remove workarounds for the bug fixed in the previous commit ac82baea1c41ec974ad49f2861ae6c06bda2b4ed, where 'read-event', 'read-char' and 'read-char-exclusively' could return wrongly -1. In the case of lisp/dbus.el, this reverts commit 7177393826c73c87ffe9b428f0e5edae244d7a98. --- lisp/net/dbus.el | 6 +----- lisp/subr.el | 5 ----- 2 files changed, 1 insertion(+), 10 deletions(-) diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 77b334e704e..46f85daba24 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -371,11 +371,7 @@ object is returned instead of a list containing this single Lisp object. (apply #'dbus-message-internal dbus-message-type-method-call bus service path interface method #'dbus-call-method-handler args)) - (result (unless executing-kbd-macro (cons :pending nil)))) - - ;; While executing a keyboard macro, we run into an infinite loop, - ;; receiving the event -1. So we don't try to get the result. - ;; (Bug#62018) + (result (cons :pending nil))) ;; Wait until `dbus-call-method-handler' has put the result into ;; `dbus-return-values-table'. If no timeout is given, use the diff --git a/lisp/subr.el b/lisp/subr.el index d58f8ba3b27..ce933e3bfdc 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3554,11 +3554,6 @@ causes it to evaluate `help-form' and display the result." (help-form-show))) ((memq char chars) (setq done t)) - ((and executing-kbd-macro (= char -1)) - ;; read-event returns -1 if we are in a kbd macro and - ;; there are no more events in the macro. Attempt to - ;; get an event interactively. - (setq executing-kbd-macro nil)) ((not inhibit-keyboard-quit) (cond ((and (null esc-flag) (eq char ?\e)) -- cgit v1.2.3 From df3e0bcbdbcfe907d7572b5561dd2bf9c3715a4a Mon Sep 17 00:00:00 2001 From: Tim Ruffing Date: Sat, 9 Mar 2024 12:29:39 +0100 Subject: * lisp/calc/calc-prog.el: Switch to new method of detecting end of kbd macro 'read-char' will no longer return -1 as of ac82baea1c41ec974ad49f2861ae6c06bda2b4ed. This switches to a cleaner method of detecting whether the end of a keyboard macro has been reached. * lisp/calc/calc-prog.el (calc--at-end-of-kmacro-p): New function. (calc-kbd-skip-to-else-if): Use the function. Co-authored-by: Stefan Monnier --- lisp/calc/calc-prog.el | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index 03210995eb3..8dff7f1f264 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -1225,13 +1225,17 @@ Redefine the corresponding command." (interactive) (calc-kbd-if)) +(defun calc--at-end-of-kmacro-p () + (and (arrayp executing-kbd-macro) + (>= executing-kbd-macro-index (length executing-kbd-macro)))) + (defun calc-kbd-skip-to-else-if (else-okay) (let ((count 0) ch) (while (>= count 0) - (setq ch (read-char)) - (if (= ch -1) + (if (calc--at-end-of-kmacro-p) (error "Unterminated Z[ in keyboard macro")) + (setq ch (read-char)) (if (= ch ?Z) (progn (setq ch (read-char)) @@ -1299,9 +1303,9 @@ Redefine the corresponding command." (or executing-kbd-macro (message "Reading loop body...")) (while (>= count 0) - (setq ch (read-event)) - (if (eq ch -1) + (if (calc--at-end-of-kmacro-p) (error "Unterminated Z%c in keyboard macro" open)) + (setq ch (read-event)) (if (eq ch ?Z) (progn (setq ch (read-event) @@ -1427,9 +1431,9 @@ Redefine the corresponding command." (if defining-kbd-macro (message "Reading body...")) (while (>= count 0) - (setq ch (read-char)) - (if (= ch -1) + (if (calc--at-end-of-kmacro-p) (error "Unterminated Z` in keyboard macro")) + (setq ch (read-char)) (if (= ch ?Z) (progn (setq ch (read-char) -- cgit v1.2.3 From 2fdb281a276af57c104008d68ae95c7f4b1c3da8 Mon Sep 17 00:00:00 2001 From: Tim Ruffing Date: Sat, 9 Mar 2024 12:15:22 +0100 Subject: * src/keyboard.c (read_key_sequence): Remove MSVC compatibility hack --- src/keyboard.c | 18 +++++------------- 1 file changed, 5 insertions(+), 13 deletions(-) diff --git a/src/keyboard.c b/src/keyboard.c index cadb376430e..1ba74a59537 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -10442,9 +10442,6 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, Lisp_Object original_uppercase UNINIT; int original_uppercase_position = -1; - /* Gets around Microsoft compiler limitations. */ - bool dummyflag = false; - #ifdef HAVE_TEXT_CONVERSION bool disabled_conversion; @@ -10693,10 +10690,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, && !requeued_events_pending_p ()) { t = 0; - /* The Microsoft C compiler can't handle the goto that - would go here. */ - dummyflag = true; - break; + goto done; } /* Otherwise, we should actually read a character. */ else @@ -11291,10 +11285,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, && help_char_p (EVENT_HEAD (key)) && t > 1) { read_key_sequence_cmd = Vprefix_help_command; - /* The Microsoft C compiler can't handle the goto that - would go here. */ - dummyflag = true; - break; + goto done; } /* If KEY is not defined in any of the keymaps, @@ -11343,8 +11334,9 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, } } } - if (!dummyflag) - read_key_sequence_cmd = current_binding; + read_key_sequence_cmd = current_binding; + + done: read_key_sequence_remapped /* Remap command through active keymaps. Do the remapping here, before the unbind_to so it uses the keymaps -- cgit v1.2.3 From c17ecd2dcd27b73d673df51ce66f4b188afff6db Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 10 Mar 2024 15:12:00 -0400 Subject: syncdoc-type-hierarchy.el: Sort and remove `comp` dependency * admin/syncdoc-type-hierarchy.el: Delay loading `org-table` so as not to "pollute" the table with Org-specific types. (syncdoc-all-types): Sort the types topologically from the root. (syncdoc-hierarchy): Use `cl--class-parents` instead if `comp--direct-supertypes` so we don't depend on `comp-cstr`. (syncdoc-make-type-table): Sort the table so supertypes always come before their subtypes. (syncdoc-make-type-table): Require `org-table` here. * doc/lispref/elisp_type_hierarchy.jpg: * doc/lispref/elisp_type_hierarchy.txt: Refresh. --- admin/syncdoc-type-hierarchy.el | 26 +++++++++----- doc/lispref/elisp_type_hierarchy.jpg | Bin 345570 -> 288444 bytes doc/lispref/elisp_type_hierarchy.txt | 66 +++++++++++++++++------------------ 3 files changed, 50 insertions(+), 42 deletions(-) diff --git a/admin/syncdoc-type-hierarchy.el b/admin/syncdoc-type-hierarchy.el index e14d7fb54e1..bfbbbc45aa4 100644 --- a/admin/syncdoc-type-hierarchy.el +++ b/admin/syncdoc-type-hierarchy.el @@ -35,7 +35,6 @@ ;;; Code: (require 'cl-lib) -(require 'org-table) (defconst syncdoc-file (or (macroexp-file-name) buffer-file-name)) @@ -51,21 +50,24 @@ (when (cl-find-class type) (push type res))) obarray) - res) + (nreverse + (merge-ordered-lists + (sort + (mapcar (lambda (type) (cl--class-allparents (cl-find-class type))) + res) + (lambda (ts1 ts2) (> (length ts1) (length ts2))))))) "List of all types.") -(declare-function 'comp--direct-supertypes "comp-cstr.el") - (defconst syncdoc-hierarchy (progn ;; Require it here so we don't load it before `syncdoc-all-types' is ;; computed. - (require 'comp-cstr) (cl-loop - with comp-ctxt = (make-comp-cstr-ctxt) with h = (make-hash-table :test #'eq) for type in syncdoc-all-types - do (puthash type (comp--direct-supertypes type) h) + do (puthash type (mapcar #'cl--class-name + (cl--class-parents (cl-find-class type))) + h) finally return h))) (defun syncdoc-insert-dot-content (rankdir) @@ -90,10 +92,14 @@ (dolist (parent parents) (push type (alist-get parent subtypes)))) syncdoc-hierarchy) - (cl-loop for (type . children) in (reverse subtypes) + (sort subtypes + (lambda (x1 x2) + (< (length (memq (car x2) syncdoc-all-types)) + (length (memq (car x1) syncdoc-all-types))))) + (cl-loop for (type . children) in subtypes do (insert "|" (symbol-name type) " |") do (cl-loop with x = 0 - for child in (reverse children) + for child in children for child-len = (length (symbol-name child)) when (> (+ x child-len 2) 60) do (progn @@ -102,6 +108,8 @@ do (insert (symbol-name child) " ") do (cl-incf x (1+ child-len)) ) do (insert "\n"))) + (require 'org-table) + (declare-function 'org-table-align "org") (org-table-align))) (defun syncdoc-update-type-hierarchy0 () diff --git a/doc/lispref/elisp_type_hierarchy.jpg b/doc/lispref/elisp_type_hierarchy.jpg index a2e14490dfa..386954e1007 100644 Binary files a/doc/lispref/elisp_type_hierarchy.jpg and b/doc/lispref/elisp_type_hierarchy.jpg differ diff --git a/doc/lispref/elisp_type_hierarchy.txt b/doc/lispref/elisp_type_hierarchy.txt index d1be8f56c72..bb93cd831b9 100644 --- a/doc/lispref/elisp_type_hierarchy.txt +++ b/doc/lispref/elisp_type_hierarchy.txt @@ -1,33 +1,33 @@ -| Type | Derived Types | -|---------------------+------------------------------------------------------------| -| atom | mutex record font-spec frame number-or-marker | -| | tree-sitter-compiled-query tree-sitter-node font-entity | -| | tree-sitter-parser hash-table window-configuration | -| | function user-ptr overlay array process font-object symbol | -| | obarray condvar buffer terminal thread window | -| | native-comp-unit | -| cl-structure-object | xref-elisp-location org-cite-processor cl--generic-method | -| | cl--random-state register-preview-info cl--generic | -| | cl--class cl-slot-descriptor uniquify-item registerv | -| | isearch--state cl--generic-generalizer lisp-indent-state | -| t | sequence atom | -| compiled-function | subr byte-code-function | -| integer | fixnum bignum | -| symbol | symbol-with-pos keyword boolean | -| accessor | oclosure-accessor | -| oclosure | advice cconv--interactive-helper advice--forward accessor | -| | save-some-buffers-function cl--generic-nnm | -| cons | ppss decoded-time | -| cl--class | cl-structure-class oclosure--class built-in-class | -| subr | subr-primitive subr-native-elisp | -| array | string vector bool-vector char-table | -| number | float integer | -| number-or-marker | integer-or-marker number | -| function | oclosure compiled-function interpreted-function | -| | module-function | -| sequence | list array | -| integer-or-marker | integer marker | -| boolean | null | -| list | null cons | -| record | cl-structure-object | -| vector | timer | +| Type | Derived Types | +|---------------------+-----------------------------------------------------------| +| t | sequence atom | +| atom | number-or-marker array record symbol function | +| | window-configuration font-object font-entity mutex | +| | tree-sitter-node buffer overlay tree-sitter-parser thread | +| | font-spec native-comp-unit tree-sitter-compiled-query | +| | terminal window frame hash-table user-ptr obarray condvar | +| | process | +| sequence | array list | +| list | null cons | +| function | oclosure compiled-function module-function | +| | interpreted-function | +| symbol | boolean symbol-with-pos keyword | +| compiled-function | subr byte-code-function | +| oclosure | accessor advice--forward cconv--interactive-helper | +| | cl--generic-nnm advice save-some-buffers-function | +| record | cl-structure-object | +| cl-structure-object | cl--class lisp-indent-state cl--random-state registerv | +| | xref-elisp-location isearch--state cl-slot-descriptor | +| | cl--generic-generalizer uniquify-item cl--generic-method | +| | register-preview-info cl--generic | +| cons | ppss decoded-time | +| array | vector string char-table bool-vector | +| number-or-marker | number integer-or-marker | +| integer-or-marker | integer marker | +| number | integer float | +| cl--class | built-in-class cl-structure-class oclosure--class | +| subr | subr-native-elisp subr-primitive | +| accessor | oclosure-accessor | +| vector | timer | +| boolean | null | +| integer | fixnum bignum | -- cgit v1.2.3 From 46afc91c9f7e6ee6a7917537c83052e0877fa4f2 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Thu, 7 Mar 2024 21:55:45 -0800 Subject: Let 'browse-url-interactive-arg' return more values for NEW-WINDOW-FLAG Previously it always returned t or nil for NEW-WINDOW-FLAG, but now it can return the actual prefix arg when appropriate. This lets functions for 'browse-url-browser-function' consult it and do more things than just open a new window or not (for example, you could use "C--" as the prefix arg to do something special in a custom function). * lisp/net/browse-url.el (browse-url-interactive-arg): Use 'xor' to adjust the value of 'current-prefix-arg'. (browse-url): Update docstring. --- lisp/net/browse-url.el | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index ddc57724343..f22aa19f5e3 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -704,8 +704,10 @@ it defaults to the current region, else to the URL at or before point. If invoked with a mouse button, it moves point to the position clicked before acting. -This function returns a list (URL NEW-WINDOW-FLAG) -for use in `interactive'." +This function returns a list (URL NEW-WINDOW-FLAG) for use in +`interactive'. NEW-WINDOW-FLAG is the prefix arg; if +`browse-url-new-window-flag' is non-nil, invert the prefix arg +instead." (let ((event (elt (this-command-keys) 0))) (mouse-set-point event)) (list (read-string prompt (or (and transient-mark-mode mark-active @@ -715,8 +717,7 @@ for use in `interactive'." (buffer-substring-no-properties (region-beginning) (region-end)))) (browse-url-url-at-point))) - (not (eq (null browse-url-new-window-flag) - (null current-prefix-arg))))) + (xor browse-url-new-window-flag current-prefix-arg))) ;; called-interactive-p needs to be called at a function's top-level, hence ;; this macro. We use that rather than interactive-p because @@ -879,8 +880,8 @@ The variables `browse-url-browser-function', `browse-url-handlers', and `browse-url-default-handlers' determine which browser function to use. -This command prompts for a URL, defaulting to the URL at or -before point. +Interactively, this command prompts for a URL, defaulting to the +URL at or before point. The additional ARGS are passed to the browser function. See the doc strings of the actual functions, starting with @@ -888,7 +889,9 @@ doc strings of the actual functions, starting with significance of ARGS (most of the functions ignore it). If ARGS are omitted, the default is to pass -`browse-url-new-window-flag' as ARGS." +`browse-url-new-window-flag' as ARGS. Interactively, pass the +prefix arg as ARGS; if `browse-url-new-window-flag' is non-nil, +invert the prefix arg instead." (interactive (browse-url-interactive-arg "URL: ")) (unless (called-interactively-p 'interactive) (setq args (or args (list browse-url-new-window-flag)))) -- cgit v1.2.3 From 887789eecc8546d60a296ce9771ecb20fc280a4d Mon Sep 17 00:00:00 2001 From: Andreas Schwab Date: Sun, 10 Mar 2024 23:02:26 +0100 Subject: Avoid dependency on nonexisting target in lispref makefile * doc/lispref/Makefile.in (auxfiles): Change target into a variable. ($(buildinfodir)/elisp.info): Adjust dependency. (infoclean): Clean $(auxfiles). --- doc/lispref/Makefile.in | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in index 9b7b6d8ea9d..0a228271be3 100644 --- a/doc/lispref/Makefile.in +++ b/doc/lispref/Makefile.in @@ -144,7 +144,7 @@ ps: $(PS_TARGETS) ${buildinfodir}: ${MKDIR_P} $@ -auxfiles: $(buildinfodir)/elisp_type_hierarchy.txt $(buildinfodir)/elisp_type_hierarchy.jpg +auxfiles = $(buildinfodir)/elisp_type_hierarchy.txt $(buildinfodir)/elisp_type_hierarchy.jpg $(buildinfodir)/elisp_type_hierarchy.txt: $(srcdir)/elisp_type_hierarchy.txt | ${buildinfodir} cp $< $@ @@ -152,7 +152,7 @@ $(buildinfodir)/elisp_type_hierarchy.txt: $(srcdir)/elisp_type_hierarchy.txt | $ $(buildinfodir)/elisp_type_hierarchy.jpg: $(srcdir)/elisp_type_hierarchy.jpg | ${buildinfodir} cp $< $@ -$(buildinfodir)/elisp.info: $(srcs) auxfiles | ${buildinfodir} +$(buildinfodir)/elisp.info: $(srcs) $(auxfiles) | ${buildinfodir} $(AM_V_GEN)$(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ $< elisp.dvi: $(srcs) @@ -187,6 +187,7 @@ infoclean: $(buildinfodir)/elisp.info \ $(buildinfodir)/elisp.info-[1-9] \ $(buildinfodir)/elisp.info-[1-9][0-9] + rm -f $(auxfiles) bootstrap-clean maintainer-clean: distclean infoclean rm -f TAGS -- cgit v1.2.3 From ed43ad5b5652aed075348357121d9193256721c0 Mon Sep 17 00:00:00 2001 From: Petteri Hintsanen Date: Sun, 10 Mar 2024 23:30:11 -0400 Subject: (bindat--unpack-item): Sanitize vector length Copyright-paperwork-exempt: yes * lisp/emacs-lisp/bindat.el (bindat--unpack-item): Sanitize vector length --- lisp/emacs-lisp/bindat.el | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index 73745e8c7ac..a2161022a89 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -204,6 +204,9 @@ ('str (bindat--unpack-str len)) ('strz (bindat--unpack-strz len)) ('vec + (when (> len (length bindat-raw)) + (error "Vector length %d is greater than raw data length %d." + len (length bindat-raw))) (let ((v (make-vector len 0)) (vlen 1)) (if (consp vectype) (setq vlen (nth 1 vectype) -- cgit v1.2.3 From 9a2ce74c3783c4be8ba70642da374d8e77c6f9ac Mon Sep 17 00:00:00 2001 From: Michael Heerdegen Date: Sun, 18 Feb 2024 02:48:15 +0100 Subject: Fix pp-emacs-lisp-code printing of symbols * lisp/emacs-lisp/pp.el (pp--insert-lisp): Print symbols readably (bug#69168). --- lisp/emacs-lisp/pp.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 1d722051406..944dd750839 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -458,6 +458,8 @@ the bounds of a region containing Lisp code to pretty-print." (string (let ((print-escape-newlines t)) (prin1 sexp (current-buffer)))) + (symbol + (prin1 sexp (current-buffer))) (otherwise (princ sexp (current-buffer))))) (defun pp--format-vector (sexp) -- cgit v1.2.3 From bbc53e0bcf3fe18e7c1cd51fb8719cf62b9f6c71 Mon Sep 17 00:00:00 2001 From: Michael Heerdegen Date: Sun, 18 Feb 2024 01:55:54 +0100 Subject: Improve pp-emacs-lisp-code backquote form printing * lisp/emacs-lisp/pp.el (pp--quoted-or-unquoted-form-p): New helper function. (pp--insert-lisp): Take care of quoted, backquoted and unquoted expressions; print using an recursive call. (pp--format-list): Exclude more cases from printing as a function call by default. Print lists whose second-last element is an (un)quoting symbol using dotted list syntax; e.g. (a b . ,c) instead of (a b \, c). --- lisp/emacs-lisp/pp.el | 56 ++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 40 insertions(+), 16 deletions(-) diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 944dd750839..569f70ca604 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -430,23 +430,33 @@ the bounds of a region containing Lisp code to pretty-print." (replace-match "")) (insert-into-buffer obuf))))) +(defvar pp--quoting-syntaxes + `((quote . "'") + (function . "#'") + (,backquote-backquote-symbol . "`") + (,backquote-unquote-symbol . ",") + (,backquote-splice-symbol . ",@"))) + +(defun pp--quoted-or-unquoted-form-p (cons) + ;; Return non-nil when CONS has one of the forms 'X, `X, ,X or ,@X + (let ((head (car cons))) + (and (symbolp head) + (assq head pp--quoting-syntaxes) + (let ((rest (cdr cons))) + (and (consp rest) (null (cdr rest))))))) + (defun pp--insert-lisp (sexp) (cl-case (type-of sexp) (vector (pp--format-vector sexp)) (cons (cond ((consp (cdr sexp)) - (if (and (length= sexp 2) - (memq (car sexp) '(quote function))) - (cond - ((symbolp (cadr sexp)) - (let ((print-quoted t)) - (prin1 sexp (current-buffer)))) - ((consp (cadr sexp)) - (insert (if (eq (car sexp) 'quote) - "'" "#'")) - (pp--format-list (cadr sexp) - (set-marker (make-marker) (1- (point)))))) - (pp--format-list sexp))) + (let ((head (car sexp))) + (if-let (((null (cddr sexp))) + (syntax-entry (assq head pp--quoting-syntaxes))) + (progn + (insert (cdr syntax-entry)) + (pp--insert-lisp (cadr sexp))) + (pp--format-list sexp)))) (t (prin1 sexp (current-buffer))))) ;; Print some of the smaller integers as characters, perhaps? @@ -470,15 +480,29 @@ the bounds of a region containing Lisp code to pretty-print." (insert "]")) (defun pp--format-list (sexp &optional start) - (if (and (symbolp (car sexp)) - (not pp--inhibit-function-formatting) - (not (keywordp (car sexp)))) + (if (not (let ((head (car sexp))) + (or pp--inhibit-function-formatting + (not (symbolp head)) + (keywordp head) + (let ((l sexp)) + (catch 'not-funcall + (while l + (when (or + (atom l) ; SEXP is a dotted list + ;; Does SEXP have a form like (ELT... . ,X) ? + (pp--quoted-or-unquoted-form-p l)) + (throw 'not-funcall t)) + (setq l (cdr l))) + nil))))) (pp--format-function sexp) (insert "(") (pp--insert start (pop sexp)) (while sexp (if (consp sexp) - (pp--insert " " (pop sexp)) + (if (not (pp--quoted-or-unquoted-form-p sexp)) + (pp--insert " " (pop sexp)) + (pp--insert " . " sexp) + (setq sexp nil)) (pp--insert " . " sexp) (setq sexp nil))) (insert ")"))) -- cgit v1.2.3 From 2d61ebb505977af4f9fd90f92a776599a73f8501 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 11 Mar 2024 00:03:39 -0700 Subject: Change bare-symbol back to match intent Also, attempt to document the intent better. Problem reported by Alan Mackenzie (Bug#69684). * src/data.c (Fbare_symbol): Do not signal if the SYM is a symbol with position and symbols-with-pos-enabled is nil. Instead, ignore symbols-with-pos-enabled, as that was the intent. * test/src/data-tests.el (data-tests-bare-symbol): New test, to help prevent this bug from reoccurring. --- doc/lispref/objects.texi | 6 ++-- doc/lispref/symbols.texi | 78 ++++++++++++++++++++++++++---------------------- src/data.c | 35 ++++++++++++++-------- test/src/data-tests.el | 5 ++++ 4 files changed, 73 insertions(+), 51 deletions(-) diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 41171bcaafc..279f449a994 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -2399,10 +2399,10 @@ The @code{equal} function recursively compares the contents of objects if they are integers, strings, markers, vectors, bool-vectors, byte-code function objects, char-tables, records, or font objects. -If @var{object1} or @var{object2} is a symbol with position, -@code{equal} regards it as its bare symbol when +If @var{object1} or @var{object2} contains symbols with position, +@code{equal} treats them as if they were their bare symbols when @code{symbols-with-pos-enabled} is non-@code{nil}. Otherwise -@code{equal} compares two symbols with position by recursively +@code{equal} compares two symbols with position by comparing their components. @xref{Symbols with Position}. Other objects are considered @code{equal} only if they are @code{eq}. diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 6f9b1ef0ec7..c76bf3d3820 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -780,13 +780,16 @@ Symbol forms whose names start with @samp{#_} are not transformed. @cindex symbol with position @cindex bare symbol -A @dfn{symbol with position} is a symbol, the @dfn{bare symbol}, -together with an unsigned integer called the @dfn{position}. Symbols -with position don't themselves have entries in the obarray (though -their bare symbols do; @pxref{Creating Symbols}). - -Symbols with position are for the use of the byte compiler, which -records in them the position of each symbol occurrence and uses those +A @dfn{symbol with position} is a symbol, called the @dfn{bare symbol}, +together with a nonnegative fixnum called the @dfn{position}. +Even though a symbol with position often acts like its bare symbol, +it is not a symbol: instead, it is an object that has both a bare symbol +and a position. Because symbols with position are not symbols, +they don't have entries in the obarray, though their bare symbols +typically do (@pxref{Creating Symbols}). + +The byte compiler uses symbols with position, +records in them the position of each symbol occurrence, and uses those positions in warning and error messages. They shouldn't normally be used otherwise. Doing so can cause unexpected results with basic Emacs functions such as @code{eq} and @code{equal}. @@ -799,22 +802,19 @@ just the bare symbol to be printed by binding the variable operation. The byte compiler does this before writing its output to the compiled Lisp file. -For most purposes, when the flag variable -@code{symbols-with-pos-enabled} is non-@code{nil}, symbols with -positions behave just as their bare symbols would. For example, -@samp{(eq # foo)} has a value @code{t} when the -variable is set; likewise, @code{equal} will treat a symbol with -position argument as its bare symbol. +When the flag variable @code{symbols-with-pos-enabled} is non-@code{nil}, +a symbol with position ordinarily behaves like its bare symbol. +For example, @samp{(eq (position-symbol 'foo 12345) 'foo)} yields @code{t}, +and @code{equal} likewise treats a symbol with position as its bare symbol. -When @code{symbols-with-pos-enabled} is @code{nil}, any symbols with -position continue to exist, but do not behave as symbols, or have the -other useful properties outlined in the previous paragraph. @code{eq} -returns @code{t} when given identical arguments, and @code{equal} -returns @code{t} when given arguments with @code{equal} components. +When @code{symbols-with-pos-enabled} is @code{nil}, symbols with +position behave as themselves, not as symbols. For example, @samp{(eq +(position-symbol 'foo 12345) 'foo)} yields @code{nil}, and @code{equal} +likewise treats a symbol with position as not equal to its bare symbol. Most of the time in Emacs @code{symbols-with-pos-enabled} is @code{nil}, but the byte compiler and the native compiler bind it to -@code{t} when they run. +@code{t} when they run and Emacs runs a little more slowly in this case. Typically, symbols with position are created by the byte compiler calling the reader function @code{read-positioning-symbols} @@ -822,36 +822,44 @@ calling the reader function @code{read-positioning-symbols} @code{position-symbol}. @defvar symbols-with-pos-enabled -When this variable is non-@code{nil}, a symbol with position behaves -like the contained bare symbol. Emacs runs a little more slowly in -this case. +This variable affects the behavior of symbols with position when they +are not being printed and are not arguments to one of the functions +defined later in this section. When this variable is non-@code{nil}, +such a symbol with position behaves like its bare symbol; otherwise it +behaves as itself, not as a symbol. @end defvar @defvar print-symbols-bare When bound to non-@code{nil}, the Lisp printer prints only the bare symbol of a symbol with position, ignoring the position. +Otherwise a symbol with position prints as itself, not as a symbol. @end defvar -@defun symbol-with-pos-p symbol -This function returns @code{t} if @var{symbol} is a symbol with +@defun symbol-with-pos-p object +This function returns @code{t} if @var{object} is a symbol with position, @code{nil} otherwise. +Unlike @code{symbolp}, this function ignores @code{symbols-with-pos-enabled}. @end defun -@defun bare-symbol symbol -This function returns the bare symbol contained in @var{symbol}, or -@var{symbol} itself if it is already a bare symbol. For any other -type of object, it signals an error. +@defun bare-symbol sym +This function returns the bare symbol of the symbol with +position @var{sym}, or @var{sym} itself if it is already a symbol. +For any other type of object, it signals an error. +This function ignores @code{symbols-with-pos-enabled}. @end defun -@defun symbol-with-pos-pos symbol -This function returns the position, a number, from a symbol with -position. For any other type of object, it signals an error. +@defun symbol-with-pos-pos sympos +This function returns the position, a nonnegative fixnum, from the symbol with +position @var{sympos}. For any other type of object, it signals an error. +This function ignores @code{symbols-with-pos-enabled}. @end defun @defun position-symbol sym pos -Make a new symbol with position. @var{sym} is either a bare symbol or -a symbol with position, and supplies the symbol part of the new -object. @var{pos} is either an integer which becomes the number part -of the new object, or a symbol with position whose position is used. +Make a new symbol with position. The new object's bare symbol is taken +from @var{sym}, which is either a symbol, or a symbol with position +whose bare symbol is used. The new object's position is taken from +@var{pos}, which is either a nonnegative fixnum, or a symbol with +position whose position is used. Emacs signals an error if either argument is invalid. +This function ignores @code{symbols-with-pos-enabled}. @end defun diff --git a/src/data.c b/src/data.c index df08eaf8102..35f4c82c68f 100644 --- a/src/data.c +++ b/src/data.c @@ -339,7 +339,8 @@ DEFUN ("bare-symbol-p", Fbare_symbol_p, Sbare_symbol_p, 1, 1, 0, } DEFUN ("symbol-with-pos-p", Fsymbol_with_pos_p, Ssymbol_with_pos_p, 1, 1, 0, - doc: /* Return t if OBJECT is a symbol together with position. */ + doc: /* Return t if OBJECT is a symbol together with position. +Ignore `symbols-with-pos-enabled'. */ attributes: const) (Lisp_Object object) { @@ -789,25 +790,32 @@ Doing that might make Emacs dysfunctional, and might even crash Emacs. */) } DEFUN ("bare-symbol", Fbare_symbol, Sbare_symbol, 1, 1, 0, - doc: /* Extract, if need be, the bare symbol from SYM, a symbol. */) + doc: /* Extract, if need be, the bare symbol from SYM. +SYM is either a symbol or a symbol with position. +Ignore `symbols-with-pos-enabled'. */) (register Lisp_Object sym) { - CHECK_SYMBOL (sym); - return BARE_SYMBOL_P (sym) ? sym : XSYMBOL_WITH_POS_SYM (sym); + if (BARE_SYMBOL_P (sym)) + return sym; + if (SYMBOL_WITH_POS_P (sym)) + return XSYMBOL_WITH_POS_SYM (sym); + xsignal2 (Qwrong_type_argument, list2 (Qsymbolp, Qsymbol_with_pos_p), sym); } DEFUN ("symbol-with-pos-pos", Fsymbol_with_pos_pos, Ssymbol_with_pos_pos, 1, 1, 0, - doc: /* Extract the position from a symbol with position. */) - (register Lisp_Object ls) + doc: /* Extract the position from the symbol with position SYMPOS. +Ignore `symbols-with-pos-enabled'. */) + (register Lisp_Object sympos) { - CHECK_TYPE (SYMBOL_WITH_POS_P (ls), Qsymbol_with_pos_p, ls); - return XSYMBOL_WITH_POS_POS (ls); + CHECK_TYPE (SYMBOL_WITH_POS_P (sympos), Qsymbol_with_pos_p, sympos); + return XSYMBOL_WITH_POS_POS (sympos); } DEFUN ("remove-pos-from-symbol", Fremove_pos_from_symbol, Sremove_pos_from_symbol, 1, 1, 0, doc: /* If ARG is a symbol with position, return it without the position. -Otherwise, return ARG unchanged. Compare with `bare-symbol'. */) +Otherwise, return ARG unchanged. Ignore `symbols-with-pos-enabled'. +Compare with `bare-symbol'. */) (register Lisp_Object arg) { if (SYMBOL_WITH_POS_P (arg)) @@ -816,10 +824,11 @@ Otherwise, return ARG unchanged. Compare with `bare-symbol'. */) } DEFUN ("position-symbol", Fposition_symbol, Sposition_symbol, 2, 2, 0, - doc: /* Create a new symbol with position. + doc: /* Make a new symbol with position. SYM is a symbol, with or without position, the symbol to position. -POS, the position, is either a fixnum or a symbol with position from which -the position will be taken. */) +POS, the position, is either a nonnegative fixnum, +or a symbol with position from which the position will be taken. +Ignore `symbols-with-pos-enabled'. */) (register Lisp_Object sym, register Lisp_Object pos) { Lisp_Object bare = Fbare_symbol (sym); @@ -4374,7 +4383,7 @@ This variable cannot be set; trying to do so will signal an error. */); DEFSYM (Qsymbols_with_pos_enabled, "symbols-with-pos-enabled"); DEFVAR_BOOL ("symbols-with-pos-enabled", symbols_with_pos_enabled, - doc: /* Non-nil when "symbols with position" can be used as symbols. + doc: /* If non-nil, a symbol with position ordinarily behaves as its bare symbol. Bind this to non-nil in applications such as the byte compiler. */); symbols_with_pos_enabled = false; diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 8af7e902109..ad3b2071254 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -833,4 +833,9 @@ comparing the subr with a much slower Lisp implementation." (should-error (defalias 'data-tests--da-c 'data-tests--da-d) :type 'cyclic-function-indirection)) +(ert-deftest data-tests-bare-symbol () + (dolist (symbols-with-pos-enabled '(nil t)) + (dolist (sym (list nil t 'xyzzy (make-symbol ""))) + (should (eq sym (bare-symbol (position-symbol sym 0))))))) + ;;; data-tests.el ends here -- cgit v1.2.3 From 75cfc6c73faa1561018b1212156964a7919c69fe Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Mon, 11 Mar 2024 11:16:20 +0100 Subject: ; Fix error message in last change to bindat.el Remove trailing period as per "(elisp) Error Symbols". Relates to the following discussion: https://lists.gnu.org/r/emacs-devel/2023-10/msg00473.html https://lists.gnu.org/r/emacs-devel/2024-03/msg00340.html --- lisp/emacs-lisp/bindat.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index a2161022a89..ef0ec688dbd 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -205,7 +205,7 @@ ('strz (bindat--unpack-strz len)) ('vec (when (> len (length bindat-raw)) - (error "Vector length %d is greater than raw data length %d." + (error "Vector length %d is greater than raw data length %d" len (length bindat-raw))) (let ((v (make-vector len 0)) (vlen 1)) (if (consp vectype) -- cgit v1.2.3 From db5915f30ba063b72b007d243fbd832e8a4e8961 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 10 Mar 2024 20:13:42 -0700 Subject: Fix 'with-sqlite-transaction' * lisp/sqlite.el (with-sqlite-transaction): Tuck misplaced body of else form back into feature-test control structure whence it escaped. (Bug#67142) * test/lisp/sqlite-tests.el: New file to accompany test/src/sqlite-tests.el. --- lisp/sqlite.el | 7 ++++--- test/lisp/sqlite-tests.el | 51 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 55 insertions(+), 3 deletions(-) create mode 100644 test/lisp/sqlite-tests.el diff --git a/lisp/sqlite.el b/lisp/sqlite.el index 46e35ac18d8..efc5997fb5c 100644 --- a/lisp/sqlite.el +++ b/lisp/sqlite.el @@ -32,7 +32,8 @@ If BODY completes normally, commit the changes and return the value of BODY. If BODY signals an error, or transaction commit fails, roll -back the transaction changes." +back the transaction changes before allowing the signal to +propagate." (declare (indent 1) (debug (form body))) (let ((db-var (gensym)) (func-var (gensym)) @@ -48,8 +49,8 @@ back the transaction changes." (setq ,res-var (funcall ,func-var)) (setq ,commit-var (sqlite-commit ,db-var)) ,res-var) - (or ,commit-var (sqlite-rollback ,db-var)))) - (funcall ,func-var)))) + (or ,commit-var (sqlite-rollback ,db-var))) + (funcall ,func-var))))) (provide 'sqlite) diff --git a/test/lisp/sqlite-tests.el b/test/lisp/sqlite-tests.el new file mode 100644 index 00000000000..d4892a27efc --- /dev/null +++ b/test/lisp/sqlite-tests.el @@ -0,0 +1,51 @@ +;;; sqlite-tests.el --- Tests for sqlite.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: +(require 'sqlite) + +(ert-deftest with-sqlite-transaction () + (skip-unless (sqlite-available-p)) + (let ((db (sqlite-open))) + (sqlite-execute db "create table test (a)") + (should + (eql 42 (with-sqlite-transaction db + (sqlite-execute db "insert into test values (1)") + (should (equal '((1)) (sqlite-select db "select * from test"))) + 42))) + ;; Body runs exactly once. + (should (equal '((1)) (sqlite-select db "select * from test"))))) + +(ert-deftest with-sqlite-transaction/rollback () + (skip-unless (sqlite-available-p)) + (let ((db (sqlite-open))) + (sqlite-execute db "create table test (a)") + (should (equal '(sqlite-error + ("SQL logic error" "no such function: fake" 1 1)) + (should-error + (with-sqlite-transaction db + (sqlite-execute db "insert into test values (1)") + (sqlite-execute db "insert into test values (fake(2))") + 42)))) + ;; First insertion (a=1) rolled back. + (should-not (sqlite-select db "select * from test")))) + +;;; sqlite-tests.el ends here -- cgit v1.2.3 From a7a37341cad230448e487d0ffa343eeeb8a66a65 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 11 Mar 2024 21:40:47 +0800 Subject: Implement notification callbacks on Android * doc/lispref/os.texi (Desktop Notifications): Document that :on-cancel, :on-action and :actions are now supported on Android. * java/org/gnu/emacs/EmacsActivity.java (onNewIntent): New function. * java/org/gnu/emacs/EmacsDesktopNotification.java (NOTIFICATION_ACTION, NOTIFICATION_TAG, NOTIFICATION_DISMISSED): New constants. : New fields. (insertActions): New function. (display1, display): Insert actions on Jelly Bean and up, and arrange to be notified when the notification is dismissed. (CancellationReceiver): New class. * java/org/gnu/emacs/EmacsNative.java (sendNotificationDeleted) (sendNotificationAction): New functions. * src/android.c (sendDndDrag, sendDndUri, sendDndText): Correct return types. (sendNotificationDeleted, sendNotificationAction) (android_exception_check_5, android_exception_check_6): New functions. * src/android.h: * src/androidgui.h (struct android_notification_event): New structure. (union android_event): New member for notification events. * src/androidselect.c (android_init_emacs_desktop_notification): Update JNI signatures. (android_notifications_notify_1, Fandroid_notifications_notify): New arguments ACTIONS, ACTION_CB and CANCEL_CB. Convert and record them as appropriate. (android_notification_deleted, android_notification_action): New functions. (syms_of_androidselect): Prepare a hash table of outstanding notifications. New defsyms. * src/androidterm.c (handle_one_android_event) : Dispatch event contents to androidselect.c for processing. * src/androidterm.h: * src/androidvfs.c (java_string_class): Export. * src/keyboard.c (kbd_buffer_get_event) : Call callback specified by the event. * src/termhooks.h (enum event_kind) [HAVE_ANDROID]: New enum NOTIFICATION_EVENT. --- doc/lispref/os.texi | 3 + java/org/gnu/emacs/EmacsActivity.java | 21 +++ java/org/gnu/emacs/EmacsDesktopNotification.java | 162 +++++++++++++++-- java/org/gnu/emacs/EmacsNative.java | 6 + src/android.c | 161 ++++++++++++++++- src/android.h | 7 + src/androidgui.h | 29 ++++ src/androidselect.c | 210 +++++++++++++++++++++-- src/androidterm.c | 22 ++- src/androidterm.h | 6 + src/androidvfs.c | 2 +- src/keyboard.c | 10 ++ src/termhooks.h | 4 + 13 files changed, 608 insertions(+), 35 deletions(-) diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 60ae57d4c1d..ecd88a39489 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -3241,6 +3241,9 @@ of parameters analogous to its namesake in @item :title @var{title} @item :body @var{body} @item :replaces-id @var{replaces-id} +@item :on-action @var{on-action} +@item :on-cancel @var{on-cancel} +@item :actions @var{actions} These have the same meaning as they do when used in calls to @code{notifications-notify}. diff --git a/java/org/gnu/emacs/EmacsActivity.java b/java/org/gnu/emacs/EmacsActivity.java index 66a1e41d84c..06b9c0f005d 100644 --- a/java/org/gnu/emacs/EmacsActivity.java +++ b/java/org/gnu/emacs/EmacsActivity.java @@ -453,6 +453,27 @@ public class EmacsActivity extends Activity syncFullscreenWith (window); } + @Override + public final void + onNewIntent (Intent intent) + { + String tag, action; + + /* This function is called when EmacsActivity is relaunched from a + notification. */ + + if (intent == null || EmacsService.SERVICE == null) + return; + + tag = intent.getStringExtra (EmacsDesktopNotification.NOTIFICATION_TAG); + action + = intent.getStringExtra (EmacsDesktopNotification.NOTIFICATION_ACTION); + + if (tag == null || action == null) + return; + + EmacsNative.sendNotificationAction (tag, action); + } @Override diff --git a/java/org/gnu/emacs/EmacsDesktopNotification.java b/java/org/gnu/emacs/EmacsDesktopNotification.java index fb35e3fea1f..f52c3d9d4fb 100644 --- a/java/org/gnu/emacs/EmacsDesktopNotification.java +++ b/java/org/gnu/emacs/EmacsDesktopNotification.java @@ -24,9 +24,12 @@ import android.app.NotificationManager; import android.app.NotificationChannel; import android.app.PendingIntent; +import android.content.BroadcastReceiver; import android.content.Context; import android.content.Intent; +import android.net.Uri; + import android.os.Build; import android.widget.RemoteViews; @@ -44,6 +47,16 @@ import android.widget.RemoteViews; public final class EmacsDesktopNotification { + /* Intent tag for notification action data. */ + public static final String NOTIFICATION_ACTION = "emacs:notification_action"; + + /* Intent tag for notification IDs. */ + public static final String NOTIFICATION_TAG = "emacs:notification_tag"; + + /* Action ID assigned to the broadcast receiver which should be + notified of any notification's being dismissed. */ + public static final String NOTIFICATION_DISMISSED = "org.gnu.emacs.DISMISSED"; + /* The content of this desktop notification. */ public final String content; @@ -66,10 +79,15 @@ public final class EmacsDesktopNotification /* The importance of this notification's group. */ public final int importance; + /* Array of actions and their user-facing text to be offered by this + notification. */ + public final String[] actions, titles; + public EmacsDesktopNotification (String title, String content, String group, String tag, int icon, - int importance) + int importance, + String[] actions, String[] titles) { this.content = content; this.title = title; @@ -77,12 +95,68 @@ public final class EmacsDesktopNotification this.tag = tag; this.icon = icon; this.importance = importance; + this.actions = actions; + this.titles = titles; } /* Functions for displaying desktop notifications. */ + /* Insert each action in actions and titles into the notification + builder BUILDER, with pending intents created with CONTEXT holding + suitable metadata. */ + + @SuppressWarnings ("deprecation") + private void + insertActions (Context context, Notification.Builder builder) + { + int i; + PendingIntent pending; + Intent intent; + Notification.Action.Builder action; + + if (actions == null) + return; + + for (i = 0; i < actions.length; ++i) + { + /* Actions named default should not be displayed. */ + if (actions[i].equals ("default")) + continue; + + intent = new Intent (context, EmacsActivity.class); + intent.addFlags (Intent.FLAG_ACTIVITY_NEW_TASK); + + /* Pending intents are specific to combinations of class, action + and data, but not information provided as extras. In order + that its target may be invoked with the action and tag set + below, generate a URL from those two elements and specify it + as the intent data, which ensures that the intent allocated + fully reflects the duo. */ + + intent.setData (new Uri.Builder ().scheme ("action") + .appendPath (tag).appendPath (actions[i]) + .build ()); + intent.putExtra (NOTIFICATION_ACTION, actions[i]); + intent.putExtra (NOTIFICATION_TAG, tag); + + if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.S) + pending = PendingIntent.getActivity (context, 0, intent, + PendingIntent.FLAG_IMMUTABLE); + else + pending = PendingIntent.getActivity (context, 0, intent, 0); + + if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.M) + { + action = new Notification.Action.Builder (0, titles[i], pending); + builder.addAction (action.build ()); + } + else + builder.addAction (0, titles[i], pending); + } + } + /* Internal helper for `display' executed on the main thread. */ @SuppressWarnings ("deprecation") /* Notification.Builder (Context). */ @@ -97,6 +171,7 @@ public final class EmacsDesktopNotification Intent intent; PendingIntent pending; int priority; + Notification.Builder builder; tem = context.getSystemService (Context.NOTIFICATION_SERVICE); manager = (NotificationManager) tem; @@ -108,13 +183,16 @@ public final class EmacsDesktopNotification (such as its importance) will be overridden. */ channel = new NotificationChannel (group, group, importance); manager.createNotificationChannel (channel); + builder = new Notification.Builder (context, group); - /* Create a notification object and display it. */ - notification = (new Notification.Builder (context, group) - .setContentTitle (title) - .setContentText (content) - .setSmallIcon (icon) - .build ()); + /* Create and configure a notification object and display + it. */ + + builder.setContentTitle (title); + builder.setContentText (content); + builder.setSmallIcon (icon); + insertActions (context, builder); + notification = builder.build (); } else if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB) { @@ -138,12 +216,16 @@ public final class EmacsDesktopNotification break; } - notification = (new Notification.Builder (context) - .setContentTitle (title) - .setContentText (content) - .setSmallIcon (icon) - .setPriority (priority) - .build ()); + builder = new Notification.Builder (context); + builder.setContentTitle (title); + builder.setContentText (content); + builder.setSmallIcon (icon); + builder.setPriority (priority); + + if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.JELLY_BEAN) + insertActions (context, builder); + + notification = builder.build (); if (Build.VERSION.SDK_INT > Build.VERSION_CODES.JELLY_BEAN) notification.priority = priority; @@ -170,6 +252,12 @@ public final class EmacsDesktopNotification intent = new Intent (context, EmacsActivity.class); intent.addFlags (Intent.FLAG_ACTIVITY_NEW_TASK); + intent.setData (new Uri.Builder () + .scheme ("action") + .appendPath (tag) + .build ()); + intent.putExtra (NOTIFICATION_ACTION, "default"); + intent.putExtra (NOTIFICATION_TAG, tag); if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.S) pending = PendingIntent.getActivity (context, 0, intent, @@ -179,6 +267,27 @@ public final class EmacsDesktopNotification notification.contentIntent = pending; + /* Provide a cancellation intent to respond to notification + dismissals. */ + + intent = new Intent (context, CancellationReceiver.class); + intent.setAction (NOTIFICATION_DISMISSED); + intent.setPackage ("org.gnu.emacs"); + intent.setData (new Uri.Builder () + .scheme ("action") + .appendPath (tag) + .build ()); + intent.putExtra (NOTIFICATION_TAG, tag); + + if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.S) + pending = PendingIntent.getBroadcast (context, 0, intent, + (PendingIntent.FLAG_IMMUTABLE + | PendingIntent.FLAG_ONE_SHOT)); + else + pending = PendingIntent.getBroadcast (context, 0, intent, + PendingIntent.FLAG_ONE_SHOT); + + notification.deleteIntent = pending; manager.notify (tag, 2, notification); } @@ -199,4 +308,31 @@ public final class EmacsDesktopNotification } }); } + + + + /* Broadcast receiver. This is something of a system-wide callback + arranged to be invoked whenever a notification posted by Emacs is + dismissed, in order to relay news of its dismissal to + androidselect.c and run or remove callbacks as appropriate. */ + + public static class CancellationReceiver extends BroadcastReceiver + { + @Override + public void + onReceive (Context context, Intent intent) + { + String tag, action; + + if (intent == null || EmacsService.SERVICE == null) + return; + + tag = intent.getStringExtra (NOTIFICATION_TAG); + + if (tag == null) + return; + + EmacsNative.sendNotificationDeleted (tag); + } + }; }; diff --git a/java/org/gnu/emacs/EmacsNative.java b/java/org/gnu/emacs/EmacsNative.java index cd0e70923d1..6845f833908 100644 --- a/java/org/gnu/emacs/EmacsNative.java +++ b/java/org/gnu/emacs/EmacsNative.java @@ -196,6 +196,12 @@ public final class EmacsNative public static native long sendDndText (short window, int x, int y, String text); + /* Send an ANDROID_NOTIFICATION_CANCELED event. */ + public static native void sendNotificationDeleted (String tag); + + /* Send an ANDROID_NOTIFICATION_ACTION event. */ + public static native void sendNotificationAction (String tag, String action); + /* Return the file name associated with the specified file descriptor, or NULL if there is none. */ public static native byte[] getProcName (int fd); diff --git a/src/android.c b/src/android.c index d7bd06f1f34..125bb5209c3 100644 --- a/src/android.c +++ b/src/android.c @@ -2457,7 +2457,7 @@ NATIVE_NAME (sendExpose) (JNIEnv *env, jobject object, return event_serial; } -JNIEXPORT jboolean JNICALL +JNIEXPORT jlong JNICALL NATIVE_NAME (sendDndDrag) (JNIEnv *env, jobject object, jshort window, jint x, jint y) { @@ -2477,7 +2477,7 @@ NATIVE_NAME (sendDndDrag) (JNIEnv *env, jobject object, return event_serial; } -JNIEXPORT jboolean JNICALL +JNIEXPORT jlong JNICALL NATIVE_NAME (sendDndUri) (JNIEnv *env, jobject object, jshort window, jint x, jint y, jstring string) @@ -2514,7 +2514,7 @@ NATIVE_NAME (sendDndUri) (JNIEnv *env, jobject object, return event_serial; } -JNIEXPORT jboolean JNICALL +JNIEXPORT jlong JNICALL NATIVE_NAME (sendDndText) (JNIEnv *env, jobject object, jshort window, jint x, jint y, jstring string) @@ -2551,6 +2551,85 @@ NATIVE_NAME (sendDndText) (JNIEnv *env, jobject object, return event_serial; } +JNIEXPORT jlong JNICALL +NATIVE_NAME (sendNotificationDeleted) (JNIEnv *env, jobject object, + jstring tag) +{ + JNI_STACK_ALIGNMENT_PROLOGUE; + + union android_event event; + const char *characters; + + event.notification.type = ANDROID_NOTIFICATION_DELETED; + event.notification.serial = ++event_serial; + event.notification.window = ANDROID_NONE; + + /* TAG is guaranteed to be an ASCII string, of which the JNI character + encoding is a superset. */ + characters = (*env)->GetStringUTFChars (env, tag, NULL); + if (!characters) + return 0; + + event.notification.tag = strdup (characters); + (*env)->ReleaseStringUTFChars (env, tag, characters); + if (!event.notification.tag) + return 0; + + event.notification.action = NULL; + event.notification.length = 0; + + android_write_event (&event); + return event_serial; +} + +JNIEXPORT jlong JNICALL +NATIVE_NAME (sendNotificationAction) (JNIEnv *env, jobject object, + jstring tag, jstring action) +{ + JNI_STACK_ALIGNMENT_PROLOGUE; + + union android_event event; + const void *characters; + jsize length; + uint16_t *buffer; + + event.notification.type = ANDROID_NOTIFICATION_ACTION; + event.notification.serial = ++event_serial; + event.notification.window = ANDROID_NONE; + + /* TAG is guaranteed to be an ASCII string, of which the JNI character + encoding is a superset. */ + characters = (*env)->GetStringUTFChars (env, tag, NULL); + if (!characters) + return 0; + + event.notification.tag = strdup (characters); + (*env)->ReleaseStringUTFChars (env, tag, characters); + if (!event.notification.tag) + return 0; + + length = (*env)->GetStringLength (env, action); + buffer = malloc (length * sizeof *buffer); + characters = (*env)->GetStringChars (env, action, NULL); + + if (!characters) + { + /* The JVM has run out of memory; return and let the out of memory + error take its course. */ + xfree (event.notification.tag); + return 0; + } + + memcpy (buffer, characters, length * sizeof *buffer); + (*env)->ReleaseStringChars (env, action, characters); + + event.notification.action = buffer; + event.notification.length = length; + + android_write_event (&event); + return event_serial; +} + JNIEXPORT jboolean JNICALL NATIVE_NAME (shouldForwardMultimediaButtons) (JNIEnv *env, jobject object) @@ -6310,6 +6389,82 @@ android_exception_check_4 (jobject object, jobject object1, memory_full (0); } +/* Like android_exception_check_4, except it takes more than four local + reference arguments. */ + +void +android_exception_check_5 (jobject object, jobject object1, + jobject object2, jobject object3, + jobject object4) +{ + if (likely (!(*android_java_env)->ExceptionCheck (android_java_env))) + return; + + __android_log_print (ANDROID_LOG_WARN, __func__, + "Possible out of memory error. " + " The Java exception follows: "); + /* Describe exactly what went wrong. */ + (*android_java_env)->ExceptionDescribe (android_java_env); + (*android_java_env)->ExceptionClear (android_java_env); + + if (object) + ANDROID_DELETE_LOCAL_REF (object); + + if (object1) + ANDROID_DELETE_LOCAL_REF (object1); + + if (object2) + ANDROID_DELETE_LOCAL_REF (object2); + + if (object3) + ANDROID_DELETE_LOCAL_REF (object3); + + if (object4) + ANDROID_DELETE_LOCAL_REF (object4); + + memory_full (0); +} + + +/* Like android_exception_check_5, except it takes more than five local + reference arguments. */ + +void +android_exception_check_6 (jobject object, jobject object1, + jobject object2, jobject object3, + jobject object4, jobject object5) +{ + if (likely (!(*android_java_env)->ExceptionCheck (android_java_env))) + return; + + __android_log_print (ANDROID_LOG_WARN, __func__, + "Possible out of memory error. " + " The Java exception follows: "); + /* Describe exactly what went wrong. */ + (*android_java_env)->ExceptionDescribe (android_java_env); + (*android_java_env)->ExceptionClear (android_java_env); + + if (object) + ANDROID_DELETE_LOCAL_REF (object); + + if (object1) + ANDROID_DELETE_LOCAL_REF (object1); + + if (object2) + ANDROID_DELETE_LOCAL_REF (object2); + + if (object3) + ANDROID_DELETE_LOCAL_REF (object3); + + if (object4) + ANDROID_DELETE_LOCAL_REF (object4); + + if (object5) + ANDROID_DELETE_LOCAL_REF (object5); + + memory_full (0); +} + /* Check for JNI problems based on the value of OBJECT. Signal out of memory if OBJECT is NULL. OBJECT1 means the diff --git a/src/android.h b/src/android.h index e1834cebf68..ee634a3e76c 100644 --- a/src/android.h +++ b/src/android.h @@ -118,6 +118,10 @@ extern void android_exception_check_1 (jobject); extern void android_exception_check_2 (jobject, jobject); extern void android_exception_check_3 (jobject, jobject, jobject); extern void android_exception_check_4 (jobject, jobject, jobject, jobject); +extern void android_exception_check_5 (jobject, jobject, jobject, jobject, + jobject); +extern void android_exception_check_6 (jobject, jobject, jobject, jobject, + jobject, jobject); extern void android_exception_check_nonnull (void *, jobject); extern void android_exception_check_nonnull_1 (void *, jobject, jobject); @@ -306,6 +310,9 @@ extern JNIEnv *android_java_env; extern JavaVM *android_jvm; #endif /* THREADS_ENABLED */ +/* The Java String class. */ +extern jclass java_string_class; + /* The EmacsService object. */ extern jobject emacs_service; diff --git a/src/androidgui.h b/src/androidgui.h index 73b60c483d3..d89aee51055 100644 --- a/src/androidgui.h +++ b/src/androidgui.h @@ -251,6 +251,8 @@ enum android_event_type ANDROID_DND_DRAG_EVENT, ANDROID_DND_URI_EVENT, ANDROID_DND_TEXT_EVENT, + ANDROID_NOTIFICATION_DELETED, + ANDROID_NOTIFICATION_ACTION, }; struct android_any_event @@ -535,6 +537,29 @@ struct android_dnd_event size_t length; }; +struct android_notification_event +{ + /* Type of the event. */ + enum android_event_type type; + + /* The event serial. */ + unsigned long serial; + + /* The window that gave rise to the event (None). */ + android_window window; + + /* The identifier of the notification whose status changed. + Must be deallocated with `free'. */ + char *tag; + + /* The action that was activated, if any. Must be deallocated with + `free'. */ + unsigned short *action; + + /* Length of that data. */ + size_t length; +}; + union android_event { enum android_event_type type; @@ -571,6 +596,10 @@ union android_event protocol, whereas there exist several competing X protocols implemented in terms of X client messages. */ struct android_dnd_event dnd; + + /* X provides no equivalent interface for displaying + notifications. */ + struct android_notification_event notification; }; enum diff --git a/src/androidselect.c b/src/androidselect.c index 61f1c6045db..04f4cf1573f 100644 --- a/src/androidselect.c +++ b/src/androidselect.c @@ -30,6 +30,7 @@ along with GNU Emacs. If not, see . */ #include "coding.h" #include "android.h" #include "androidterm.h" +#include "termhooks.h" /* Selection support on Android is confined to copying and pasting of plain text and MIME data from the clipboard. There is no primary @@ -490,6 +491,9 @@ struct android_emacs_desktop_notification /* Methods provided by the EmacsDesktopNotification class. */ static struct android_emacs_desktop_notification notification_class; +/* Hash table pairing notification identifiers with callbacks. */ +static Lisp_Object notification_table; + /* Initialize virtual function IDs and class pointers tied to the EmacsDesktopNotification class. */ @@ -521,7 +525,8 @@ android_init_emacs_desktop_notification (void) FIND_METHOD (init, "", "(Ljava/lang/String;" "Ljava/lang/String;Ljava/lang/String;" - "Ljava/lang/String;II)V"); + "Ljava/lang/String;II[Ljava/lang/String;" + "[Ljava/lang/String;)V"); FIND_METHOD (display, "display", "()V"); #undef FIND_METHOD } @@ -562,25 +567,32 @@ android_locate_icon (const char *name) } /* Display a desktop notification with the provided TITLE, BODY, - REPLACES_ID, GROUP, ICON, and URGENCY. Return an identifier for - the resulting notification. */ + REPLACES_ID, GROUP, ICON, URGENCY, ACTIONS, ACTION_CB and CANCEL_CB. + Return an identifier for the resulting notification. */ static intmax_t android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, Lisp_Object replaces_id, Lisp_Object group, Lisp_Object icon, - Lisp_Object urgency) + Lisp_Object urgency, Lisp_Object actions, + Lisp_Object action_cb, + Lisp_Object cancel_cb) { static intmax_t counter; intmax_t id; jstring title1, body1, group1, identifier1; jint type, icon1; jobject notification; + jobjectArray action_keys, action_titles; char identifier[INT_STRLEN_BOUND (int) + INT_STRLEN_BOUND (long int) + INT_STRLEN_BOUND (intmax_t) + sizeof "..."]; struct timespec boot_time; + Lisp_Object key, value, tem; + jint nitems, i; + jstring item; + Lisp_Object length; if (EQ (urgency, Qlow)) type = 2; /* IMPORTANCE_LOW */ @@ -591,6 +603,29 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, else signal_error ("Invalid notification importance given", urgency); + nitems = 0; + + /* If ACTIONS is provided, split it into two arrays of Java strings + holding keys and titles. */ + + if (!NILP (actions)) + { + /* Count the number of items to be inserted. */ + + length = Flength (actions); + if (!TYPE_RANGED_FIXNUMP (jint, length)) + error ("Action list too long"); + nitems = XFIXNAT (length); + if (nitems & 1) + error ("Length of action list is invalid"); + nitems /= 2; + + /* Verify that the list consists exclusively of strings. */ + tem = actions; + FOR_EACH_TAIL (tem) + CHECK_STRING (XCAR (tem)); + } + if (NILP (replaces_id)) { /* Generate a new identifier. */ @@ -626,14 +661,62 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, = (*android_java_env)->NewStringUTF (android_java_env, identifier); android_exception_check_3 (title1, body1, group1); + /* Create the arrays for action identifiers and titles if + provided. */ + + if (nitems) + { + action_keys = (*android_java_env)->NewObjectArray (android_java_env, + nitems, + java_string_class, + NULL); + android_exception_check_4 (title, body1, group1, identifier1); + action_titles = (*android_java_env)->NewObjectArray (android_java_env, + nitems, + java_string_class, + NULL); + android_exception_check_5 (title, body1, group1, identifier1, + action_keys); + + for (i = 0; i < nitems; ++i) + { + key = XCAR (actions); + value = XCAR (XCDR (actions)); + actions = XCDR (XCDR (actions)); + + /* Create a string for this action. */ + item = android_build_string (key, body1, group1, identifier1, + action_keys, action_titles, NULL); + (*android_java_env)->SetObjectArrayElement (android_java_env, + action_keys, i, + item); + ANDROID_DELETE_LOCAL_REF (item); + + /* Create a string for this title. */ + item = android_build_string (value, body1, group1, identifier1, + action_keys, action_titles, NULL); + (*android_java_env)->SetObjectArrayElement (android_java_env, + action_titles, i, + item); + ANDROID_DELETE_LOCAL_REF (item); + } + } + else + { + action_keys = NULL; + action_titles = NULL; + } + /* Create the notification. */ notification = (*android_java_env)->NewObject (android_java_env, notification_class.class, notification_class.init, title1, body1, group1, - identifier1, icon1, type); - android_exception_check_4 (title1, body1, group1, identifier1); + identifier1, icon1, type, + action_keys, action_titles); + android_exception_check_6 (title1, body1, group1, identifier1, + action_titles, action_keys); /* Delete unused local references. */ ANDROID_DELETE_LOCAL_REF (title1); @@ -641,6 +724,12 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, ANDROID_DELETE_LOCAL_REF (group1); ANDROID_DELETE_LOCAL_REF (identifier1); + if (action_keys) + ANDROID_DELETE_LOCAL_REF (action_keys); + + if (action_titles) + ANDROID_DELETE_LOCAL_REF (action_titles); + /* Display the notification. */ (*android_java_env)->CallNonvirtualVoidMethod (android_java_env, notification, @@ -649,6 +738,12 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, android_exception_check_1 (notification); ANDROID_DELETE_LOCAL_REF (notification); + /* If callbacks are provided, save them into notification_table. */ + + if (!NILP (action_cb) || !NILP (cancel_cb)) + Fputhash (build_string (identifier), Fcons (action_cb, cancel_cb), + notification_table); + /* Return the ID. */ return id; } @@ -659,14 +754,28 @@ DEFUN ("android-notifications-notify", Fandroid_notifications_notify, ARGS must contain keywords followed by values. Each of the following keywords is understood: - :title The notification title. - :body The notification body. - :replaces-id The ID of a previous notification to supersede. - :group The notification group, or nil. - :urgency One of the symbols `low', `normal' or `critical', - defining the importance of the notification group. - :icon The name of a drawable resource to display as the - notification's icon. + :title The notification title. + :body The notification body. + :replaces-id The ID of a previous notification to supersede. + :group The notification group, or nil. + :urgency One of the symbols `low', `normal' or `critical', + defining the importance of the notification group. + :icon The name of a drawable resource to display as the + notification's icon. + :actions A list of actions of the form: + (KEY TITLE KEY TITLE ...) + where KEY and TITLE are both strings. + The action for which CALLBACK is called when the + notification itself is selected is named "default", + its existence is implied, and its TITLE is ignored. + No more than three actions can be defined, not + counting any action with "default" as its key. + :on-action Function to call when an action is invoked. + The notification id and the key of the action are + provided as arguments to the function. + :on-cancel Function to call if the notification is dismissed, + with the notification id and the symbol `undefined' + for arguments. The notification group is ignored on Android 7.1 and earlier versions of Android. Outside such older systems, it identifies a category that @@ -686,6 +795,9 @@ within the "android.R.drawable" class designating an icon with a transparent background. If no icon is provided (or the icon is absent from this system), it defaults to "ic_dialog_alert". +Actions specified with :actions cannot be displayed on Android 4.0 and +earlier versions of the system. + When the system is running Android 13 or later, notifications sent will be silently disregarded unless permission to display notifications is expressly granted from the "App Info" settings panel @@ -701,14 +813,15 @@ usage: (android-notifications-notify &rest ARGS) */) { Lisp_Object title, body, replaces_id, group, urgency; Lisp_Object icon; - Lisp_Object key, value; + Lisp_Object key, value, actions, action_cb, cancel_cb; ptrdiff_t i; if (!android_init_gui) error ("No Android display connection!"); /* Clear each variable above. */ - title = body = replaces_id = group = icon = urgency = Qnil; + title = body = replaces_id = group = icon = urgency = actions = Qnil; + action_cb = cancel_cb = Qnil; /* If NARGS is odd, error. */ @@ -734,6 +847,12 @@ usage: (android-notifications-notify &rest ARGS) */) urgency = value; else if (EQ (key, QCicon)) icon = value; + else if (EQ (key, QCactions)) + actions = value; + else if (EQ (key, QCon_action)) + action_cb = value; + else if (EQ (key, QCon_cancel)) + cancel_cb = value; } /* Demand at least TITLE and BODY be present. */ @@ -758,7 +877,58 @@ usage: (android-notifications-notify &rest ARGS) */) CHECK_STRING (icon); return make_int (android_notifications_notify_1 (title, body, replaces_id, - group, icon, urgency)); + group, icon, urgency, + actions, action_cb, + cancel_cb)); +} + +/* Run callbacks in response to a notification being deleted. + Save any input generated for the keyboard within *IE. + EVENT should be the notification deletion event. */ + +void +android_notification_deleted (struct android_notification_event *event, + struct input_event *ie) +{ + Lisp_Object item, tag; + intmax_t id; + + tag = build_string (event->tag); + item = Fgethash (tag, notification_table, Qnil); + + if (!NILP (item)) + Fremhash (tag, notification_table); + + if (CONSP (item) && FUNCTIONP (XCDR (item)) + && sscanf (event->tag, "%*d.%*ld.%jd", &id) > 0) + { + ie->kind = NOTIFICATION_EVENT; + ie->arg = list3 (XCDR (item), make_int (id), + Qundefined); + } +} + +/* Run callbacks in response to one of a notification's actions being + invoked, saving any input generated for the keyboard within *IE. + EVENT should be the notification deletion event, and ACTION the + action key. */ + +void +android_notification_action (struct android_notification_event *event, + struct input_event *ie, Lisp_Object action) +{ + Lisp_Object item, tag; + intmax_t id; + + tag = build_string (event->tag); + item = Fgethash (tag, notification_table, Qnil); + + if (CONSP (item) && FUNCTIONP (XCAR (item)) + && sscanf (event->tag, "%*d.%*ld.%jd", &id) > 0) + { + ie->kind = NOTIFICATION_EVENT; + ie->arg = list3 (XCAR (item), make_int (id), action); + } } @@ -800,6 +970,9 @@ syms_of_androidselect (void) DEFSYM (QCgroup, ":group"); DEFSYM (QCurgency, ":urgency"); DEFSYM (QCicon, ":icon"); + DEFSYM (QCactions, ":actions"); + DEFSYM (QCon_action, ":on-action"); + DEFSYM (QCon_cancel, ":on-cancel"); DEFSYM (Qlow, "low"); DEFSYM (Qnormal, "normal"); @@ -814,4 +987,7 @@ syms_of_androidselect (void) defsubr (&Sandroid_get_clipboard_data); defsubr (&Sandroid_notifications_notify); + + notification_table = CALLN (Fmake_hash_table, QCtest, Qequal); + staticpro (¬ification_table); } diff --git a/src/androidterm.c b/src/androidterm.c index baf26abe322..f68f8a9ef62 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -1761,6 +1761,26 @@ handle_one_android_event (struct android_display_info *dpyinfo, free (event->dnd.uri_or_string); goto OTHER; + case ANDROID_NOTIFICATION_DELETED: + case ANDROID_NOTIFICATION_ACTION: + + if (event->notification.type == ANDROID_NOTIFICATION_DELETED) + android_notification_deleted (&event->notification, &inev.ie); + else + { + Lisp_Object action; + + action = android_decode_utf16 (event->notification.action, + event->notification.length); + android_notification_action (&event->notification, &inev.ie, + action); + } + + /* Free dynamically allocated data. */ + free (event->notification.tag); + free (event->notification.action); + goto OTHER; + default: goto OTHER; } @@ -4740,7 +4760,7 @@ android_sync_edit (void) /* Return a copy of the specified Java string and its length in *LENGTH. Use the JNI environment ENV. Value is NULL if copying - *the string fails. */ + the string fails. */ static unsigned short * android_copy_java_string (JNIEnv *env, jstring string, size_t *length) diff --git a/src/androidterm.h b/src/androidterm.h index 41c93067e82..ca6929bef0e 100644 --- a/src/androidterm.h +++ b/src/androidterm.h @@ -25,6 +25,7 @@ along with GNU Emacs. If not, see . */ #include "character.h" #include "dispextern.h" #include "font.h" +#include "termhooks.h" struct android_bitmap_record { @@ -464,6 +465,11 @@ extern void syms_of_sfntfont_android (void); #ifndef ANDROID_STUBIFY +extern void android_notification_deleted (struct android_notification_event *, + struct input_event *); +extern void android_notification_action (struct android_notification_event *, + struct input_event *, Lisp_Object); + extern void init_androidselect (void); extern void syms_of_androidselect (void); diff --git a/src/androidvfs.c b/src/androidvfs.c index d618e351204..4bb652f3eb7 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -292,7 +292,7 @@ struct android_parcel_file_descriptor_class }; /* The java.lang.String class. */ -static jclass java_string_class; +jclass java_string_class; /* Fields and methods associated with the Cursor class. */ static struct android_cursor_class cursor_class; diff --git a/src/keyboard.c b/src/keyboard.c index 1ba74a59537..91faf4582fa 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -4187,6 +4187,16 @@ kbd_buffer_get_event (KBOARD **kbp, break; } +#ifdef HAVE_ANDROID + case NOTIFICATION_EVENT: + { + kbd_fetch_ptr = next_kbd_event (event); + input_pending = readable_events (0); + CALLN (Fapply, XCAR (event->ie.arg), XCDR (event->ie.arg)); + break; + } +#endif /* HAVE_ANDROID */ + #ifdef HAVE_EXT_MENU_BAR case MENU_BAR_ACTIVATE_EVENT: { diff --git a/src/termhooks.h b/src/termhooks.h index 8defebb20bd..d828c62ce33 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -343,6 +343,10 @@ enum event_kind the notification that was clicked. */ , NOTIFICATION_CLICKED_EVENT #endif /* HAVE_HAIKU */ +#ifdef HAVE_ANDROID + /* In a NOTIFICATION_EVENT, .arg is a lambda to evaluate. */ + , NOTIFICATION_EVENT +#endif /* HAVE_ANDROID */ }; /* Bit width of an enum event_kind tag at the start of structs and unions. */ -- cgit v1.2.3 From bf38783c32e794e46fd03210242f265f34257940 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 12 Mar 2024 08:51:52 +0800 Subject: Fix notification cancellation detection on Android * java/org/gnu/emacs/EmacsDesktopNotification.java (display1): Don't specify FLAG_ONE_SHOT in cancel intents. --- java/org/gnu/emacs/EmacsDesktopNotification.java | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/java/org/gnu/emacs/EmacsDesktopNotification.java b/java/org/gnu/emacs/EmacsDesktopNotification.java index f52c3d9d4fb..d05ed2e6203 100644 --- a/java/org/gnu/emacs/EmacsDesktopNotification.java +++ b/java/org/gnu/emacs/EmacsDesktopNotification.java @@ -281,11 +281,9 @@ public final class EmacsDesktopNotification if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.S) pending = PendingIntent.getBroadcast (context, 0, intent, - (PendingIntent.FLAG_IMMUTABLE - | PendingIntent.FLAG_ONE_SHOT)); + PendingIntent.FLAG_IMMUTABLE); else - pending = PendingIntent.getBroadcast (context, 0, intent, - PendingIntent.FLAG_ONE_SHOT); + pending = PendingIntent.getBroadcast (context, 0, intent, 0); notification.deleteIntent = pending; manager.notify (tag, 2, notification); -- cgit v1.2.3 From d7ded996082503ca00546c220c7ce8d96e16b76a Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 12 Mar 2024 09:48:53 +0800 Subject: Implement notification residency on Android * doc/lispref/os.texi (Desktop Notifications): Document support for `:resident'. * java/org/gnu/emacs/EmacsService.java (cancelNotification): * src/android.c (android_init_emacs_service): * src/android.h (struct android_emacs_service): New function. * src/androidselect.c (android_notifications_notify_1) (Fandroid_notifications_notify): New parameter QCresident; save it within notification lists. (android_notification_deleted, android_notification_action): Adjust for changes to the format of notification lists and cancel non-resident notifications when an action is selected. (syms_of_androidselect): : New symbol. --- doc/lispref/os.texi | 6 ++-- java/org/gnu/emacs/EmacsService.java | 25 ++++++++++++++++ src/android.c | 2 ++ src/android.h | 1 + src/androidselect.c | 55 ++++++++++++++++++++++++++++-------- 5 files changed, 75 insertions(+), 14 deletions(-) diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index ecd88a39489..65c5ed2b4cc 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -3244,11 +3244,13 @@ of parameters analogous to its namesake in @item :on-action @var{on-action} @item :on-cancel @var{on-cancel} @item :actions @var{actions} +@item :resident @var{resident} These have the same meaning as they do when used in calls to -@code{notifications-notify}. +@code{notifications-notify}, except that no more than three non-default +actions will be displayed. @item :urgency @var{urgency} -The set of values for @var{urgency} is the same as with +The set of accepted values for @var{urgency} is the same as with @code{notifications-notify}, but the urgency applies to all notifications displayed with the defined @var{group}, except under Android 7.1 and earlier. diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index d17ba597d8e..9bc40d63311 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -1967,4 +1967,29 @@ public final class EmacsService extends Service else requestStorageAccess30 (); } + + + + /* Notification miscellany. */ + + /* Cancel any notification displayed with the tag TAG. */ + + public void + cancelNotification (final String string) + { + Object tem; + final NotificationManager manager; + + tem = getSystemService (Context.NOTIFICATION_SERVICE); + manager = (NotificationManager) tem; + + runOnUiThread (new Runnable () { + @Override + public void + run () + { + manager.cancel (string, 2); + } + }); + } }; diff --git a/src/android.c b/src/android.c index 125bb5209c3..dcd5c6d99c7 100644 --- a/src/android.c +++ b/src/android.c @@ -1688,6 +1688,8 @@ android_init_emacs_service (void) "externalStorageAvailable", "()Z"); FIND_METHOD (request_storage_access, "requestStorageAccess", "()V"); + FIND_METHOD (cancel_notification, + "cancelNotification", "(Ljava/lang/String;)V"); #undef FIND_METHOD } diff --git a/src/android.h b/src/android.h index ee634a3e76c..2ca3d7e1446 100644 --- a/src/android.h +++ b/src/android.h @@ -302,6 +302,7 @@ struct android_emacs_service jmethodID valid_authority; jmethodID external_storage_available; jmethodID request_storage_access; + jmethodID cancel_notification; }; extern JNIEnv *android_java_env; diff --git a/src/androidselect.c b/src/androidselect.c index 04f4cf1573f..bcb7bcd2c3b 100644 --- a/src/androidselect.c +++ b/src/androidselect.c @@ -567,15 +567,15 @@ android_locate_icon (const char *name) } /* Display a desktop notification with the provided TITLE, BODY, - REPLACES_ID, GROUP, ICON, URGENCY, ACTIONS, ACTION_CB and CANCEL_CB. - Return an identifier for the resulting notification. */ + REPLACES_ID, GROUP, ICON, URGENCY, ACTIONS, RESIDENT, ACTION_CB and + CANCEL_CB. Return an identifier for the resulting notification. */ static intmax_t android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, Lisp_Object replaces_id, Lisp_Object group, Lisp_Object icon, Lisp_Object urgency, Lisp_Object actions, - Lisp_Object action_cb, + Lisp_Object resident, Lisp_Object action_cb, Lisp_Object cancel_cb) { static intmax_t counter; @@ -740,8 +740,9 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, /* If callbacks are provided, save them into notification_table. */ - if (!NILP (action_cb) || !NILP (cancel_cb)) - Fputhash (build_string (identifier), Fcons (action_cb, cancel_cb), + if (!NILP (action_cb) || !NILP (cancel_cb) || !NILP (resident)) + Fputhash (build_string (identifier), list3 (action_cb, cancel_cb, + resident), notification_table); /* Return the ID. */ @@ -755,12 +756,12 @@ ARGS must contain keywords followed by values. Each of the following keywords is understood: :title The notification title. - :body The notification body. + :body The notification body. :replaces-id The ID of a previous notification to supersede. :group The notification group, or nil. :urgency One of the symbols `low', `normal' or `critical', defining the importance of the notification group. - :icon The name of a drawable resource to display as the + :icon The name of a drawable resource to display as the notification's icon. :actions A list of actions of the form: (KEY TITLE KEY TITLE ...) @@ -770,6 +771,8 @@ keywords is understood: its existence is implied, and its TITLE is ignored. No more than three actions can be defined, not counting any action with "default" as its key. + :resident When set the notification will not be automatically + dismissed when it or an action is selected. :on-action Function to call when an action is invoked. The notification id and the key of the action are provided as arguments to the function. @@ -811,7 +814,7 @@ this function. usage: (android-notifications-notify &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { - Lisp_Object title, body, replaces_id, group, urgency; + Lisp_Object title, body, replaces_id, group, urgency, resident; Lisp_Object icon; Lisp_Object key, value, actions, action_cb, cancel_cb; ptrdiff_t i; @@ -821,7 +824,7 @@ usage: (android-notifications-notify &rest ARGS) */) /* Clear each variable above. */ title = body = replaces_id = group = icon = urgency = actions = Qnil; - action_cb = cancel_cb = Qnil; + resident = action_cb = cancel_cb = Qnil; /* If NARGS is odd, error. */ @@ -849,6 +852,8 @@ usage: (android-notifications-notify &rest ARGS) */) icon = value; else if (EQ (key, QCactions)) actions = value; + else if (EQ (key, QCresident)) + resident = value; else if (EQ (key, QCon_action)) action_cb = value; else if (EQ (key, QCon_cancel)) @@ -878,8 +883,8 @@ usage: (android-notifications-notify &rest ARGS) */) return make_int (android_notifications_notify_1 (title, body, replaces_id, group, icon, urgency, - actions, action_cb, - cancel_cb)); + actions, resident, + action_cb, cancel_cb)); } /* Run callbacks in response to a notification being deleted. @@ -899,7 +904,7 @@ android_notification_deleted (struct android_notification_event *event, if (!NILP (item)) Fremhash (tag, notification_table); - if (CONSP (item) && FUNCTIONP (XCDR (item)) + if (CONSP (item) && FUNCTIONP (XCAR (XCDR (item))) && sscanf (event->tag, "%*d.%*ld.%jd", &id) > 0) { ie->kind = NOTIFICATION_EVENT; @@ -919,6 +924,8 @@ android_notification_action (struct android_notification_event *event, { Lisp_Object item, tag; intmax_t id; + jstring tag_object; + jmethodID method; tag = build_string (event->tag); item = Fgethash (tag, notification_table, Qnil); @@ -929,6 +936,29 @@ android_notification_action (struct android_notification_event *event, ie->kind = NOTIFICATION_EVENT; ie->arg = list3 (XCAR (item), make_int (id), action); } + + /* Test whether ITEM is resident. Non-resident notifications must be + removed when activated. */ + + if (!CONSP (item) || NILP (XCAR (XCDR (XCDR (item))))) + { + method = service_class.cancel_notification; + tag_object + = (*android_java_env)->NewStringUTF (android_java_env, + event->tag); + android_exception_check (); + + (*android_java_env)->CallNonvirtualVoidMethod (android_java_env, + emacs_service, + service_class.class, + method, tag_object); + android_exception_check_1 (tag_object); + ANDROID_DELETE_LOCAL_REF (tag_object); + + /* Remove the notification from the callback table. */ + if (!NILP (item)) + Fremhash (tag, notification_table); + } } @@ -971,6 +1001,7 @@ syms_of_androidselect (void) DEFSYM (QCurgency, ":urgency"); DEFSYM (QCicon, ":icon"); DEFSYM (QCactions, ":actions"); + DEFSYM (QCresident, ":resident"); DEFSYM (QCon_action, ":on-action"); DEFSYM (QCon_cancel, ":on-cancel"); -- cgit v1.2.3 From fd33b637e986e7ec1c34a1358b5c71e31db95c11 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 12 Mar 2024 09:54:54 +0800 Subject: ; Fix omission from last change * src/androidselect.c (android_notification_deleted): Adjust for changed notification list format. --- src/androidselect.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/androidselect.c b/src/androidselect.c index bcb7bcd2c3b..a5a4c4c2e59 100644 --- a/src/androidselect.c +++ b/src/androidselect.c @@ -908,7 +908,7 @@ android_notification_deleted (struct android_notification_event *event, && sscanf (event->tag, "%*d.%*ld.%jd", &id) > 0) { ie->kind = NOTIFICATION_EVENT; - ie->arg = list3 (XCDR (item), make_int (id), + ie->arg = list3 (XCAR (XCDR (item)), make_int (id), Qundefined); } } -- cgit v1.2.3 From 7ea3a464036f123f70d89b4571afcdeb3e650688 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 12 Mar 2024 09:58:51 +0800 Subject: Resolve inconsistency between Android and XDG notifications * doc/lispref/os.texi (Desktop Notifications): * src/androidselect.c (android_notifications_notify_1) (Fandroid_notifications_notify, android_notification_action) (syms_of_androidselect): Rename `:on-cancel' to `:on-close'. --- doc/lispref/os.texi | 2 +- src/androidselect.c | 22 +++++++++++----------- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 65c5ed2b4cc..435886320fd 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -3242,7 +3242,7 @@ of parameters analogous to its namesake in @item :body @var{body} @item :replaces-id @var{replaces-id} @item :on-action @var{on-action} -@item :on-cancel @var{on-cancel} +@item :on-cancel @var{on-close} @item :actions @var{actions} @item :resident @var{resident} These have the same meaning as they do when used in calls to diff --git a/src/androidselect.c b/src/androidselect.c index a5a4c4c2e59..521133976a7 100644 --- a/src/androidselect.c +++ b/src/androidselect.c @@ -568,7 +568,7 @@ android_locate_icon (const char *name) /* Display a desktop notification with the provided TITLE, BODY, REPLACES_ID, GROUP, ICON, URGENCY, ACTIONS, RESIDENT, ACTION_CB and - CANCEL_CB. Return an identifier for the resulting notification. */ + CLOSE_CB. Return an identifier for the resulting notification. */ static intmax_t android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, @@ -576,7 +576,7 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, Lisp_Object group, Lisp_Object icon, Lisp_Object urgency, Lisp_Object actions, Lisp_Object resident, Lisp_Object action_cb, - Lisp_Object cancel_cb) + Lisp_Object close_cb) { static intmax_t counter; intmax_t id; @@ -740,8 +740,8 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, /* If callbacks are provided, save them into notification_table. */ - if (!NILP (action_cb) || !NILP (cancel_cb) || !NILP (resident)) - Fputhash (build_string (identifier), list3 (action_cb, cancel_cb, + if (!NILP (action_cb) || !NILP (close_cb) || !NILP (resident)) + Fputhash (build_string (identifier), list3 (action_cb, close_cb, resident), notification_table); @@ -776,7 +776,7 @@ keywords is understood: :on-action Function to call when an action is invoked. The notification id and the key of the action are provided as arguments to the function. - :on-cancel Function to call if the notification is dismissed, + :on-close Function to call if the notification is dismissed, with the notification id and the symbol `undefined' for arguments. @@ -816,7 +816,7 @@ usage: (android-notifications-notify &rest ARGS) */) { Lisp_Object title, body, replaces_id, group, urgency, resident; Lisp_Object icon; - Lisp_Object key, value, actions, action_cb, cancel_cb; + Lisp_Object key, value, actions, action_cb, close_cb; ptrdiff_t i; if (!android_init_gui) @@ -824,7 +824,7 @@ usage: (android-notifications-notify &rest ARGS) */) /* Clear each variable above. */ title = body = replaces_id = group = icon = urgency = actions = Qnil; - resident = action_cb = cancel_cb = Qnil; + resident = action_cb = close_cb = Qnil; /* If NARGS is odd, error. */ @@ -856,8 +856,8 @@ usage: (android-notifications-notify &rest ARGS) */) resident = value; else if (EQ (key, QCon_action)) action_cb = value; - else if (EQ (key, QCon_cancel)) - cancel_cb = value; + else if (EQ (key, QCon_close)) + close_cb = value; } /* Demand at least TITLE and BODY be present. */ @@ -884,7 +884,7 @@ usage: (android-notifications-notify &rest ARGS) */) return make_int (android_notifications_notify_1 (title, body, replaces_id, group, icon, urgency, actions, resident, - action_cb, cancel_cb)); + action_cb, close_cb)); } /* Run callbacks in response to a notification being deleted. @@ -1003,7 +1003,7 @@ syms_of_androidselect (void) DEFSYM (QCactions, ":actions"); DEFSYM (QCresident, ":resident"); DEFSYM (QCon_action, ":on-action"); - DEFSYM (QCon_cancel, ":on-cancel"); + DEFSYM (QCon_close, ":on-close"); DEFSYM (Qlow, "low"); DEFSYM (Qnormal, "normal"); -- cgit v1.2.3 From 2704ec54fd3e33a0914b06ad762be42c4956110d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 11 Mar 2024 21:51:29 -0400 Subject: (gnus-convert-old-newsrc): Remove ancient converters * lisp/gnus/gnus-start.el (gnus-convert-old-newsrc): Remove converters from 2004 and before. * lisp/gnus/legacy-gnus-agent.el: Delete file. --- lisp/gnus/gnus-start.el | 18 +-- lisp/gnus/legacy-gnus-agent.el | 260 ----------------------------------------- 2 files changed, 10 insertions(+), 268 deletions(-) delete mode 100644 lisp/gnus/legacy-gnus-agent.el diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index f337278994c..05ad4303b5c 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -2285,14 +2285,16 @@ If FORCE is non-nil, the .newsrc file is read." ;; doesn't change with each release) and the ;; function that must be applied to convert the ;; previous version into the current version. - '(("September Gnus v0.1" nil - gnus-convert-old-ticks) - ("Oort Gnus v0.08" "legacy-gnus-agent" - gnus-agent-convert-to-compressed-agentview) - ("Gnus v5.10.7" "legacy-gnus-agent" - gnus-agent-unlist-expire-days) - ("Gnus v5.10.7" "legacy-gnus-agent" - gnus-agent-unhook-expire-days))) + '(;;These all date back to 2004 or earlier! + ;; ("September Gnus v0.1" nil + ;; gnus-convert-old-ticks) + ;; ("Oort Gnus v0.08" "legacy-gnus-agent" + ;; gnus-agent-convert-to-compressed-agentview) + ;; ("Gnus v5.10.7" "legacy-gnus-agent" + ;; gnus-agent-unlist-expire-days) + ;; ("Gnus v5.10.7" "legacy-gnus-agent" + ;; gnus-agent-unhook-expire-days) + )) #'car-less-than-car))) ;; Skip converters older than the file version (while (and converters (>= fcv (caar converters))) diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el deleted file mode 100644 index d4f08c72de8..00000000000 --- a/lisp/gnus/legacy-gnus-agent.el +++ /dev/null @@ -1,260 +0,0 @@ -;;; legacy-gnus-agent.el --- Legacy unplugged support for Gnus -*- lexical-binding: t; -*- - -;; Copyright (C) 2004-2024 Free Software Foundation, Inc. - -;; Author: Kevin Greiner -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; Conversion functions for the Agent. - -;;; Code: -(require 'gnus-start) -(require 'gnus-util) -(require 'gnus-range) -(require 'gnus-agent) - -;; Oort Gnus v0.08 - This release updated agent to no longer use -;; history file and to support a compressed alist. - -(defvar gnus-agent-compressed-agentview-search-only nil) - -(defun gnus-agent-convert-to-compressed-agentview (converting-to) - "Iterates over all agentview files to ensure that they have been -converted to the compressed format." - - (let ((search-in (list gnus-agent-directory)) - here - members - member - converted-something) - (while (setq here (pop search-in)) - (setq members (directory-files here t)) - (while (setq member (pop members)) - (cond ((string-match "/\\.\\.?$" member) - nil) - ((file-directory-p member) - (push member search-in)) - ((equal (file-name-nondirectory member) ".agentview") - (setq converted-something - (or (gnus-agent-convert-agentview member) - converted-something)))))) - - (if converted-something - (gnus-message 4 "Successfully converted Gnus %s offline (agent) files to %s" gnus-newsrc-file-version converting-to)))) - -(defun gnus-agent-convert-to-compressed-agentview-prompt () - (catch 'found-file-to-convert - (let ((gnus-agent-compressed-agentview-search-only t)) - (gnus-agent-convert-to-compressed-agentview nil)))) - -(gnus-convert-mark-converter-prompt 'gnus-agent-convert-to-compressed-agentview 'gnus-agent-convert-to-compressed-agentview-prompt) - -(defun gnus-agent-convert-agentview (file) - "Load FILE and do a `read' there." - (with-temp-buffer - (nnheader-insert-file-contents file) - (goto-char (point-min)) - (let ((inhibit-quit t) - (alist (read (current-buffer))) - (version (condition-case nil (read (current-buffer)) - (end-of-file 0))) - changed-version - history-file) - - (cond - ((= version 0) - (let (entry - (gnus-command-method nil)) - (mm-disable-multibyte) ;; everything is binary - (erase-buffer) - (insert "\n") - (let ((file (concat (file-name-directory file) "/history"))) - (when (file-exists-p file) - (nnheader-insert-file-contents file) - (setq history-file file))) - - (goto-char (point-min)) - (while (not (eobp)) - (if (and (looking-at - "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)") - (string= (gnus-agent-article-name ".agentview" (match-string 2)) - file) - (setq entry (assoc (string-to-number (match-string 3)) alist))) - (setcdr entry (string-to-number (match-string 1)))) - (forward-line 1)) - (setq changed-version t))) - ((= version 1) - (setq changed-version t))) - - (when changed-version - (when gnus-agent-compressed-agentview-search-only - (throw 'found-file-to-convert t)) - - (erase-buffer) - (let (article-id day-of-download comp-list compressed) - (while alist - (setq article-id (caar alist) - day-of-download (cdar alist) - comp-list (assq day-of-download compressed) - alist (cdr alist)) - (if comp-list - (setcdr comp-list (cons article-id (cdr comp-list))) - (push (list day-of-download article-id) compressed))) - (setq alist compressed) - (while alist - (setq comp-list (pop alist)) - (setcdr comp-list - (gnus-compress-sequence (nreverse (cdr comp-list))))) - (princ compressed (current-buffer))) - (insert "\n2\n") - (write-file file) - (when history-file - (delete-file history-file)) - t)))) - -;; End of Oort Gnus v0.08 updates - -;; No Gnus v0.3 - This release provides a mechanism for upgrading gnus -;; from previous versions. Therefore, the previous -;; hacks to handle a gnus-agent-expire-days that -;; specifies a list of values can be removed. - -(defun gnus-agent-unlist-expire-days (converting-to) - (when (listp gnus-agent-expire-days) - (let (buffer) - (unwind-protect - (save-window-excursion - (setq buffer (gnus-get-buffer-create " *Gnus agent upgrade*")) - (set-buffer buffer) - (erase-buffer) - (insert "The definition of gnus-agent-expire-days has been changed.\nYou currently have it set to the list:\n ") - (gnus-pp gnus-agent-expire-days) - - (insert - (format-message - "\nIn order to use version `%s' of gnus, you will need to set\n" - converting-to)) - (insert "gnus-agent-expire-days to an integer. If you still wish to set different\n") - (insert "expiration days to individual groups, you must instead set the\n") - (insert (format-message - "`agent-days-until-old' group and/or topic parameter.\n")) - (insert "\n") - (insert "If you would like, gnus can iterate over every group comparing its name to the\n") - (insert "regular expressions that you currently have in gnus-agent-expire-days. When\n") - (insert (format-message - "gnus finds a match, it will update that group's `agent-days-until-old' group\n")) - (insert "parameter to the value associated with the regular expression.\n") - (insert "\n") - (insert "Whether gnus assigns group parameters, or not, gnus will terminate with an\n") - (insert "ERROR as soon as this function completes. The reason is that you must\n") - (insert "manually edit your configuration to either not set gnus-agent-expire-days or\n") - (insert "to set it to an integer before gnus can be used.\n") - (insert "\n") - (insert "Once you have successfully edited gnus-agent-expire-days, gnus will be able to\n") - (insert "execute past this function.\n") - (insert "\n") - (insert "Should gnus use gnus-agent-expire-days to assign\n") - (insert "agent-days-until-old parameters to individual groups? (Y/N)") - - (switch-to-buffer buffer) - (beep) - (beep) - - (let ((echo-keystrokes 0) - c) - (while (progn (setq c (read-char-exclusive)) - (cond ((or (eq c ?y) (eq c ?Y)) - (save-excursion - (let ((groups (gnus-group-listed-groups))) - (while groups - (let* ((group (pop groups)) - (days gnus-agent-expire-days) - (day (catch 'found - (while days - (when (eq 0 (string-match - (caar days) - group)) - (throw 'found (cadr (car days)))) - (setq days (cdr days))) - nil))) - (when day - (gnus-group-set-parameter group 'agent-days-until-old - day)))))) - nil - ) - ((or (eq c ?n) (eq c ?N)) - nil) - (t - t)))))) - (kill-buffer buffer)) - (error "Change gnus-agent-expire-days to an integer for gnus to start")))) - -;; The gnus-agent-unlist-expire-days has its own conversion prompt. -;; Therefore, hide the default prompt. -(gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t) - -(defun gnus-agent-unhook-expire-days (_converting-to) - "Remove every lambda from `gnus-group-prepare-hook' that mention the -symbol `gnus-agent-do-once' in their definition. This should NOT be -necessary as gnus-agent.el no longer adds them. However, it is -possible that the hook was persistently saved." - (let ((h t)) ; Iterate from bgn of hook. - (while h - (let ((func (progn (when (eq h t) - ;; Init h to list of functions. - (setq h (cond ((listp gnus-group-prepare-hook) - gnus-group-prepare-hook) - ((boundp 'gnus-group-prepare-hook) - (list gnus-group-prepare-hook))))) - (pop h)))) - - (when (cond ((byte-code-function-p func) - ;; Search def. of compiled function for - ;; gnus-agent-do-once string. - (let* (definition - print-level - print-length - (standard-output - (lambda (char) - (setq definition (cons char definition))))) - (princ func) ; Populates definition with reversed list - ; of characters. - (let* ((i (length definition)) - (s (make-string i 0))) - (while definition - (aset s (setq i (1- i)) (pop definition))) - - (string-match "\\bgnus-agent-do-once\\b" s)))) - ((listp func) - (eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; Handles eval'd lambda. - )) - - (remove-hook 'gnus-group-prepare-hook func) - ;; I don't what remove-hook is going to actually do to the - ;; hook list so start over from the beginning. - (setq h t)))))) - -;; gnus-agent-unhook-expire-days is safe in that it does not modify -;; the .newsrc.eld file. -(gnus-convert-mark-converter-prompt 'gnus-agent-unhook-expire-days t) - -(provide 'legacy-gnus-agent) - -;;; legacy-gnus-agent.el ends here -- cgit v1.2.3 From fd293c7c67d03204356be3cd6a0cb565dec9ecbf Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 12 Mar 2024 10:46:00 +0800 Subject: ; Check in missing change to AndroidManifest.xml.in * java/AndroidManifest.xml.in: Register CancellationReceiver. --- java/AndroidManifest.xml.in | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/java/AndroidManifest.xml.in b/java/AndroidManifest.xml.in index 27af9c912fe..4d23c752747 100644 --- a/java/AndroidManifest.xml.in +++ b/java/AndroidManifest.xml.in @@ -316,6 +316,13 @@ along with GNU Emacs. If not, see . --> + + + + + + Date: Tue, 12 Mar 2024 12:24:59 +0800 Subject: Fix CheckJNI crash on Android 2.2 * src/androidfns.c (syms_of_androidfns_for_pdumper): Don't free local reference to script name if nonexistent. --- src/androidfns.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/androidfns.c b/src/androidfns.c index 0675a0a3c98..83cf81c1f07 100644 --- a/src/androidfns.c +++ b/src/androidfns.c @@ -3398,9 +3398,9 @@ syms_of_androidfns_for_pdumper (void) string, data); } } - } - ANDROID_DELETE_LOCAL_REF (string); + ANDROID_DELETE_LOCAL_REF (string); + } /* And variant. */ -- cgit v1.2.3 From d5773276fb1671da619eeee2c316098d6b1c25c4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 12 Mar 2024 08:48:09 -0400 Subject: (comp-known-predicates): Fix overly optimistic `functionp` * lisp/emacs-lisp/comp.el (comp-known-predicates): `functionp` can also be true for `cons` objects. --- lisp/emacs-lisp/comp.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 21e2bb01ed0..9c2182092cb 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -202,7 +202,7 @@ Useful to hook into pass checkers.") (consp . cons) (floatp . float) (framep . frame) - (functionp . (or function symbol)) + (functionp . (or function symbol cons)) (hash-table-p . hash-table) (integer-or-marker-p . integer-or-marker) (integerp . integer) @@ -244,6 +244,7 @@ Useful to hook into pass checkers.") (defun comp--pred-to-cstr (predicate) "Given PREDICATE, return the corresponding constraint." + ;; FIXME: Unify those two hash tables? (or (gethash predicate comp-known-predicates-h) (gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt)))) -- cgit v1.2.3 From 7c552b22e64fa9173557e3511aa4e37ac1d5ea59 Mon Sep 17 00:00:00 2001 From: Daniel Pettersson Date: Wed, 28 Feb 2024 13:03:56 +0100 Subject: Jsonrpc: improve performance of process filter function `run-at-time' keeps `timer-list' list sorted by inserting each timer based on the timer value. This means that `timer--time-less-p' needs is executed ~N*N/2 times for each N pending messages. This means that jsonrpc becomes unusable for connections that generate a lot messages at the same time. * lisp/jsonrpc.el (Version): Bump to 1.0.25. (jsonrpc--process-filter): Improve performance by activating timers in a different order. (Bug#69241) --- lisp/jsonrpc.el | 28 +++++++++++++++++++--------- 1 file changed, 19 insertions(+), 9 deletions(-) diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 14fe0447008..5037d8c5b2b 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -4,7 +4,7 @@ ;; Author: João Távora ;; Keywords: processes, languages, extensions -;; Version: 1.0.24 +;; Version: 1.0.25 ;; Package-Requires: ((emacs "25.2")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -760,10 +760,11 @@ With optional CLEANUP, kill any associated buffers." (setq message (plist-put message :jsonrpc-json (buffer-string))) - (process-put proc 'jsonrpc-mqueue - (nconc (process-get proc - 'jsonrpc-mqueue) - (list message))))) + ;; Put new messages at the front of the queue, + ;; this is correct as the order is reversed + ;; before putting the timers on `timer-list'. + (push message + (process-get proc 'jsonrpc-mqueue)))) (goto-char message-end) (let ((inhibit-read-only t)) (delete-region (point-min) (point))) @@ -782,11 +783,20 @@ With optional CLEANUP, kill any associated buffers." ;; non-locally (typically the reply to a request), so do ;; this all this processing in top-level loops timer. (cl-loop + ;; `timer-activate' orders timers by time, which is an + ;; very expensive operation when jsonrpc-mqueue is large, + ;; therefore the time object is reused for each timer + ;; created. + with time = (current-time) for msg = (pop (process-get proc 'jsonrpc-mqueue)) while msg - do (run-at-time 0 nil - (lambda (m) (with-temp-buffer - (jsonrpc-connection-receive conn m))) - msg))))))) + do (let ((timer (timer-create))) + (timer-set-time timer time) + (timer-set-function timer + (lambda (conn msg) + (with-temp-buffer + (jsonrpc-connection-receive conn msg))) + (list conn msg)) + (timer-activate timer)))))))) (defun jsonrpc--remove (conn id &optional deferred-spec) "Cancel CONN's continuations for ID, including its timer, if it exists. -- cgit v1.2.3 From 0cc44094613530744d3650e4a169335374d6727b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 12 Mar 2024 15:30:18 +0200 Subject: ; * admin/MAINTAINERS: Add Daniel Pettersson. --- admin/MAINTAINERS | 3 +++ 1 file changed, 3 insertions(+) diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index f59c684e81f..ec719744339 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -360,6 +360,9 @@ Po Lu X11 and GTK xwidget support in src/xwidget.c Precision pixel scrolling in lisp/pixel-scroll.el +Daniel Pettersson + lisp/jsonrpc.el + ============================================================================== 3. Externally maintained packages. ============================================================================== -- cgit v1.2.3 From a9be5c7ea92e7868873d6d3c721d5a0be62ee3ad Mon Sep 17 00:00:00 2001 From: Arash Esbati Date: Tue, 12 Mar 2024 12:53:32 +0100 Subject: ; * doc/lispref/control.texi (Conditionals): Add missing paren (bug#69742). --- doc/lispref/control.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index eb1640ede52..292086ee4e0 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -322,7 +322,7 @@ described below. @defmac if-let spec then-form else-forms... Evaluate each binding in @var{spec} in turn, like in @code{let*} -(@pxref{Local Variables}, stopping if a binding value is @code{nil}. +(@pxref{Local Variables}), stopping if a binding value is @code{nil}. If all are non-@code{nil}, return the value of @var{then-form}, otherwise the last form in @var{else-forms}. @end defmac -- cgit v1.2.3 From 3e96dd4f8851a45c66ebc9b8666ae449cc4c2725 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 12 Mar 2024 12:00:17 -0400 Subject: cl-generic: Signal an error when a type specializer won't work * lisp/emacs-lisp/cl-generic.el (cl--generic--unreachable-types): New var. (cl-generic-generalizers :extra "typeof"): Use it to signal an error for those types we can't handle. --- lisp/emacs-lisp/cl-generic.el | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 84eb800ec24..613ecf82a92 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1332,6 +1332,12 @@ These match if the argument is `eql' to VAL." ;;; Dispatch on "normal types". +(defconst cl--generic--unreachable-types + ;; FIXME: Try to make that list empty? + '(fixnum bignum boolean keyword + special-form subr-primitive subr-native-elisp) + "Built-in classes on which we cannot dispatch for technical reasons.") + (defun cl--generic-type-specializers (tag &rest _) (and (symbolp tag) (let ((class (cl--find-class tag))) @@ -1352,6 +1358,8 @@ This currently works for built-in types and types built on top of records." (and (symbolp type) (not (eq type t)) ;; Handled by the `t-generalizer'. (let ((class (cl--find-class type))) + (when (memq type cl--generic--unreachable-types) + (error "Dispatch on %S is currently not supported" type)) (memq (type-of class) '(built-in-class cl-structure-class eieio--class))) (list cl--generic-typeof-generalizer)) -- cgit v1.2.3 From 8df673907781bce8b080b91b056cb9987587387c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 12 Mar 2024 15:43:43 -0400 Subject: Cleanup some type predicates Use the new `cl--define-built-in-type` to reduce the manually maintained list of built-in type predicates. Also tweak docstrings to use "supertype" rather than "super type", since it seems to be what we use elsewhere. * lisp/subr.el (special-form-p): Remove redundant `fboundp` test. (compiled-function-p): Don'Return nil for subrs that aren't functions. * lisp/emacs-lisp/cl-macs.el (type predicates): Trim down the list. * lisp/emacs-lisp/cl-preloaded.el (cl--define-built-in-type): Register the corresponding predicate if applicable. (atom, null): Specify the predicate name explicitly. --- lisp/emacs-lisp/cl-macs.el | 45 +++++------------------------------- lisp/emacs-lisp/cl-preloaded.el | 51 ++++++++++++++++++++++++++--------------- lisp/emacs-lisp/oclosure.el | 2 +- lisp/subr.el | 6 ++--- 4 files changed, 42 insertions(+), 62 deletions(-) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index be477b7a6df..129b83c61b9 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3463,45 +3463,12 @@ Of course, we really can't know that for sure, so it's just a heuristic." ;; Please keep it in sync with `comp-known-predicates'. (pcase-dolist (`(,type . ,pred) ;; Mostly kept in alphabetical order. - '((array . arrayp) - (atom . atom) - (base-char . characterp) - (bignum . bignump) - (boolean . booleanp) - (bool-vector . bool-vector-p) - (buffer . bufferp) - (byte-code-function . byte-code-function-p) - (character . natnump) - (char-table . char-table-p) - (command . commandp) - (compiled-function . compiled-function-p) - (hash-table . hash-table-p) - (cons . consp) - (fixnum . fixnump) - (float . floatp) - (frame . framep) - (function . functionp) - (integer . integerp) - (keyword . keywordp) - (list . listp) - (marker . markerp) - (natnum . natnump) - (number . numberp) - (null . null) - (obarray . obarrayp) - (overlay . overlayp) - (process . processp) - (real . numberp) - (sequence . sequencep) - (subr . subrp) - (string . stringp) - (symbol . symbolp) - (symbol-with-pos . symbol-with-pos-p) - (vector . vectorp) - (window . windowp) - ;; FIXME: Do we really want to consider these types? - (number-or-marker . number-or-marker-p) - (integer-or-marker . integer-or-marker-p) + ;; These aren't defined via `cl--define-built-in-type'. + '((base-char . characterp) ;Could be subtype of `fixnum'. + (character . natnump) ;Could be subtype of `fixnum'. + (command . commandp) ;Subtype of closure & subr. + (natnum . natnump) ;Subtype of fixnum & bignum. + (real . numberp) ;Not clear where it would fit. )) (put type 'cl-deftype-satisfies pred)) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 5743684fa89..515aa99549d 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -308,7 +308,7 @@ (:copier nil)) ) -(defmacro cl--define-built-in-type (name parents &optional docstring &rest _slots) +(defmacro cl--define-built-in-type (name parents &optional docstring &rest slots) ;; `slots' is currently unused, but we could make it take ;; a list of "slot like properties" together with the corresponding ;; accessor, and then we could maybe even make `slot-value' work @@ -317,15 +317,26 @@ (unless (listp parents) (setq parents (list parents))) (unless (or parents (eq name t)) (error "Missing parents for %S: %S" name parents)) - `(progn - (put ',name 'cl--class - (built-in-class--make ',name ,docstring - (mapcar (lambda (type) - (let ((class (get type 'cl--class))) - (unless class - (error "Unknown type: %S" type)) - class)) - ',parents))))) + (let ((predicate (intern-soft (format + (if (string-match "-" (symbol-name name)) + "%s-p" "%sp") + name)))) + (unless (fboundp predicate) (setq predicate nil)) + (while (keywordp (car slots)) + (let ((kw (pop slots)) (val (pop slots))) + (pcase kw + (:predicate (setq predicate val)) + (_ (error "Unknown keyword arg: %S" kw))))) + `(progn + ,(if predicate `(put ',name 'cl-deftype-satisfies #',predicate)) + (put ',name 'cl--class + (built-in-class--make ',name ,docstring + (mapcar (lambda (type) + (let ((class (get type 'cl--class))) + (unless class + (error "Unknown type: %S" type)) + class)) + ',parents)))))) ;; FIXME: Our type DAG has various quirks: ;; - `subr' says it's a `compiled-function' but that's not true @@ -336,8 +347,9 @@ ;; so the DAG of OClosure types is "orthogonal" to the distinction ;; between interpreted and compiled functions. -(cl--define-built-in-type t nil "The type of everything.") -(cl--define-built-in-type atom t "The type of anything but cons cells.") +(cl--define-built-in-type t nil "Abstract supertype of everything.") +(cl--define-built-in-type atom t "Abstract supertype of anything but cons cells." + :predicate atom) (cl--define-built-in-type tree-sitter-compiled-query atom) (cl--define-built-in-type tree-sitter-node atom) @@ -358,7 +370,7 @@ (cl--define-built-in-type window-configuration atom) (cl--define-built-in-type overlay atom) (cl--define-built-in-type number-or-marker atom - "Abstract super type of both `number's and `marker's.") + "Abstract supertype of both `number's and `marker's.") (cl--define-built-in-type symbol atom "Type of symbols." ;; Example of slots we could document. It would be desirable to @@ -373,14 +385,14 @@ (cl--define-built-in-type obarray atom) (cl--define-built-in-type native-comp-unit atom) -(cl--define-built-in-type sequence t "Abstract super type of sequences.") +(cl--define-built-in-type sequence t "Abstract supertype of sequences.") (cl--define-built-in-type list sequence) -(cl--define-built-in-type array (sequence atom) "Abstract super type of arrays.") +(cl--define-built-in-type array (sequence atom) "Abstract supertype of arrays.") (cl--define-built-in-type number (number-or-marker) - "Abstract super type of numbers.") + "Abstract supertype of numbers.") (cl--define-built-in-type float (number)) (cl--define-built-in-type integer-or-marker (number-or-marker) - "Abstract super type of both `integer's and `marker's.") + "Abstract supertype of both `integer's and `marker's.") (cl--define-built-in-type integer (number integer-or-marker)) (cl--define-built-in-type marker (integer-or-marker)) (cl--define-built-in-type bignum (integer) @@ -404,13 +416,14 @@ For this build of Emacs it's %dbit." "Type of special arrays that are indexed by characters.") (cl--define-built-in-type string (array)) (cl--define-built-in-type null (boolean list) ;FIXME: `atom' comes before `list'? - "Type of the nil value.") + "Type of the nil value." + :predicate null) (cl--define-built-in-type cons (list) "Type of cons cells." ;; Example of slots we could document. (car car) (cdr cdr)) (cl--define-built-in-type function (atom) - "Abstract super type of function values.") + "Abstract supertype of function values.") (cl--define-built-in-type compiled-function (function) "Abstract type of functions that have been compiled.") (cl--define-built-in-type byte-code-function (compiled-function) diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index 977d5735171..4da8e61aaa7 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -437,7 +437,7 @@ This has 2 uses: - For compiled code, this is used as a marker which cconv uses to check that immutable fields are indeed not mutated." (if (byte-code-function-p oclosure) - ;; Actually, this should never happen since the `cconv.el' should have + ;; Actually, this should never happen since `cconv.el' should have ;; optimized away the call to this function. oclosure ;; For byte-coded functions, we store the type as a symbol in the docstring diff --git a/lisp/subr.el b/lisp/subr.el index ce933e3bfdc..38a3f6edb34 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4494,8 +4494,7 @@ Otherwise, return nil." (defun special-form-p (object) "Non-nil if and only if OBJECT is a special form." (declare (side-effect-free error-free)) - (if (and (symbolp object) (fboundp object)) - (setq object (indirect-function object))) + (if (symbolp object) (setq object (indirect-function object))) (and (subrp object) (eq (cdr (subr-arity object)) 'unevalled))) (defun plistp (object) @@ -4517,7 +4516,8 @@ Otherwise, return nil." Does not distinguish between functions implemented in machine code or byte-code." (declare (side-effect-free error-free)) - (or (subrp object) (byte-code-function-p object))) + (or (and (subrp object) (not (eq 'unevalled (cdr (subr-arity object))))) + (byte-code-function-p object))) (defun field-at-pos (pos) "Return the field at position POS, taking stickiness etc into account." -- cgit v1.2.3 From 4afafa03704aab0c21e4cb4f028256ecead5f795 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 12 Mar 2024 16:09:23 -0400 Subject: Try and avoid hardcoding lists of function types * lisp/bind-key.el (bind-key--get-binding-description): Show docstrings for compiled functions also. Don't hardcode knowledge about various particular kinds of functions. * lisp/emacs-lisp/bytecomp.el (display-call-tree): Remove special support for functions with a `byte-code` body since we never generate that nowadays. Don't hardcode knowledge about various particular kinds of functions. --- lisp/bind-key.el | 42 +++++++++++++++++++----------------------- lisp/emacs-lisp/bytecomp.el | 15 +++------------ 2 files changed, 22 insertions(+), 35 deletions(-) diff --git a/lisp/bind-key.el b/lisp/bind-key.el index 378ad69b2bc..1e59c75566a 100644 --- a/lisp/bind-key.el +++ b/lisp/bind-key.el @@ -453,31 +453,27 @@ other modes. See `override-global-mode'." (macroexp-progn (bind-keys-form args 'override-global-map))) (defun bind-key--get-binding-description (elem) - (cond - ((listp elem) + (let (doc) (cond - ((memq (car elem) '(lambda function)) - (if (and bind-key-describe-special-forms - (stringp (nth 2 elem))) - (nth 2 elem) - "#")) - ((eq 'closure (car elem)) - (if (and bind-key-describe-special-forms - (stringp (nth 3 elem))) - (nth 3 elem) - "#")) - ((eq 'keymap (car elem)) - "#") + ((symbolp elem) + (cond + ((and bind-key-describe-special-forms (keymapp elem) + ;; FIXME: Is this really ever better than the symbol-name? + ;; FIXME: `variable-documentation' describe what's in + ;; elem's `symbol-value', whereas `elem' here stands for + ;; its `symbol-function'. + (stringp (setq doc (get elem 'variable-documentation)))) + doc) + (t elem))) + ((and bind-key-describe-special-forms (functionp elem) + (stringp (setq doc (documentation elem)))) + doc) ;;FIXME: Keep only the first line? + ((consp elem) + (if (symbolp (car elem)) + (format "#<%s>" (car elem)) + elem)) (t - elem))) - ;; must be a symbol, non-symbol keymap case covered above - ((and bind-key-describe-special-forms (keymapp elem)) - (let ((doc (get elem 'variable-documentation))) - (if (stringp doc) doc elem))) - ((symbolp elem) - elem) - (t - "#"))) + (format "#<%s>" (type-of elem)))))) (defun bind-key--compare-keybindings (l r) (let* ((regex bind-key-segregation-regexp) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index cf0e6d600dd..7af568cfe34 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5536,23 +5536,14 @@ invoked interactively." (if (null f) " ";; shouldn't insert nil then, actually -sk " ")) - ((subrp (setq f (symbol-function f))) - " ") - ((symbolp f) + ((symbolp (setq f (symbol-function f))) ;; An alias. (format " ==> %s" f)) - ((byte-code-function-p f) - "") ((not (consp f)) - "") + (format " <%s>" (type-of f))) ((eq 'macro (car f)) - (if (or (compiled-function-p (cdr f)) - ;; FIXME: Can this still happen? - (assq 'byte-code (cdr (cdr (cdr f))))) + (if (compiled-function-p (cdr f)) " " " ")) - ((assq 'byte-code (cdr (cdr f))) - ;; FIXME: Can this still happen? - "") ((eq 'lambda (car f)) "") (t "???")) -- cgit v1.2.3 From db027a06976ee1bcbe6294e281bd5954dd1052ef Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Tue, 12 Mar 2024 22:47:45 +0100 Subject: ; Fix bibtex-biblatex-field-alist docstring typo. --- lisp/textmodes/bibtex.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 3d155ac87b5..d78dac53516 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -1012,7 +1012,7 @@ if `bibtex-BibTeX-entry-alist' does not define a comment for FIELD." ("volumes" "Total number of volumes of a multi-volume work") ("year" "Year of publication")) "Alist of biblatex fields. -It has the same format as `bibtex-BibTeX-entry-alist'." +It has the same format as `bibtex-BibTeX-field-alist'." :group 'bibtex :version "28.1" :type 'bibtex-field-alist) -- cgit v1.2.3 From 6b40d557c4a9a4152565c1a1b0da49a1aaaec84f Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 13 Mar 2024 10:59:39 +0800 Subject: Port more notification senders to non-XDG systems * doc/lispref/os.texi (Desktop Notifications): Document that `:timeout' is now implemented. * java/org/gnu/emacs/EmacsDesktopNotification.java (EmacsDesktopNotification): New field delay. (display1): Set delay on Android 8.0 and up. * lisp/erc/erc-desktop-notifications.el (erc-notifications-notify): Call Android or Haiku notification functions on those systems. * lisp/gnus/gnus-notifications.el (gnus-notifications-action) (gnus-notification-close): Remove dismissed notifications from the notification to message map. (gnus-notifications-notify): Call android-notifications-notify if possible. * src/androidselect.c (android_init_emacs_desktop_notification): Update accordingly. (android_notifications_notify_1): New argument TIMEOUT. (Fandroid_notifications_notify): New argument QCtimeout. (syms_of_androidselect) : New symbol. --- doc/lispref/os.texi | 1 + java/org/gnu/emacs/EmacsDesktopNotification.java | 10 ++- lisp/erc/erc-desktop-notifications.el | 24 ++++--- lisp/gnus/gnus-notifications.el | 41 ++++++++--- src/androidselect.c | 86 ++++++++++++++++-------- 5 files changed, 115 insertions(+), 47 deletions(-) diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 435886320fd..3ba3da459bf 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -3244,6 +3244,7 @@ of parameters analogous to its namesake in @item :on-action @var{on-action} @item :on-cancel @var{on-close} @item :actions @var{actions} +@item :timeout @var{timeout} @item :resident @var{resident} These have the same meaning as they do when used in calls to @code{notifications-notify}, except that no more than three non-default diff --git a/java/org/gnu/emacs/EmacsDesktopNotification.java b/java/org/gnu/emacs/EmacsDesktopNotification.java index d05ed2e6203..d00b9f2ea22 100644 --- a/java/org/gnu/emacs/EmacsDesktopNotification.java +++ b/java/org/gnu/emacs/EmacsDesktopNotification.java @@ -83,11 +83,16 @@ public final class EmacsDesktopNotification notification. */ public final String[] actions, titles; + /* Delay in miliseconds after which this notification should be + automatically dismissed. */ + public final long delay; + public EmacsDesktopNotification (String title, String content, String group, String tag, int icon, int importance, - String[] actions, String[] titles) + String[] actions, String[] titles, + long delay) { this.content = content; this.title = title; @@ -97,6 +102,7 @@ public final class EmacsDesktopNotification this.importance = importance; this.actions = actions; this.titles = titles; + this.delay = delay; } @@ -191,6 +197,8 @@ public final class EmacsDesktopNotification builder.setContentTitle (title); builder.setContentText (content); builder.setSmallIcon (icon); + builder.setTimeoutAfter (delay); + insertActions (context, builder); notification = builder.build (); } diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el index 2e905097f97..9bb89fbfc81 100644 --- a/lisp/erc/erc-desktop-notifications.el +++ b/lisp/erc/erc-desktop-notifications.el @@ -54,6 +54,9 @@ (defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors +(declare-function haiku-notifications-notify "haikuselect.c") +(declare-function android-notifications-notify "androidselect.c") + (defun erc-notifications-notify (nick msg &optional privp) "Notify that NICK send some MSG, where PRIVP should be non-nil for PRIVMSGs. This will replace the last notification sent with this function." @@ -64,14 +67,19 @@ This will replace the last notification sent with this function." (let* ((channel (if privp (erc-get-buffer nick) (current-buffer))) (title (format "%s in %s" (xml-escape-string nick t) channel)) (body (xml-escape-string (erc-controls-strip msg) t))) - (notifications-notify :bus erc-notifications-bus - :title title - :body body - :replaces-id erc-notifications-last-notification - :app-icon erc-notifications-icon - :actions '("default" "Switch to buffer") - :on-action (lambda (&rest _) - (pop-to-buffer channel))))))) + (funcall (cond ((featurep 'android) + #'android-notifications-notify) + ((featurep 'haiku) + #'haiku-notifications-notify) + (t #'notifications-notify)) + :bus erc-notifications-bus + :title title + :body body + :replaces-id erc-notifications-last-notification + :app-icon erc-notifications-icon + :actions '("default" "Switch to buffer") + :on-action (lambda (&rest _) + (pop-to-buffer channel))))))) (defun erc-notifications-PRIVMSG (_proc parsed) (let ((nick (car (erc-parse-user (erc-response.sender parsed)))) diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el index f34f5ea0e26..9ef21c91627 100644 --- a/lisp/gnus/gnus-notifications.el +++ b/lisp/gnus/gnus-notifications.el @@ -83,27 +83,46 @@ not get notifications." group (delq article (gnus-list-of-unread-articles group))) ;; gnus-group-refresh-group - (gnus-group-update-group group))))))) + (gnus-group-update-group group)))))) + ;; Notifications are removed unless otherwise specified once they (or + ;; an action of theirs) are selected + (assoc-delete-all id gnus-notifications-id-to-msg)) + +(defun gnus-notification-close (id reason) + "Remove ID from the alist of notification identifiers to messages. +REASON is ignored." + (assoc-delete-all id gnus-notifications-id-to-msg)) (defun gnus-notifications-notify (from subject photo-file) "Send a notification about a new mail. Return a notification id if any, or t on success." - (if (fboundp 'notifications-notify) + (if (featurep 'android) (gnus-funcall-no-warning - 'notifications-notify + 'android-notifications-notify :title from :body subject :actions '("read" "Read" "mark-read" "Mark As Read") :on-action 'gnus-notifications-action - :app-icon (gnus-funcall-no-warning - 'image-search-load-path "gnus/gnus.png") - :image-path photo-file - :app-name "Gnus" - :category "email.arrived" + :on-close 'gnus-notifications-close + :group "Email arrivals" :timeout gnus-notifications-timeout) - (message "New message from %s: %s" from subject) - ;; Don't return an id - t)) + (if (fboundp 'notifications-notify) + (gnus-funcall-no-warning + 'notifications-notify + :title from + :body subject + :actions '("read" "Read" "mark-read" "Mark As Read") + :on-action 'gnus-notifications-action + :on-close 'gnus-notifications-close + :app-icon (gnus-funcall-no-warning + 'image-search-load-path "gnus/gnus.png") + :image-path photo-file + :app-name "Gnus" + :category "email.arrived" + :timeout gnus-notifications-timeout) + (message "New message from %s: %s" from subject) + ;; Don't return an id + t))) (declare-function gravatar-retrieve-synchronously "gravatar.el" (mail-address)) diff --git a/src/androidselect.c b/src/androidselect.c index 521133976a7..87dd2c3d079 100644 --- a/src/androidselect.c +++ b/src/androidselect.c @@ -526,7 +526,7 @@ android_init_emacs_desktop_notification (void) FIND_METHOD (init, "", "(Ljava/lang/String;" "Ljava/lang/String;Ljava/lang/String;" "Ljava/lang/String;II[Ljava/lang/String;" - "[Ljava/lang/String;)V"); + "[Ljava/lang/String;J)V"); FIND_METHOD (display, "display", "()V"); #undef FIND_METHOD } @@ -567,16 +567,17 @@ android_locate_icon (const char *name) } /* Display a desktop notification with the provided TITLE, BODY, - REPLACES_ID, GROUP, ICON, URGENCY, ACTIONS, RESIDENT, ACTION_CB and - CLOSE_CB. Return an identifier for the resulting notification. */ + REPLACES_ID, GROUP, ICON, URGENCY, ACTIONS, TIMEOUT, RESIDENT, + ACTION_CB and CLOSE_CB. Return an identifier for the resulting + notification. */ static intmax_t android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, Lisp_Object replaces_id, Lisp_Object group, Lisp_Object icon, Lisp_Object urgency, Lisp_Object actions, - Lisp_Object resident, Lisp_Object action_cb, - Lisp_Object close_cb) + Lisp_Object timeout, Lisp_Object resident, + Lisp_Object action_cb, Lisp_Object close_cb) { static intmax_t counter; intmax_t id; @@ -593,6 +594,7 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, jint nitems, i; jstring item; Lisp_Object length; + jlong timeout_val; if (EQ (urgency, Qlow)) type = 2; /* IMPORTANCE_LOW */ @@ -603,6 +605,23 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, else signal_error ("Invalid notification importance given", urgency); + /* Decode the timeout. */ + + timeout_val = 0; + + if (!NILP (timeout)) + { + CHECK_INTEGER (timeout); + + if (!integer_to_intmax (timeout, &id) + || id > TYPE_MAXIMUM (jlong) + || id < TYPE_MINIMUM (jlong)) + signal_error ("Invalid timeout", timeout); + + if (id > 0) + timeout_val = id; + } + nitems = 0; /* If ACTIONS is provided, split it into two arrays of Java strings @@ -714,7 +733,8 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, notification_class.init, title1, body1, group1, identifier1, icon1, type, - action_keys, action_titles); + action_keys, action_titles, + timeout_val); android_exception_check_6 (title1, body1, group1, identifier1, action_titles, action_keys); @@ -723,12 +743,8 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, ANDROID_DELETE_LOCAL_REF (body1); ANDROID_DELETE_LOCAL_REF (group1); ANDROID_DELETE_LOCAL_REF (identifier1); - - if (action_keys) - ANDROID_DELETE_LOCAL_REF (action_keys); - - if (action_titles) - ANDROID_DELETE_LOCAL_REF (action_titles); + ANDROID_DELETE_LOCAL_REF (action_keys); + ANDROID_DELETE_LOCAL_REF (action_titles); /* Display the notification. */ (*android_java_env)->CallNonvirtualVoidMethod (android_java_env, @@ -769,8 +785,14 @@ keywords is understood: The action for which CALLBACK is called when the notification itself is selected is named "default", its existence is implied, and its TITLE is ignored. - No more than three actions can be defined, not - counting any action with "default" as its key. + No more than three actions defined here will be + displayed, not counting any with "default" as its + key. + :timeout Number of miliseconds from the display of the + notification at which it will be automatically + dismissed, or a value of zero or smaller if it + is to remain until user action is taken to dismiss + it. :resident When set the notification will not be automatically dismissed when it or an action is selected. :on-action Function to call when an action is invoked. @@ -780,12 +802,15 @@ keywords is understood: with the notification id and the symbol `undefined' for arguments. -The notification group is ignored on Android 7.1 and earlier versions -of Android. Outside such older systems, it identifies a category that -will be displayed in the system Settings menu, and the urgency -provided always extends to affect all notifications displayed within -that category. If the group is not provided, it defaults to the -string "Desktop Notifications". +The notification group and timeout are ignored on Android 7.1 and +earlier versions of Android. On more recent versions, the urgency +identifies a category that will be displayed in the system Settings +menu, and the urgency provided always extends to affect all +notifications displayed within that category, though it may be ignored +if higher than any previously-specified urgency or if the user have +already configured a different urgency for this category from Settings. +If the group is not provided, it defaults to the string "Desktop +Notifications" with the urgency suffixed. Each caller should strive to provide one unchanging combination of notification group and urgency for each kind of notification it sends, @@ -795,8 +820,8 @@ first notification sent to its notification group. The provided icon should be the name of a "drawable resource" present within the "android.R.drawable" class designating an icon with a -transparent background. If no icon is provided (or the icon is absent -from this system), it defaults to "ic_dialog_alert". +transparent background. Should no icon be provided (or the icon is +absent from this system), it defaults to "ic_dialog_alert". Actions specified with :actions cannot be displayed on Android 4.0 and earlier versions of the system. @@ -814,17 +839,18 @@ this function. usage: (android-notifications-notify &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { - Lisp_Object title, body, replaces_id, group, urgency, resident; + Lisp_Object title, body, replaces_id, group, urgency, timeout, resident; Lisp_Object icon; Lisp_Object key, value, actions, action_cb, close_cb; ptrdiff_t i; + AUTO_STRING (default_icon, "ic_dialog_alert"); if (!android_init_gui) error ("No Android display connection!"); /* Clear each variable above. */ title = body = replaces_id = group = icon = urgency = actions = Qnil; - resident = action_cb = close_cb = Qnil; + timeout = resident = action_cb = close_cb = Qnil; /* If NARGS is odd, error. */ @@ -852,6 +878,8 @@ usage: (android-notifications-notify &rest ARGS) */) icon = value; else if (EQ (key, QCactions)) actions = value; + else if (EQ (key, QCtimeout)) + timeout = value; else if (EQ (key, QCresident)) resident = value; else if (EQ (key, QCon_action)) @@ -874,16 +902,19 @@ usage: (android-notifications-notify &rest ARGS) */) urgency = Qlow; if (NILP (group)) - group = build_string ("Desktop Notifications"); + { + AUTO_STRING (format, "Desktop Notifications (%s importance)"); + group = CALLN (Fformat, format, urgency); + } if (NILP (icon)) - icon = build_string ("ic_dialog_alert"); + icon = default_icon; else CHECK_STRING (icon); return make_int (android_notifications_notify_1 (title, body, replaces_id, group, icon, urgency, - actions, resident, + actions, timeout, resident, action_cb, close_cb)); } @@ -1001,6 +1032,7 @@ syms_of_androidselect (void) DEFSYM (QCurgency, ":urgency"); DEFSYM (QCicon, ":icon"); DEFSYM (QCactions, ":actions"); + DEFSYM (QCtimeout, ":timeout"); DEFSYM (QCresident, ":resident"); DEFSYM (QCon_action, ":on-action"); DEFSYM (QCon_close, ":on-close"); -- cgit v1.2.3 From 4ac4cec652ffaca4333d8f297b8a6c0e5bd79c68 Mon Sep 17 00:00:00 2001 From: Gerd Möllmann Date: Sat, 9 Mar 2024 15:06:29 +0100 Subject: Prevent freezes on macOS (bug#69561) * src/nsterm.m (ns_select_1): Store pending input_events. Always call [NSApp run]. --- src/nsterm.m | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/src/nsterm.m b/src/nsterm.m index f094b145fe3..f161edc4ac2 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -4739,12 +4739,15 @@ ns_select_1 (int nfds, fd_set *readfds, fd_set *writefds, check_native_fs (); #endif - if (hold_event_q.nr > 0 && !run_loop_only) + /* If there are input events pending, store them so that Emacs can + recognize C-g. (And we must make sure [NSApp run] is called in + this function, so that C-g has a chance to land in + hold_event_q.) */ + if (hold_event_q.nr > 0) { - /* We already have events pending. */ - raise (SIGIO); - errno = EINTR; - return -1; + for (int i = 0; i < hold_event_q.nr; ++i) + kbd_buffer_store_event_hold (&hold_event_q.q[i], NULL); + hold_event_q.nr = 0; } eassert (nfds <= FD_SETSIZE); @@ -4757,8 +4760,8 @@ ns_select_1 (int nfds, fd_set *readfds, fd_set *writefds, if (NSApp == nil || ![NSThread isMainThread] || (timeout && timeout->tv_sec == 0 && timeout->tv_nsec == 0)) - return thread_select (pselect, nfds, readfds, writefds, - exceptfds, timeout, sigmask); + thread_select (pselect, nfds, readfds, writefds, + exceptfds, timeout, sigmask); else { struct timespec t = {0, 0}; -- cgit v1.2.3 From e7e285ec348c8c19b1ce06a52b89baec71956d7a Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 13 Mar 2024 15:33:24 +0800 Subject: Fix crash when displaying notifications on Android 3.0 * java/org/gnu/emacs/EmacsDesktopNotification.java (display1): Don't call setPriority until Jelly Bean. --- java/org/gnu/emacs/EmacsDesktopNotification.java | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/java/org/gnu/emacs/EmacsDesktopNotification.java b/java/org/gnu/emacs/EmacsDesktopNotification.java index d00b9f2ea22..d072994df2b 100644 --- a/java/org/gnu/emacs/EmacsDesktopNotification.java +++ b/java/org/gnu/emacs/EmacsDesktopNotification.java @@ -228,10 +228,12 @@ public final class EmacsDesktopNotification builder.setContentTitle (title); builder.setContentText (content); builder.setSmallIcon (icon); - builder.setPriority (priority); if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.JELLY_BEAN) - insertActions (context, builder); + { + builder.setPriority (priority); + insertActions (context, builder); + } notification = builder.build (); -- cgit v1.2.3 From c5945e0f9eaf01e653d5afbce72837a05e3e347a Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Wed, 13 Mar 2024 07:38:49 -0700 Subject: Fix name of gnus-notification(s)-close; ignore argument * lisp/gnus/gnus-notifications.el (gnus-notifications-close): Original name was probably a typo. --- lisp/gnus/gnus-notifications.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el index 9ef21c91627..35f90ebfe40 100644 --- a/lisp/gnus/gnus-notifications.el +++ b/lisp/gnus/gnus-notifications.el @@ -88,7 +88,7 @@ not get notifications." ;; an action of theirs) are selected (assoc-delete-all id gnus-notifications-id-to-msg)) -(defun gnus-notification-close (id reason) +(defun gnus-notifications-close (id _reason) "Remove ID from the alist of notification identifiers to messages. REASON is ignored." (assoc-delete-all id gnus-notifications-id-to-msg)) -- cgit v1.2.3 From d95f2a882d5f0587a8e02c5be6f0fd005d4a6a43 Mon Sep 17 00:00:00 2001 From: Gerd Möllmann Date: Wed, 13 Mar 2024 20:27:20 +0100 Subject: ns_select fix for macOS terminals (bug#69561) * src/nsterm.m (ns_select_1): Return early for terminals. --- src/nsterm.m | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/nsterm.m b/src/nsterm.m index f161edc4ac2..faf9324402b 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -4757,8 +4757,12 @@ ns_select_1 (int nfds, fd_set *readfds, fd_set *writefds, if (writefds && FD_ISSET(k, writefds)) ++nr; } - if (NSApp == nil - || ![NSThread isMainThread] + /* emacs -nw doesn't have an NSApp, so we're done. */ + if (NSApp == nil) + return thread_select (pselect, nfds, readfds, writefds, exceptfds, + timeout, sigmask); + + if (![NSThread isMainThread] || (timeout && timeout->tv_sec == 0 && timeout->tv_nsec == 0)) thread_select (pselect, nfds, readfds, writefds, exceptfds, timeout, sigmask); -- cgit v1.2.3 From db5c8bda638468f8798c974f4ef4ab3905dbddd3 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 14 Mar 2024 08:24:42 +0800 Subject: ; * java/org/gnu/emacs/EmacsDesktopNotification.java (display1): Another fix. --- java/org/gnu/emacs/EmacsDesktopNotification.java | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/java/org/gnu/emacs/EmacsDesktopNotification.java b/java/org/gnu/emacs/EmacsDesktopNotification.java index d072994df2b..c80aa21b4fe 100644 --- a/java/org/gnu/emacs/EmacsDesktopNotification.java +++ b/java/org/gnu/emacs/EmacsDesktopNotification.java @@ -233,9 +233,10 @@ public final class EmacsDesktopNotification { builder.setPriority (priority); insertActions (context, builder); + notification = builder.build (); } - - notification = builder.build (); + else + notification = builder.getNotification (); if (Build.VERSION.SDK_INT > Build.VERSION_CODES.JELLY_BEAN) notification.priority = priority; -- cgit v1.2.3 From 30bc867aecc59265b6e315acf459f8d79c423bca Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 14 Mar 2024 13:45:48 +0800 Subject: Improve /proc/self/exe substitution on Android * exec/configure.ac (USER_SWORD): New macro. * exec/exec.c (format_pid): Export this function. * exec/exec.h: * exec/trace.c (canon_path): New function. (handle_readlinkat, handle_openat): Test complete file name against /proc/self/exe, and further check for /proc/pid/exe. --- exec/configure.ac | 8 ++++ exec/exec.c | 2 +- exec/exec.h | 1 + exec/trace.c | 121 +++++++++++++++++++++++++++++++++++++++++++++++++----- 4 files changed, 121 insertions(+), 11 deletions(-) diff --git a/exec/configure.ac b/exec/configure.ac index 317250332cb..a473a1dc633 100644 --- a/exec/configure.ac +++ b/exec/configure.ac @@ -122,6 +122,7 @@ AH_TEMPLATE([SYSCALL_RET_REG], [Define to register holding value of system calls AH_TEMPLATE([STACK_POINTER], [Define to register holding the stack pointer.]) AH_TEMPLATE([EXEC_SYSCALL], [Define to number of the `exec' system call.]) AH_TEMPLATE([USER_WORD], [Define to word type used by tracees.]) +AH_TEMPLATE([USER_SWORD], [Define to signed word type used by tracees.]) AH_TEMPLATE([EXEC_64], [Define to 1 if the system utilizes 64-bit ELF.]) AH_TEMPLATE([STACK_GROWS_DOWNWARDS], [Define to 1 if the stack grows downwards.]) AH_TEMPLATE([ABI_RED_ZONE], [Define to number of reserved bytes past the stack frame.]) @@ -251,6 +252,7 @@ AS_CASE([$host], [x86_64-*linux*], AC_DEFINE([STACK_POINTER], [rsp]) AC_DEFINE([EXEC_SYSCALL], [__NR_execve]) AC_DEFINE([USER_WORD], [uintptr_t]) + AC_DEFINE([USER_SWORD], [intptr_t]) AC_DEFINE([EXEC_64], [1]) AC_DEFINE([ABI_RED_ZONE], [128]) AC_DEFINE([EXECUTABLE_BASE], [0x555555554000]) @@ -283,6 +285,7 @@ AS_CASE([$host], [x86_64-*linux*], AC_DEFINE([STACK_POINTER], [esp]) AC_DEFINE([EXEC_SYSCALL], [__NR_execve]) AC_DEFINE([USER_WORD], [uintptr_t]) + AC_DEFINE([USER_SWORD], [intptr_t]) AC_DEFINE([EXECUTABLE_BASE], [0x0f000000]) AC_DEFINE([INTERPRETER_BASE], [0xaf000000]) AC_DEFINE([STACK_GROWS_DOWNWARDS], [1]) @@ -313,6 +316,7 @@ AS_CASE([$host], [x86_64-*linux*], AC_DEFINE([STACK_POINTER], [sp]) AC_DEFINE([EXEC_SYSCALL], [__NR_execve]) AC_DEFINE([USER_WORD], [uintptr_t]) + AC_DEFINE([USER_SWORD], [intptr_t]) AC_DEFINE([EXEC_64], [1]) AC_DEFINE([EXECUTABLE_BASE], [0x3000000000]) AC_DEFINE([INTERPRETER_BASE], [0x3f00000000]) @@ -344,6 +348,7 @@ AS_CASE([$host], [x86_64-*linux*], AC_DEFINE([STACK_POINTER], [[uregs[13]]]) AC_DEFINE([EXEC_SYSCALL], [__NR_execve]) AC_DEFINE([USER_WORD], [uintptr_t]) + AC_DEFINE([USER_SWORD], [intptr_t]) AC_DEFINE([EXECUTABLE_BASE], [0x0f000000]) AC_DEFINE([INTERPRETER_BASE], [0x1f000000]) AC_DEFINE([STACK_GROWS_DOWNWARDS], [1]) @@ -368,6 +373,7 @@ AS_CASE([$host], [x86_64-*linux*], AC_DEFINE([STACK_POINTER], [[uregs[13]]]) AC_DEFINE([EXEC_SYSCALL], [__NR_execve]) AC_DEFINE([USER_WORD], [uintptr_t]) + AC_DEFINE([USER_SWORD], [intptr_t]) AC_DEFINE([EXECUTABLE_BASE], [0x0f000000]) AC_DEFINE([INTERPRETER_BASE], [0x1f000000]) AC_DEFINE([STACK_GROWS_DOWNWARDS], [1]) @@ -398,6 +404,7 @@ AS_CASE([$host], [x86_64-*linux*], AC_DEFINE([STACK_POINTER], [[gregs[29]]]) # sp AC_DEFINE([EXEC_SYSCALL], [__NR_execve]) AC_DEFINE([USER_WORD], [uintptr_t]) + AC_DEFINE([USER_SWORD], [intptr_t]) AC_DEFINE([EXECUTABLE_BASE], [0x0f000000]) AC_DEFINE([INTERPRETER_BASE], [0x1f000000]) AC_DEFINE([STACK_GROWS_DOWNWARDS], [1]) @@ -427,6 +434,7 @@ AS_CASE([$host], [x86_64-*linux*], AC_DEFINE([STACK_POINTER], [[gregs[29]]]) # sp AC_DEFINE([EXEC_SYSCALL], [__NR_execve]) AC_DEFINE([USER_WORD], [uintptr_t]) + AC_DEFINE([USER_SWORD], [intptr_t]) AC_DEFINE([EXEC_64], [1]) AC_DEFINE([EXECUTABLE_BASE], [0x400000]) AC_DEFINE([INTERPRETER_BASE], [0x3f00000000]) diff --git a/exec/exec.c b/exec/exec.c index 254a983f25f..cbe22d4f18c 100644 --- a/exec/exec.c +++ b/exec/exec.c @@ -865,7 +865,7 @@ insert_args (struct exec_tracee *tracee, USER_REGS_STRUCT *regs, result in *IN, and return a pointer to the byte after the result. REM should be NULL. */ -static char * +char * format_pid (char *in, unsigned int pid) { unsigned int digits[32], *fill; diff --git a/exec/exec.h b/exec/exec.h index ad1b50276c8..3ce06c35311 100644 --- a/exec/exec.h +++ b/exec/exec.h @@ -180,6 +180,7 @@ extern int aarch64_set_regs (pid_t, USER_REGS_STRUCT *, bool); +extern char *format_pid (char *, unsigned int); extern USER_WORD user_alloca (struct exec_tracee *, USER_REGS_STRUCT *, USER_REGS_STRUCT *, USER_WORD); extern int user_copy (struct exec_tracee *, const unsigned char *, diff --git a/exec/trace.c b/exec/trace.c index a7cbda54d68..64dadc092c2 100644 --- a/exec/trace.c +++ b/exec/trace.c @@ -31,6 +31,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include "exec.h" @@ -894,6 +895,68 @@ handle_exec (struct exec_tracee *tracee, USER_REGS_STRUCT *regs) return 3; } +/* Modify BUFFER, of size SIZE, so that it holds the absolute name of + the file identified by BUFFER, relative to the current working + directory of TRACEE if FD be AT_FDCWD, or the file referenced by FD + otherwise. + + Value is 1 if this information is unavailable (of which there are + variety of causes), and 0 on success. */ + +static int +canon_path (struct exec_tracee *tracee, int fd, char *buffer, + ptrdiff_t size) +{ + char link[sizeof "/proc//fd/" + 48], *p; /* Or /proc/pid/cwd. */ + char target[PATH_MAX]; + ssize_t rc, length; + + if (buffer[0] == '/') + /* Absolute file name; return immediately. */ + return 0; + else if (fd == AT_FDCWD) + { + p = stpcpy (link, "/proc/"); + p = format_pid (p, tracee->pid); + stpcpy (p, "/cwd"); + } + else if (fd < 0) + /* Invalid file descriptor. */ + return 1; + else + { + p = stpcpy (link, "/proc/"); + p = format_pid (p, tracee->pid); + p = stpcpy (p, "/fd/"); + format_pid (p, fd); + } + + /* Read LINK's target, and should it be oversized, punt. */ + rc = readlink (link, target, PATH_MAX); + if (rc < 0 || rc >= PATH_MAX) + return 1; + + /* Consider the amount by which BUFFER's existing contents should be + displaced. */ + + length = strlen (buffer) + 1; + if ((length + rc + (target[rc - 1] != '/')) > size) + /* Punt if this would overflow. */ + return 1; + + memmove ((buffer + rc + (target[rc - 1] != '/')), + buffer, length); + + /* Copy the new file name into BUFFER. */ + memcpy (buffer, target, rc); + + /* Insert separator in between if need be. */ + if (target[rc - 1] != '/') + buffer[rc] = '/'; + + return 0; +} + /* Handle a `readlink' or `readlinkat' system call. CALLNO is the system call number, and REGS are the current user @@ -924,22 +987,26 @@ handle_readlinkat (USER_WORD callno, USER_REGS_STRUCT *regs, char buffer[PATH_MAX + 1]; USER_WORD address, return_buffer, size; size_t length; + char proc_pid_exe[sizeof "/proc//exe" + 24], *p; + int dirfd; /* Read the file name. */ #ifdef READLINK_SYSCALL if (callno == READLINK_SYSCALL) { - address = regs->SYSCALL_ARG_REG; + dirfd = AT_FDCWD; + address = regs->SYSCALL_ARG_REG; return_buffer = regs->SYSCALL_ARG1_REG; - size = regs->SYSCALL_ARG2_REG; + size = regs->SYSCALL_ARG2_REG; } else #endif /* READLINK_SYSCALL */ { - address = regs->SYSCALL_ARG1_REG; + dirfd = (USER_SWORD) regs->SYSCALL_ARG_REG; + address = regs->SYSCALL_ARG1_REG; return_buffer = regs->SYSCALL_ARG2_REG; - size = regs->SYSCALL_ARG3_REG; + size = regs->SYSCALL_ARG3_REG; } read_memory (tracee, buffer, PATH_MAX, address); @@ -952,12 +1019,25 @@ handle_readlinkat (USER_WORD callno, USER_REGS_STRUCT *regs, return 1; } - /* Now check if the caller is looking for /proc/self/exe. + /* Expand BUFFER into an absolute file name. TODO: + AT_SYMLINK_FOLLOW? */ + + if (canon_path (tracee, dirfd, buffer, sizeof buffer)) + return 0; + + /* Now check if the caller is looking for /proc/self/exe or its + equivalent with the PID made explicit. dirfd can be ignored, as for now only absolute file names are handled. FIXME. */ - if (strcmp (buffer, "/proc/self/exe") || !tracee->exec_file) + p = stpcpy (proc_pid_exe, "/proc/"); + p = format_pid (p, tracee->pid); + stpcpy (p, "/exe"); + + if ((strcmp (buffer, "/proc/self/exe") + && strcmp (buffer, proc_pid_exe)) + || !tracee->exec_file) return 0; /* Copy over tracee->exec_file. Truncate it to PATH_MAX, length, or @@ -1004,15 +1084,23 @@ handle_openat (USER_WORD callno, USER_REGS_STRUCT *regs, USER_WORD address; size_t length; USER_REGS_STRUCT original; + char proc_pid_exe[sizeof "/proc//exe" + 24], *p; + int dirfd; /* Read the file name. */ #ifdef OPEN_SYSCALL if (callno == OPEN_SYSCALL) - address = regs->SYSCALL_ARG_REG; + { + dirfd = AT_FDCWD; + address = regs->SYSCALL_ARG_REG; + } else #endif /* OPEN_SYSCALL */ - address = regs->SYSCALL_ARG1_REG; + { + dirfd = (USER_SWORD) regs->SYSCALL_ARG_REG; + address = regs->SYSCALL_ARG1_REG; + } /* Read the file name into the buffer and verify that it is NULL terminated. */ @@ -1024,12 +1112,25 @@ handle_openat (USER_WORD callno, USER_REGS_STRUCT *regs, return 1; } - /* Now check if the caller is looking for /proc/self/exe. + /* Expand BUFFER into an absolute file name. TODO: + AT_SYMLINK_FOLLOW? */ + + if (canon_path (tracee, dirfd, buffer, sizeof buffer)) + return 0; + + /* Now check if the caller is looking for /proc/self/exe or its + equivalent with the PID made explicit. dirfd can be ignored, as for now only absolute file names are handled. FIXME. */ - if (strcmp (buffer, "/proc/self/exe") || !tracee->exec_file) + p = stpcpy (proc_pid_exe, "/proc/"); + p = format_pid (p, tracee->pid); + stpcpy (p, "/exe"); + + if ((strcmp (buffer, "/proc/self/exe") + && strcmp (buffer, proc_pid_exe)) + || !tracee->exec_file) return 0; /* Copy over tracee->exec_file. This doesn't correctly handle the -- cgit v1.2.3 From 1b94f800ae34de5f4e72682a81de1d42bdda9276 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 14 Mar 2024 14:21:49 +0800 Subject: * exec/trace.c (rpl_stpcpy): Replace stpcpy if absent. --- exec/trace.c | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/exec/trace.c b/exec/trace.c index 64dadc092c2..05d862f5b9f 100644 --- a/exec/trace.c +++ b/exec/trace.c @@ -895,6 +895,36 @@ handle_exec (struct exec_tracee *tracee, USER_REGS_STRUCT *regs) return 3; } + + +/* Define replacements for required string functions. */ + +#if !defined HAVE_STPCPY || !defined HAVE_DECL_STPCPY + +/* Copy SRC to DEST, returning the address of the terminating '\0' in + DEST. */ + +static char * +rpl_stpcpy (char *dest, const char *src) +{ + register char *d; + register const char *s; + + d = dest; + s = src; + + do + *d++ = *s; + while (*s++ != '\0'); + + return d - 1; +} + +#define stpcpy rpl_stpcpy +#endif /* !defined HAVE_STPCPY || !defined HAVE_DECL_STPCPY */ + + + /* Modify BUFFER, of size SIZE, so that it holds the absolute name of the file identified by BUFFER, relative to the current working directory of TRACEE if FD be AT_FDCWD, or the file referenced by FD -- cgit v1.2.3 From e7b1743b798cab338e0fa7b98dfb20c0ba7204b1 Mon Sep 17 00:00:00 2001 From: Raffael Stocker Date: Mon, 4 Mar 2024 19:06:07 +0100 Subject: Fix resetting keyboard hook state on MS-Windows Register session notifications so Emacs is notified when the computer is being locked, as required to reset the low level keyboard hook state. (Bug#69083). * src/w32term.h: * src/w32fns.c (setup_w32_kbdhook, remove_w32_kbdhook) (w32_wnd_proc, globals_of_w32fns, maybe_pass_notification): Register and manage session notifications in GUI Emacs. * src/w32console.c (initialize_w32_display, find_ime_window): * src/w32xfns.c (drain_message_queue): Register notifications and reset keyboard hook state in console Emacs. * src/w32.c (term_ntproc): Un-register session notifications when terminating. --- src/w32.c | 5 ++++ src/w32console.c | 25 +++++++++++++++-- src/w32fns.c | 84 +++++++++++++++++++++++++++++++++++++++++++++++++++++--- src/w32term.h | 3 +- src/w32xfns.c | 12 ++++++-- 5 files changed, 120 insertions(+), 9 deletions(-) diff --git a/src/w32.c b/src/w32.c index df5465c2135..d34ab70f82d 100644 --- a/src/w32.c +++ b/src/w32.c @@ -10392,11 +10392,16 @@ check_windows_init_file (void) } } +/* from w32fns.c */ +extern void remove_w32_kbdhook (void); + void term_ntproc (int ignored) { (void)ignored; + remove_w32_kbdhook (); + term_timers (); /* shutdown the socket interface if necessary */ diff --git a/src/w32console.c b/src/w32console.c index 0936b5f37e6..7dcbc795cac 100644 --- a/src/w32console.c +++ b/src/w32console.c @@ -659,6 +659,24 @@ w32_face_attributes (struct frame *f, int face_id) return char_attr; } +/* The IME window is needed to receive the session notifications + required to reset the low level keyboard hook state. */ + +static BOOL CALLBACK +find_ime_window (HWND hwnd, LPARAM arg) +{ + char window_class[32]; + + GetClassName (hwnd, window_class, sizeof (window_class)); + if (strcmp (window_class, "IME") == 0) + { + *(HWND *) arg = hwnd; + return FALSE; + } + /* keep looking */ + return TRUE; +} + void initialize_w32_display (struct terminal *term, int *width, int *height) { @@ -818,11 +836,14 @@ initialize_w32_display (struct terminal *term, int *width, int *height) else w32_console_unicode_input = 0; - /* Setup w32_display_info structure for this frame. */ + /* Setup w32_display_info structure for this frame. */ w32_initialize_display_info (build_string ("Console")); + HWND hwnd = NULL; + EnumThreadWindows (GetCurrentThreadId (), find_ime_window, (LPARAM) &hwnd); + /* Set up the keyboard hook. */ - setup_w32_kbdhook (); + setup_w32_kbdhook (hwnd); } diff --git a/src/w32fns.c b/src/w32fns.c index 8d4bd00b91c..3e4a8c475b7 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -49,6 +49,7 @@ along with GNU Emacs. If not, see . */ #ifdef WINDOWSNT #include #include /* for _getmbcp */ +#include /* for WTS(Un)RegisterSessionNotification */ #endif /* WINDOWSNT */ #if CYGWIN @@ -204,6 +205,10 @@ typedef HRESULT (WINAPI * SetWindowTheme_Proc) typedef HRESULT (WINAPI * DwmSetWindowAttribute_Proc) (HWND hwnd, DWORD dwAttribute, IN LPCVOID pvAttribute, DWORD cbAttribute); +typedef BOOL (WINAPI * WTSRegisterSessionNotification_Proc) + (HWND hwnd, DWORD dwFlags); +typedef BOOL (WINAPI * WTSUnRegisterSessionNotification_Proc) (HWND hwnd); + TrackMouseEvent_Proc track_mouse_event_fn = NULL; ImmGetCompositionString_Proc get_composition_string_fn = NULL; ImmGetContext_Proc get_ime_context_fn = NULL; @@ -220,6 +225,8 @@ IsDebuggerPresent_Proc is_debugger_present = NULL; SetThreadDescription_Proc set_thread_description = NULL; SetWindowTheme_Proc SetWindowTheme_fn = NULL; DwmSetWindowAttribute_Proc DwmSetWindowAttribute_fn = NULL; +WTSUnRegisterSessionNotification_Proc WTSUnRegisterSessionNotification_fn = NULL; +WTSRegisterSessionNotification_Proc WTSRegisterSessionNotification_fn = NULL; extern AppendMenuW_Proc unicode_append_menu; @@ -307,6 +314,7 @@ static struct int hook_count; /* counter, if several windows are created */ HHOOK hook; /* hook handle */ HWND console; /* console window handle */ + HWND notified_wnd; /* window that receives session notifications */ int lwindown; /* Left Windows key currently pressed (and hooked) */ int rwindown; /* Right Windows key currently pressed (and hooked) */ @@ -2744,7 +2752,7 @@ funhook (int code, WPARAM w, LPARAM l) /* Set up the hook; can be called several times, with matching remove_w32_kbdhook calls. */ void -setup_w32_kbdhook (void) +setup_w32_kbdhook (HWND hwnd) { kbdhook.hook_count++; @@ -2800,6 +2808,15 @@ setup_w32_kbdhook (void) /* Set the hook. */ kbdhook.hook = SetWindowsHookEx (WH_KEYBOARD_LL, funhook, GetModuleHandle (NULL), 0); + + /* Register session notifications so we get notified about the + computer being locked. */ + kbdhook.notified_wnd = NULL; + if (hwnd != NULL && WTSRegisterSessionNotification_fn != NULL) + { + WTSRegisterSessionNotification_fn (hwnd, NOTIFY_FOR_THIS_SESSION); + kbdhook.notified_wnd = hwnd; + } } } @@ -2811,7 +2828,11 @@ remove_w32_kbdhook (void) if (kbdhook.hook_count == 0 && w32_kbdhook_active) { UnhookWindowsHookEx (kbdhook.hook); + if (kbdhook.notified_wnd != NULL + && WTSUnRegisterSessionNotification_fn != NULL) + WTSUnRegisterSessionNotification_fn (kbdhook.notified_wnd); kbdhook.hook = NULL; + kbdhook.notified_wnd = NULL; } } #endif /* WINDOWSNT */ @@ -2884,13 +2905,12 @@ check_w32_winkey_state (int vkey) } return 0; } -#endif /* WINDOWSNT */ /* Reset the keyboard hook state. Locking the workstation with Win-L leaves the Win key(s) "down" from the hook's point of view - the keyup event is never seen. Thus, this function must be called when the system is locked. */ -static void +void reset_w32_kbdhook_state (void) { kbdhook.lwindown = 0; @@ -2900,6 +2920,7 @@ reset_w32_kbdhook_state (void) kbdhook.suppress_lone = 0; kbdhook.winseen = 0; } +#endif /* WINDOWSNT */ /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish between left and right keys as advertised. We test for this @@ -4129,6 +4150,47 @@ deliver_wm_chars (int do_translate, HWND hwnd, UINT msg, UINT wParam, return 0; } +/* Maybe pass session notification registration to another frame. If + the frame with window handle HWND is deleted, we must pass the + notifications to some other frame, if they have been sent to this + frame before and have not already been passed on. If there is no + other frame, do nothing. */ + +#ifdef WINDOWSNT +static void +maybe_pass_notification (HWND hwnd) +{ + if (hwnd == kbdhook.notified_wnd + && kbdhook.hook_count > 0 && w32_kbdhook_active) + { + Lisp_Object tail, frame; + struct frame *f; + bool found_frame = false; + + FOR_EACH_FRAME (tail, frame) + { + f = XFRAME (frame); + if (FRAME_W32_P (f) && FRAME_OUTPUT_DATA (f) != NULL + && FRAME_W32_WINDOW (f) != hwnd) + { + found_frame = true; + break; + } + } + + if (found_frame && WTSUnRegisterSessionNotification_fn != NULL + && WTSRegisterSessionNotification_fn != NULL) + { + /* There is another frame, pass on the session notification. */ + HWND next_wnd = FRAME_W32_WINDOW (f); + WTSUnRegisterSessionNotification_fn (hwnd); + WTSRegisterSessionNotification_fn (next_wnd, NOTIFY_FOR_THIS_SESSION); + kbdhook.notified_wnd = next_wnd; + } + } +} +#endif /* WINDOWSNT */ + /* Main window procedure */ static LRESULT CALLBACK @@ -5301,23 +5363,29 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) #ifdef WINDOWSNT case WM_CREATE: - setup_w32_kbdhook (); + setup_w32_kbdhook (hwnd); goto dflt; #endif case WM_DESTROY: #ifdef WINDOWSNT + maybe_pass_notification (hwnd); remove_w32_kbdhook (); #endif CoUninitialize (); return 0; +#ifdef WINDOWSNT case WM_WTSSESSION_CHANGE: if (wParam == WTS_SESSION_LOCK) reset_w32_kbdhook_state (); goto dflt; +#endif case WM_CLOSE: +#ifdef WINDOWSNT + maybe_pass_notification (hwnd); +#endif wmsg.dwModifiers = w32_get_modifiers (); my_post_msg (&wmsg, hwnd, msg, wParam, lParam); return 0; @@ -11335,6 +11403,14 @@ globals_of_w32fns (void) set_thread_description = (SetThreadDescription_Proc) get_proc_addr (hm_kernel32, "SetThreadDescription"); +#ifdef WINDOWSNT + HMODULE wtsapi32_lib = LoadLibrary ("wtsapi32.dll"); + WTSRegisterSessionNotification_fn = (WTSRegisterSessionNotification_Proc) + get_proc_addr (wtsapi32_lib, "WTSRegisterSessionNotification"); + WTSUnRegisterSessionNotification_fn = (WTSUnRegisterSessionNotification_Proc) + get_proc_addr (wtsapi32_lib, "WTSUnRegisterSessionNotification"); +#endif + /* Support OS dark mode on Windows 10 version 1809 and higher. See `w32_applytheme' which uses appropriate APIs per version of Windows. For future wretches who may need to understand Windows build numbers: diff --git a/src/w32term.h b/src/w32term.h index 29ace0b2797..3120c8bd71f 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -779,8 +779,9 @@ extern bool w32_image_rotations_p (void); #ifdef WINDOWSNT /* Keyboard hooks. */ -extern void setup_w32_kbdhook (void); +extern void setup_w32_kbdhook (HWND); extern void remove_w32_kbdhook (void); +extern void reset_w32_kbdhook_state (void); extern int check_w32_winkey_state (int); #define w32_kbdhook_active (os_subtype != OS_SUBTYPE_9X) #else diff --git a/src/w32xfns.c b/src/w32xfns.c index fa7d5fbdb61..3d7a1514f72 100644 --- a/src/w32xfns.c +++ b/src/w32xfns.c @@ -413,8 +413,16 @@ drain_message_queue (void) while (PeekMessage (&msg, NULL, 0, 0, PM_REMOVE)) { - if (msg.message == WM_EMACS_FILENOTIFY) - retval = 1; + switch (msg.message) + { + case WM_WTSSESSION_CHANGE: + if (msg.wParam == WTS_SESSION_LOCK) + reset_w32_kbdhook_state (); + break; + case WM_EMACS_FILENOTIFY: + retval = 1; + break; + } TranslateMessage (&msg); DispatchMessage (&msg); } -- cgit v1.2.3 From 7971537d3cdab62f7ce1924cbb2effde73b59b1e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 14 Mar 2024 10:22:52 +0200 Subject: ; Fix last change to compile with mingw.org's MinGW * src/w32xfns.c: * src/w32fns.c (WTS_VIRTUAL_CLASS) [!MINGW_W64]: Declare. * src/w32xfns.c: Include wtsapi32.h. --- src/w32fns.c | 7 +++++++ src/w32xfns.c | 11 +++++++++++ 2 files changed, 18 insertions(+) diff --git a/src/w32fns.c b/src/w32fns.c index 3e4a8c475b7..7d288ce7bd5 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -47,6 +47,13 @@ along with GNU Emacs. If not, see . */ #include "w32inevt.h" #ifdef WINDOWSNT +/* mingw.org's MinGW headers mistakenly omit this enumeration: */ +# ifndef MINGW_W64 +typedef enum _WTS_VIRTUAL_CLASS { + WTSVirtualClientData, + WTSVirtualFileHandle +} WTS_VIRTUAL_CLASS; +# endif #include #include /* for _getmbcp */ #include /* for WTS(Un)RegisterSessionNotification */ diff --git a/src/w32xfns.c b/src/w32xfns.c index 3d7a1514f72..853c8368118 100644 --- a/src/w32xfns.c +++ b/src/w32xfns.c @@ -22,6 +22,17 @@ along with GNU Emacs. If not, see . */ #include #include #include +/* Override API version to get the required functionality. */ +#undef _WIN32_WINNT +#define _WIN32_WINNT 0x0501 +/* mingw.org's MinGW headers mistakenly omit this enumeration: */ +# ifndef MINGW_W64 +typedef enum _WTS_VIRTUAL_CLASS { + WTSVirtualClientData, + WTSVirtualFileHandle +} WTS_VIRTUAL_CLASS; +# endif +#include /* for WM_WTSSESSION_CHANGE, WTS_SESSION_LOCK */ #include "lisp.h" #include "frame.h" -- cgit v1.2.3 From 013114664ef4923872ffad26a97f4d314c9a84bf Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 8 Mar 2024 22:28:52 -0600 Subject: * lisp/emacs-lisp/vtable.el (vtable-update-object): Fix. The order of the arguments to 'seq-position' was wrong, and it did not compare the correct values. (Bug#69664) --- lisp/emacs-lisp/vtable.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 02020552e7f..5cf8d8854bb 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -300,7 +300,9 @@ If it can't be found, return nil and don't move point." (error "Can't find the old object")) (setcar (cdr objects) object)) ;; Then update the cache... - (let* ((line-number (seq-position old-object (car (vtable--cache table)))) + (let* ((line-number (seq-position (car (vtable--cache table)) old-object + (lambda (a b) + (equal (car a) b)))) (line (elt (car (vtable--cache table)) line-number))) (unless line (error "Can't find cached object")) -- cgit v1.2.3 From f6a27bc32d19727dfcbee65fb9894b53aec46c65 Mon Sep 17 00:00:00 2001 From: Noé Lopez Date: Fri, 19 Jan 2024 23:40:53 +0100 Subject: Add user option to disable JavaScript in xwidget webview * src/xwidget.c: Add the 'xwidget-webkit-disable-javascript' variable to disable JavaScript in WebKit sessions. (Bug#68604) * etc/NEWS: * doc/emacs/misc.texi (Embedded Webkit Widgets): Document the change. --- doc/emacs/misc.texi | 8 ++++++++ etc/NEWS | 6 ++++++ lisp/xwidget.el | 7 +++++++ src/xwidget.c | 8 +++++++- 4 files changed, 28 insertions(+), 1 deletion(-) diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 7eb28f56826..bfc86e3c9d4 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -3009,6 +3009,14 @@ buffer, and lets you navigate to those pages by hitting @kbd{RET}. It is bound to @kbd{H}. +@vindex xwidget-webkit-disable-javascript +@cindex disabling javascript in webkit buffers + JavaScript is enabled by default inside WebKit buffers, this can be +undesirable as websites often use it to track your online activity. It +can be disabled by setting the variable @code{xwidget-webkit-disable-javascript} to @code{t}. +You must kill all WebKit buffers for this setting to take effect after +it is changed. + @node Browse-URL @subsection Following URLs @cindex World Wide Web diff --git a/etc/NEWS b/etc/NEWS index 19cd170e5c7..2985169ea91 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1437,6 +1437,12 @@ This allows the user to customize the key selection method, which can be either by using a pop-up buffer or from the minibuffer. The pop-up buffer method is the default, which preserves previous behavior. +** Xwidget Webkit + ++++ +*** New user option 'xwidget-webkit-disable-javascript'. +This allows disabling JavaScript in xwidget Webkit sessions. + * New Modes and Packages in Emacs 30.1 diff --git a/lisp/xwidget.el b/lisp/xwidget.el index cca01c8cb3a..2fb79bb7b1d 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -116,6 +116,13 @@ buffers for this setting to take effect after setting it to nil." :type '(choice (const :tag "Do not store cookies" nil) file) :version "29.1") +(defcustom xwidget-webkit-disable-javascript nil + "If non-nil, disables the execution of JavaScript in xwidget webkit sessions. +You must kill all xwidget-webkit buffers for this setting to take +effect after changing it." + :type '(boolean) + :version "30.0") + ;;;###autoload (defun xwidget-webkit-browse-url (url &optional new-session) "Ask xwidget-webkit to browse URL. diff --git a/src/xwidget.c b/src/xwidget.c index 58910459142..5b82ef6e840 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -22,7 +22,6 @@ along with GNU Emacs. If not, see . */ #include "buffer.h" #include "coding.h" #include "xwidget.h" - #include "lisp.h" #include "blockinput.h" #include "dispextern.h" @@ -379,6 +378,7 @@ fails. */) /* Enable the developer extras. */ settings = webkit_web_view_get_settings (WEBKIT_WEB_VIEW (xw->widget_osr)); g_object_set (G_OBJECT (settings), "enable-developer-extras", TRUE, NULL); + g_object_set (G_OBJECT (settings), "enable-javascript", !xwidget_webkit_disable_javascript, NULL); } gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width, @@ -3972,6 +3972,12 @@ syms_of_xwidget (void) doc: /* List of all xwidget views. */); Vxwidget_view_list = Qnil; + DEFVAR_BOOL("xwidget-webkit-disable-javascript", xwidget_webkit_disable_javascript, + doc: /* If non-nil, disables the execution of JavaScript in xwidget webkit sessions. +You must kill all xwidget-webkit buffers for this setting to take +effect after changing it. */); + xwidget_webkit_disable_javascript = false; + Fprovide (intern ("xwidget-internal"), Qnil); id_to_xwidget_map = CALLN (Fmake_hash_table, QCtest, Qeq, -- cgit v1.2.3 From a60804ab954e0de73a80a217f677142176678465 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 14 Mar 2024 11:32:00 +0200 Subject: ; Fix last change (bug#68604) * lisp/xwidget.el (xwidget-webkit-disable-javascript): Move from here... * lisp/cus-start.el (standard): ...to here. * src/xwidget.c (syms_of_xwidget) : Doc fix. * doc/emacs/misc.texi (Embedded WebKit Widgets): Fix wording. --- doc/emacs/misc.texi | 9 +++++---- lisp/cus-start.el | 4 ++++ lisp/xwidget.el | 7 ------- src/xwidget.c | 6 +++--- 4 files changed, 12 insertions(+), 14 deletions(-) diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index bfc86e3c9d4..8f9ee317080 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -3011,10 +3011,11 @@ It is bound to @kbd{H}. @vindex xwidget-webkit-disable-javascript @cindex disabling javascript in webkit buffers - JavaScript is enabled by default inside WebKit buffers, this can be -undesirable as websites often use it to track your online activity. It -can be disabled by setting the variable @code{xwidget-webkit-disable-javascript} to @code{t}. -You must kill all WebKit buffers for this setting to take effect after + JavaScript is enabled by default inside WebKit buffers, which could be +undesirable, as Web sites often use it to track your online activity. +You can disable JavaScript in WebKit buffers by customizing the variable +@code{xwidget-webkit-disable-javascript} to a non-@code{nil} value. +You must kill all WebKit buffers for this setting to take effect, after it is changed. @node Browse-URL diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 3fe62c8d0da..165296d2242 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -846,6 +846,8 @@ since it could result in memory overflow and make Emacs crash." (x-select-enable-clipboard-manager killing boolean "24.1") ;; xsettings.c (font-use-system-font font-selection boolean "23.2") + ;; xwidget.c + (xwidget-webkit-disable-javascript xwidget boolean "30.1") ;; haikuterm.c (haiku-debug-on-fatal-error debug boolean "29.1") ;; haikufns.c @@ -906,6 +908,8 @@ since it could result in memory overflow and make Emacs crash." (symbol-name symbol)) ;; Any function from fontset.c will do. (fboundp 'new-fontset)) + ((string-match "xwidget-" (symbol-name symbol)) + (boundp 'xwidget-internal)) (t t)))) (if (not (boundp symbol)) ;; If variables are removed from C code, give an error here! diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 2fb79bb7b1d..cca01c8cb3a 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -116,13 +116,6 @@ buffers for this setting to take effect after setting it to nil." :type '(choice (const :tag "Do not store cookies" nil) file) :version "29.1") -(defcustom xwidget-webkit-disable-javascript nil - "If non-nil, disables the execution of JavaScript in xwidget webkit sessions. -You must kill all xwidget-webkit buffers for this setting to take -effect after changing it." - :type '(boolean) - :version "30.0") - ;;;###autoload (defun xwidget-webkit-browse-url (url &optional new-session) "Ask xwidget-webkit to browse URL. diff --git a/src/xwidget.c b/src/xwidget.c index 5b82ef6e840..557b1e60409 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -3973,9 +3973,9 @@ syms_of_xwidget (void) Vxwidget_view_list = Qnil; DEFVAR_BOOL("xwidget-webkit-disable-javascript", xwidget_webkit_disable_javascript, - doc: /* If non-nil, disables the execution of JavaScript in xwidget webkit sessions. -You must kill all xwidget-webkit buffers for this setting to take -effect after changing it. */); + doc: /* If non-nil, disable execution of JavaScript in xwidget webkit sessions. +You must kill all xwidget-webkit buffers for this setting to take effect +after changing it. */); xwidget_webkit_disable_javascript = false; Fprovide (intern ("xwidget-internal"), Qnil); -- cgit v1.2.3 From cb9ee24ea69be4a70f68cb2d564b23a55cb84216 Mon Sep 17 00:00:00 2001 From: Visuwesh Date: Sat, 9 Mar 2024 15:17:26 +0530 Subject: Add bounds-of-thing-at-point property for 'number' * lisp/thingatpt.el (thing-at-point-decimal-regexp) (thing-at-point-hexadecimal-regexp): Extract regexps from... (number-at-point): ...here. Use them in 'number-at-point'. (number): Add 'bounds-of-thing-at-point' property as `forward-word' does not always return the right boundary, e.g., in latex-mode buffers. (Bug#69239) --- lisp/thingatpt.el | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 83ddc640d35..7896ad984df 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -735,20 +735,33 @@ Signal an error if the entire string was not used." (let ((thing (thing-at-point 'symbol))) (if thing (intern thing)))) +(defvar thing-at-point-decimal-regexp + "-?[0-9]+\\.?[0-9]*" + "A regexp matching a decimal number.") + +(defvar thing-at-point-hexadecimal-regexp + "\\(0x\\|#x\\)\\([a-fA-F0-9]+\\)" + "A regexp matchin a hexadecimal number.") + ;;;###autoload (defun number-at-point () "Return the number at point, or nil if none is found. Decimal numbers like \"14\" or \"-14.5\", as well as hex numbers like \"0xBEEF09\" or \"#xBEEF09\", are recognized." (cond - ((thing-at-point-looking-at "\\(0x\\|#x\\)\\([a-fA-F0-9]+\\)" 500) + ((thing-at-point-looking-at thing-at-point-hexadecimal-regexp 500) (string-to-number (buffer-substring (match-beginning 2) (match-end 2)) 16)) - ((thing-at-point-looking-at "-?[0-9]+\\.?[0-9]*" 500) + ((thing-at-point-looking-at thing-at-point-decimal-regexp 500) (string-to-number (buffer-substring (match-beginning 0) (match-end 0)))))) +(put 'number 'bounds-of-thing-at-point + (lambda () + (and (or (thing-at-point-looking-at thing-at-point-hexadecimal-regexp 500) + (thing-at-point-looking-at thing-at-point-decimal-regexp 500)) + (cons (match-beginning 0) (match-end 0))))) (put 'number 'forward-op 'forward-word) (put 'number 'thing-at-point 'number-at-point) -- cgit v1.2.3 From fd0a6cb172dbae8779dae768fa8c475eb0af50ee Mon Sep 17 00:00:00 2001 From: StrawberryTea Date: Sat, 9 Mar 2024 15:37:44 -0600 Subject: ffap.el: Exclude angle brackets from file names in XML * lisp/ffap.el (ffap-string-at-point-mode-alist): Add elements for XML, to better recognize file names in XML buffers. Copyright-paperwork-exempt: yes --- lisp/ffap.el | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lisp/ffap.el b/lisp/ffap.el index 5383f743878..b2b681b7c44 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1065,6 +1065,9 @@ If a given RFC isn't in these then `ffap-rfc-path' is offered." ;; (La)TeX: don't allow braces (latex-mode "--:\\\\$+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:") (tex-mode "--:\\\\$+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:") + ;; XML: don't allow angle brackets + (xml-mode "--:\\\\${}+@-Z_[:alpha:]~*?#" "{<@" "@>;.,!:}") + (nxml-mode "--:\\\\${}+@-Z_[:alpha:]~*?#" "{<@" "@>;.,!:}") ) "Alist of (MODE CHARS BEG END), where MODE is a symbol. This is possibly a major-mode name, or one of the symbols -- cgit v1.2.3 From 3807f380b3334205bfcbba88003ff96507c86fc4 Mon Sep 17 00:00:00 2001 From: Phil Hagelberg Date: Sat, 9 Mar 2024 15:36:11 -0800 Subject: bug#69685: Add language server for Fennel to eglot * lisp/progmodes/eglot.el (eglot-server-programs): Add fennel-ls language server. Copyright-paperwork-exempt: yes --- lisp/progmodes/eglot.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index afe3281361d..4ffaf5f8a0e 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -294,6 +294,7 @@ automatically)." (nickel-mode . ("nls")) ((nushell-mode nushell-ts-mode) . ("nu" "--lsp")) (gdscript-mode . ("localhost" 6008)) + (fennel-mode . ("fennel-ls")) ((fortran-mode f90-mode) . ("fortls")) (futhark-mode . ("futhark" "lsp")) ((lua-mode lua-ts-mode) . ,(eglot-alternatives -- cgit v1.2.3 From 6d1c1fca0aa7c5a1ff0254af3f89a34d5309ea0d Mon Sep 17 00:00:00 2001 From: Tim Landscheidt Date: Tue, 12 Mar 2024 00:21:06 +0000 Subject: ; Simplify (with-current-buffer (get-buffer ...) ...) There's no need to call 'get-buffer', since 'with-current-buffer' does that internally. * lisp/calendar/todo-mode.el (todo-merge-category): * lisp/comint.el (comint-dynamic-list-completions): * lisp/emacs-lisp/checkdoc.el (checkdoc-error): * lisp/emacs-lisp/debug.el (debug, debugger-record-expression): * lisp/emacs-lisp/eieio-opt.el (eieio-browse): * lisp/emacs-lisp/re-builder.el (reb-restart-font-lock): * lisp/erc/erc-dcc.el (erc-dcc-do-LIST-command): * lisp/eshell/em-unix.el (eshell-poor-mans-grep): * lisp/gnus/gnus-group.el (gnus-add-mark): * lisp/net/eww.el (eww-next-bookmark, eww-previous-bookmark): * lisp/net/sieve.el (sieve-upload): * lisp/net/tramp-cmds.el (tramp-cleanup-some-buffers): * lisp/obsolete/quickurl.el (quickurl-list-populate-buffer): * lisp/org/ob-calc.el: (org-babel-execute:calc): * lisp/org/org-agenda.el (org-agenda-use-sticky-p): * lisp/pcomplete.el (pcomplete-show-completions): * lisp/progmodes/bug-reference.el (bug-reference--try-setup-gnus-article): * lisp/progmodes/idlw-help.el (idlwave-highlight-linked-completions): * lisp/progmodes/verilog-mode.el (verilog-preprocess): * lisp/replace.el (occur-1): * lisp/term.el (term-dynamic-list-completions): * lisp/time.el (world-clock-update): * lisp/url/url-cache.el (url-store-in-cache): * lisp/vc/vc-cvs.el (vc-cvs-merge, vc-cvs-merge-news): * lisp/vc/vc-rcs.el (vc-rcs-system-release): * lisp/vc/vc-svn.el (vc-svn-merge, vc-svn-merge-news): * test/lisp/calendar/icalendar-tests.el (icalendar-tests--get-error-string-for-export): * test/lisp/erc/erc-dcc-tests.el (pcomplete/erc-mode/DCC--get-1flag) (pcomplete/erc-mode/DCC--get-2flags) (pcomplete/erc-mode/DCC--get-2flags-reverse): * test/lisp/erc/erc-networks-tests.el (erc-networks--rename-server-buffer--existing--noreuse): * test/lisp/erc/erc-scenarios-services-misc.el (erc-scenarios-services-misc--reconnect-retry-nick): * test/lisp/erc/erc-tests.el (erc--refresh-prompt): Replace (with-current-buffer (get-buffer ...) ...) with (with-current-buffer ...). --- lisp/calendar/todo-mode.el | 8 ++++---- lisp/comint.el | 2 +- lisp/emacs-lisp/checkdoc.el | 2 +- lisp/emacs-lisp/debug.el | 4 ++-- lisp/emacs-lisp/eieio-opt.el | 2 +- lisp/emacs-lisp/re-builder.el | 2 +- lisp/erc/erc-dcc.el | 2 +- lisp/eshell/em-unix.el | 2 +- lisp/gnus/gnus-group.el | 2 +- lisp/net/eww.el | 4 ++-- lisp/net/sieve.el | 2 +- lisp/net/tramp-cmds.el | 2 +- lisp/obsolete/quickurl.el | 2 +- lisp/org/ob-calc.el | 2 +- lisp/org/org-agenda.el | 2 +- lisp/pcomplete.el | 2 +- lisp/progmodes/bug-reference.el | 2 +- lisp/progmodes/idlw-help.el | 2 +- lisp/progmodes/verilog-mode.el | 2 +- lisp/replace.el | 2 +- lisp/term.el | 2 +- lisp/time.el | 2 +- lisp/url/url-cache.el | 2 +- lisp/vc/vc-cvs.el | 4 ++-- lisp/vc/vc-rcs.el | 2 +- lisp/vc/vc-svn.el | 4 ++-- test/lisp/calendar/icalendar-tests.el | 2 +- test/lisp/erc/erc-dcc-tests.el | 6 +++--- test/lisp/erc/erc-networks-tests.el | 2 +- test/lisp/erc/erc-scenarios-services-misc.el | 2 +- test/lisp/erc/erc-tests.el | 2 +- 31 files changed, 40 insertions(+), 40 deletions(-) diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index f2ee94ec8f7..12287299a7f 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -1612,7 +1612,7 @@ archive file and the source category is deleted." (garchive (concat (file-name-sans-extension gfile) ".toda")) (archived-count (todo-get-count 'archived)) here) - (with-current-buffer (get-buffer (find-file-noselect tfile)) + (with-current-buffer (find-file-noselect tfile) (widen) (let* ((inhibit-read-only t) (cbeg (progn @@ -1638,7 +1638,7 @@ archive file and the source category is deleted." (todo-count (todo-get-count 'todo cat)) (done-count (todo-get-count 'done cat))) ;; Merge into goal todo category. - (with-current-buffer (get-buffer (find-file-noselect gfile)) + (with-current-buffer (find-file-noselect gfile) (unless (derived-mode-p 'todo-mode) (todo-mode)) (widen) (goto-char (point-min)) @@ -1677,7 +1677,7 @@ archive file and the source category is deleted." (mapc (lambda (m) (set-marker m nil)) (list cbeg tbeg dbeg tend cend)))) (when (> archived-count 0) - (with-current-buffer (get-buffer (find-file-noselect tarchive)) + (with-current-buffer (find-file-noselect tarchive) (widen) (goto-char (point-min)) (let* ((inhibit-read-only t) @@ -1697,7 +1697,7 @@ archive file and the source category is deleted." (forward-line) (buffer-substring-no-properties (point) cend)))) ;; Merge into goal archive category, if it exists, else create it. - (with-current-buffer (get-buffer (find-file-noselect garchive)) + (with-current-buffer (find-file-noselect garchive) (let ((gbeg (when (re-search-forward (concat "^" (regexp-quote (concat todo-category-beg goal)) diff --git a/lisp/comint.el b/lisp/comint.el index 655ff30469c..a8fe095e99c 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3510,7 +3510,7 @@ the completions." ;; Read the next key, to process SPC. (let (key first) - (if (with-current-buffer (get-buffer "*Completions*") + (if (with-current-buffer "*Completions*" (setq-local comint-displayed-dynamic-completions completions) (setq key (read-key-sequence nil) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 02c11cae573..c22dfb2eb26 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -2794,7 +2794,7 @@ function called to create the messages." ": " msg))) (if (string= checkdoc-diagnostic-buffer "*warn*") (warn (apply #'concat text)) - (with-current-buffer (get-buffer checkdoc-diagnostic-buffer) + (with-current-buffer checkdoc-diagnostic-buffer (let ((inhibit-read-only t) (pt (point-max))) (goto-char pt) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 506b73f6fa2..60d14d11970 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -200,7 +200,7 @@ the debugger will not be entered." (let (debugger-value (debugger-previous-state (if (get-buffer "*Backtrace*") - (with-current-buffer (get-buffer "*Backtrace*") + (with-current-buffer "*Backtrace*" (debugger--save-buffer-state)))) (debugger-args args) (debugger-buffer (get-buffer-create "*Backtrace*")) @@ -651,7 +651,7 @@ Complete list of commands: (princ (debugger-eval-expression exp)) (terpri)) - (with-current-buffer (get-buffer debugger-record-buffer) + (with-current-buffer debugger-record-buffer (message "%s" (buffer-substring (line-beginning-position 0) (line-end-position 0))))) diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index 893f8cd7e7f..bf6be1690e4 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -50,7 +50,7 @@ variable `eieio-default-superclass'." (if (not root-class) (setq root-class 'eieio-default-superclass)) (cl-check-type root-class class) (display-buffer (get-buffer-create "*EIEIO OBJECT BROWSE*") t) - (with-current-buffer (get-buffer "*EIEIO OBJECT BROWSE*") + (with-current-buffer "*EIEIO OBJECT BROWSE*" (erase-buffer) (goto-char 0) (eieio-browse-tree root-class "" "") diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index 0a47cca0231..c5307f70d08 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -825,7 +825,7 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions." (defun reb-restart-font-lock () "Restart `font-lock-mode' to fit current regexp format." - (with-current-buffer (get-buffer reb-buffer) + (with-current-buffer reb-buffer (let ((font-lock-is-on font-lock-mode)) (font-lock-mode -1) (kill-local-variable 'font-lock-set-defaults) diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 522973a0156..b8e16df755b 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -619,7 +619,7 @@ It lists the current state of `erc-dcc-list' in an easy to read manner." (buffer-live-p (get-buffer (plist-get elt :file))) (plist-member elt :size)) (let ((byte-count (with-current-buffer - (get-buffer (plist-get elt :file)) + (plist-get elt :file) (+ (buffer-size) 0.0 erc-dcc-byte-count)))) (format " (%d%%)" diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 23028576f45..751f13cc715 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -789,7 +789,7 @@ available..." (ignore-errors (occur (car args)))) (if (get-buffer "*Occur*") - (with-current-buffer (get-buffer "*Occur*") + (with-current-buffer "*Occur*" (setq string (buffer-string)) (kill-buffer (current-buffer))))) (if string (insert string)) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index d562d052d82..71bfaa639fa 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -4638,7 +4638,7 @@ and the second element is the address." "Mark ARTICLE in GROUP with MARK, whether the group is displayed or not." (let ((buffer (gnus-summary-buffer-name group))) (if (gnus-buffer-live-p buffer) - (with-current-buffer (get-buffer buffer) + (with-current-buffer buffer (gnus-summary-add-mark article mark)) (gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists)) (list article))))) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 2936bc8f099..54847bdf396 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -2267,7 +2267,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks." (setq first t) (eww-read-bookmarks t) (eww-bookmark-prepare)) - (with-current-buffer (get-buffer "*eww bookmarks*") + (with-current-buffer "*eww bookmarks*" (when (and (not first) (not (eobp))) (forward-line 1)) @@ -2286,7 +2286,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks." (setq first t) (eww-read-bookmarks t) (eww-bookmark-prepare)) - (with-current-buffer (get-buffer "*eww bookmarks*") + (with-current-buffer "*eww bookmarks*" (if first (goto-char (point-max)) (beginning-of-line)) diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el index fddc6e21bcc..a6ba556e7ae 100644 --- a/lisp/net/sieve.el +++ b/lisp/net/sieve.el @@ -354,7 +354,7 @@ Used to bracket operations which move point in the sieve-buffer." (let ((script (buffer-string)) (script-name (file-name-sans-extension (buffer-name))) err) - (with-current-buffer (get-buffer sieve-buffer) + (with-current-buffer sieve-buffer (setq err (sieve-manage-putscript (or name sieve-buffer-script-name script-name) script sieve-manage-buffer)) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index a545a8e7273..d3af7a009ec 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -281,7 +281,7 @@ non-nil." ;; Remove all buffers with a remote default-directory which fit the hook. (dolist (name (tramp-list-remote-buffers)) (and (buffer-live-p (get-buffer name)) - (with-current-buffer (get-buffer name) + (with-current-buffer name (run-hook-with-args-until-success 'tramp-cleanup-some-buffers-hook)) (kill-buffer name)))) diff --git a/lisp/obsolete/quickurl.el b/lisp/obsolete/quickurl.el index 7393bebdce1..7da51a8a4a8 100644 --- a/lisp/obsolete/quickurl.el +++ b/lisp/obsolete/quickurl.el @@ -447,7 +447,7 @@ The key bindings for `quickurl-list-mode' are: (defun quickurl-list-populate-buffer () "Populate the `quickurl-list' buffer." - (with-current-buffer (get-buffer quickurl-list-buffer-name) + (with-current-buffer quickurl-list-buffer-name (let* ((sizes (or (cl-loop for url in quickurl-urls collect (length (quickurl-url-description url))) (list 20))) diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el index d335aab7499..f834f05cb6d 100644 --- a/lisp/org/ob-calc.el +++ b/lisp/org/ob-calc.el @@ -93,7 +93,7 @@ (mapcar #'org-trim (split-string (org-babel-expand-body:calc body params) "[\n\r]")))) (save-excursion - (with-current-buffer (get-buffer "*Calculator*") + (with-current-buffer "*Calculator*" (prog1 (calc-eval (calc-top 1)) (calc-pop 1))))) diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index f8195a053bc..06249ed48fa 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -3883,7 +3883,7 @@ generating a new one." ;; buffer found (get-buffer org-agenda-buffer-name) ;; C-u parameter is same as last call - (with-current-buffer (get-buffer org-agenda-buffer-name) + (with-current-buffer org-agenda-buffer-name (and (equal current-prefix-arg org-agenda-last-prefix-arg) diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 196c5f159cd..0b34712a50c 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -1140,7 +1140,7 @@ Typing SPC flushes the help buffer." (let (event) (prog1 (catch 'done - (while (with-current-buffer (get-buffer "*Completions*") + (while (with-current-buffer "*Completions*" (setq event (read-event))) (cond ((eq event ?\s) diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 29ff521253b..977a3d72cb7 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -493,7 +493,7 @@ and set it if applicable." ;; the values of the From, To, and Cc headers. (let (header-values) (with-current-buffer - (get-buffer gnus-original-article-buffer) + gnus-original-article-buffer (save-excursion (goto-char (point-min)) ;; The Newsgroup is omitted because we already matched diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index 217b2ab6691..7bed69a738b 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -631,7 +631,7 @@ Needs additional info stored in global `idlwave-completion-help-info'." Those words in `idlwave-completion-help-links' have links. The `idlwave-help-link' face is used for this." (if idlwave-highlight-help-links-in-completion - (with-current-buffer (get-buffer "*Completions*") + (with-current-buffer "*Completions*" (save-excursion (let* ((case-fold-search t) (props (list 'face 'idlwave-help-link)) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 7af78f2229a..a83bad0e8ed 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -5803,7 +5803,7 @@ FILENAME to find directory to run in, or defaults to `buffer-file-name'." (dir (file-name-directory (or filename buffer-file-name))) (cmd (concat "cd " dir "; " command))) (with-output-to-temp-buffer "*Verilog-Preprocessed*" - (with-current-buffer (get-buffer "*Verilog-Preprocessed*") + (with-current-buffer "*Verilog-Preprocessed*" (insert (concat "// " cmd "\n")) (call-process shell-file-name nil t nil shell-command-switch cmd) (verilog-mode) diff --git a/lisp/replace.el b/lisp/replace.el index 49e7c85c487..01a892bbba7 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1931,7 +1931,7 @@ See also `multi-occur'." (lambda (boo) (buffer-name (if (overlayp boo) (overlay-buffer boo) boo))) active-bufs)) - (with-current-buffer (get-buffer buf-name) + (with-current-buffer buf-name (rename-uniquely))) ;; Now find or create the output buffer. diff --git a/lisp/term.el b/lisp/term.el index 2ce0c2b5e79..3a0ecc041ca 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -4342,7 +4342,7 @@ Typing SPC flushes the help buffer." (display-completion-list (sort completions 'string-lessp))) (message "Hit space to flush") (let (key first) - (if (with-current-buffer (get-buffer "*Completions*") + (if (with-current-buffer "*Completions*" (setq key (read-key-sequence nil) first (aref key 0)) (and (consp first) diff --git a/lisp/time.el b/lisp/time.el index 9b932e945ba..a8d3ab9c813 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -611,7 +611,7 @@ To turn off the world time display, go to the window and type \\[quit-window]." (defun world-clock-update (&optional _arg _noconfirm) "Update the `world-clock' buffer." (if (get-buffer world-clock-buffer-name) - (with-current-buffer (get-buffer world-clock-buffer-name) + (with-current-buffer world-clock-buffer-name (let ((op (point))) (world-clock-display (time--display-world-list)) (goto-char op))) diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el index 0d27321cc47..ce6de2b3ee4 100644 --- a/lisp/url/url-cache.el +++ b/lisp/url/url-cache.el @@ -70,7 +70,7 @@ FILE can be created or overwritten." ;;;###autoload (defun url-store-in-cache (&optional buff) "Store buffer BUFF in the cache." - (with-current-buffer (get-buffer (or buff (current-buffer))) + (with-current-buffer (or buff (current-buffer)) (let ((fname (url-cache-create-filename (url-view-url t)))) (if (url-cache-prepare fname) (let ((coding-system-for-write 'binary)) diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 52039f8da74..63b566b0afe 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -476,7 +476,7 @@ The changes are between FIRST-REVISION and SECOND-REVISION." (concat "-j" first-revision) (concat "-j" second-revision)) (vc-file-setprop file 'vc-state 'edited) - (with-current-buffer (get-buffer "*vc*") + (with-current-buffer "*vc*" (goto-char (point-min)) (if (re-search-forward "conflicts during merge" nil t) (progn @@ -495,7 +495,7 @@ The changes are between FIRST-REVISION and SECOND-REVISION." (vc-cvs-command nil nil file "update") ;; Analyze the merge result reported by CVS, and set ;; file properties accordingly. - (with-current-buffer (get-buffer "*vc*") + (with-current-buffer "*vc*" (goto-char (point-min)) ;; get new working revision (if (re-search-forward diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index 1a43b440d18..33377ce1cc8 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -1177,7 +1177,7 @@ variable `vc-rcs-release' is set to the returned value." (or vc-rcs-release (setq vc-rcs-release (or (and (zerop (vc-do-command "*vc*" nil "rcs" nil "-V")) - (with-current-buffer (get-buffer "*vc*") + (with-current-buffer "*vc*" (vc-parse-buffer "^RCS version \\([0-9.]+ *.*\\)" 1))) 'unknown)))) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 96baa642b44..ae281e54519 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -436,7 +436,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION." (concat first-version ":" second-version) first-version)) (vc-file-setprop file 'vc-state 'edited) - (with-current-buffer (get-buffer "*vc*") + (with-current-buffer "*vc*" (goto-char (point-min)) (if (looking-at "C ") 1 ; signal conflict @@ -450,7 +450,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION." (vc-svn-command nil 0 file "update") ;; Analyze the merge result reported by SVN, and set ;; file properties accordingly. - (with-current-buffer (get-buffer "*vc*") + (with-current-buffer "*vc*" (goto-char (point-min)) ;; get new working revision (if (re-search-forward diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el index 7d3af25ea49..39ad735a789 100644 --- a/test/lisp/calendar/icalendar-tests.el +++ b/test/lisp/calendar/icalendar-tests.el @@ -68,7 +68,7 @@ (with-temp-buffer (insert diary-string) (icalendar-export-region (point-min) (point-max) file)) - (with-current-buffer (get-buffer "*icalendar-errors*") + (with-current-buffer "*icalendar-errors*" (buffer-string)))) ;; ====================================================================== diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el index a2fb0392727..d4b5919a1cc 100644 --- a/test/lisp/erc/erc-dcc-tests.el +++ b/test/lisp/erc/erc-dcc-tests.el @@ -243,7 +243,7 @@ (delete-region (point) (point-max)) (insert "/dcc get -") (call-interactively #'completion-at-point) - (with-current-buffer (get-buffer "*Completions*") + (with-current-buffer "*Completions*" (goto-char (point-min)) (search-forward "-s") (search-forward "-t")) @@ -264,7 +264,7 @@ (delete-region (point) (point-max)) (insert "/dcc get -") (call-interactively #'completion-at-point) - (with-current-buffer (get-buffer "*Completions*") + (with-current-buffer "*Completions*" (goto-char (point-min)) (search-forward "-s") (search-forward "-t")) @@ -289,7 +289,7 @@ (delete-region (point) (point-max)) (insert "/dcc get -") (call-interactively #'completion-at-point) - (with-current-buffer (get-buffer "*Completions*") + (with-current-buffer "*Completions*" (goto-char (point-min)) (search-forward "-s") (search-forward "-t")) diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index 90b8aa99741..0d8861f2167 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el @@ -1349,7 +1349,7 @@ (should-not (erc-server-process-alive (should (get-buffer "#chan/irc.foonet.org")))) - (with-current-buffer (get-buffer "#chan/irc.foonet.org") + (with-current-buffer "#chan/irc.foonet.org" (should-not erc-server-connected) (should (eq erc-server-process old-proc)) (erc-with-server-buffer diff --git a/test/lisp/erc/erc-scenarios-services-misc.el b/test/lisp/erc/erc-scenarios-services-misc.el index ab4a97c5724..47d0bcff41a 100644 --- a/test/lisp/erc/erc-scenarios-services-misc.el +++ b/test/lisp/erc/erc-scenarios-services-misc.el @@ -186,7 +186,7 @@ (funcall expect 10 "Last login from") (funcall expect 10 "Your new nickname is tester"))) - (with-current-buffer (get-buffer "#test") + (with-current-buffer "#test" (funcall expect 10 "tester ") (funcall expect 10 "was created on")))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 6809d9db41d..3e8ddef3731 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -382,7 +382,7 @@ (should-not (search-forward (rx (or "9" "10") ">") nil t))))) (ert-info ("Query buffer") - (with-current-buffer (get-buffer "bob") + (with-current-buffer "bob" (goto-char erc-insert-marker) (should (looking-at-p "bob@ServNet 14>")) (goto-char erc-input-marker) -- cgit v1.2.3 From c94d680f6eb46a47549633c7076fe32660b3cd42 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 12 Mar 2024 16:01:57 -0500 Subject: Handle the case where 'vtable-update-object' doesn't find old object * lisp/emacs-lisp/vtable.el (vtable-update-object): If OLD-OBJECT is not found, don't call ELT, since SEQ-POSITION may return nil. (Bug#69664) --- lisp/emacs-lisp/vtable.el | 44 ++++++++++++++++++++++---------------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 5cf8d8854bb..15a430f5c26 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -300,28 +300,28 @@ If it can't be found, return nil and don't move point." (error "Can't find the old object")) (setcar (cdr objects) object)) ;; Then update the cache... - (let* ((line-number (seq-position (car (vtable--cache table)) old-object - (lambda (a b) - (equal (car a) b)))) - (line (elt (car (vtable--cache table)) line-number))) - (unless line - (error "Can't find cached object")) - (setcar line object) - (setcdr line (vtable--compute-cached-line table object)) - ;; ... and redisplay the line in question. - (save-excursion - (vtable-goto-object old-object) - (let ((keymap (get-text-property (point) 'keymap)) - (start (point))) - (delete-line) - (vtable--insert-line table line line-number - (nth 1 (vtable--cache table)) - (vtable--spacer table)) - (add-text-properties start (point) (list 'keymap keymap - 'vtable table)))) - ;; We may have inserted a non-numerical value into a previously - ;; all-numerical table, so recompute. - (vtable--recompute-numerical table (cdr line))))) + (if-let ((line-number (seq-position (car (vtable--cache table)) old-object + (lambda (a b) + (equal (car a) b)))) + (line (elt (car (vtable--cache table)) line-number))) + (progn + (setcar line object) + (setcdr line (vtable--compute-cached-line table object)) + ;; ... and redisplay the line in question. + (save-excursion + (vtable-goto-object old-object) + (let ((keymap (get-text-property (point) 'keymap)) + (start (point))) + (delete-line) + (vtable--insert-line table line line-number + (nth 1 (vtable--cache table)) + (vtable--spacer table)) + (add-text-properties start (point) (list 'keymap keymap + 'vtable table)))) + ;; We may have inserted a non-numerical value into a previously + ;; all-numerical table, so recompute. + (vtable--recompute-numerical table (cdr line))) + (error "Can't find cached object in vtable")))) (defun vtable-remove-object (table object) "Remove OBJECT from TABLE. -- cgit v1.2.3 From a7057745f5ef903a2655c6d9e7813168e361baf7 Mon Sep 17 00:00:00 2001 From: Liu Hui Date: Mon, 26 Feb 2024 18:46:36 +0800 Subject: Detect the readline support for Python shell completion * lisp/progmodes/python.el (python-shell-comint-watch-for-first-prompt-output-filter): Detect the readline support. (python-shell-readline-completer-delims): Update docstring. (python-shell-completion-native-setup): Move the readline detection code to ... (python-shell-readline-detect): ... new function. (python-shell-completion-native-turn-on-maybe): Skip if Python has no readline support. (python-shell-completion-at-point): Respect the delimiter of readline completer in non-native completion. * test/lisp/progmodes/python-tests.el (python-shell-completion-at-point-1) (python-shell-completion-at-point-native-1) (python-completion-at-point-1, python-completion-at-point-2) (python-completion-at-point-pdb-1) (python-completion-at-point-while-running-1) (python-completion-at-point-native-1) (python-completion-at-point-native-2) (python-completion-at-point-native-with-ffap-1) (python-completion-at-point-native-with-eldoc-1): Skip tests if Python has no readline support. (python-shell-completion-at-point-jedi-completer): Add test for non-native Python shell completion. (bug#68559) --- lisp/progmodes/python.el | 29 ++++++++++++++++++++++------- test/lisp/progmodes/python-tests.el | 31 ++++++++++++++++++++++++++----- 2 files changed, 48 insertions(+), 12 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 1016655cb62..8279617b6e7 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -3601,6 +3601,7 @@ The coding cookie regexp is specified in PEP 263.") (python-shell-send-string-no-output python-shell-eval-file-setup-code)) (with-current-buffer (current-buffer) (let ((inhibit-quit nil)) + (python-shell-readline-detect) (run-hooks 'python-shell-first-prompt-hook)))))) output) @@ -4361,7 +4362,23 @@ When a match is found, native completion is disabled." (defvar python-shell-readline-completer-delims nil "Word delimiters used by the readline completer. -It is automatically set by Python shell.") +It is automatically set by Python shell. An empty string means no +characters are considered delimiters and the readline completion +considers the entire line of input. A value of nil means the Python +shell has no readline support.") + +(defun python-shell-readline-detect () + "Detect the readline support for Python shell completion." + (let* ((process (python-shell-get-process)) + (output (python-shell-send-string-no-output " +try: + import readline + print(readline.get_completer_delims()) +except: + print('No readline support')" process))) + (setq-local python-shell-readline-completer-delims + (unless (string-search "No readline support" output) + (string-trim-right output))))) (defvar python-shell-completion-native-redirect-buffer " *Python completions redirect*" @@ -4501,10 +4518,6 @@ def __PYTHON_EL_native_completion_setup(): __PYTHON_EL_native_completion_setup()" process))) (when (string-match-p "python\\.el: native completion setup loaded" output) - (setq-local python-shell-readline-completer-delims - (string-trim-right - (python-shell-send-string-no-output - "import readline; print(readline.get_completer_delims())"))) (python-shell-completion-native-try)))) (defun python-shell-completion-native-turn-off (&optional msg) @@ -4533,7 +4546,8 @@ With argument MSG show activation/deactivation message." (cond ((python-shell-completion-native-interpreter-disabled-p) (python-shell-completion-native-turn-off msg)) - ((python-shell-completion-native-setup) + ((and python-shell-readline-completer-delims + (python-shell-completion-native-setup)) (when msg (message "Shell native completion is enabled."))) (t @@ -4705,7 +4719,8 @@ using that one instead of current buffer's process." (with-current-buffer (process-buffer process) (if python-shell-completion-native-enable (string= python-shell-readline-completer-delims "") - (string-match-p "ipython[23]?\\'" python-shell-interpreter))))) + (or (string-match-p "ipython[23]?\\'" python-shell-interpreter) + (equal python-shell-readline-completer-delims "")))))) (start (if (< (point) line-start) (point) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 1ceee690cfb..e11440cdb5b 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -4783,6 +4783,7 @@ def foo(): (python-tests-with-temp-buffer-with-shell "" (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims) (insert "import abc") (comint-send-input) (python-tests-shell-wait-for-prompt) @@ -4797,6 +4798,7 @@ def foo(): "" (python-shell-completion-native-turn-on) (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims) (insert "import abc") (comint-send-input) (python-tests-shell-wait-for-prompt) @@ -4883,11 +4885,14 @@ def foo(): (python-tests-with-temp-buffer-with-shell "" (python-shell-with-shell-buffer - (python-shell-completion-native-turn-on) - (skip-unless (string= python-shell-readline-completer-delims "")) - (python-tests--completion-module) - (python-tests--completion-parameters) - (python-tests--completion-extra-context))))) + (skip-unless (string= python-shell-readline-completer-delims "")) + (python-shell-completion-native-turn-off) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-shell-completion-native-turn-on) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-tests--completion-extra-context))))) (ert-deftest python-shell-completion-at-point-ipython () "Check if Python shell completion works for IPython." @@ -4924,6 +4929,8 @@ def foo(): import abc " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) (goto-char (point-max)) @@ -4940,6 +4947,8 @@ import abc import abc " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) (python-shell-with-shell-buffer @@ -4959,6 +4968,8 @@ pdb.set_trace() print('Hello') " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) (goto-char (point-max)) @@ -4975,6 +4986,8 @@ import time time.sleep(3) " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-send-buffer) (goto-char (point-max)) (insert "time.") @@ -4987,6 +5000,8 @@ time.sleep(3) import abc " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-completion-native-turn-on) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) @@ -5004,6 +5019,8 @@ import abc import abc " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-completion-native-turn-on) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) @@ -5020,6 +5037,8 @@ import abc import abc " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-completion-native-turn-on) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) @@ -5036,6 +5055,8 @@ import abc import abc " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-completion-native-turn-on) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) -- cgit v1.2.3 From eae2c73edb3f09a06a31a38edd28e9751626e761 Mon Sep 17 00:00:00 2001 From: Pankaj Jangid Date: Thu, 14 Mar 2024 17:11:43 +0530 Subject: Add language server for Move to eglot * lisp/progmodes/eglot.el (eglot-server-programs): Added 'move-analyzer' language server. (Bug#69796) --- lisp/progmodes/eglot.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 4ffaf5f8a0e..b3fd104a227 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -295,6 +295,7 @@ automatically)." ((nushell-mode nushell-ts-mode) . ("nu" "--lsp")) (gdscript-mode . ("localhost" 6008)) (fennel-mode . ("fennel-ls")) + (move-mode . ("move-analyzer")) ((fortran-mode f90-mode) . ("fortls")) (futhark-mode . ("futhark" "lsp")) ((lua-mode lua-ts-mode) . ,(eglot-alternatives -- cgit v1.2.3 From f3deaa117acfc975be3edbe8461b18fc29b4adf0 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 14 Mar 2024 19:29:16 +0200 Subject: Context menu for project (bug#69566) * lisp/menu-bar.el (menu-bar-project-item): New variable from 'project-menu-entry'. (menu-bar-tools-menu): Use 'menu-bar-project-item'. * lisp/mouse.el (context-menu-functions): Add 'context-menu-project' to choice. (context-menu-project): New function. * lisp/progmodes/project.el (project-menu-entry): Remove variable. (project-mode-line-map): Use 'menu-bar-project-item' instead of 'project-menu-entry'. --- lisp/menu-bar.el | 5 ++++- lisp/mouse.el | 7 +++++++ lisp/progmodes/project.el | 6 ++---- 3 files changed, 13 insertions(+), 5 deletions(-) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 5b290899ff5..320fabb54cf 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1838,6 +1838,9 @@ mail status in mode line")) (bindings--define-key menu [project-open-file] '(menu-item "Open File..." project-find-file :help "Open an existing file that belongs to current project")) menu)) +(defvar menu-bar-project-item + `(menu-item "Project" ,menu-bar-project-menu)) + (defun menu-bar-read-mail () "Read mail using `read-mail-command'." (interactive) @@ -1925,7 +1928,7 @@ mail status in mode line")) :help "Start language server suitable for this buffer's major-mode")) (bindings--define-key menu [project] - `(menu-item "Project" ,menu-bar-project-menu)) + menu-bar-project-item) (bindings--define-key menu [ede] '(menu-item "Project Support (EDE)" diff --git a/lisp/mouse.el b/lisp/mouse.el index 26835437c08..cef88dede8a 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -393,6 +393,7 @@ and should return the same menu with changes such as added new menu items." (function-item context-menu-local) (function-item context-menu-minor) (function-item context-menu-buffers) + (function-item context-menu-project) (function-item context-menu-vc) (function-item context-menu-ffap) (function-item hi-lock-context-menu) @@ -533,6 +534,12 @@ Some context functions add menu items below the separator." (mouse-buffer-menu-keymap)) menu) +(defun context-menu-project (menu _click) + "Populate MENU with project commands." + (define-key-after menu [separator-project] menu-bar-separator) + (define-key-after menu [project-menu] menu-bar-project-item) + menu) + (defun context-menu-vc (menu _click) "Populate MENU with Version Control commands." (define-key-after menu [separator-vc] menu-bar-separator) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 9622b1b6768..4284ea6edc6 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -2140,12 +2140,10 @@ is part of the default mode line beginning with Emacs 30." :group 'project :version "30.1") -(defvar project-menu-entry - `(menu-item "Project" ,(bound-and-true-p menu-bar-project-menu))) - (defvar project-mode-line-map (let ((map (make-sparse-keymap))) - (define-key map [mode-line down-mouse-1] project-menu-entry) + (define-key map [mode-line down-mouse-1] + (bound-and-true-p menu-bar-project-item)) map)) (defvar project-mode-line-face nil -- cgit v1.2.3 From bd6b64e0a8856a735b484f0482af0e937eb585d3 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 14 Mar 2024 19:37:44 +0200 Subject: * lisp/progmodes/project.el: Don't run modes from .dir-locals.el. (project--value-in-dir): Use 'alist-get' on 'file-local-variables-alist' to avoid calling 'hack-local-variables-apply' via 'hack-dir-local-variables-non-file-buffer' because it might enable undesirable modes such as flyspell-mode in a temporary buffer (bug#69740). --- lisp/progmodes/project.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 4284ea6edc6..a7c164f5857 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -808,8 +808,9 @@ DIRS must contain directory names." (with-temp-buffer (setq default-directory dir) (let ((enable-local-variables :all)) - (hack-dir-local-variables-non-file-buffer)) - (symbol-value var))) + (hack-dir-local-variables)) + ;; Don't use `hack-local-variables-apply' to avoid setting modes. + (alist-get var file-local-variables-alist))) (cl-defmethod project-buffers ((project (head vc))) (let* ((root (expand-file-name (file-name-as-directory (project-root project)))) -- cgit v1.2.3 From f03f14165ed51148b72b431ac99c4a4829bb1a7f Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 14 Mar 2024 20:11:33 +0200 Subject: * lisp/textmodes/flyspell.el (flyspell-check-changes): New user option. (flyspell--mode-on): Add flyspell-check-changes to post-command-hook when flyspell-check-changes is non-nil. (flyspell--mode-off): Remove flyspell-check-changes from post-command-hook. (flyspell-check-changes): New function (bug#61874). --- etc/NEWS | 5 +++++ lisp/textmodes/flyspell.el | 27 ++++++++++++++++++++++++++- 2 files changed, 31 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index 2985169ea91..327042f9d20 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1129,6 +1129,11 @@ distracting and easily confused with actual code, or a significant early aid that relieves you from moving the buffer or reaching for the mouse to consult an error message. +** Flyspell + +*** New user option 'flyspell-check-changes'. +It checks only edited text. + ** JS mode. The binding 'M-.' has been removed from the major mode keymaps in 'js-mode' and 'js-ts-mode', having it default to the global binding diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index de59294e9f0..d64e4d601f7 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -288,6 +288,12 @@ If this variable is nil, all regions are treated as small." "The key binding for flyspell auto correction." :type 'key-sequence) +(defcustom flyspell-check-changes nil + "Check only on moving point from the edited word. +Unlike the default behavior, don't check when moving point without editing." + :type 'boolean + :version "30.1") + ;;*---------------------------------------------------------------------*/ ;;* Mode specific options */ ;;* ------------------------------------------------------------- */ @@ -610,7 +616,9 @@ are both non-nil." (flyspell-accept-buffer-local-defs 'force) (flyspell-delay-commands) (flyspell-deplacement-commands) - (add-hook 'post-command-hook (function flyspell-post-command-hook) t t) + (if flyspell-check-changes + (add-hook 'post-command-hook (function flyspell-check-changes) t t) + (add-hook 'post-command-hook (function flyspell-post-command-hook) t t)) (add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t) (add-hook 'after-change-functions 'flyspell-after-change-function nil t) (add-hook 'hack-local-variables-hook @@ -709,6 +717,7 @@ has been used, the current word is not checked." ;;;###autoload (defun flyspell--mode-off () "Turn Flyspell mode off." + (remove-hook 'post-command-hook (function flyspell-check-changes) t) (remove-hook 'post-command-hook (function flyspell-post-command-hook) t) (remove-hook 'pre-command-hook (function flyspell-pre-command-hook) t) (remove-hook 'after-change-functions 'flyspell-after-change-function t) @@ -990,6 +999,22 @@ Mostly we check word delimiters." (setq flyspell-changes (cdr flyspell-changes)))) (setq flyspell-previous-command command))))) +(defun flyspell-check-changes () + "The `post-command-hook' used by flyspell to check only edits. +It checks only on moving point from the edited word, +not when moving point without editing." + (when flyspell-mode + (with-local-quit + (when (consp flyspell-changes) + (let ((start (car (car flyspell-changes))) + (stop (cdr (car flyspell-changes))) + (word (save-excursion (flyspell-get-word)))) + (unless (and word (<= (nth 1 word) start) (>= (nth 2 word) stop)) + (save-excursion + (goto-char start) + (flyspell-word)) + (setq flyspell-changes nil))))))) + ;;*---------------------------------------------------------------------*/ ;;* flyspell-notify-misspell ... */ ;;*---------------------------------------------------------------------*/ -- cgit v1.2.3 From b708e639d63f488a98c7416866665c16730b9e8f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 14 Mar 2024 21:08:36 +0200 Subject: ; * src/lread.c (maybe_swap_for_eln): Clarify warning message. --- src/lread.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/lread.c b/src/lread.c index 451f699e27d..7574e45f3dd 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1745,9 +1745,9 @@ maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd, = Fcons (list2 (Qcomp, CALLN (Fformat, - build_string ("Cannot look up eln " - "file as no source file " - "was found for %s"), + build_string ("Cannot look up .eln file " + "for %s because no source " + "file was found for it"), *filename)), Vdelayed_warnings_list); return; -- cgit v1.2.3 From 9a2c7d865ff8df960793e19c3f854db66b40e0fb Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 15 Mar 2024 08:36:21 +0800 Subject: Fix last change * src/xwidget.c (Fmake_xwidget): Cast boolean value to gboolean. (syms_of_xwidget): Fix coding style and improve doc string. --- src/xwidget.c | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/xwidget.c b/src/xwidget.c index 557b1e60409..2260c0c2e0f 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -378,7 +378,8 @@ fails. */) /* Enable the developer extras. */ settings = webkit_web_view_get_settings (WEBKIT_WEB_VIEW (xw->widget_osr)); g_object_set (G_OBJECT (settings), "enable-developer-extras", TRUE, NULL); - g_object_set (G_OBJECT (settings), "enable-javascript", !xwidget_webkit_disable_javascript, NULL); + g_object_set (G_OBJECT (settings), "enable-javascript", + (gboolean) (!xwidget_webkit_disable_javascript), NULL); } gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width, @@ -3972,10 +3973,10 @@ syms_of_xwidget (void) doc: /* List of all xwidget views. */); Vxwidget_view_list = Qnil; - DEFVAR_BOOL("xwidget-webkit-disable-javascript", xwidget_webkit_disable_javascript, - doc: /* If non-nil, disable execution of JavaScript in xwidget webkit sessions. -You must kill all xwidget-webkit buffers for this setting to take effect -after changing it. */); + DEFVAR_BOOL ("xwidget-webkit-disable-javascript", xwidget_webkit_disable_javascript, + doc: /* If non-nil, disable execution of JavaScript in WebKit widgets. +Modifications to this setting do not take effect in existing WebKit +widgets. */); xwidget_webkit_disable_javascript = false; Fprovide (intern ("xwidget-internal"), Qnil); -- cgit v1.2.3 From c8c0d0a9550620adb111bf5d9e0155332498a6bf Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 14 Mar 2024 22:00:14 -0400 Subject: (customize-mode): Fix bug#69501 * lisp/cus-edit.el (customize-mode): Use the predicate arg of `completing-read` instead of binding `completion-regexp-list`. --- lisp/cus-edit.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 8fad51dc116..f004002333b 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1159,14 +1159,15 @@ argument or if the current major mode has no known group, prompt for the MODE to customize." (interactive (list - (let ((completion-regexp-list '("-mode\\'")) - (group (custom-group-of-mode major-mode))) + (let ((group (custom-group-of-mode major-mode))) (if (and group (not current-prefix-arg)) major-mode (intern (completing-read (format-prompt "Mode" (and group major-mode)) obarray - 'custom-group-of-mode + (lambda (s) + (and (string-match "-mode\\'" (symbol-name s)) + (custom-group-of-mode s))) t nil nil (if group (symbol-name major-mode)))))))) (customize-group (custom-group-of-mode mode))) -- cgit v1.2.3 From 9422a6737447b186ca017929da79985cef7898a8 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 14 Mar 2024 22:15:41 -0400 Subject: (set-auto-mode): Streamline to fix bug#67795 The old code tested if the mode function is `fboundp` but in an inconsistent way and without paying attention to `major-mode-remap`. * lisp/files.el (set-auto-mode-0): Return `:keep` rather than nil if the mode was already set. And emit a warning when the mode function doesn't exist. (set-auto-mode): Remove checks that the mode function exists now that `set-auto-mode-0` does it for us. Adjust to the new return values of that function, and simplify the code using a big `or` instead of a sequence of steps each setting&testing `done`. (hack-local-variables--find-variables): Use `major-mode-remap` when skipping the "mode:" entries that specify modes we don't have. Also, when (eq handle-mode t), don't bother building a list of results only to return a single element in the end. --- lisp/files.el | 231 ++++++++++++++++++++++++++++++---------------------------- 1 file changed, 118 insertions(+), 113 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index 3ca4f047144..766ed573392 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3425,7 +3425,7 @@ set the major mode only if that would change it. In other words we don't actually set it to the same mode the buffer already has." ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*- (let ((try-locals (not (inhibit-local-variables-p))) - end done mode modes) + end modes) ;; Once we drop the deprecated feature where mode: is also allowed to ;; specify minor-modes (ie, there can be more than one "mode:"), we can ;; remove this section and just let (hack-local-variables t) handle it. @@ -3456,100 +3456,96 @@ we don't actually set it to the same mode the buffer already has." (push (intern (concat (downcase (buffer-substring (point) end)) "-mode")) modes)))) - ;; If we found modes to use, invoke them now, outside the save-excursion. - (if modes - (catch 'nop - (dolist (mode (nreverse modes)) - (if (not (functionp mode)) - (message "Ignoring unknown mode `%s'" mode) - (setq done t) - (or (set-auto-mode-0 mode keep-mode-if-same) - ;; continuing would call minor modes again, toggling them off - (throw 'nop nil)))))) - ;; Check for auto-mode-alist entry in dir-locals. - (unless done - (with-demoted-errors "Directory-local variables error: %s" - ;; Note this is a no-op if enable-local-variables is nil. - (let* ((mode-alist (cdr (hack-dir-local--get-variables - (lambda (key) (eq key 'auto-mode-alist)))))) - (setq done (set-auto-mode--apply-alist mode-alist - keep-mode-if-same t))))) - (and (not done) - (setq mode (hack-local-variables t (not try-locals))) - (not (memq mode modes)) ; already tried and failed - (if (not (functionp mode)) - (message "Ignoring unknown mode `%s'" mode) - (setq done t) - (set-auto-mode-0 mode keep-mode-if-same))) - ;; If we didn't, look for an interpreter specified in the first line. - ;; As a special case, allow for things like "#!/bin/env perl", which - ;; finds the interpreter anywhere in $PATH. - (and (not done) - (setq mode (save-excursion - (goto-char (point-min)) - (if (looking-at auto-mode-interpreter-regexp) - (match-string 2)))) - ;; Map interpreter name to a mode, signaling we're done at the - ;; same time. - (setq done (assoc-default - (file-name-nondirectory mode) - (mapcar (lambda (e) - (cons - (format "\\`%s\\'" (car e)) - (cdr e))) - interpreter-mode-alist) - #'string-match-p)) - ;; If we found an interpreter mode to use, invoke it now. - (set-auto-mode-0 done keep-mode-if-same)) - ;; Next try matching the buffer beginning against magic-mode-alist. - (unless done - (if (setq done (save-excursion - (goto-char (point-min)) - (save-restriction - (narrow-to-region (point-min) - (min (point-max) - (+ (point-min) magic-mode-regexp-match-limit))) - (assoc-default - nil magic-mode-alist - (lambda (re _dummy) - (cond - ((functionp re) - (funcall re)) - ((stringp re) - (let ((case-fold-search nil)) - (looking-at re))) - (t - (error - "Problem in magic-mode-alist with element %s" - re)))))))) - (set-auto-mode-0 done keep-mode-if-same))) - ;; Next compare the filename against the entries in auto-mode-alist. - (unless done - (setq done (set-auto-mode--apply-alist auto-mode-alist - keep-mode-if-same nil))) - ;; Next try matching the buffer beginning against magic-fallback-mode-alist. - (unless done - (if (setq done (save-excursion - (goto-char (point-min)) - (save-restriction - (narrow-to-region (point-min) - (min (point-max) - (+ (point-min) magic-mode-regexp-match-limit))) - (assoc-default nil magic-fallback-mode-alist - (lambda (re _dummy) - (cond - ((functionp re) - (funcall re)) - ((stringp re) - (let ((case-fold-search nil)) - (looking-at re))) - (t - (error - "Problem with magic-fallback-mode-alist element: %s" - re)))))))) - (set-auto-mode-0 done keep-mode-if-same))) - (unless done - (set-buffer-major-mode (current-buffer))))) + (or + ;; If we found modes to use, invoke them now, outside the save-excursion. + ;; Presume `modes' holds a major mode followed by minor modes. + (let ((done ())) + (dolist (mode (nreverse modes)) + (if (eq done :keep) + ;; `keep-mode-if-same' is set and the (major) mode + ;; was already set. Refrain from calling the following + ;; minor modes since they have already been set. + ;; It was especially important in the past when calling + ;; minor modes without an arg would toggle them, but it's + ;; still preferable to avoid re-enabling them, + nil + (let ((res (set-auto-mode-0 mode keep-mode-if-same))) + (setq done (or res done))))) + done) + ;; Check for auto-mode-alist entry in dir-locals. + (with-demoted-errors "Directory-local variables error: %s" + ;; Note this is a no-op if enable-local-variables is nil. + (let* ((mode-alist (cdr (hack-dir-local--get-variables + (lambda (key) (eq key 'auto-mode-alist)))))) + (set-auto-mode--apply-alist mode-alist keep-mode-if-same t))) + (let ((mode (hack-local-variables t (not try-locals)))) + (unless (memq mode modes) ; already tried and failed + (set-auto-mode-0 mode keep-mode-if-same))) + ;; If we didn't, look for an interpreter specified in the first line. + ;; As a special case, allow for things like "#!/bin/env perl", which + ;; finds the interpreter anywhere in $PATH. + (when-let + ((interp (save-excursion + (goto-char (point-min)) + (if (looking-at auto-mode-interpreter-regexp) + (match-string 2)))) + ;; Map interpreter name to a mode, signaling we're done at the + ;; same time. + (mode (assoc-default + (file-name-nondirectory interp) + (mapcar (lambda (e) + (cons + (format "\\`%s\\'" (car e)) + (cdr e))) + interpreter-mode-alist) + #'string-match-p))) + ;; If we found an interpreter mode to use, invoke it now. + (set-auto-mode-0 mode keep-mode-if-same)) + ;; Next try matching the buffer beginning against magic-mode-alist. + (let ((mode (save-excursion + (goto-char (point-min)) + (save-restriction + (narrow-to-region (point-min) + (min (point-max) + (+ (point-min) magic-mode-regexp-match-limit))) + (assoc-default + nil magic-mode-alist + (lambda (re _dummy) + (cond + ((functionp re) + (funcall re)) + ((stringp re) + (let ((case-fold-search nil)) + (looking-at re))) + (t + (error + "Problem in magic-mode-alist with element %s" + re))))))))) + (set-auto-mode-0 mode keep-mode-if-same)) + ;; Next compare the filename against the entries in auto-mode-alist. + (set-auto-mode--apply-alist auto-mode-alist + keep-mode-if-same nil) + ;; Next try matching the buffer beginning against magic-fallback-mode-alist. + (let ((mode (save-excursion + (goto-char (point-min)) + (save-restriction + (narrow-to-region (point-min) + (min (point-max) + (+ (point-min) magic-mode-regexp-match-limit))) + (assoc-default nil magic-fallback-mode-alist + (lambda (re _dummy) + (cond + ((functionp re) + (funcall re)) + ((stringp re) + (let ((case-fold-search nil)) + (looking-at re))) + (t + (error + "Problem with magic-fallback-mode-alist element: %s" + re))))))))) + (set-auto-mode-0 mode keep-mode-if-same)) + (set-buffer-major-mode (current-buffer))))) (defvar-local set-auto-mode--last nil "Remember the mode we have set via `set-auto-mode-0'.") @@ -3583,18 +3579,29 @@ and it is meant to be modified by packages rather than users.") "Apply MODE and return it. If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is chased of any aliases and compared to current major mode. If they are the -same, do nothing and return nil." - (unless (and keep-mode-if-same - (or (eq (indirect-function mode) - (indirect-function major-mode)) - (and set-auto-mode--last - (eq mode (car set-auto-mode--last)) - (eq major-mode (cdr set-auto-mode--last))))) - (when mode - (funcall (major-mode-remap mode)) - (unless (eq mode major-mode) - (setq set-auto-mode--last (cons mode major-mode))) - mode))) +same, do nothing and return `:keep'. +Return nil if MODE could not be applied." + (when mode + (if (and keep-mode-if-same + (or (eq (indirect-function mode) + (indirect-function major-mode)) + (and set-auto-mode--last + (eq mode (car set-auto-mode--last)) + (eq major-mode (cdr set-auto-mode--last))))) + :keep + (let ((modefun (major-mode-remap mode))) + (if (not (functionp modefun)) + (progn + (message "Ignoring unknown mode `%s'%s" mode + (if (eq mode modefun) "" + (format " (remapped to `%S')" modefun))) + nil) + (funcall modefun) + (unless (or (eq mode major-mode) ;`set-auto-mode--last' is overkill. + ;; `modefun' is something like a minor mode. + (local-variable-p 'set-auto-mode--last)) + (setq set-auto-mode--last (cons mode major-mode))) + mode))))) (defvar file-auto-mode-skip "^\\(#!\\|'\\\\\"\\)" "Regexp of lines to skip when looking for file-local settings. @@ -4201,8 +4208,9 @@ major-mode." (not (string-match "-minor\\'" (setq val2 (downcase (symbol-name val))))) - ;; Allow several mode: elements. - (push (intern (concat val2 "-mode")) result)) + (let ((mode (intern (concat val2 "-mode")))) + (when (fboundp (major-mode-remap mode)) + (setq result mode)))) (cond ((eq var 'coding)) ((eq var 'lexical-binding) (unless hack-local-variables--warned-lexical @@ -4233,10 +4241,7 @@ major-mode." val) result)))))) (forward-line 1))))))) - (if (eq handle-mode t) - ;; Return the final mode: setting that's defined. - (car (seq-filter #'fboundp result)) - result))) + result)) (defun hack-local-variables-apply () "Apply the elements of `file-local-variables-alist'. -- cgit v1.2.3 From 5037b9eed711dec0ef73dd6fca1e60e0b521c13b Mon Sep 17 00:00:00 2001 From: Patrick Bader Date: Mon, 4 Mar 2024 16:14:25 +0100 Subject: fix: project submodule detection does not work for worktrees --- lisp/progmodes/project.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index a7c164f5857..7103b36a892 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -602,7 +602,7 @@ See `project-vc-extra-root-markers' for the marker value format.") (goto-char (point-min)) ;; Kind of a hack to distinguish a submodule from ;; other cases of .git files pointing elsewhere. - (looking-at "gitdir: [./]+/\\.git/modules/")) + (looking-at "gitdir: .+/\\.git/\\(worktrees/.*\\)?modules/")) t) (t nil)))) -- cgit v1.2.3 From 77a86d738eebc7a80b7d4a6357a5fa675df9de8c Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Fri, 15 Mar 2024 04:28:45 +0200 Subject: (project--value-in-dir): Ensure that the global value is still honored * lisp/progmodes/project.el (project--value-in-dir): Ensure that the global value of the variable is still honored, when the variable is not in dir-locals. --- lisp/progmodes/project.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 7103b36a892..ac18aceadcf 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -810,7 +810,8 @@ DIRS must contain directory names." (let ((enable-local-variables :all)) (hack-dir-local-variables)) ;; Don't use `hack-local-variables-apply' to avoid setting modes. - (alist-get var file-local-variables-alist))) + (alist-get var file-local-variables-alist + (symbol-value var)))) (cl-defmethod project-buffers ((project (head vc))) (let* ((root (expand-file-name (file-name-as-directory (project-root project)))) -- cgit v1.2.3 From c453c82dc6af2178ce10ffddccd9f38543ea6e88 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 15 Mar 2024 11:50:09 +0800 Subject: * src/sfntfont-android.c (init_sfntfont_android): Fix SDK check. --- src/sfntfont-android.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/sfntfont-android.c b/src/sfntfont-android.c index 94aedd0cd66..1ed394b9458 100644 --- a/src/sfntfont-android.c +++ b/src/sfntfont-android.c @@ -770,7 +770,7 @@ init_sfntfont_android (void) build_string ("Roboto")), Fcons (build_string ("DejaVu Serif"), build_string ("Noto Serif"))); - else if (api_level >= 15) + else if (api_level >= 14) /* Android 4.0 and later distribute Roboto in lieu of Droid Sans. */ Vsfnt_default_family_alist -- cgit v1.2.3 From 1be33963f068b884d1f8cbd37372638c47a79e84 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 15 Mar 2024 11:50:27 +0800 Subject: ; * src/androidselect.c (Fandroid_notifications_notify): Typo in doc string. --- src/androidselect.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/androidselect.c b/src/androidselect.c index 87dd2c3d079..2f6114d0fcb 100644 --- a/src/androidselect.c +++ b/src/androidselect.c @@ -803,7 +803,7 @@ keywords is understood: for arguments. The notification group and timeout are ignored on Android 7.1 and -earlier versions of Android. On more recent versions, the urgency +earlier versions of Android. On more recent versions, the group identifies a category that will be displayed in the system Settings menu, and the urgency provided always extends to affect all notifications displayed within that category, though it may be ignored -- cgit v1.2.3 From 09ab66935154ea0cc4a351b8320bc0e9276b7780 Mon Sep 17 00:00:00 2001 From: Kévin Le Gouguec Date: Sun, 3 Mar 2024 17:20:56 +0100 Subject: Keep indenting text when 'shr-fill-text' is nil (bug#69555) The 'shr-fill-...' functions handle both hard-filling (adding newlines to break long lines) and indentation. Setting 'shr-fill-text' to nil currently causes these functions to be short-circuited completely, so e.g. blockquotes are no longer indented, whereas the intent of this user option is only to prevent hard-filling to let visual-line-mode reflow text. * lisp/net/shr.el (shr-fill-lines): Document that the function handles more than just filling; move the 'shr-fill-text' check... (shr-fill-line): ... here, after indentation has been taken care of. * test/lisp/net/shr-resources/blockquote.html: * test/lisp/net/shr-resources/blockquote.txt: New test resources. * test/lisp/net/shr-tests.el (shr-test--rendering-check): Rename from 'shr-test', to make the relationship with the 'rendering' testcase clearer; prefer 'file-name-concat' to 'format'; raise ERT failure if need be, calling (ert-fail ...) directly instead of (should (not (list ...))). (shr-test--rendering-extra-configs): New variable to easily check that user customizations do not degrade rendering. (rendering): Consult that new variable; delegate failure-raising to reduce duplication. --- lisp/net/shr.el | 15 ++++-- test/lisp/net/shr-resources/blockquote.html | 2 + test/lisp/net/shr-resources/blockquote.txt | 3 ++ test/lisp/net/shr-tests.el | 72 +++++++++++++++++++++-------- 4 files changed, 67 insertions(+), 25 deletions(-) create mode 100644 test/lisp/net/shr-resources/blockquote.html create mode 100644 test/lisp/net/shr-resources/blockquote.txt diff --git a/lisp/net/shr.el b/lisp/net/shr.el index e23fc6104d2..09df5f5a9bb 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -784,8 +784,9 @@ size, and full-buffer size." (or shr-current-font 'shr-text))))))))) (defun shr-fill-lines (start end) - (if (or (not shr-fill-text) (<= shr-internal-width 0)) - nil + "Indent and fill text from START to END. +When `shr-fill-text' is nil, only indent." + (unless (<= shr-internal-width 0) (save-restriction (narrow-to-region start end) (goto-char start) @@ -807,6 +808,8 @@ size, and full-buffer size." (forward-char 1)))) (defun shr-fill-line () + "Indent and fill the current line. +When `shr-fill-text' is nil, only indent." (let ((shr-indentation (or (get-text-property (point) 'shr-indentation) shr-indentation)) (continuation (get-text-property @@ -821,9 +824,11 @@ size, and full-buffer size." `,(shr-face-background face)))) (setq start (point)) (setq shr-indentation (or continuation shr-indentation)) - ;; If we have an indentation that's wider than the width we're - ;; trying to fill to, then just give up and don't do any filling. - (when (< shr-indentation shr-internal-width) + ;; Fill the current line, unless `shr-fill-text' is unset, or we + ;; have an indentation that's wider than the width we're trying to + ;; fill to. + (when (and shr-fill-text + (< shr-indentation shr-internal-width)) (shr-vertical-motion shr-internal-width) (when (looking-at " $") (delete-region (point) (line-end-position))) diff --git a/test/lisp/net/shr-resources/blockquote.html b/test/lisp/net/shr-resources/blockquote.html new file mode 100644 index 00000000000..412caf8bae6 --- /dev/null +++ b/test/lisp/net/shr-resources/blockquote.html @@ -0,0 +1,2 @@ +
Citation.
+
Reply.
diff --git a/test/lisp/net/shr-resources/blockquote.txt b/test/lisp/net/shr-resources/blockquote.txt new file mode 100644 index 00000000000..8ed610b8ea2 --- /dev/null +++ b/test/lisp/net/shr-resources/blockquote.txt @@ -0,0 +1,3 @@ + Citation. + +Reply. diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el index 0c6e2c091bf..17138053450 100644 --- a/test/lisp/net/shr-tests.el +++ b/test/lisp/net/shr-tests.el @@ -29,30 +29,62 @@ (declare-function libxml-parse-html-region "xml.c") -(defun shr-test (name) - (with-temp-buffer - (insert-file-contents (format (concat (ert-resource-directory) "/%s.html") name)) - (let ((dom (libxml-parse-html-region (point-min) (point-max))) - (shr-width 80) - (shr-use-fonts nil)) - (erase-buffer) - (shr-insert-document dom) - (cons (buffer-substring-no-properties (point-min) (point-max)) - (with-temp-buffer - (insert-file-contents - (format (concat (ert-resource-directory) "/%s.txt") name)) - (while (re-search-forward "%\\([0-9A-F][0-9A-F]\\)" nil t) - (replace-match (string (string-to-number (match-string 1) 16)) - t t)) - (buffer-string)))))) +(defun shr-test--rendering-check (name &optional context) + "Render NAME.html and compare it to NAME.txt. +Raise a test failure if the rendered buffer does not match NAME.txt. +Append CONTEXT to the failure data, if non-nil." + (let ((text-file (file-name-concat (ert-resource-directory) (concat name ".txt"))) + (html-file (file-name-concat (ert-resource-directory) (concat name ".html"))) + (description (if context (format "%s (%s)" name context) name))) + (with-temp-buffer + (insert-file-contents html-file) + (let ((dom (libxml-parse-html-region (point-min) (point-max))) + (shr-width 80) + (shr-use-fonts nil)) + (erase-buffer) + (shr-insert-document dom) + (let ((result (buffer-substring-no-properties (point-min) (point-max))) + (expected + (with-temp-buffer + (insert-file-contents text-file) + (while (re-search-forward "%\\([0-9A-F][0-9A-F]\\)" nil t) + (replace-match (string (string-to-number (match-string 1) 16)) + t t)) + (buffer-string)))) + (unless (equal result expected) + (ert-fail (list description result expected)))))))) + +(defconst shr-test--rendering-extra-configs + '(("blockquote" + ;; Make sure blockquotes remain indented even when filling is + ;; disabled (bug#69555). + . ((shr-fill-text . nil)))) + "Extra customizations which can impact rendering. +This is a list of (NAME . SETTINGS) pairs. NAME is the basename of a +set of txt/html files under shr-resources/, as passed to `shr-test'. +SETTINGS is a list of (OPTION . VALUE) pairs that are interesting to +validate for the NAME testcase. + +The `rendering' testcase will test NAME once without altering any +settings, then once more for each (OPTION . VALUE) pair.") (ert-deftest rendering () (skip-unless (fboundp 'libxml-parse-html-region)) (dolist (file (directory-files (ert-resource-directory) nil "\\.html\\'")) - (let* ((name (replace-regexp-in-string "\\.html\\'" "" file)) - (result (shr-test name))) - (unless (equal (car result) (cdr result)) - (should (not (list name (car result) (cdr result)))))))) + (let* ((name (string-remove-suffix ".html" file)) + (extra-options (alist-get name shr-test--rendering-extra-configs + nil nil 'string=))) + ;; Test once with default settings. + (shr-test--rendering-check name) + ;; Test once more for every extra option for this specific NAME. + (pcase-dolist (`(,option-sym ,option-val) + extra-options) + (let ((option-old (symbol-value option-sym))) + (set option-sym option-val) + (unwind-protect + (shr-test--rendering-check + name (format "with %s %s" option-sym option-val)) + (set option-sym option-old))))))) (ert-deftest use-cookies () (let ((shr-cookie-policy 'same-origin)) -- cgit v1.2.3 From 9dcb28d6014f72e5f52ad46d6141e9be4e11bfa5 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Tue, 27 Feb 2024 15:42:38 -0500 Subject: With visible-completions, only bind RET when completion is selected Previously, if minibuffer-visible-completions was non-nil, we bound RET whenever the *Completions* buffer was visible. This meant that RET in completion-in-region would not enter a newline, which is a somewhat annoying behavior change from minibuffer-visible-completions=nil. Now, we only bind RET when a completion is selected. This means RET will newline in completion-in-region. So that completion help continues to suggest the correct keys, we also add minibuffer-visible-completions--always-bind. When let-bound to a non-nil value, it makes the minibuffer-visible-completions binds always active. We let-bind it around substitute-command-keys. * lisp/minibuffer.el (minibuffer-visible-completions--always-bind) (minibuffer-visible-completions--filter): Add. (minibuffer-visible-completions-bind): Use minibuffer-visible-completions--filter. (bug#68801) * lisp/simple.el (minibuffer-visible-completions--always-bind) (completion-setup-function): Let-bind minibuffer-visible-completions--always-bind so the completion help is correct. --- lisp/minibuffer.el | 24 ++++++++++++++++++------ lisp/simple.el | 19 +++++++++++-------- 2 files changed, 29 insertions(+), 14 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 099fa1599d5..0a844c538b4 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3163,18 +3163,30 @@ and `RET' accepts the input typed into the minibuffer." :type 'boolean :version "30.1") +(defvar minibuffer-visible-completions--always-bind nil + "If non-nil, force the `minibuffer-visible-completions' bindings on.") + +(defun minibuffer-visible-completions--filter (cmd) + "Return CMD if `minibuffer-visible-completions' bindings should be active." + (if minibuffer-visible-completions--always-bind + cmd + (when-let ((window (get-buffer-window "*Completions*" 0))) + (when (and (eq (buffer-local-value 'completion-reference-buffer + (window-buffer window)) + (window-buffer (active-minibuffer-window))) + (if (eq cmd #'minibuffer-choose-completion-or-exit) + (with-current-buffer (window-buffer window) + (get-text-property (point) 'completion--string)) + t)) + cmd)))) + (defun minibuffer-visible-completions-bind (binding) "Use BINDING when completions are visible. Return an item that is enabled only when a window displaying the *Completions* buffer exists." `(menu-item "" ,binding - :filter ,(lambda (cmd) - (when-let ((window (get-buffer-window "*Completions*" 0))) - (when (eq (buffer-local-value 'completion-reference-buffer - (window-buffer window)) - (window-buffer (active-minibuffer-window))) - cmd))))) + :filter ,#'minibuffer-visible-completions--filter)) (defvar-keymap minibuffer-visible-completions-map :doc "Local keymap for minibuffer input with visible completions." diff --git a/lisp/simple.el b/lisp/simple.el index f127290231b..0645f18cc78 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10298,6 +10298,8 @@ Called from `temp-buffer-show-hook'." :version "22.1" :group 'completion) +(defvar minibuffer-visible-completions--always-bind) + ;; This function goes in completion-setup-hook, so that it is called ;; after the text of the completion list buffer is written. (defun completion-setup-function () @@ -10338,15 +10340,16 @@ Called from `temp-buffer-show-hook'." (if minibuffer-visible-completions (let ((helps (with-current-buffer (window-buffer (active-minibuffer-window)) - (list - (substitute-command-keys - (if (display-mouse-p) - "Click or type \\[minibuffer-choose-completion-or-exit] on a completion to select it.\n" - "Type \\[minibuffer-choose-completion-or-exit] on a completion to select it.\n")) - (substitute-command-keys - "Type \\[minibuffer-next-completion], \\[minibuffer-previous-completion], \ + (let ((minibuffer-visible-completions--always-bind t)) + (list + (substitute-command-keys + (if (display-mouse-p) + "Click or type \\[minibuffer-choose-completion-or-exit] on a completion to select it.\n" + "Type \\[minibuffer-choose-completion-or-exit] on a completion to select it.\n")) + (substitute-command-keys + "Type \\[minibuffer-next-completion], \\[minibuffer-previous-completion], \ \\[minibuffer-next-line-completion], \\[minibuffer-previous-line-completion] \ -to move point between completions.\n\n"))))) +to move point between completions.\n\n")))))) (dolist (help helps) (insert help))) (insert (substitute-command-keys -- cgit v1.2.3 From ffbf876a93c7b34c84806e43659efbac519279fa Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 15 Mar 2024 09:45:48 +0200 Subject: * lisp/vc/diff-mode.el (diff-mode-menu): Add menu item "Apply all hunks". It's bound to the recently added command 'diff-apply-buffer'. --- lisp/vc/diff-mode.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index ac7d55c8a46..0f393ba86a2 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -240,6 +240,8 @@ The default \"-b\" means to ignore whitespace-only changes, :help "Apply the current hunk to the source file and go to the next"] ["Test applying hunk" diff-test-hunk :help "See whether it's possible to apply the current hunk"] + ["Apply all hunks" diff-apply-buffer + :help "Apply all hunks in the current diff buffer"] ["Apply diff with Ediff" diff-ediff-patch :help "Call `ediff-patch-file' on the current buffer"] ["Create Change Log entries" diff-add-change-log-entries-other-window -- cgit v1.2.3 From ebd32040e06bf57761f59638b600cfdeb408cbc5 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 15 Mar 2024 10:29:06 +0200 Subject: ; * src/xwidget.c (xwidget-webkit-disable-javascript): Doc fix. --- src/xwidget.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/xwidget.c b/src/xwidget.c index 2260c0c2e0f..389c48ca7f5 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -3974,9 +3974,10 @@ syms_of_xwidget (void) Vxwidget_view_list = Qnil; DEFVAR_BOOL ("xwidget-webkit-disable-javascript", xwidget_webkit_disable_javascript, - doc: /* If non-nil, disable execution of JavaScript in WebKit widgets. + doc: /* If non-nil, disable execution of JavaScript in xwidget WebKit widgets. Modifications to this setting do not take effect in existing WebKit -widgets. */); +widgets; kill all xwidget-webkit buffers for changes in this setting +to take effect. */); xwidget_webkit_disable_javascript = false; Fprovide (intern ("xwidget-internal"), Qnil); -- cgit v1.2.3 From 1c4233b9a391ba5d5746acf6b6fd4b352b8c3a58 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 15 Mar 2024 10:44:23 +0200 Subject: ; Fix documentation of 'flyspell-check-changes' * lisp/textmodes/flyspell.el (flyspell-check-changes): Doc fixes. * etc/NEWS: Improve wording of entry for 'flyspell-check-changes'. --- etc/NEWS | 3 ++- lisp/textmodes/flyspell.el | 14 +++++++++----- 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 327042f9d20..da9a2fd90fa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1132,7 +1132,8 @@ mouse to consult an error message. ** Flyspell *** New user option 'flyspell-check-changes'. -It checks only edited text. +When non-nil, Flyspell mode spell-checks only words that you edited; it +does not check unedited words just because you move point across them. ** JS mode. The binding 'M-.' has been removed from the major mode keymaps in diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index d64e4d601f7..09d4e8a8d1a 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -289,8 +289,11 @@ If this variable is nil, all regions are treated as small." :type 'key-sequence) (defcustom flyspell-check-changes nil - "Check only on moving point from the edited word. -Unlike the default behavior, don't check when moving point without editing." + "If non-nil, spell-check only words that were edited. +By default, this is nil, and Flyspell checks every word across which +you move point, even if you haven't edited the word. Customizing this +option to a non-nil value will not flag mis-spelled words across which +you move point without editing them." :type 'boolean :version "30.1") @@ -1000,9 +1003,10 @@ Mostly we check word delimiters." (setq flyspell-previous-command command))))) (defun flyspell-check-changes () - "The `post-command-hook' used by flyspell to check only edits. -It checks only on moving point from the edited word, -not when moving point without editing." + "Function to spell-check only edited words when point moves off the word. +This is installed by flyspell as `post-command-hook' when the user +option `flyspell-check-changes' is non-nil. It spell-checks a word +on moving point from the word only if the word was edited before the move." (when flyspell-mode (with-local-quit (when (consp flyspell-changes) -- cgit v1.2.3 From 5bba1b95b8088048808b306bf8b00eb9b342ce92 Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Fri, 15 Mar 2024 10:35:27 +0100 Subject: Further adjustments for restoring killed buffer windows (Bug#68235) * etc/NEWS: Announce 'window-restore-killed-buffer-windows'. * src/buffer.h (struct buffer) : New field last_name_. * src/buffer.c (Fbuffer_last_name): New function to return last name of buffer before it was killed or renamed. (bset_last_name, Fget_buffer_create, Fmake_indirect_buffer) (Frename_buffer, Fkill_buffer, init_buffer_once): Set buffer's last_name_ field accordingly. * src/window.c (window_restore_killed_buffer_windows): New variable replacing Vwindow_kept_windows_functions. (Fset_window_configuration): Use window_restore_killed_buffer_windows instead of Vwindow_kept_windows_functions. * lisp/window.el (window--state-put-2, window-state-put): Use 'window-restore-killed-buffer-windows' instead of 'window-kept-windows-functions'. * doc/lispref/windows.texi (Window Configurations): Describe 'window-restore-killed-buffer-windows' which replaces 'window-kept-windows-functions'. --- doc/lispref/windows.texi | 114 ++++++++++++++++++++++------------ etc/NEWS | 6 ++ lisp/window.el | 49 ++++++++------- src/buffer.c | 26 +++++++- src/buffer.h | 3 + src/window.c | 155 ++++++++++++++++++++++++++++------------------- 6 files changed, 225 insertions(+), 128 deletions(-) diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index fe3dc573df5..45d67ba4946 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -6264,15 +6264,10 @@ this function does is to restore the value of the variable @code{minibuffer-selected-window}. In this case, the function returns @code{nil}. Otherwise, it returns @code{t}. -If the buffer of a window of @var{configuration} has been killed since -@var{configuration} was made, that window is, as a rule, removed from -the restored configuration. However, if that window is the last window -remaining in the restored configuration, another live buffer is shown in -it. Also, if the variable @var{window-kept-windows-functions} is -non-@code{nil}, any window whose buffer is now dead is not deleted. -Rather, this function will show another live buffer in that window and -include an entry for that window when calling any function in -@var{window-kept-windows-functions} (@pxref{Window Hooks}). +This function consults the variable +@code{window-restore-killed-buffer-windows} (see below) when it tries to +restore a window whose buffer was killed after @var{configuration} was +recorded. Here is a way of using this function to get the same effect as @code{save-window-excursion}: @@ -6361,14 +6356,9 @@ a live window, it is replaced by a new live window created on the same frame before putting @var{state} into it. If @var{window} is @code{nil}, it puts the window state into a new window. -If the buffer of any window recorded in @var{state} has been killed -since @var{state} was made, that window is, as a rule, not restored. -However, if that window is the only window in @var{state}, another live -buffer will be shown in it. Also, if the variable -@var{window-kept-windows-functions} is non-@code{nil}, any window whose -buffer is now dead is restored. This function will show another live -buffer in it and include an entry for that window when calling a -function in @var{window-kept-windows-functions} (@pxref{Window Hooks}). +This function consults the variable +@code{window-restore-killed-buffer-windows} (see below) when it tries to +restore a window whose buffer was killed after @var{state} was recorded. If the optional argument @var{ignore} is non-@code{nil}, it means to ignore minimum window sizes and fixed-size restrictions. If @var{ignore} @@ -6376,6 +6366,75 @@ is @code{safe}, this means windows can get as small as one line and/or two columns. @end defun +By default, @code{set-window-configuration} and @code{window-state-put} +may delete a window from the restored configuration when they find out +that its buffer was killed since the corresponding configuration or +state has been recorded. The variable described next can be used to +fine-tune that behavior. + +@cindex restoring windows whose buffers have been killed +@defvar window-restore-killed-buffer-windows +This variable specifies how @code{set-window-configuration} and +@code{window-state-put} shall handle a window whose buffer has been +killed since the corresponding configuration or state was made. Any +such window may be live - in which case it shows some other buffer - or +dead at the time one of these functions is called. Usually, +@code{set-window-configuration} leaves the window alone if it is live +while @code{window-state-put} deletes it. + +The following values can be used to override the default behavior for +dead windows in the case of @code{set-window-configuration} and for dead +and live windows in the case of @code{window-state-put}. + +@table @asis +@item @code{t} +This value means to unconditionally restore the window and show some +other buffer in it. + +@item @code{delete} +This means to unconditionally try to delete the window. + +@item @code{dedicated} +This means to try to delete the window if and only if it is dedicated to +its buffer. + +@item @code{nil} +This is the default and means that @code{set-window-configuration} will +try to delete the window if and only if it is dedicated to its buffer +and @code{window-state-put} will unconditionally try to delete it. + +@item a function +This means to restore the window, show some other buffer in it and add +an entry for that window to a list that will be later passed as argument +to that function. +@end table + +If a window cannot be deleted (typically, because it is the last window +on its frame), @code{set-window-configuration} and +@code{window-state-put} will show another buffer in it. + +If the value of this variable is a function, that function should take +three arguments. The first argument specifies the frame whose windows +have been restored. The third argument is either the constant +@code{configuration} if the windows are restored by +@code{set-window-configuration} or the constant @code{state} if the +windows are restored by @code{window-state-put}. + +The second argument specifies a list of entries for @emph{any} window +whose previous buffer has been encountered dead at the time +@code{set-window-configuration} or @code{window-state-put} tried to +restore it in that window (minibuffer windows are excluded). This means +that the function specified by this variable may also delete windows +encountered live by @code{set-window-configuration}. + +Each entry is a list of six values - the window whose buffer was found +dead, the dead buffer or its name, the positions of start and point of +the buffer in that window, the dedicated status of the window as +previously reported by @code{window-dedicated-p} and a flag that is +@code{t} if the window has been encountered live by +@code{set-window-configuration} and @code{nil} otherwise. +@end defvar + The functions @code{window-state-get} and @code{window-state-put} also allow exchanging the contents of two live windows. The following function does precisely that: @@ -6636,27 +6695,6 @@ Lock fontification function, which will be called whenever parts of a buffer are (re)fontified because a window was scrolled or its size changed. @xref{Other Font Lock Variables}. -@cindex window kept windows functions -@defvar window-kept-windows-functions - This variable holds a list of functions that Emacs will call after -restoring a window configuration via @code{set-window-configuration} or -state via @code{window-state-put} (@pxref{Window Configurations}). When -the value of this variable is non-@code{nil}, these functions will not -delete any window whose buffer has been killed since the corresponding -configuration or state was saved, but show some live buffer in it. - -The value should be a list of functions that take two arguments. The -first argument specifies the frame whose windows have been restored. -The second argument specifies a list of entries for each window whose -buffer has been found dead at the time @code{set-window-configuration} -or @code{window-state-put} tried to restore it. Each entry is a list of -four values - the window whose buffer was found dead, the dead buffer, -and the last known positions of start and point of the buffer in that -window. Any function run by this hook should check that the window is -live since another function run by this hook may have deleted it in the -meantime. -@end defvar - @cindex window change functions The remainder of this section covers six hooks that are called during redisplay provided a significant, non-scrolling change of a diff --git a/etc/NEWS b/etc/NEWS index da9a2fd90fa..dfbf6edb098 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -283,6 +283,12 @@ right-aligned to is controlled by the new user option It specifies whether the window of the displayed buffer should be selected or deselected at the end of executing the current command. ++++ +*** New variable 'window-restore-killed-buffer-windows'. +It specifies how 'set-window-configuration' and 'window-state-put' +should proceed with windows whose buffer was killed after the +corresponding configuration or state was made. + ** Tab Bars and Tab Lines --- diff --git a/lisp/window.el b/lisp/window.el index 29336f573f8..246708dbd56 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -6286,7 +6286,8 @@ value can be also stored on disk and read back in a new session." (when state (let* ((old-buffer-or-name (car state)) (buffer (get-buffer old-buffer-or-name)) - (state (cdr state))) + (state (cdr state)) + (dedicated (cdr (assq 'dedicated state)))) (if (buffer-live-p buffer) (with-current-buffer buffer (set-window-buffer window buffer) @@ -6345,7 +6346,7 @@ value can be also stored on disk and read back in a new session." window delta t ignore nil nil nil pixelwise)) (window-resize window delta t ignore pixelwise)))) ;; Set dedicated status. - (set-window-dedicated-p window (cdr (assq 'dedicated state))) + (set-window-dedicated-p window dedicated) ;; Install positions (maybe we should do this after all ;; windows have been created and sized). (ignore-errors @@ -6388,12 +6389,12 @@ value can be also stored on disk and read back in a new session." (set-marker (make-marker) m2 buffer)))))) prev-buffers)))) - ;; We don't want to raise an error in case the buffer does - ;; not exist anymore, so we switch to a previous one and - ;; save the window with the intention of deleting it later - ;; if possible. - (switch-to-prev-buffer window) - (if window-kept-windows-functions + (unless (window-minibuffer-p window) + ;; Preferably show a buffer previously shown in this + ;; window. + (switch-to-prev-buffer window) + (cond + ((functionp window-restore-killed-buffer-windows) (let* ((start (cdr (assq 'start state))) ;; Handle both - marker positions from writable ;; states and markers from non-writable states. @@ -6404,9 +6405,15 @@ value can be also stored on disk and read back in a new session." (point-pos (if (markerp point) (marker-last-position point) point))) - (push (list window old-buffer-or-name start-pos point-pos) - window-state-put-kept-windows)) - (push window window-state-put-stale-windows)))))))) + (push (list window old-buffer-or-name + start-pos point-pos dedicated nil) + window-state-put-kept-windows))) + ((or (and dedicated + (eq window-restore-killed-buffer-windows 'dedicated)) + (memq window-restore-killed-buffer-windows '(nil delete))) + ;; Try to delete the window. + (push window window-state-put-stale-windows))) + (set-window-dedicated-p window nil)))))))) (defun window-state-put (state &optional window ignore) "Put window state STATE into WINDOW. @@ -6421,16 +6428,9 @@ sizes and fixed size restrictions. IGNORE equal `safe' means windows can get as small as `window-safe-min-height' and `window-safe-min-width'. -If the abnormal hook `window-kept-windows-functions' is non-nil, -do not delete any windows saved by STATE whose buffers were -deleted since STATE was saved. Rather, show some live buffer in -them and call the functions in `window-kept-windows-functions' -with a list of two arguments: the frame where STATE was put and a -list of entries for each such window. Each entry contains four -elements - the window, its old buffer and the last positions of -`window-start' and `window-point' for the buffer in that window. -Always check the window for liveness because another function run -by this hook may have deleted it." +If this function tries to restore a non-minibuffer window whose buffer +was killed since STATE was made, it will consult the variable +`window-restore-killed-buffer-windows' on how to proceed." (setq window-state-put-stale-windows nil) (setq window-state-put-kept-windows nil) @@ -6544,10 +6544,9 @@ by this hook may have deleted it." (when (and (window-valid-p window) (eq (window-deletable-p window) t)) (delete-window window)))) - (when window-kept-windows-functions - (run-hook-with-args - 'window-kept-windows-functions - frame window-state-put-kept-windows) + (when (functionp window-restore-killed-buffer-windows) + (funcall window-restore-killed-buffer-windows + frame window-state-put-kept-windows 'state) (setq window-state-put-kept-windows nil)) (window--check frame)))) diff --git a/src/buffer.c b/src/buffer.c index 43a9249528c..07d19dfc078 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -327,6 +327,11 @@ bset_name (struct buffer *b, Lisp_Object val) b->name_ = val; } static void +bset_last_name (struct buffer *b, Lisp_Object val) +{ + b->last_name_ = val; +} +static void bset_overwrite_mode (struct buffer *b, Lisp_Object val) { b->overwrite_mode_ = val; @@ -647,6 +652,7 @@ even if it is dead. The return value is never nil. */) name = Fcopy_sequence (buffer_or_name); set_string_intervals (name, NULL); bset_name (b, name); + bset_last_name (b, name); b->inhibit_buffer_hooks = !NILP (inhibit_buffer_hooks); bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt); @@ -866,6 +872,7 @@ Interactively, CLONE and INHIBIT-BUFFER-HOOKS are nil. */) name = Fcopy_sequence (name); set_string_intervals (name, NULL); bset_name (b, name); + bset_last_name (b, name); /* An indirect buffer shares undo list of its base (Bug#18180). */ bset_undo_list (b, BVAR (b->base_buffer, undo_list)); @@ -1282,6 +1289,17 @@ Return nil if BUFFER has been killed. */) return BVAR (decode_buffer (buffer), name); } +DEFUN ("buffer-last-name", Fbuffer_last_name, Sbuffer_last_name, 0, 1, 0, + doc: /* Return last name of BUFFER, as a string. +BUFFER defaults to the current buffer. + +This is the name BUFFER had before the last time it was renamed or +immediately before it was killed. */) + (Lisp_Object buffer) +{ + return BVAR (decode_buffer (buffer), last_name); +} + DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0, doc: /* Return name of file BUFFER is visiting, or nil if none. No argument or nil as argument means use the current buffer. */) @@ -1652,6 +1670,7 @@ This does not change the name of the visited file (if any). */) (register Lisp_Object newname, Lisp_Object unique) { register Lisp_Object tem, buf; + Lisp_Object oldname = BVAR (current_buffer, name); Lisp_Object requestedname = newname; CHECK_STRING (newname); @@ -1669,12 +1688,12 @@ This does not change the name of the visited file (if any). */) if (NILP (unique) && XBUFFER (tem) == current_buffer) return BVAR (current_buffer, name); if (!NILP (unique)) - newname = Fgenerate_new_buffer_name (newname, - BVAR (current_buffer, name)); + newname = Fgenerate_new_buffer_name (newname, oldname); else error ("Buffer name `%s' is in use", SDATA (newname)); } + bset_last_name (current_buffer, oldname); bset_name (current_buffer, newname); /* Catch redisplay's attention. Unless we do this, the mode lines for @@ -2095,6 +2114,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) This gets rid of them for certain. */ reset_buffer_local_variables (b, 1); + bset_last_name (b, BVAR (b, name)); bset_name (b, Qnil); block_input (); @@ -4666,6 +4686,7 @@ init_buffer_once (void) /* These used to be stuck at 0 by default, but now that the all-zero value means Qnil, we have to initialize them explicitly. */ bset_name (&buffer_local_flags, make_fixnum (0)); + bset_last_name (&buffer_local_flags, make_fixnum (0)); bset_mark (&buffer_local_flags, make_fixnum (0)); bset_local_var_alist (&buffer_local_flags, make_fixnum (0)); bset_keymap (&buffer_local_flags, make_fixnum (0)); @@ -6026,6 +6047,7 @@ There is no reason to change that value except for debugging purposes. */); defsubr (&Smake_indirect_buffer); defsubr (&Sgenerate_new_buffer_name); defsubr (&Sbuffer_name); + defsubr (&Sbuffer_last_name); defsubr (&Sbuffer_file_name); defsubr (&Sbuffer_base_buffer); defsubr (&Sbuffer_local_value); diff --git a/src/buffer.h b/src/buffer.h index 87ba2802b39..bbe1aeff668 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -309,6 +309,9 @@ struct buffer /* The name of this buffer. */ Lisp_Object name_; + /* The last name of this buffer before it was renamed or killed. */ + Lisp_Object last_name_; + /* The name of the file visited in this buffer, or nil. */ Lisp_Object filename_; diff --git a/src/window.c b/src/window.c index ea761fad8bc..928c4ae02a8 100644 --- a/src/window.c +++ b/src/window.c @@ -7109,23 +7109,9 @@ current at the start of the function. If DONT-SET-MINIWINDOW is non-nil, the mini-window of the frame doesn't get set to the corresponding element of CONFIGURATION. -Normally, this function will try to delete any dead window in -CONFIGURATION whose buffer has been deleted since CONFIGURATION was -made. However, if the abnormal hook `window-kept-windows-functions' is -non-nil, it will preserve such a window in the restored layout and show -another buffer in it. - -After restoring the frame layout, this function runs the abnormal hook -`window-kept-windows-functions' with two arguments - the frame whose -layout it has restored and a list of entries for each window whose -buffer has been found dead when it tried to restore CONFIGURATION: Each -entry is a list of four elements where -`window' denotes the window whose buffer was found dead, `buffer' -denotes the dead buffer, and `start' and `point' denote the last known -positions of `window-start' and `window-point' of the buffer in that -window. Any function run by this hook should check such a window for -liveness because another function run by this hook may have deleted it -in the meantime." +This function consults the variable `window-restore-killed-buffer-windows' +when restoring a window whose buffer was killed after CONFIGURATION was +recorded. If CONFIGURATION was made from a frame that is now deleted, only frame-independent values can be restored. In this case, @@ -7378,10 +7364,12 @@ the return value is nil. Otherwise the value is t. */) BUF_PT (XBUFFER (w->contents)), BUF_PT_BYTE (XBUFFER (w->contents))); w->start_at_line_beg = true; - if (!NILP (Vwindow_kept_windows_functions)) - kept_windows = Fcons (list4 (window, p->buffer, + if (FUNCTIONP (window_restore_killed_buffer_windows) + && !MINI_WINDOW_P (w)) + kept_windows = Fcons (listn (6, window, p->buffer, Fmarker_last_position (p->start), - Fmarker_last_position (p->pointm)), + Fmarker_last_position (p->pointm), + p->dedicated, Qt), kept_windows); } else if (!NILP (w->start)) @@ -7398,16 +7386,25 @@ the return value is nil. Otherwise the value is t. */) set_marker_restricted_both (w->pointm, w->contents, 0, 0); set_marker_restricted_both (w->old_pointm, w->contents, 0, 0); w->start_at_line_beg = true; - if (!NILP (w->dedicated)) - /* Record this window as dead. */ - dead_windows = Fcons (window, dead_windows); - /* Make sure window is no more dedicated. */ - wset_dedicated (w, Qnil); - if (!NILP (Vwindow_kept_windows_functions)) - kept_windows = Fcons (list4 (window, p->buffer, - Fmarker_last_position (p->start), - Fmarker_last_position (p->pointm)), - kept_windows); + if (!MINI_WINDOW_P (w)) + { + if (FUNCTIONP (window_restore_killed_buffer_windows)) + kept_windows + = Fcons (listn (6, window, p->buffer, + Fmarker_last_position (p->start), + Fmarker_last_position (p->pointm), + p->dedicated, Qnil), + kept_windows); + else if (EQ (window_restore_killed_buffer_windows, Qdelete) + || (!NILP (p->dedicated) + && (NILP (window_restore_killed_buffer_windows) + || EQ (window_restore_killed_buffer_windows, + Qdedicated)))) + /* Try to delete this window later. */ + dead_windows = Fcons (window, dead_windows); + /* Make sure window is no more dedicated. */ + wset_dedicated (w, Qnil); + } } } @@ -7459,13 +7456,12 @@ the return value is nil. Otherwise the value is t. */) unblock_input (); /* Scan dead buffer windows. */ - if (!NILP (Vwindow_kept_windows_functions)) - for (; CONSP (dead_windows); dead_windows = XCDR (dead_windows)) - { - window = XCAR (dead_windows); - if (WINDOW_LIVE_P (window) && !EQ (window, FRAME_ROOT_WINDOW (f))) - delete_deletable_window (window); - } + for (; CONSP (dead_windows); dead_windows = XCDR (dead_windows)) + { + window = XCAR (dead_windows); + if (WINDOW_LIVE_P (window) && !EQ (window, FRAME_ROOT_WINDOW (f))) + delete_deletable_window (window); + } /* Record the selected window's buffer here. The window should already be the selected one from the call above. */ @@ -7513,9 +7509,9 @@ the return value is nil. Otherwise the value is t. */) SAFE_FREE (); - if (!NILP (Vrun_hooks) && !NILP (Vwindow_kept_windows_functions)) - run_hook_with_args_2 (Qwindow_kept_windows_functions, frame, - kept_windows); + if (!NILP (Vrun_hooks) && FUNCTIONP (window_restore_killed_buffer_windows)) + safe_calln (window_restore_killed_buffer_windows, + frame, kept_windows, Qconfiguration); return FRAME_LIVE_P (f) ? Qt : Qnil; } @@ -8514,8 +8510,9 @@ syms_of_window (void) DEFSYM (Qheader_line_format, "header-line-format"); DEFSYM (Qtab_line_format, "tab-line-format"); DEFSYM (Qno_other_window, "no-other-window"); - DEFSYM (Qwindow_kept_windows_functions, - "window-kept-windows-functions"); + DEFSYM (Qconfiguration, "configuration"); + DEFSYM (Qdelete, "delete"); + DEFSYM (Qdedicated, "dedicated"); DEFVAR_LISP ("temp-buffer-show-function", Vtemp_buffer_show_function, doc: /* Non-nil means call as function to display a help buffer. @@ -8673,27 +8670,59 @@ its buffer or its total or body size since the last redisplay. Each call is performed with the frame temporarily selected. */); Vwindow_configuration_change_hook = Qnil; - DEFVAR_LISP ("window-kept-windows-functions", - Vwindow_kept_windows_functions, - doc: /* Functions run after restoring a window configuration or state. -These functions are called by `set-window-configuration' and -`window-state-put'. When the value of this variable is non-nil, these -functions restore any window whose buffer has been deleted since the -corresponding configuration or state was saved. Rather than deleting -such a window, `set-window-configuration' and `window-state-put' show -some live buffer in it. - -The value should be a list of functions that take two arguments. The -first argument specifies the frame whose configuration has been -restored. The second argument, if non-nil, specifies a list of entries -for each window whose buffer has been found dead at the time -'set-window-configuration' or `window-state-put' tried to restore it in -that window. Each entry is a list of four values - the window whose -buffer was found dead, the dead buffer, and the positions of start and -point of the buffer in that window. Note that the window may be already -dead since another function on this list may have deleted it in the -meantime. */); - Vwindow_kept_windows_functions = Qnil; + DEFVAR_LISP ("window-restore-killed-buffer-windows", + window_restore_killed_buffer_windows, + doc: /* Control restoring windows whose buffer was killed. +This variable specifies how the functions `set-window-configuration' and +`window-state-put' shall handle a window whose buffer has been killed +since the corresponding configuration or state was made. Any such +window may be live - in which case it shows some other buffer - or dead +at the time one of these functions is called. + +As a rule, `set-window-configuration' leaves the window alone if it is +live while `window-state-put' deletes it. The following values can be +used to override the default behavior for dead windows in the case of +`set-window-configuration' and for dead and live windows in the case of +`window-state-put'. + +- t means to restore the window and show some other buffer in it. + +- `delete' means to try to delete the window. + +- `dedicated' means to try to delete the window if and only if it is + dedicated to its buffer. + +- nil, the default, means that `set-window-configuration' will try to + delete the window if and only if it is dedicated to its buffer while + `window-state-put' will unconditionally try to delete it. + +- a function means to restore the window, show some other buffer in it + and add an entry for that window to a list that will be later passed + as argument to that function. + +If a window cannot be deleted (typically, because it is the last window +on its frame), show another buffer in it. + +If the value is a function, it should take three arguments. The first +argument specifies the frame whose windows have been restored. The +third argument is the constant `configuration' if the windows are +restored by `set-window-configuration' and the constant `state' if the +windows are restored by `window-state-put'. + +The second argument specifies a list of entries for @emph{any} window +whose previous buffer has been encountered dead at the time +`set-window-configuration' or `window-state-put' tried to restore it in +that window (minibuffer windows are excluded). This means that the +function specified by this variable may also delete windows encountered +live by `set-window-configuration'. + +Each entry is a list of six values - the window whose buffer was found +dead, the dead buffer or its name, the positions of start and point of +the buffer in that window, the dedicated status of the window as +reported by `window-dedicated-p' and a boolean - t if the window was +live when `set-window-configuration' tried to restore it and nil +otherwise. */); + window_restore_killed_buffer_windows = Qnil; DEFVAR_LISP ("recenter-redisplay", Vrecenter_redisplay, doc: /* Non-nil means `recenter' redraws entire frame. -- cgit v1.2.3 From 3858e4f22946dc49d2d3dde5f45a65eab83fd7aa Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Fri, 15 Mar 2024 11:53:31 +0100 Subject: Fix bug with CHECK_STRUCTS introduced by last buffer.h change * src/pdumper.c (dump_buffer): Fix HASH_buffer_. Assign last_name_ field. --- src/pdumper.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/pdumper.c b/src/pdumper.c index f0bce09cbde..c7ebb38dea5 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2796,7 +2796,7 @@ dump_obarray (struct dump_context *ctx, Lisp_Object object) static dump_off dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) { -#if CHECK_STRUCTS && !defined HASH_buffer_EBBA38AEFA +#if CHECK_STRUCTS && !defined HASH_buffer_B02F648B82 # error "buffer changed. See CHECK_STRUCTS comment in config.h." #endif struct buffer munged_buffer = *in_buffer; @@ -2808,6 +2808,7 @@ dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) else eassert (buffer->window_count == -1); buffer->local_minor_modes_ = Qnil; + buffer->last_name_ = Qnil; buffer->last_selected_window_ = Qnil; buffer->display_count_ = make_fixnum (0); buffer->clip_changed = 0; -- cgit v1.2.3 From ed48b0d657cbf183a3e391a95672f921688e6ba8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 15 Mar 2024 13:29:31 +0200 Subject: ; * CONTRIBUTE: Ask not to use non-ASCII unless necessary. --- CONTRIBUTE | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CONTRIBUTE b/CONTRIBUTE index cdb47911d76..af5519c1bb3 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -237,6 +237,8 @@ formatting them: particular, gnu.org and fsf.org URLs should start with "https:". - Commit messages should contain only printable UTF-8 characters. + However, we ask that non-ASCII characters be used only if strictly + necessary, not just for aesthetic purposes. - Commit messages should not contain the "Signed-off-by:" lines that are used in some other projects. -- cgit v1.2.3 From bf3d296d24ea24fb707a9410fccd745523347d2a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 15 Mar 2024 14:22:14 +0200 Subject: ; Fix documentation of a recent change (bug#68235) * etc/NEWS: * doc/lispref/windows.texi (Window Configurations): Improve wording of 'window-restore-killed-buffer-windows's doc. * src/window.c (syms_of_window) : Doc fix. * etc/NEWS: * doc/lispref/buffers.texi (Buffer Names): Document 'buffer-last-name'. --- doc/lispref/buffers.texi | 6 ++++++ doc/lispref/windows.texi | 39 ++++++++++++++++++---------------- etc/NEWS | 6 +++++- src/window.c | 54 +++++++++++++++++++++++++----------------------- 4 files changed, 60 insertions(+), 45 deletions(-) diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 77f5f09c7bd..5375eb64155 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -371,6 +371,12 @@ See the related function @code{generate-new-buffer} in @ref{Creating Buffers}. @end defun +@defun buffer-last-name &optional buffer +This function returns the previous name of @var{buffer}, before it was +killed or before the last time it was renamed. If nil or omitted, +@var{buffer} defaults to the current buffer. +@end defun + @node Buffer File Name @section Buffer File Name @cindex visited file diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 45d67ba4946..8fa4e57b153 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -6376,8 +6376,8 @@ fine-tune that behavior. @defvar window-restore-killed-buffer-windows This variable specifies how @code{set-window-configuration} and @code{window-state-put} shall handle a window whose buffer has been -killed since the corresponding configuration or state was made. Any -such window may be live - in which case it shows some other buffer - or +killed since the corresponding configuration or state was recorded. Any +such window may be live---in which case it shows some other buffer---or dead at the time one of these functions is called. Usually, @code{set-window-configuration} leaves the window alone if it is live while @code{window-state-put} deletes it. @@ -6399,14 +6399,15 @@ This means to try to delete the window if and only if it is dedicated to its buffer. @item @code{nil} -This is the default and means that @code{set-window-configuration} will -try to delete the window if and only if it is dedicated to its buffer -and @code{window-state-put} will unconditionally try to delete it. +This is the default, and it means that @code{set-window-configuration} +will try to delete the window if and only if it is dedicated to its +buffer, and @code{window-state-put} will unconditionally try to delete +it. @item a function -This means to restore the window, show some other buffer in it and add -an entry for that window to a list that will be later passed as argument -to that function. +This means to restore the window and show some other buffer in it, like +if the value is @code{t}, and also add an entry for that window to a +list that will be later passed as the second argument to that function. @end table If a window cannot be deleted (typically, because it is the last window @@ -6417,21 +6418,23 @@ If the value of this variable is a function, that function should take three arguments. The first argument specifies the frame whose windows have been restored. The third argument is either the constant @code{configuration} if the windows are restored by -@code{set-window-configuration} or the constant @code{state} if the +@code{set-window-configuration}, or the constant @code{state} if the windows are restored by @code{window-state-put}. -The second argument specifies a list of entries for @emph{any} window -whose previous buffer has been encountered dead at the time +The second argument specifies a list of entries for @emph{all} windows +whose previous buffers have been found dead at the time @code{set-window-configuration} or @code{window-state-put} tried to restore it in that window (minibuffer windows are excluded). This means -that the function specified by this variable may also delete windows -encountered live by @code{set-window-configuration}. - -Each entry is a list of six values - the window whose buffer was found -dead, the dead buffer or its name, the positions of start and point of -the buffer in that window, the dedicated status of the window as +that the function may also delete windows which were found live by +@code{set-window-configuration}. + +Each entry in the list that is passed as the second argument to the +function is itself a list of six values: the window whose buffer was +found dead, the dead buffer or its name, the positions of window-start +(@pxref{Window Start and End}) and window-point (@pxref{Window Point}) +of the buffer in that window, the dedicated state of the window as previously reported by @code{window-dedicated-p} and a flag that is -@code{t} if the window has been encountered live by +@code{t} if the window has been found to be alive by @code{set-window-configuration} and @code{nil} otherwise. @end defvar diff --git a/etc/NEWS b/etc/NEWS index dfbf6edb098..a654d2d8d79 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -287,7 +287,7 @@ selected or deselected at the end of executing the current command. *** New variable 'window-restore-killed-buffer-windows'. It specifies how 'set-window-configuration' and 'window-state-put' should proceed with windows whose buffer was killed after the -corresponding configuration or state was made. +corresponding configuration or state was recorded. ** Tab Bars and Tab Lines @@ -1812,6 +1812,10 @@ styles to skip eager fontification of completion candidates, which improves performance. Such a Lisp program can then use the 'completion-lazy-hilit' function to fontify candidates just in time. +** New primitive 'buffer-last-name'. +It returns the name of a buffer before the last time it was renamed or +killed. + ** Functions and variables to transpose sexps +++ diff --git a/src/window.c b/src/window.c index 928c4ae02a8..2c002418605 100644 --- a/src/window.c +++ b/src/window.c @@ -8675,30 +8675,32 @@ call is performed with the frame temporarily selected. */); doc: /* Control restoring windows whose buffer was killed. This variable specifies how the functions `set-window-configuration' and `window-state-put' shall handle a window whose buffer has been killed -since the corresponding configuration or state was made. Any such -window may be live - in which case it shows some other buffer - or dead -at the time one of these functions is called. +since the corresponding configuration or state was recorded. Any such +window may be live -- in which case it shows some other buffer -- or +dead at the time one of these functions is called. -As a rule, `set-window-configuration' leaves the window alone if it is -live while `window-state-put' deletes it. The following values can be +By default, `set-window-configuration' leaves the window alone if it is +live, while `window-state-put' deletes it. The following values can be used to override the default behavior for dead windows in the case of `set-window-configuration' and for dead and live windows in the case of `window-state-put'. -- t means to restore the window and show some other buffer in it. + - t means to restore the window and show some other buffer in it. -- `delete' means to try to delete the window. + - `delete' means to try to delete the window. -- `dedicated' means to try to delete the window if and only if it is - dedicated to its buffer. + - `dedicated' means to try to delete the window if and only if it is + dedicated to its buffer. -- nil, the default, means that `set-window-configuration' will try to - delete the window if and only if it is dedicated to its buffer while - `window-state-put' will unconditionally try to delete it. + - nil, the default, which means that `set-window-configuration' will + try to delete the window if and only if it is dedicated to its + buffer while `window-state-put' will unconditionally try to delete + it. -- a function means to restore the window, show some other buffer in it - and add an entry for that window to a list that will be later passed - as argument to that function. + - a function means to restore the window and show some other buffer in + it, like if the value were t, but also to add an entry for that + window to a list that will be later passed as argument to that + function. If a window cannot be deleted (typically, because it is the last window on its frame), show another buffer in it. @@ -8709,19 +8711,19 @@ third argument is the constant `configuration' if the windows are restored by `set-window-configuration' and the constant `state' if the windows are restored by `window-state-put'. -The second argument specifies a list of entries for @emph{any} window -whose previous buffer has been encountered dead at the time +The second argument specifies a list of entries for all windows +whose previous buffers have been found dead at the time `set-window-configuration' or `window-state-put' tried to restore it in that window (minibuffer windows are excluded). This means that the -function specified by this variable may also delete windows encountered -live by `set-window-configuration'. - -Each entry is a list of six values - the window whose buffer was found -dead, the dead buffer or its name, the positions of start and point of -the buffer in that window, the dedicated status of the window as -reported by `window-dedicated-p' and a boolean - t if the window was -live when `set-window-configuration' tried to restore it and nil -otherwise. */); +function specified by this variable may also delete windows which were +found to be alive by `set-window-configuration'. + +Each entry is a list of six values: the window whose buffer was found +dead, the dead buffer or its name, the positions of window-start and +window-point of the buffer in that window, the dedicated state of the +window as reported by `window-dedicated-p', and a boolean -- t if the +window was live when `set-window-configuration' tried to restore it, +and nil otherwise. */); window_restore_killed_buffer_windows = Qnil; DEFVAR_LISP ("recenter-redisplay", Vrecenter_redisplay, -- cgit v1.2.3 From c393c0467972cba9dc7ed256acd72b553204c33a Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 15 Mar 2024 12:32:06 +0100 Subject: * lisp/emacs-lisp/advice.el (comp-subr-trampoline-install): Don't declare. --- lisp/emacs-lisp/advice.el | 2 -- 1 file changed, 2 deletions(-) diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 9489a9fd1b3..752660156b9 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2042,8 +2042,6 @@ in that CLASS." function class name))) (error "ad-remove-advice: `%s' is not advised" function))) -(declare-function comp-subr-trampoline-install "comp-run") - ;;;###autoload (defun ad-add-advice (function advice class position) "Add a piece of ADVICE to FUNCTION's list of advices in CLASS. -- cgit v1.2.3 From 005536285585bcdf5a67a01cdfd8e1242742f953 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 15 Mar 2024 14:18:51 +0100 Subject: * Don't install unnecessary trampolines (bug#69573) * lisp/emacs-lisp/comp-run.el (comp-subr-trampoline-install): Check that subr-name actually matches the target subr. --- lisp/emacs-lisp/comp-run.el | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index 057760322ab..afb46e3cd19 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -364,13 +364,15 @@ Return the trampoline if found or nil otherwise." (when (memq subr-name comp-warn-primitives) (warn "Redefining `%s' might break native compilation of trampolines." subr-name)) - (unless (or (null native-comp-enable-subr-trampolines) - (memq subr-name native-comp-never-optimize-functions) - (gethash subr-name comp-installed-trampolines-h)) - (cl-assert (subr-primitive-p (symbol-function subr-name))) - (when-let ((trampoline (or (comp-trampoline-search subr-name) - (comp-trampoline-compile subr-name)))) - (comp--install-trampoline subr-name trampoline)))) + (let ((subr (symbol-function subr-name))) + (unless (or (not (string= subr-name (subr-name subr))) ;; (bug#69573) + (null native-comp-enable-subr-trampolines) + (memq subr-name native-comp-never-optimize-functions) + (gethash subr-name comp-installed-trampolines-h)) + (cl-assert (subr-primitive-p subr)) + (when-let ((trampoline (or (comp-trampoline-search subr-name) + (comp-trampoline-compile subr-name)))) + (comp--install-trampoline subr-name trampoline))))) ;;;###autoload (defun native--compile-async (files &optional recursively load selector) -- cgit v1.2.3 From 7231a89524f280c51278c3c74c6ae2215a307f0f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 15 Mar 2024 12:45:09 -0400 Subject: * lisp/emacs-lisp/bindat.el (sint): Burp in dynbind (bug#69749) --- lisp/emacs-lisp/bindat.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index ef0ec688dbd..42ba89ba2c1 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -944,9 +944,13 @@ a bindat type expression." (bindat-defmacro sint (bitlen le) "Signed integer of size BITLEN. Big-endian if LE is nil and little-endian if not." + (unless lexical-binding + (error "The `sint' type requires 'lexical-binding'")) (let ((bl (make-symbol "bitlen")) (max (make-symbol "max")) (wrap (make-symbol "wrap"))) + ;; FIXME: This `let*' around the `struct' results in code which the + ;; byte-compiler does not handle efficiently. 🙁 `(let* ((,bl ,bitlen) (,max (ash 1 (1- ,bl))) (,wrap (+ ,max ,max))) -- cgit v1.2.3 From 3b791ebbe173fa18515558acaafbef1f88c51791 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sat, 16 Mar 2024 00:19:43 +0100 Subject: ; Fix 'usage:' keyword in Ffile_name_concat doc. --- src/fileio.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fileio.c b/src/fileio.c index a2e230879c3..a5d29d81fb7 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -759,7 +759,7 @@ Elements in COMPONENTS must be a string or nil. DIRECTORY or the non-final elements in COMPONENTS may or may not end with a slash -- if they don't end with a slash, a slash will be inserted before concatenating. -usage: (record DIRECTORY &rest COMPONENTS) */) +usage: (file-name-concat DIRECTORY &rest COMPONENTS) */) (ptrdiff_t nargs, Lisp_Object *args) { ptrdiff_t chars = 0, bytes = 0, multibytes = 0, eargs = 0; -- cgit v1.2.3 From 983d17309911b84199e43a83d841cf7caff47316 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sat, 16 Mar 2024 00:23:41 +0100 Subject: ; * src/eval.c (Fhandler_bind_1): Fix docstring. --- src/eval.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/eval.c b/src/eval.c index 95eb21909d2..f48d7b0682f 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1374,8 +1374,8 @@ push_handler_bind (Lisp_Object conditions, Lisp_Object handler, int skip) } DEFUN ("handler-bind-1", Fhandler_bind_1, Shandler_bind_1, 1, MANY, 0, - doc: /* Setup error handlers around execution of BODYFUN. -BODYFUN be a function and it is called with no arguments. + doc: /* Set up error handlers around execution of BODYFUN. +BODYFUN should be a function and it is called with no arguments. CONDITIONS should be a list of condition names (symbols). When an error is signaled during execution of BODYFUN, if that error matches one of CONDITIONS, then the associated HANDLER is -- cgit v1.2.3 From bbbf1e6f2d5c93e51e62c33529d3098b1ee46616 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 16 Mar 2024 09:29:42 +0800 Subject: Fix calc.texi for Texinfo 4.13 * doc/misc/calc.texi (Fractions): Replace instances of @U with raw Unicode characters and adjust the document encoding suitably. --- doc/misc/calc.texi | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index dacf1451cc2..ac2ac5a0f91 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -6,6 +6,7 @@ @settitle GNU Emacs Calc Manual @include docstyle.texi @setchapternewpage odd +@documentencoding UTF-8 @comment %**end of header (This is for running Texinfo on a region.) @include emacsver.texi @@ -10572,12 +10573,11 @@ Non-decimal fractions are entered and displayed as form). The numerator and denominator always use the same radix. @ifnottex -Fractions may also be entered with @kbd{@U{2044}} (U+2044 FRACTION -SLASH) in place of any @kbd{:}. Precomposed fraction characters from -@kbd{@U{00BD}} (U+00BD VULGAR FRACTION ONE HALF) through -@kbd{@U{215E}} (U+215E VULGAR FRACTION SEVEN EIGHTHS) are supported as -well. Thus, @samp{2:3}, @samp{2@U{2044}3}, and @samp{@U{2154}} are all -equivalent. +Fractions may also be entered with @kbd{⁄} (U+2044 FRACTION SLASH) in +place of any @kbd{:}. Precomposed fraction characters from @kbd{½} +(U+00BD VULGAR FRACTION ONE HALF) through @kbd{⅞} (U+215E VULGAR +FRACTION SEVEN EIGHTHS) are supported as well. Thus, @samp{2:3}, +@samp{2⁄3}, and @samp{⅞} are all equivalent. @end ifnottex @iftex Fractions may also be entered with U+2044 FRACTION SLASH in place of -- cgit v1.2.3 From 6461854f47d0b768e0550b46317045811a8cbe80 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 16 Mar 2024 09:50:58 +0800 Subject: ; Circumvent miscompilations on Sun C 5.12 (148917-07) * src/minibuf.c (Ftry_completion, Fall_completions): Transform ternary expressions after open-ended if statements into proper if/else statements. --- src/minibuf.c | 30 ++++++++++++++++++------------ 1 file changed, 18 insertions(+), 12 deletions(-) diff --git a/src/minibuf.c b/src/minibuf.c index df6ca7ce1d8..51816133fb2 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1701,11 +1701,12 @@ or from one of the possible completions. */) tem = Fcommandp (elt, Qnil); else { - tem = (type == hash_table - ? call2 (predicate, elt, - HASH_VALUE (XHASH_TABLE (collection), - idx - 1)) - : call1 (predicate, elt)); + if (type == hash_table) + tem = call2 (predicate, elt, + HASH_VALUE (XHASH_TABLE (collection), + idx - 1)); + else + tem = call1 (predicate, elt); } if (NILP (tem)) continue; } @@ -1845,9 +1846,12 @@ with a space are ignored unless STRING itself starts with a space. */) Lisp_Object allmatches; if (VECTORP (collection)) collection = check_obarray (collection); - int type = HASH_TABLE_P (collection) ? 3 - : OBARRAYP (collection) ? 2 - : NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection)); + int type = (HASH_TABLE_P (collection) + ? 3 : (OBARRAYP (collection) + ? 2 : ((NILP (collection) + || (CONSP (collection) + && !FUNCTIONP (collection))) + ? 1 : 0))); ptrdiff_t idx = 0; Lisp_Object bucket, tem, zero; @@ -1931,10 +1935,12 @@ with a space are ignored unless STRING itself starts with a space. */) tem = Fcommandp (elt, Qnil); else { - tem = type == 3 - ? call2 (predicate, elt, - HASH_VALUE (XHASH_TABLE (collection), idx - 1)) - : call1 (predicate, elt); + if (type == 3) + tem = call2 (predicate, elt, + HASH_VALUE (XHASH_TABLE (collection), + idx - 1)); + else + tem = call1 (predicate, elt); } if (NILP (tem)) continue; } -- cgit v1.2.3 From c77e35efd36f2c43e87066faa4257606d5c6f849 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 16 Mar 2024 09:55:23 +0800 Subject: * doc/lispref/frames.texi (Window System Selections): Fix misuse of xref. --- doc/lispref/frames.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 16c0432da3a..cf7fc7721c5 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4052,8 +4052,8 @@ programs. It takes two optional arguments, @var{type} and The @var{data-type} argument specifies the form of data conversion to use, to convert the raw data obtained from another program into Lisp -data. @xref{X Selections}, for an enumeration of data types valid -under X, and @xref{Other Selections} for those elsewhere. +data. @xref{X Selections}, for an enumeration of data types valid under +X, and @pxref{Other Selections} for those elsewhere. @end defun @defopt selection-coding-system -- cgit v1.2.3 From 4d03f70b7f01477a8d72f827ba8b0dabba8c0a61 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 16 Mar 2024 15:12:33 +0800 Subject: Correct doc strings for x-*-keysym * src/xterm.c (syms_of_xterm): Clarify whether x-*-keysym affects the modifier key reported for a keysym or the other way around. --- src/xterm.c | 42 ++++++++++++++++++++++-------------------- 1 file changed, 22 insertions(+), 20 deletions(-) diff --git a/src/xterm.c b/src/xterm.c index c8a43785564..bebc30c9103 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -32536,38 +32536,40 @@ Android does not support scroll bars at all. */); DEFSYM (Qreally_fast, "really-fast"); DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym, - doc: /* Which keys Emacs uses for the ctrl modifier. -This should be one of the symbols `ctrl', `alt', `hyper', `meta', -`super'. For example, `ctrl' means use the Ctrl_L and Ctrl_R keysyms. -The default is nil, which is the same as `ctrl'. */); + doc: /* Which modifer value Emacs reports when Ctrl is depressed. +This should be one of the symbols `ctrl', `alt', `hyper', `meta', or +`super', representing a modifier to be reported in key events with the +Ctrl modifier (i.e. the keysym Ctrl_L or Ctrl_R) depressed. */); Vx_ctrl_keysym = Qnil; DEFVAR_LISP ("x-alt-keysym", Vx_alt_keysym, - doc: /* Which keys Emacs uses for the alt modifier. -This should be one of the symbols `ctrl', `alt', `hyper', `meta', -`super'. For example, `alt' means use the Alt_L and Alt_R keysyms. -The default is nil, which is the same as `alt'. */); + doc: /* Which modifer value Emacs reports when Alt is depressed. +This should be one of the symbols `ctrl', `alt', `hyper', `meta', or +`super', representing a modifier to be reported in key events with the +Alt modifier (e.g. the keysym Alt_L or Alt_R, if the keyboard features a +dedicated key for Meta) depressed. */); Vx_alt_keysym = Qnil; DEFVAR_LISP ("x-hyper-keysym", Vx_hyper_keysym, - doc: /* Which keys Emacs uses for the hyper modifier. -This should be one of the symbols `ctrl', `alt', `hyper', `meta', -`super'. For example, `hyper' means use the Hyper_L and Hyper_R -keysyms. The default is nil, which is the same as `hyper'. */); + doc: /* Which modifer value Emacs reports when Hyper is depressed. +This should be one of the symbols `ctrl', `alt', `hyper', `meta', or +`super', representing a modifier to be reported in key events with the +Hyper modifier (i.e. the keysym Hyper_L or Hyper_R) depressed. */); Vx_hyper_keysym = Qnil; DEFVAR_LISP ("x-meta-keysym", Vx_meta_keysym, - doc: /* Which keys Emacs uses for the meta modifier. -This should be one of the symbols `ctrl', `alt', `hyper', `meta', -`super'. For example, `meta' means use the Meta_L and Meta_R keysyms. -The default is nil, which is the same as `meta'. */); + doc: /* Which modifer value Emacs reports when Meta is depressed. +This should be one of the symbols `ctrl', `alt', `hyper', `meta', or +`super', representing a modifier to be reported in key events with the +Meta modifier (e.g. the keysym Alt_L or Alt_R, when the keyboard does +not feature a dedicated key for Meta) depressed. */); Vx_meta_keysym = Qnil; DEFVAR_LISP ("x-super-keysym", Vx_super_keysym, - doc: /* Which keys Emacs uses for the super modifier. -This should be one of the symbols `ctrl', `alt', `hyper', `meta', -`super'. For example, `super' means use the Super_L and Super_R -keysyms. The default is nil, which is the same as `super'. */); + doc: /* Which modifer value Emacs reports when Super is depressed. +This should be one of the symbols `ctrl', `alt', `hyper', `meta', or +`super', representing a modifier to be reported in key events with the +Super modifier (i.e. the keysym Super_L or Super_R) depressed. */); Vx_super_keysym = Qnil; DEFVAR_LISP ("x-wait-for-event-timeout", Vx_wait_for_event_timeout, -- cgit v1.2.3 From 658529921614b8d5498c267a7ffc786c25d2d26f Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 16 Mar 2024 15:13:09 +0800 Subject: Support x-*-keysym on Android * src/androidterm.c (android_android_to_emacs_modifiers) (android_emacs_to_android_modifiers, syms_of_androidterm): Port x-*-keysym from xterm.c. --- src/androidterm.c | 81 ++++++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 71 insertions(+), 10 deletions(-) diff --git a/src/androidterm.c b/src/androidterm.c index f68f8a9ef62..9948a2919d8 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -361,22 +361,52 @@ static int android_android_to_emacs_modifiers (struct android_display_info *dpyinfo, int state) { - return (((state & ANDROID_CONTROL_MASK) ? ctrl_modifier : 0) - | ((state & ANDROID_SHIFT_MASK) ? shift_modifier : 0) - | ((state & ANDROID_ALT_MASK) ? meta_modifier : 0) - | ((state & ANDROID_SUPER_MASK) ? super_modifier : 0) - | ((state & ANDROID_META_MASK) ? alt_modifier : 0)); + int mod_ctrl = ctrl_modifier; + int mod_meta = meta_modifier; + int mod_alt = alt_modifier; + int mod_super = super_modifier; + Lisp_Object tem; + + tem = Fget (Vx_ctrl_keysym, Qmodifier_value); + if (FIXNUMP (tem)) mod_ctrl = XFIXNUM (tem) & INT_MAX; + tem = Fget (Vx_alt_keysym, Qmodifier_value); + if (FIXNUMP (tem)) mod_alt = XFIXNUM (tem) & INT_MAX; + tem = Fget (Vx_meta_keysym, Qmodifier_value); + if (FIXNUMP (tem)) mod_meta = XFIXNUM (tem) & INT_MAX; + tem = Fget (Vx_super_keysym, Qmodifier_value); + if (FIXNUMP (tem)) mod_super = XFIXNUM (tem) & INT_MAX; + + return (((state & ANDROID_CONTROL_MASK) ? mod_ctrl : 0) + | ((state & ANDROID_SHIFT_MASK) ? mod_shift : 0) + | ((state & ANDROID_ALT_MASK) ? mod_meta : 0) + | ((state & ANDROID_SUPER_MASK) ? mod_super : 0) + | ((state & ANDROID_META_MASK) ? mod_alt : 0)); } static int android_emacs_to_android_modifiers (struct android_display_info *dpyinfo, intmax_t state) { - return (((state & ctrl_modifier) ? ANDROID_CONTROL_MASK : 0) - | ((state & shift_modifier) ? ANDROID_SHIFT_MASK : 0) - | ((state & meta_modifier) ? ANDROID_ALT_MASK : 0) - | ((state & super_modifier) ? ANDROID_SUPER_MASK : 0) - | ((state & alt_modifier) ? ANDROID_META_MASK : 0)); + EMACS_INT mod_ctrl = ctrl_modifier; + EMACS_INT mod_meta = meta_modifier; + EMACS_INT mod_alt = alt_modifier; + EMACS_INT mod_super = super_modifier; + Lisp_Object tem; + + tem = Fget (Vx_ctrl_keysym, Qmodifier_value); + if (FIXNUMP (tem)) mod_ctrl = XFIXNUM (tem); + tem = Fget (Vx_alt_keysym, Qmodifier_value); + if (FIXNUMP (tem)) mod_alt = XFIXNUM (tem); + tem = Fget (Vx_meta_keysym, Qmodifier_value); + if (FIXNUMP (tem)) mod_meta = XFIXNUM (tem); + tem = Fget (Vx_super_keysym, Qmodifier_value); + if (FIXNUMP (tem)) mod_super = XFIXNUM (tem); + + return (((state & mod_ctrl) ? ANDROID_CONTROL_MASK : 0) + | ((state & mod_shift) ? ANDROID_SHIFT_MASK : 0) + | ((state & mod_meta) ? ANDROID_ALT_MASK : 0) + | ((state & mod_super) ? ANDROID_SUPER_MASK : 0) + | ((state & mod_alt) ? ANDROID_META_MASK : 0)); } static void android_frame_rehighlight (struct android_display_info *); @@ -6670,6 +6700,26 @@ Emacs is running on. */); doc: /* Name of the developer of the running version of Android. */); Vandroid_build_manufacturer = Qnil; + DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym, + doc: /* SKIP: real doc in xterm.c. */); + Vx_ctrl_keysym = Qnil; + + DEFVAR_LISP ("x-alt-keysym", Vx_alt_keysym, + doc: /* SKIP: real doc in xterm.c. */); + Vx_alt_keysym = Qnil; + + DEFVAR_LISP ("x-hyper-keysym", Vx_hyper_keysym, + doc: /* SKIP: real doc in xterm.c. */); + Vx_hyper_keysym = Qnil; + + DEFVAR_LISP ("x-meta-keysym", Vx_meta_keysym, + doc: /* SKIP: real doc in xterm.c. */); + Vx_meta_keysym = Qnil; + + DEFVAR_LISP ("x-super-keysym", Vx_super_keysym, + doc: /* SKIP: real doc in xterm.c. */); + Vx_super_keysym = Qnil; + /* Only defined so loadup.el loads scroll-bar.el. */ DEFVAR_LISP ("x-toolkit-scroll-bars", Vx_toolkit_scroll_bars, doc: /* SKIP: real doc in xterm.c. */); @@ -6683,6 +6733,17 @@ Emacs is running on. */); /* Symbols defined for DND events. */ DEFSYM (Quri, "uri"); DEFSYM (Qtext, "text"); + + /* Symbols defined for modifier value reassignment. */ + DEFSYM (Qmodifier_value, "modifier-value"); + DEFSYM (Qctrl, "ctrl"); + Fput (Qctrl, Qmodifier_value, make_fixnum (ctrl_modifier)); + DEFSYM (Qalt, "alt"); + Fput (Qalt, Qmodifier_value, make_fixnum (alt_modifier)); + DEFSYM (Qmeta, "meta"); + Fput (Qmeta, Qmodifier_value, make_fixnum (meta_modifier)); + DEFSYM (Qsuper, "super"); + Fput (Qsuper, Qmodifier_value, make_fixnum (super_modifier)); } void -- cgit v1.2.3 From 28e481bf7af873cdaf016e25855a8e0ebc424fe7 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 16 Mar 2024 15:15:10 +0800 Subject: Respond to default action from Gnus notifications * lisp/gnus/gnus-notifications.el (gnus-notifications-action): Consider default equivalent to read. --- lisp/gnus/gnus-notifications.el | 5 +++-- src/androidterm.c | 20 ++++++++++---------- 2 files changed, 13 insertions(+), 12 deletions(-) diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el index 35f90ebfe40..e4c3d2c0381 100644 --- a/lisp/gnus/gnus-notifications.el +++ b/lisp/gnus/gnus-notifications.el @@ -75,10 +75,11 @@ not get notifications." (when group-article (let ((group (cadr group-article)) (article (nth 2 group-article))) - (cond ((string= key "read") + (cond ((or (equal key "read") + (equal key "default")) (gnus-fetch-group group (list article)) (select-frame-set-input-focus (selected-frame))) - ((string= key "mark-read") + ((equal key "mark-read") (gnus-update-read-articles group (delq article (gnus-list-of-unread-articles group))) diff --git a/src/androidterm.c b/src/androidterm.c index 9948a2919d8..ba9b6d3b8a9 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -376,11 +376,11 @@ android_android_to_emacs_modifiers (struct android_display_info *dpyinfo, tem = Fget (Vx_super_keysym, Qmodifier_value); if (FIXNUMP (tem)) mod_super = XFIXNUM (tem) & INT_MAX; - return (((state & ANDROID_CONTROL_MASK) ? mod_ctrl : 0) - | ((state & ANDROID_SHIFT_MASK) ? mod_shift : 0) - | ((state & ANDROID_ALT_MASK) ? mod_meta : 0) - | ((state & ANDROID_SUPER_MASK) ? mod_super : 0) - | ((state & ANDROID_META_MASK) ? mod_alt : 0)); + return (((state & ANDROID_CONTROL_MASK) ? mod_ctrl : 0) + | ((state & ANDROID_SHIFT_MASK) ? shift_modifier : 0) + | ((state & ANDROID_ALT_MASK) ? mod_meta : 0) + | ((state & ANDROID_SUPER_MASK) ? mod_super : 0) + | ((state & ANDROID_META_MASK) ? mod_alt : 0)); } static int @@ -402,11 +402,11 @@ android_emacs_to_android_modifiers (struct android_display_info *dpyinfo, tem = Fget (Vx_super_keysym, Qmodifier_value); if (FIXNUMP (tem)) mod_super = XFIXNUM (tem); - return (((state & mod_ctrl) ? ANDROID_CONTROL_MASK : 0) - | ((state & mod_shift) ? ANDROID_SHIFT_MASK : 0) - | ((state & mod_meta) ? ANDROID_ALT_MASK : 0) - | ((state & mod_super) ? ANDROID_SUPER_MASK : 0) - | ((state & mod_alt) ? ANDROID_META_MASK : 0)); + return (((state & mod_ctrl) ? ANDROID_CONTROL_MASK : 0) + | ((state & shift_modifier) ? ANDROID_SHIFT_MASK : 0) + | ((state & mod_meta) ? ANDROID_ALT_MASK : 0) + | ((state & mod_super) ? ANDROID_SUPER_MASK : 0) + | ((state & mod_alt) ? ANDROID_META_MASK : 0)); } static void android_frame_rehighlight (struct android_display_info *); -- cgit v1.2.3 From deebf74b0e178f841c8f504b002b139d13889344 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 16 Mar 2024 15:18:07 +0800 Subject: ; * src/xterm.c (syms_of_xterm): Fix typo. --- src/xterm.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/xterm.c b/src/xterm.c index bebc30c9103..c30015ec8f0 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -32538,14 +32538,14 @@ Android does not support scroll bars at all. */); DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym, doc: /* Which modifer value Emacs reports when Ctrl is depressed. This should be one of the symbols `ctrl', `alt', `hyper', `meta', or -`super', representing a modifier to be reported in key events with the +`super', representing a modifier to be reported for key events with the Ctrl modifier (i.e. the keysym Ctrl_L or Ctrl_R) depressed. */); Vx_ctrl_keysym = Qnil; DEFVAR_LISP ("x-alt-keysym", Vx_alt_keysym, doc: /* Which modifer value Emacs reports when Alt is depressed. This should be one of the symbols `ctrl', `alt', `hyper', `meta', or -`super', representing a modifier to be reported in key events with the +`super', representing a modifier to be reported for key events with the Alt modifier (e.g. the keysym Alt_L or Alt_R, if the keyboard features a dedicated key for Meta) depressed. */); Vx_alt_keysym = Qnil; @@ -32553,14 +32553,14 @@ dedicated key for Meta) depressed. */); DEFVAR_LISP ("x-hyper-keysym", Vx_hyper_keysym, doc: /* Which modifer value Emacs reports when Hyper is depressed. This should be one of the symbols `ctrl', `alt', `hyper', `meta', or -`super', representing a modifier to be reported in key events with the +`super', representing a modifier to be reported for key events with the Hyper modifier (i.e. the keysym Hyper_L or Hyper_R) depressed. */); Vx_hyper_keysym = Qnil; DEFVAR_LISP ("x-meta-keysym", Vx_meta_keysym, doc: /* Which modifer value Emacs reports when Meta is depressed. This should be one of the symbols `ctrl', `alt', `hyper', `meta', or -`super', representing a modifier to be reported in key events with the +`super', representing a modifier to be reported for key events with the Meta modifier (e.g. the keysym Alt_L or Alt_R, when the keyboard does not feature a dedicated key for Meta) depressed. */); Vx_meta_keysym = Qnil; @@ -32568,7 +32568,7 @@ not feature a dedicated key for Meta) depressed. */); DEFVAR_LISP ("x-super-keysym", Vx_super_keysym, doc: /* Which modifer value Emacs reports when Super is depressed. This should be one of the symbols `ctrl', `alt', `hyper', `meta', or -`super', representing a modifier to be reported in key events with the +`super', representing a modifier to be reported for key events with the Super modifier (i.e. the keysym Super_L or Super_R) depressed. */); Vx_super_keysym = Qnil; -- cgit v1.2.3 From 899ea79310d1b8ed78c3fd8ac1784043dd732dbf Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Sat, 16 Mar 2024 10:10:29 +0100 Subject: In window-related documentation write 'symbol' instead of 'constant' Suggested by Michael Heerdegen . * src/window.c (window_restore_killed_buffer_windows): In doc-string write 'symbol' instead of 'constant'. * lisp/window.el (display-buffer--lru-window) (display-buffer-use-least-recent-window): In doc-strings write 'symbol' instead of 'constant'. * doc/lispref/windows.texi (Window Configurations): Write 'symbol' instead of 'constant'. --- doc/lispref/windows.texi | 4 ++-- lisp/window.el | 8 ++++---- src/window.c | 4 ++-- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 8fa4e57b153..2e2fdee422b 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -6416,9 +6416,9 @@ on its frame), @code{set-window-configuration} and If the value of this variable is a function, that function should take three arguments. The first argument specifies the frame whose windows -have been restored. The third argument is either the constant +have been restored. The third argument is either the symbol @code{configuration} if the windows are restored by -@code{set-window-configuration}, or the constant @code{state} if the +@code{set-window-configuration}, or the symbol @code{state} if the windows are restored by @code{window-state-put}. The second argument specifies a list of entries for @emph{all} windows diff --git a/lisp/window.el b/lisp/window.el index 246708dbd56..df55a7ca673 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -8668,11 +8668,11 @@ buffer. ALIST is a buffer display action alist as compiled by use time is higher than this. - `window-min-width' specifies a preferred minimum width in - canonical frame columns. If it is the constant `full-width', + canonical frame columns. If it is the symbol `full-width', prefer a full-width window. - `window-min-height' specifies a preferred minimum height in - canonical frame lines. If it is the constant `full-height', + canonical frame lines. If it is the symbol `full-height', prefer a full-height window. If ALIST contains a non-nil `inhibit-same-window' entry, do not @@ -8799,11 +8799,11 @@ Distinctive features are: call. `window-min-width' specifies a preferred minimum width in - canonical frame columns. If it is the constant `full-width', + canonical frame columns. If it is the symbol `full-width', prefer a full-width window. `window-min-height' specifies a preferred minimum height in - canonical frame lines. If it is the constant `full-height', + canonical frame lines. If it is the symbol `full-height', prefer a full-height window. - If the preceding steps fail, try to pop up a new window on the diff --git a/src/window.c b/src/window.c index 2c002418605..b69f4719d93 100644 --- a/src/window.c +++ b/src/window.c @@ -8707,8 +8707,8 @@ on its frame), show another buffer in it. If the value is a function, it should take three arguments. The first argument specifies the frame whose windows have been restored. The -third argument is the constant `configuration' if the windows are -restored by `set-window-configuration' and the constant `state' if the +third argument is the symbol `configuration' if the windows are +restored by `set-window-configuration' and the symbol `state' if the windows are restored by `window-state-put'. The second argument specifies a list of entries for all windows -- cgit v1.2.3 From c12852bbf61ebb9ae124033deb427b15ce1a2ffb Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Sat, 16 Mar 2024 10:46:02 +0100 Subject: Document and announce 'marker-last-position' * doc/lispref/markers.texi (Information from Markers): Document 'marker-last-position'. * etc/NEWS: Announce 'marker-last-position'. * src/window.c (window_restore_killed_buffer_windows): Minor doc-string fix. * doc/lispref/windows.texi (Window Configurations): Minor fix. --- doc/lispref/markers.texi | 7 +++++++ doc/lispref/windows.texi | 4 ++-- etc/NEWS | 5 +++++ src/window.c | 12 ++++++------ 4 files changed, 20 insertions(+), 8 deletions(-) diff --git a/doc/lispref/markers.texi b/doc/lispref/markers.texi index 3037790692c..28ad0ff73c0 100644 --- a/doc/lispref/markers.texi +++ b/doc/lispref/markers.texi @@ -283,6 +283,13 @@ This function returns the position that @var{marker} points to, or @code{nil} if it points nowhere. @end defun +@defun marker-last-position marker +This function returns the last known position of @var{marker} in its +buffer. It behaves like @code{marker-position} with one exception: If +the buffer of @var{marker} has been killed, it returns the last position +of @var{marker} in that buffer before it was killed. +@end defun + @defun marker-buffer marker This function returns the buffer that @var{marker} points into, or @code{nil} if it points nowhere. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 2e2fdee422b..eef05d94fdb 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -6424,8 +6424,8 @@ windows are restored by @code{window-state-put}. The second argument specifies a list of entries for @emph{all} windows whose previous buffers have been found dead at the time @code{set-window-configuration} or @code{window-state-put} tried to -restore it in that window (minibuffer windows are excluded). This means -that the function may also delete windows which were found live by +restore them (minibuffer windows are excluded). This means that the +function may also delete windows which were found live by @code{set-window-configuration}. Each entry in the list that is passed as the second argument to the diff --git a/etc/NEWS b/etc/NEWS index a654d2d8d79..8cad9412def 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1816,6 +1816,11 @@ improves performance. Such a Lisp program can then use the It returns the name of a buffer before the last time it was renamed or killed. +** New primitive 'marker-last-position'. +It returns the last position of MARKER in its buffer even if that buffer +has been killed. + + ** Functions and variables to transpose sexps +++ diff --git a/src/window.c b/src/window.c index b69f4719d93..748ad9e77d4 100644 --- a/src/window.c +++ b/src/window.c @@ -8711,12 +8711,12 @@ third argument is the symbol `configuration' if the windows are restored by `set-window-configuration' and the symbol `state' if the windows are restored by `window-state-put'. -The second argument specifies a list of entries for all windows -whose previous buffers have been found dead at the time -`set-window-configuration' or `window-state-put' tried to restore it in -that window (minibuffer windows are excluded). This means that the -function specified by this variable may also delete windows which were -found to be alive by `set-window-configuration'. +The second argument specifies a list of entries for all windows whose +previous buffers have been found dead at the time +`set-window-configuration' or `window-state-put' tried to restore them +(minibuffer windows are excluded). This means that the function +specified by this variable may also delete windows which were found to +be alive by `set-window-configuration'. Each entry is a list of six values: the window whose buffer was found dead, the dead buffer or its name, the positions of window-start and -- cgit v1.2.3 From d855f1c3f9c488f48694fe63bbc49d66d775c16c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 16 Mar 2024 11:58:56 +0200 Subject: ; Fix recent changes in documentation * doc/lispref/markers.texi (Information from Markers): * etc/NEWS: Improve description of 'marker-last-position'. --- doc/lispref/markers.texi | 5 +++-- etc/NEWS | 5 +++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/doc/lispref/markers.texi b/doc/lispref/markers.texi index 28ad0ff73c0..a13edb02ae6 100644 --- a/doc/lispref/markers.texi +++ b/doc/lispref/markers.texi @@ -285,9 +285,10 @@ This function returns the position that @var{marker} points to, or @defun marker-last-position marker This function returns the last known position of @var{marker} in its -buffer. It behaves like @code{marker-position} with one exception: If +buffer. It behaves like @code{marker-position} with one exception: if the buffer of @var{marker} has been killed, it returns the last position -of @var{marker} in that buffer before it was killed. +of @var{marker} in that buffer before the buffer was killed, instead of +returning @code{nil}. @end defun @defun marker-buffer marker diff --git a/etc/NEWS b/etc/NEWS index 8cad9412def..50f0ee4a1aa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1817,8 +1817,9 @@ It returns the name of a buffer before the last time it was renamed or killed. ** New primitive 'marker-last-position'. -It returns the last position of MARKER in its buffer even if that buffer -has been killed. +It returns the last position of a marker in its buffer even if that +buffer has been killed. ('marker-position' would return nil in that +case.) ** Functions and variables to transpose sexps -- cgit v1.2.3 From d5901f3f05e0aec9bf4b6b4b6ebf27c66c7cee14 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 16 Mar 2024 12:42:16 +0200 Subject: Improve documentation of 'edebug-print-*' variables * lisp/emacs-lisp/edebug.el (edebug-print-length) (edebug-print-level): Fix doc strings and customization labels. Suggested by Matt Trzcinski . (Bug#69745) --- lisp/emacs-lisp/edebug.el | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 9656bdf03d8..623b1c6a8c9 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -193,11 +193,15 @@ Use this with caution since it is not debugged." (defcustom edebug-print-length 50 - "If non-nil, default value of `print-length' for printing results in Edebug." - :type '(choice integer (const nil))) + "Maximum length of list to print before abbreviating, when in Edebug. +If this is nil, use the value of `print-length' instead." + :type '(choice (integer :tag "A number") + (const :tag "Use `print-length'" nil))) (defcustom edebug-print-level 50 - "If non-nil, default value of `print-level' for printing results in Edebug." - :type '(choice integer (const nil))) + "Maximum depth of list nesting to print before abbreviating, when in Edebug. +If nil, use the value of `print-level' instead." + :type '(choice (integer :tag "A number") + (const :tag "Use `print-level'" nil))) (defcustom edebug-print-circle t "If non-nil, default value of `print-circle' for printing results in Edebug." :type 'boolean) -- cgit v1.2.3 From 685f4295f9810b4aab8ec3ba7146b17904a1c37f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 16 Mar 2024 12:58:33 +0200 Subject: ; Document more DND functions with limited support * lisp/dnd.el (dnd-begin-text-drag, dnd-begin-file-drag) (dnd-begin-drag-files): Document platforms that support these functions. (Bug#69662) --- lisp/dnd.el | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/lisp/dnd.el b/lisp/dnd.el index 22cb18359a3..1fc1ab45b84 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -453,7 +453,10 @@ on FRAME itself. This function might return immediately if no mouse buttons are currently being held down. It should only be called upon a -`down-mouse-1' (or similar) event." +`down-mouse-1' (or similar) event. + +This function is only supported on X Windows, macOS/GNUstep, and Haiku; +on all other platforms it will signal an error." (unless (fboundp 'x-begin-drag) (error "Dragging text from Emacs is not supported by this window system")) (gui-set-selection 'XdndSelection text) @@ -513,7 +516,10 @@ nil, any drops on FRAME itself will be ignored. This function might return immediately if no mouse buttons are currently being held down. It should only be called upon a -`down-mouse-1' (or similar) event." +`down-mouse-1' (or similar) event. + +This function is only supported on X Windows, macOS/GNUstep, and Haiku; +on all other platforms it will signal an error." (unless (fboundp 'x-begin-drag) (error "Dragging files from Emacs is not supported by this window system")) (dnd-remove-last-dragged-remote-file) @@ -580,7 +586,10 @@ FRAME, ACTION and ALLOW-SAME-FRAME mean the same as in FILES is a list of files that will be dragged. If the drop target doesn't support dropping multiple files, the first file in -FILES will be dragged." +FILES will be dragged. + +This function is only supported on X Windows, macOS/GNUstep, and Haiku; +on all other platforms it will signal an error." (unless (fboundp 'x-begin-drag) (error "Dragging files from Emacs is not supported by this window system")) (dnd-remove-last-dragged-remote-file) -- cgit v1.2.3 From 8cf05d9be12e8b5f8893cfd8a67c92e904a2aa05 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 16 Mar 2024 13:07:52 +0200 Subject: Fix 'shortdoc-copy-function-as-kill' * lisp/emacs-lisp/shortdoc.el (shortdoc-copy-function-as-kill): Fix handling of functions with no arguments. (Bug#69720) --- lisp/emacs-lisp/shortdoc.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 75ac7b3d52c..fdba6d32418 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1675,7 +1675,7 @@ With prefix numeric argument ARG, do it that many times." (interactive) (save-excursion (goto-char (pos-bol)) - (when-let* ((re (rx bol "(" (group (+ (not (in " ")))))) + (when-let* ((re (rx bol "(" (group (+ (not (in " )")))))) (string (and (or (looking-at re) (re-search-backward re nil t)) -- cgit v1.2.3 From f48babb1120343f211367a1b5854dc7740c3091d Mon Sep 17 00:00:00 2001 From: Konstantin Kharlamov Date: Sat, 16 Mar 2024 13:24:34 +0300 Subject: `term-mode': mention the keymap to add keybindings to A user typically expects a keymap for mode `foo' to be called `foo-mode-map'. term-mode has `term-mode-map' too, but for user-defined bindings to have effect they have to be put to `term-raw-map' instead. So let's mention that. * lisp/term.el (term-mode) (term-mode-map) (term-raw-map): Mention the keymaps to add keybindings to for `term-mode'. (Bug#69786) --- lisp/term.el | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/lisp/term.el b/lisp/term.el index 647938c3b86..e769577b4f2 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -658,7 +658,8 @@ executed once, when the buffer is created." ["Forward Output Group" term-next-prompt t] ["Kill Current Output Group" term-kill-output t])) map) - "Keymap for Term mode.") + "Keymap for \"line mode\" in Term mode. For custom keybindings purposes +please note there is also `term-raw-map'") (defvar term-escape-char nil "Escape character for char sub-mode of term mode. @@ -958,7 +959,9 @@ underlying shell." (dotimes (key 21) (keymap-set map (format "" key) #'term-send-function-key))) map) - "Keyboard map for sending characters directly to the inferior process.") + "Keyboard map for sending characters directly to the inferior process. +For custom keybindings purposes please note there is also +`term-mode-map'") (easy-menu-define term-terminal-menu (list term-mode-map term-raw-map term-pager-break-map) @@ -1122,6 +1125,10 @@ particular subprocesses. This can be done by setting the hooks and the variable `term-prompt-regexp' to the appropriate regular expression. +If you define custom keybindings, make sure to assign them to the +correct keymap (or to both): use `term-raw-map' in raw mode and +`term-mode-map' in line mode. + Commands in raw mode: \\{term-raw-map} -- cgit v1.2.3 From ad3a3ad6e616a53ec5ae28aed02e8d3461a5ce5c Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sat, 16 Mar 2024 14:15:25 +0100 Subject: ; Pacify -Wmaybe-uninitialized in coding.c. Warning seen with GCC 13 -Og. --- src/coding.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/coding.c b/src/coding.c index 5f3ceab718b..ff7cf56c297 100644 --- a/src/coding.c +++ b/src/coding.c @@ -5488,7 +5488,7 @@ decode_coding_charset (struct coding_system *coding) { int c; Lisp_Object val; - struct charset *charset; + struct charset *charset UNINIT; int dim; int len = 1; unsigned code; -- cgit v1.2.3 From c890622e1a9ae6f2ab5d083ca8b668c9228c52fa Mon Sep 17 00:00:00 2001 From: Theodor Thornhill Date: Sat, 16 Mar 2024 20:28:10 +0100 Subject: Tweak regexp for object initializers in csharp-mode (bug#69571) * lisp/progmodes/csharp-mode.el (csharp-guess-basic-syntax): Add handling to not consider ended statements as object init openers. * test/lisp/progmodes/csharp-mode-resources/indent.erts: New test resources. * test/lisp/progmodes/csharp-mode-tests.el: Add test for this particular issue. --- lisp/progmodes/csharp-mode.el | 7 +++-- .../progmodes/csharp-mode-resources/indent.erts | 19 ++++++++++++++ test/lisp/progmodes/csharp-mode-tests.el | 30 ++++++++++++++++++++++ 3 files changed, 54 insertions(+), 2 deletions(-) create mode 100644 test/lisp/progmodes/csharp-mode-resources/indent.erts create mode 100644 test/lisp/progmodes/csharp-mode-tests.el diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 3cd64ae435f..2740d34e3b2 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -495,9 +495,12 @@ compilation and evaluation time conflicts." (unless (eq (char-after) ?{) (ignore-errors (backward-up-list 1 t t))) (save-excursion - ;; 'new' should be part of the line + ;; 'new' should be part of the line, but should not trigger if + ;; statement has already ended, like for 'var x = new X();'. + ;; Also, deal with the possible end of line obscured by a + ;; trailing comment. (goto-char (c-point 'iopl)) - (looking-at ".*new.*"))) + (looking-at "^[^//]*new[^//]*;$"))) ;; Line should not already be terminated (save-excursion (goto-char (c-point 'eopl)) diff --git a/test/lisp/progmodes/csharp-mode-resources/indent.erts b/test/lisp/progmodes/csharp-mode-resources/indent.erts new file mode 100644 index 00000000000..a676ecc9728 --- /dev/null +++ b/test/lisp/progmodes/csharp-mode-resources/indent.erts @@ -0,0 +1,19 @@ +Code: + (lambda () + (csharp-mode) + (indent-region (point-min) (point-max))) + +Point-Char: | + +Name: Don't consider closed statements as object initializers. (bug#69571) + +=-= +public class Foo { + void Bar () { + var x = new X(); // [1] + for (;;) { + x(); + } // [2] + } +} +=-=-= diff --git a/test/lisp/progmodes/csharp-mode-tests.el b/test/lisp/progmodes/csharp-mode-tests.el new file mode 100644 index 00000000000..f50fabf5836 --- /dev/null +++ b/test/lisp/progmodes/csharp-mode-tests.el @@ -0,0 +1,30 @@ +;;; csharp-mode-tests.el --- Tests for CC Mode C# mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'csharp-mode) + +(ert-deftest csharp-mode-test-indentation () + (ert-test-erts-file (ert-resource-file "indent.erts"))) + +(provide 'csharp-mode-tests) +;;; csharp-mode-tests.el ends here -- cgit v1.2.3 From 445e2499baa1b8ef21e8edcc13692b5d78912922 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 16 Mar 2024 23:10:48 -0400 Subject: debug.el: Prevent re-entering the debugger for the same error We can have several active `handler-bind`s that all want to invoke the debugger, in which case we can have the following sequence: - The more deeply nested handler calls the debugger. - After a while the user invokes `debugger-continue`. - `signal_or_quit` propagates the error up the stack to the second handler, which calls the debugger again. - The user thus ends up right back at the same place, as if `debugger-continue` had not be processed. Fix this by remembering the last processed error and skipping the debugger if we bump into it again. * lisp/emacs-lisp/debug.el (debugger--last-error): New var. (debugger--duplicate-p): New function. (debug): Use them. --- lisp/emacs-lisp/debug.el | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 60d14d11970..ec947c1215d 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -153,6 +153,12 @@ where CAUSE can be: (insert (debugger--buffer-state-content state))) (goto-char (debugger--buffer-state-pos state))) +(defvar debugger--last-error nil) + +(defun debugger--duplicate-p (args) + (pcase args + (`(error ,err . ,_) (and (consp err) (eq err debugger--last-error))))) + ;;;###autoload (setq debugger 'debug) ;;;###autoload @@ -175,9 +181,14 @@ first will be printed into the backtrace buffer. If `inhibit-redisplay' is non-nil when this function is called, the debugger will not be entered." (interactive) - (if inhibit-redisplay - ;; Don't really try to enter debugger within an eval from redisplay. + (if (or inhibit-redisplay + (debugger--duplicate-p args)) + ;; Don't really try to enter debugger within an eval from redisplay + ;; or if we already popper into the debugger for this error, + ;; which can happen when we have several nested `handler-bind's that + ;; want to invoke the debugger. debugger-value + (setq debugger--last-error nil) (let ((non-interactive-frame (or noninteractive ;FIXME: Presumably redundant. ;; If we're in the initial-frame (where `message' just @@ -318,6 +329,12 @@ the debugger will not be entered." (backtrace-mode)))) (with-timeout-unsuspend debugger-with-timeout-suspend) (set-match-data debugger-outer-match-data))) + (when (eq 'error (car-safe debugger-args)) + ;; Remember the error we just debugged, to avoid re-entering + ;; the debugger if some higher-up `handler-bind' invokes us + ;; again, oblivious that the error was already debugged from + ;; a more deeply nested `handler-bind'. + (setq debugger--last-error (nth 1 debugger-args))) (setq debug-on-next-call debugger-step-after-exit) debugger-value)))) -- cgit v1.2.3 From 06a991e7e87c9954f590d30e87d8710ff60ce7b8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 17 Mar 2024 10:47:41 +0200 Subject: ; * admin/notes/bugtracker: Minor copyedit. --- admin/notes/bugtracker | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/admin/notes/bugtracker b/admin/notes/bugtracker index b47061884d6..93532e02d20 100644 --- a/admin/notes/bugtracker +++ b/admin/notes/bugtracker @@ -430,8 +430,8 @@ reassign 123 spam *** To change the title of a bug: retitle 123 Some New Title -*** To change the submitter address: -submitter 123 none@example.com +*** To change the submitter name and address: +submitter 123 J. Hacker none@example.com Note that it does not seem to work to specify "Submitter:" in the pseudo-header when first reporting a bug. -- cgit v1.2.3 From 7a0f4de3c18cab43b5bff47fdab4944e006c68e4 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 17 Mar 2024 19:32:15 +0800 Subject: Improve C++ standard library detection on Android * configure.ac: Stop relaying --with-ndk-cxx-shared to the nested invocation of configure. * build-aux/ndk-build-helper-1.mk (SYSTEM_LIBRARIES): * build-aux/ndk-build-helper-2.mk (SYSTEM_LIBRARIES): Insert all of the C++ libraries available on Android. * configure.ac: Call ndk_LATE and ndk_LATE_EARLY within if statement at toplevel, averting needless calls to AC_PROG_CXX. * cross/ndk-build/Makefile.in (NDK_BUILD_CXX_STL) (NDK_BUILD_CXX_LDFLAGS): * cross/ndk-build/ndk-build.mk.in (NDK_BUILD_CXX_STL) (NDK_BUILD_CXX_LDFLAGS): New variables. * cross/ndk-build/ndk-resolve.mk (NDK_SYSTEM_LIBRARIES): Introduce several other C++ libraries sometimes present on Android. (NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE)): Insert NDK_BUILD_CXX_STL when any of these new C++ libraries are requested. * m4/ndk-build.m4: Completely rewrite C++ compiler and library detection. * java/org/gnu/emacs/EmacsNative.java (EmacsNative): Attempt to load more libraries from static initializer. * java/INSTALL: Remove obsolete information. --- build-aux/ndk-build-helper-1.mk | 2 +- build-aux/ndk-build-helper-2.mk | 2 +- configure.ac | 12 +- cross/ndk-build/Makefile.in | 26 +-- cross/ndk-build/ndk-build.mk.in | 2 + cross/ndk-build/ndk-resolve.mk | 32 +++- java/INSTALL | 34 ++-- java/org/gnu/emacs/EmacsNative.java | 6 +- m4/ndk-build.m4 | 354 +++++++++++++++++++++++++++--------- 9 files changed, 337 insertions(+), 133 deletions(-) diff --git a/build-aux/ndk-build-helper-1.mk b/build-aux/ndk-build-helper-1.mk index 5681728154c..490064b6e32 100644 --- a/build-aux/ndk-build-helper-1.mk +++ b/build-aux/ndk-build-helper-1.mk @@ -94,7 +94,7 @@ endef # dependencies can be ignored while building a shared library, as they # will be linked in to the resulting shared object file later. -SYSTEM_LIBRARIES = z libz libc c libdl dl stdc++ libstdc++ log liblog android libandroid +SYSTEM_LIBRARIES = z libz libc c libdl dl stdc++ libstdc++ stlport libstlport gnustl libgnustl c++ libc++ log liblog android libandroid $(foreach module,$(filter-out $(SYSTEM_LIBRARIES), $(LOCAL_SHARED_LIBRARIES)),$(eval $(call add-so-name,$(module)))) $(foreach module,$(filter-out $(SYSTEM_LIBRARIES), $(LOCAL_SHARED_LIBRARIES) $(LOCAL_STATIC_LIBRARIES) $(LOCAL_WHOLE_STATIC_LIBRARIES)),$(eval $(call add-includes,$(module)))) diff --git a/build-aux/ndk-build-helper-2.mk b/build-aux/ndk-build-helper-2.mk index 1c2409cfd57..e696fcbdade 100644 --- a/build-aux/ndk-build-helper-2.mk +++ b/build-aux/ndk-build-helper-2.mk @@ -87,7 +87,7 @@ endef # Resolve additional dependencies based on LOCAL_STATIC_LIBRARIES and # LOCAL_SHARED_LIBRARIES. -SYSTEM_LIBRARIES = z libz libc c libdl dl libstdc++ stdc++ log liblog android libandroid +SYSTEM_LIBRARIES = z libz libc c libdl dl libstdc++ stdc++ stlport libstlport gnustl libgnustl c++ libc++ log liblog android libandroid $(foreach module,$(filter-out $(SYSTEM_LIBRARIES), $(LOCAL_STATIC_LIBRARIES) $(LOCAL_WHOLE_STATIC_LIBRARIES)),$(eval $(call add-a-name,$(module)))) $(foreach module,$(filter-out $(SYSTEM_LIBRARIES), $(LOCAL_SHARED_LIBRARIES)),$(eval $(call add-so-name,$(module)))) diff --git a/configure.ac b/configure.ac index 452aa0838f1..bd678ea52a3 100644 --- a/configure.ac +++ b/configure.ac @@ -171,7 +171,6 @@ AS_IF([test "$XCONFIGURE" = "android"],[ # Make sure to pass through the CFLAGS, as older versions of the # NDK require them to be able to find system includes. with_ndk_path="$android_ndk_path" - with_ndk_cxx_shared="$android_ndk_cxx_shared" with_ndk_cxx="$android_ndk_cxx" ndk_INIT([$android_abi], [$ANDROID_SDK], [cross/ndk-build], [$ANDROID_CFLAGS]) @@ -1233,7 +1232,7 @@ package will likely install on older systems but crash on startup.]) passthrough="$passthrough --with-harfbuzz=$with_harfbuzz" passthrough="$passthrough --with-threads=$with_threads" - # Now pass through some checking options. + # Now pass through some checking-related options. emacs_val="--enable-check-lisp-object-type=$enable_check_lisp_object_type" passthrough="$passthrough $emacs_val" @@ -1243,7 +1242,6 @@ package will likely install on older systems but crash on startup.]) AS_IF([XCONFIGURE=android ANDROID_CC="$ANDROID_CC" \ ANDROID_SDK="$android_sdk" android_abi=$android_abi \ android_ndk_path="$with_ndk_path" \ - android_ndk_cxx_shared="$with_ndk_cxx_shared" \ android_ndk_cxx="$android_ndk_cxx" \ $CONFIG_SHELL $0 $passthrough], [], [AC_MSG_ERROR([Failed to cross-configure Emacs for android.])]) @@ -1570,7 +1568,13 @@ AC_DEFUN_ONCE([gl_STDLIB_H], # Initialize gnulib right after choosing the compiler. dnl Amongst other things, this sets AR and ARFLAGS. gl_EARLY -ndk_LATE + +# ndk_LATE must be enclosed in this conditional to prevent the +# AC_PROG_CXX it indirectly requires from being expanded at top level. +if test "$ndk_INITIALIZED" = "yes"; then + ndk_LATE_EARLY + ndk_LATE +fi if test "$ac_test_CFLAGS" != set; then # It's helpful to have C macros available to GDB, so prefer -g3 to -g diff --git a/cross/ndk-build/Makefile.in b/cross/ndk-build/Makefile.in index 8ba2d356f27..0970a765b45 100644 --- a/cross/ndk-build/Makefile.in +++ b/cross/ndk-build/Makefile.in @@ -24,15 +24,17 @@ srcdir = @srcdir@ # This is a list of Android.mk files which provide targets. -NDK_BUILD_ANDROID_MK = @NDK_BUILD_ANDROID_MK@ - NDK_BUILD_ARCH = @NDK_BUILD_ARCH@ - NDK_BUILD_ABI = @NDK_BUILD_ABI@ - NDK_BUILD_SDK = @NDK_BUILD_SDK@ - NDK_BUILD_CC = @NDK_BUILD_CC@ - NDK_BUILD_CXX = @NDK_BUILD_CXX@ - NDK_BUILD_AR = @NDK_BUILD_AR@ - NDK_BUILD_NASM = @NDK_BUILD_NASM@ - NDK_BUILD_CFLAGS = @NDK_BUILD_CFLAGS@ + NDK_BUILD_ANDROID_MK = @NDK_BUILD_ANDROID_MK@ + NDK_BUILD_ARCH = @NDK_BUILD_ARCH@ + NDK_BUILD_ABI = @NDK_BUILD_ABI@ + NDK_BUILD_SDK = @NDK_BUILD_SDK@ + NDK_BUILD_CC = @NDK_BUILD_CC@ + NDK_BUILD_CXX = @NDK_BUILD_CXX@ + NDK_BUILD_CXX_STL = @NDK_BUILD_CXX_STL@ +NDK_BUILD_CXX_LDFLAGS = @NDK_BUILD_CXX_LDFLAGS@ + NDK_BUILD_AR = @NDK_BUILD_AR@ + NDK_BUILD_NASM = @NDK_BUILD_NASM@ + NDK_BUILD_CFLAGS = @NDK_BUILD_CFLAGS@ # This is a list of targets to build. NDK_BUILD_MODULES = @NDK_BUILD_MODULES@ @@ -58,8 +60,10 @@ NDK_BUILD_ANDROID_MK := $(call uniqify,$(NDK_BUILD_ANDROID_MK)) NDK_BUILD_MODULES := $(call uniqify,$(NDK_BUILD_MODULES)) # Define CFLAGS for compiling C++ code; this involves removing all -# -std=NNN options. -NDK_BUILD_CFLAGS_CXX := $(filter-out -std=%,$(NDK_BUILD_CFLAGS)) +# -std=NNN options and inserting compilation options for the C++ +# library. +NDK_BUILD_CFLAGS_CXX := $(filter-out -std=%,$(NDK_BUILD_CFLAGS)) \ + $(NDK_BUILD_CXX_STL) define subr-1 diff --git a/cross/ndk-build/ndk-build.mk.in b/cross/ndk-build/ndk-build.mk.in index 6c85ff5044e..ea1be5af6f1 100644 --- a/cross/ndk-build/ndk-build.mk.in +++ b/cross/ndk-build/ndk-build.mk.in @@ -22,6 +22,8 @@ NDK_BUILD_MODULES = @NDK_BUILD_MODULES@ NDK_BUILD_CXX_SHARED = @NDK_BUILD_CXX_SHARED@ +NDK_BUILD_CXX_STL = @NDK_BUILD_CXX_STL@ +NDK_BUILD_CXX_LDFLAGS = @NDK_BUILD_CXX_LDFLAGS@ NDK_BUILD_ANY_CXX_MODULE = @NDK_BUILD_ANY_CXX_MODULE@ NDK_BUILD_SHARED = NDK_BUILD_STATIC = diff --git a/cross/ndk-build/ndk-resolve.mk b/cross/ndk-build/ndk-resolve.mk index d3b398bca62..4d8ecf8667a 100644 --- a/cross/ndk-build/ndk-resolve.mk +++ b/cross/ndk-build/ndk-resolve.mk @@ -20,7 +20,7 @@ # which actually builds targets. # List of system libraries to ignore. -NDK_SYSTEM_LIBRARIES = z libz libc c libdl dl stdc++ libstdc++ log liblog android libandroid +NDK_SYSTEM_LIBRARIES = z libz libc c libdl dl stdc++ libstdc++ stlport libstlport gnustl libgnustl c++ libc++ log liblog android libandroid # Save information. NDK_LOCAL_PATH_$(LOCAL_MODULE) := $(LOCAL_PATH) @@ -90,11 +90,35 @@ endif # Likewise for libstdc++. ifeq ($(strip $(1)),libstdc++) -NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += -lstdc++ +NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS) endif -ifeq ($(strip $(1)),dl) -NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += -lstdc++ +ifeq ($(strip $(1)),stdc++) +NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS) +endif + +ifeq ($(strip $(1)),libstlport) +NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS) +endif + +ifeq ($(strip $(1)),stlport) +NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS) +endif + +ifeq ($(strip $(1)),libgnustl) +NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS) +endif + +ifeq ($(strip $(1)),gnustl) +NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS) +endif + +ifeq ($(strip $(1)),libc++) +NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS) +endif + +ifeq ($(strip $(1)),c++) +NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS) endif # Likewise for liblog. diff --git a/java/INSTALL b/java/INSTALL index 175ff2826b2..f1063b40c25 100644 --- a/java/INSTALL +++ b/java/INSTALL @@ -166,25 +166,21 @@ than a compressed package for a newer version of Android. BUILDING C++ DEPENDENCIES -With a new version of the NDK, dependencies containing C++ code should -build without any further configuration. However, older versions -require that you use the ``make_standalone_toolchain.py'' script in -the NDK distribution to create a ``standalone toolchain'', and use -that instead, in order for C++ headers to be found. - -See https://developer.android.com/ndk/guides/standalone_toolchain for -more details; when a ``standalone toolchain'' is specified, the -configure script will try to determine the location of the C++ -compiler based on the C compiler specified. If that automatic -detection does not work, you can specify a C++ compiler yourself, like -so: - - ./configure --with-ndk-cxx=/path/to/toolchain/bin/i686-linux-android-g++ - -Some versions of the NDK have a bug, where GCC fails to locate -``stddef.h'' after being copied to a standalone toolchain. To work -around this problem (which normally exhibits itself when building C++ -code), add: +In normal circumstances, Emacs should automatically detect and configure +one of the C++ standard libraries part of the NDK when such a library is +required to build a dependency specified under `--with-ndk-path'. + +Nevertheless, this process is not infalliable, and with certain versions +of the NDK is liable to fail to locate a C++ compiler, requiring that +you run the `make_standalone_toolchain.py' script in the NDK +distribution to create a ``standalone toolchain'' and substitute the +same for the regular compiler toolchain. See +https://developer.android.com/ndk/guides/standalone_toolchain for +further details. + +Some versions of the NDK that ship GCC 4.9.x exhibit a bug where the +compiler cannot locate `stddef.h' after being copied to a standalone +toolchain. To work around this problem, add: -isystem /path/to/toolchain/include/c++/4.9.x diff --git a/java/org/gnu/emacs/EmacsNative.java b/java/org/gnu/emacs/EmacsNative.java index 6845f833908..898eaef41a7 100644 --- a/java/org/gnu/emacs/EmacsNative.java +++ b/java/org/gnu/emacs/EmacsNative.java @@ -323,7 +323,9 @@ public final class EmacsNative Every time you add a new shared library dependency to Emacs, please add it here as well. */ - libraryDeps = new String[] { "png_emacs", "selinux_emacs", + libraryDeps = new String[] { "c++_shared", "gnustl_shared", + "stlport_shared", "gabi++_shared", + "png_emacs", "selinux_emacs", "crypto_emacs", "pcre_emacs", "packagelistparser_emacs", "gnutls_emacs", "gmp_emacs", @@ -331,7 +333,7 @@ public final class EmacsNative "tasn1_emacs", "hogweed_emacs", "jansson_emacs", "jpeg_emacs", "tiff_emacs", "xml2_emacs", - "icuuc_emacs", + "icuuc_emacs", "harfbuzz_emacs", "tree-sitter_emacs", }; for (String dependency : libraryDeps) diff --git a/m4/ndk-build.m4 b/m4/ndk-build.m4 index aacb2ed048b..7012471e046 100644 --- a/m4/ndk-build.m4 +++ b/m4/ndk-build.m4 @@ -21,10 +21,6 @@ AC_ARG_WITH([ndk_path], [AS_HELP_STRING([--with-ndk-path], [find Android libraries in these directories])]) -AC_ARG_WITH([ndk_cxx_shared], - [AS_HELP_STRING([--with-ndk-cxx-shared], - [name of the C++ standard library included with the NDK])]) - AC_ARG_WITH([ndk_cxx], [AS_HELP_STRING([--with-ndk-cxx], [name of the C++ compiler included with the NDK])]) @@ -59,6 +55,7 @@ ndk_DIR=$3 ndk_ANY_CXX= ndk_BUILD_CFLAGS="$4" ndk_working_cxx=no +ndk_CXX_SHARED= AS_CASE(["$ndk_ABI"], [*arm64*], [ndk_ARCH=arm64], @@ -149,7 +146,7 @@ ndk_resolve_import_module () { for ndk_android_mk in $ndk_module_files; do # Read this Android.mk file. Set NDK_ROOT to /tmp: the Android in - # tree build system sets it to a meaning value, but build files + # tree build system sets it to a meaningful value, but build files # just use it to test whether or not the NDK is being used. ndk_commands=`ndk_run_test` eval "$ndk_commands" @@ -169,13 +166,14 @@ that could not be found in the list of directories specified in \ ndk_ANY_CXX=yes fi - AS_IF([test "$ndk_ANY_CXX" = "yes" && test -z "$with_ndk_cxx_shared"], - [AC_MSG_ERROR([The module [$]1 requires the C++ standard library \ -(libc++_shared.so), but it was not found.])]) + AS_IF([test "$module_cxx_deps" = "yes" && test -z "$ndk_CXX_STL" \ + && test -z "$ndk_CXX_LDFLAGS"], + [AC_MSG_ERROR([The module $1 requires a C++ standard library, +but none were found.])]) - AS_IF([test "$ndk_ANY_CXX" = "yes" && test "$ndk_working_cxx" != "yes"], - [AC_MSG_ERROR([The module [$]1 requires the C++ standard library \ -(libc++_shared.so), but a working C++ compiler was not found.])]) + AS_IF([test "$module_cxx_deps" = "yes" && test "$ndk_working_cxx" != "yes"], + [AC_MSG_ERROR([The module [$]1 requires the C++ standard library, +but a working C++ compiler was not found.])]) AC_MSG_RESULT([yes]) @@ -227,6 +225,88 @@ ndk_subst_cc_onto_cxx () { done } +# ndk_subst_cflags_onto_cxx +# --------------------- +# Print any options in CFLAGS also suitable for a C++ compiler. + +ndk_subst_cflags_onto_cxx () { + ndk_flag= + for ndk_word in $CFLAGS; do + AS_IF([test "$ndk_flag" = "yes"], + [AS_ECHO_N(["$ndk_word "]) + ndk_flag=no], + [AS_CASE([$ndk_word], + [*-sysroot=*], + [AS_ECHO_N(["$ndk_word "])], + [*-isystem*], + [AS_ECHO_N(["$ndk_word "]) + ndk_flag=yes], + [*-I*], + [AS_ECHO_N(["$ndk_word "]) + ndk_flag=yes], + [*-sysroot*], + [AS_ECHO_N(["$ndk_word "]) + ndk_flag=yes], + [-D__ANDROID_API__*], + [AS_ECHO_N(["$ndk_word "])])]) + done +} + +# Detect the installation directory and type of the NDK being used. + +ndk_install_dir= +ndk_toolchain_type= + +AC_MSG_CHECKING([for the directory where the NDK is installed]) + +dnl If the install directory isn't available, repeat the search over +dnl each entry in the programs directory. +ndk_programs_dirs=`$CC -print-search-dirs | sed -n "s/^programs:[[\t ]]*=\?\(.*\)/\1/p"` +ndk_save_IFS=$IFS; IFS=: +for ndk_dir in $ndk_programs_dirs; do + if test -d "$ndk_dir"; then :; else + continue + fi + ndk_dir=`cd "$ndk_dir"; pwd` + while test "$ndk_dir" != "/" && test -z "$ndk_toolchain_type"; do + ndk_dir=`AS_DIRNAME([$ndk_dir])` + AS_IF([test -d "$ndk_dir/bin" && test -d "$ndk_dir/lib"], + [dnl The directory reached is most likely either the directory + dnl holding prebuilt binaries in a combined toolchain or the + dnl directory holding a standalone toolchain itself. + dnl + dnl Distinguish between the two by verifying the name of the + dnl parent directory (and its parent). + ndk_dir1=`AS_DIRNAME(["$ndk_dir"])` + ndk_basename=`AS_BASENAME(["$ndk_dir1"])` + AS_IF([test "$ndk_basename" = "prebuilt"], + [dnl Directories named "prebuilt" are exclusively present in + dnl combined toolchains, where they are children of the + dnl base directory or, in recent releases, a directory + dnl within the base directory. Continue searching for the + dnl base directory. + ndk_toolchain_type=combined + while test "$ndk_dir1" != "/"; do + AS_IF([test -d "$ndk_dir1/toolchains" \ + && test -d "$ndk_dir1/sources"], + [ndk_install_dir=$ndk_dir1 + break]) + ndk_dir1=`AS_DIRNAME(["$ndk_dir1"])` + done], + [ndk_toolchain_type=standalone + ndk_install_dir=$ndk_dir])]) + done + AS_IF([test -n "$ndk_toolchain_type"], + [break]) +done +IFS=$ndk_save_IFS + +AS_IF([test -z "$ndk_install_dir"], + [AC_MSG_RESULT([unknown]) + AC_MSG_WARN([The NDK installation directory could not be \ +derived from the compiler.])], + [AC_MSG_RESULT([$ndk_install_dir ($ndk_toolchain_type)])]) + # Look for a suitable ar and ranlib in the same directory as the C # compiler. ndk_cc_firstword=`AS_ECHO(["$CC"]) | cut -d' ' -f1` @@ -259,72 +339,8 @@ NDK_BUILD_NASM= AS_IF([test "$ndk_ARCH" = "x86" || test "$ndk_ARCH" = "x86_64"], [AC_CHECK_PROGS([NDK_BUILD_NASM], [nasm])]) -# Look for a file named ``libc++_shared.so'' in a subdirectory of -# $ndk_where_cc if it was not specified. -AC_MSG_CHECKING([for libc++_shared.so]) - -ndk_where_toolchain= -AS_IF([test -z "$with_ndk_cxx_shared" && test -n "$ndk_where_cc"],[ - # Find the NDK root directory. Go to $ndk_where_cc. - SAVE_PWD=`pwd` - cd `AS_DIRNAME(["$ndk_where_cc"])` - - # Now, keep moving backwards until pwd ends with ``toolchains''. - while :; do - if test "`pwd`" = "/"; then - cd "$SAVE_PWD" - break - fi - - ndk_pwd=`pwd` - if test "`AS_BASENAME([$ndk_pwd])`" = "toolchains"; then - ndk_where_toolchain=$ndk_pwd - cd "$SAVE_PWD" - break - fi - - cd .. - done - - ndk_matching_libcxx_shared_so= - - # The toolchain directory should be in "$ndk_where_toolchain". - AS_IF([test -n "$ndk_where_toolchain"],[ - # Now, look in the directory behind it. - ndk_cxx_shared_so=`find "$ndk_where_toolchain" -name libc++_shared.so` - - # Look for one with the correct architecture. - for ndk_candidate in $ndk_cxx_shared_so; do - AS_CASE([$ndk_candidate], - [*arm-linux-android*], - [AS_IF([test "$ndk_ARCH" = "arm"], - [ndk_matching_libcxx_shared_so=$ndk_candidate])], - [*aarch64-linux-android*], - [AS_IF([test "$ndk_ARCH" = "arm64"], - [ndk_matching_libcxx_shared_so=$ndk_candidate])], - [*i[[3-6]]86-linux-android*], - [AS_IF([test "$ndk_ARCH" = "x86"], - [ndk_matching_libcxx_shared_so=$ndk_candidate])], - [*x86_64-linux-android*], - [AS_IF([test "$ndk_ARCH" = "x86_64"], - [ndk_matching_libcxx_shared_so=$ndk_candidate])]) - - AS_IF([test -n "$ndk_matching_libcxx_shared_so"], - [with_ndk_cxx_shared=$ndk_matching_libcxx_shared_so]) - done])]) - -AS_IF([test -z "$with_ndk_cxx_shared"],[AC_MSG_RESULT([no]) - AC_MSG_WARN([The C++ standard library could not be found. \ -If you try to build Emacs with a dependency that requires the C++ standard \ -library, Emacs will not build correctly, unless you manually specify the \ -name of an appropriate ``libc++_shared.so'' binary.])], - [AC_MSG_RESULT([$with_ndk_cxx_shared])]) - -ndk_CXX_SHARED=$with_ndk_cxx_shared - -# These variables have now been found. Now look for a C++ compiler. -# Upon failure, pretend the C compiler is a C++ compiler and use that -# instead. +# Search for a C++ compiler. Upon failure, pretend the C compiler is a +# C++ compiler and use that instead. ndk_cc_name=`AS_BASENAME(["${ndk_cc_firstword}"])` ndk_cxx_name= @@ -338,8 +354,162 @@ AS_IF([test -n "$with_ndk_cxx"], [CXX=$with_ndk_cxx], [], [`AS_DIRNAME(["$ndk_where_cc"])`:$PATH]) AS_IF([test -z "$CXX"], [CXX=`ndk_filter_cc_for_cxx`], [CXX=`ndk_subst_cc_onto_cxx`])]) + +# None of the C++ standard libraries installed with Android are +# available to NDK programs, which are expected to select one of several +# standard libraries distributed with the NDK. This library must be +# extracted from the NDK by the program's build system and copied into +# the application directory, and the build system is also expected to +# provide the compiler with suitable options to enable it. +# +# Emacs, on recent releases of the NDK, prefers the libc++ library, the +# most complete of the libraries available, when it detects the presence +# of its headers and libraries in the compiler's search path. Next in +# line are the several libraries located in a directory named `cxx-stl' +# inside the NDK distribution, of which Emacs prefers, in this order, +# the GNU libstdc++, stlport, gabi and the system C++ library. The +# scope of the last two is confined to providing runtime support for +# basic C++ operations, and is useless for compiling most C++ +# dependencies whose requirements go beyond such operations. +# +# The NDK comes in two forms. In a "combined toolchain", all C++ +# libraries are present in the NDK directory and the responsibility is +# left to the build system to locate and select the best C++ library, +# whereas in a "standalone toolchain" an STL will have already been +# specified a C++ library, besides which no others will be present. +# +# Though Android.mk files are provided by the NDK for each such library, +# Emacs cannot use any of these, both for lack of prebuilt support in +# its ndk-build implementation, and since they are absent from combined +# toolchains. + +ndk_CXX_SHARED= +ndk_CXX_STL= +ndk_CXX_LDFLAGS= + +AS_IF([test -n "$CXX" && test -n "$ndk_install_dir"], + [ndk_library_dirs=`$CXX -print-search-dirs \ + | sed -n "s/^libraries:[[\t ]]*=\?\(.*\)/\1/p"` + AS_IF([test "$ndk_toolchain_type" = "standalone"], + [dnl With a standalone toolchain, just use the first C++ library + dnl present in the compiler's library search path, that being the + dnl only C++ library that will ever be present. + ndk_save_IFS=$IFS; IFS=: + for ndk_dir in $ndk_library_dirs; do + if test -d "$ndk_dir"; then :; else + continue + fi + ndk_dir=`cd "$ndk_dir"; pwd` + if test -f "$ndk_dir/libc++_shared.so"; then + ndk_CXX_SHARED="$ndk_dir/libc++_shared.so" + ndk_CXX_LDFLAGS=-lc++_shared; break + elif test -f "$ndk_dir/libgnustl_shared.so"; then + ndk_CXX_SHARED="$ndk_dir/libgnustl_shared.so" + ndk_CXX_LDFLAGS=-lgnustl_shared; break + elif test -f "$ndk_dir/libstlport_shared.so"; then + ndk_CXX_SHARED="$ndk_dir/libstlport_shared.so" + ndk_CXX_LDFLAGS=-lstlport_shared; break + fi + done + IFS=$ndk_save_IFS], + [dnl Otherwise, search for a suitable standard library + dnl in the order stated above. + dnl + dnl Detect if this compiler is configured to link against libc++ by + dnl default. + AC_MSG_CHECKING([whether compiler defaults to libc++]) + cat <<_ACEOF >conftest.cc +#include +#ifndef _LIBCPP_VERSION +Not libc++! +#endif /* _LIBCPP_VERSION */ + +int +main (void) +{ + +} +_ACEOF + AS_IF([$CXX conftest.cc -o conftest.o >&AS_MESSAGE_LOG_FD 2>&1], + [dnl The compiler defaults to libc++. + AC_MSG_RESULT([yes]) + ndk_save_IFS=$IFS; IFS=: + for ndk_dir in $ndk_library_dirs; do + if test -f "$ndk_dir/libc++_shared.so"; then + ndk_CXX_SHARED="$ndk_dir/libc++_shared.so" + ndk_CXX_LDFLAGS=-lc++_shared; break + fi + done + IFS=$ndk_save_IFS], + [dnl Search for gnustl, stlport, gabi, and failing that, system. + dnl The name of the gabi system root directory varies by GCC + dnl version. + AC_MSG_RESULT([no]) + ndk_gcc_version=`($CXX -v 2>&1) \ + | sed -n "s/^gcc version \([[0123456789]\+.[0123456789]\+]\).*/\1/p"` + cxx_stl="$ndk_install_dir/sources/cxx-stl" + ndk_cxx_stl_base="$cxx_stl/gnu-libstdc++/$ndk_gcc_version" + AS_IF([test -n "$ndk_gcc_version" \ + && test -d "$ndk_cxx_stl_base/libs/$ndk_ABI"], + [ndk_CXX_LDFLAGS="-L$ndk_cxx_stl_base/libs/$ndk_ABI -lgnustl_shared" + ndk_CXX_LDFLAGS="$ndk_CXX_LDFLAGS -lsupc++" + ndk_CXX_STL="-isystem $ndk_cxx_stl_base/include" + ndk_CXX_STL="$ndk_CXX_STL -isystem $ndk_cxx_stl_base/libs/$ndk_ABI/include" + ndk_CXX_SHARED="$ndk_cxx_stl_base/libs/$ndk_ABI/libgnustl_shared.so"]) + AS_IF([test -f "$ndk_CXX_SHARED"], [], + [dnl No STL was located or the library is not reachable. + dnl Search for alternatives. + ndk_CXX_STL= + ndk_CXX_SHARED= + ndk_CXX_LDFLAGS= + ndk_cxx_stl_base="$cxx_stl/stlport" + AS_IF([test -d "$ndk_cxx_stl_base"], + [ndk_CXX_LDFLAGS="-L$ndk_cxx_stl_base/libs/$ndk_ABI -lstlport_shared" + ndk_CXX_STL="-isystem $ndk_cxx_stl_base/stlport" + ndk_CXX_SHARED="$ndk_cxx_stl_base/libs/$ndk_ABI/libstlport_shared.so"]) + AS_IF([test -f "$ndk_CXX_SHARED"], [], + [ndk_CXX_STL= + ndk_CXX_SHARED= + ndk_CXX_LDFLAGS= + ndk_cxx_stl_base="$cxx_stl/gabi++" + AS_IF([test -d "$ndk_cxx_stl_base"], + [ndk_CXX_LDFLAGS="-L$ndk_cxx_stl_base/libs/$ndk_ABI -lgabi++_shared" + ndk_CXX_STL="$ndk_CXX_STL -isystem $ndk_cxx_stl_base/include" + ndk_CXX_SHARED="$ndk_cxx_stl_base/libs/$ndk_ABI/lgabi++_shared.so"])]) + AS_IF([test -f "$ndk_CXX_SHARED"], [], + [ndk_CXX_STL= + ndk_CXX_SHARED= + ndk_CXX_LDFLAGS= + ndk_cxx_stl_base="$cxx_stl/system" + AS_IF([test -d "$ndk_cxx_stl_base"], + [ndk_CXX_LDFLAGS="-L$ndk_cxx_stl_base/libs/$ndk_ABI -lstdc++" + ndk_CXX_STL="-isystem $ndk_cxx_stl_base/include" + dnl The "system" library is distributed with Android and + dnl need not be present in app packages. + ndk_CXX_SHARED= + dnl Done. + ])])])]) + rm -f conftest.o])]) + +AS_ECHO([]) +AS_ECHO(["C++ compiler configuration: "]) +AS_ECHO([]) +AS_ECHO(["Library includes : $ndk_CXX_STL"]) +AS_ECHO(["Linker options : $ndk_CXX_LDFLAGS"]) +AS_ECHO(["Library file (if any) : $ndk_CXX_SHARED"]) +AS_ECHO([]) ]) +# ndk_LATE_EARLY +# -------------- +# Call before ndk_LATE to establish certain variables in time for +# ndk_LATE's C++ compiler detection. + +AC_DEFUN([ndk_LATE_EARLY], +[ndk_save_LDFLAGS="$LDFLAGS" + LDFLAGS="$LDFLAGS $ndk_CXX_LDFLAGS" + CXXFLAGS="$CXXFLAGS `ndk_subst_cflags_onto_cxx` $ndk_CXX_STL"]) + # ndk_LATE # -------- # Perform late initialization of the ndk-build system by checking for @@ -347,17 +517,14 @@ AS_IF([test -n "$with_ndk_cxx"], [CXX=$with_ndk_cxx], AC_DEFUN([ndk_LATE], [dnl -dnl This calls AC_REQUIRE([AC_PROG_CXX]), leading to configure looking -dnl for a C++ compiler. However, the language is not restored -dnl afterwards if not `$ndk_INITIALIZED'. AS_IF([test "$ndk_INITIALIZED" = "yes"],[ - AS_IF([test -n "$CXX"], [AC_LANG_PUSH([C++]) + AS_IF([test -n "$CXX"], [ + AC_LANG_PUSH([C++]) AC_CHECK_HEADER([string], [ndk_working_cxx=yes], - [AC_MSG_WARN([Your C++ compiler is not properly set up, and\ - the standard library headers could not be found.])]) + [AC_MSG_WARN([Your C++ compiler is not properly configured, as \ +the standard library headers could not be found.])]) AC_LANG_POP([C++])])]) -dnl Thus, manually switch back to C here. -AC_LANG([C]) +LDFLAGS="$ndk_save_LDFLAGS" ]) # ndk_SEARCH_MODULE(MODULE, NAME, ACTION-IF-FOUND, [ACTION-IF-NOT-FOUND]) @@ -396,13 +563,14 @@ else ndk_ANY_CXX=yes fi - AS_IF([test "$ndk_ANY_CXX" = "yes" && test -z "$with_ndk_cxx_shared"], - [AC_MSG_ERROR([The module $1 requires the C++ standard library \ -(libc++_shared.so), but it was not found.])]) + AS_IF([test "$module_cxx_deps" = "yes" && test -z "$ndk_CXX_STL" \ + && test -z "$ndk_CXX_LDFLAGS"], + [AC_MSG_ERROR([The module $1 requires a C++ standard library, +but none were found.])]) - AS_IF([test "$ndk_ANY_CXX" = "yes" && test "$ndk_working_cxx" != "yes"], - [AC_MSG_ERROR([The module [$]1 requires the C++ standard library \ -(libc++_shared.so), but a working C++ compiler was not found.])]) + AS_IF([test "$module_cxx_deps" = "yes" && test "$ndk_working_cxx" != "yes"], + [AC_MSG_ERROR([The module [$]1 requires the C++ standard library, +but a working C++ compiler was not found.])]) $2[]_CFLAGS="[$]$2[]_CFLAGS $module_cflags $module_includes" $2[]_LIBS="[$]$2[]_LIBS $module_ldflags" @@ -457,6 +625,8 @@ AC_DEFUN_ONCE([ndk_CONFIG_FILES], NDK_BUILD_AR=$AR NDK_BUILD_MODULES="$ndk_MODULES" NDK_BUILD_CXX_SHARED="$ndk_CXX_SHARED" + NDK_BUILD_CXX_STL="$ndk_CXX_STL" + NDK_BUILD_CXX_LDFLAGS="$ndk_CXX_LDFLAGS" NDK_BUILD_ANY_CXX_MODULE=$ndk_ANY_CXX NDK_BUILD_CFLAGS="$ndk_BUILD_CFLAGS" @@ -470,6 +640,8 @@ AC_DEFUN_ONCE([ndk_CONFIG_FILES], AC_SUBST([NDK_BUILD_NASM]) AC_SUBST([NDK_BUILD_MODULES]) AC_SUBST([NDK_BUILD_CXX_SHARED]) + AC_SUBST([NDK_BUILD_CXX_STL]) + AC_SUBST([NDK_BUILD_CXX_LDFLAGS]) AC_SUBST([NDK_BUILD_ANY_CXX_MODULE]) AC_SUBST([NDK_BUILD_CFLAGS]) -- cgit v1.2.3 From 8014dbb2ad8c1163bedfda8c94f66d2bfa5b69ab Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 17 Mar 2024 13:25:35 +0100 Subject: * admin/notes/bugtracker: Minor copyedit. --- admin/notes/bugtracker | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/admin/notes/bugtracker b/admin/notes/bugtracker index 93532e02d20..419d91ae854 100644 --- a/admin/notes/bugtracker +++ b/admin/notes/bugtracker @@ -431,7 +431,7 @@ reassign 123 spam retitle 123 Some New Title *** To change the submitter name and address: -submitter 123 J. Hacker none@example.com +submitter 123 J. Hacker Note that it does not seem to work to specify "Submitter:" in the pseudo-header when first reporting a bug. -- cgit v1.2.3 From 21828f288ef57422d12860d71e3d4cd8b8cc97b4 Mon Sep 17 00:00:00 2001 From: Kévin Le Gouguec Date: Mon, 12 Feb 2024 08:29:19 +0100 Subject: Fix vc-dir when "remote" Git branch is local While in there, add that "tracking" branch to the vc-dir buffer. For bug#68183. * lisp/vc/vc-git.el (vc-git-dir-extra-headers): Reduce boilerplate with new function 'vc-git--out-ok'; stop calling vc-git-repository-url when REMOTE is "." to avoid throwing an error; display tracking branch; prefer "none ()" to "not ()" since that reads more grammatically correct. (vc-git--out-ok): Add documentation. (vc-git--out-str): New function to easily get the output from a Git command. * test/lisp/vc/vc-git-tests.el (vc-git-test--with-repo) (vc-git-test--run): New helpers, defined to steer clear of vc-git-- internal functions. (vc-git-test-dir-track-local-branch): Check that vc-dir does not crash. --- lisp/vc/vc-git.el | 46 ++++++++++++++++++++++++++++++-------------- test/lisp/vc/vc-git-tests.el | 40 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 72 insertions(+), 14 deletions(-) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 18b4a8691e9..0d54e234659 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -817,27 +817,31 @@ or an empty string if none." cmds)) (defun vc-git-dir-extra-headers (dir) - (let ((str (with-output-to-string - (with-current-buffer standard-output - (vc-git--out-ok "symbolic-ref" "HEAD")))) + (let ((str (vc-git--out-str "symbolic-ref" "HEAD")) (stash-list (vc-git-stash-list)) (default-directory dir) (in-progress (vc-git--cmds-in-progress)) - branch remote remote-url stash-button stash-string) + branch remote-url stash-button stash-string tracking-branch) (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) (progn (setq branch (match-string 2 str)) - (setq remote - (with-output-to-string - (with-current-buffer standard-output - (vc-git--out-ok "config" - (concat "branch." branch ".remote"))))) - (when (string-match "\\([^\n]+\\)" remote) - (setq remote (match-string 1 remote))) - (when (> (length remote) 0) - (setq remote-url (vc-git-repository-url dir remote)))) - (setq branch "not (detached HEAD)")) + (let ((remote (vc-git--out-str + "config" (concat "branch." branch ".remote"))) + (merge (vc-git--out-str + "config" (concat "branch." branch ".merge")))) + (when (string-match "\\([^\n]+\\)" remote) + (setq remote (match-string 1 remote))) + (when (string-match "^\\(refs/heads/\\)?\\(.+\\)$" merge) + (setq tracking-branch (match-string 2 merge))) + (pcase remote + ("." + (setq remote-url "none (tracking local branch)")) + ((pred (not string-empty-p)) + (setq + remote-url (vc-git-repository-url dir remote) + tracking-branch (concat remote "/" tracking-branch)))))) + (setq branch "none (detached HEAD)")) (when stash-list (let* ((len (length stash-list)) (limit @@ -890,6 +894,11 @@ or an empty string if none." (propertize "Branch : " 'face 'vc-dir-header) (propertize branch 'face 'vc-dir-header-value) + (when tracking-branch + (concat + "\n" + (propertize "Tracking : " 'face 'vc-dir-header) + (propertize tracking-branch 'face 'vc-dir-header-value))) (when remote-url (concat "\n" @@ -2226,8 +2235,17 @@ The difference to vc-do-command is that this function always invokes (apply #'process-file vc-git-program nil buffer nil "--no-pager" command args))) (defun vc-git--out-ok (command &rest args) + "Run `git COMMAND ARGS...' and insert standard output in current buffer. +Return whether the process exited with status zero." (zerop (apply #'vc-git--call '(t nil) command args))) +(defun vc-git--out-str (command &rest args) + "Run `git COMMAND ARGS...' and return standard output. +The exit status is ignored." + (with-output-to-string + (with-current-buffer standard-output + (apply #'vc-git--out-ok command args)))) + (defun vc-git--run-command-string (file &rest args) "Run a git command on FILE and return its output as string. FILE can be nil." diff --git a/test/lisp/vc/vc-git-tests.el b/test/lisp/vc/vc-git-tests.el index c52cd9c5875..fd3e8ccd602 100644 --- a/test/lisp/vc/vc-git-tests.el +++ b/test/lisp/vc/vc-git-tests.el @@ -24,6 +24,8 @@ ;;; Code: +(require 'ert-x) +(require 'vc) (require 'vc-git) (ert-deftest vc-git-test-program-version-general () @@ -81,4 +83,42 @@ (should-not (vc-git-annotate-time)) (should-not (vc-git-annotate-time)))) +(defmacro vc-git-test--with-repo (name &rest body) + "Initialize a repository in a temporary directory and evaluate BODY. + +The current directory will be set to the top of that repository; NAME +will be bound to that directory's file name. Once BODY exits, the +directory will be deleted." + (declare (indent 1)) + `(ert-with-temp-directory ,name + (let ((default-directory ,name)) + (vc-create-repo 'Git) + ,@body))) + +(defun vc-git-test--run (&rest args) + "Run git ARGS…, check for non-zero status, and return output." + (with-temp-buffer + (apply 'vc-git-command t 0 nil args) + (buffer-string))) + +(ert-deftest vc-git-test-dir-track-local-branch () + "Test that `vc-dir' works when tracking local branches. Bug#68183." + (skip-unless (executable-find vc-git-program)) + (vc-git-test--with-repo repo + ;; Create an initial commit to get a branch started. + (write-region "hello" nil "README") + (vc-git-test--run "add" "README") + (vc-git-test--run "commit" "-mFirst") + ;; Get current branch name lazily, to remain agnostic of + ;; init.defaultbranch. + (let ((upstream-branch + (string-trim (vc-git-test--run "branch" "--show-current")))) + (vc-git-test--run "checkout" "--track" "-b" "hack" upstream-branch) + (vc-dir default-directory) + (pcase-dolist (`(,header ,value) + `(("Branch" "hack") + ("Tracking" ,upstream-branch))) + (goto-char (point-min)) + (re-search-forward (format "^%s *: %s$" header value)))))) + ;;; vc-git-tests.el ends here -- cgit v1.2.3 From 67b0c1c09eab65c302eb02b20d87900be6367565 Mon Sep 17 00:00:00 2001 From: Protesilaos Stavrou Date: Sun, 17 Mar 2024 18:46:15 +0200 Subject: Update modus-themes to their 4.4.0 version * doc/misc/modus-themes.org: Update the manual to better document existing functionality and cover the new features. * etc/themes/modus-operandi-deuteranopia-theme.el: * etc/themes/modus-operandi-theme.el: * etc/themes/modus-operandi-tinted-theme.el: * etc/themes/modus-operandi-tritanopia-theme.el: * etc/themes/modus-vivendi-deuteranopia-theme.el: * etc/themes/modus-vivendi-theme.el: * etc/themes/modus-vivendi-tinted-theme.el: * etc/themes/modus-vivendi-tritanopia-theme.el: Update the palette of each theme. * etc/themes/modus-themes.el (require): Remove call to cl-lib and do not use relevant functions. (modus-themes-operandi-colors, modus-themes-vivendi-colors) (modus-themes-version, modus-themes-report-bug): Remove old calls to 'make-obsolete' and related. (modus-themes--annotate-theme): Tweak the completion annotation function. (modus-themes--org-block): Deprecate the user option 'modus-themes-org-blocks'. (modus-themes-faces): Update faces. (modus-themes-custom-variables): Update the list of custom variables. Detailed release notes are available here: . --- doc/misc/modus-themes.org | 1435 ++++++++++++----------- etc/themes/modus-operandi-deuteranopia-theme.el | 77 +- etc/themes/modus-operandi-theme.el | 75 +- etc/themes/modus-operandi-tinted-theme.el | 84 +- etc/themes/modus-operandi-tritanopia-theme.el | 77 +- etc/themes/modus-themes.el | 545 ++++----- etc/themes/modus-vivendi-deuteranopia-theme.el | 78 +- etc/themes/modus-vivendi-theme.el | 77 +- etc/themes/modus-vivendi-tinted-theme.el | 96 +- etc/themes/modus-vivendi-tritanopia-theme.el | 77 +- lisp/vc/vc-git.el | 46 +- test/lisp/vc/vc-git-tests.el | 40 - 12 files changed, 1428 insertions(+), 1279 deletions(-) diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org index 45f96778203..c3de15c35ad 100644 --- a/doc/misc/modus-themes.org +++ b/doc/misc/modus-themes.org @@ -4,9 +4,9 @@ #+language: en #+options: ':t toc:nil author:t email:t num:t #+startup: content -#+macro: stable-version 4.3.0 -#+macro: release-date 2023-09-19 -#+macro: development-version 4.4.0-dev +#+macro: stable-version 4.4.0 +#+macro: release-date 2024-03-17 +#+macro: development-version 4.5.0-dev #+macro: file @@texinfo:@file{@@$1@@texinfo:}@@ #+macro: space @@texinfo:@: @@ #+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@ @@ -37,12 +37,10 @@ Current development target is {{{development-version}}}. + Change log: + Color palette: + Sample pictures: -+ Git repo on SourceHut: - - Mirrors: - + GitHub: - + GitLab: -+ Mailing list: -+ Backronym: My Old Display Unexpectedly Sharpened ... themes ++ Git repositories: + + GitHub: + + GitLab: ++ Backronym: My Old Display Unexpectedly Sharpened ... themes. #+toc: headlines 8 insert TOC here, with eight headline levels @@ -90,7 +88,7 @@ The Modus themes consist of eight themes, divided into four subgroups. are variants of the two main themes. They slightly tone down the intensity of the background and provide a bit more color variety. ~modus-operandi-tinted~ has a set of base tones that are shades of - light ocher (earthly colors), while ~modus-vivendi-tinted~ gives a + light ochre (earthly colors), while ~modus-vivendi-tinted~ gives a night sky impression. - Deuteranopia themes :: ~modus-operandi-deuteranopia~ and its @@ -265,9 +263,6 @@ wrong. :properties: :custom_id: h:3f3c3728-1b34-437d-9d0c-b110f5b161a9 :end: -#+findex: modus-themes-toggle -#+findex: modus-themes-load-theme -#+vindex: modus-themes-after-load-theme-hook #+cindex: Essential configuration NOTE that Emacs can load multiple themes, which typically produces @@ -285,7 +280,7 @@ theme of their preference by adding either form to their init file: (load-theme 'modus-vivendi) ; Dark theme #+end_src -Remember that the Modus themes are six themes ([[#h:f0f3dbcb-602d-40cf-b918-8f929c441baf][Overview]]). Adapt the +Remember that there are multiple Modus themes ([[#h:f0f3dbcb-602d-40cf-b918-8f929c441baf][Overview]]). Adapt the above snippet accordingly. Users of packaged variants of the themes must add a few more lines to @@ -342,6 +337,38 @@ This is how a basic setup could look like ([[#h:b66b128d-54a4-4265-b59f-4d1ea2fe [[#h:e979734c-a9e1-4373-9365-0f2cd36107b8][Sample configuration with and without use-package]]. +To disable other themes before loading a Modus theme, use something +like this: + +#+begin_src emacs-lisp +(mapc #'disable-theme custom-enabled-themes) +(load-theme 'modus-operandi :no-confirm) +#+end_src + +#+findex: modus-themes-load-theme +Instead of using the basic ~load-theme~ function, users can rely on +the ~modus-themes-load-theme~. It accepts a single argument, which is +a symbol representing the Modus theme of choice, such as: + +#+begin_src emacs-lisp +(modus-themes-load-theme 'modus-operandi) +#+end_src + +#+vindex: modus-themes-after-load-theme-hook +#+vindex: modus-themes-post-load-hook +The ~modus-themes-load-theme~ takes care to disable other themes, if +the user opts in ([[#h:adb0c49a-f1f9-4690-868b-013a080eed68][Option for disabling other themes while loading Modus]]). +After loading the theme of choice, this function calls the +hook ~modus-themes-after-load-theme-hook~ (alias ~modus-themes-post-load-hook~). +Users can add their own functions to this hook to make further +customizations ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]). + +#+findex: modus-themes-toggle +#+findex: modus-themes-select +The commands ~modus-themes-toggle~ and ~modus-themes-select~ use +~modus-themes-load-theme~ internally ([[#h:4fbfed66-5a89-447a-a07d-a03f6819c5bd][Option for which themes to toggle]]). +The aforementioned hold true for them as well. + ** The ~require-theme~ for built-in Emacs themes :PROPERTIES: :CUSTOM_ID: h:b66b128d-54a4-4265-b59f-4d1ea2feb073 @@ -449,8 +476,6 @@ will lead to failures in loading the files. If either or both of those variables need to be changed, their values should be defined before the package declaration of the themes. -[[#h:aabcada6-810d-4eee-b34a-d2a9c301824d][Make the themes look like what the maintainer uses]] - ** Differences between loading and enabling :properties: :custom_id: h:e68560b3-7fb0-42bc-a151-e015948f8a35 @@ -608,9 +633,9 @@ Possible values: When the value is non-~nil~, the commands ~modus-themes-toggle~ and ~modus-themes-select~, as well as the ~modus-themes-load-theme~ function, will disable all other themes while loading the specified -Modus theme. This is done to ensure that Emacs does not blend two or -more themes: such blends lead to awkward results that undermine the -work of the designer. +Modus theme ([[#h:4fbfed66-5a89-447a-a07d-a03f6819c5bd][Option for which themes to toggle]]). This is done to +ensure that Emacs does not blend two or more themes: such blends lead +to awkward results that undermine the work of the designer. When the value is ~nil~, the aforementioned commands and function will only disable other themes within the Modus collection. @@ -678,6 +703,32 @@ Advanced users may also want to configure the exact attributes of the [[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]. +** Option for which themes to toggle +:PROPERTIES: +:CUSTOM_ID: h:4fbfed66-5a89-447a-a07d-a03f6819c5bd +:END: +#+vindex: modus-themes-to-toggle + +Brief: Choose to Modus themes to toggle between + +Symbol: ~modus-themes-to-toggle~ (=list= type) + +Default value: ='(modus-operandi modus-vivendi)= + +Possible values: + +- ~modus-operandi~ +- ~modus-vivendi~ +- ~modus-operandi-tinted~ +- ~modus-vivendi-tinted~ +- ~modus-operandi-deuteranopia~ +- ~modus-vivendi-deuteranopia~ +- ~modus-operandi-tritanopia~ +- ~modus-vivendi-tritanopia~ + +Specify two themes to toggle between using the command +~modus-themes-toggle~. + ** Option for font mixing :properties: :alt_title: Mixed fonts @@ -851,43 +902,13 @@ Is the same as: :end: #+vindex: modus-themes-org-blocks -Brief: Set the overall style of Org code blocks, quotes, and the like. - -Symbol: ~modus-themes-org-blocks~ (=choice= type) - -Possible values: +As part of version =4.4.0=, the ~modus-themes-org-blocks~ is no more. +Users can apply palette overrides to set a style that fits their +preference (purple, blue, yellow, green, etc.). It is more flexible +and more powerful ([[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][DIY Make Org block colors more or less colorful]]) -1. ~nil~ (default) -2. ~gray-background~ -3. ~tinted-background~ - -Option ~nil~ (the default) means that the block has no background of -its own: it uses the one that applies to the rest of the buffer. -In this case, the delimiter lines have a gray color for their text, -making them look exactly like all other Org properties. - -Option ~gray-background~ applies a subtle gray background to the -block's contents. It also affects the begin and end lines of the -block as they get another shade of gray as their background, which -differentiates them from the contents of the block. All background -colors extend to the edge of the window, giving the area a -rectangular, "blocky" presentation. If the begin/end lines do not -extend in this way, check the value of the Org user option -~org-fontify-whole-block-delimiter-line~. - -Option ~tinted-background~ uses a colored background for the contents -of the block. The exact color value will depend on the programming -language and is controlled by the variable ~org-src-block-faces~ -(refer to the theme's source code for the current association list). -For this to take effect, the Org buffer needs to be restarted with -~org-mode-restart~. - -Code blocks use their major mode's fontification (syntax highlighting) -only when the variable ~org-src-fontify-natively~ is non-~nil~. While -quote/verse blocks require setting -~org-fontify-quote-and-verse-blocks~ to a non-~nil~ value. - -[[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][Update Org block delimiter fontification]]. +For the option to change the background of Org source blocks, we +provide the relevant setup ([[#h:8c842804-43b7-4287-b4e9-8c07d04d1f89][DIY Use colored Org source blocks per language]]). ** Option for the headings' overall style :properties: @@ -1169,22 +1190,175 @@ Named colors can be previewed, such as with the command For a video tutorial that users of all skill levels can approach, watch: https://protesilaos.com/codelog/2022-12-17-modus-themes-v4-demo/. +* Preview theme colors +:properties: +:custom_id: h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d +:end: +#+cindex: Preview named colors or semantic color mappings + +#+findex: modus-themes-list-colors +The command ~modus-themes-list-colors~ uses minibuffer completion to +select an item from the Modus themes and then produces a buffer with +previews of its color palette entries. The buffer has a naming scheme +that reflects the given choice, like =modus-operandi-list-colors= for +the ~modus-operandi~ theme. + +#+findex: modus-themes-list-colors-current +The command ~modus-themes-list-colors-current~ skips the minibuffer +selection process and just produces a preview for the current Modus +theme. + +When called with a prefix argument (=C-u= with the default key +bindings), these commands will show a preview of the palette's +semantic color mappings instead of the named colors. In this context, +"named colors" are entries that associate a symbol to a string color +value, such as =(blue-warmer "#354fcf")=. Whereas "semantic color +mappings" associate a named color to a symbol, like =(string +blue-warmer)=, thus making the theme render all string constructs in +the =blue-warmer= color value ([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]). + +#+findex: modus-themes-preview-colors +#+findex: modus-themes-preview-colors-current +Aliases for those commands are ~modus-themes-preview-colors~ and +~modus-themes-preview-colors-current~. + +Each row shows a foreground and background coloration using the +underlying value it references. For example a line with =#a60000= (a +shade of red) will show red text followed by a stripe with that same +color as a backdrop. + +The name of the buffer describes the given Modus theme and what the +contents are, such as =*modus-operandi-list-colors*= for named colors +and ==*modus-operandi-list-mappings*= for the semantic color mappings. + +* Use colors from the Modus themes palette +:PROPERTIES: +:CUSTOM_ID: h:33460ae8-984b-40fd-8baa-383cc5fc2698 +:END: + +The Modus themes provide the means to access the palette of (i) the +active theme or (ii) any theme in the Modus collection. These are +useful for Do-It-Yourself customizations ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]), +though it can also be helpful in other cases, such as to reuse a color +value in some other application. + +- Function :: [[#h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e][Get a single color from the palette with ~modus-themes-get-color-value~]] +- Macro :: [[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with ~modus-themes-with-colors~]]. + +** Get a single color from the palette with ~modus-themes-get-color-value~ +:PROPERTIES: +:CUSTOM_ID: h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e +:END: + +#+findex: modus-themes-get-color-value +The fuction ~modus-themes-get-color-value~ can be called from Lisp to +return the value of a color from the active Modus theme palette. It +takea a =COLOR= argument and an optional =OVERRIDES=. It also accepts +a third =THEME= argument, to get the color from the given theme. + +=COLOR= is a symbol that represents a named color entry in the +palette ([[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]]). + +If the value is the name of another color entry in the palette (so a +mapping), this function recurs until it finds the underlying color +value. + +With an optional =OVERRIDES= argument as a non-~nil~ value, it +accounts for palette overrides. Else it reads only the default palette +([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]) + +With an optional =THEME= as a symbol among the ~modus-themes-items~ +(alias ~modus-themes-collection~), it uses the palette of that theme. +Else it uses the current Modus theme. + +If =COLOR= is not present in the palette, this function returns the +~unspecified~ symbol, which is safe when used as a face attribute's +value. + +An example with ~modus-operandi~ to show how this function behaves +with/without overrides and when recursive mappings are introduced. + +#+begin_src emacs-lisp +;; Here we show the recursion of palette mappings. In general, it is +;; better for the user to specify named colors to avoid possible +;; confusion with their configuration, though those still work as +;; expected. +(setq modus-themes-common-palette-overrides + '((cursor red) + (fg-mode-line-active cursor) + (border-mode-line-active fg-mode-line-active))) + +;; Ignore the overrides and get the original value. +(modus-themes-get-color-value 'border-mode-line-active) +;; => "#5a5a5a" + +;; Read from the overrides and deal with any recursion to find the +;; underlying value. +(modus-themes-get-color-value 'border-mode-line-active :overrides) +;; => "#a60000" +#+end_src + +** Use theme colors in code with ~modus-themes-with-colors~ +:properties: +:custom_id: h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae +:end: +#+cindex: Use colors from the palette anywhere + +[ Note that for common cases the following is not not needed. Just rely on + the comprehensive overrides we provide ([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]). ] + +#+findex: modus-themes-with-colors +Advanced users may want to apply many colors from the palette of the +active Modus theme in their custom code. In such a case, retrieving +each value with the function ~modus-themes-get-color-value~ is +inefficient ([[#h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e][Get a single color from the palette]]). The Lisp macro +~modus-themes-with-colors~ provides the requisite functionality. It +supplies the current theme's palette to the code called from inside of +it. For example: + +#+begin_src emacs-lisp +(modus-themes-with-colors + (list blue-warmer magenta-cooler fg-added warning variable fg-heading-4)) +;; => ("#354fcf" "#531ab6" "#005000" "#884900" "#005e8b" "#721045") +#+end_src + +The above return value is for ~modus-operandi~ when that is the active +theme. Switching to another theme and evaluating this code anew will +return the relevant results for that theme (remember that since +version 4, the Modus themes consist of many items ([[#h:f0f3dbcb-602d-40cf-b918-8f929c441baf][Overview]])). The +same with ~modus-vivendi~ as the active theme: + +#+begin_src emacs-lisp +(modus-themes-with-colors + (list blue-warmer magenta-cooler fg-added warning variable fg-heading-4)) +;; => ("#79a8ff" "#b6a0ff" "#a0e0a0" "#fec43f" "#00d3d0" "#feacd0") +#+end_src + +The ~modus-themes-with-colors~ has access to the whole palette of the +active theme, meaning that it can instantiate both (i) named colors +like =blue-warmer= and (ii) semantic color mappings like =warning=. +We provide commands to inspect those ([[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]]). + +Others sections in this manual show how to use the aforementioned +macro ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]). In practice, the use of a hook will +also be needed ([[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][DIY Use a hook at the post-load-theme phase]]). + * Advanced customization :properties: :custom_id: h:f4651d55-8c07-46aa-b52b-bed1e53463bb :end: -Unlike the predefined customization options which follow a clear pattern -of allowing the user to quickly specify their preference, the themes -also provide a more flexible, albeit difficult, mechanism to control -things with precision ([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization Options]]). +Unlike the predefined customization options which follow a clear +pattern of allowing the user to quickly specify their preference, the +themes also provide a more flexible, albeit a bit more difficult, +mechanism to control things with precision ([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization Options]]). This section is of interest only to users who are prepared to maintain their own local tweaks and who are willing to deal with any possible -incompatibilities between versioned releases of the themes. As such, +incompatibilities between versioned releases of the themes. As such, they are labeled as "do-it-yourself" or "DIY". -** Palette override presets +** DIY Palette override presets :PROPERTIES: :CUSTOM_ID: h:b0bc811c-227e-42ec-bf67-15e1f41eb7bc :END: @@ -1257,7 +1431,7 @@ the general idea (extra space for didactic purposes): ,@modus-themes-preset-overrides-intense)) #+end_src -** Stylistic variants using palette overrides +** DIY Stylistic variants using palette overrides :PROPERTIES: :CUSTOM_ID: h:df1199d8-eaba-47db-805d-6b568a577bf3 :END: @@ -1269,7 +1443,7 @@ to take effect. To apply overrides at startup simply define them before the call that loads the theme. Remember that we also provide presets that are easier to apply ([[#h:b0bc811c-227e-42ec-bf67-15e1f41eb7bc][Palette override presets]]). -*** Make the mode line borderless +*** DIY Make the mode line borderless :PROPERTIES: :CUSTOM_ID: h:80ddba52-e188-411f-8cc0-480ebd75befe :END: @@ -1284,14 +1458,6 @@ set their color to that of the underlying background. [[#h:5a0c58cc-f97f-429c-be08-927b9fbb0a9c][Add padding to mode line]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - ;; Remove the border (setq modus-themes-common-palette-overrides '((border-mode-line-active unspecified) @@ -1306,7 +1472,9 @@ set their color to that of the underlying background. (border-mode-line-inactive bg-mode-line-inactive))) #+end_src -*** Make the active mode line colorful +Reload the theme for changes to take effect. + +*** DIY Make the active mode line colorful :PROPERTIES: :CUSTOM_ID: h:e8d781be-eefc-4a81-ac4e-5ed156190df7 :END: @@ -1323,14 +1491,6 @@ have a blue mode line for ~modus-operandi~ and a red one for [[#h:5a0c58cc-f97f-429c-be08-927b9fbb0a9c][Add padding to mode line]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - ;; Blue background, neutral foreground, intense blue border (setq modus-themes-common-palette-overrides '((bg-mode-line-active bg-blue-intense) @@ -1343,14 +1503,28 @@ have a blue mode line for ~modus-operandi~ and a red one for (fg-mode-line-active fg-main) (border-mode-line-active blue-intense))) -;; Subtle red background, red foreground, invisible border +;; Sage (green/cyan) background, neutral foreground, slightly distinct green border +(setq modus-themes-common-palette-overrides + '((bg-mode-line-active bg-sage) + (fg-mode-line-active fg-main) + (border-mode-line-active bg-green-intense))) + +;; As above, but with a purple style (setq modus-themes-common-palette-overrides - '((bg-mode-line-active bg-red-subtle) - (fg-mode-line-active red-warmer) - (border-mode-line-active bg-red-subtle))) + '((bg-mode-line-active bg-lavender) + (fg-mode-line-active fg-main) + (border-mode-line-active bg-magenta-intense))) + +;; As above, but with an earthly style +(setq modus-themes-common-palette-overrides + '((bg-mode-line-active bg-ochre) + (fg-mode-line-active fg-main) + (border-mode-line-active bg-yellow-intense))) #+end_src -*** Make the tab bar more or less colorful +Reload the theme for changes to take effect. + +*** DIY Make the tab bar more or less colorful :PROPERTIES: :CUSTOM_ID: h:096658d7-a0bd-4a99-b6dc-9b20a20cda37 :END: @@ -1365,15 +1539,6 @@ fringes, and line numbers. These are shown in other sections of this manual. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - - ;; Make the `tab-bar-mode' mode subtle while keepings its original ;; gray aesthetic. (setq modus-themes-common-palette-overrides @@ -1402,7 +1567,9 @@ manual. (bg-tab-other bg-cyan-subtle))) #+end_src -*** Make the fringe invisible or another color +Reload the theme for changes to take effect. + +*** DIY Make the fringe invisible or another color :PROPERTIES: :CUSTOM_ID: h:c312dcac-36b6-4a1f-b1f5-ab1c9abe27b0 :END: @@ -1415,14 +1582,6 @@ side of the Emacs window which shows indicators such as for truncation or continuation lines. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - ;; Make the fringe invisible (setq modus-themes-common-palette-overrides '((fringe unspecified))) @@ -1436,7 +1595,9 @@ or continuation lines. '((fringe bg-blue-nuanced))) #+end_src -*** Make links use subtle or no underlines +Reload the theme for changes to take effect. + +*** DIY Make links use subtle or no underlines :PROPERTIES: :CUSTOM_ID: h:6c1d1dea-5cbf-4d92-b7bb-570a7a23ffe9 :END: @@ -1460,7 +1621,9 @@ that underline mappings can read correctly. (underline-link-symbolic unspecified))) #+end_src -*** Make prompts more or less colorful +Reload the theme for changes to take effect. + +*** DIY Make prompts more or less colorful :PROPERTIES: :CUSTOM_ID: h:bd75b43a-0bf1-45e7-b8b4-20944ca8b7f8 :END: @@ -1472,14 +1635,6 @@ block we show how to add or remove color from prompts. [[#h:db5a9a7c-2928-4a28-b0f0-6f2b9bd52ba1][Option for command prompt styles]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - ;; Keep the background unspecified (like the default), but use a faint ;; foreground color. (setq modus-themes-common-palette-overrides @@ -1497,7 +1652,9 @@ block we show how to add or remove color from prompts. (bg-prompt bg-yellow-subtle))) ; try to replace "subtle" with "intense" #+end_src -*** Make completion matches more or less colorful +Reload the theme for changes to take effect. + +*** DIY Make completion matches more or less colorful :PROPERTIES: :CUSTOM_ID: h:d959f789-0517-4636-8780-18123f936f91 :END: @@ -1510,14 +1667,6 @@ three different degrees of intensity. [[#h:f1c20c02-7b34-4c35-9c65-99170efb2882][Option for completion framework aesthetics]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - ;; Add a nuanced background color to completion matches, while keeping ;; their foreground intact (foregrounds do not need to be specified in ;; this case, but we do it for didactic purposes). @@ -1584,7 +1733,9 @@ colors to two: The user can mix and match to their liking. -*** Make comments yellow and strings green +Reload the theme for changes to take effect. + +*** DIY Make comments yellow and strings green :PROPERTIES: :CUSTOM_ID: h:26f53daa-0065-48dc-88ab-6a718d16cd95 :END: @@ -1601,14 +1752,6 @@ reproduce the effect, but also how to tweak it to one's liking. [[#h:943063da-7b27-4ba4-9afe-f8fe77652fd1][Make use of alternative styles for code syntax]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - ;; Yellow comments and green strings like older versions of the Modus ;; themes (setq modus-themes-common-palette-overrides @@ -1627,7 +1770,9 @@ reproduce the effect, but also how to tweak it to one's liking. (string yellow-cooler))) #+end_src -*** Make code syntax use the old alt-syntax style +Reload the theme for changes to take effect. + +*** DIY Make code syntax use the old alt-syntax style :PROPERTIES: :CUSTOM_ID: h:c8767172-bf11-4c96-81dc-e736c464fc9c :END: @@ -1640,16 +1785,7 @@ upside of using overrides for this purpose is that we can tweak the style to our liking, but first let's start with its recreation: #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - - -;; The old "alt-syntax" +;; The old "alt-syntax" (before version 4.0.0 of the Modus themes) (setq modus-themes-common-palette-overrides '((builtin magenta) (comment fg-dim) @@ -1712,7 +1848,9 @@ The user can always mix and match styles to their liking. [[#h:943063da-7b27-4ba4-9afe-f8fe77652fd1][Make use of alternative styles for code syntax]]. -*** Make use of alternative styles for code syntax +Reload the theme for changes to take effect. + +*** DIY Make use of alternative styles for code syntax :PROPERTIES: :CUSTOM_ID: h:943063da-7b27-4ba4-9afe-f8fe77652fd1 :END: @@ -1730,18 +1868,9 @@ theme palette. [[#h:26f53daa-0065-48dc-88ab-6a718d16cd95][Make comments yellow and strings green]]. -[[*Make code syntax use the old alt-syntax style][Make code syntax use the old alt-syntax style]]. +[[#h:c8767172-bf11-4c96-81dc-e736c464fc9c][Make code syntax use the old alt-syntax style]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - - ;; Mimic `ef-night' theme (from my `ef-themes') for code syntax ;; highlighting, while still using the Modus colors (and other ;; mappings). @@ -1803,7 +1932,9 @@ theme palette. (variable cyan-warmer))) #+end_src -*** Make matching parenthesis more or less intense +Reload the theme for changes to take effect. + +*** DIY Make matching parenthesis more or less intense :PROPERTIES: :CUSTOM_ID: h:259cf8f5-48ec-4b13-8a69-5d6387094468 :END: @@ -1815,14 +1946,6 @@ delimiters when ~show-paren-mode~ is enabled. We also demonstrate how to enable underlines for those highlights. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - ;; Change the background to a shade of magenta (setq modus-themes-common-palette-overrides '((bg-paren-match bg-magenta-intense))) @@ -1831,9 +1954,17 @@ to enable underlines for those highlights. (setq modus-themes-common-palette-overrides '((bg-paren-match bg-magenta-intense) (underline-paren-match fg-main))) + +;; Do not use any background color and instead apply an intense red +;; foreground. +(setq modus-themes-common-palette-overrides + '((bg-paren-match unspecified) + (fg-paren-match red-intense))) #+end_src -*** Make box buttons more or less gray +Reload the theme for changes to take effect. + +*** DIY Make box buttons more or less gray :PROPERTIES: :CUSTOM_ID: h:4f6b6ca3-f5bb-4830-8312-baa232305360 :END: @@ -1846,14 +1977,6 @@ removes the gray from the active buttons and amplifies it for the inactive ones. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - (setq modus-themes-common-palette-overrides '((bg-button-active bg-main) (fg-button-active fg-main) @@ -1861,7 +1984,9 @@ inactive ones. (fg-button-inactive "gray50"))) #+end_src -*** Make TODO and DONE more or less intense +Reload the theme for changes to take effect. + +*** DIY Make TODO and DONE more or less intense :PROPERTIES: :CUSTOM_ID: h:b57bb50b-a863-4ea8-bb38-6de2275fa868 :END: @@ -1877,14 +2002,6 @@ to subdue them. [[#h:bb5b396f-5532-4d52-ab13-149ca24854f1][Make inline code in prose use alternative styles]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - ;; Increase intensity (setq modus-themes-common-palette-overrides '((prose-done green-intense) @@ -1901,7 +2018,9 @@ to subdue them. '((prose-done fg-dim))) #+end_src -*** Make headings more or less colorful +Reload the theme for changes to take effect. + +*** DIY Make headings more or less colorful :PROPERTIES: :CUSTOM_ID: h:11297984-85ea-4678-abe9-a73aeab4676a :END: @@ -1916,15 +2035,6 @@ match styles at will. [[#h:b57bb50b-a863-4ea8-bb38-6de2275fa868][Make TODO and DONE more intense]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - - ;; Apply more colorful foreground to some headings (headings 0-8). ;; Level 0 is for Org #+title and related. (setq modus-themes-common-palette-overrides @@ -1958,7 +2068,107 @@ match styles at will. (overline-heading-1 border))) #+end_src -*** Make Org agenda more or less colorful +Reload the theme for changes to take effect. + +*** DIY Make Org block colors more or less colorful +:properties: +:custom_id: h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50 +:end: + +This is one of our practical examples to override the semantic colors +of the Modus themes ([[#h:df1199d8-eaba-47db-805d-6b568a577bf3][Stylistic variants using palette overrides]]). Here +we show how to change the presentation of Org blocks (and other such +blocks like Markdown fenced code sections, though the exact +presentation depends on each major mode). + +The default style of Org blocks is a subtle gray background for the +contents and for the delimiter lines (the =#+begin_= and =#+end_= +parts). The text of the delimiter lines is a subtle gray foreground +color. + +[[#h:bb5b396f-5532-4d52-ab13-149ca24854f1][Make inline code in prose use alternative styles]]. + +#+begin_src emacs-lisp +;; Make code blocks (in Org, for example) use a more colorful style +;; for their delimiter lines as well as their contents. Give this a +;; purple feel. Make the delimiter lines distinct from the contents. +(setq modus-themes-common-palette-overrides + '((bg-prose-block-contents bg-magenta-nuanced) + (bg-prose-block-delimiter bg-lavender) + (fg-prose-block-delimiter fg-main))) + +;; As above, but with a more blue feel. +(setq modus-themes-common-palette-overrides + '((bg-prose-block-contents bg-blue-nuanced) + (bg-prose-block-delimiter bg-lavender) + (fg-prose-block-delimiter fg-main))) + +;; As above, but with a green feel. +(setq modus-themes-common-palette-overrides + '((bg-prose-block-contents bg-green-nuanced) + (bg-prose-block-delimiter bg-sage) + (fg-prose-block-delimiter fg-main))) + +;; As above, but with a yellow/gold feel. +(setq modus-themes-common-palette-overrides + '((bg-prose-block-contents bg-yellow-nuanced) + (bg-prose-block-delimiter bg-ochre) + (fg-prose-block-delimiter fg-main))) + +;; As above, but with a slightly more red feel. +(setq modus-themes-common-palette-overrides + '((bg-prose-block-contents bg-red-nuanced) + (bg-prose-block-delimiter bg-ochre) + (fg-prose-block-delimiter fg-main))) +#+end_src + +The previous examples differentiate the delimiter lines from the +block's contents. Though we can mimic the default aesthetic of a +uniform background, while changing the applicable colors. Here are +some nice combinations: + +#+begin_src emacs-lisp +;; Solid green style. +(setq modus-themes-common-palette-overrides + '((bg-prose-block-contents bg-green-nuanced) + (bg-prose-block-delimiter bg-green-nuanced) + (fg-prose-block-delimiter green-warmer))) + +;; Solid yellow style. +(setq modus-themes-common-palette-overrides + '((bg-prose-block-contents bg-yellow-nuanced) + (bg-prose-block-delimiter bg-yellow-nuanced) + (fg-prose-block-delimiter yellow-cooler))) + +;; Solid cyan style. +(setq modus-themes-common-palette-overrides + '((bg-prose-block-contents bg-cyan-nuanced) + (bg-prose-block-delimiter bg-cyan-nuanced) + (fg-prose-block-delimiter cyan-cooler))) +#+end_src + +[ Combine the above with a suitable mode line style for maximum effect + ([[#h:e8d781be-eefc-4a81-ac4e-5ed156190df7][DIY Make the active mode line colorful]]). ] + +Finally, the following makes code blocks have no distinct background. +The minimal styles are applied to the delimiter lines, which only use +a subtle gray foreground. This was the default for the Modus themes up +until version 4.3.0. + +#+begin_src emacs-lisp +;; Make code blocks more minimal, so that (i) the delimiter lines have +;; no background, (ii) the delimiter foreground is a subtle gray, and +;; (iii) the block contents have no distinct background either. This +;; was the default in versions of the Modus themes before 4.4.0 +(setq modus-themes-common-palette-overrides + '((bg-prose-block-contents unspecified) + (bg-prose-block-delimiter unspeficied) + (fg-prose-block-delimiter fg-dim))) +#+end_src + +[[#h:8c842804-43b7-4287-b4e9-8c07d04d1f89][DIY Use colored Org source blocks per language]]. + +*** DIY Make Org agenda more or less colorful :PROPERTIES: :CUSTOM_ID: h:a5af0452-a50f-481d-bf60-d8143f98105f :END: @@ -1973,14 +2183,6 @@ these styles with what we show in the other chapters with practical stylistic variants. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - ;; Make the Org agenda use alternative and varied colors. (setq modus-themes-common-palette-overrides '((date-common cyan) ; default value (for timestamps and more) @@ -2004,7 +2206,7 @@ An example with faint coloration: (date-holiday magenta) ; default (for M-x calendar) (date-now fg-main) ; default (date-scheduled yellow-faint) - (date-weekday fg-dim) + (date-weekday fg-alt) (date-weekend fg-dim))) #+end_src @@ -2041,7 +2243,9 @@ Yet another example that also affects =DONE= and =TODO= keywords: (prose-todo yellow))) #+end_src -*** Make inline code in prose use alternative styles +Reload the theme for changes to take effect. + +*** DIY Make inline code in prose use alternative styles :PROPERTIES: :CUSTOM_ID: h:bb5b396f-5532-4d52-ab13-149ca24854f1 :END: @@ -2053,54 +2257,47 @@ Org's verbatim, code, and macro entries. We also provide mappings for tables, property drawers, tags, and code block delimiters, though we do not show every possible permutation. -[[#h:b57bb50b-a863-4ea8-bb38-6de2275fa868][Make TODO and DONE more or less intense]]. +- [[#h:b57bb50b-a863-4ea8-bb38-6de2275fa868][Make TODO and DONE more or less intense]]. +- [[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][DIY Make Org block colors more or less colorful]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. +;; A nuanced accented background, combined with a suitable foreground. +(setq modus-themes-common-palette-overrides + '((bg-prose-code bg-green-nuanced) + (fg-prose-code green-cooler) + (bg-prose-verbatim bg-magenta-nuanced) + (fg-prose-verbatim magenta-warmer) -;; These are all the mappings at their default values for didactic -;; purposes -(setq modus-themes-common-palette-overrides - '((prose-block fg-dim) - (prose-code green-cooler) - (prose-done green) - (prose-macro magenta-cooler) - (prose-metadata fg-dim) - (prose-metadata-value fg-alt) - (prose-table fg-alt) - (prose-tag magenta-faint) - (prose-todo red) - (prose-verbatim magenta-warmer))) - -;; Make code block delimiters use a shade of red, tone down verbatim, -;; code, and macro, and amplify the style of property drawers + (bg-prose-macro bg-blue-nuanced) + (fg-prose-macro magenta-cooler))) + +;; A more noticeable accented background, combined with a suitable foreground. (setq modus-themes-common-palette-overrides - '((prose-block red-faint) - (prose-code fg-dim) - (prose-macro magenta-faint) - (prose-metadata cyan) - (prose-metadata-value green-warmer) - (prose-verbatim fg-dim))) - -;; Like the above but with more color variety for the inline code -;; elements + '((bg-prose-code bg-sage) + (fg-prose-code green-faint) + + (bg-prose-verbatim bg-ochre) + (fg-prose-verbatim red-faint) + + (bg-prose-macro bg-lavender) + (fg-prose-macro blue-faint))) + +;; Leave the backgrounds without a color and simply make the foregrounds more intense. (setq modus-themes-common-palette-overrides - '((prose-block red-faint) - (prose-code blue-cooler) - (prose-macro yellow-warmer) - (prose-metadata cyan) - (prose-metadata-value green-warmer) - (prose-verbatim red-warmer))) + '((bg-prose-code unspecified) + (fg-prose-code green-intense) + + (bg-prose-verbatim unspecified) + (fg-prose-verbatim magenta-intense) + + (bg-prose-macro unspecified) + (fg-prose-macro cyan-intense))) #+end_src -*** Make mail citations and headers more or less colorful +Reload the theme for changes to take effect. + +*** DIY Make mail citations and headers more or less colorful :PROPERTIES: :CUSTOM_ID: h:7da7a4ad-5d3a-4f11-9796-5a1abed0f0c4 :END: @@ -2125,15 +2322,6 @@ This is some sample text We thus have the following: #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - - ;; Reduce the intensity of mail citations and headers (setq modus-themes-common-palette-overrides '((mail-cite-0 cyan-faint) @@ -2169,7 +2357,9 @@ We thus have the following: (mail-other green))) #+end_src -*** Make the region preserve text colors, plus other styles +Reload the theme for changes to take effect. + +*** DIY Make the region preserve text colors, plus other styles :PROPERTIES: :CUSTOM_ID: h:c8605d37-66e1-42aa-986e-d7514c3af6fe :END: @@ -2183,15 +2373,6 @@ with an appropriate foreground value. [[#h:a5140c9c-18b2-45db-8021-38d0b5074116][Do not extend the region background]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - - ;; A background with no specific foreground (use foreground of ;; underlying text) (setq modus-themes-common-palette-overrides @@ -2209,7 +2390,9 @@ with an appropriate foreground value. (fg-region fg-main))) #+end_src -*** Make mouse highlights more or less colorful +Reload the theme for changes to take effect. + +*** DIY Make mouse highlights more or less colorful :PROPERTIES: :CUSTOM_ID: h:b5cab69d-d7cb-451c-8ff9-1f545ceb6caf :END: @@ -2220,15 +2403,6 @@ the following code block we show how to affect the semantic color mapping that covers mouse hover effects and related highlights: #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - - ;; Make the background an intense yellow (setq modus-themes-common-palette-overrides '((bg-hover bg-yellow-intense))) @@ -2238,7 +2412,9 @@ mapping that covers mouse hover effects and related highlights: '((bg-hover bg-green-subtle))) #+end_src -*** Make language underlines less colorful +Reload the theme for changes to take effect. + +*** DIY Make language underlines less colorful :PROPERTIES: :CUSTOM_ID: h:03dbd5af-6bae-475e-85a2-cec189f69598 :END: @@ -2249,15 +2425,6 @@ Here we show how to affect the color of the underlines that are used by code linters and prose spell checkers. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - - ;; Make the underlines less intense (setq modus-themes-common-palette-overrides '((underline-err red-faint) @@ -2271,7 +2438,9 @@ by code linters and prose spell checkers. (underline-note green-intense))) #+end_src -*** Make line numbers use alternative styles +Reload the theme for changes to take effect. + +*** DIY Make line numbers use alternative styles :PROPERTIES: :CUSTOM_ID: h:b6466f51-cb58-4007-9ebe-53a27af655c7 :END: @@ -2281,15 +2450,6 @@ of the Modus themes ([[#h:df1199d8-eaba-47db-805d-6b568a577bf3][Stylistic varian this section we show how to affect the ~display-line-numbers-mode~. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - - ;; Make line numbers less intense (setq modus-themes-common-palette-overrides '((fg-line-number-inactive "gray50") @@ -2313,7 +2473,9 @@ this section we show how to affect the ~display-line-numbers-mode~. (bg-line-number-active bg-cyan-intense))) #+end_src -*** Make diffs use only a foreground +Reload the theme for changes to take effect. + +*** DIY Make diffs use only a foreground :PROPERTIES: :CUSTOM_ID: h:b3761482-bcbf-4990-a41e-4866fb9dad15 :END: @@ -2377,7 +2539,9 @@ just using the "common" overrides. (fg-removed-intense yellow-intense))) #+end_src -*** Make deuteranopia diffs red and blue instead of yellow and blue +Reload the theme for changes to take effect. + +*** DIY Make deuteranopia diffs red and blue instead of yellow and blue :PROPERTIES: :CUSTOM_ID: h:16389ea1-4cb6-4b18-9409-384324113541 :END: @@ -2428,112 +2592,9 @@ respectively. This is achieved by overriding the "changed" and (fg-removed-intense "#ff9095"))) #+end_src -*** Make the themes look like what the maintainer uses -:PROPERTIES: -:CUSTOM_ID: h:aabcada6-810d-4eee-b34a-d2a9c301824d -:END: - -Based on what we have learnt from the previous sections of this -manual, here is what Protesilaos uses: - -#+begin_src emacs-lisp -;; Always reload the theme for changes to take effect! - -(setq modus-themes-custom-auto-reload nil - modus-themes-to-toggle '(modus-operandi modus-vivendi) - modus-themes-mixed-fonts t - modus-themes-variable-pitch-ui nil - modus-themes-italic-constructs t - modus-themes-bold-constructs nil - modus-themes-org-blocks nil - modus-themes-completions '((t . (extrabold))) - modus-themes-prompts nil - modus-themes-headings - '((agenda-structure . (variable-pitch light 2.2)) - (agenda-date . (variable-pitch regular 1.3)) - (t . (regular 1.15)))) - -(setq modus-themes-common-palette-overrides - '((cursor magenta-cooler) - ;; Make the fringe invisible. - (fringe unspecified) - ;; Make line numbers less intense and add a shade of cyan - ;; for the current line number. - (fg-line-number-inactive "gray50") - (fg-line-number-active cyan-cooler) - (bg-line-number-inactive unspecified) - (bg-line-number-active unspecified) - ;; Make the current line of `hl-line-mode' a fine shade of - ;; gray (though also see my `lin' package). - (bg-hl-line bg-dim) - ;; Make the region have a cyan-green background with no - ;; specific foreground (use foreground of underlying text). - ;; "bg-sage" refers to Salvia officinalis, else the common - ;; sage. - (bg-region bg-sage) - (fg-region unspecified) - ;; Make matching parentheses a shade of magenta. It - ;; complements the region nicely. - (bg-paren-match bg-magenta-intense) - ;; Make email citations faint and neutral, reducing the - ;; default four colors to two; make mail headers cyan-blue. - (mail-cite-0 fg-dim) - (mail-cite-1 blue-faint) - (mail-cite-2 fg-dim) - (mail-cite-3 blue-faint) - (mail-part cyan-warmer) - (mail-recipient blue-warmer) - (mail-subject magenta-cooler) - (mail-other cyan-warmer) - ;; Change dates to a set of more subtle combinations. - (date-deadline magenta-cooler) - (date-scheduled magenta) - (date-weekday fg-main) - (date-event fg-dim) - (date-now blue-faint) - ;; Make tags (Org) less colorful and tables look the same as - ;; the default foreground. - (prose-done cyan-cooler) - (prose-tag fg-dim) - (prose-table fg-main) - ;; Make headings less colorful (though I never use deeply - ;; nested headings). - (fg-heading-2 blue-faint) - (fg-heading-3 magenta-faint) - (fg-heading-4 blue-faint) - (fg-heading-5 magenta-faint) - (fg-heading-6 blue-faint) - (fg-heading-7 magenta-faint) - (fg-heading-8 blue-faint) - ;; Make the active mode line a fine shade of lavender - ;; (purple) and tone down the gray of the inactive mode - ;; lines. - (bg-mode-line-active bg-lavender) - (border-mode-line-active bg-lavender) - - (bg-mode-line-inactive bg-dim) - (border-mode-line-inactive bg-inactive) - ;; Make the prompts a shade of magenta, to fit in nicely with - ;; the overall blue-cyan-purple style of the other overrides. - ;; Add a nuanced background as well. - (bg-prompt bg-magenta-nuanced) - (fg-prompt magenta-cooler) - ;; Tweak some more constructs for stylistic consistency. - (name blue-warmer) - (identifier magenta-faint) - (keybind magenta-cooler) - (accent-0 magenta-cooler) - (accent-1 cyan-cooler) - (accent-2 blue-warmer) - (accent-3 red-cooler))) - -;; Make the active mode line have a pseudo 3D effect (this assumes -;; you are using the default mode line and not an extra package). -(custom-set-faces - '(mode-line ((t :box (:style released-button))))) -#+end_src +Reload the theme for changes to take effect. -** More accurate colors in terminal emulators +** DIY More accurate colors in terminal emulators :PROPERTIES: :CUSTOM_ID: h:fbb5e254-afd6-4313-bb05-93b3b4f67358 :END: @@ -2562,7 +2623,7 @@ Another example that can be bound to a key: : TERM=xterm-direct uxterm -e emacsclient -nw -** Range of color with terminal emulators +** DIY Range of color with terminal emulators :PROPERTIES: :CUSTOM_ID: h:6b8211b0-d11b-4c00-9543-4685ec3b742f :END: @@ -2633,48 +2694,7 @@ xterm*color14: #6ae4b9 xterm*color15: #ffffff #+end_src -** Preview theme colors -:properties: -:custom_id: h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d -:end: -#+cindex: Preview named colors or semantic color mappings - -#+findex: modus-themes-list-colors -The command ~modus-themes-list-colors~ uses minibuffer completion to -select an item from the Modus themes and then produces a buffer with -previews of its color palette entries. The buffer has a naming scheme -that reflects the given choice, like =modus-operandi-list-colors= for -the ~modus-operandi~ theme. - -#+findex: modus-themes-list-colors-current -The command ~modus-themes-list-colors-current~ skips the minibuffer -selection process and just produces a preview for the current Modus -theme. - -When called with a prefix argument (=C-u= with the default key -bindings), these commands will show a preview of the palette's -semantic color mappings instead of the named colors. In this context, -"named colors" are entries that associate a symbol to a string color -value, such as =(blue-warmer "#354fcf")=. Whereas "semantic color -mappings" associate a named color to a symbol, like =(string -blue-warmer)=, thus making the theme render all string constructs in -the =blue-warmer= color value ([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]). - -#+findex: modus-themes-preview-colors -#+findex: modus-themes-preview-colors-current -Aliases for those commands are ~modus-themes-preview-colors~ and -~modus-themes-preview-colors-current~. - -Each row shows a foreground and background coloration using the -underlying value it references. For example a line with =#a60000= (a -shade of red) will show red text followed by a stripe with that same -color as a backdrop. - -The name of the buffer describes the given Modus theme and what the -contents are, such as =*modus-operandi-list-colors*= for named colors -and ==*modus-operandi-list-mappings*= for the semantic color mappings. - -** Per-theme customization settings +** DIY Per-theme customization settings :properties: :custom_id: h:a897b302-8e10-4a26-beab-3caaee1e1193 :end: @@ -2709,114 +2729,9 @@ equivalent the themes provide. For a more elaborate design, it is better to inspect the source code of ~modus-themes-toggle~ and relevant functions. -** Get a single color from the palette -:PROPERTIES: -:CUSTOM_ID: h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e -:END: - -[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. - -#+findex: modus-themes-get-color-value -The function ~modus-themes-get-color-value~ can be called from Lisp to -return the value of a color from the active Modus theme palette. It -takea a =COLOR= argument and an optional =OVERRIDES=. - -=COLOR= is a symbol that represents a named color entry in the -palette. +Reload the theme for changes to take effect. -[[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]]. - -If the value is the name of another color entry in the palette (so a -mapping), this function recurs until it finds the underlying color -value. - -With an optional =OVERRIDES= argument as a non-~nil~ value, it accounts -for palette overrides. Else it reads only the default palette. - -[[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]. - -With optional =THEME= as a symbol among ~modus-themes-items~ (alias -~modus-themes-collection~), use the palette of that item. Else use -the current Modus theme. - -If =COLOR= is not present in the palette, this function returns the -~unspecified~ symbol, which is safe when used as a face attribute's -value. - -An example with ~modus-operandi~ to show how this function behaves -with/without overrides and when recursive mappings are introduced. - -#+begin_src emacs-lisp -;; Here we show the recursion of palette mappings. In general, it is -;; better for the user to specify named colors to avoid possible -;; confusion with their configuration, though those still work as -;; expected. -(setq modus-themes-common-palette-overrides - '((cursor red) - (fg-mode-line-active cursor) - (border-mode-line-active fg-mode-line-active))) - -;; Ignore the overrides and get the original value. -(modus-themes-get-color-value 'border-mode-line-active) -;; => "#5a5a5a" - -;; Read from the overrides and deal with any recursion to find the -;; underlying value. -(modus-themes-get-color-value 'border-mode-line-active :overrides) -;; => "#a60000" -#+end_src - -** Use theme colors in code with modus-themes-with-colors -:properties: -:custom_id: h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae -:end: -#+cindex: Use colors from the palette anywhere - -[[#h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e][Get a single color from the palette]]. - -Note that users most probably do not need the following. Just rely on -the comprehensive overrides we provide ([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]). - -#+findex: modus-themes-with-colors -Advanced users may want to apply colors from the palette of the active -Modus theme in their custom code. The ~modus-themes-with-colors~ -macro supplies those to any form called inside of it. For example: - -#+begin_src emacs-lisp -(modus-themes-with-colors - (list blue-warmer magenta-cooler fg-added warning variable fg-heading-4)) -;; => ("#354fcf" "#531ab6" "#005000" "#884900" "#005e8b" "#721045") -#+end_src - -The above return value is for ~modus-operandi~ when that is the active -theme. Switching to another theme and evaluating this code anew will -give us the relevant results for that theme (remember that since -version 4, the Modus themes consist of six items ([[#h:f0f3dbcb-602d-40cf-b918-8f929c441baf][Overview]])). The -same with ~modus-vivendi~ as the active theme: - -#+begin_src emacs-lisp -(modus-themes-with-colors - (list blue-warmer magenta-cooler fg-added warning variable fg-heading-4)) -;; => ("#79a8ff" "#b6a0ff" "#a0e0a0" "#fec43f" "#00d3d0" "#feacd0") -#+end_src - -The ~modus-themes-with-colors~ has access to the whole palette of the -active theme, meaning that it can instantiate both (i) named colors -like =blue-warmer= and (ii) semantic color mappings like =warning=. -We provide commands to inspect those ([[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]]). - -Others sections in this manual show how to use the aforementioned -macro ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]). - -Because the ~modus-themes-with-colors~ will most likely be used to -customize faces, note that any function that calls it must be run at -startup after the theme loads. The same function must also be -assigned to the ~modus-themes-after-load-theme-hook~ for its effects -to persist and be updated when switching between Modus themes (e.g. to -update the exact value of =blue-warmer= when toggling between -~modus-operandi~ to ~modus-vivendi~. - -** Do not extend the region background +** DIY Do not extend the region background :PROPERTIES: :CUSTOM_ID: h:a5140c9c-18b2-45db-8021-38d0b5074116 :END: @@ -2834,11 +2749,14 @@ this to the Emacs configuration file will suffice: [[#h:c8605d37-66e1-42aa-986e-d7514c3af6fe][Make the region preserve text colors, plus other styles]]. -** Add padding to mode line +** DIY Add padding to the mode line :PROPERTIES: :CUSTOM_ID: h:5a0c58cc-f97f-429c-be08-927b9fbb0a9c :END: +[ Consider using the ~spacious-padding~ package from GNU ELPA (by + Protesilaos) for more than just the mode line. ] + Emacs faces do not have a concept of "padding" for the space between the text and its box boundaries. We can approximate the effect by adding a =:box= attribute, making its border several pixels thick, and @@ -2849,7 +2767,7 @@ mode line. [[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. #+begin_src emacs-lisp -(defun my-modus-themes-custom-faces () +(defun my-modus-themes-custom-faces (&rest _) (modus-themes-with-colors (custom-set-faces ;; Add "padding" to the mode lines @@ -2859,6 +2777,8 @@ mode line. (add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) #+end_src +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + The above has the effect of removing the border around the mode lines. In older versions of the themes, we provided the option for a padded mode line which could also have borders around it. Those were not @@ -2866,7 +2786,7 @@ real border, however, but an underline and an overline. Adjusting the above: #+begin_src emacs-lisp -(defun my-modus-themes-custom-faces () +(defun my-modus-themes-custom-faces (&rest _) (modus-themes-with-colors (custom-set-faces ;; Add "padding" to the mode lines @@ -2886,13 +2806,15 @@ above: The reason we no longer provide this option is because it depends on a non-~nil~ value for ~x-underline-at-descent-line~. That variable affects ALL underlines, including those of links. The effect is -intrusive and looks awkward in prose. +intrusive and looks awkard in prose. As such, the Modus themes no longer provide that option but instead offer this piece of documentation to make the user fully aware of the state of affairs. -** Remap face with local value +Reload the theme for changes to take effect. + +** DIY Remap face with local value :properties: :custom_id: h:7a93cb6f-4eca-4d56-a85c-9dcd813d6b0f :end: @@ -2954,12 +2876,17 @@ Perhaps you may wish to generalize those findings in to a set of functions that also accept an arbitrary face. We shall leave the experimentation up to you. -** Font configurations for Org and others +Reload the theme for changes to take effect. + +** DIY Font configurations for Org and others :properties: :custom_id: h:defcf4fc-8fa8-4c29-b12e-7119582cc929 :end: #+cindex: Font configurations +[ Consider using the ~fontaine~ package from GNU ELPA (by Protesilaos) + for all font-related configurations. ] + The themes are designed to optionally cope well with mixed font configurations. This mostly concerns ~org-mode~ and ~markdown-mode~, though expect to find it elsewhere like in ~Info-mode~. @@ -2979,9 +2906,6 @@ the ~variable-pitch~ (proportional spacing) and ~fixed-pitch~ (monospaced) faces respectively. It may also be convenient to set your main typeface by configuring the ~default~ face the same way. -[ The ~fontaine~ package on GNU ELPA (by Protesilaos) is designed to - handle this case. ] - Put something like this in your initialization file (also consider reading the doc string of ~set-face-attribute~): @@ -3023,12 +2947,15 @@ absolute height). [[#h:e6c5451f-6763-4be7-8fdb-b4706a422a4c][Note for EWW and Elfeed fonts]]. -** Configure bold and italic faces +** DIY Configure bold and italic faces :properties: :custom_id: h:2793a224-2109-4f61-a106-721c57c01375 :end: #+cindex: Bold and italic fonts +[ Consider using the ~fontaine~ package from GNU ELPA (by Protesilaos) + for all font-related configurations. ] + The Modus themes do not hardcode a ~:weight~ or ~:slant~ attribute in the thousands of faces they cover. Instead, they configure the generic faces called ~bold~ and ~italic~ to use the appropriate styles and then @@ -3082,12 +3009,12 @@ To reset the font family, one can use this: #+end_src To ensure that the effects persist after switching between the Modus -themes (such as with {{{kbd(M-x modus-themes-toggle)}}}), the user needs to -write their configurations to a function and pass it to the -~modus-themes-after-load-theme-hook~. This is necessary because themes -set the styles of faces upon activation, overriding prior values where -conflicts occur between the previous and the current states (otherwise -changing themes would not be possible). +themes (such as with {{{kbd(M-x modus-themes-toggle)}}}), the user +needs to write their configurations to a function and pass it to the +~modus-themes-after-load-theme-hook~ ([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]). This is +necessary because themes set the styles of faces upon activation, +overriding prior values where conflicts occur between the previous and +the current states (otherwise changing themes would not be possible). [[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A theme-agnostic hook for theme loading]]. @@ -3100,14 +3027,14 @@ of the themes, which can make it easier to redefine faces in bulk). #+begin_src emacs-lisp ;; our generic function -(defun my-modes-themes-bold-italic-faces () +(defun my-modes-themes-bold-italic-faces (&rest _) (set-face-attribute 'default nil :family "Source Code Pro" :height 110) (set-face-attribute 'bold nil :weight 'semibold)) ;; or use this if you configure a lot of face and attributes and ;; especially if you plan to use `modus-themes-with-colors', as shown ;; elsewhere in the manual -(defun my-modes-themes-bold-italic-faces () +(defun my-modes-themes-bold-italic-faces (&rest _) (custom-set-faces '(default ((t :family "Source Code Pro" :height 110))) '(bold ((t :weight semibold))))) @@ -3118,7 +3045,11 @@ of the themes, which can make it easier to redefine faces in bulk). [[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. -** Custom Org todo keyword and priority faces +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + +Reload the theme for changes to take effect. + +** DIY Custom Org todo keyword and priority faces :properties: :custom_id: h:89f0678d-c5c3-4a57-a526-668b2bb2d7ad :end: @@ -3207,7 +3138,7 @@ it if you plan to control face attributes. [[#h:02e25930-e71a-493d-828a-8907fc80f874][Check color combinations]]. -** Custom Org emphasis faces +** DIY Custom Org emphasis faces :properties: :custom_id: h:26026302-47f4-4471-9004-9665470e7029 :end: @@ -3229,7 +3160,7 @@ specification of that variable looks like this: With the exception of ~org-verbatim~ and ~org-code~ faces, everything else uses the corresponding type of emphasis: a bold typographic weight, or -italicized, underlined, and struck through text. +italicised, underlined, and struck through text. The best way for users to add some extra attributes, such as a foreground color, is to define their own faces and assign them to the @@ -3340,49 +3271,97 @@ styled by the themes, it probably is best not to edit them: That's it! For changes to take effect in already visited Org files, invoke {{{kbd(M-x org-mode-restart)}}}. -** Update Org block delimiter fontification -:properties: -:custom_id: h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50 -:end: +** DIY Use colored Org source blocks per language +:PROPERTIES: +:CUSTOM_ID: h:8c842804-43b7-4287-b4e9-8c07d04d1f89 +:END: -As noted in the section about ~modus-themes-org-blocks~, Org contains a -variable that determines whether the block's begin and end lines are -extended to the edge of the window ([[#h:b7e328c0-3034-4db7-9cdf-d5ba12081ca2][Option for org-mode block styles]]). -The variable is ~org-fontify-whole-block-delimiter-line~. +[[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][DIY Make Org block colors more or less colorful]]. -Users who change the style of Org blocks from time to time may prefer to -automatically update delimiter line fontification, such as with the -following setup: +In versions of the Modus themes before =4.4.0= there was an option to +change the coloration of Org source blocks so that certain languages +would have a distinctly colored background. This was not flexible +enough, because (i) we cannot cover all languages effectively and (ii) +the user had no choice over the =language --> color= mapping. -#+begin_src emacs-lisp -(defun my-modus-themes-org-fontify-block-delimiter-lines () - "Match `org-fontify-whole-block-delimiter-line' to theme style. -Run this function at the post theme load phase, such as with the -`modus-themes-after-load-theme-hook'." - (if (eq modus-themes-org-blocks 'gray-background) - (setq org-fontify-whole-block-delimiter-line t) - (setq org-fontify-whole-block-delimiter-line nil))) +As such, the old user option is no more. Users can use the following +to achieve what they want: -(add-hook 'modus-themes-after-load-theme-hook - #'my-modus-themes-org-fontify-block-delimiter-lines) +[ All this is done by setting the Org user option ~org-src-block-faces~, + so it is not related to the palette overrides mechanism provided by + the Modus themes. ] + +#+begin_src emacs-lisp +(defun my-modus-themes-org-block-faces (&rest _) + (modus-themes-with-colors + ;; The `org-src-block-faces' does not get re-applied in existing + ;; Org buffers. Do M-x org-mode-restart for changes to take + ;; effect. + (setq org-src-block-faces + `(("emacs-lisp" modus-themes-nuanced-magenta) + ("elisp" modus-themes-nuanced-magenta) + ("clojure" modus-themes-nuanced-magenta) + ("clojurescript" modus-themes-nuanced-magenta) + ("c" modus-themes-nuanced-blue) + ("c++" modus-themes-nuanced-blue) + ("sh" modus-themes-nuanced-yellow) + ("shell" modus-themes-nuanced-yellow) + ("python" modus-themes-nuanced-yellow) + ("ipython" modus-themes-nuanced-yellow) + ("r" modus-themes-nuanced-yellow) + ("html" modus-themes-nuanced-green) + ("xml" modus-themes-nuanced-green) + ("css" modus-themes-nuanced-red) + ("scss" modus-themes-nuanced-red) + ("yaml" modus-themes-nuanced-cyan) + ("conf" modus-themes-nuanced-cyan) + ("docker" modus-themes-nuanced-cyan))))) + +(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-org-block-faces) #+end_src -Then {{{kbd(M-x org-mode-restart)}}} for changes to take effect, though manual -intervention can be circumvented by tweaking the function thus: +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][DIY Use a hook at the post-load-theme phase]]. + +Note that the ~org-src-block-faces~ accepts a named face, as shown +above, as well as a list of face attributes. The latter approach is +not good enough because it hardcodes values in such a way that an +~org-mode-restart~ is necessary. Whereas the indirection of the named +face lets the theme change the values while Org buffers continue to +show the right colors. + +Still, if a user prefers to hardcode face attributes, here is the +idea: #+begin_src emacs-lisp -(defun my-modus-themes-org-fontify-block-delimiter-lines () - "Match `org-fontify-whole-block-delimiter-line' to theme style. -Run this function at the post theme load phase, such as with the -`modus-themes-after-load-theme-hook'." - (if (eq modus-themes-org-blocks 'gray-background) - (setq org-fontify-whole-block-delimiter-line t) - (setq org-fontify-whole-block-delimiter-line nil)) - (when (derived-mode-p 'org-mode) - (font-lock-flush))) +;; This is for the sake of completeness. I DO NOT RECOMMEND THIS +;; method because it hardcodes values and thus requires +;; `org-mode-restart' every time you change a theme. +(defun my-modus-themes-org-block-faces (&rest _) + (modus-themes-with-colors + (setq org-src-block-faces + `(("emacs-lisp" (:inherit org-block :background ,bg-magenta-nuanced)) + ("elisp" (:inherit org-block :background ,bg-magenta-nuanced)) + ("clojure" (:inherit org-block :background ,bg-magenta-nuanced)) + ("clojurescript" (:inherit org-block :background ,bg-magenta-nuanced)) + ("c" (:inherit org-block :background ,bg-blue-nuanced)) + ("c++" (:inherit org-block :background ,bg-blue-nuanced)) + ("sh" (:inherit org-block :background ,bg-yellow-nuanced)) + ("shell" (:inherit org-block :background ,bg-yellow-nuanced)) + ("python" (:inherit org-block :background ,bg-yellow-nuanced)) + ("ipython" (:inherit org-block :background ,bg-yellow-nuanced)) + ("r" (:inherit org-block :background ,bg-yellow-nuanced)) + ("html" (:inherit org-block :background ,bg-green-nuanced)) + ("xml" (:inherit org-block :background ,bg-green-nuanced)) + ("css" (:inherit org-block :background ,bg-red-nuanced)) + ("scss" (:inherit org-block :background ,bg-red-nuanced)) + ("yaml" (:inherit org-block :background ,bg-cyan-nuanced)) + ("conf" (:inherit org-block :background ,bg-cyan-nuanced)) + ("docker" (:inherit org-block :background ,bg-cyan-nuanced)))))) + +(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-org-block-faces) #+end_src -** Measure color contrast +** DIY Measure color contrast :properties: :custom_id: h:02e25930-e71a-493d-828a-8907fc80f874 :end: @@ -3455,7 +3434,7 @@ minutia and relevant commentary. Such knowledge may prove valuable while attempting to customize the theme's color palette. -** Load theme depending on time of day +** DIY Load theme depending on time of day :properties: :custom_id: h:1d1ef4b4-8600-4a09-993c-6de3af0ddd26 :end: @@ -3483,7 +3462,7 @@ the ~circadian~ package: (circadian-setup)) #+end_src -** Backdrop for pdf-tools +** DIY Backdrop for pdf-tools :properties: :custom_id: h:ff69dfe1-29c0-447a-915c-b5ff7c5509cd :end: @@ -3504,7 +3483,7 @@ buffer-local value of the ~default~ face. To remap the buffer's backdrop, we start with a function like this one: #+begin_src emacs-lisp -(defun my-pdf-tools-backdrop () +(defun my-pdf-tools-backdrop (&rest _) (modus-themes-with-colors (face-remap-add-relative 'default @@ -3518,7 +3497,8 @@ The idea is to assign that function to a hook that gets called when when you only use one theme. However it has the downside of setting the background color value only at render time. In other words, the face remapping function does not get evaluated anew whenever the theme -changes, such as upon invoking {{{kbd(M-x modus-themes-toggle)}}}. +changes, such as upon invoking {{{kbd(M-x modus-themes-toggle)}}} +([[#h:4fbfed66-5a89-447a-a07d-a03f6819c5bd][Option for which themes to toggle]]). To have our face remapping adapt gracefully while switching between the Modus themes, we need to also account for the current theme and control @@ -3526,20 +3506,20 @@ the activation of ~pdf-view-midnight-minor-mode~. To which end we arrive at something like the following, which builds on the above example: #+begin_src emacs-lisp -(defun my-pdf-tools-backdrop () +(defun my-pdf-tools-backdrop (&rest _) (modus-themes-with-colors (face-remap-add-relative 'default `(:background ,bg-dim)))) -(defun my-pdf-tools-midnight-mode-toggle () +(defun my-pdf-tools-midnight-mode-toggle (&rest _) (when (derived-mode-p 'pdf-view-mode) (if (eq (car custom-enabled-themes) 'modus-vivendi) (pdf-view-midnight-minor-mode 1) (pdf-view-midnight-minor-mode -1)) (my-pdf-tools-backdrop))) -(defun my-pdf-tools-themes-toggle () +(defun my-pdf-tools-themes-toggle (&rest _) (mapc (lambda (buf) (with-current-buffer buf @@ -3550,11 +3530,15 @@ at something like the following, which builds on the above example: (add-hook 'modus-themes-after-load-theme-hook #'my-pdf-tools-themes-toggle) #+end_src +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + With those in place, PDFs have a distinct backdrop for their page, while buffers with major-mode as ~pdf-view-mode~ automatically switches to dark mode when ~modus-themes-toggle~ is called. -** Toggle themes without reloading them +Reload the theme for changes to take effect. + +** DIY Toggle themes without reloading them :properties: :custom_id: h:b40aca50-a3b2-4c43-be58-2c26fcd14237 :end: @@ -3583,58 +3567,7 @@ manual." Recall that ~modus-themes-toggle~ uses ~load-theme~. -** A theme-agnostic hook for theme loading -:properties: -:custom_id: h:86f6906b-f090-46cc-9816-1fe8aeb38776 -:end: - -The themes are designed with the intent to be useful to Emacs users of -varying skill levels, from beginners to experts. This means that we try -to make things easier by not expecting anyone reading this document to -be proficient in Emacs Lisp or programming in general. - -Such a case is with the use of ~modus-themes-after-load-theme-hook~, -which runs after the ~modus-themes-load-theme~ function (used by the -command ~modus-themes-toggle~). We recommend using that hook for -advanced customizations, because (1) we know for sure that it is -available once the themes are loaded, and (2) anyone consulting this -manual, especially the sections on enabling and loading the themes, -will be in a good position to benefit from that hook. - -Advanced users who have a need to switch between the Modus themes and -other items will find that such a hook does not meet their requirements: -it only works with the Modus themes and only with the aforementioned -functions. - -A theme-agnostic setup can be configured thus: - -#+begin_src emacs-lisp -(defvar after-enable-theme-hook nil - "Normal hook run after enabling a theme.") - -(defun run-after-enable-theme-hook (&rest _args) - "Run `after-enable-theme-hook'." - (run-hooks 'after-enable-theme-hook)) - -(advice-add 'enable-theme :after #'run-after-enable-theme-hook) -#+end_src - -This creates the ~after-enable-theme-hook~ and makes it run after each -call to ~enable-theme~, which means that it will work for all themes and -also has the benefit that it does not depend on functions such as -~modus-themes-toggle~ and the others mentioned above. ~enable-theme~ is -called internally by ~load-theme~, so the hook works everywhere. - -The downside of the theme-agnostic hook is that any functions added to -it will likely not be able to benefit from macro calls that read the -active theme, such as ~modus-themes-with-colors~. Not all Emacs -themes have the same capabilities. - -In this document, we cover ~modus-themes-after-load-theme-hook~ though -the user can replace it with ~after-enable-theme-hook~ should they -need to (provided they understand the implications). - -** Use more spacious margins or padding in Emacs frames +** DIY Use more spacious margins or padding in Emacs frames :PROPERTIES: :CUSTOM_ID: h:43bcb5d0-e25f-470f-828c-662cee9e21f1 :END: @@ -3687,7 +3620,7 @@ The reason we do this with a function is so we can hook it to the faces will no longer be invisible). #+begin_src emacs-lisp -(defun my-modus-themes-invisible-dividers () +(defun my-modus-themes-invisible-dividers (&rest _) "Make window dividers invisible. Add this to the `modus-themes-post-load-hook'." (let ((bg (face-background 'default))) @@ -3700,6 +3633,8 @@ Add this to the `modus-themes-post-load-hook'." (add-hook 'modus-themes-post-load-hook #'my-modus-themes-invisible-dividers) #+end_src +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + The above will work only for themes that belong to the Modus family. For users of Emacs version 29 or higher, there exists a theme-agnostic hook that takes a function with one argument---that of the theme---and @@ -3707,7 +3642,7 @@ calls in the the "post enable" phase of theme loading. Here is the above snippet, with the necessary tweaks: #+begin_src emacs-lisp -(defun my-modus-themes-invisible-dividers (_theme) +(defun my-modus-themes-invisible-dividers (&rest _) "Make window dividers for THEME invisible." (let ((bg (face-background 'default))) (custom-set-faces @@ -3722,7 +3657,7 @@ above snippet, with the necessary tweaks: Users of older versions of Emacs can read the entry herein about defining their own theme-agnostic hook ([[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A theme-agnostic hook for theme loading]]). -** Custom hl-todo colors +** DIY Custom hl-todo colors :PROPERTIES: :CUSTOM_ID: h:2ef83a21-2f0a-441e-9634-473feb940743 :END: @@ -3735,7 +3670,7 @@ may still prefer to apply their custom values, in which case the following approach is necessary: #+begin_src emacs-lisp -(defun my-modus-themes-hl-todo-faces () +(defun my-modus-themes-hl-todo-faces (&rest _) (setq hl-todo-keyword-faces '(("TODO" . "#ff0000") ("HACK" . "#ffff00") ("XXX" . "#00ffff") @@ -3744,10 +3679,12 @@ following approach is necessary: (add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-hl-todo-faces) #+end_src +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + Or include a ~let~ form, if needed: #+begin_src emacs-lisp -(defun my-modus-themes-hl-todo-faces () +(defun my-modus-themes-hl-todo-faces (&rest _) (let ((red "#ff0000") (blue "#0000ff")) (setq hl-todo-keyword-faces `(("TODO" . ,blue) @@ -3758,10 +3695,14 @@ Or include a ~let~ form, if needed: (add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-hl-todo-faces) #+end_src +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + Normally, we do not touch user options, though this is an exception: otherwise the defaults are not always legible. -** Add support for solaire-mode +Reload the theme for changes to take effect. + +** DIY Add support for solaire-mode :PROPERTIES: :CUSTOM_ID: h:439c9e46-52e2-46be-b1dc-85841dd99671 :END: @@ -3806,7 +3747,7 @@ on what we cover at length elsewhere in this manual: [[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. #+begin_src emacs-lisp -(defun my-modus-themes-custom-faces () +(defun my-modus-themes-custom-faces (&rest _) (modus-themes-with-colors (custom-set-faces `(solaire-default-face ((,c :inherit default :background ,bg-dim :foreground ,fg-dim))) @@ -3817,7 +3758,106 @@ on what we cover at length elsewhere in this manual: (add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) #+end_src -As always, re-load the theme for changes to take effect. +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + +Reload the theme for changes to take effect. + +** DIY Use a hook at the post-load-theme phase +:PROPERTIES: +:CUSTOM_ID: h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24 +:END: + +Many of the Do-It-Yourself (DIY) snippets provided herein make use of +a hook to apply the desired changes. In most examples, this hook is +the ~modus-themes-after-load-theme-hook~ (alias ~modus-themes-post-load-hook~). +This hook is provided by the Modus themes and is called at the end of +one the following: + +- Command ~modus-themes-toggle~ :: [[#h:4fbfed66-5a89-447a-a07d-a03f6819c5bd][Option for which themes to toggle]]. + +- Command ~modus-themes-select~ :: Select a Modus theme using minibuffer + completion and then load it. + +- Function ~modus-themes-load-theme~ :: Called only from Lisp, such as + in the user's init file, with the quoted symbol of a Modus theme as + an argument ([[#h:adb0c49a-f1f9-4690-868b-013a080eed68][Option for disabling other themes while loading Modus]]). + This function is used internally by ~modus-themes-toggle~ and + ~modus-themes-select~. + +Users who switch between themes that are not limited to the Modus +collection cannot benefit from the aforementioned hook: it only works +with the Modus themes. A theme-agnostic hook is needed in such a case. +Before Emacs 29, this had to be set up manually ([[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][DIY A theme-agnostic hook for theme loading]]). +Starting with Emacs 29, the special hook ~enable-theme-functions~ +works with anything that uses the basic ~enable-theme~ function. + +To use the ~enable-theme-functions~ just add the given function to it +the way it is done with every hook: + +#+begin_src emacs-lisp +(add-hook 'enable-theme-functions 'MY-FUNCTION-HERE) +#+end_src + +Functions added to ~enable-theme-functions~ accept a single =THEME= +argument. The examples shown in this manual use the pattern =(&rest +_)=, which is how a function accepts one or more arguments but +declares it will not use them (in plain terms, the code works with or +without ~enable-theme-functions~). + +*** DIY A theme-agnostic hook for theme loading +:properties: +:custom_id: h:86f6906b-f090-46cc-9816-1fe8aeb38776 +:end: + +[ NOTE: The following is for versions of Emacs before 29. For Emacs 29 + or higher, users can rely on the built-in ~enable-theme-functions~ + ([[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]). ] + +The themes are designed with the intent to be useful to Emacs users of +varying skill levels, from beginners to experts. This means that we try +to make things easier by not expecting anyone reading this document to +be proficient in Emacs Lisp or programming in general. + +Such a case is with the use of ~modus-themes-after-load-theme-hook~, +which runs after the ~modus-themes-load-theme~ function (used by the +command ~modus-themes-toggle~). We recommend using that hook for +advanced customizations, because (1) we know for sure that it is +available once the themes are loaded, and (2) anyone consulting this +manual, especially the sections on enabling and loading the themes, +will be in a good position to benefit from that hook. + +Advanced users who have a need to switch between the Modus themes and +other items will find that such a hook does not meet their requirements: +it only works with the Modus themes and only with the aforementioned +functions. + +A theme-agnostic setup can be configured thus: + +#+begin_src emacs-lisp +(defvar after-enable-theme-hook nil + "Normal hook run after enabling a theme.") + +(defun run-after-enable-theme-hook (&rest _args) + "Run `after-enable-theme-hook'." + (run-hooks 'after-enable-theme-hook)) + +(advice-add 'enable-theme :after #'run-after-enable-theme-hook) +#+end_src + +This creates the ~after-enable-theme-hook~ and makes it run after each +call to ~enable-theme~, which means that it will work for all themes and +also has the benefit that it does not depend on functions such as +~modus-themes-toggle~ and the others mentioned above. ~enable-theme~ is +called internally by ~load-theme~, so the hook works everywhere. + +The downside of the theme-agnostic hook is that any functions added to +it will likely not be able to benefit from macro calls that read the +active theme, such as ~modus-themes-with-colors~. Not all Emacs +themes have the same capabilities. + +In this document, we cover ~modus-themes-after-load-theme-hook~ though +the user can replace it with ~after-enable-theme-hook~ should they +need to (provided they understand the implications). * Face coverage :properties: @@ -3882,7 +3922,9 @@ have lots of extensions, so the "full support" may not be 100% true… + custom (what you get with {{{kbd(M-x customize)}}}) + dashboard + deadgrep ++ debbugs + deft ++ denote + devdocs + dictionary + diff-hl @@ -3978,6 +4020,7 @@ have lots of extensions, so the "full support" may not be 100% true… + marginalia + markdown-mode + markup-faces (~adoc-mode~) ++ mct + messages + minimap + mode-line @@ -4089,6 +4132,7 @@ have lots of extensions, so the "full support" may not be 100% true… + xterm-color (and ansi-colors) + yaml-mode + yasnippet ++ ztree Plus many other miscellaneous faces that are provided by Emacs. @@ -4213,7 +4257,7 @@ length elsewhere in this manual: [[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. #+begin_src emacs-lisp -(defun my-modus-themes-custom-faces () +(defun my-modus-themes-custom-faces (&rest _) (modus-themes-with-colors (custom-set-faces ;; Make foreground the same as background for a uniform bar on @@ -4229,6 +4273,8 @@ length elsewhere in this manual: (add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) #+end_src +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + As always, re-load the theme for changes to take effect. If the above does not work, try this instead: @@ -4260,7 +4306,7 @@ multiline comments in PHP with the ~php-mode~ package use the This seems to make all comments use the appropriate face: #+begin_src emacs-lisp -(defun my-multine-comments () +(defun my-multine-comments (&rest _) (setq-local c-doc-face-name 'font-lock-comment-face)) (add-hook 'php-mode-hook #'my-multine-comments) @@ -4396,7 +4442,7 @@ advanced customization options of the themes. [[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]. In the following example, we are assuming that the user wants to (i) -reuse color variables provided by the themes, (ii) be able to retain +re-use color variables provided by the themes, (ii) be able to retain their tweaks while switching between ~modus-operandi~ and ~modus-vivendi~, and (iii) have the option to highlight either the foreground of the parentheses or the background as well. @@ -4416,7 +4462,7 @@ Then we can update our preference with this: (setq my-highlight-parentheses-use-background nil) #+end_src -To reuse colors from the themes, we must wrap our code in the +To re-use colors from the themes, we must wrap our code in the ~modus-themes-with-colors~ macro. Our implementation must interface with the variables ~highlight-parentheses-background-colors~ and/or ~highlight-parentheses-colors~. @@ -4472,7 +4518,7 @@ implementation: (setq my-highlight-parentheses-use-background nil) ; Set to nil to disable backgrounds -(defun my-modus-themes-highlight-parentheses () +(defun my-modus-themes-highlight-parentheses (&rest _) (modus-themes-with-colors ;; Our preference for setting either background or foreground ;; styles, depending on `my-highlight-parentheses-use-background'. @@ -4507,6 +4553,8 @@ implementation: (add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-highlight-parentheses) #+end_src +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + As always, re-load the theme for changes to take effect. ** Note on mmm-mode.el background colors @@ -5026,7 +5074,7 @@ more effective than trying to do the same with either red or blue (the latter is the least effective in that regard). When we need to work with several colors, it is always better to have -sufficient maneuvering space, especially since we cannot pick arbitrary +sufficient manoeuvring space, especially since we cannot pick arbitrary colors but only those that satisfy the accessibility objectives of the themes. @@ -5080,7 +5128,7 @@ each of the three channels of light (red, green, blue). For example: : xrandr --output LVDS1 --brightness 1.0 --gamma 0.76:0.75:0.68 Typography is another variable. Some font families are blurry at small -point sizes. Others may have a regular weight that is lighter (thinner) +point sizes. Others may have a regular weight that is lighter (thiner) than that of their peers which may, under certain circumstances, cause a halo effect around each glyph. @@ -5132,7 +5180,7 @@ it is already understood that one must follow the indicator or headline to view its contents and (ii) underlining everything would make the interface virtually unusable. -Again, one must exercise judgment in order to avoid discrimination, +Again, one must exercise judgement in order to avoid discrimination, where "discrimination" refers to: + The treatment of substantially different magnitudes as if they were of @@ -5206,7 +5254,7 @@ the themes, which is partially fleshed out in this manual. With regard to the artistic aspect (where "art" qua skill may amount to an imprecise science), there is no hard-and-fast rule in effect as it -requires one to exercise discretion and make decisions based on +requires one to exercize discretion and make decisions based on context-dependent information or constraints. As is true with most things in life, when in doubt, do not cling on to the letter of the law but try to understand its spirit. @@ -5356,12 +5404,12 @@ The Modus themes are a collective effort. Every bit of work matters. Daniel Mendler, David Edmondson, Eli Zaretskii, Fritz Grabo, Gautier Ponsinet, Illia Ostapyshyn, Kévin Le Gouguec, Koen van Greevenbroek, Kostadin Ninev, Madhavan Krishnan, Manuel Giraud, Markus Beppler, - Matthew Stevenson, Mauro Aranda, Nacho Barrientos, Nicolas De - Jaeghere, Paul David, Philip Kaludercic, Pierre Téchoueyres, Rudolf - Adamkovič, Sergey Nichiporchik, Shreyas Ragavan, Stefan Kangas, - Stephen Berman, Stephen Gildea, Steve Downey, Tomasz Hołubowicz, - Utkarsh Singh, Vincent Murphy, Xinglu Chen, Yuanchen Xie, fluentpwn, - okamsn. + Matthew Stevenson, Mauro Aranda, Nacho Barrientos, Niall Dooley, + Nicolas De Jaeghere, Paul David, Philip Kaludercic, Pierre + Téchoueyres, Rudolf Adamkovič, Sergey Nichiporchik, Shreyas Ragavan, + Stefan Kangas, Stephen Berman, Stephen Gildea, Steve Downey, Tomasz + Hołubowicz, Utkarsh Singh, Vincent Murphy, Xinglu Chen, Yuanchen + Xie, fluentpwn, okamsn. + Ideas and user feedback :: Aaron Jensen, Adam Porter, Adam Spiers, Adrian Manea, Aleksei Pirogov, Alex Griffin, Alex Koen, Alex @@ -5376,13 +5424,13 @@ The Modus themes are a collective effort. Every bit of work matters. Gonçalo Marrafa, Guilherme Semente, Gustavo Barros, Hörmetjan Yiltiz, Ilja Kocken, Imran Khan, Iris Garcia, Ivan Popovych, James Ferguson, Jeremy Friesen, Jerry Zhang, Johannes Grødem, John Haman, - Jonas Collberg, Jorge Morais, Joshua O'Connor, Julio C. Villasante, - Kenta Usami, Kevin Fleming, Kévin Le Gouguec, Kevin Kainan Li, - Kostadin Ninev, Laith Bahodi, Lasse Lindner, Len Trigg, Lennart - C. Karssen, Luis Miguel Castañeda, Magne Hov, Manuel Giraud, Manuel - Uberti, Mark Bestley, Mark Burton, Mark Simpson, Marko Kocic, Markus - Beppler, Matt Armstrong, Matthias Fuchs, Mattias Engdegård, Mauro - Aranda, Maxime Tréca, Michael Goldenberg, Morgan Smith, Morgan + John Wick, Jonas Collberg, Jorge Morais, Joshua O'Connor, Julio C. + Villasante, Kenta Usami, Kevin Fleming, Kévin Le Gouguec, Kevin + Kainan Li, Kostadin Ninev, Laith Bahodi, Lasse Lindner, Len Trigg, + Lennart C.{{{space()}}} Karssen, Luis Miguel Castañeda, Magne Hov, Manuel Giraud, + Manuel Uberti, Mark Bestley, Mark Burton, Mark Simpson, Marko Kocic, + Markus Beppler, Matt Armstrong, Matthias Fuchs, Mattias Engdegård, + Mauro Aranda, Maxime Tréca, Michael Goldenberg, Morgan Smith, Morgan Willcock, Murilo Pereira, Nicky van Foreest, Nicolas De Jaeghere, Nicolas Semrau, Olaf Meeuwissen, Oliver Epper, Pablo Stafforini, Paul Poloskov, Pengji Zhang, Pete Kazmier, Peter Wu, Philip @@ -5392,11 +5440,12 @@ The Modus themes are a collective effort. Every bit of work matters. Ragavan, Simon Pugnet, Steve Downey, Tassilo Horn, Thanos Apollo, Thibaut Verron, Thomas Heartman, Togan Muftuoglu, Tony Zorman, Trey Merkley, Tomasz Hołubowicz, Toon Claes, Uri Sharf, Utkarsh Singh, - Vincent Foley, Zoltan Kiraly. As well as users: Ben, CsBigDataHub1, + Vincent Foley, Zoltan Kiraly. As well as users: Ben, CsBigDataHub1, Emacs Contrib, Eugene, Fourchaux, Fredrik, Moesasji, Nick, Summer Emacs, TheBlob42, TitusMu, Trey, bepolymathe, bit9tream, bangedorrunt, derek-upham, doolio, fleimgruber, gitrj95, iSeeU, - jixiuf, okamsn, pRot0ta1p, soaringbird, tumashu, wakamenod. + jixiuf, ltmsyvag, okamsn, pRot0ta1p, soaringbird, tumashu, + wakamenod. + Packaging :: Basil L.{{{space()}}} Contovounesios, Eli Zaretskii, Glenn Morris, Mauro Aranda, Richard Stallman, Stefan Kangas (core diff --git a/etc/themes/modus-operandi-deuteranopia-theme.el b/etc/themes/modus-operandi-deuteranopia-theme.el index 4d210b977eb..42479965300 100644 --- a/etc/themes/modus-operandi-deuteranopia-theme.el +++ b/etc/themes/modus-operandi-deuteranopia-theme.el @@ -1,11 +1,10 @@ ;;; modus-operandi-deuteranopia-theme.el --- Deuteranopia-optimized theme with a white background -*- lexical-binding:t -*- -;; Copyright (C) 2019-2024 Free Software Foundation, Inc. +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> -;; URL: https://git.sr.ht/~protesilaos/modus-themes -;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes +;; Maintainer: Protesilaos Stavrou +;; URL: https://github.com/protesilaos/modus-themes ;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. @@ -128,12 +127,12 @@ standard)." (bg-magenta-subtle "#ffddff") (bg-cyan-subtle "#bfefff") - (bg-red-nuanced "#fff1f0") - (bg-green-nuanced "#ecf7ed") - (bg-yellow-nuanced "#fff3da") - (bg-blue-nuanced "#f3f3ff") - (bg-magenta-nuanced "#fdf0ff") - (bg-cyan-nuanced "#ebf6fa") + (bg-red-nuanced "#ffe8e8") + (bg-green-nuanced "#e0f6e0") + (bg-yellow-nuanced "#f8f0d0") + (bg-blue-nuanced "#ecedff") + (bg-magenta-nuanced "#f8e6f5") + (bg-cyan-nuanced "#e0f2fa") ;;; Uncommon accent backgrounds @@ -212,6 +211,7 @@ standard)." ;;; Paren match (bg-paren-match "#5fcfff") + (fg-paren-match fg-main) (bg-paren-expression "#efd3f5") (underline-paren-match unspecified) @@ -241,6 +241,11 @@ standard)." (bg-prominent-note bg-cyan-intense) (fg-prominent-note fg-main) + (bg-active-argument bg-yellow-nuanced) + (fg-active-argument yellow-warmer) + (bg-active-value bg-blue-nuanced) + (fg-active-value blue-warmer) + ;;;; Code mappings (builtin magenta-warmer) @@ -289,7 +294,7 @@ standard)." (date-event fg-alt) (date-holiday yellow-warmer) (date-holiday-other blue) - (date-now blue-faint) + (date-now fg-main) (date-range fg-alt) (date-scheduled yellow-cooler) (date-weekday cyan) @@ -343,16 +348,29 @@ standard)." ;;;; Prose mappings - (prose-block fg-dim) - (prose-code cyan-cooler) + (bg-prose-block-delimiter bg-dim) + (fg-prose-block-delimiter fg-dim) + (bg-prose-block-contents bg-dim) + + (bg-prose-code unspecified) + (fg-prose-code cyan-cooler) + + (bg-prose-macro unspecified) + (fg-prose-macro magenta-cooler) + + (bg-prose-verbatim unspecified) + (fg-prose-verbatim magenta-warmer) + (prose-done blue) - (prose-macro magenta-cooler) + (prose-todo yellow-warmer) + (prose-metadata fg-dim) (prose-metadata-value fg-alt) + (prose-table fg-alt) + (prose-table-formula yellow-warmer) + (prose-tag magenta-faint) - (prose-todo yellow-warmer) - (prose-verbatim magenta-warmer) ;;;; Rainbow mappings @@ -366,6 +384,17 @@ standard)." (rainbow-7 yellow-faint) (rainbow-8 cyan) +;;;; Search mappings + + (bg-search-current bg-yellow-intense) + (bg-search-lazy bg-blue-intense) + (bg-search-replace bg-magenta-intense) + + (bg-search-rx-group-0 bg-cyan-intense) + (bg-search-rx-group-1 bg-magenta-intense) + (bg-search-rx-group-2 bg-blue-subtle) + (bg-search-rx-group-3 bg-yellow-subtle) + ;;;; Space mappings (bg-space unspecified) @@ -374,10 +403,10 @@ standard)." ;;;; Terminal mappings - (bg-term-black "black") - (fg-term-black "black") - (bg-term-black-bright "gray35") - (fg-term-black-bright "gray35") + (bg-term-black "#000000") + (fg-term-black "#000000") + (bg-term-black-bright "#595959") + (fg-term-black-bright "#595959") (bg-term-red red) (fg-term-red red) @@ -409,10 +438,10 @@ standard)." (bg-term-cyan-bright cyan-cooler) (fg-term-cyan-bright cyan-cooler) - (bg-term-white "gray65") - (fg-term-white "gray65") - (bg-term-white-bright "white") - (fg-term-white-bright "white") + (bg-term-white "#a6a6a6") + (fg-term-white "#a6a6a6") + (bg-term-white-bright "#ffffff") + (fg-term-white-bright "#ffffff") ;;;; Heading mappings diff --git a/etc/themes/modus-operandi-theme.el b/etc/themes/modus-operandi-theme.el index b41d5491c2e..fb2ff99a74b 100644 --- a/etc/themes/modus-operandi-theme.el +++ b/etc/themes/modus-operandi-theme.el @@ -1,11 +1,10 @@ ;;; modus-operandi-theme.el --- Elegant, highly legible theme with a white background -*- lexical-binding:t -*- -;; Copyright (C) 2019-2024 Free Software Foundation, Inc. +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> -;; URL: https://git.sr.ht/~protesilaos/modus-themes -;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes +;; Maintainer: Protesilaos Stavrou +;; URL: https://github.com/protesilaos/modus-themes ;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. @@ -126,12 +125,12 @@ which corresponds to a minimum contrast in relative luminance of (bg-magenta-subtle "#ffddff") (bg-cyan-subtle "#bfefff") - (bg-red-nuanced "#fff1f0") - (bg-green-nuanced "#ecf7ed") - (bg-yellow-nuanced "#fff3da") - (bg-blue-nuanced "#f3f3ff") - (bg-magenta-nuanced "#fdf0ff") - (bg-cyan-nuanced "#ebf6fa") + (bg-red-nuanced "#ffe8e8") + (bg-green-nuanced "#e0f6e0") + (bg-yellow-nuanced "#f8f0d0") + (bg-blue-nuanced "#ecedff") + (bg-magenta-nuanced "#f8e6f5") + (bg-cyan-nuanced "#e0f2fa") ;;; Uncommon accent backgrounds @@ -210,6 +209,7 @@ which corresponds to a minimum contrast in relative luminance of ;;; Paren match (bg-paren-match "#5fcfff") + (fg-paren-match fg-main) (bg-paren-expression "#efd3f5") (underline-paren-match unspecified) @@ -239,6 +239,11 @@ which corresponds to a minimum contrast in relative luminance of (bg-prominent-note bg-cyan-intense) (fg-prominent-note fg-main) + (bg-active-argument bg-yellow-nuanced) + (fg-active-argument yellow-warmer) + (bg-active-value bg-cyan-nuanced) + (fg-active-value cyan-warmer) + ;;;; Code mappings (builtin magenta-warmer) @@ -341,16 +346,29 @@ which corresponds to a minimum contrast in relative luminance of ;;;; Prose mappings - (prose-block fg-dim) - (prose-code green-cooler) + (bg-prose-block-delimiter bg-dim) + (fg-prose-block-delimiter fg-dim) + (bg-prose-block-contents bg-dim) + + (bg-prose-code unspecified) + (fg-prose-code cyan-cooler) + + (bg-prose-macro unspecified) + (fg-prose-macro magenta-cooler) + + (bg-prose-verbatim unspecified) + (fg-prose-verbatim magenta-warmer) + (prose-done green) - (prose-macro magenta-cooler) + (prose-todo red) + (prose-metadata fg-dim) (prose-metadata-value fg-alt) + (prose-table fg-alt) + (prose-table-formula magenta-warmer) + (prose-tag magenta-faint) - (prose-todo red) - (prose-verbatim magenta-warmer) ;;;; Rainbow mappings @@ -364,6 +382,17 @@ which corresponds to a minimum contrast in relative luminance of (rainbow-7 blue-warmer) (rainbow-8 magenta-warmer) +;;;; Search mappings + + (bg-search-current bg-yellow-intense) + (bg-search-lazy bg-cyan-intense) + (bg-search-replace bg-red-intense) + + (bg-search-rx-group-0 bg-blue-intense) + (bg-search-rx-group-1 bg-green-intense) + (bg-search-rx-group-2 bg-red-subtle) + (bg-search-rx-group-3 bg-magenta-subtle) + ;;;; Space mappings (bg-space unspecified) @@ -372,10 +401,10 @@ which corresponds to a minimum contrast in relative luminance of ;;;; Terminal mappings - (bg-term-black "black") - (fg-term-black "black") - (bg-term-black-bright "gray35") - (fg-term-black-bright "gray35") + (bg-term-black "#000000") + (fg-term-black "#000000") + (bg-term-black-bright "#595959") + (fg-term-black-bright "#595959") (bg-term-red red) (fg-term-red red) @@ -407,10 +436,10 @@ which corresponds to a minimum contrast in relative luminance of (bg-term-cyan-bright cyan-cooler) (fg-term-cyan-bright cyan-cooler) - (bg-term-white "gray65") - (fg-term-white "gray65") - (bg-term-white-bright "white") - (fg-term-white-bright "white") + (bg-term-white "#a6a6a6") + (fg-term-white "#a6a6a6") + (bg-term-white-bright "#ffffff") + (fg-term-white-bright "#ffffff") ;;;; Heading mappings diff --git a/etc/themes/modus-operandi-tinted-theme.el b/etc/themes/modus-operandi-tinted-theme.el index 7e0ad3d7ea8..f112456034b 100644 --- a/etc/themes/modus-operandi-tinted-theme.el +++ b/etc/themes/modus-operandi-tinted-theme.el @@ -1,11 +1,11 @@ -;;; modus-operandi-tinted-theme.el --- Elegant, highly legible theme with a light ocher background -*- lexical-binding:t -*- +;;; modus-operandi-tinted-theme.el --- Elegant, highly legible theme with a light ochre background -*- lexical-binding:t -*- -;; Copyright (C) 2019-2024 Free Software Foundation, Inc. +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> -;; URL: https://git.sr.ht/~protesilaos/modus-themes -;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes +;; Maintainer: Protesilaos Stavrou +;; URL: https://github.com/protesilaos/modus-themes +;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. @@ -44,7 +44,7 @@ ;;;###theme-autoload (deftheme modus-operandi-tinted - "Elegant, highly legible theme with a light ocher background. + "Elegant, highly legible theme with a light ochre background. Conforms with the highest legibility standard for color contrast between background and foreground in any given piece of text, which corresponds to a minimum contrast in relative luminance of @@ -125,12 +125,12 @@ which corresponds to a minimum contrast in relative luminance of (bg-magenta-subtle "#ffddff") (bg-cyan-subtle "#bfefff") - (bg-red-nuanced "#ffe8f0") - (bg-green-nuanced "#e0f5e0") - (bg-yellow-nuanced "#f9ead0") - (bg-blue-nuanced "#ebebff") - (bg-magenta-nuanced "#f6e7ff") - (bg-cyan-nuanced "#e1f3fc") + (bg-red-nuanced "#ffe8e8") + (bg-green-nuanced "#e0f6e0") + (bg-yellow-nuanced "#f8f0d0") + (bg-blue-nuanced "#ecedff") + (bg-magenta-nuanced "#f8e6f5") + (bg-cyan-nuanced "#e0f2fa") ;;; Uncommon accent backgrounds @@ -209,6 +209,7 @@ which corresponds to a minimum contrast in relative luminance of ;;; Paren match (bg-paren-match "#7fdfcf") + (fg-paren-match fg-main) (bg-paren-expression "#efd3f5") (underline-paren-match unspecified) @@ -217,9 +218,9 @@ which corresponds to a minimum contrast in relative luminance of ;;;; General mappings (fringe bg-dim) - (cursor red) + (cursor red-intense) - (keybind blue-cooler) + (keybind red) (name magenta) (identifier yellow-cooler) @@ -238,6 +239,11 @@ which corresponds to a minimum contrast in relative luminance of (bg-prominent-note bg-cyan-intense) (fg-prominent-note fg-main) + (bg-active-argument bg-yellow-nuanced) + (fg-active-argument yellow-warmer) + (bg-active-value bg-cyan-nuanced) + (fg-active-value cyan-warmer) + ;;;; Code mappings (builtin magenta-warmer) @@ -340,16 +346,29 @@ which corresponds to a minimum contrast in relative luminance of ;;;; Prose mappings - (prose-block fg-dim) - (prose-code green-cooler) + (bg-prose-block-delimiter bg-dim) + (fg-prose-block-delimiter fg-dim) + (bg-prose-block-contents bg-dim) + + (bg-prose-code unspecified) + (fg-prose-code cyan-cooler) + + (bg-prose-macro unspecified) + (fg-prose-macro magenta-cooler) + + (bg-prose-verbatim unspecified) + (fg-prose-verbatim magenta-warmer) + (prose-done green) - (prose-macro magenta-cooler) + (prose-todo red) + (prose-metadata fg-dim) (prose-metadata-value fg-alt) + (prose-table fg-alt) + (prose-table-formula magenta-warmer) + (prose-tag magenta-faint) - (prose-todo red) - (prose-verbatim magenta-warmer) ;;;; Rainbow mappings @@ -363,6 +382,17 @@ which corresponds to a minimum contrast in relative luminance of (rainbow-7 blue-warmer) (rainbow-8 magenta-warmer) +;;;; Search mappings + + (bg-search-current bg-yellow-intense) + (bg-search-lazy bg-cyan-intense) + (bg-search-replace bg-red-intense) + + (bg-search-rx-group-0 bg-blue-intense) + (bg-search-rx-group-1 bg-green-intense) + (bg-search-rx-group-2 bg-red-subtle) + (bg-search-rx-group-3 bg-magenta-subtle) + ;;;; Space mappings (bg-space unspecified) @@ -371,10 +401,10 @@ which corresponds to a minimum contrast in relative luminance of ;;;; Terminal mappings - (bg-term-black "black") - (fg-term-black "black") - (bg-term-black-bright "gray35") - (fg-term-black-bright "gray35") + (bg-term-black "#000000") + (fg-term-black "#000000") + (bg-term-black-bright "#595959") + (fg-term-black-bright "#595959") (bg-term-red red) (fg-term-red red) @@ -406,10 +436,10 @@ which corresponds to a minimum contrast in relative luminance of (bg-term-cyan-bright cyan-cooler) (fg-term-cyan-bright cyan-cooler) - (bg-term-white "gray65") - (fg-term-white "gray65") - (bg-term-white-bright "white") - (fg-term-white-bright "white") + (bg-term-white "#a6a6a6") + (fg-term-white "#a6a6a6") + (bg-term-white-bright "#ffffff") + (fg-term-white-bright "#ffffff") ;;;; Heading mappings diff --git a/etc/themes/modus-operandi-tritanopia-theme.el b/etc/themes/modus-operandi-tritanopia-theme.el index 968a6526ca3..56be8329784 100644 --- a/etc/themes/modus-operandi-tritanopia-theme.el +++ b/etc/themes/modus-operandi-tritanopia-theme.el @@ -1,11 +1,10 @@ ;;; modus-operandi-tritanopia-theme.el --- Tritanopia-optimized theme with a white background -*- lexical-binding:t -*- -;; Copyright (C) 2019-2024 Free Software Foundation, Inc. +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> -;; URL: https://git.sr.ht/~protesilaos/modus-themes -;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes +;; Maintainer: Protesilaos Stavrou +;; URL: https://github.com/protesilaos/modus-themes ;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. @@ -128,12 +127,12 @@ standard)." (bg-magenta-subtle "#ffddff") (bg-cyan-subtle "#bfefff") - (bg-red-nuanced "#fff1f0") - (bg-green-nuanced "#ecf7ed") - (bg-yellow-nuanced "#fff3da") - (bg-blue-nuanced "#f3f3ff") - (bg-magenta-nuanced "#fdf0ff") - (bg-cyan-nuanced "#ebf6fa") + (bg-red-nuanced "#ffe8e8") + (bg-green-nuanced "#e0f6e0") + (bg-yellow-nuanced "#f8f0d0") + (bg-blue-nuanced "#ecedff") + (bg-magenta-nuanced "#f8e6f5") + (bg-cyan-nuanced "#e0f2fa") ;;; Uncommon accent backgrounds @@ -212,6 +211,7 @@ standard)." ;;; Paren match (bg-paren-match "#5fcfff") + (fg-paren-match fg-main) (bg-paren-expression "#efd3f5") (underline-paren-match unspecified) @@ -241,6 +241,11 @@ standard)." (bg-prominent-note bg-cyan-intense) (fg-prominent-note fg-main) + (bg-active-argument bg-red-nuanced) + (fg-active-argument red-warmer) + (bg-active-value bg-cyan-nuanced) + (fg-active-value cyan) + ;;;; Code mappings (builtin magenta) @@ -343,16 +348,29 @@ standard)." ;;;; Prose mappings - (prose-block fg-dim) - (prose-code cyan) + (bg-prose-block-delimiter bg-dim) + (fg-prose-block-delimiter fg-dim) + (bg-prose-block-contents bg-dim) + + (bg-prose-code unspecified) + (fg-prose-code cyan) + + (bg-prose-macro unspecified) + (fg-prose-macro red-warmer) + + (bg-prose-verbatim unspecified) + (fg-prose-verbatim magenta-warmer) + (prose-done cyan) - (prose-macro red-warmer) + (prose-todo red) + (prose-metadata fg-dim) (prose-metadata-value fg-alt) + (prose-table fg-alt) - (prose-tag fg-alt) - (prose-todo red) - (prose-verbatim magenta-warmer) + (prose-table-formula red-cooler) + + (prose-tag magenta-faint) ;;;; Rainbow mappings @@ -366,6 +384,17 @@ standard)." (rainbow-7 magenta-faint) (rainbow-8 red-faint) +;;;; Search mappings + + (bg-search-current bg-red-intense) + (bg-search-lazy bg-cyan-intense) + (bg-search-replace bg-magenta-intense) + + (bg-search-rx-group-0 bg-blue-intense) + (bg-search-rx-group-1 bg-magenta-intense) + (bg-search-rx-group-2 bg-cyan-subtle) + (bg-search-rx-group-3 bg-red-subtle) + ;;;; Space mappings (bg-space unspecified) @@ -374,10 +403,10 @@ standard)." ;;;; Terminal mappings - (bg-term-black "black") - (fg-term-black "black") - (bg-term-black-bright "gray35") - (fg-term-black-bright "gray35") + (bg-term-black "#000000") + (fg-term-black "#000000") + (bg-term-black-bright "#595959") + (fg-term-black-bright "#595959") (bg-term-red red) (fg-term-red red) @@ -409,10 +438,10 @@ standard)." (bg-term-cyan-bright cyan-cooler) (fg-term-cyan-bright cyan-cooler) - (bg-term-white "gray65") - (fg-term-white "gray65") - (bg-term-white-bright "white") - (fg-term-white-bright "white") + (bg-term-white "#a6a6a6") + (fg-term-white "#a6a6a6") + (bg-term-white-bright "#ffffff") + (fg-term-white-bright "#ffffff") ;;;; Heading mappings diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el index 44f25182a30..b776f12671e 100644 --- a/etc/themes/modus-themes.el +++ b/etc/themes/modus-themes.el @@ -1,12 +1,11 @@ ;;; modus-themes.el --- Elegant, highly legible and customizable themes -*- lexical-binding:t -*- -;; Copyright (C) 2019-2024 Free Software Foundation, Inc. +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> -;; URL: https://git.sr.ht/~protesilaos/modus-themes -;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes -;; Version: 4.3.0 +;; Maintainer: Protesilaos Stavrou +;; URL: https://github.com/protesilaos/modus-themes +;; Version: 4.4.0 ;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility @@ -37,9 +36,7 @@ -(eval-when-compile - (require 'cl-lib) - (require 'subr-x)) +(eval-when-compile (require 'subr-x)) (defgroup modus-themes () "User options for the Modus themes. @@ -66,11 +63,6 @@ deficiency (deuteranopia or tritanopia, respectively)." :prefix "modus-themes-" :tag "Modus Themes Faces") -(make-obsolete-variable 'modus-themes-operandi-colors nil "4.0.0") -(make-obsolete-variable 'modus-themes-vivendi-colors nil "4.0.0") -(make-obsolete-variable 'modus-themes-version nil "4.0.0") -(make-obsolete 'modus-themes-report-bug nil "4.0.0") - ;;;; Custom faces @@ -139,7 +131,7 @@ deficiency (deuteranopia or tritanopia, respectively)." :version "30.1" :group 'modus-themes-faces)) -(dolist (scope '(current lazy)) +(dolist (scope '(current lazy replace)) (custom-declare-face (intern (format "modus-themes-search-%s" scope)) nil (format "Search of type %s." scope) @@ -147,15 +139,13 @@ deficiency (deuteranopia or tritanopia, respectively)." :version "30.1" :group 'modus-themes-faces)) -(define-obsolete-variable-alias - 'modus-themes-search-success - 'modus-themes-search-current - "4.0.0") - -(define-obsolete-variable-alias - 'modus-themes-search-success-lazy - 'modus-themes-search-lazy - "4.0.0") +(dotimes (n 4) + (custom-declare-face + (intern (format "modus-themes-search-rx-group-%s" n)) + nil (format "Search regexp group number %s." n) + :package-version '(modus-themes . "4.4.0") + :version "30.1" + :group 'modus-themes-faces)) (dolist (scope '(code macro verbatim)) (custom-declare-face @@ -165,21 +155,6 @@ deficiency (deuteranopia or tritanopia, respectively)." :version "30.1" :group 'modus-themes-faces)) -(define-obsolete-variable-alias - 'modus-themes-markup-code - 'modus-themes-prose-code - "4.0.0") - -(define-obsolete-variable-alias - 'modus-themes-markup-macro - 'modus-themes-prose-macro - "4.0.0") - -(define-obsolete-variable-alias - 'modus-themes-markup-verbatim - 'modus-themes-prose-verbatim - "4.0.0") - (dotimes (n 9) (custom-declare-face (intern (format "modus-themes-heading-%d" n)) @@ -248,67 +223,6 @@ text should not be underlined as well) yet still blend in." :version "30.1" :group 'modus-themes-faces)) -(make-obsolete-variable 'modus-themes-reset-hard nil "4.0.0") -(make-obsolete-variable 'modus-themes-subtle-neutral nil "4.0.0") -(make-obsolete-variable 'modus-themes-intense-neutral nil "4.0.0") -(make-obsolete-variable 'modus-themes-refine-red nil "4.0.0") -(make-obsolete-variable 'modus-themes-refine-green nil "4.0.0") -(make-obsolete-variable 'modus-themes-refine-yellow nil "4.0.0") -(make-obsolete-variable 'modus-themes-refine-blue nil "4.0.0") -(make-obsolete-variable 'modus-themes-refine-magenta nil "4.0.0") -(make-obsolete-variable 'modus-themes-refine-cyan nil "4.0.0") -(make-obsolete-variable 'modus-themes-active-red nil "4.0.0") -(make-obsolete-variable 'modus-themes-active-green nil "4.0.0") -(make-obsolete-variable 'modus-themes-active-yellow nil "4.0.0") -(make-obsolete-variable 'modus-themes-active-blue nil "4.0.0") -(make-obsolete-variable 'modus-themes-active-magenta nil "4.0.0") -(make-obsolete-variable 'modus-themes-active-cyan nil "4.0.0") -(make-obsolete-variable 'modus-themes-fringe-red nil "4.0.0") -(make-obsolete-variable 'modus-themes-fringe-green nil "4.0.0") -(make-obsolete-variable 'modus-themes-fringe-yellow nil "4.0.0") -(make-obsolete-variable 'modus-themes-fringe-blue nil "4.0.0") -(make-obsolete-variable 'modus-themes-fringe-magenta nil "4.0.0") -(make-obsolete-variable 'modus-themes-fringe-cyan nil "4.0.0") -(make-obsolete-variable 'modus-themes-grue nil "4.0.0") -(make-obsolete-variable 'modus-themes-grue-nuanced nil "4.0.0") -(make-obsolete-variable 'modus-themes-red-nuanced nil "4.0.0") -(make-obsolete-variable 'modus-themes-green-nuanced nil "4.0.0") -(make-obsolete-variable 'modus-themes-yellow-nuanced nil "4.0.0") -(make-obsolete-variable 'modus-themes-blue-nuanced nil "4.0.0") -(make-obsolete-variable 'modus-themes-magenta-nuanced nil "4.0.0") -(make-obsolete-variable 'modus-themes-cyan-nuanced nil "4.0.0") -(make-obsolete-variable 'modus-themes-special-calm nil "4.0.0") -(make-obsolete-variable 'modus-themes-special-cold nil "4.0.0") -(make-obsolete-variable 'modus-themes-special-mild nil "4.0.0") -(make-obsolete-variable 'modus-themes-special-warm nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-added nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-changed nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-removed nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-refine-added nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-refine-changed nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-refine-removed nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-focus-added nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-focus-changed nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-focus-removed nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-heading nil "4.0.0") -(make-obsolete-variable 'modus-themes-pseudo-header nil "4.0.0") -(make-obsolete-variable 'modus-themes-mark-symbol nil "4.0.0") -(make-obsolete-variable 'modus-themes-hl-line nil "4.0.0") -(make-obsolete-variable 'modus-themes-search-success-modeline nil "4.0.0") -(make-obsolete-variable 'modus-themes-grue-active nil "4.0.0") -(make-obsolete-variable 'modus-themes-grue-background-active nil "4.0.0") -(make-obsolete-variable 'modus-themes-grue-background-intense nil "4.0.0") -(make-obsolete-variable 'modus-themes-grue-background-subtle nil "4.0.0") -(make-obsolete-variable 'modus-themes-grue-background-refine nil "4.0.0") -(make-obsolete-variable 'modus-themes-link-broken nil "4.0.0") -(make-obsolete-variable 'modus-themes-link-symlink nil "4.0.0") -(make-obsolete-variable 'modus-themes-tab-backdrop nil "4.0.0") -(make-obsolete-variable 'modus-themes-tab-active nil "4.0.0") -(make-obsolete-variable 'modus-themes-tab-inactive nil "4.0.0") -(make-obsolete-variable 'modus-themes-completion-selected-popup nil "4.0.0") -(make-obsolete-variable 'modus-themes-box-button nil "4.0.0") -(make-obsolete-variable 'modus-themes-box-button-pressed nil "4.0.0") - ;;;; Customization variables @@ -331,8 +245,6 @@ consequences. The user must manually reload the theme." :type 'boolean :link '(info-link "(modus-themes) Custom reload theme")) -(make-obsolete-variable 'modus-themes-inhibit-reload 'modus-themes-custom-auto-reload "4.0.0") - (defun modus-themes--set-option (sym val) "Custom setter for theme related user options. Will set SYM to VAL, and reload the current theme, unless @@ -422,9 +334,6 @@ This is used by the command `modus-themes-toggle'." :initialize #'custom-initialize-default :group 'modus-themes) -(make-obsolete-variable 'modus-themes-operandi-color-overrides nil "4.0.0") -(make-obsolete-variable 'modus-themes-vivendi-color-overrides nil "4.0.0") - (defvaralias 'modus-themes-slanted-constructs 'modus-themes-italic-constructs) (defcustom modus-themes-italic-constructs nil @@ -477,8 +386,6 @@ Protesilaos))." :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Mixed fonts")) -(make-obsolete-variable 'modus-themes-intense-mouseovers nil "4.0.0") - (defconst modus-themes--weight-widget '(choice :tag "Font weight (must be supported by the typeface)" (const :tag "Unspecified (use whatever the default is)" nil) @@ -611,51 +518,7 @@ and related user options." :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Heading styles")) -(make-obsolete-variable 'modus-themes-org-agenda nil "4.0.0") -(make-obsolete-variable 'modus-themes-fringes nil "4.0.0") -(make-obsolete-variable 'modus-themes-lang-checkers nil "4.0.0") - -(defcustom modus-themes-org-blocks nil - "Set the overall style of Org code blocks, quotes, and the like. - -Nil (the default) means that the block has no background of its -own: it uses the one that applies to the rest of the buffer. In -this case, the delimiter lines have a gray color for their text, -making them look exactly like all other Org properties. - -Option `gray-background' applies a subtle gray background to the -block's contents. It also affects the begin and end lines of the -block as they get another shade of gray as their background, -which differentiates them from the contents of the block. All -background colors extend to the edge of the window, giving the -area a rectangular, \"blocky\" presentation. If the begin/end -lines do not extend in this way, check the value of the Org user -option `org-fontify-whole-block-delimiter-line'. - -Option `tinted-background' uses a colored background for the -contents of the block. The exact color value will depend on the -programming language and is controlled by the variable -`org-src-block-faces' (refer to the theme's source code for the -current association list). For this to take effect, the Org -buffer needs to be restarted with `org-mode-restart'. - -Code blocks use their major mode's fontification (syntax -highlighting) only when the variable `org-src-fontify-natively' -is non-nil. While quote/verse blocks require setting -`org-fontify-quote-and-verse-blocks' to a non-nil value." - :group 'modus-themes - :package-version '(modus-themes . "4.0.0") - :version "30.1" - :type '(choice - (const :format "[%v] %t\n" :tag "No Org block background (default)" nil) - (const :format "[%v] %t\n" :tag "Subtle gray block background" gray-background) - (const :format "[%v] %t\n" :tag "Color-coded background per programming language" tinted-background)) - :set #'modus-themes--set-option - :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Org mode blocks")) - -(make-obsolete-variable 'modus-themes-mode-line nil "4.0.0") -(make-obsolete-variable 'modus-themes-diffs nil "4.0.0") +(make-obsolete-variable 'modus-themes-org-blocks nil "4.4.0: Use palette overrides") (defcustom modus-themes-completions nil "Control the style of completion user interfaces. @@ -778,17 +641,6 @@ In user configuration files the form may look like this: :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Command prompts")) -(make-obsolete-variable 'modus-themes-subtle-line-numbers nil "4.0.0") -(make-obsolete-variable 'modus-themes-markup nil "4.0.0") -(make-obsolete-variable 'modus-themes-paren-match nil "4.0.0") -(make-obsolete-variable 'modus-themes-syntax nil "4.0.0") -(make-obsolete-variable 'modus-themes-links nil "4.0.0") -(make-obsolete-variable 'modus-themes-region nil "4.0.0") -(make-obsolete-variable 'modus-themes-deuteranopia nil "4.0.0") -(make-obsolete-variable 'modus-themes-mail-citations nil "4.0.0") -(make-obsolete-variable 'modus-themes-tabs-accented nil "4.0.0") -(make-obsolete-variable 'modus-themes-box-buttons nil "4.0.0") - (defcustom modus-themes-common-palette-overrides nil "Set palette overrides for all the Modus themes. @@ -918,12 +770,13 @@ represents." (fg-prompt cyan-faint) - (prose-code olive) + (fg-prose-code olive) + (fg-prose-macro indigo) + (fg-prose-verbatim maroon) + (prose-done green-faint) - (prose-macro indigo) (prose-tag rust) (prose-todo red-faint) - (prose-verbatim maroon) (rainbow-0 fg-main) (rainbow-1 magenta) @@ -983,17 +836,18 @@ Info node `(modus-themes) Option for palette overrides'.") (keybind blue-intense) (mail-cite-0 blue) - (mail-cite-1 yellow) - (mail-cite-2 green) + (mail-cite-1 yellow-cooler) + (mail-cite-2 green-warmer) (mail-cite-3 magenta) - (mail-part magenta-cooler) - (mail-recipient cyan) + (mail-part cyan) + (mail-recipient magenta-cooler) (mail-subject red-warmer) (mail-other cyan-cooler) (fg-prompt blue-intense) - (prose-block red-faint) + (bg-prose-block-delimiter bg-dim) + (fg-prose-block-delimiter red-faint) (prose-done green-intense) (prose-metadata magenta-faint) (prose-metadata-value blue-cooler) @@ -1081,7 +935,7 @@ Info node `(modus-themes) Option for palette overrides'.") (mail-other blue) (prose-tag fg-dim) - (prose-verbatim blue-cooler)) + (fg-prose-verbatim blue-cooler)) "Preset of palette overrides with cooler colors. This changes parts of the palette to use more blue and @@ -1136,7 +990,7 @@ Info node `(modus-themes) Option for palette overrides'.") (mail-subject blue-warmer) (mail-other magenta-warmer) - (prose-macro red-cooler) + (fg-prose-macro red-cooler) (prose-tag fg-dim)) "Preset of palette overrides with warmer colors. @@ -1162,14 +1016,22 @@ Info node `(modus-themes) Option for palette overrides'.") ;;;; Helper functions for theme setup ;; This is the WCAG formula: https://www.w3.org/TR/WCAG20-TECHS/G18.html +(defun modus-themes--wcag-contribution (channel weight) + "Return the CHANNEL contribution to overall luminance given WEIGHT." + (* weight + (if (<= channel 0.03928) + (/ channel 12.92) + (expt (/ (+ channel 0.055) 1.055) 2.4)))) + (defun modus-themes-wcag-formula (hex) "Get WCAG value of color value HEX. The value is defined in hexadecimal RGB notation, such #123456." - (cl-loop for k in '(0.2126 0.7152 0.0722) - for x in (color-name-to-rgb hex) - sum (* k (if (<= x 0.03928) - (/ x 12.92) - (expt (/ (+ x 0.055) 1.055) 2.4))))) + (let ((channels (color-name-to-rgb hex)) + (weights '(0.2126 0.7152 0.0722)) + contribution) + (while channels + (push (modus-themes--wcag-contribution (pop channels) (pop weights)) contribution)) + (apply #'+ contribution))) ;;;###autoload (defun modus-themes-contrast (c1 c2) @@ -1179,32 +1041,27 @@ C1 and C2 are color values written in hexadecimal RGB." (+ (modus-themes-wcag-formula c2) 0.05)))) (max ct (/ ct)))) -(make-obsolete 'modus-themes-color nil "4.0.0") -(make-obsolete 'modus-themes-color-alts nil "4.0.0") - -(declare-function cl-remove-if-not "cl-seq" (cl-pred cl-list &rest cl-keys)) +(defun modus-themes--modus-p (theme) + "Return non-nil if THEME name has a modus- prefix." + (string-prefix-p "modus-" (symbol-name theme))) (defun modus-themes--list-enabled-themes () "Return list of `custom-enabled-themes' with modus- prefix." - (cl-remove-if-not - (lambda (theme) - (string-prefix-p "modus-" (symbol-name theme))) - custom-enabled-themes)) + (seq-filter #'modus-themes--modus-p custom-enabled-themes)) + +(defun modus-themes--load-no-enable (theme) + "Load but do not enable THEME if it belongs to `custom-known-themes'." + (unless (memq theme custom-known-themes) + (load-theme theme :no-confirm :no-enable))) (defun modus-themes--enable-themes () "Enable the Modus themes." - (mapc (lambda (theme) - (unless (memq theme custom-known-themes) - (load-theme theme :no-confirm :no-enable))) - modus-themes-items)) + (mapc #'modus-themes--load-no-enable modus-themes-items)) (defun modus-themes--list-known-themes () "Return list of `custom-known-themes' with modus- prefix." (modus-themes--enable-themes) - (cl-remove-if-not - (lambda (theme) - (string-prefix-p "modus-" (symbol-name theme))) - custom-known-themes)) + (seq-filter #'modus-themes--modus-p custom-known-themes)) (defun modus-themes--current-theme () "Return first enabled Modus theme." @@ -1311,10 +1168,6 @@ symbol, which is safe when used as a face attribute's value." ;;;; Commands -(make-obsolete 'modus-themes-load-themes nil "4.0.0") -(make-obsolete 'modus-themes-load-operandi nil "4.0.0; Check `modus-themes-load-theme'") -(make-obsolete 'modus-themes-load-vivendi nil "4.0.0; Check `modus-themes-load-theme'") - (defvar modus-themes--select-theme-history nil "Minibuffer history of `modus-themes--select-prompt'.") @@ -1322,7 +1175,9 @@ symbol, which is safe when used as a face attribute's value." "Return completion annotation for THEME." (when-let ((symbol (intern-soft theme)) (doc-string (get symbol 'theme-documentation))) - (format " -- %s" (car (split-string doc-string "\\."))))) + (format " -- %s" + (propertize (car (split-string doc-string "\\.")) + 'face 'completions-annotations)))) (defun modus-themes--completion-table (category candidates) "Pass appropriate metadata CATEGORY to completion CANDIDATES." @@ -1486,8 +1341,7 @@ Check PROPERTIES for an alist value that corresponds to ALIST-KEY. If no alist is present, search the PROPERTIES list given LIST-PRED, using DEFAULT as a fallback." (if-let* ((val (or (alist-get alist-key properties) - (cl-loop for x in properties - if (funcall list-pred x) return x) + (seq-filter (lambda (x) (funcall list-pred x)) properties) default)) ((listp val))) (car val) @@ -1535,7 +1389,7 @@ color that is combined with FG-FOR-BG." :foreground fg :weight ;; If we have `bold' specifically, we inherit the face of - ;; the same name. This allows the user to customize that + ;; the same name. This allows the user to customise that ;; face, such as to change its font family. (if (and weight (not (eq weight 'bold))) weight @@ -1581,16 +1435,6 @@ Optional OL is the color of an overline." 'unspecified) :weight (or weight 'unspecified)))) -(defun modus-themes--org-block (fg bg) - "Conditionally set the FG and BG of Org blocks." - (let ((gray (or (eq modus-themes-org-blocks 'gray-background) - (eq modus-themes-org-blocks 'grayscale) ; for backward compatibility - (eq modus-themes-org-blocks 'greyscale)))) - (list :inherit 'modus-themes-fixed-pitch - :background (if gray bg 'unspecified) - :foreground (if gray 'unspecified fg) - :extend (if gray t 'unspecified)))) - (defun modus-themes--completion-line (bg) "Styles for `modus-themes-completions' with BG as the background." (let* ((var (modus-themes--list-or-warn 'modus-themes-completions)) @@ -1723,12 +1567,18 @@ FG and BG are the main colors." `(modus-themes-prominent-note ((,c :background ,bg-prominent-note :foreground ,fg-prominent-note))) `(modus-themes-prominent-warning ((,c :background ,bg-prominent-warning :foreground ,fg-prominent-warning))) ;;;;; markup - `(modus-themes-prose-code ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-code))) - `(modus-themes-prose-macro ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-macro))) - `(modus-themes-prose-verbatim ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-verbatim))) + `(modus-themes-prose-code ((,c :inherit modus-themes-fixed-pitch :background ,bg-prose-code :foreground ,fg-prose-code))) + `(modus-themes-prose-macro ((,c :inherit modus-themes-fixed-pitch :background ,bg-prose-macro :foreground ,fg-prose-macro))) + `(modus-themes-prose-verbatim ((,c :inherit modus-themes-fixed-pitch :background ,bg-prose-verbatim :foreground ,fg-prose-verbatim))) ;;;;; search - `(modus-themes-search-current ((,c :background ,bg-yellow-intense :foreground ,fg-main))) - `(modus-themes-search-lazy ((,c :background ,bg-cyan-intense :foreground ,fg-main))) + `(modus-themes-search-current ((,c :background ,bg-search-current :foreground ,fg-main))) + `(modus-themes-search-lazy ((,c :background ,bg-search-lazy :foreground ,fg-main))) + `(modus-themes-search-replace ((,c :background ,bg-search-replace :foreground ,fg-main))) +;;;;; search regexp groups + `(modus-themes-search-rx-group-0 ((,c :background ,bg-search-rx-group-0 :foreground ,fg-main))) + `(modus-themes-search-rx-group-1 ((,c :background ,bg-search-rx-group-1 :foreground ,fg-main))) + `(modus-themes-search-rx-group-2 ((,c :background ,bg-search-rx-group-2 :foreground ,fg-main))) + `(modus-themes-search-rx-group-3 ((,c :background ,bg-search-rx-group-3 :foreground ,fg-main))) ;;;;; completion frameworks `(modus-themes-completion-match-0 ((,c ,@(modus-themes--completion-match fg-completion-match-0 bg-completion-match-0)))) `(modus-themes-completion-match-1 ((,c ,@(modus-themes--completion-match fg-completion-match-1 bg-completion-match-1)))) @@ -1756,12 +1606,12 @@ FG and BG are the main colors." `(cursor ((,c :background ,cursor))) `(fringe ((,c :background ,fringe :foreground ,fg-main))) `(menu ((,c :background ,bg-dim :foreground ,fg-main))) - `(scroll-bar ((,c :background ,bg-dim :foreground ,fg-dim))) + `(scroll-bar ((,c :background ,fringe :foreground ,border))) `(tool-bar ((,c :background ,bg-dim :foreground ,fg-main))) `(vertical-border ((,c :foreground ,border))) ;;;;; basic and/or ungrouped styles - `(appt-notification ((,c :inherit error))) - `(blink-matching-paren-highlight-offscreen ((,c :background ,bg-paren-match))) + `(appt-notification ((,c :inherit bold :foreground ,modeline-err))) + `(blink-matching-paren-offscreen ((,c :background ,bg-paren-match))) `(bold ((,c :weight bold))) `(bold-italic ((,c :inherit (bold italic)))) `(underline ((,c :underline ,fg-dim))) @@ -1776,7 +1626,7 @@ FG and BG are the main colors." `(escape-glyph ((,c :foreground ,err))) `(file-name-shadow ((,c :inherit shadow))) `(header-line ((,c :inherit modus-themes-ui-variable-pitch :background ,bg-dim))) - `(header-line-highlight ((,c :inherit highlight))) + `(header-line-highlight ((,c :background ,bg-hover :foreground ,fg-main :box ,fg-main))) `(help-argument-name ((,c :inherit modus-themes-slant :foreground ,variable))) `(help-key-binding ((,c :inherit modus-themes-key-binding))) `(highlight ((,c :background ,bg-hover :foreground ,fg-main))) @@ -1792,7 +1642,7 @@ FG and BG are the main colors." `(mm-uu-extract ((,c :foreground ,mail-part))) `(next-error ((,c :inherit modus-themes-prominent-error :extend t))) `(pgtk-im-0 ((,c :inherit modus-themes-prominent-note))) - `(read-multiple-choice-face ((,c :inherit (bold modus-themes-mark-alt)))) + `(read-multiple-choice-face ((,c :inherit modus-themes-mark-sel))) `(rectangle-preview ((,c :inherit secondary-selection))) `(region ((,c :background ,bg-region :foreground ,fg-region))) `(secondary-selection ((,c :background ,bg-hover-secondary :foreground ,fg-main))) @@ -1909,7 +1759,7 @@ FG and BG are the main colors." `(anzu-match-3 ((,c :inherit modus-themes-subtle-yellow))) `(anzu-mode-line ((,c :inherit bold))) `(anzu-mode-line-no-match ((,c :inherit error))) - `(anzu-replace-highlight ((,c :inherit modus-themes-prominent-error :underline t))) + `(anzu-replace-highlight ((,c :inherit modus-themes-search-replace))) `(anzu-replace-to ((,c :inherit modus-themes-search-current))) ;;;;; auctex and Tex `(font-latex-bold-face ((,c :inherit bold))) @@ -2097,6 +1947,7 @@ FG and BG are the main colors." `(completions-annotations ((,c :inherit modus-themes-slant :foreground ,docstring))) `(completions-common-part ((,c :inherit modus-themes-completion-match-0))) `(completions-first-difference ((,c :inherit modus-themes-completion-match-1))) + `(completions-highlight ((,c :inherit modus-themes-completion-selected))) ;;;;; consult `(consult-async-split ((,c :inherit error))) `(consult-file ((,c :inherit modus-themes-bold :foreground ,info))) @@ -2104,6 +1955,7 @@ FG and BG are the main colors." `(consult-imenu-prefix ((,c :inherit shadow))) `(consult-line-number ((,c :inherit shadow))) `(consult-line-number-prefix ((,c :inherit shadow))) + `(consult-preview-insertion ((,c :background ,bg-dim))) ;;;;; corfu `(corfu-current ((,c :inherit modus-themes-completion-selected))) `(corfu-bar ((,c :background ,fg-dim))) @@ -2164,6 +2016,22 @@ FG and BG are the main colors." `(deadgrep-meta-face ((,c :inherit shadow))) `(deadgrep-regexp-metachar-face ((,c :inherit font-lock-regexp-grouping-construct))) `(deadgrep-search-term-face ((,c :inherit success))) +;;;;; debbugs + `(debbugs-gnu-archived ((,c :background ,bg-inactive :foreground ,fg-dim))) + `(debbugs-gnu-done ((,c :inherit success))) + `(debbugs-gnu-forwarded ((,c :inherit modus-themes-slant :foreground ,info))) + `(debbugs-gnu-handled (( ))) + `(debbugs-gnu-marked ((,c :inherit modus-themes-mark-sel))) + `(debbugs-gnu-marked-stale ((,c :inherit modus-themes-mark-alt))) + `(debbugs-gnu-new ((,c :inherit error))) + `(debbugs-gnu-pending ((,c :inherit modus-themes-slant :foreground ,fg-alt))) + `(debbugs-gnu-stale-1 ((,c :foreground ,red-cooler))) + `(debbugs-gnu-stale-2 ((,c :foreground ,yellow-warmer))) + `(debbugs-gnu-stale-3 ((,c :foreground ,magenta-warmer))) + `(debbugs-gnu-stale-4 ((,c :foreground ,magenta-cooler))) + `(debbugs-gnu-stale-5 ((,c :foreground ,cyan-faint))) + `(debbugs-gnu-tagged ((,c :inherit modus-themes-mark-alt))) + `(debbugs-gnu-title ((,c :inherit bold))) ;;;;; deft `(deft-filter-string-face ((,c :inherit success))) `(deft-header-face ((,c :inherit shadow))) @@ -2171,6 +2039,20 @@ FG and BG are the main colors." `(deft-summary-face ((,c :inherit (shadow modus-themes-slant)))) `(deft-time-face ((,c :foreground ,date-common))) `(deft-title-face ((,c :inherit bold))) +;;;;; denote + `(denote-faces-date ((,c :foreground ,date-common))) + `(denote-faces-delimiter ((,c :inherit shadow))) + `(denote-faces-extension ((,c :inherit shadow))) + `(denote-faces-keywords ((,c :inherit modus-themes-bold :foreground ,keyword))) + `(denote-faces-link ((,c :inherit link))) + `(denote-faces-prompt-current-name ((,c :inherit modus-themes-slant :foreground ,fg-changed-intense))) + `(denote-faces-prompt-new-name ((,c :inherit modus-themes-slant :foreground ,fg-added-intense))) + `(denote-faces-prompt-old-name ((,c :inherit modus-themes-slant :foreground ,fg-removed-intense))) + `(denote-faces-signature ((,c :inherit modus-themes-bold :foreground ,string))) + `(denote-faces-subdirectory ((,c :inherit modus-themes-bold :foreground ,fg-alt))) + `(denote-faces-time ((,c :inherit denote-faces-date))) + `(denote-faces-time-delimiter ((,c :inherit shadow))) + `(denote-faces-title (( ))) ;;;;; devdocs `(devdocs-code-block ((,c :inherit modus-themes-fixed-pitch :background ,bg-dim :extend t))) ;;;;; dictionary @@ -2340,7 +2222,7 @@ FG and BG are the main colors." `(el-search-occur-match ((,c :inherit match))) ;;;;; eldoc ;; NOTE: see https://github.com/purcell/package-lint/issues/187 - (list 'eldoc-highlight-function-argument `((,c :inherit modus-themes-mark-alt))) + (list 'eldoc-highlight-function-argument `((,c :inherit bold :background ,bg-active-argument :foreground ,fg-active-argument))) ;;;;; eldoc-box `(eldoc-box-body ((,c :background ,bg-dim :foreground ,fg-main))) `(eldoc-box-border ((,c :background ,border))) @@ -2420,9 +2302,11 @@ FG and BG are the main colors." `(erc-dangerous-host-face ((,c :inherit error))) `(erc-direct-msg-face ((,c :inherit shadow))) `(erc-error-face ((,c :inherit error))) + `(erc-fill-wrap-merge-indicator-face ((,c :foreground ,fg-dim))) `(erc-fool-face ((,c :inherit shadow))) `(erc-input-face ((,c :foreground ,fnname))) `(erc-inverse-face ((,c :inherit erc-default-face :inverse-video t))) + `(erc-keep-place-indicator-arrow ((,c :foreground ,info))) `(erc-keyword-face ((,c :inherit bold :foreground ,keyword))) `(erc-my-nick-face ((,c :inherit bold :foreground ,name))) `(erc-my-nick-prefix-face ((,c :inherit erc-my-nick-face))) @@ -2463,7 +2347,7 @@ FG and BG are the main colors." `(evil-ex-info ((,c :inherit font-lock-type-face))) `(evil-ex-lazy-highlight ((,c :inherit modus-themes-search-lazy))) `(evil-ex-search ((,c :inherit modus-themes-search-current))) - `(evil-ex-substitute-matches ((,c :inherit modus-themes-prominent-error :underline t))) + `(evil-ex-substitute-matches ((,c :inherit modus-themes-search-replace))) `(evil-ex-substitute-replacement ((,c :inherit modus-themes-search-current))) ;;;;; eww `(eww-invalid-certificate ((,c :foreground ,err))) @@ -2533,7 +2417,7 @@ FG and BG are the main colors." `(font-lock-variable-name-face ((,c :foreground ,variable))) `(font-lock-warning-face ((,c :inherit modus-themes-bold :foreground ,warning))) ;;;;; geiser - `(geiser-font-lock-autodoc-current-arg ((,c :inherit modus-themes-mark-alt))) + `(geiser-font-lock-autodoc-current-arg ((,c :inherit bold :background ,bg-active-argument :foreground ,fg-active-argument))) `(geiser-font-lock-autodoc-identifier ((,c :foreground ,docstring))) `(geiser-font-lock-doc-button ((,c :inherit button))) `(geiser-font-lock-doc-link ((,c :inherit button))) @@ -2574,7 +2458,7 @@ FG and BG are the main colors." `(git-timemachine-minibuffer-author-face ((,c :foreground ,name))) `(git-timemachine-minibuffer-detail-face ((,c :foreground ,fg-main))) ;;;;; gnus - `(gnus-button ((,c :inherit button))) + `(gnus-button ((,c :inherit button :underline nil))) `(gnus-cite-1 ((,c :inherit message-cited-text-1))) `(gnus-cite-2 ((,c :inherit message-cited-text-2))) `(gnus-cite-3 ((,c :inherit message-cited-text-3))) @@ -2665,37 +2549,37 @@ FG and BG are the main colors." ;; entries in their palette for such an edge case. Defining those ;; entries is not appropriate. `(hi-aquamarine ((((class color) (min-colors 88) (background light)) - :background "white" :foreground "#227f9f" :inverse-video t) + :background "#ffffff" :foreground "#227f9f" :inverse-video t) (((class color) (min-colors 88) (background dark)) - :background "black" :foreground "#66cbdc" :inverse-video t))) + :background "#000000" :foreground "#66cbdc" :inverse-video t))) `(hi-black-b ((,c :inverse-video t))) `(hi-black-hb ((,c :background ,bg-main :foreground ,fg-dim :inverse-video t))) `(hi-blue ((((class color) (min-colors 88) (background light)) - :background "white" :foreground "#3366dd" :inverse-video t) + :background "#ffffff" :foreground "#3366dd" :inverse-video t) (((class color) (min-colors 88) (background dark)) - :background "black" :foreground "#aaccff" :inverse-video t))) + :background "#000000" :foreground "#aaccff" :inverse-video t))) `(hi-blue-b ((,c :inherit (bold hi-blue)))) `(hi-green ((((class color) (min-colors 88) (background light)) - :background "white" :foreground "#008a00" :inverse-video t) + :background "#ffffff" :foreground "#008a00" :inverse-video t) (((class color) (min-colors 88) (background dark)) - :background "black" :foreground "#66dd66" :inverse-video t))) + :background "#000000" :foreground "#66dd66" :inverse-video t))) `(hi-green-b ((,c :inherit (bold hi-green)))) `(hi-pink ((((class color) (min-colors 88) (background light)) - :background "white" :foreground "#bd30aa" :inverse-video t) + :background "#ffffff" :foreground "#bd30aa" :inverse-video t) (((class color) (min-colors 88) (background dark)) - :background "black" :foreground "#ff88ee" :inverse-video t))) + :background "#000000" :foreground "#ff88ee" :inverse-video t))) `(hi-red-b ((((class color) (min-colors 88) (background light)) - :background "white" :foreground "#dd0000" :inverse-video t) + :background "#ffffff" :foreground "#dd0000" :inverse-video t) (((class color) (min-colors 88) (background dark)) - :background "black" :foreground "#f06666" :inverse-video t))) + :background "#000000" :foreground "#f06666" :inverse-video t))) `(hi-salmon ((((class color) (min-colors 88) (background light)) - :background "white" :foreground "#bf555a" :inverse-video t) + :background "#ffffff" :foreground "#bf555a" :inverse-video t) (((class color) (min-colors 88) (background dark)) - :background "black" :foreground "#e08a50" :inverse-video t))) + :background "#000000" :foreground "#e08a50" :inverse-video t))) `(hi-yellow ((((class color) (min-colors 88) (background light)) - :background "white" :foreground "#af6400" :inverse-video t) + :background "#ffffff" :foreground "#af6400" :inverse-video t) (((class color) (min-colors 88) (background dark)) - :background "black" :foreground "#faea00" :inverse-video t))) + :background "#000000" :foreground "#faea00" :inverse-video t))) `(highlight-changes ((,c :foreground ,warning :underline nil))) `(highlight-changes-delete ((,c :foreground ,err :underline t))) `(hl-line ((,c :background ,bg-hl-line :extend t))) @@ -2735,14 +2619,14 @@ FG and BG are the main colors." `(image-dired-thumb-header-file-size ((,c :foreground ,constant))) `(image-dired-thumb-mark ((,c :inherit modus-themes-mark-sel :box (:line-width -3)))) ;;;;; imenu-list - `(imenu-list-entry-face-0 ((,c :foreground ,fg-heading-0))) - `(imenu-list-entry-face-1 ((,c :foreground ,fg-heading-1))) - `(imenu-list-entry-face-2 ((,c :foreground ,fg-heading-2))) - `(imenu-list-entry-face-3 ((,c :foreground ,fg-heading-3))) - `(imenu-list-entry-subalist-face-0 ((,c :inherit bold :foreground ,fg-heading-4 :underline t))) - `(imenu-list-entry-subalist-face-1 ((,c :inherit bold :foreground ,fg-heading-5 :underline t))) - `(imenu-list-entry-subalist-face-2 ((,c :inherit bold :foreground ,fg-heading-6 :underline t))) - `(imenu-list-entry-subalist-face-3 ((,c :inherit bold :foreground ,fg-heading-7 :underline t))) + `(imenu-list-entry-face-0 ((,c :foreground ,fg-heading-1))) + `(imenu-list-entry-face-1 ((,c :foreground ,fg-heading-2))) + `(imenu-list-entry-face-2 ((,c :foreground ,fg-heading-3))) + `(imenu-list-entry-face-3 ((,c :foreground ,fg-heading-4))) + `(imenu-list-entry-subalist-face-0 ((,c :inherit bold :foreground ,fg-heading-1 :underline t))) + `(imenu-list-entry-subalist-face-1 ((,c :inherit bold :foreground ,fg-heading-2 :underline t))) + `(imenu-list-entry-subalist-face-2 ((,c :inherit bold :foreground ,fg-heading-3 :underline t))) + `(imenu-list-entry-subalist-face-3 ((,c :inherit bold :foreground ,fg-heading-4 :underline t))) ;;;;; indium `(indium-breakpoint-face ((,c :foreground ,err))) `(indium-frame-url-face ((,c :inherit (shadow button)))) @@ -2807,11 +2691,11 @@ FG and BG are the main colors." ;;;;; isearch, occur, and the like `(isearch ((,c :inherit modus-themes-search-current))) `(isearch-fail ((,c :inherit modus-themes-prominent-error))) - `(isearch-group-1 ((,c :inherit modus-themes-intense-blue))) - `(isearch-group-2 ((,c :inherit modus-themes-intense-magenta))) + `(isearch-group-1 ((,c :inherit modus-themes-search-rx-group-0))) + `(isearch-group-2 ((,c :inherit modus-themes-search-rx-group-1))) `(lazy-highlight ((,c :inherit modus-themes-search-lazy))) `(match ((,c :background ,bg-magenta-subtle :foreground ,fg-main))) - `(query-replace ((,c :inherit modus-themes-prominent-error))) + `(query-replace ((,c :inherit modus-themes-search-replace))) ;;;;; ivy `(ivy-action ((,c :inherit modus-themes-key-binding))) `(ivy-confirm-face ((,c :inherit success))) @@ -2876,7 +2760,7 @@ FG and BG are the main colors." `(kaocha-runner-warning-face ((,c :inherit warning))) ;;;;; keycast `(keycast-command ((,c :inherit bold))) - `(keycast-key ((,c :background ,keybind :foreground ,bg-main))) + `(keycast-key ((,c :inherit modus-themes-bold :background ,keybind :foreground ,bg-main))) ;;;;; ledger-mode `(ledger-font-auto-xact-face ((,c :inherit font-lock-builtin-face))) `(ledger-font-account-name-face ((,c :foreground ,name))) @@ -3033,7 +2917,7 @@ FG and BG are the main colors." `(markdown-highlighting-face ((,c :inherit secondary-selection))) `(markdown-inline-code-face ((,c :inherit modus-themes-prose-code))) `(markdown-italic-face ((,c :inherit italic))) - `(markdown-language-keyword-face ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-block))) + `(markdown-language-keyword-face ((,c :inherit modus-themes-fixed-pitch :background ,bg-prose-block-delimiter :foreground ,fg-prose-block-delimiter))) `(markdown-line-break-face ((,c :inherit nobreak-space))) `(markdown-link-face ((,c :inherit link))) `(markdown-markup-face ((,c :inherit shadow))) @@ -3046,12 +2930,12 @@ FG and BG are the main colors." ;;;;; markup-faces (`adoc-mode') `(markup-attribute-face ((,c :inherit (modus-themes-slant markup-meta-face)))) `(markup-bold-face ((,c :inherit bold))) - `(markup-code-face ((,c :foreground ,prose-code))) + `(markup-code-face ((,c :inherit modus-themes-prose-code))) `(markup-comment-face ((,c :inherit font-lock-comment-face))) - `(markup-complex-replacement-face ((,c :foreground ,prose-macro))) + `(markup-complex-replacement-face ((,c :inherit modus-themes-prose-macro))) `(markup-emphasis-face ((,c :inherit markup-italic-face))) `(markup-error-face ((,c :inherit error))) - `(markup-gen-face ((,c :foreground ,prose-verbatim))) + `(markup-gen-face ((,c :inherit modus-themes-prose-verbatim))) `(markup-internal-reference-face ((,c :inherit (shadow modus-themes-slant)))) `(markup-italic-face ((,c :inherit italic))) `(markup-list-face ((,c :background ,bg-inactive))) @@ -3073,7 +2957,9 @@ FG and BG are the main colors." `(markup-title-3-face ((,c :inherit modus-themes-heading-4))) `(markup-title-4-face ((,c :inherit modus-themes-heading-5))) `(markup-title-5-face ((,c :inherit modus-themes-heading-6))) - `(markup-verbatim-face ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-verbatim))) + `(markup-verbatim-face ((,c :inherit modus-themes-prose-verbatim))) +;;;;; mct + `(mct-highlight-candidate ((,c :inherit modus-themes-completion-selected))) ;;;;; messages `(message-cited-text-1 ((,c :foreground ,mail-cite-0))) `(message-cited-text-2 ((,c :foreground ,mail-cite-1))) @@ -3087,7 +2973,7 @@ FG and BG are the main colors." `(message-header-xheader ((,c :inherit message-header-other))) `(message-header-other ((,c :foreground ,mail-other))) `(message-mml ((,c :foreground ,mail-part))) - `(message-separator ((,c :background ,bg-active))) + `(message-separator ((,c :background ,bg-inactive :foreground ,fg-main))) ;;;;; minimap `(minimap-active-region-background ((,c :background ,bg-active))) `(minimap-current-line-face ((,c :background ,bg-cyan-intense :foreground ,fg-main))) @@ -3129,7 +3015,7 @@ FG and BG are the main colors." `(mu4e-contact-face ((,c :inherit message-header-to))) `(mu4e-context-face ((,c :inherit bold))) `(mu4e-draft-face ((,c :foreground ,warning))) - `(mu4e-flagged-face ((,c :foreground ,err))) + `(mu4e-flagged-face ((,c :foreground ,keyword))) `(mu4e-footer-face ((,c :inherit italic :foreground ,fg-alt))) `(mu4e-forwarded-face ((,c :inherit italic :foreground ,info))) `(mu4e-header-face ((,c :inherit shadow))) @@ -3148,6 +3034,7 @@ FG and BG are the main colors." `(mu4e-replied-face ((,c :foreground ,info))) `(mu4e-special-header-value-face ((,c :inherit message-header-subject))) `(mu4e-system-face ((,c :inherit italic))) + `(mu4e-thread-fold-face ((,c :foreground ,border))) `(mu4e-title-face (( ))) `(mu4e-trashed-face ((,c :foreground ,err))) `(mu4e-unread-face ((,c :inherit bold))) @@ -3233,7 +3120,7 @@ FG and BG are the main colors." `(notmuch-message-summary-face ((,c :inherit bold :background ,bg-inactive))) `(notmuch-search-count ((,c :foreground ,fg-dim))) `(notmuch-search-date ((,c :foreground ,date-common))) - `(notmuch-search-flagged-face ((,c :foreground ,err))) + `(notmuch-search-flagged-face ((,c :foreground ,keyword))) `(notmuch-search-matching-authors ((,c :foreground ,mail-recipient))) `(notmuch-search-non-matching-authors ((,c :inherit shadow))) `(notmuch-search-subject ((,c :foreground ,fg-main))) @@ -3241,7 +3128,7 @@ FG and BG are the main colors." `(notmuch-tag-added ((,c :underline ,info))) `(notmuch-tag-deleted ((,c :strike-through ,err))) `(notmuch-tag-face ((,c :foreground ,accent-0))) - `(notmuch-tag-flagged ((,c :foreground ,err))) + `(notmuch-tag-flagged ((,c :foreground ,keyword))) `(notmuch-tag-unread ((,c :foreground ,accent-1))) `(notmuch-tree-match-author-face ((,c :inherit notmuch-search-matching-authors))) `(notmuch-tree-match-date-face ((,c :inherit notmuch-search-date))) @@ -3280,7 +3167,7 @@ FG and BG are the main colors." `(nxml-ref ((,c :inherit (shadow modus-themes-bold)))) `(rng-error ((,c :inherit error))) ;;;;; olivetti - `(olivetti-fringe ((,c :background ,bg-main))) + `(olivetti-fringe ((,c :background ,fringe))) ;;;;; orderless `(orderless-match-face-0 ((,c :inherit modus-themes-completion-match-0))) `(orderless-match-face-1 ((,c :inherit modus-themes-completion-match-1))) @@ -3290,7 +3177,7 @@ FG and BG are the main colors." `(org-agenda-calendar-daterange ((,c :foreground ,date-range))) `(org-agenda-calendar-event ((,c :foreground ,date-event))) `(org-agenda-calendar-sexp ((,c :inherit (modus-themes-slant org-agenda-calendar-event)))) - `(org-agenda-clocking ((,c :inherit modus-themes-mark-alt))) + `(org-agenda-clocking ((,c :inherit bold :background ,bg-active-argument :foreground ,fg-active-argument))) `(org-agenda-column-dateline ((,c :background ,bg-inactive))) `(org-agenda-current-time ((,c :foreground ,date-now))) `(org-agenda-date ((,c ,@(modus-themes--heading 'agenda-date date-weekday)))) @@ -3309,10 +3196,10 @@ FG and BG are the main colors." `(org-agenda-structure-filter ((,c :inherit org-agenda-structure :foreground ,warning))) `(org-agenda-structure-secondary ((,c :inherit font-lock-doc-face))) `(org-archived ((,c :background ,bg-inactive :foreground ,fg-main))) - `(org-block ((,c ,@(modus-themes--org-block fg-main bg-dim)))) - `(org-block-begin-line ((,c ,@(modus-themes--org-block prose-block bg-inactive)))) + `(org-block ((,c :inherit modus-themes-fixed-pitch :background ,bg-prose-block-contents :extend t))) + `(org-block-begin-line ((,c :inherit modus-themes-fixed-pitch :background ,bg-prose-block-delimiter :foreground ,fg-prose-block-delimiter :extend t))) `(org-block-end-line ((,c :inherit org-block-begin-line))) - `(org-checkbox ((,c :foreground ,warning))) + `(org-checkbox ((,c :inherit modus-themes-fixed-pitch :foreground ,warning))) `(org-checkbox-statistics-done ((,c :inherit org-done))) `(org-checkbox-statistics-todo ((,c :inherit org-todo))) `(org-clock-overlay ((,c :inherit secondary-selection))) @@ -3321,6 +3208,11 @@ FG and BG are the main colors." `(org-column-title ((,c :inherit (bold default) :underline t :background ,bg-dim))) `(org-date ((,c :inherit modus-themes-fixed-pitch :foreground ,date-common))) `(org-date-selected ((,c :foreground ,date-common :inverse-video t))) + ;; NOTE 2024-03-17: Normally we do not want to add this padding + ;; with the :box, but I do it here because the keys are otherwise + ;; very hard to read. The square brackets around them are not + ;; colored, which is what is causing the problem. + `(org-dispatcher-highlight ((,c :inherit modus-themes-bold :box (:line-width 2 :color ,bg-hover-secondary) :background ,bg-hover-secondary :foreground ,fg-main))) `(org-document-info ((,c :foreground ,prose-metadata-value))) `(org-document-info-keyword ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-metadata))) `(org-document-title ((,c :inherit modus-themes-heading-0))) @@ -3328,7 +3220,7 @@ FG and BG are the main colors." `(org-drawer ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-metadata))) `(org-ellipsis (( ))) ; inherits from the heading's color `(org-footnote ((,c :inherit link))) - `(org-formula ((,c :inherit modus-themes-fixed-pitch :foreground ,fnname))) + `(org-formula ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-table-formula))) `(org-headline-done ((,c :inherit org-done))) `(org-headline-todo ((,c :inherit org-todo))) `(org-hide ((,c :foreground ,bg-main))) @@ -3370,13 +3262,13 @@ FG and BG are the main colors." `(org-verse ((,c :inherit org-block))) `(org-warning ((,c :inherit warning))) ;;;;; org-habit - `(org-habit-alert-face ((,c :background ,bg-graph-yellow-0 :foreground "black"))) ; fg is special case + `(org-habit-alert-face ((,c :background ,bg-graph-yellow-0 :foreground "#000000"))) ; fg is special case `(org-habit-alert-future-face ((,c :background ,bg-graph-yellow-1))) - `(org-habit-clear-face ((,c :background ,bg-graph-blue-0 :foreground "black"))) ; fg is special case + `(org-habit-clear-face ((,c :background ,bg-graph-blue-0 :foreground "#000000"))) ; fg is special case `(org-habit-clear-future-face ((,c :background ,bg-graph-blue-1))) `(org-habit-overdue-face ((,c :background ,bg-graph-red-0))) `(org-habit-overdue-future-face ((,c :background ,bg-graph-red-1))) - `(org-habit-ready-face ((,c :background ,bg-graph-green-0 :foreground "black"))) ; fg is special case + `(org-habit-ready-face ((,c :background ,bg-graph-green-0 :foreground "#000000"))) ; fg is special case `(org-habit-ready-future-face ((,c :background ,bg-graph-green-1))) ;;;;; org-journal `(org-journal-calendar-entry-face ((,c :inherit modus-themes-slant :foreground ,date-common))) @@ -3551,10 +3443,10 @@ FG and BG are the main colors." `(recursion-indicator-general ((,c :foreground ,modeline-err))) `(recursion-indicator-minibuffer ((,c :foreground ,modeline-info))) ;;;;; regexp-builder (re-builder) - `(reb-match-0 ((,c :inherit modus-themes-intense-cyan))) - `(reb-match-1 ((,c :inherit modus-themes-subtle-magenta))) - `(reb-match-2 ((,c :inherit modus-themes-subtle-green))) - `(reb-match-3 ((,c :inherit modus-themes-intense-yellow))) + `(reb-match-0 ((,c :inherit modus-themes-search-rx-group-0))) + `(reb-match-1 ((,c :inherit modus-themes-search-rx-group-1))) + `(reb-match-2 ((,c :inherit modus-themes-search-rx-group-2))) + `(reb-match-3 ((,c :inherit modus-themes-search-rx-group-3))) `(reb-regexp-grouping-backslash ((,c :inherit font-lock-regexp-grouping-backslash))) `(reb-regexp-grouping-construct ((,c :inherit font-lock-regexp-grouping-construct))) ;;;;; rg (rg.el) @@ -3609,7 +3501,7 @@ FG and BG are the main colors." `(shortdoc-heading ((,c :inherit bold))) `(shortdoc-section (())) ; remove the default's variable-pitch style ;;;;; show-paren-mode - `(show-paren-match ((,c :background ,bg-paren-match :foreground ,fg-main :underline ,underline-paren-match))) + `(show-paren-match ((,c :background ,bg-paren-match :foreground ,fg-paren-match :underline ,underline-paren-match))) `(show-paren-match-expression ((,c :background ,bg-paren-expression))) `(show-paren-mismatch ((,c :inherit modus-themes-prominent-error))) ;;;;; shr @@ -3621,6 +3513,7 @@ FG and BG are the main colors." `(shr-h4 ((,c :inherit modus-themes-heading-4))) `(shr-h5 ((,c :inherit modus-themes-heading-5))) `(shr-h6 ((,c :inherit modus-themes-heading-6))) + `(shr-mark ((,c :inherit match))) `(shr-selected-link ((,c :inherit modus-themes-mark-sel))) ;;;;; side-notes `(side-notes ((,c :background ,bg-dim :foreground ,fg-dim))) @@ -3803,14 +3696,25 @@ FG and BG are the main colors." `(transient-amaranth ((,c :inherit bold :foreground ,yellow-warmer))) ;; Placate the compiler for what is a spurious warning. We also ;; have to do this with `eldoc-highlight-function-argument'. - (list 'transient-argument `((,c :inherit (bold modus-themes-mark-alt)))) + (list 'transient-argument `((,c :inherit bold :background ,bg-active-argument :foreground ,fg-active-argument))) `(transient-blue ((,c :inherit bold :foreground ,blue))) `(transient-disabled-suffix ((,c :inherit modus-themes-mark-del))) `(transient-enabled-suffix ((,c :inherit modus-themes-subtle-cyan))) `(transient-heading ((,c :inherit bold :foreground ,fg-main))) `(transient-inactive-argument ((,c :inherit shadow))) `(transient-inactive-value ((,c :inherit shadow))) + ;; NOTE 2023-12-09 10:30:09 +0200: The new user option + ;; `transient-semantic-coloring' is enabled by default. This is + ;; not good for us, because we are making it harder for users who + ;; need accessible colors to use the transient interfaces. I + ;; could set that user option to nil, but I think it is less + ;; intrusive to enforce uniformity among the relevant faces. + ;; Those who want semantic coloring can modify these faces. `(transient-key ((,c :inherit modus-themes-key-binding))) + `(transient-key-exit ((,c :inherit modus-themes-key-binding))) + `(transient-key-noop ((,c :inherit (shadow modus-themes-key-binding)))) + `(transient-key-return ((,c :inherit modus-themes-key-binding))) + `(transient-key-stay ((,c :inherit modus-themes-key-binding))) `(transient-mismatched-key ((,c :underline t))) `(transient-nonstandard-key ((,c :underline t))) `(transient-pink ((,c :inherit bold :foreground ,magenta))) @@ -3819,7 +3723,7 @@ FG and BG are the main colors." `(transient-teal ((,c :inherit bold :foreground ,cyan-cooler))) `(transient-unreachable ((,c :inherit shadow))) `(transient-unreachable-key ((,c :inherit shadow))) - `(transient-value ((,c :inherit (bold modus-themes-mark-sel)))) + `(transient-value ((,c :inherit bold :background ,bg-active-value :foreground ,fg-active-value))) ;;;;; trashed `(trashed-deleted ((,c :inherit modus-themes-mark-del))) `(trashed-directory ((,c :foreground ,accent-0))) @@ -3918,11 +3822,11 @@ FG and BG are the main colors." `(visible-mark-forward-face1 ((,c :background ,bg-magenta-intense))) `(visible-mark-forward-face2 ((,c :background ,bg-green-intense))) ;;;;; visual-regexp - `(vr/group-0 ((,c :inherit modus-themes-intense-blue))) - `(vr/group-1 ((,c :inherit modus-themes-intense-magenta))) - `(vr/group-2 ((,c :inherit modus-themes-intense-green))) - `(vr/match-0 ((,c :inherit modus-themes-intense-yellow))) - `(vr/match-1 ((,c :inherit modus-themes-intense-yellow))) + `(vr/group-0 ((,c :inherit modus-themes-search-rx-group-0))) + `(vr/group-1 ((,c :inherit modus-themes-search-rx-group-1))) + `(vr/group-2 ((,c :inherit modus-themes-search-rx-group-2))) + `(vr/match-0 ((,c :inherit modus-themes-search-current))) + `(vr/match-1 ((,c :inherit modus-themes-search-lazy))) `(vr/match-separator-face ((,c :inherit bold :background ,bg-active))) ;;;;; vterm ;; NOTE 2023-08-10: `vterm-color-black' and `vterm-color-white' @@ -4025,7 +3929,7 @@ FG and BG are the main colors." `(which-func ((,c :inherit bold :foreground ,modeline-info))) ; same as `breadcrumb-imenu-leaf-face' ;;;;; which-key `(which-key-command-description-face ((,c :foreground ,fg-main))) - `(which-key-group-description-face ((,c :foreground ,keyword))) + `(which-key-group-description-face ((,c :foreground ,type))) `(which-key-highlighted-command-face ((,c :foreground ,warning :underline t))) `(which-key-key-face ((,c :inherit modus-themes-key-binding))) `(which-key-local-map-description-face ((,c :foreground ,fg-main))) @@ -4034,14 +3938,14 @@ FG and BG are the main colors." `(which-key-special-key-face ((,c :inherit error))) ;;;;; whitespace-mode `(whitespace-big-indent ((,c :background ,bg-space-err))) - `(whitespace-empty ((,c :inherit modus-themes-intense-magenta))) + `(whitespace-empty ((,c :background ,bg-space))) `(whitespace-hspace ((,c :background ,bg-space :foreground ,fg-space))) `(whitespace-indentation ((,c :background ,bg-space :foreground ,fg-space))) `(whitespace-line ((,c :background ,bg-space :foreground ,warning))) `(whitespace-newline ((,c :background ,bg-space :foreground ,fg-space))) `(whitespace-space ((,c :background ,bg-space :foreground ,fg-space))) - `(whitespace-space-after-tab ((,c :inherit modus-themes-subtle-magenta))) - `(whitespace-space-before-tab ((,c :inherit modus-themes-subtle-cyan))) + `(whitespace-space-after-tab ((,c :inherit warning :background ,bg-space))) + `(whitespace-space-before-tab ((,c :inherit warning :background ,bg-space))) `(whitespace-tab ((,c :background ,bg-space :foreground ,fg-space))) `(whitespace-trailing ((,c :background ,bg-space-err))) ;;;;; window-divider-mode @@ -4072,14 +3976,27 @@ FG and BG are the main colors." ;;;;; yaml-mode `(yaml-tab-face ((,c :background ,bg-space-err))) ;;;;; yasnippet - `(yas-field-highlight-face ((,c :inherit highlight)))) + `(yas-field-highlight-face ((,c :inherit highlight))) +;;;;; ztree + `(ztreep-arrow-face ((,c :inherit shadow))) + `(ztreep-diff-header-face ((,c :inherit modus-themes-heading-0))) + `(ztreep-diff-header-small-face ((,c :inherit font-lock-doc-face))) + `(ztreep-diff-model-add-face ((,c :foreground ,info))) + `(ztreep-diff-model-diff-face ((,c :foreground ,err))) + `(ztreep-diff-model-ignored-face ((,c :foreground ,fg-dim :strike-through t))) + `(ztreep-diff-model-normal-face (( ))) + `(ztreep-expand-sign-face ((,c :inherit shadow))) + `(ztreep-header-face ((,c :inherit modus-themes-heading-0))) + `(ztreep-leaf-face (( ))) + `(ztreep-node-count-children-face ((,c :inherit (shadow italic)))) + `(ztreep-node-face ((,c :foreground ,accent-0)))) "Face specs for use with `modus-themes-theme'.") (defconst modus-themes-custom-variables '( ;;;; ansi-colors `(ansi-color-faces-vector [default bold shadow italic underline success warning error]) - `(ansi-color-names-vector ["gray35" ,red ,green ,yellow ,blue ,magenta ,cyan "gray65"]) + `(ansi-color-names-vector ["#595959" ,red ,green ,yellow ,blue ,magenta ,cyan "#a6a6a6"]) ;;;; chart `(chart-face-color-list '( ,bg-graph-red-0 ,bg-graph-green-0 ,bg-graph-yellow-0 ,bg-graph-blue-0 ,bg-graph-magenta-0 ,bg-graph-cyan-0 @@ -4152,29 +4069,35 @@ FG and BG are the main colors." modus-themes-fg-yellow-intense modus-themes-fg-magenta-intense modus-themes-fg-cyan-intense)) -;;;; org-src-block-faces - (if (or (eq modus-themes-org-blocks 'tinted-background) - (eq modus-themes-org-blocks 'rainbow)) - `(org-src-block-faces - `(("emacs-lisp" modus-themes-nuanced-magenta) - ("elisp" modus-themes-nuanced-magenta) - ("clojure" modus-themes-nuanced-magenta) - ("clojurescript" modus-themes-nuanced-magenta) - ("c" modus-themes-nuanced-blue) - ("c++" modus-themes-nuanced-blue) - ("sh" modus-themes-nuanced-green) - ("shell" modus-themes-nuanced-green) - ("html" modus-themes-nuanced-yellow) - ("xml" modus-themes-nuanced-yellow) - ("css" modus-themes-nuanced-red) - ("scss" modus-themes-nuanced-red) - ("python" modus-themes-nuanced-green) - ("ipython" modus-themes-nuanced-magenta) - ("r" modus-themes-nuanced-cyan) - ("yaml" modus-themes-nuanced-cyan) - ("conf" modus-themes-nuanced-cyan) - ("docker" modus-themes-nuanced-cyan))) - `(org-src-block-faces '()))) +;;;; rustic-ansi-faces + `(rustic-ansi-faces + [,fg-term-black + ,fg-term-red + ,fg-term-green + ,fg-term-yellow + ,fg-term-blue + ,fg-term-magenta + ,fg-term-cyan + ,fg-term-white]) +;;;; xterm-color + `(xterm-color-names + [,fg-term-black + ,fg-term-red + ,fg-term-green + ,fg-term-yellow + ,fg-term-blue + ,fg-term-magenta + ,fg-term-cyan + ,fg-term-white]) + `(xterm-color-names-bright + [,fg-term-black-bright + ,fg-term-red-bright + ,fg-term-green-bright + ,fg-term-yellow-bright + ,fg-term-blue-bright + ,fg-term-magenta-bright + ,fg-term-cyan-bright + ,fg-term-white-bright])) "Custom variables for `modus-themes-theme'.") ;;; Theme macros diff --git a/etc/themes/modus-vivendi-deuteranopia-theme.el b/etc/themes/modus-vivendi-deuteranopia-theme.el index 62715e20e51..d721dba09a9 100644 --- a/etc/themes/modus-vivendi-deuteranopia-theme.el +++ b/etc/themes/modus-vivendi-deuteranopia-theme.el @@ -1,11 +1,11 @@ ;;; modus-vivendi-deuteranopia-theme.el --- Deuteranopia-optimized theme with a black background -*- lexical-binding:t -*- -;; Copyright (C) 2019-2024 Free Software Foundation, Inc. +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> -;; URL: https://git.sr.ht/~protesilaos/modus-themes -;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes +;; Maintainer: Protesilaos Stavrou +;; URL: https://github.com/protesilaos/modus-themes +;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. @@ -127,12 +127,12 @@ standard)." (bg-magenta-subtle "#552f5f") (bg-cyan-subtle "#004065") - (bg-red-nuanced "#2c0614") - (bg-green-nuanced "#001904") - (bg-yellow-nuanced "#221000") - (bg-blue-nuanced "#0f0e39") - (bg-magenta-nuanced "#230631") - (bg-cyan-nuanced "#041529") + (bg-red-nuanced "#3a0c14") + (bg-green-nuanced "#092f1f") + (bg-yellow-nuanced "#381d0f") + (bg-blue-nuanced "#12154a") + (bg-magenta-nuanced "#2f0c3f") + (bg-cyan-nuanced "#042837") ;;; Uncommon accent backgrounds @@ -211,6 +211,7 @@ standard)." ;;; Paren match (bg-paren-match "#2f7f9f") + (fg-paren-match fg-main) (bg-paren-expression "#453040") (underline-paren-match unspecified) @@ -240,6 +241,11 @@ standard)." (bg-prominent-note bg-cyan-intense) (fg-prominent-note fg-main) + (bg-active-argument bg-yellow-nuanced) + (fg-active-argument yellow-warmer) + (bg-active-value bg-blue-nuanced) + (fg-active-value blue-warmer) + ;;;; Code mappings (builtin magenta-warmer) @@ -288,7 +294,7 @@ standard)." (date-event fg-alt) (date-holiday yellow-warmer) (date-holiday-other blue) - (date-now blue-faint) + (date-now fg-main) (date-range fg-alt) (date-scheduled yellow-cooler) (date-weekday cyan) @@ -342,16 +348,29 @@ standard)." ;;;; Prose mappings - (prose-block fg-dim) - (prose-code cyan-cooler) + (bg-prose-block-delimiter bg-dim) + (fg-prose-block-delimiter fg-dim) + (bg-prose-block-contents bg-dim) + + (bg-prose-code unspecified) + (fg-prose-code cyan-cooler) + + (bg-prose-macro unspecified) + (fg-prose-macro magenta-cooler) + + (bg-prose-verbatim unspecified) + (fg-prose-verbatim magenta-warmer) + (prose-done blue) - (prose-macro magenta-cooler) + (prose-todo yellow-warmer) + (prose-metadata fg-dim) (prose-metadata-value fg-alt) + (prose-table fg-alt) + (prose-table-formula yellow-warmer) + (prose-tag magenta-faint) - (prose-todo yellow-warmer) - (prose-verbatim magenta-warmer) ;;;; Rainbow mappings @@ -365,6 +384,17 @@ standard)." (rainbow-7 blue-faint) (rainbow-8 magenta-faint) +;;;; Search mappings + + (bg-search-current bg-yellow-intense) + (bg-search-lazy bg-blue-intense) + (bg-search-replace bg-magenta-intense) + + (bg-search-rx-group-0 bg-cyan-intense) + (bg-search-rx-group-1 bg-magenta-intense) + (bg-search-rx-group-2 bg-blue-subtle) + (bg-search-rx-group-3 bg-yellow-subtle) + ;;;; Space mappings (bg-space unspecified) @@ -373,10 +403,10 @@ standard)." ;;;; Terminal mappings - (bg-term-black "black") - (fg-term-black "black") - (bg-term-black-bright "gray35") - (fg-term-black-bright "gray35") + (bg-term-black "#000000") + (fg-term-black "#000000") + (bg-term-black-bright "#595959") + (fg-term-black-bright "#595959") (bg-term-red red) (fg-term-red red) @@ -408,10 +438,10 @@ standard)." (bg-term-cyan-bright cyan-cooler) (fg-term-cyan-bright cyan-cooler) - (bg-term-white "gray65") - (fg-term-white "gray65") - (bg-term-white-bright "white") - (fg-term-white-bright "white") + (bg-term-white "#a6a6a6") + (fg-term-white "#a6a6a6") + (bg-term-white-bright "#ffffff") + (fg-term-white-bright "#ffffff") ;;;; Heading mappings diff --git a/etc/themes/modus-vivendi-theme.el b/etc/themes/modus-vivendi-theme.el index 238484206bb..8b822974c15 100644 --- a/etc/themes/modus-vivendi-theme.el +++ b/etc/themes/modus-vivendi-theme.el @@ -1,11 +1,11 @@ ;;; modus-vivendi-theme.el --- Elegant, highly legible theme with a black background -*- lexical-binding:t -*- -;; Copyright (C) 2019-2024 Free Software Foundation, Inc. +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> -;; URL: https://git.sr.ht/~protesilaos/modus-themes -;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes +;; Maintainer: Protesilaos Stavrou +;; URL: https://github.com/protesilaos/modus-themes +;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. @@ -125,12 +125,12 @@ which corresponds to a minimum contrast in relative luminance of (bg-magenta-subtle "#552f5f") (bg-cyan-subtle "#004065") - (bg-red-nuanced "#2c0614") - (bg-green-nuanced "#001904") - (bg-yellow-nuanced "#221000") - (bg-blue-nuanced "#0f0e39") - (bg-magenta-nuanced "#230631") - (bg-cyan-nuanced "#041529") + (bg-red-nuanced "#3a0c14") + (bg-green-nuanced "#092f1f") + (bg-yellow-nuanced "#381d0f") + (bg-blue-nuanced "#12154a") + (bg-magenta-nuanced "#2f0c3f") + (bg-cyan-nuanced "#042837") ;;; Uncommon accent backgrounds @@ -209,6 +209,7 @@ which corresponds to a minimum contrast in relative luminance of ;;; Paren match (bg-paren-match "#2f7f9f") + (fg-paren-match fg-main) (bg-paren-expression "#453040") (underline-paren-match unspecified) @@ -238,6 +239,11 @@ which corresponds to a minimum contrast in relative luminance of (bg-prominent-note bg-cyan-intense) (fg-prominent-note fg-main) + (bg-active-argument bg-yellow-nuanced) + (fg-active-argument yellow-cooler) + (bg-active-value bg-cyan-nuanced) + (fg-active-value cyan-cooler) + ;;;; Code mappings (builtin magenta-warmer) @@ -340,16 +346,29 @@ which corresponds to a minimum contrast in relative luminance of ;;;; Prose mappings - (prose-block fg-dim) - (prose-code cyan-cooler) + (bg-prose-block-delimiter bg-dim) + (fg-prose-block-delimiter fg-dim) + (bg-prose-block-contents bg-dim) + + (bg-prose-code unspecified) + (fg-prose-code cyan-cooler) + + (bg-prose-macro unspecified) + (fg-prose-macro magenta-cooler) + + (bg-prose-verbatim unspecified) + (fg-prose-verbatim magenta-warmer) + (prose-done green) - (prose-macro magenta-cooler) + (prose-todo red) + (prose-metadata fg-dim) (prose-metadata-value fg-alt) + (prose-table fg-alt) + (prose-table-formula magenta-warmer) + (prose-tag magenta-faint) - (prose-todo red) - (prose-verbatim magenta-warmer) ;;;; Rainbow mappings @@ -363,6 +382,17 @@ which corresponds to a minimum contrast in relative luminance of (rainbow-7 blue-warmer) (rainbow-8 magenta-warmer) +;;;; Search mappings + + (bg-search-current bg-yellow-intense) + (bg-search-lazy bg-cyan-intense) + (bg-search-replace bg-red-intense) + + (bg-search-rx-group-0 bg-blue-intense) + (bg-search-rx-group-1 bg-green-intense) + (bg-search-rx-group-2 bg-red-subtle) + (bg-search-rx-group-3 bg-magenta-subtle) + ;;;; Space mappings (bg-space unspecified) @@ -371,10 +401,10 @@ which corresponds to a minimum contrast in relative luminance of ;;;; Terminal mappings - (bg-term-black "black") - (fg-term-black "black") - (bg-term-black-bright "gray35") - (fg-term-black-bright "gray35") + (bg-term-black "#000000") + (fg-term-black "#000000") + (bg-term-black-bright "#595959") + (fg-term-black-bright "#595959") (bg-term-red red) (fg-term-red red) @@ -406,10 +436,10 @@ which corresponds to a minimum contrast in relative luminance of (bg-term-cyan-bright cyan-cooler) (fg-term-cyan-bright cyan-cooler) - (bg-term-white "gray65") - (fg-term-white "gray65") - (bg-term-white-bright "white") - (fg-term-white-bright "white") + (bg-term-white "#a6a6a6") + (fg-term-white "#a6a6a6") + (bg-term-white-bright "#ffffff") + (fg-term-white-bright "#ffffff") ;;;; Heading mappings @@ -451,7 +481,6 @@ Semantic color mappings have the form (MAPPING-NAME COLOR-NAME) with both as symbols. The latter is a named color that already exists in the palette and is associated with a HEX-VALUE.") - (defcustom modus-vivendi-palette-overrides nil "Overrides for `modus-vivendi-palette'. diff --git a/etc/themes/modus-vivendi-tinted-theme.el b/etc/themes/modus-vivendi-tinted-theme.el index 025257ef01c..5aa44304ee9 100644 --- a/etc/themes/modus-vivendi-tinted-theme.el +++ b/etc/themes/modus-vivendi-tinted-theme.el @@ -1,11 +1,11 @@ ;;; modus-vivendi-tinted-theme.el --- Elegant, highly legible theme with a night sky background -*- lexical-binding:t -*- -;; Copyright (C) 2019-2024 Free Software Foundation, Inc. +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> -;; URL: https://git.sr.ht/~protesilaos/modus-themes -;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes +;; Maintainer: Protesilaos Stavrou +;; URL: https://github.com/protesilaos/modus-themes +;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. @@ -125,12 +125,18 @@ which corresponds to a minimum contrast in relative luminance of (bg-magenta-subtle "#552f5f") (bg-cyan-subtle "#004065") - (bg-red-nuanced "#350f14") - (bg-green-nuanced "#002718") - (bg-yellow-nuanced "#2c1f00") - (bg-blue-nuanced "#131c4d") - (bg-magenta-nuanced "#2f133f") - (bg-cyan-nuanced "#04253f") + (bg-red-nuanced "#3a0c14") + (bg-green-nuanced "#092f1f") + (bg-yellow-nuanced "#381d0f") + (bg-blue-nuanced "#12154a") + (bg-magenta-nuanced "#2f0c3f") + (bg-cyan-nuanced "#042837") + +;;; Uncommon accent backgrounds + + (bg-ochre "#442c2f") + (bg-lavender "#38325c") + (bg-sage "#0f3d30") ;;; Graphs @@ -200,15 +206,10 @@ which corresponds to a minimum contrast in relative luminance of (bg-diff-context "#1a1f30") -;;; Uncommon accent backgrounds - - (bg-ochre "#442c2f") - (bg-lavender "#38325c") - (bg-sage "#0f3d30") - ;;; Paren match - (bg-paren-match "#2f7f9f") + (bg-paren-match "#5f789f") + (fg-paren-match fg-main) (bg-paren-expression "#453040") (underline-paren-match unspecified) @@ -217,9 +218,9 @@ which corresponds to a minimum contrast in relative luminance of ;;;; General mappings (fringe bg-dim) - (cursor magenta-warmer) + (cursor magenta-intense) - (keybind blue-cooler) + (keybind magenta-cooler) (name magenta) (identifier yellow-faint) @@ -238,6 +239,11 @@ which corresponds to a minimum contrast in relative luminance of (bg-prominent-note bg-cyan-intense) (fg-prominent-note fg-main) + (bg-active-argument bg-yellow-nuanced) + (fg-active-argument yellow-cooler) + (bg-active-value bg-cyan-nuanced) + (fg-active-value cyan-cooler) + ;;;; Code mappings (builtin magenta-warmer) @@ -337,20 +343,32 @@ which corresponds to a minimum contrast in relative luminance of (fg-prompt cyan-cooler) (bg-prompt unspecified) - (bg-space-err bg-red-intense) ;;;; Prose mappings - (prose-block fg-dim) - (prose-code cyan-cooler) + (bg-prose-block-delimiter bg-dim) + (fg-prose-block-delimiter fg-dim) + (bg-prose-block-contents bg-dim) + + (bg-prose-code unspecified) + (fg-prose-code cyan-cooler) + + (bg-prose-macro unspecified) + (fg-prose-macro magenta-cooler) + + (bg-prose-verbatim unspecified) + (fg-prose-verbatim magenta-warmer) + (prose-done green) - (prose-macro magenta-cooler) + (prose-todo red) + (prose-metadata fg-dim) (prose-metadata-value fg-alt) + (prose-table fg-alt) + (prose-table-formula magenta-warmer) + (prose-tag magenta-faint) - (prose-todo red) - (prose-verbatim magenta-warmer) ;;;; Rainbow mappings @@ -364,17 +382,29 @@ which corresponds to a minimum contrast in relative luminance of (rainbow-7 blue-warmer) (rainbow-8 magenta-warmer) +;;;; Search mappings + + (bg-search-current bg-yellow-intense) + (bg-search-lazy bg-cyan-intense) + (bg-search-replace bg-red-intense) + + (bg-search-rx-group-0 bg-blue-intense) + (bg-search-rx-group-1 bg-green-intense) + (bg-search-rx-group-2 bg-red-subtle) + (bg-search-rx-group-3 bg-magenta-subtle) + ;;;; Space mappings (bg-space unspecified) (fg-space border) + (bg-space-err bg-red-intense) ;;;; Terminal mappings - (bg-term-black "black") - (fg-term-black "black") - (bg-term-black-bright "gray35") - (fg-term-black-bright "gray35") + (bg-term-black "#000000") + (fg-term-black "#000000") + (bg-term-black-bright "#595959") + (fg-term-black-bright "#595959") (bg-term-red red) (fg-term-red red) @@ -406,10 +436,10 @@ which corresponds to a minimum contrast in relative luminance of (bg-term-cyan-bright cyan-cooler) (fg-term-cyan-bright cyan-cooler) - (bg-term-white "gray65") - (fg-term-white "gray65") - (bg-term-white-bright "white") - (fg-term-white-bright "white") + (bg-term-white "#a6a6a6") + (fg-term-white "#a6a6a6") + (bg-term-white-bright "#ffffff") + (fg-term-white-bright "#ffffff") ;;;; Heading mappings diff --git a/etc/themes/modus-vivendi-tritanopia-theme.el b/etc/themes/modus-vivendi-tritanopia-theme.el index bfd6d63b844..2327a1e9c97 100644 --- a/etc/themes/modus-vivendi-tritanopia-theme.el +++ b/etc/themes/modus-vivendi-tritanopia-theme.el @@ -1,11 +1,10 @@ ;;; modus-vivendi-tritanopia-theme.el --- Tritanopia-optimized theme with a black background -*- lexical-binding:t -*- -;; Copyright (C) 2019-2024 Free Software Foundation, Inc. +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> -;; URL: https://git.sr.ht/~protesilaos/modus-themes -;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes +;; Maintainer: Protesilaos Stavrou +;; URL: https://github.com/protesilaos/modus-themes ;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. @@ -128,12 +127,12 @@ standard)." (bg-magenta-subtle "#552f5f") (bg-cyan-subtle "#004065") - (bg-red-nuanced "#2c0614") - (bg-green-nuanced "#001904") - (bg-yellow-nuanced "#221000") - (bg-blue-nuanced "#0f0e39") - (bg-magenta-nuanced "#230631") - (bg-cyan-nuanced "#041529") + (bg-red-nuanced "#3a0c14") + (bg-green-nuanced "#092f1f") + (bg-yellow-nuanced "#381d0f") + (bg-blue-nuanced "#12154a") + (bg-magenta-nuanced "#2f0c3f") + (bg-cyan-nuanced "#042837") ;;; Uncommon accent backgrounds @@ -212,6 +211,7 @@ standard)." ;;; Paren match (bg-paren-match "#2f7f9f") + (fg-paren-match fg-main) (bg-paren-expression "#453040") (underline-paren-match unspecified) @@ -241,6 +241,11 @@ standard)." (bg-prominent-note bg-cyan-intense) (fg-prominent-note fg-main) + (bg-active-argument bg-red-nuanced) + (fg-active-argument red-warmer) + (bg-active-value bg-cyan-nuanced) + (fg-active-value cyan) + ;;;; Code mappings (builtin magenta) @@ -343,16 +348,29 @@ standard)." ;;;; Prose mappings - (prose-block fg-dim) - (prose-code cyan) + (bg-prose-block-delimiter bg-dim) + (fg-prose-block-delimiter fg-dim) + (bg-prose-block-contents bg-dim) + + (bg-prose-code unspecified) + (fg-prose-code cyan) + + (bg-prose-macro unspecified) + (fg-prose-macro red-warmer) + + (bg-prose-verbatim unspecified) + (fg-prose-verbatim magenta-warmer) + (prose-done cyan) - (prose-macro red-warmer) + (prose-todo red) + (prose-metadata fg-dim) (prose-metadata-value fg-alt) + (prose-table fg-alt) - (prose-tag fg-alt) - (prose-todo red) - (prose-verbatim magenta-warmer) + (prose-table-formula red-cooler) + + (prose-tag magenta-faint) ;;;; Rainbow mappings @@ -366,6 +384,17 @@ standard)." (rainbow-7 magenta-faint) (rainbow-8 red-faint) +;;;; Search mappings + + (bg-search-current bg-red-intense) + (bg-search-lazy bg-cyan-intense) + (bg-search-replace bg-magenta-intense) + + (bg-search-rx-group-0 bg-blue-intense) + (bg-search-rx-group-1 bg-magenta-intense) + (bg-search-rx-group-2 bg-cyan-subtle) + (bg-search-rx-group-3 bg-red-subtle) + ;;;; Space mappings (bg-space unspecified) @@ -374,10 +403,10 @@ standard)." ;;;; Terminal mappings - (bg-term-black "black") - (fg-term-black "black") - (bg-term-black-bright "gray35") - (fg-term-black-bright "gray35") + (bg-term-black "#000000") + (fg-term-black "#000000") + (bg-term-black-bright "#595959") + (fg-term-black-bright "#595959") (bg-term-red red) (fg-term-red red) @@ -409,10 +438,10 @@ standard)." (bg-term-cyan-bright cyan-cooler) (fg-term-cyan-bright cyan-cooler) - (bg-term-white "gray65") - (fg-term-white "gray65") - (bg-term-white-bright "white") - (fg-term-white-bright "white") + (bg-term-white "#a6a6a6") + (fg-term-white "#a6a6a6") + (bg-term-white-bright "#ffffff") + (fg-term-white-bright "#ffffff") ;;;; Heading mappings diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 0d54e234659..18b4a8691e9 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -817,31 +817,27 @@ or an empty string if none." cmds)) (defun vc-git-dir-extra-headers (dir) - (let ((str (vc-git--out-str "symbolic-ref" "HEAD")) + (let ((str (with-output-to-string + (with-current-buffer standard-output + (vc-git--out-ok "symbolic-ref" "HEAD")))) (stash-list (vc-git-stash-list)) (default-directory dir) (in-progress (vc-git--cmds-in-progress)) - branch remote-url stash-button stash-string tracking-branch) + branch remote remote-url stash-button stash-string) (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) (progn (setq branch (match-string 2 str)) - (let ((remote (vc-git--out-str - "config" (concat "branch." branch ".remote"))) - (merge (vc-git--out-str - "config" (concat "branch." branch ".merge")))) - (when (string-match "\\([^\n]+\\)" remote) - (setq remote (match-string 1 remote))) - (when (string-match "^\\(refs/heads/\\)?\\(.+\\)$" merge) - (setq tracking-branch (match-string 2 merge))) - (pcase remote - ("." - (setq remote-url "none (tracking local branch)")) - ((pred (not string-empty-p)) - (setq - remote-url (vc-git-repository-url dir remote) - tracking-branch (concat remote "/" tracking-branch)))))) - (setq branch "none (detached HEAD)")) + (setq remote + (with-output-to-string + (with-current-buffer standard-output + (vc-git--out-ok "config" + (concat "branch." branch ".remote"))))) + (when (string-match "\\([^\n]+\\)" remote) + (setq remote (match-string 1 remote))) + (when (> (length remote) 0) + (setq remote-url (vc-git-repository-url dir remote)))) + (setq branch "not (detached HEAD)")) (when stash-list (let* ((len (length stash-list)) (limit @@ -894,11 +890,6 @@ or an empty string if none." (propertize "Branch : " 'face 'vc-dir-header) (propertize branch 'face 'vc-dir-header-value) - (when tracking-branch - (concat - "\n" - (propertize "Tracking : " 'face 'vc-dir-header) - (propertize tracking-branch 'face 'vc-dir-header-value))) (when remote-url (concat "\n" @@ -2235,17 +2226,8 @@ The difference to vc-do-command is that this function always invokes (apply #'process-file vc-git-program nil buffer nil "--no-pager" command args))) (defun vc-git--out-ok (command &rest args) - "Run `git COMMAND ARGS...' and insert standard output in current buffer. -Return whether the process exited with status zero." (zerop (apply #'vc-git--call '(t nil) command args))) -(defun vc-git--out-str (command &rest args) - "Run `git COMMAND ARGS...' and return standard output. -The exit status is ignored." - (with-output-to-string - (with-current-buffer standard-output - (apply #'vc-git--out-ok command args)))) - (defun vc-git--run-command-string (file &rest args) "Run a git command on FILE and return its output as string. FILE can be nil." diff --git a/test/lisp/vc/vc-git-tests.el b/test/lisp/vc/vc-git-tests.el index fd3e8ccd602..c52cd9c5875 100644 --- a/test/lisp/vc/vc-git-tests.el +++ b/test/lisp/vc/vc-git-tests.el @@ -24,8 +24,6 @@ ;;; Code: -(require 'ert-x) -(require 'vc) (require 'vc-git) (ert-deftest vc-git-test-program-version-general () @@ -83,42 +81,4 @@ (should-not (vc-git-annotate-time)) (should-not (vc-git-annotate-time)))) -(defmacro vc-git-test--with-repo (name &rest body) - "Initialize a repository in a temporary directory and evaluate BODY. - -The current directory will be set to the top of that repository; NAME -will be bound to that directory's file name. Once BODY exits, the -directory will be deleted." - (declare (indent 1)) - `(ert-with-temp-directory ,name - (let ((default-directory ,name)) - (vc-create-repo 'Git) - ,@body))) - -(defun vc-git-test--run (&rest args) - "Run git ARGS…, check for non-zero status, and return output." - (with-temp-buffer - (apply 'vc-git-command t 0 nil args) - (buffer-string))) - -(ert-deftest vc-git-test-dir-track-local-branch () - "Test that `vc-dir' works when tracking local branches. Bug#68183." - (skip-unless (executable-find vc-git-program)) - (vc-git-test--with-repo repo - ;; Create an initial commit to get a branch started. - (write-region "hello" nil "README") - (vc-git-test--run "add" "README") - (vc-git-test--run "commit" "-mFirst") - ;; Get current branch name lazily, to remain agnostic of - ;; init.defaultbranch. - (let ((upstream-branch - (string-trim (vc-git-test--run "branch" "--show-current")))) - (vc-git-test--run "checkout" "--track" "-b" "hack" upstream-branch) - (vc-dir default-directory) - (pcase-dolist (`(,header ,value) - `(("Branch" "hack") - ("Tracking" ,upstream-branch))) - (goto-char (point-min)) - (re-search-forward (format "^%s *: %s$" header value)))))) - ;;; vc-git-tests.el ends here -- cgit v1.2.3 From 562d9c9db56172c754a2556a996245145ae223f5 Mon Sep 17 00:00:00 2001 From: Protesilaos Stavrou Date: Sun, 17 Mar 2024 18:49:21 +0200 Subject: Update source repository of the Modus themes * admin/MAINTAINERS: Update URL and remove outdated references. --- admin/MAINTAINERS | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index ec719744339..4fa65a8df24 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -381,9 +381,7 @@ Tramp Modus themes Maintainer: Protesilaos Stavrou - Repository: https://git.sr.ht/~protesilaos - Mailing list: https://lists.sr.ht/~protesilaos/modus-themes - Bug Reports: M-x modus-themes-report-bug + Repository: https://github.com/protesilaos/modus-themes doc/misc/modus-themes.org etc/themes/modus*.el -- cgit v1.2.3 From c29b6df2273347946d5b8c88b5dee39d8d6fd202 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 17 Mar 2024 19:57:05 +0200 Subject: * lisp/tab-bar.el (tab-bar-select-restore-windows): New defcustom. (tab-bar-select-restore-windows): New function. (tab-bar-select-tab): Let-bind window-restore-killed-buffer-windows to tab-bar-select-restore-windows (bug#68235). --- etc/NEWS | 7 +++++++ lisp/tab-bar.el | 54 +++++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 60 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index 50f0ee4a1aa..b02712dd21c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -291,6 +291,13 @@ corresponding configuration or state was recorded. ** Tab Bars and Tab Lines +--- +*** New user option 'tab-bar-select-restore-windows'. +It defines what to do with windows whose buffer was killed +since the tab was last selected. By default it displays +a placeholder buffer that provides information about the name +of the killed buffer that was displayed in that window. + --- *** New user option 'tab-bar-tab-name-format-functions'. It can be used to add, remove and reorder functions that change diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 61efa332e0b..fa22500a04e 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1393,6 +1393,55 @@ and the newly selected tab." :group 'tab-bar :version "30.1") +(defcustom tab-bar-select-restore-windows #'tab-bar-select-restore-windows + "Function called when selecting a tab to handle windows whose buffer was killed. +When a tab-bar tab displays a window whose buffer was killed since +this tab was last selected, this function determines what to do with +that window. By default, either a random buffer is displayed instead of +the killed buffer, or the window gets deleted. However, with the help +of `window-restore-killed-buffer-windows' it's possible to handle such +situations better by displaying an information about the killed buffer." + :type '(choice (const :tag "No special handling" nil) + (const :tag "Show placeholder buffers" + tab-bar-select-restore-windows) + (function :tag "Function")) + :group 'tab-bar + :version "30.1") + +(defun tab-bar-select-restore-windows (_frame windows _type) + "Display a placeholder buffer in the window whose buffer was killed. +A button in the window allows to restore the killed buffer, +if it was visiting a file." + (dolist (quad windows) + (when (window-live-p (nth 0 quad)) + (let* ((window (nth 0 quad)) + (old-buffer (nth 1 quad)) + (file (when (bufferp old-buffer) + (buffer-file-name old-buffer))) + (name (or file + (and (bufferp old-buffer) + (fboundp 'buffer-last-name) + (buffer-last-name old-buffer)) + old-buffer)) + (new-buffer (generate-new-buffer + (format "*Old buffer %s*" name)))) + (with-current-buffer new-buffer + (set-auto-mode) + (insert (format-message "This window displayed the %s `%s'.\n" + (if file "file" "buffer") + name)) + (when file + (insert-button + "[Restore]" 'action + (lambda (_button) + (set-window-buffer window (find-file-noselect file)) + (set-window-start window (nth 2 quad) t) + (set-window-point window (nth 3 quad)))) + (insert "\n")) + (goto-char (point-min)) + (setq buffer-read-only t) + (set-window-buffer window new-buffer)))))) + (defvar tab-bar-minibuffer-restore-tab nil "Tab number for `tab-bar-minibuffer-restore-tab'.") @@ -1438,7 +1487,10 @@ Negative TAB-NUMBER counts tabs from the end of the tab bar." (let* ((from-tab (tab-bar--tab)) (to-tab (nth to-index tabs)) (wc (alist-get 'wc to-tab)) - (ws (alist-get 'ws to-tab))) + (ws (alist-get 'ws to-tab)) + (window-restore-killed-buffer-windows + (or tab-bar-select-restore-windows + window-restore-killed-buffer-windows))) ;; During the same session, use window-configuration to switch ;; tabs, because window-configurations are more reliable -- cgit v1.2.3 From 8d4a8b7dfd0905defac172cc58c2252dc1b39ad7 Mon Sep 17 00:00:00 2001 From: Kévin Le Gouguec Date: Mon, 12 Feb 2024 08:29:19 +0100 Subject: ; Re-apply accidentally reverted commit This re-applies: 2024-03-17 "Fix vc-dir when "remote" Git branch is local" (21828f288ef) reverted as part of the unrelated: 2024-03-17 "Update modus-themes to their 4.4.0 version" (67b0c1c09ea) The original commit message follows: Fix vc-dir when "remote" Git branch is local While in there, add that "tracking" branch to the vc-dir buffer. For bug#68183. * lisp/vc/vc-git.el (vc-git-dir-extra-headers): Reduce boilerplate with new function 'vc-git--out-ok'; stop calling vc-git-repository-url when REMOTE is "." to avoid throwing an error; display tracking branch; prefer "none ()" to "not ()" since that reads more grammatically correct. (vc-git--out-ok): Add documentation. (vc-git--out-str): New function to easily get the output from a Git command. * test/lisp/vc/vc-git-tests.el (vc-git-test--with-repo) (vc-git-test--run): New helpers, defined to steer clear of vc-git-- internal functions. (vc-git-test-dir-track-local-branch): Check that vc-dir does not crash. --- lisp/vc/vc-git.el | 46 ++++++++++++++++++++++++++++++-------------- test/lisp/vc/vc-git-tests.el | 40 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 72 insertions(+), 14 deletions(-) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 18b4a8691e9..0d54e234659 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -817,27 +817,31 @@ or an empty string if none." cmds)) (defun vc-git-dir-extra-headers (dir) - (let ((str (with-output-to-string - (with-current-buffer standard-output - (vc-git--out-ok "symbolic-ref" "HEAD")))) + (let ((str (vc-git--out-str "symbolic-ref" "HEAD")) (stash-list (vc-git-stash-list)) (default-directory dir) (in-progress (vc-git--cmds-in-progress)) - branch remote remote-url stash-button stash-string) + branch remote-url stash-button stash-string tracking-branch) (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) (progn (setq branch (match-string 2 str)) - (setq remote - (with-output-to-string - (with-current-buffer standard-output - (vc-git--out-ok "config" - (concat "branch." branch ".remote"))))) - (when (string-match "\\([^\n]+\\)" remote) - (setq remote (match-string 1 remote))) - (when (> (length remote) 0) - (setq remote-url (vc-git-repository-url dir remote)))) - (setq branch "not (detached HEAD)")) + (let ((remote (vc-git--out-str + "config" (concat "branch." branch ".remote"))) + (merge (vc-git--out-str + "config" (concat "branch." branch ".merge")))) + (when (string-match "\\([^\n]+\\)" remote) + (setq remote (match-string 1 remote))) + (when (string-match "^\\(refs/heads/\\)?\\(.+\\)$" merge) + (setq tracking-branch (match-string 2 merge))) + (pcase remote + ("." + (setq remote-url "none (tracking local branch)")) + ((pred (not string-empty-p)) + (setq + remote-url (vc-git-repository-url dir remote) + tracking-branch (concat remote "/" tracking-branch)))))) + (setq branch "none (detached HEAD)")) (when stash-list (let* ((len (length stash-list)) (limit @@ -890,6 +894,11 @@ or an empty string if none." (propertize "Branch : " 'face 'vc-dir-header) (propertize branch 'face 'vc-dir-header-value) + (when tracking-branch + (concat + "\n" + (propertize "Tracking : " 'face 'vc-dir-header) + (propertize tracking-branch 'face 'vc-dir-header-value))) (when remote-url (concat "\n" @@ -2226,8 +2235,17 @@ The difference to vc-do-command is that this function always invokes (apply #'process-file vc-git-program nil buffer nil "--no-pager" command args))) (defun vc-git--out-ok (command &rest args) + "Run `git COMMAND ARGS...' and insert standard output in current buffer. +Return whether the process exited with status zero." (zerop (apply #'vc-git--call '(t nil) command args))) +(defun vc-git--out-str (command &rest args) + "Run `git COMMAND ARGS...' and return standard output. +The exit status is ignored." + (with-output-to-string + (with-current-buffer standard-output + (apply #'vc-git--out-ok command args)))) + (defun vc-git--run-command-string (file &rest args) "Run a git command on FILE and return its output as string. FILE can be nil." diff --git a/test/lisp/vc/vc-git-tests.el b/test/lisp/vc/vc-git-tests.el index c52cd9c5875..fd3e8ccd602 100644 --- a/test/lisp/vc/vc-git-tests.el +++ b/test/lisp/vc/vc-git-tests.el @@ -24,6 +24,8 @@ ;;; Code: +(require 'ert-x) +(require 'vc) (require 'vc-git) (ert-deftest vc-git-test-program-version-general () @@ -81,4 +83,42 @@ (should-not (vc-git-annotate-time)) (should-not (vc-git-annotate-time)))) +(defmacro vc-git-test--with-repo (name &rest body) + "Initialize a repository in a temporary directory and evaluate BODY. + +The current directory will be set to the top of that repository; NAME +will be bound to that directory's file name. Once BODY exits, the +directory will be deleted." + (declare (indent 1)) + `(ert-with-temp-directory ,name + (let ((default-directory ,name)) + (vc-create-repo 'Git) + ,@body))) + +(defun vc-git-test--run (&rest args) + "Run git ARGS…, check for non-zero status, and return output." + (with-temp-buffer + (apply 'vc-git-command t 0 nil args) + (buffer-string))) + +(ert-deftest vc-git-test-dir-track-local-branch () + "Test that `vc-dir' works when tracking local branches. Bug#68183." + (skip-unless (executable-find vc-git-program)) + (vc-git-test--with-repo repo + ;; Create an initial commit to get a branch started. + (write-region "hello" nil "README") + (vc-git-test--run "add" "README") + (vc-git-test--run "commit" "-mFirst") + ;; Get current branch name lazily, to remain agnostic of + ;; init.defaultbranch. + (let ((upstream-branch + (string-trim (vc-git-test--run "branch" "--show-current")))) + (vc-git-test--run "checkout" "--track" "-b" "hack" upstream-branch) + (vc-dir default-directory) + (pcase-dolist (`(,header ,value) + `(("Branch" "hack") + ("Tracking" ,upstream-branch))) + (goto-char (point-min)) + (re-search-forward (format "^%s *: %s$" header value)))))) + ;;; vc-git-tests.el ends here -- cgit v1.2.3 From 1a8b34a503e5af32851c1aac27a3f09e2345673b Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 18 Mar 2024 09:14:18 +0800 Subject: Makeshift solution for X server bug * src/xterm.c (x_sync_init_fences): Detect errors around XSyncCreateFence. (bug#69762) --- src/xterm.c | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/xterm.c b/src/xterm.c index c30015ec8f0..b30a2485148 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -7292,6 +7292,11 @@ x_sync_init_fences (struct frame *f) && dpyinfo->xsync_minor < 1)) return; + /* Suppress errors around XSyncCreateFence requests, since its + implementations on certain X servers erroneously reject valid + drawables, such as the frame's inner window. (bug#69762) */ + + x_catch_errors (dpyinfo->display); output->sync_fences[0] = XSyncCreateFence (FRAME_X_DISPLAY (f), /* The drawable given below is only used to @@ -7303,6 +7308,9 @@ x_sync_init_fences (struct frame *f) = XSyncCreateFence (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), False); + if (x_had_errors_p (dpyinfo->display)) + output->sync_fences[1] = output->sync_fences[0] = None; + x_uncatch_errors_after_check (); XChangeProperty (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), dpyinfo->Xatom_net_wm_sync_fences, XA_CARDINAL, -- cgit v1.2.3 From 706403f2aa3a306369a0150022da0cba1802ca2b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 12 Mar 2024 09:26:24 -0400 Subject: (cl-type-of): New function to return more precise types (bug#69739) * src/data.c (Fcl_type_of): New function, extracted from `Ftype_of`. Make it return more precise types for symbols, integers, and subrs. (Ftype_of): Use it. (syms_of_data): Define the corresponding new symbols and defsubr the new function. * doc/lispref/objects.texi (Type Predicates): Document it. * src/comp.c (emit_limple_insn): Use `Fcl_type_of`. * lisp/emacs-lisp/cl-preloaded.el (subr): Demote it to `atom`. (subr-native-elisp, subr-primitive): Add `compiled-function` as parent instead. (special-form): New type. * lisp/obsolete/eieio-core.el (cl--generic-struct-tag): * lisp/emacs-lisp/cl-generic.el (cl--generic-typeof-generalizer): Use `cl-type-of`. cl--generic--unreachable-types): Update accordingly. test/src/data-tests.el (data-tests--cl-type-of): New test. --- doc/lispref/objects.texi | 21 +++++++++++++++++++++ etc/NEWS | 5 +++++ lisp/emacs-lisp/cl-generic.el | 6 ++---- lisp/emacs-lisp/cl-preloaded.el | 12 ++++++------ lisp/emacs-lisp/eieio-core.el | 2 +- src/comp.c | 2 +- src/data.c | 40 +++++++++++++++++++++++++++++++++++----- test/src/data-tests.el | 37 +++++++++++++++++++++++++++++++++++++ 8 files changed, 108 insertions(+), 17 deletions(-) diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 279f449a994..1e448b64296 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -2207,6 +2207,27 @@ slot is returned; @ref{Records}. @end example @end defun +@defun cl-type-of object +This function returns a symbol naming @emph{the} type of +@var{object}. It usually behaves like @code{type-of}, except +that it guarantees to return the most precise type possible, which also +implies that the specific type it returns may change depending on the +Emacs version. For this reason, as a rule you should never compare its +return value against some fixed set of types. + +@example +(cl-type-of 1) + @result{} fixnum +@group +(cl-type-of 'nil) + @result{} null +(cl-type-of (record 'foo)) + @result{} foo +@end group +@end example +@end defun + + @node Equality Predicates @section Equality Predicates @cindex equality diff --git a/etc/NEWS b/etc/NEWS index b02712dd21c..b522fbd338b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1647,6 +1647,11 @@ values. * Lisp Changes in Emacs 30.1 +** New function 'cl-type-of'. +This function is like 'type-of' except that it sometimes returns +a more precise type. For example, for nil and t it returns 'null' +and 'boolean' respectively, instead of just 'symbol'. + ** Built-in types have now corresponding classes. At the Lisp level, this means that things like (cl-find-class 'integer) will now return a class object, and at the UI level it means that diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 613ecf82a92..62abe8d1589 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1334,8 +1334,7 @@ These match if the argument is `eql' to VAL." (defconst cl--generic--unreachable-types ;; FIXME: Try to make that list empty? - '(fixnum bignum boolean keyword - special-form subr-primitive subr-native-elisp) + '(keyword) "Built-in classes on which we cannot dispatch for technical reasons.") (defun cl--generic-type-specializers (tag &rest _) @@ -1345,8 +1344,7 @@ These match if the argument is `eql' to VAL." (cl--class-allparents class))))) (cl-generic-define-generalizer cl--generic-typeof-generalizer - ;; FIXME: We could also change `type-of' to return `null' for nil. - 10 (lambda (name &rest _) `(if ,name (type-of ,name) 'null)) + 10 (lambda (name &rest _) `(cl-type-of ,name)) #'cl--generic-type-specializers) (cl-defmethod cl-generic-generalizers :extra "typeof" (type) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 515aa99549d..3e89afea452 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -339,8 +339,6 @@ ',parents)))))) ;; FIXME: Our type DAG has various quirks: -;; - `subr' says it's a `compiled-function' but that's not true -;; for those subrs that are special forms! ;; - Some `keyword's are also `symbol-with-pos' but that's not reflected ;; in the DAG. ;; - An OClosure can be an interpreted function or a `byte-code-function', @@ -428,15 +426,17 @@ For this build of Emacs it's %dbit." "Abstract type of functions that have been compiled.") (cl--define-built-in-type byte-code-function (compiled-function) "Type of functions that have been byte-compiled.") -(cl--define-built-in-type subr (compiled-function) +(cl--define-built-in-type subr (atom) "Abstract type of functions compiled to machine code.") (cl--define-built-in-type module-function (function) "Type of functions provided via the module API.") (cl--define-built-in-type interpreted-function (function) "Type of functions that have not been compiled.") -(cl--define-built-in-type subr-native-elisp (subr) - "Type of function that have been compiled by the native compiler.") -(cl--define-built-in-type subr-primitive (subr) +(cl--define-built-in-type special-form (subr) + "Type of the core syntactic elements of the Emacs Lisp language.") +(cl--define-built-in-type subr-native-elisp (subr compiled-function) + "Type of functions that have been compiled by the native compiler.") +(cl--define-built-in-type subr-primitive (subr compiled-function) "Type of functions hand written in C.") (unless (cl--class-parents (cl--find-class 'cl-structure-object)) diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index a2f7c4172a3..cf8bd749f2a 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -1046,7 +1046,7 @@ method invocation orders of the involved classes." (defun cl--generic-struct-tag (name &rest _) ;; Use exactly the same code as for `typeof'. - `(if ,name (type-of ,name) 'null)) + `(cl-type-of ,name)) (cl-generic-define-generalizer eieio--generic-generalizer ;; Use the exact same tagcode as for cl-struct, so that methods diff --git a/src/comp.c b/src/comp.c index 3f989c722d4..76cf1f3ab6e 100644 --- a/src/comp.c +++ b/src/comp.c @@ -2442,7 +2442,7 @@ emit_limple_insn (Lisp_Object insn) { Lisp_Object arg1 = arg[1]; - if (EQ (Ftype_of (arg1), Qcomp_mvar)) + if (EQ (Fcl_type_of (arg1), Qcomp_mvar)) res = emit_mvar_rval (arg1); else if (EQ (FIRST (arg1), Qcall)) res = emit_limple_call (XCDR (arg1)); diff --git a/src/data.c b/src/data.c index 35f4c82c68f..5d6b6e0ba9d 100644 --- a/src/data.c +++ b/src/data.c @@ -193,16 +193,37 @@ DEFUN ("null", Fnull, Snull, 1, 1, 0, DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0, doc: /* Return a symbol representing the type of OBJECT. The symbol returned names the object's basic type; -for example, (type-of 1) returns `integer'. */) +for example, (type-of 1) returns `integer'. +Contrary to `cl-type-of', the returned type is not always the most +precise type possible, because instead this function tries to preserve +compatibility with the return value of previous Emacs versions. */) + (Lisp_Object object) +{ + return SYMBOLP (object) ? Qsymbol + : INTEGERP (object) ? Qinteger + : SUBRP (object) ? Qsubr + : Fcl_type_of (object); +} + +DEFUN ("cl-type-of", Fcl_type_of, Scl_type_of, 1, 1, 0, + doc: /* Return a symbol representing the type of OBJECT. +The returned symbol names the most specific possible type of the object. +for example, (cl-type-of nil) returns `null'. +The specific type returned may change depending on Emacs versions, +so we recommend you use `cl-typep', `cl-typecase', or other predicates +rather than compare the return value of this function against +a fixed set of types. */) (Lisp_Object object) { switch (XTYPE (object)) { case_Lisp_Int: - return Qinteger; + return Qfixnum; case Lisp_Symbol: - return Qsymbol; + return NILP (object) ? Qnull + : EQ (object, Qt) ? Qboolean + : Qsymbol; case Lisp_String: return Qstring; @@ -215,7 +236,7 @@ for example, (type-of 1) returns `integer'. */) switch (PSEUDOVECTOR_TYPE (XVECTOR (object))) { case PVEC_NORMAL_VECTOR: return Qvector; - case PVEC_BIGNUM: return Qinteger; + case PVEC_BIGNUM: return Qbignum; case PVEC_MARKER: return Qmarker; case PVEC_SYMBOL_WITH_POS: return Qsymbol_with_pos; case PVEC_OVERLAY: return Qoverlay; @@ -224,7 +245,10 @@ for example, (type-of 1) returns `integer'. */) case PVEC_WINDOW_CONFIGURATION: return Qwindow_configuration; case PVEC_PROCESS: return Qprocess; case PVEC_WINDOW: return Qwindow; - case PVEC_SUBR: return Qsubr; + case PVEC_SUBR: + return XSUBR (object)->max_args == UNEVALLED ? Qspecial_form + : SUBR_NATIVE_COMPILEDP (object) ? Qsubr_native_elisp + : Qsubr_primitive; case PVEC_COMPILED: return Qcompiled_function; case PVEC_BUFFER: return Qbuffer; case PVEC_CHAR_TABLE: return Qchar_table; @@ -4202,7 +4226,9 @@ syms_of_data (void) "Variable binding depth exceeds max-specpdl-size"); /* Types that type-of returns. */ + DEFSYM (Qboolean, "boolean"); DEFSYM (Qinteger, "integer"); + DEFSYM (Qbignum, "bignum"); DEFSYM (Qsymbol, "symbol"); DEFSYM (Qstring, "string"); DEFSYM (Qcons, "cons"); @@ -4218,6 +4244,9 @@ syms_of_data (void) DEFSYM (Qprocess, "process"); DEFSYM (Qwindow, "window"); DEFSYM (Qsubr, "subr"); + DEFSYM (Qspecial_form, "special-form"); + DEFSYM (Qsubr_primitive, "subr-primitive"); + DEFSYM (Qsubr_native_elisp, "subr-native-elisp"); DEFSYM (Qcompiled_function, "compiled-function"); DEFSYM (Qbuffer, "buffer"); DEFSYM (Qframe, "frame"); @@ -4255,6 +4284,7 @@ syms_of_data (void) defsubr (&Seq); defsubr (&Snull); defsubr (&Stype_of); + defsubr (&Scl_type_of); defsubr (&Slistp); defsubr (&Snlistp); defsubr (&Sconsp); diff --git a/test/src/data-tests.el b/test/src/data-tests.el index ad3b2071254..9d76c58224d 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -838,4 +838,41 @@ comparing the subr with a much slower Lisp implementation." (dolist (sym (list nil t 'xyzzy (make-symbol ""))) (should (eq sym (bare-symbol (position-symbol sym 0))))))) +(require 'cl-extra) ;For `cl--class-children'. + +(ert-deftest data-tests--cl-type-of () + ;; Make sure that `cl-type-of' returns the most precise type. + ;; Note: This doesn't work for list/vector structs since those types + ;; are too difficult/unreliable to detect (so `cl-type-of' only says + ;; it's a `cons' or a `vector'). + (dolist (val (list -2 10 (expt 2 128) nil t 'car + (symbol-function 'car) + (symbol-function 'progn) + (position-symbol 'car 7))) + (let* ((type (cl-type-of val)) + (class (cl-find-class type)) + (alltypes (cl--class-allparents class)) + ;; FIXME: Our type DAG is affected by `symbols-with-pos-enabled'. + ;; (e.g. `symbolp' returns nil on a sympos if that var is nil). + (symbols-with-pos-enabled t)) + (dolist (parent alltypes) + (should (cl-typep val parent)) + (dolist (subtype (cl--class-children (cl-find-class parent))) + (unless (memq subtype alltypes) + (unless (memq subtype + ;; FIXME: Some types don't have any associated + ;; predicate, + '( font-spec font-entity font-object + finalizer condvar terminal + native-comp-unit interpreted-function + tree-sitter-compiled-query + tree-sitter-node tree-sitter-parser + ;; `functionp' also matches things of type + ;; `symbol' and `cons'. + ;; FIXME: `subr-primitive-p' also matches + ;; special-forms. + function subr-primitive)) + (should-not (cl-typep val subtype))))))))) + + ;;; data-tests.el ends here -- cgit v1.2.3 From e624bc62752ceb2e60940c5fd9cb6e70611df71c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 17 Mar 2024 17:29:02 -0400 Subject: (primitive-function): New type The type hierarchy and `cl-type-of` code assumed that `subr-primitive` only applies to functions, but since it also accepts special-forms it makes it an unsuitable choice since it can't be a subtype of `compiled-function`. So, use a new type `primitive-function` instead. * lisp/subr.el (subr-primitive-p): Fix docstring (bug#69832). (primitive-function-p): New function. * lisp/emacs-lisp/cl-preloaded.el (primitive-function): Rename from `subr-primitive` since `subr-primitive-p` means something else. * src/data.c (Fcl_type_of): Return `primitive-function` instead of `subr-primitive` for C functions. (syms_of_data): Adjust accordingly. * test/src/data-tests.el (data-tests--cl-type-of): Remove workaround. --- etc/NEWS | 4 ++++ lisp/emacs-lisp/cl-preloaded.el | 2 +- lisp/subr.el | 11 ++++++++++- src/data.c | 4 ++-- test/src/data-tests.el | 4 +--- 5 files changed, 18 insertions(+), 7 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index b522fbd338b..69e61d91b0e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1652,6 +1652,10 @@ This function is like 'type-of' except that it sometimes returns a more precise type. For example, for nil and t it returns 'null' and 'boolean' respectively, instead of just 'symbol'. +** New function `primitive-function-p`. +This is like `subr-primitive-p` except that it returns t only if the +argument is a function rather than a special-form. + ** Built-in types have now corresponding classes. At the Lisp level, this means that things like (cl-find-class 'integer) will now return a class object, and at the UI level it means that diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 3e89afea452..d11c97a3e3a 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -436,7 +436,7 @@ For this build of Emacs it's %dbit." "Type of the core syntactic elements of the Emacs Lisp language.") (cl--define-built-in-type subr-native-elisp (subr compiled-function) "Type of functions that have been compiled by the native compiler.") -(cl--define-built-in-type subr-primitive (subr compiled-function) +(cl--define-built-in-type primitive-function (subr compiled-function) "Type of functions hand written in C.") (unless (cl--class-parents (cl--find-class 'cl-structure-object)) diff --git a/lisp/subr.el b/lisp/subr.el index 38a3f6edb34..3de4412637f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -312,11 +312,20 @@ value of last one, or nil if there are none." cond '(empty-body unless) t))) (defsubst subr-primitive-p (object) - "Return t if OBJECT is a built-in primitive function." + "Return t if OBJECT is a built-in primitive written in C. +Such objects can be functions or special forms." (declare (side-effect-free error-free)) (and (subrp object) (not (subr-native-elisp-p object)))) +(defsubst primitive-function-p (object) + "Return t if OBJECT is a built-in primitive function. +This excludes special forms, since they are not functions." + (declare (side-effect-free error-free)) + (and (subrp object) + (not (or (subr-native-elisp-p object) + (eq (cdr (subr-arity object)) 'unevalled))))) + (defsubst xor (cond1 cond2) "Return the boolean exclusive-or of COND1 and COND2. If only one of the arguments is non-nil, return it; otherwise diff --git a/src/data.c b/src/data.c index 5d6b6e0ba9d..69b990bed76 100644 --- a/src/data.c +++ b/src/data.c @@ -248,7 +248,7 @@ a fixed set of types. */) case PVEC_SUBR: return XSUBR (object)->max_args == UNEVALLED ? Qspecial_form : SUBR_NATIVE_COMPILEDP (object) ? Qsubr_native_elisp - : Qsubr_primitive; + : Qprimitive_function; case PVEC_COMPILED: return Qcompiled_function; case PVEC_BUFFER: return Qbuffer; case PVEC_CHAR_TABLE: return Qchar_table; @@ -4245,7 +4245,7 @@ syms_of_data (void) DEFSYM (Qwindow, "window"); DEFSYM (Qsubr, "subr"); DEFSYM (Qspecial_form, "special-form"); - DEFSYM (Qsubr_primitive, "subr-primitive"); + DEFSYM (Qprimitive_function, "primitive-function"); DEFSYM (Qsubr_native_elisp, "subr-native-elisp"); DEFSYM (Qcompiled_function, "compiled-function"); DEFSYM (Qbuffer, "buffer"); diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 9d76c58224d..daa49e671b5 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -869,9 +869,7 @@ comparing the subr with a much slower Lisp implementation." tree-sitter-node tree-sitter-parser ;; `functionp' also matches things of type ;; `symbol' and `cons'. - ;; FIXME: `subr-primitive-p' also matches - ;; special-forms. - function subr-primitive)) + function)) (should-not (cl-typep val subtype))))))))) -- cgit v1.2.3 From 63e67916b01569da5bb24f6d9a354dc72897c468 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 14 Mar 2024 12:49:08 -0400 Subject: Followup changes to `cl-type-of` These changes came up while working on `cl-type-of` but are not directly related to the new `cl-type-of`. The BASE_PURESIZE bump was needed at some point on one of my machine, not sure why. * src/puresize.h (BASE_PURESIZE): Bump up. * src/sqlite.c (bind_value): Don't use `Ftype_of`. * lisp/emacs-lisp/seq.el (seq-remove-at-position): Simplify. * lisp/emacs-lisp/cl-preloaded.el (finalizer): New (previously missing) type. * doc/lispref/objects.texi (Type Predicates): Minor tweaks. --- doc/lispref/objects.texi | 6 +++--- lisp/emacs-lisp/cl-preloaded.el | 1 + lisp/emacs-lisp/seq.el | 3 +-- src/lisp.h | 6 ++---- src/puresize.h | 2 +- src/sqlite.c | 17 ++++++----------- 6 files changed, 14 insertions(+), 21 deletions(-) diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 1e448b64296..aa1e073042f 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -1485,8 +1485,8 @@ types that are not built into Emacs. @subsection Type Descriptors A @dfn{type descriptor} is a @code{record} which holds information -about a type. Slot 1 in the record must be a symbol naming the type, and -@code{type-of} relies on this to return the type of @code{record} +about a type. The first slot in the record must be a symbol naming the type, +and @code{type-of} relies on this to return the type of @code{record} objects. No other type descriptor slot is used by Emacs; they are free for use by Lisp extensions. @@ -2175,7 +2175,7 @@ with references to further information. function @code{type-of}. Recall that each object belongs to one and only one primitive type; @code{type-of} tells you which one (@pxref{Lisp Data Types}). But @code{type-of} knows nothing about non-primitive -types. In most cases, it is more convenient to use type predicates than +types. In most cases, it is preferable to use type predicates than @code{type-of}. @defun type-of object diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index d11c97a3e3a..cba56e0bbd4 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -365,6 +365,7 @@ (cl--define-built-in-type buffer atom) (cl--define-built-in-type window atom) (cl--define-built-in-type process atom) +(cl--define-built-in-type finalizer atom) (cl--define-built-in-type window-configuration atom) (cl--define-built-in-type overlay atom) (cl--define-built-in-type number-or-marker atom diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 20077db9e60..a20cff16982 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -362,8 +362,7 @@ the result. The result is a sequence of the same type as SEQUENCE." (seq-concatenate - (let ((type (type-of sequence))) - (if (eq type 'cons) 'list type)) + (if (listp sequence) 'list (type-of sequence)) (seq-subseq sequence 0 n) (seq-subseq sequence (1+ n)))) diff --git a/src/lisp.h b/src/lisp.h index f353e4956eb..f86758c88fb 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -569,10 +569,8 @@ enum Lisp_Fwd_Type your object -- this way, the same object could be used to represent several disparate C structures. - In addition, you need to add switch branches in data.c for Ftype_of. - - You also need to add the new type to the constant - `cl--typeof-types' in lisp/emacs-lisp/cl-preloaded.el. */ + In addition, you need to add switch branches in data.c for Fcl_type_of + and `cl--define-builtin-type` in lisp/emacs-lisp/cl-preloaded.el. */ /* A Lisp_Object is a tagged pointer or integer. Ordinarily it is a diff --git a/src/puresize.h b/src/puresize.h index ac5d2da30dc..2a716872832 100644 --- a/src/puresize.h +++ b/src/puresize.h @@ -47,7 +47,7 @@ INLINE_HEADER_BEGIN #endif #ifndef BASE_PURESIZE -#define BASE_PURESIZE (2750000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) +#define BASE_PURESIZE (3000000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) #endif /* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */ diff --git a/src/sqlite.c b/src/sqlite.c index 7a018b28aa4..261080da673 100644 --- a/src/sqlite.c +++ b/src/sqlite.c @@ -349,9 +349,7 @@ bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object values) value = XCAR (values); values = XCDR (values); } - Lisp_Object type = Ftype_of (value); - - if (EQ (type, Qstring)) + if (STRINGP (value)) { Lisp_Object encoded; bool blob = false; @@ -385,14 +383,11 @@ bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object values) SSDATA (encoded), SBYTES (encoded), NULL); } - else if (EQ (type, Qinteger)) - { - if (BIGNUMP (value)) - ret = sqlite3_bind_int64 (stmt, i + 1, bignum_to_intmax (value)); - else - ret = sqlite3_bind_int64 (stmt, i + 1, XFIXNUM (value)); - } - else if (EQ (type, Qfloat)) + else if (FIXNUMP (value)) + ret = sqlite3_bind_int64 (stmt, i + 1, XFIXNUM (value)); + else if (BIGNUMP (value)) + ret = sqlite3_bind_int64 (stmt, i + 1, bignum_to_intmax (value)); + else if (FLOATP (value)) ret = sqlite3_bind_double (stmt, i + 1, XFLOAT_DATA (value)); else if (NILP (value)) ret = sqlite3_bind_null (stmt, i + 1); -- cgit v1.2.3 From 70ac815ece299007ff468c09632ef4d488e69be3 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 18 Mar 2024 09:38:23 -0400 Subject: * lisp/emacs-lisp/cl-preloaded.el (user-ptr): Add predicate --- lisp/emacs-lisp/cl-preloaded.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index cba56e0bbd4..f7757eae9c0 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -328,7 +328,9 @@ (:predicate (setq predicate val)) (_ (error "Unknown keyword arg: %S" kw))))) `(progn - ,(if predicate `(put ',name 'cl-deftype-satisfies #',predicate)) + ,(if predicate `(put ',name 'cl-deftype-satisfies #',predicate) + ;; (message "Missing predicate for: %S" name) + nil) (put ',name 'cl--class (built-in-class--make ',name ,docstring (mapcar (lambda (type) @@ -352,7 +354,8 @@ (cl--define-built-in-type tree-sitter-compiled-query atom) (cl--define-built-in-type tree-sitter-node atom) (cl--define-built-in-type tree-sitter-parser atom) -(cl--define-built-in-type user-ptr atom) +(cl--define-built-in-type user-ptr atom + nil :predicate user-ptrp) ;; FIXME: Shouldn't it be called `user-ptr-p'? (cl--define-built-in-type font-object atom) (cl--define-built-in-type font-entity atom) (cl--define-built-in-type font-spec atom) -- cgit v1.2.3 From ce29ae32d0b05cedbc9ba65c1a347ab7c34420ad Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 18 Mar 2024 15:59:54 +0200 Subject: ; * lisp/vc/vc-git.el (vc-git--out-str): Doc fix. --- lisp/emacs-lisp/shortdoc.el | 2 +- lisp/vc/vc-git.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index cbb5618ffce..a1e49b50510 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1781,7 +1781,7 @@ With prefix numeric argument ARG, do it that many times." (interactive) (save-excursion (goto-char (pos-bol)) - (when-let* ((re (rx bol "(" (group (+ (not (in " ")))))) + (when-let* ((re (rx bol "(" (group (+ (not (in " )")))))) (string (and (or (looking-at re) (re-search-backward re nil t)) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 0d54e234659..b23a5ca95a1 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -2240,7 +2240,7 @@ Return whether the process exited with status zero." (zerop (apply #'vc-git--call '(t nil) command args))) (defun vc-git--out-str (command &rest args) - "Run `git COMMAND ARGS...' and return standard output. + "Run `git COMMAND ARGS...' and return standard output as a string. The exit status is ignored." (with-output-to-string (with-current-buffer standard-output -- cgit v1.2.3 From f2e239c6a7d54ec3849a3bb783685953b6683752 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 19 Mar 2024 12:08:17 +0800 Subject: Respect display names of Android content URIs * java/org/gnu/emacs/EmacsNative.java (displayNameHash): New function. * java/org/gnu/emacs/EmacsService.java (buildContentName): New argument RESOLVER. Generate names holding URI's display name if available. All callers changed. * lisp/international/mule-cmds.el (set-default-coding-systems): Fix file name coding system as utf-8-unix on Android as on Mac OS. * src/androidvfs.c (enum android_vnode_type): New enum ANDROID_VNODE_CONTENT_AUTHORITY_NAMED. (android_content_name): Register root directories for this new type. (displayNameHash): New function. (android_get_content_name): New argument WITH_CHECKSUM. If present, treat the final two components as a pair of checksum and display name, and verify and exclude the two. (android_authority_name): Provide new argument as appropriate. (android_authority_initial_name): New function. --- java/org/gnu/emacs/EmacsNative.java | 10 +- java/org/gnu/emacs/EmacsOpenActivity.java | 9 +- java/org/gnu/emacs/EmacsService.java | 80 +++++++++++++++- lisp/international/mule-cmds.el | 7 +- src/androidvfs.c | 150 +++++++++++++++++++++++++++--- 5 files changed, 231 insertions(+), 25 deletions(-) diff --git a/java/org/gnu/emacs/EmacsNative.java b/java/org/gnu/emacs/EmacsNative.java index 898eaef41a7..654e94b1a7d 100644 --- a/java/org/gnu/emacs/EmacsNative.java +++ b/java/org/gnu/emacs/EmacsNative.java @@ -281,7 +281,7 @@ public final class EmacsNative public static native int[] getSelection (short window); - /* Graphics functions used as a replacement for potentially buggy + /* Graphics functions used as replacements for potentially buggy Android APIs. */ public static native void blitRect (Bitmap src, Bitmap dest, int x1, @@ -289,7 +289,6 @@ public final class EmacsNative /* Increment the generation ID of the specified BITMAP, forcing its texture to be re-uploaded to the GPU. */ - public static native void notifyPixelsChanged (Bitmap bitmap); @@ -313,6 +312,13 @@ public final class EmacsNative in the process. */ public static native boolean ftruncate (int fd); + + /* Functions that assist in generating content file names. */ + + /* Calculate an 8 digit checksum for the byte array DISPLAYNAME + suitable for inclusion in a content file name. */ + public static native String displayNameHash (byte[] displayName); + static { /* Older versions of Android cannot link correctly with shared diff --git a/java/org/gnu/emacs/EmacsOpenActivity.java b/java/org/gnu/emacs/EmacsOpenActivity.java index 9ae1bf353dd..2cdfa2ec776 100644 --- a/java/org/gnu/emacs/EmacsOpenActivity.java +++ b/java/org/gnu/emacs/EmacsOpenActivity.java @@ -252,7 +252,7 @@ public final class EmacsOpenActivity extends Activity if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.KITKAT) { - content = EmacsService.buildContentName (uri); + content = EmacsService.buildContentName (uri, getContentResolver ()); return content; } @@ -423,6 +423,7 @@ public final class EmacsOpenActivity extends Activity /* Obtain the intent that started Emacs. */ intent = getIntent (); action = intent.getAction (); + resolver = getContentResolver (); if (action == null) { @@ -536,7 +537,7 @@ public final class EmacsOpenActivity extends Activity if ((scheme = uri.getScheme ()) != null && scheme.equals ("content")) { - tem1 = EmacsService.buildContentName (uri); + tem1 = EmacsService.buildContentName (uri, resolver); attachmentString = ("'(\"" + (tem1.replace ("\\", "\\\\") .replace ("\"", "\\\"") .replace ("$", "\\$")) @@ -568,7 +569,8 @@ public final class EmacsOpenActivity extends Activity && (scheme = uri.getScheme ()) != null && scheme.equals ("content")) { - tem1 = EmacsService.buildContentName (uri); + tem1 + = EmacsService.buildContentName (uri, resolver); builder.append ("\""); builder.append (tem1.replace ("\\", "\\\\") .replace ("\"", "\\\"") @@ -609,7 +611,6 @@ public final class EmacsOpenActivity extends Activity underlying file, but it cannot be found without opening the file and doing readlink on its file descriptor in /proc/self/fd. */ - resolver = getContentResolver (); fd = null; try diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 9bc40d63311..19aa3dee456 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -79,6 +79,7 @@ import android.os.VibrationEffect; import android.provider.DocumentsContract; import android.provider.DocumentsContract.Document; +import android.provider.OpenableColumns; import android.provider.Settings; import android.util.Log; @@ -1033,22 +1034,87 @@ public final class EmacsService extends Service return false; } + /* Return a 8 character checksum for the string STRING, after encoding + as UTF-8 data. */ + + public static String + getDisplayNameHash (String string) + { + byte[] encoded; + + try + { + encoded = string.getBytes ("UTF-8"); + return EmacsNative.displayNameHash (encoded); + } + catch (UnsupportedEncodingException exception) + { + /* This should be impossible. */ + return "error"; + } + } + /* Build a content file name for URI. Return a file name within the /contents/by-authority pseudo-directory that `android_get_content_name' can then transform back into an encoded URI. + If a display name can be requested from URI (using the resolver + RESOLVER), append it to this file name. + A content name consists of any number of unencoded path segments separated by `/' characters, possibly followed by a question mark and an encoded query string. */ public static String - buildContentName (Uri uri) + buildContentName (Uri uri, ContentResolver resolver) { StringBuilder builder; + String displayName; + String[] projection; + Cursor cursor; + int column; + + displayName = null; + cursor = null; - builder = new StringBuilder ("/content/by-authority/"); + try + { + projection = new String[] { OpenableColumns.DISPLAY_NAME, }; + cursor = resolver.query (uri, projection, null, null, null); + + if (cursor != null) + { + cursor.moveToFirst (); + column + = cursor.getColumnIndexOrThrow (OpenableColumns.DISPLAY_NAME); + displayName + = cursor.getString (column); + + /* Verify that the display name is valid, i.e. it + contains no characters unsuitable for a file name and + is nonempty. */ + if (displayName.isEmpty () || displayName.contains ("/")) + displayName = null; + } + } + catch (Exception e) + { + /* Ignored. */ + } + finally + { + if (cursor != null) + cursor.close (); + } + + /* If a display name is available, at this point it should be the + value of displayName. */ + + builder = new StringBuilder (displayName != null + ? "/content/by-authority-named/" + : "/content/by-authority/"); builder.append (uri.getAuthority ()); /* First, append each path segment. */ @@ -1065,6 +1131,16 @@ public final class EmacsService extends Service if (uri.getEncodedQuery () != null) builder.append ('?').append (uri.getEncodedQuery ()); + /* Append the display name. */ + + if (displayName != null) + { + builder.append ('/'); + builder.append (getDisplayNameHash (displayName)); + builder.append ('/'); + builder.append (displayName); + } + return builder.toString (); } diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 6b4c83112e3..e80c42f523a 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -350,9 +350,10 @@ This also sets the following values: if CODING-SYSTEM is ASCII-compatible" (check-coding-system coding-system) (setq-default buffer-file-coding-system coding-system) - - (if (eq system-type 'darwin) - ;; The file-name coding system on Darwin systems is always utf-8. + (if (or (eq system-type 'darwin) + (eq system-type 'android)) + ;; The file-name coding system on Darwin and Android systems is + ;; always UTF-8. (setq default-file-name-coding-system 'utf-8-unix) (if (and (or (not coding-system) (coding-system-get coding-system 'ascii-compatible-p))) diff --git a/src/androidvfs.c b/src/androidvfs.c index 4bb652f3eb7..9e3d5cab8cf 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -33,6 +33,7 @@ along with GNU Emacs. If not, see . */ #include #include +#include #include @@ -255,6 +256,7 @@ enum android_vnode_type ANDROID_VNODE_AFS, ANDROID_VNODE_CONTENT, ANDROID_VNODE_CONTENT_AUTHORITY, + ANDROID_VNODE_CONTENT_AUTHORITY_NAMED, ANDROID_VNODE_SAF_ROOT, ANDROID_VNODE_SAF_TREE, ANDROID_VNODE_SAF_FILE, @@ -2435,6 +2437,7 @@ struct android_content_vdir }; static struct android_vnode *android_authority_initial (char *, size_t); +static struct android_vnode *android_authority_initial_name (char *, size_t); static struct android_vnode *android_saf_root_initial (char *, size_t); /* Content provider meta-interface. This implements a vnode at @@ -2445,9 +2448,9 @@ static struct android_vnode *android_saf_root_initial (char *, size_t); a list of each directory tree Emacs has been granted permanent access to through the Storage Access Framework. - /content/by-authority exists on Android 4.4 and later; it contains - no directories, but provides a `name' function that converts - children into content URIs. */ + /content/by-authority and /content/by-authority-named exists on + Android 4.4 and later; it contains no directories, but provides a + `name' function that converts children into content URIs. */ static struct android_vnode *android_content_name (struct android_vnode *, char *, size_t); @@ -2490,7 +2493,7 @@ static struct android_vops content_vfs_ops = static const char *content_directory_contents[] = { - "storage", "by-authority", + "storage", "by-authority", "by-authority-named", }; /* Chain consisting of all open content directory streams. */ @@ -2508,8 +2511,9 @@ android_content_name (struct android_vnode *vnode, char *name, int api; static struct android_special_vnode content_vnodes[] = { - { "storage", 7, android_saf_root_initial, }, - { "by-authority", 12, android_authority_initial, }, + { "storage", 7, android_saf_root_initial, }, + { "by-authority", 12, android_authority_initial, }, + { "by-authority-named", 18, android_authority_initial_name, }, }; /* Canonicalize NAME. */ @@ -2551,7 +2555,7 @@ android_content_name (struct android_vnode *vnode, char *name, call its root lookup function with the rest of NAME there. */ if (api < 19) - i = 2; + i = 3; else if (api < 21) i = 1; else @@ -2855,18 +2859,59 @@ android_content_initial (char *name, size_t length) +#ifdef __clang__ +#pragma clang diagnostic push +#pragma clang diagnostic ignored "-Wmissing-prototypes" +#else /* GNUC */ +#pragma GCC diagnostic push +#pragma GCC diagnostic ignored "-Wmissing-prototypes" +#endif /* __clang__ */ + /* Content URI management functions. */ +JNIEXPORT jstring JNICALL +NATIVE_NAME (displayNameHash) (JNIEnv *env, jobject object, + jbyteArray display_name) +{ + char checksum[9], block[MD5_DIGEST_SIZE]; + jbyte *data; + + data = (*env)->GetByteArrayElements (env, display_name, NULL); + if (!data) + return NULL; + + /* Hash the buffer. */ + md5_buffer ((char *) data, (*env)->GetArrayLength (env, display_name), + block); + (*env)->ReleaseByteArrayElements (env, display_name, data, JNI_ABORT); + + /* Generate the digest string. */ + hexbuf_digest (checksum, (char *) block, 4); + checksum[8] = '\0'; + return (*env)->NewStringUTF (env, checksum); +} + +#ifdef __clang__ +#pragma clang diagnostic pop +#else /* GNUC */ +#pragma GCC diagnostic pop +#endif /* __clang__ */ + /* Return the content URI corresponding to a `/content/by-authority' file name, or NULL if it is invalid for some reason. FILENAME should be relative to /content/by-authority, with no leading - directory separator character. */ + directory separator character. + + WITH_CHECKSUM should be true if FILENAME contains a display name and + a checksum for that display name. */ static char * -android_get_content_name (const char *filename) +android_get_content_name (const char *filename, bool with_checksum) { char *fill, *buffer; size_t length; + char checksum[9], new_checksum[9], block[MD5_DIGEST_SIZE]; + const char *p2, *p1; /* Make sure FILENAME isn't obviously invalid: it must contain an authority name and a file name component. */ @@ -2888,11 +2933,55 @@ android_get_content_name (const char *filename) return NULL; } + if (!with_checksum) + goto no_checksum; + + /* Content file names hold two components providing a display name and + a short checksum that protects against files being opened under + display names besides those provided in the content file name at + the time of generation. */ + + p1 = strrchr (filename, '/'); /* Display name. */ + p2 = memrchr (filename, '/', p1 - filename); /* Start of checksum. */ + + /* If the name be excessively short or the checksum of an invalid + length, return. */ + if (!p2 || (p1 - p2) != 9) + { + errno = ENOENT; + return NULL; + } + + /* Copy the checksum into CHECKSUM. */ + memcpy (checksum, p2 + 1, 8); + new_checksum[8] = checksum[8] = '\0'; + + /* Hash this string and store 8 bytes of the resulting digest into + new_checksum. */ + md5_buffer (p1 + 1, strlen (p1 + 1), block); + hexbuf_digest (new_checksum, (char *) block, 4); + + /* Compare both checksums. */ + if (strcmp (new_checksum, checksum)) + { + errno = ENOENT; + return NULL; + } + + /* Remove the checksum and file display name from the URI. */ + length = p2 - filename; + + no_checksum: + if (length > INT_MAX) + { + errno = ENOMEM; + return NULL; + } + /* Prefix FILENAME with content:// and return the buffer containing that URI. */ - - buffer = xmalloc (sizeof "content://" + length); - sprintf (buffer, "content://%s", filename); + buffer = xmalloc (sizeof "content://" + length + 1); + sprintf (buffer, "content://%.*s", (int) length, filename); return buffer; } @@ -2932,7 +3021,7 @@ android_check_content_access (const char *uri, int mode) /* Content authority-based vnode implementation. - /contents/by-authority is a simple vnode implementation that converts + /content/by-authority is a simple vnode implementation that converts components to content:// URIs. It does not canonicalize file names by removing parent directory @@ -3039,7 +3128,14 @@ android_authority_name (struct android_vnode *vnode, char *name, if (android_verify_jni_string (name)) goto no_entry; - uri_name = android_get_content_name (name); + if (vp->vnode.type == ANDROID_VNODE_CONTENT_AUTHORITY_NAMED) + /* This indicates that the two trailing components of NAME + provide a checksum and a file display name, to be verified, + then excluded from the content URI. */ + uri_name = android_get_content_name (name, true); + else + uri_name = android_get_content_name (name, false); + if (!uri_name) goto error; @@ -3333,6 +3429,32 @@ android_authority_initial (char *name, size_t length) return android_authority_name (&temp.vnode, name, length); } +/* Find the vnode designated by NAME relative to the root of the + by-authority-named directory. + + If NAME is empty or a single leading separator character, return + a vnode representing the by-authority directory itself. + + Otherwise, represent the remainder of NAME as a URI (without + normalizing it) and return a vnode corresponding to that. + + Value may also be NULL with errno set if the designated vnode is + not available, such as when Android windowing has not been + initialized. */ + +static struct android_vnode * +android_authority_initial_name (char *name, size_t length) +{ + struct android_authority_vnode temp; + + temp.vnode.ops = &authority_vfs_ops; + temp.vnode.type = ANDROID_VNODE_CONTENT_AUTHORITY_NAMED; + temp.vnode.flags = 0; + temp.uri = NULL; + + return android_authority_name (&temp.vnode, name, length); +} + /* SAF ``root'' vnode implementation. -- cgit v1.2.3 From a7cb220523d881449a2dba683e7358b3312fd482 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 19 Mar 2024 12:17:43 +0800 Subject: Update android.texi * doc/emacs/android.texi (Android Startup): Describe /content/by-authority-named. --- doc/emacs/android.texi | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi index a45ec84f3f0..56bfa2591f6 100644 --- a/doc/emacs/android.texi +++ b/doc/emacs/android.texi @@ -143,11 +143,13 @@ that if that Emacs in turn does not start the Emacs server, subsequent attempts to open the file with the wrapper will fail. @cindex /content/by-authority directory, android +@cindex /content/by-authority-named directory, android Some files are given to Emacs as ``content identifiers'' that the system provides access to outside the normal filesystem APIs. Emacs -uses a pseudo-directory named @file{/content/by-authority} to access -those files. Do not make any assumptions about the contents of this -directory, or try to open files in it yourself. +uses pseudo-directories named @file{/content/by-authority} and +@file{/content/by-authority-named} to access those files. Do not make +any assumptions about the contents of this directory, or try to open +files in it yourself. This feature is not provided on Android 4.3 and earlier, in which case such files are copied to a temporary directory before being -- cgit v1.2.3 From 0f76baeac074a3d8f15b29b34b873b44d551979b Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 19 Mar 2024 10:41:52 +0100 Subject: * Use 'cl-type-of' in comp-cstr.el * lisp/emacs-lisp/comp-cstr.el (comp-cstr-union-homogeneous-no-range) (comp-cstr-union-1-no-mem, comp-cstr-intersection-no-hashcons): Make use of 'cl-type-of' in place of 'type-of'. --- lisp/emacs-lisp/comp-cstr.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 5922a8caf12..70456a70de1 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -575,7 +575,7 @@ All SRCS constraints must be homogeneously negated or non-negated." ;; We propagate only values those types are not already ;; into typeset. when (cl-notany (lambda (x) - (comp-subtype-p (type-of v) x)) + (comp-subtype-p (cl-type-of v) x)) (comp-cstr-typeset dst)) collect v))) @@ -664,7 +664,7 @@ DST is returned." ;; Verify disjoint condition between positive types and ;; negative types coming from values, in case give-up. - (let ((neg-value-types (nconc (mapcar #'type-of (valset neg)) + (let ((neg-value-types (nconc (mapcar #'cl-type-of (valset neg)) (when (range neg) '(integer))))) (when (cl-some (lambda (x) @@ -685,7 +685,7 @@ DST is returned." ((cl-some (lambda (x) (cl-some (lambda (y) (comp-subtype-p y x)) - (mapcar #'type-of (valset pos)))) + (mapcar #'cl-type-of (valset pos)))) (typeset neg)) (give-up)) (t @@ -1108,7 +1108,7 @@ DST is returned." (cl-loop for v in (valset dst) unless (symbolp v) do (push v strip-values) - (push (type-of v) strip-types)) + (push (cl-type-of v) strip-types)) (when strip-values (setf (typeset dst) (comp-union-typesets (typeset dst) strip-types) (valset dst) (cl-set-difference (valset dst) strip-values))) -- cgit v1.2.3 From f7f619779c93bb567a1658ef06199fc1816f88fb Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 19 Mar 2024 10:48:18 +0100 Subject: * test/lisp/emacs-lisp/comp-cstr-tests.el (comp-cstr-test-93): Add test. --- test/lisp/emacs-lisp/comp-cstr-tests.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el b/test/lisp/emacs-lisp/comp-cstr-tests.el index 991ab1f40eb..b823a190d5a 100644 --- a/test/lisp/emacs-lisp/comp-cstr-tests.el +++ b/test/lisp/emacs-lisp/comp-cstr-tests.el @@ -232,9 +232,8 @@ The arg is an alist of: type specifier -> expected type specifier." ;; 92 ((or string char-table bool-vector vector cons symbol number) . (or number sequence symbol)) - ;; 93? - ;; FIXME: I get `cons' rather than `list'? - ;;((or null cons) . list) + ;; 93 + ((or list (not null)) . t) )) ;;; comp-cstr-tests.el ends here -- cgit v1.2.3 From 88355de6022458c3e890cc6d5da60d6f35fe8868 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 19 Mar 2024 14:45:45 +0200 Subject: Unbreak the Cygw32 build broken by resent WTS_SESSION changes * src/w32xfns.c (WTS_VIRTUAL_CLASS): * src/w32fns.c (WTS_VIRTUAL_CLASS, WM_WTSSESSION_CHANGE) (WTS_SESSION_LOCK): Define only for WINDOWSNT. * src/w32xfns.c (drain_message_queue): Call 'reset_w32_kbdhook_state' only for WINDOWSNT. (Bug#69888) --- src/w32fns.c | 8 +++++--- src/w32xfns.c | 9 +++++++-- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/src/w32fns.c b/src/w32fns.c index 7d288ce7bd5..ace8d1016a5 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -305,10 +305,12 @@ static unsigned int sound_type = 0xFFFFFFFF; /* Special virtual key code for indicating "any" key. */ #define VK_ANY 0xFF -#ifndef WM_WTSSESSION_CHANGE +#ifdef WINDOWSNT +# ifndef WM_WTSSESSION_CHANGE /* 32-bit MinGW does not define these constants. */ -# define WM_WTSSESSION_CHANGE 0x02B1 -# define WTS_SESSION_LOCK 0x7 +# define WM_WTSSESSION_CHANGE 0x02B1 +# define WTS_SESSION_LOCK 0x7 +# endif #endif #ifndef WS_EX_NOACTIVATE diff --git a/src/w32xfns.c b/src/w32xfns.c index 853c8368118..b248697e658 100644 --- a/src/w32xfns.c +++ b/src/w32xfns.c @@ -22,9 +22,11 @@ along with GNU Emacs. If not, see . */ #include #include #include + +#ifdef WINDOWSNT /* Override API version to get the required functionality. */ -#undef _WIN32_WINNT -#define _WIN32_WINNT 0x0501 +# undef _WIN32_WINNT +# define _WIN32_WINNT 0x0501 /* mingw.org's MinGW headers mistakenly omit this enumeration: */ # ifndef MINGW_W64 typedef enum _WTS_VIRTUAL_CLASS { @@ -33,6 +35,7 @@ typedef enum _WTS_VIRTUAL_CLASS { } WTS_VIRTUAL_CLASS; # endif #include /* for WM_WTSSESSION_CHANGE, WTS_SESSION_LOCK */ +#endif /* WINDOWSNT */ #include "lisp.h" #include "frame.h" @@ -426,10 +429,12 @@ drain_message_queue (void) { switch (msg.message) { +#ifdef WINDOWSNT case WM_WTSSESSION_CHANGE: if (msg.wParam == WTS_SESSION_LOCK) reset_w32_kbdhook_state (); break; +#endif case WM_EMACS_FILENOTIFY: retval = 1; break; -- cgit v1.2.3 From 014cd0040275bb2a4d08d392825b4814452275db Mon Sep 17 00:00:00 2001 From: Kévin Le Gouguec Date: Mon, 18 Mar 2024 19:47:59 +0100 Subject: Fix vc-git test when no identities are configured Reported by john muhl . * test/lisp/vc/vc-git-tests.el (vc-git-test--with-repo): Set some environment variables (lifted from vc-tests.el) to let 'git commit' compute dummy author and committer identities. --- test/lisp/vc/vc-git-tests.el | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/test/lisp/vc/vc-git-tests.el b/test/lisp/vc/vc-git-tests.el index fd3e8ccd602..bbf0c4277dd 100644 --- a/test/lisp/vc/vc-git-tests.el +++ b/test/lisp/vc/vc-git-tests.el @@ -88,10 +88,17 @@ The current directory will be set to the top of that repository; NAME will be bound to that directory's file name. Once BODY exits, the -directory will be deleted." +directory will be deleted. + +Some dummy environment variables will be set for the duration of BODY to +allow 'git commit' to determine identities for authors and committers." (declare (indent 1)) `(ert-with-temp-directory ,name - (let ((default-directory ,name)) + (let ((default-directory ,name) + (process-environment (append '("EMAIL=john@doe.ee" + "GIT_AUTHOR_NAME=A" + "GIT_COMMITTER_NAME=C") + process-environment))) (vc-create-repo 'Git) ,@body))) -- cgit v1.2.3 From e72f17e4622fae45c9814f6ed196e5a9ed06cdd2 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 20 Mar 2024 10:23:42 +0800 Subject: Respect file display names during Android drag-and-drop * java/org/gnu/emacs/EmacsService.java (buildContentName): Remove redundant projection argument to resolver.query. * java/org/gnu/emacs/EmacsWindow.java (onDragEvent): If a content resolver is available, attempt to convert content URIs into file names in advance. * lisp/term/android-win.el (android-handle-dnd-event): Adjust correspondingly. --- java/org/gnu/emacs/EmacsService.java | 4 +--- java/org/gnu/emacs/EmacsWindow.java | 18 +++++++++++++++++- lisp/term/android-win.el | 37 ++++++++++++++++++++---------------- 3 files changed, 39 insertions(+), 20 deletions(-) diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 19aa3dee456..785163c713c 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -1072,7 +1072,6 @@ public final class EmacsService extends Service { StringBuilder builder; String displayName; - String[] projection; Cursor cursor; int column; @@ -1081,8 +1080,7 @@ public final class EmacsService extends Service try { - projection = new String[] { OpenableColumns.DISPLAY_NAME, }; - cursor = resolver.query (uri, projection, null, null, null); + cursor = resolver.query (uri, null, null, null, null); if (cursor != null) { diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index 6e8bdaf7401..93a512cc7ef 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java @@ -31,6 +31,7 @@ import android.app.Activity; import android.content.ClipData; import android.content.ClipDescription; +import android.content.ContentResolver; import android.content.Context; import android.graphics.Rect; @@ -1699,10 +1700,11 @@ public final class EmacsWindow extends EmacsHandleObject ClipData data; ClipDescription description; int i, j, x, y, itemCount; - String type; + String type, uriString; Uri uri; EmacsActivity activity; StringBuilder builder; + ContentResolver resolver; x = (int) event.getX (); y = (int) event.getY (); @@ -1799,6 +1801,20 @@ public final class EmacsWindow extends EmacsHandleObject { if ((activity.requestDragAndDropPermissions (event) == null)) uri = null; + else + { + resolver = activity.getContentResolver (); + + /* Substitute a content file name for the URI, if + possible. */ + uriString = EmacsService.buildContentName (uri, resolver); + + if (uriString != null) + { + builder.append (uriString).append ("\n"); + continue; + } + } } if (uri != null) diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index 1d10402b15d..8d262e5da98 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -282,11 +282,12 @@ If it reflects the motion of an item above a frame, call `dnd-handle-movement' to move the cursor or scroll the window under the item pursuant to the pertinent user options. -If it reflects dropped text, insert such text within window at -the location of the drop. +If it holds dropped text, insert such text within window at the +location of the drop. -If it reflects a list of URIs, then open each URI, converting -content:// URIs into the special file names which represent them." +If it holds a list of URIs, or file names, then open each URI or +file name, converting content:// URIs into the special file +names which represent them." (interactive "e") (let ((message (caddr event)) (posn (event-start event))) @@ -304,18 +305,22 @@ content:// URIs into the special file names which represent them." (new-uri-list nil) (dnd-unescape-file-uris t)) (dolist (uri uri-list) - (ignore-errors - (let ((url (url-generic-parse-url uri))) - (when (equal (url-type url) "content") - ;; Replace URI with a matching /content file - ;; name. - (setq uri (format "file:/content/by-authority/%s%s" - (url-host url) - (url-filename url)) - ;; And guarantee that this file URI is not - ;; subject to URI decoding, for it must be - ;; transformed back into a content URI. - dnd-unescape-file-uris nil)))) + ;; If the URI is a preprepared file name, insert it directly. + (if (string-match-p "^/content/by-authority\\(-named\\)?/" uri) + (setq uri (concat "file:" uri) + dnd-unescape-file-uris nil) + (ignore-errors + (let ((url (url-generic-parse-url uri))) + (when (equal (url-type url) "content") + ;; Replace URI with a matching /content file + ;; name. + (setq uri (format "file:/content/by-authority/%s%s" + (url-host url) + (url-filename url)) + ;; And guarantee that this file URI is not + ;; subject to URI decoding, for it must be + ;; transformed back into a content URI. + dnd-unescape-file-uris nil))))) (push uri new-uri-list)) (dnd-handle-multiple-urls (posn-window posn) new-uri-list -- cgit v1.2.3 From 5bdc2436c649ccc897a548a8e553244f58168216 Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Wed, 20 Mar 2024 09:33:37 +0100 Subject: ; * lisp/emacs-lisp/cl-macs.el (cl-labels): Fix stray diff marker. --- lisp/emacs-lisp/cl-macs.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 949b3284782..732deda618d 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2203,7 +2203,7 @@ Like `cl-flet' but the definitions can refer to previous ones. ;;;###autoload (defmacro cl-labels (bindings &rest body) "Make local (recursive) function definitions. -+BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where +BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where FUNC is the function name, ARGLIST its arguments, and BODY the forms of the function body. FUNC is defined in any BODY, as well as FORM, so you can write recursive and mutually recursive -- cgit v1.2.3 From 0b0c7da8c80a1e4dc328459f3403f358736ae90d Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 22:31:45 +0100 Subject: Add native compiler sanitizer * src/comp.c (ABI_VERSION): Bump new version. (CALL0I): Uncomment. (helper_link_table, declare_runtime_imported_funcs): Add 'helper_sanitizer_assert'. (Fcomp__init_ctxt): Register emitter for 'helper_sanitizer_assert'. (helper_sanitizer_assert): New function. (syms_of_comp): 'helper_sanitizer_assert' defsym. (syms_of_comp): 'comp-sanitizer-error' define error. (syms_of_comp): 'comp-sanitizer-active' defvar. * lisp/emacs-lisp/comp.el (comp-passes): Add 'comp--sanitizer'. (comp-sanitizer-emit): Define var. (comp--sanitizer): Define function. * lisp/emacs-lisp/comp-run.el (comp-run-async-workers): Forward 'comp-sanitizer-emit'. --- lisp/emacs-lisp/comp-run.el | 1 + lisp/emacs-lisp/comp.el | 46 +++++++++++++++++++++++++++++++++++++++++++++ src/comp.c | 42 ++++++++++++++++++++++++++++++++++++++--- 3 files changed, 86 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index afb46e3cd19..480f048777c 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -256,6 +256,7 @@ display a message." load-path backtrace-line-length byte-compile-warnings + comp-sanitizer-emit ;; package-load-list ;; package-user-dir ;; package-directory-list diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 9c2182092cb..6afb357bef2 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -165,6 +165,7 @@ Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.") comp--tco comp--fwprop comp--remove-type-hints + comp--sanitizer comp--compute-function-types comp--final) "Passes to be executed in order.") @@ -3006,6 +3007,51 @@ These are substituted with a normal `set' op." (comp--log-func comp-func 3)))) (comp-ctxt-funcs-h comp-ctxt))) + +;;; Sanitizer pass specific code. + +;; This pass aims to verify compile time value type predictions during +;; execution. +;; The sanitizer pass injects a call to 'helper_sanitizer_assert' before +;; each conditional branch. 'helper_sanitizer_assert' will verify that +;; the variable tested by the conditional branch is of the predicted +;; value type and signal an error otherwise. + +(defvar comp-sanitizer-emit nil + "Gates the sanitizer pass. +In use for native compiler development and verification only.") + +(defun comp--sanitizer (_) + (when comp-sanitizer-emit + (cl-loop + for f being each hash-value of (comp-ctxt-funcs-h comp-ctxt) + for comp-func = f + unless (comp-func-has-non-local comp-func) + do + (cl-loop + for b being each hash-value of (comp-func-blocks f) + do + (cl-loop + named in-the-basic-block + for insns-seq on (comp-block-insns b) + do (pcase insns-seq + (`((cond-jump ,(and (pred comp-mvar-p) mvar-tested) + ,(pred comp-mvar-p) ,_bb1 ,_bb2)) + (let ((type (comp-cstr-to-type-spec mvar-tested)) + (insn (car insns-seq))) + ;; No need to check if type is t. + (unless (eq type t) + (comp--add-const-to-relocs type) + (setcar + insns-seq + (comp--call 'helper_sanitizer_assert + mvar-tested + (make--comp-mvar :constant type))) + (setcdr insns-seq (list insn))) + ;; (setf (comp-func-ssa-status comp-func) 'dirty) + (cl-return-from in-the-basic-block)))))) + do (comp--log-func comp-func 3)))) + ;;; Function types pass specific code. diff --git a/src/comp.c b/src/comp.c index 76cf1f3ab6e..5e4ca643072 100644 --- a/src/comp.c +++ b/src/comp.c @@ -469,7 +469,7 @@ load_gccjit_if_necessary (bool mandatory) /* Increase this number to force a new Vcomp_abi_hash to be generated. */ -#define ABI_VERSION "5" +#define ABI_VERSION "6" /* Length of the hashes used for eln file naming. */ #define HASH_LENGTH 8 @@ -502,11 +502,9 @@ load_gccjit_if_necessary (bool mandatory) #define THIRD(x) \ XCAR (XCDR (XCDR (x))) -#if 0 /* unused for now */ /* Like call0 but stringify and intern. */ #define CALL0I(fun) \ CALLN (Ffuncall, intern_c_string (STR (fun))) -#endif /* Like call1 but stringify and intern. */ #define CALL1I(fun, arg) \ @@ -702,6 +700,8 @@ static void helper_save_restriction (void); static bool helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object, enum pvec_type); static struct Lisp_Symbol_With_Pos * helper_GET_SYMBOL_WITH_POSITION (Lisp_Object); +static Lisp_Object +helper_sanitizer_assert (Lisp_Object, Lisp_Object); /* Note: helper_link_table must match the list created by `declare_runtime_imported_funcs'. */ @@ -714,6 +714,7 @@ static void *helper_link_table[] = helper_unbind_n, helper_save_restriction, helper_GET_SYMBOL_WITH_POSITION, + helper_sanitizer_assert, record_unwind_current_buffer, set_internal, helper_unwind_protect, @@ -2975,6 +2976,10 @@ declare_runtime_imported_funcs (void) ADD_IMPORTED (helper_GET_SYMBOL_WITH_POSITION, comp.lisp_symbol_with_position_ptr_type, 1, args); + args[0] = comp.lisp_obj_type; + args[1] = comp.lisp_obj_type; + ADD_IMPORTED (helper_sanitizer_assert, comp.lisp_obj_type, 2, args); + ADD_IMPORTED (record_unwind_current_buffer, comp.void_type, 0, NULL); args[0] = args[1] = args[2] = comp.lisp_obj_type; @@ -4619,6 +4624,8 @@ Return t on success. */) emit_simple_limple_call_void_ret); register_emitter (Qhelper_save_restriction, emit_simple_limple_call_void_ret); + register_emitter (Qhelper_sanitizer_assert, + emit_simple_limple_call_lisp_ret); /* Inliners. */ register_emitter (Qadd1, emit_add1); register_emitter (Qsub1, emit_sub1); @@ -5082,6 +5089,21 @@ helper_GET_SYMBOL_WITH_POSITION (Lisp_Object a) return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos); } +static Lisp_Object +helper_sanitizer_assert (Lisp_Object val, Lisp_Object type) +{ + if (!comp_sanitizer_active + || !NILP ((CALL2I (cl-typep, val, type)))) + return Qnil; + + AUTO_STRING (format, "Comp sanitizer FAIL for %s with type %s"); + CALLN (Fmessage, format, val, type); + CALL0I (backtrace); + xsignal2 (Qcomp_sanitizer_error, val, type); + + return Qnil; +} + /* `native-comp-eln-load-path' clean-up support code. */ @@ -5709,6 +5731,7 @@ natively-compiled one. */); DEFSYM (Qhelper_unbind_n, "helper_unbind_n"); DEFSYM (Qhelper_unwind_protect, "helper_unwind_protect"); DEFSYM (Qhelper_save_restriction, "helper_save_restriction"); + DEFSYM (Qhelper_sanitizer_assert, "helper_sanitizer_assert"); /* Inliners. */ DEFSYM (Qadd1, "1+"); DEFSYM (Qsub1, "1-"); @@ -5779,6 +5802,12 @@ natively-compiled one. */); build_pure_c_string ("eln file inconsistent with current runtime " "configuration, please recompile")); + DEFSYM (Qcomp_sanitizer_error, "comp-sanitizer-error"); + Fput (Qcomp_sanitizer_error, Qerror_conditions, + pure_list (Qcomp_sanitizer_error, Qerror)); + Fput (Qcomp_sanitizer_error, Qerror_message, + build_pure_c_string ("Native code sanitizer runtime error")); + DEFSYM (Qnative__compile_async, "native--compile-async"); defsubr (&Scomp__subr_signature); @@ -5901,6 +5930,13 @@ subr-name -> arity For internal use. */); Vcomp_subr_arities_h = CALLN (Fmake_hash_table, QCtest, Qequal); + DEFVAR_BOOL ("comp-sanitizer-active", comp_sanitizer_active, + doc: /* When non-nil enable sanitizer runtime execution. +To be effective Lisp Code must have been compiled with +`comp-sanitizer-emit' non-nil. +In use for native compiler development and verification only. */); + comp_sanitizer_active = false; + Fprovide (intern_c_string ("native-compile"), Qnil); #endif /* #ifdef HAVE_NATIVE_COMP */ -- cgit v1.2.3 From e8d2bc75314262d512d367c270c6d43201ef533f Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 20 Mar 2024 11:49:32 +0100 Subject: ; * lisp/emacs-lisp/comp-cstr.el (comp--normalize-typeset0): Fix comment. --- lisp/emacs-lisp/comp-cstr.el | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 70456a70de1..cbfb9540f03 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -288,13 +288,10 @@ Return them as multiple value." (apply #'append (mapcar #'comp--direct-supertypes typeset))) for subs = (comp--direct-subtypes sup) - when (and (length> subs 1) ;;FIXME: Why? - ;; Every subtype of `sup` is a subtype of - ;; some element of `typeset`? - ;; It's tempting to just check (member x typeset), - ;; but think of the typeset (marker number), - ;; where `sup' is `integer-or-marker' and `sub' - ;; is `integer'. + when (and (length> subs 1) ;; If there's only one sub do + ;; nothing as we want to + ;; return the most specific + ;; type. (cl-every (lambda (sub) (cl-some (lambda (type) (comp-subtype-p sub type)) -- cgit v1.2.3 From 1475e3c3b562f7604e538fccbb41f1d66b10663d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 20 Mar 2024 14:27:25 +0200 Subject: ; Fix doc strings of recent changes * src/comp.c (syms_of_comp) : * lisp/emacs-lisp/comp.el (comp-sanitizer-emit): Doc fixes. --- lisp/emacs-lisp/comp.el | 3 ++- src/comp.c | 9 +++++---- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 6afb357bef2..d7830597709 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3019,7 +3019,8 @@ These are substituted with a normal `set' op." (defvar comp-sanitizer-emit nil "Gates the sanitizer pass. -In use for native compiler development and verification only.") +This is intended to be used only for development and verification of +the native compiler.") (defun comp--sanitizer (_) (when comp-sanitizer-emit diff --git a/src/comp.c b/src/comp.c index 5e4ca643072..99f51e07048 100644 --- a/src/comp.c +++ b/src/comp.c @@ -5931,10 +5931,11 @@ For internal use. */); Vcomp_subr_arities_h = CALLN (Fmake_hash_table, QCtest, Qequal); DEFVAR_BOOL ("comp-sanitizer-active", comp_sanitizer_active, - doc: /* When non-nil enable sanitizer runtime execution. -To be effective Lisp Code must have been compiled with -`comp-sanitizer-emit' non-nil. -In use for native compiler development and verification only. */); + doc: /* If non-nil, enable runtime execution of native-compiler sanitizer. +For this to be effective, Lisp code must be compiled +with `comp-sanitizer-emit' non-nil. +This is intended to be used only for development and +verification of the native compiler. */); comp_sanitizer_active = false; Fprovide (intern_c_string ("native-compile"), Qnil); -- cgit v1.2.3 From 7f6e335f4b4dba9378345625274fa477e0d38c5d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 20 Mar 2024 14:45:24 +0200 Subject: Fix documentation of M-SPC in user manual * doc/emacs/killing.texi (Deletion): Fix documentation of 'cycle-spacing'. (Bug#69905) --- doc/emacs/killing.texi | 28 +++++++++++++++++++--------- 1 file changed, 19 insertions(+), 9 deletions(-) diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 75ad631649c..c6633eb1892 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi @@ -91,9 +91,11 @@ Delete the next character (@code{delete-char}). @item M-\ Delete spaces and tabs around point (@code{delete-horizontal-space}). +@item M-x just-one-space +Delete spaces and tabs around point, leaving one space. @item M-@key{SPC} -Delete spaces and tabs around point, leaving one space -(@code{just-one-space}). +Delete spaces and tabs around point in flexible ways +(@code{cycle-spacing}). @item C-x C-o Delete blank lines around the current line (@code{delete-blank-lines}). @item M-^ @@ -118,12 +120,13 @@ characters before and after point. With a prefix argument, this only deletes spaces and tab characters before point. @findex just-one-space -@code{just-one-space} does likewise but leaves a single space before -point, regardless of the number of spaces that existed previously -(even if there were none before). With a numeric argument @var{n}, it -leaves @var{n} spaces before point if @var{n} is positive; if @var{n} -is negative, it deletes newlines in addition to spaces and tabs, -leaving @minus{}@var{n} spaces before point. +@kbd{M-x just-one-space} deletes tabs and spaces around point, but +leaves a single space before point, regardless of the number of spaces +that existed previously (even if there were none before). With a +numeric argument @var{n}, it leaves @var{n} spaces before point if +@var{n} is positive; if @var{n} is negative, it deletes newlines in +addition to spaces and tabs, leaving @minus{}@var{n} spaces before +point. @kindex M-SPC @findex cycle-spacing @@ -131,7 +134,14 @@ leaving @minus{}@var{n} spaces before point. The command @code{cycle-spacing} (@kbd{M-@key{SPC}}) acts like a more flexible version of @code{just-one-space}. It performs different space cleanup actions defined by @code{cycle-spacing-actions}, in a -cyclic manner, if you call it repeatedly in succession. +cyclic manner, if you call it repeatedly in succession. By default, +the first invocation does the same as @code{just-one-space}, the +second deletes all whitespace characters around point like +@code{delete-horizontal-space}, and the third restores the original +whitespace characters; then it cycles. If invoked with a prefix +argument, each action is given that value of the argument. The user +option @code{cycle-spacing-actions} can include other members; see the +doc string of that option for the details. @kbd{C-x C-o} (@code{delete-blank-lines}) deletes all blank lines after the current line. If the current line is blank, it deletes all -- cgit v1.2.3 From e2fec514fd22e61c2a4e9343056aa744e93203a1 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 20 Mar 2024 14:49:28 +0100 Subject: ; * lisp/emacs-lisp/comp.el: Add a simple sanitizer usage example. --- lisp/emacs-lisp/comp.el | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index d7830597709..7e8d4e15e0a 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3017,6 +3017,18 @@ These are substituted with a normal `set' op." ;; the variable tested by the conditional branch is of the predicted ;; value type and signal an error otherwise. +;;; Example: +;; Assuming we want to compile 'test.el' and test function `foo' defined +;; into it. + +;; Native compile 'test.el' instrumenting it for sanitizer usage. +;; (let ((comp-sanitizer-emit t)) +;; (load (native-compile "test.el"))) + +;; Run `foo' with the sanitizer active. +;; (let ((comp-sanitizer-active t)) +;; (foo)) + (defvar comp-sanitizer-emit nil "Gates the sanitizer pass. This is intended to be used only for development and verification of -- cgit v1.2.3 From ae9d8eedfdd6030a082010ac933b4aa4ddc05749 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 20 Mar 2024 16:08:15 +0200 Subject: ; Minor copyedits of last change. --- lisp/emacs-lisp/comp.el | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 7e8d4e15e0a..1df1e3b3ddb 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3010,24 +3010,25 @@ These are substituted with a normal `set' op." ;;; Sanitizer pass specific code. -;; This pass aims to verify compile time value type predictions during -;; execution. +;; This pass aims to verify compile-time value-type predictions during +;; execution of the code. ;; The sanitizer pass injects a call to 'helper_sanitizer_assert' before -;; each conditional branch. 'helper_sanitizer_assert' will verify that +;; each conditional branch. 'helper_sanitizer_assert' will verify that ;; the variable tested by the conditional branch is of the predicted -;; value type and signal an error otherwise. +;; value type, or signal an error otherwise. ;;; Example: -;; Assuming we want to compile 'test.el' and test function `foo' defined -;; into it. -;; Native compile 'test.el' instrumenting it for sanitizer usage. -;; (let ((comp-sanitizer-emit t)) -;; (load (native-compile "test.el"))) +;; Assume we want to compile 'test.el' and test the function `foo' +;; defined in it. Then: -;; Run `foo' with the sanitizer active. -;; (let ((comp-sanitizer-active t)) -;; (foo)) +;; - Native-compile 'test.el' instrumenting it for sanitizer usage: +;; (let ((comp-sanitizer-emit t)) +;; (load (native-compile "test.el"))) + +;; - Run `foo' with the sanitizer active: +;; (let ((comp-sanitizer-active t)) +;; (foo)) (defvar comp-sanitizer-emit nil "Gates the sanitizer pass. -- cgit v1.2.3 From 0df28dc00edd0db343619d02aa41999a7bfce5fb Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 20 Mar 2024 16:59:33 +0100 Subject: ; * lisp/emacs-lisp/comp-run.el (comp-run-async-workers): Fix indentation. --- lisp/emacs-lisp/comp-run.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index 480f048777c..5cc61579030 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -233,8 +233,8 @@ display a message." "`comp-files-queue' should be \".el\" files: %s" source-file) when (or native-comp-always-compile - load ; Always compile when the compilation is - ; commanded for late load. + load ; Always compile when the compilation is + ; commanded for late load. ;; Skip compilation if `comp-el-to-eln-filename' fails ;; to find a writable directory. (with-demoted-errors "Async compilation :%S" -- cgit v1.2.3 From ad0492c5a97aaad7f784f7834772400d9af96b69 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 21 Mar 2024 14:23:40 +0800 Subject: Android compatibility fixes * doc/emacs/android.texi (Android Windowing): Document restrictions on number of windows under Android 4.4 and earlier. * java/AndroidManifest.xml.in : Assign each class of activity a unique task affinity. * java/org/gnu/emacs/EmacsDesktopNotification.java (display1): Remove redundant priority assignment. * java/org/gnu/emacs/EmacsOpenActivity.java (onCreate): Handle file URIs when processing attachments from a mailto URI, and check for KitKat before opening content ones. * java/org/gnu/emacs/EmacsWindow.java (figureChange): Replace coordinate HashMap with a SparseArray. * java/org/gnu/emacs/EmacsWindowAttachmentManager.java (registerWindow): Don't specify FLAG_ACTIVITY_NEW_DOCUMENT on systems where it is absent. --- doc/emacs/android.texi | 6 ++++ java/AndroidManifest.xml.in | 4 ++- java/org/gnu/emacs/EmacsDesktopNotification.java | 35 ++++++++++------------ java/org/gnu/emacs/EmacsOpenActivity.java | 34 +++++++++++++++++++-- java/org/gnu/emacs/EmacsWindow.java | 12 ++++---- .../gnu/emacs/EmacsWindowAttachmentManager.java | 9 ++++-- 6 files changed, 70 insertions(+), 30 deletions(-) diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi index 56bfa2591f6..b367515cb35 100644 --- a/doc/emacs/android.texi +++ b/doc/emacs/android.texi @@ -864,6 +864,12 @@ behalf of a specific frame, Emacs deletes the frame displayed within that window. @end itemize + When the system predates Android 5.0, the window manager will not +accept more than one user-created Emacs window. If frame creation gives +rise to windows in excess of this limit, the window manager will +arbitrarily select one of their number to display, with the rest +remaining invisible until that window is destroyed with its frame. + @cindex windowing limitations, android @cindex frame parameters, android Emacs only supports a limited subset of GUI features on Android; the diff --git a/java/AndroidManifest.xml.in b/java/AndroidManifest.xml.in index 4d23c752747..563914fb02c 100644 --- a/java/AndroidManifest.xml.in +++ b/java/AndroidManifest.xml.in @@ -218,6 +218,7 @@ along with GNU Emacs. If not, see . --> @@ -229,7 +230,7 @@ along with GNU Emacs. If not, see . --> @@ -273,6 +274,7 @@ along with GNU Emacs. If not, see . --> diff --git a/java/org/gnu/emacs/EmacsDesktopNotification.java b/java/org/gnu/emacs/EmacsDesktopNotification.java index c80aa21b4fe..72569631a8c 100644 --- a/java/org/gnu/emacs/EmacsDesktopNotification.java +++ b/java/org/gnu/emacs/EmacsDesktopNotification.java @@ -208,22 +208,6 @@ public final class EmacsDesktopNotification distinct categories, but permit an importance to be assigned to each individual notification. */ - switch (importance) - { - case 2: /* IMPORTANCE_LOW */ - default: - priority = Notification.PRIORITY_LOW; - break; - - case 3: /* IMPORTANCE_DEFAULT */ - priority = Notification.PRIORITY_DEFAULT; - break; - - case 4: /* IMPORTANCE_HIGH */ - priority = Notification.PRIORITY_HIGH; - break; - } - builder = new Notification.Builder (context); builder.setContentTitle (title); builder.setContentText (content); @@ -231,15 +215,28 @@ public final class EmacsDesktopNotification if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.JELLY_BEAN) { + switch (importance) + { + case 2: /* IMPORTANCE_LOW */ + default: + priority = Notification.PRIORITY_LOW; + break; + + case 3: /* IMPORTANCE_DEFAULT */ + priority = Notification.PRIORITY_DEFAULT; + break; + + case 4: /* IMPORTANCE_HIGH */ + priority = Notification.PRIORITY_HIGH; + break; + } + builder.setPriority (priority); insertActions (context, builder); notification = builder.build (); } else notification = builder.getNotification (); - - if (Build.VERSION.SDK_INT > Build.VERSION_CODES.JELLY_BEAN) - notification.priority = priority; } else { diff --git a/java/org/gnu/emacs/EmacsOpenActivity.java b/java/org/gnu/emacs/EmacsOpenActivity.java index 2cdfa2ec776..327a53bc417 100644 --- a/java/org/gnu/emacs/EmacsOpenActivity.java +++ b/java/org/gnu/emacs/EmacsOpenActivity.java @@ -535,7 +535,9 @@ public final class EmacsOpenActivity extends Activity uri = intent.getParcelableExtra (Intent.EXTRA_STREAM); if ((scheme = uri.getScheme ()) != null - && scheme.equals ("content")) + && scheme.equals ("content") + && (Build.VERSION.SDK_INT + >= Build.VERSION_CODES.KITKAT)) { tem1 = EmacsService.buildContentName (uri, resolver); attachmentString = ("'(\"" + (tem1.replace ("\\", "\\\\") @@ -543,6 +545,14 @@ public final class EmacsOpenActivity extends Activity .replace ("$", "\\$")) + "\")"); } + else if (scheme != null && scheme.equals ("file")) + { + tem1 = uri.getPath (); + attachmentString = ("'(\"" + (tem1.replace ("\\", "\\\\") + .replace ("\"", "\\\"") + .replace ("$", "\\$")) + + "\")"); + } } else { @@ -567,7 +577,9 @@ public final class EmacsOpenActivity extends Activity if (uri != null && (scheme = uri.getScheme ()) != null - && scheme.equals ("content")) + && scheme.equals ("content") + && (Build.VERSION.SDK_INT + >= Build.VERSION_CODES.KITKAT)) { tem1 = EmacsService.buildContentName (uri, resolver); @@ -577,6 +589,16 @@ public final class EmacsOpenActivity extends Activity .replace ("$", "\\$")); builder.append ("\""); } + else if (scheme != null + && scheme.equals ("file")) + { + tem1 = uri.getPath (); + builder.append ("\""); + builder.append (tem1.replace ("\\", "\\\\") + .replace ("\"", "\\\"") + .replace ("$", "\\$")); + builder.append ("\""); + } } builder.append (")"); @@ -604,7 +626,13 @@ public final class EmacsOpenActivity extends Activity { fileName = null; - if (scheme.equals ("content")) + if (scheme.equals ("content") + /* Retrieving the native file descriptor of a + ParcelFileDescriptor requires Honeycomb, and + proceeding without this capability is pointless on + systems before KitKat, since Emacs doesn't support + opening content files on those. */ + && Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB) { /* This is one of the annoying Android ``content'' URIs. Most of the time, there is actually an diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index 93a512cc7ef..2baede1d2d0 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java @@ -23,7 +23,6 @@ import java.lang.IllegalStateException; import java.util.ArrayList; import java.util.List; import java.util.ListIterator; -import java.util.HashMap; import java.util.LinkedHashMap; import java.util.Map; @@ -50,6 +49,7 @@ import android.view.View; import android.view.ViewManager; import android.view.WindowManager; +import android.util.SparseArray; import android.util.Log; import android.os.Build; @@ -109,7 +109,7 @@ public final class EmacsWindow extends EmacsHandleObject /* Map between pointer identifiers and last known position. Used to compute which pointer changed upon a touch event. */ - private HashMap pointerMap; + private SparseArray pointerMap; /* The window consumer currently attached, if it exists. */ private EmacsWindowAttachmentManager.WindowConsumer attached; @@ -166,7 +166,7 @@ public final class EmacsWindow extends EmacsHandleObject super (handle); rect = new Rect (x, y, x + width, y + height); - pointerMap = new HashMap (); + pointerMap = new SparseArray (); /* Create the view from the context's UI thread. The window is unmapped, so the view is GONE. */ @@ -1001,7 +1001,8 @@ public final class EmacsWindow extends EmacsHandleObject case MotionEvent.ACTION_CANCEL: /* Primary pointer released with index 0. */ pointerID = event.getPointerId (0); - coordinate = pointerMap.remove (pointerID); + coordinate = pointerMap.get (pointerID); + pointerMap.delete (pointerID); break; case MotionEvent.ACTION_POINTER_DOWN: @@ -1020,7 +1021,8 @@ public final class EmacsWindow extends EmacsHandleObject /* Pointer removed. Remove it from the map. */ pointerIndex = event.getActionIndex (); pointerID = event.getPointerId (pointerIndex); - coordinate = pointerMap.remove (pointerID); + coordinate = pointerMap.get (pointerID); + pointerMap.delete (pointerID); break; default: diff --git a/java/org/gnu/emacs/EmacsWindowAttachmentManager.java b/java/org/gnu/emacs/EmacsWindowAttachmentManager.java index 18bdb6dbf60..aae4e2ee49b 100644 --- a/java/org/gnu/emacs/EmacsWindowAttachmentManager.java +++ b/java/org/gnu/emacs/EmacsWindowAttachmentManager.java @@ -124,10 +124,15 @@ public final class EmacsWindowAttachmentManager intent = new Intent (EmacsService.SERVICE, EmacsMultitaskActivity.class); - intent.addFlags (Intent.FLAG_ACTIVITY_NEW_DOCUMENT - | Intent.FLAG_ACTIVITY_NEW_TASK + + intent.addFlags (Intent.FLAG_ACTIVITY_NEW_TASK | Intent.FLAG_ACTIVITY_MULTIPLE_TASK); + /* Intent.FLAG_ACTIVITY_NEW_DOCUMENT is lamentably unavailable on + older systems than Lolipop. */ + if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.LOLLIPOP) + intent.addFlags (Intent.FLAG_ACTIVITY_NEW_DOCUMENT); + if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N) EmacsService.SERVICE.startActivity (intent); else -- cgit v1.2.3 From b3f04eb68499f285e05b5b74e9cbd67f3140fb3c Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 21 Mar 2024 02:13:28 -0500 Subject: Avoid recomputing the whole table in 'vtable--recompute-numerical' Each element of LINE being tested is a list, the first element of which is the value actually being represented in the table. Previously, the 'numberp' test would always fail, because it was being compared with the list rather than the intended value in it; that could cause the whole table to be recomputed, sometimes unnecessarily. * lisp/emacs-lisp/vtable.el (vtable--recompute-numerical): Test the car of ELEM, not ELEM itself, which is a list. (Bug#69927) --- lisp/emacs-lisp/vtable.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 15a430f5c26..5f7d3ae5210 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -743,7 +743,7 @@ If NEXT, do the next column." (seq-do-indexed (lambda (elem index) (when (and (vtable-column--numerical (elt columns index)) - (not (numberp elem))) + (not (numberp (car elem)))) (setq recompute t))) line) (when recompute -- cgit v1.2.3 From fa79de7c6b8883de4433572b2f6dc5b941f6ac66 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 21 Mar 2024 09:49:34 +0200 Subject: ; * lisp/calendar/calendar.el: Remove extra space. --- lisp/calendar/calendar.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index a13c2b7ca6d..422a6ceaa7a 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1973,7 +1973,7 @@ Gregorian date Sunday, December 31, 1 BC. This function does not handle dates in years BC." ;; For an explanation, see the footnote on page 384 of "Calendrical ;; Calculations, Part II: Three Historical Calendars" by - ;; E. M. Reingold, N. Dershowitz, and S. M. Clamen, + ;; E. M. Reingold, N. Dershowitz, and S. M. Clamen, ;; Software--Practice and Experience, Volume 23, Number 4 (April, ;; 1993), pages 383-404 ;; . -- cgit v1.2.3 From fe24a8c3c091c1e051fe6a8c1ec4fd30ca052ca7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 21 Mar 2024 10:25:56 +0200 Subject: Speed up display of RTL text with many character compositions * src/bidi.c (bidi_level_start): New function. * src/dispextern.h (bidi_level_start): Add prototype. * src/xdisp.c (compute_stop_pos, set_iterator_to_next) (get_visually_first_element, next_element_from_buffer): Call 'bidi_level_start' when looking for composed characters backwards, to set limit of searching back, instead of looking all the way to BOB. (Bug#69385) --- src/bidi.c | 13 +++++++++++++ src/dispextern.h | 1 + src/xdisp.c | 20 +++++++++++--------- 3 files changed, 25 insertions(+), 9 deletions(-) diff --git a/src/bidi.c b/src/bidi.c index 36d1a0496b8..bdf60001781 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -754,6 +754,19 @@ bidi_cache_find_level_change (int level, int dir, bool before) return -1; } +/* Find the previous character position where LEVEL changes to a lower + one. Return -1 if not found (which really shouldn't happen if this + function is called on a backward scan). */ +ptrdiff_t +bidi_level_start (int level) +{ + ptrdiff_t slot = bidi_cache_find_level_change (level, -1, true); + + if (slot >= 0) + return bidi_cache[slot].charpos; + return -1; +} + static void bidi_cache_ensure_space (ptrdiff_t idx) { diff --git a/src/dispextern.h b/src/dispextern.h index 5387cb45603..1c3232fae3d 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3438,6 +3438,7 @@ extern void bidi_pop_it (struct bidi_it *); extern void *bidi_shelve_cache (void); extern void bidi_unshelve_cache (void *, bool); extern ptrdiff_t bidi_find_first_overridden (struct bidi_it *); +extern ptrdiff_t bidi_level_start (int); /* Defined in xdisp.c */ diff --git a/src/xdisp.c b/src/xdisp.c index d03769e2a31..140d71129f3 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -4353,7 +4353,7 @@ compute_stop_pos (struct it *it) an automatic composition, limit the search of composable characters to that position. */ if (it->bidi_p && it->bidi_it.scan_dir < 0) - stoppos = -1; + stoppos = bidi_level_start (it->bidi_it.resolved_level) - 1; else if (!STRINGP (it->string) && it->cmp_it.stop_pos <= IT_CHARPOS (*it) && cmp_limit_pos > 0) @@ -8712,9 +8712,8 @@ set_iterator_to_next (struct it *it, bool reseat_p) ptrdiff_t stop = it->end_charpos; if (it->bidi_it.scan_dir < 0) - /* Now we are scanning backward and don't know - where to stop. */ - stop = -1; + /* Now we are scanning backward; figure out where to stop. */ + stop = bidi_level_start (it->bidi_it.resolved_level) - 1; composition_compute_stop_pos (&it->cmp_it, IT_CHARPOS (*it), IT_BYTEPOS (*it), stop, Qnil, true); } @@ -8745,7 +8744,7 @@ set_iterator_to_next (struct it *it, bool reseat_p) re-compute the stop position for composition. */ ptrdiff_t stop = it->end_charpos; if (it->bidi_it.scan_dir < 0) - stop = -1; + stop = bidi_level_start (it->bidi_it.resolved_level) - 1; composition_compute_stop_pos (&it->cmp_it, IT_CHARPOS (*it), IT_BYTEPOS (*it), stop, Qnil, true); @@ -9190,7 +9189,9 @@ get_visually_first_element (struct it *it) bytepos = IT_BYTEPOS (*it); } if (it->bidi_it.scan_dir < 0) - stop = -1; + stop = STRINGP (it->string) + ? -1 + : bidi_level_start (it->bidi_it.resolved_level) - 1; composition_compute_stop_pos (&it->cmp_it, charpos, bytepos, stop, it->string, true); } @@ -9694,9 +9695,10 @@ next_element_from_buffer (struct it *it) && PT < it->end_charpos) ? PT : it->end_charpos; } else - stop = it->bidi_it.scan_dir < 0 ? -1 : it->end_charpos; - if (CHAR_COMPOSED_P (it, IT_CHARPOS (*it), IT_BYTEPOS (*it), - stop) + stop = it->bidi_it.scan_dir < 0 + ? bidi_level_start (it->bidi_it.resolved_level) - 1 + : it->end_charpos; + if (CHAR_COMPOSED_P (it, IT_CHARPOS (*it), IT_BYTEPOS (*it), stop) && next_element_from_composition (it)) { return true; -- cgit v1.2.3 From 759dedfab07a1c4db49c1291c9dde2aee648919d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 21 Mar 2024 10:55:59 +0200 Subject: More accurate documentation of 'rmail-mail-new-frame' * doc/emacs/rmail.texi (Rmail Reply): More accurate documentation of the effects of 'rmail-mail-new-frame'. (Bug#69738) --- doc/emacs/rmail.texi | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi index 51bd6086ce0..f94708b08ac 100644 --- a/doc/emacs/rmail.texi +++ b/doc/emacs/rmail.texi @@ -875,7 +875,10 @@ already composing, or to alter a message you have sent. If you set the variable @code{rmail-mail-new-frame} to a non-@code{nil} value, then all the Rmail commands to start sending a message create a new frame to edit it in. This frame is deleted when -you send the message. +you send the message (but not if it is the only visible frame on the +current display, or if it's a text-mode frame). If this frame cannot +be deleted when you send the message, Emacs will try to reuse it for +composing subsequent messages. @ignore @c FIXME does not work with Message -> Kill Message , or when you use the @samp{Cancel} item in the @samp{Mail} menu. -- cgit v1.2.3 From 689f04a2ddfae856153bed762cc1461d66ec88de Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sun, 17 Mar 2024 13:04:32 +0100 Subject: Clarify description of format-spec truncation * doc/lispref/strings.texi (Custom Format Strings): Mention that precision specifier affects both '<' and '>' truncation (bug#69822). * lisp/format-spec.el (format-spec, format-spec--do-flags): Use same terminology as 'format', especially when referring to its behavior. --- doc/lispref/strings.texi | 2 +- lisp/format-spec.el | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index a364fef3aab..eca69002779 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -1369,7 +1369,7 @@ given width and precision, if specified. @item > This flag causes the substitution to be truncated on the right to the -given width, if specified. +given width and precision, if specified. @item ^ This flag converts the substituted text to upper case (@pxref{Case diff --git a/lisp/format-spec.el b/lisp/format-spec.el index cf34017b994..73f9fccd793 100644 --- a/lisp/format-spec.el +++ b/lisp/format-spec.el @@ -38,7 +38,7 @@ For instance: (?l . \"ls\"))) Each %-spec may contain optional flag, width, and precision -modifiers, as follows: +specifiers, as follows: %character @@ -51,7 +51,7 @@ The following flags are allowed: * ^: Convert to upper case. * _: Convert to lower case. -The width and truncation modifiers behave like the corresponding +The width and precision specifiers behave like the corresponding ones in `format' when applied to %s. For example, \"%<010b\" means \"substitute into the output the @@ -145,7 +145,7 @@ is returned, where each format spec is its own element." "Return STR formatted according to FLAGS, WIDTH, and TRUNC. FLAGS is a list of keywords as returned by `format-spec--parse-flags'. WIDTH and TRUNC are either nil or -string widths corresponding to `format-spec' modifiers." +string widths corresponding to `format-spec' specifiers." (let (diff str-width) ;; Truncate original string first, like `format' does. (when trunc -- cgit v1.2.3 From 393f58c85aeb78f814866ccaad9ae7efd3fa6766 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 8 Mar 2024 23:43:14 -0600 Subject: 'vtable-update-object' can now be called with one argument It's often necessary to update the representation of a single object in a table (e.g a struct, whose identity does not change when its slots' values are changed). To do so, now the function may be called like this: (vtable-update-object table object) Instead of like this: (vtable-update-object table object object) This also documents the behavior of the just-discovered limitation filed as bug#69837. * lisp/emacs-lisp/vtable.el (vtable-update-object): Make 'old-object' argument optional. (Bug#69666) * doc/misc/vtable.texi (Interface Functions): Update documentation. * etc/NEWS: Add news entry. --- doc/misc/vtable.texi | 13 ++++++++++--- etc/NEWS | 9 +++++++++ lisp/emacs-lisp/vtable.el | 15 +++++++++++++-- 3 files changed, 32 insertions(+), 5 deletions(-) diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi index a4f2ed29d93..dd5b70cf32f 100644 --- a/doc/misc/vtable.texi +++ b/doc/misc/vtable.texi @@ -554,12 +554,19 @@ the object after this object; otherwise append to @var{table}. This also updates the displayed table. @end defun -@defun vtable-update-object table object old-object -Change @var{old-object} into @var{object} in @var{table}. This also -updates the displayed table. +@defun vtable-update-object table object &optional old-object +Update @var{object}'s representation in @var{table}. Optional argument +@var{old-object}, if non-@code{nil}, means to replace @var{old-object} +with @var{object} and redisplay the associated row in the table. In +either case, if the existing object is not found in the table (being +compared with @code{equal}), signal an error. This has the same effect as calling @code{vtable-remove-object} and then @code{vtable-insert-object}, but is more efficient. + +Note a limitation: if the table's buffer is not in a visible window, or +if its window has changed width since it was updated, updating the table +is not possible, and an error is signaled. @end defun @defun vtable-column table index diff --git a/etc/NEWS b/etc/NEWS index 69e61d91b0e..ba0e4c80fa0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2197,6 +2197,15 @@ aforementioned functions: (and (arrayp executing-kbd-macro) (>= executing-kbd-macro-index (length executing-kbd-macro)))) ++++ +** 'vtable-update-object' updates an existing object with just two arguments. +It is now possible to update the representation of an object in a vtable +by calling 'vtable-update-object' with just the vtable and the object as +arguments. (Previously the 'old-object' argument was required which, in +this case, would mean repeating the object in the argument list.) When +replacing an object with a different one, passing both the new and old +objects is still necessary. + * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 5f7d3ae5210..d8e5136c666 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -283,8 +283,16 @@ If it can't be found, return nil and don't move point." (goto-char (prop-match-beginning match)) (end-of-line))) -(defun vtable-update-object (table object old-object) - "Replace OLD-OBJECT in TABLE with OBJECT." +(defun vtable-update-object (table object &optional old-object) + "Update OBJECT's representation in TABLE. +If OLD-OBJECT is non-nil, replace OLD-OBJECT with OBJECT and display it. +In either case, if the existing object is not found in the table (being +compared with `equal'), signal an error. Note a limitation: if TABLE's +buffer is not in a visible window, or if its window has changed width +since it was updated, updating the TABLE is not possible, and an error +is signaled." + (unless old-object + (setq old-object object)) (let* ((objects (vtable-objects table)) (inhibit-read-only t)) ;; First replace the object in the object storage. @@ -300,6 +308,9 @@ If it can't be found, return nil and don't move point." (error "Can't find the old object")) (setcar (cdr objects) object)) ;; Then update the cache... + ;; FIXME: If the table's buffer has no visible window, or if its + ;; width has changed since the table was updated, the cache key will + ;; not match and the object can't be updated. (Bug #69837). (if-let ((line-number (seq-position (car (vtable--cache table)) old-object (lambda (a b) (equal (car a) b)))) -- cgit v1.2.3 From 51848e4731f3e32e5d152990bf570b08ca544a92 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 17 May 2023 15:28:46 +0200 Subject: * Fix missing `comp-files-queue' update (bug#63415). * lisp/emacs-lisp/comp.el (native--compile-async): Update `comp-files-queue' for real. --- lisp/emacs-lisp/comp.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 614c62c35c6..6b65a375ea0 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -4229,8 +4229,9 @@ bytecode definition was not changed in the meantime)." ;; compilation, so update `comp-files-queue' to reflect that. (unless (or (null load) (eq load (cdr entry))) - (cl-substitute (cons file load) (car entry) comp-files-queue - :key #'car :test #'string=)) + (setf comp-files-queue + (cl-substitute (cons file load) (car entry) comp-files-queue + :key #'car :test #'string=))) (unless (native-compile-async-skip-p file load selector) (let* ((out-filename (comp-el-to-eln-filename file)) -- cgit v1.2.3 From 5a09cc111f052c120eddf0bcc98eeb1fd5435ae2 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 21 Mar 2024 20:45:25 +0800 Subject: ; * src/xterm.c (syms_of_xterm): Document x-*-keysym's default values. --- src/xterm.c | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/src/xterm.c b/src/xterm.c index b30a2485148..c0aef65ab66 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -32547,7 +32547,8 @@ Android does not support scroll bars at all. */); doc: /* Which modifer value Emacs reports when Ctrl is depressed. This should be one of the symbols `ctrl', `alt', `hyper', `meta', or `super', representing a modifier to be reported for key events with the -Ctrl modifier (i.e. the keysym Ctrl_L or Ctrl_R) depressed. */); +Ctrl modifier (i.e. the keysym Ctrl_L or Ctrl_R) depressed, with nil or +any other value equivalent to `ctrl'. */); Vx_ctrl_keysym = Qnil; DEFVAR_LISP ("x-alt-keysym", Vx_alt_keysym, @@ -32555,14 +32556,16 @@ Ctrl modifier (i.e. the keysym Ctrl_L or Ctrl_R) depressed. */); This should be one of the symbols `ctrl', `alt', `hyper', `meta', or `super', representing a modifier to be reported for key events with the Alt modifier (e.g. the keysym Alt_L or Alt_R, if the keyboard features a -dedicated key for Meta) depressed. */); +dedicated key for Meta) depressed, with nil or any other value +equivalent to `alt'. */); Vx_alt_keysym = Qnil; DEFVAR_LISP ("x-hyper-keysym", Vx_hyper_keysym, doc: /* Which modifer value Emacs reports when Hyper is depressed. This should be one of the symbols `ctrl', `alt', `hyper', `meta', or `super', representing a modifier to be reported for key events with the -Hyper modifier (i.e. the keysym Hyper_L or Hyper_R) depressed. */); +Hyper modifier (i.e. the keysym Hyper_L or Hyper_R) depressed, with nil +or any other value equivalent to `hyper'. */); Vx_hyper_keysym = Qnil; DEFVAR_LISP ("x-meta-keysym", Vx_meta_keysym, @@ -32570,14 +32573,16 @@ Hyper modifier (i.e. the keysym Hyper_L or Hyper_R) depressed. */); This should be one of the symbols `ctrl', `alt', `hyper', `meta', or `super', representing a modifier to be reported for key events with the Meta modifier (e.g. the keysym Alt_L or Alt_R, when the keyboard does -not feature a dedicated key for Meta) depressed. */); +not feature a dedicated key for Meta) depressed, with nil or any other +value equivalent to `meta'. */); Vx_meta_keysym = Qnil; DEFVAR_LISP ("x-super-keysym", Vx_super_keysym, doc: /* Which modifer value Emacs reports when Super is depressed. This should be one of the symbols `ctrl', `alt', `hyper', `meta', or `super', representing a modifier to be reported for key events with the -Super modifier (i.e. the keysym Super_L or Super_R) depressed. */); +Super modifier (i.e. the keysym Super_L or Super_R) depressed, with nil +or any other value equivalent to `super'. */); Vx_super_keysym = Qnil; DEFVAR_LISP ("x-wait-for-event-timeout", Vx_wait_for_event_timeout, -- cgit v1.2.3 From 3a902db97a99525b6f54100dc45a8cffcd3c5c8e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 21 Mar 2024 11:38:12 -0400 Subject: (widget--allow-insertion): New macro * lisp/wid-edit.el (widget--allow-insertion): New macro. (widget-specify-insert, widget-insert, widget-setup) (widget-default-delete, widget-editable-list-insert-before) (widget-editable-list-delete-at): Use it. --- lisp/wid-edit.el | 156 +++++++++++++++++++++++++++---------------------------- 1 file changed, 78 insertions(+), 78 deletions(-) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index cd06acd3f99..0645871f16d 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -510,14 +510,20 @@ With CHECK-AFTER non-nil, considers also the content after point, if needed." ;; indented it. (not (eq (following-char) ?\s)))))) -(defmacro widget-specify-insert (&rest form) - "Execute FORM without inheriting any text properties." - (declare (debug (body))) +(defmacro widget--allow-insertion (&rest forms) + "Run FORMS such that they can insert widgets in the current buffer." + (declare (debug t)) + `(let ((inhibit-read-only t) + (inhibit-modification-hooks t)) ;; FIXME: Why? This is risky! + ,@forms)) + +(defmacro widget-specify-insert (&rest forms) + "Execute FORMS without inheriting any text properties." + (declare (debug t)) `(save-restriction - (let ((inhibit-read-only t) - (inhibit-modification-hooks t)) + (widget--allow-insertion (narrow-to-region (point) (point)) - (prog1 (progn ,@form) + (prog1 (progn ,@forms) (goto-char (point-max)))))) (defface widget-inactive @@ -954,9 +960,8 @@ The optional ARGS are additional keyword arguments." ;;;###autoload (defun widget-insert (&rest args) "Call `insert' with ARGS even if surrounding text is read only." - (let ((inhibit-read-only t) - (inhibit-modification-hooks t)) - (apply 'insert args))) + (widget--allow-insertion + (apply #'insert args))) (defun widget-convert-text (type from to &optional button-from button-to @@ -1376,19 +1381,18 @@ When not inside a field, signal an error." ;;;###autoload (defun widget-setup () "Setup current buffer so editing string widgets works." - (let ((inhibit-read-only t) - (inhibit-modification-hooks t) - field) - (while widget-field-new - (setq field (car widget-field-new) - widget-field-new (cdr widget-field-new) - widget-field-list (cons field widget-field-list)) - (let ((from (car (widget-get field :field-overlay))) - (to (cdr (widget-get field :field-overlay)))) - (widget-specify-field field - (marker-position from) (marker-position to)) - (set-marker from nil) - (set-marker to nil)))) + (widget--allow-insertion + (let (field) + (while widget-field-new + (setq field (car widget-field-new) + widget-field-new (cdr widget-field-new) + widget-field-list (cons field widget-field-list)) + (let ((from (car (widget-get field :field-overlay))) + (to (cdr (widget-get field :field-overlay)))) + (widget-specify-field field + (marker-position from) (marker-position to)) + (set-marker from nil) + (set-marker to nil))))) (widget-clear-undo) (widget-add-change)) @@ -1773,24 +1777,23 @@ The value of the :type attribute should be an unconverted widget type." (inactive-overlay (widget-get widget :inactive)) (button-overlay (widget-get widget :button-overlay)) (sample-overlay (widget-get widget :sample-overlay)) - (doc-overlay (widget-get widget :doc-overlay)) - (inhibit-modification-hooks t) - (inhibit-read-only t)) - (widget-apply widget :value-delete) - (widget-children-value-delete widget) - (when inactive-overlay - (delete-overlay inactive-overlay)) - (when button-overlay - (delete-overlay button-overlay)) - (when sample-overlay - (delete-overlay sample-overlay)) - (when doc-overlay - (delete-overlay doc-overlay)) - (when (< from to) - ;; Kludge: this doesn't need to be true for empty formats. - (delete-region from to)) - (set-marker from nil) - (set-marker to nil)) + (doc-overlay (widget-get widget :doc-overlay))) + (widget--allow-insertion + (widget-apply widget :value-delete) + (widget-children-value-delete widget) + (when inactive-overlay + (delete-overlay inactive-overlay)) + (when button-overlay + (delete-overlay button-overlay)) + (when sample-overlay + (delete-overlay sample-overlay)) + (when doc-overlay + (delete-overlay doc-overlay)) + (when (< from to) + ;; Kludge: this doesn't need to be true for empty formats. + (delete-region from to)) + (set-marker from nil) + (set-marker to nil))) (widget-clear-undo)) (defun widget-default-value-set (widget value) @@ -2885,27 +2888,26 @@ The new widget gets inserted at the position of the BEFORE child." (last-deleted (when-let ((lst (widget-get widget :last-deleted))) (prog1 (pop lst) - (widget-put widget :last-deleted lst)))) - (inhibit-read-only t) - (inhibit-modification-hooks t)) - (cond (before - (goto-char (widget-get before :entry-from))) - (t - (goto-char (widget-get widget :value-pos)))) - (let ((child (widget-editable-list-entry-create - widget (and last-deleted - (widget-apply last-deleted - :value-to-external - (widget-get last-deleted :value))) - last-deleted))) - (when (< (widget-get child :entry-from) (widget-get widget :from)) - (set-marker (widget-get widget :from) - (widget-get child :entry-from))) - (if (eq (car children) before) - (widget-put widget :children (cons child children)) - (while (not (eq (car (cdr children)) before)) - (setq children (cdr children))) - (setcdr children (cons child (cdr children))))))) + (widget-put widget :last-deleted lst))))) + (widget--allow-insertion + (cond (before + (goto-char (widget-get before :entry-from))) + (t + (goto-char (widget-get widget :value-pos)))) + (let ((child (widget-editable-list-entry-create + widget (and last-deleted + (widget-apply last-deleted + :value-to-external + (widget-get last-deleted :value))) + last-deleted))) + (when (< (widget-get child :entry-from) (widget-get widget :from)) + (set-marker (widget-get widget :from) + (widget-get child :entry-from))) + (if (eq (car children) before) + (widget-put widget :children (cons child children)) + (while (not (eq (car (cdr children)) before)) + (setq children (cdr children))) + (setcdr children (cons child (cdr children)))))))) (widget-setup) (widget-apply widget :notify widget)) @@ -2922,24 +2924,22 @@ Save CHILD into the :last-deleted list, so it can be inserted later." ;; Delete child from list of children. (save-excursion (let ((buttons (copy-sequence (widget-get widget :buttons))) - button - (inhibit-read-only t) - (inhibit-modification-hooks t)) - (while buttons - (setq button (car buttons) - buttons (cdr buttons)) - (when (eq (widget-get button :widget) child) - (widget-put widget - :buttons (delq button (widget-get widget :buttons))) - (widget-delete button)))) + button) + (widget--allow-insertion + (while buttons + (setq button (car buttons) + buttons (cdr buttons)) + (when (eq (widget-get button :widget) child) + (widget-put widget + :buttons (delq button (widget-get widget :buttons))) + (widget-delete button))))) (let ((entry-from (widget-get child :entry-from)) - (entry-to (widget-get child :entry-to)) - (inhibit-read-only t) - (inhibit-modification-hooks t)) - (widget-delete child) - (delete-region entry-from entry-to) - (set-marker entry-from nil) - (set-marker entry-to nil)) + (entry-to (widget-get child :entry-to))) + (widget--allow-insertion + (widget-delete child) + (delete-region entry-from entry-to) + (set-marker entry-from nil) + (set-marker entry-to nil))) (widget-put widget :children (delq child (widget-get widget :children)))) (widget-setup) (widget-apply widget :notify widget)) -- cgit v1.2.3 From 129bc91a2c9b7a6e314b4a5a4c60c266ca1cac0f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 21 Mar 2024 12:08:02 -0400 Subject: wid-edit.el: Cosmetic changes * lisp/wid-edit.el: Use #' to quote function names. (widget--simplify-menu, widget-echo-help): Explicitly specify the lexenv to `eval`. (widget-choose, widget-get-sibling, widget-setup, widget-field-find) (widget-choice-action, widget-checklist-value-get) (widget-radio-value-create, widget-radio-value-set) (widget-radio-action, widget-editable-list-delete-at) (widget-group-value-create, widget-choice-prompt-value): Use `dolist`. (widget-convert): Hoist `(setq current` out of the ifs. (widget-convert): Hoist `(setq keys` out of the if. (widget-after-change): Hoist `(setq begin` out of the if. (widget-default-completions): Use `cond`. (widget-default-value-set): Hoist `goto-char` out of the if. (widget-choice-action): Hoist `nth` out of the if. (widget-checkbox-action): Hoist `widget-apply` out of the if. (widget-editable-list-value-create): Hoist `car` out of the if. (widget-editable-list-entry-create): Hoist `(setq child ...` out of the if. (widget-documentation-link-action): Fold `if` into `cond`. (widget-key-sequence-value-to-external): Use `key-parse`. (widget-plist-convert-option, widget-alist-convert-option): Hoist `(setq key-type` out of the if. --- lisp/wid-edit.el | 363 ++++++++++++++++++++++++------------------------------- 1 file changed, 159 insertions(+), 204 deletions(-) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 0645871f16d..f69a3d3b05f 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1,4 +1,4 @@ -;;; wid-edit.el --- Functions for creating and using widgets -*- lexical-binding:t -*- +;; wid-edit.el --- Functions for creating and using widgets -*- lexical-binding:t -*- ;; ;; Copyright (C) 1996-1997, 1999-2024 Free Software Foundation, Inc. ;; @@ -247,10 +247,10 @@ to evaluate to nil for the menu item to be meaningful." (eq (car value) :radio)) (setq selected (cdr value)))) (setq plist (cddr plist))) - (when (and (eval visible) - (eval enable) + (when (and (eval visible t) + (eval enable t) (or (not selected) - (not (eval selected)))) + (not (eval selected t)))) (push (cons (nth 1 def) ev) simplified))))) extended) (reverse simplified))) @@ -317,7 +317,7 @@ in the key vector, as in the argument of `define-key'." (when (keymapp items) (setq items (widget--simplify-menu items))) ;; Read the choice of name from the minibuffer. - (setq items (cl-remove-if 'stringp items)) + (setq items (cl-remove-if #'stringp items)) (let ((val (completing-read (concat title ": ") items nil t))) (if (stringp val) (let ((try (try-completion val items))) @@ -330,12 +330,11 @@ in the key vector, as in the argument of `define-key'." ;; Construct a menu of the choices ;; and then use it for prompting for a single character. (let ((next-digit ?0) - alist choice some-choice-enabled value) + alist some-choice-enabled value) (with-current-buffer (get-buffer-create " widget-choose") (erase-buffer) (insert "Available choices:\n\n") - (while items - (setq choice (pop items)) + (dolist (choice items) (when (consp choice) (insert (format "%c = %s\n" next-digit (car choice))) (push (cons next-digit (cdr choice)) alist) @@ -665,12 +664,9 @@ The current value is assumed to be VALUE, unless UNBOUND is non-nil." (defun widget-get-sibling (widget) "Get the item WIDGET is assumed to toggle. This is only meaningful for radio buttons or checkboxes in a list." - (let* ((children (widget-get (widget-get widget :parent) :children)) - child) + (let* ((children (widget-get (widget-get widget :parent) :children))) (catch 'child - (while children - (setq child (car children) - children (cdr children)) + (dolist (child children) (when (eq (widget-get child :button) widget) (throw 'child child))) nil))) @@ -850,14 +846,14 @@ button is pressed or inactive, respectively. These are currently ignored." (defun widget-create (type &rest args) "Create widget of TYPE. The optional ARGS are additional keyword arguments." - (let ((widget (apply 'widget-convert type args))) + (let ((widget (apply #'widget-convert type args))) (widget-apply widget :create) widget)) (defun widget-create-child-and-convert (parent type &rest args) "As part of the widget PARENT, create a child widget TYPE. The child is converted, using the keyword arguments ARGS." - (let ((widget (apply 'widget-convert type args))) + (let ((widget (apply #'widget-convert type args))) (widget-put widget :parent parent) (unless (widget-get widget :indent) (widget-put widget :indent (+ (or (widget-get parent :indent) 0) @@ -911,18 +907,19 @@ The optional ARGS are additional keyword arguments." (keys args)) ;; First set the :args keyword. (while (cdr current) ;Look in the type. - (if (and (keywordp (cadr current)) - ;; If the last element is a keyword, - ;; it is still the :args element, - ;; even though it is a keyword. - (cddr current)) - (if (eq (cadr current) :args) - ;; If :args is explicitly specified, obey it. - (setq current nil) - ;; Some other irrelevant keyword. - (setq current (cdr (cdr current)))) - (setcdr current (list :args (cdr current))) - (setq current nil))) + (setq current + (if (and (keywordp (cadr current)) + ;; If the last element is a keyword, + ;; it is still the :args element, + ;; even though it is a keyword. + (cddr current)) + (if (eq (cadr current) :args) + ;; If :args is explicitly specified, obey it. + nil + ;; Some other irrelevant keyword. + (cdr (cdr current))) + (setcdr current (list :args (cdr current))) + nil))) (while (and args (not done)) ;Look in ARGS. (cond ((eq (car args) :args) ;; Handle explicit specification of :args. @@ -943,11 +940,9 @@ The optional ARGS are additional keyword arguments." ;; Finally set the keyword args. (while keys (let ((next (nth 0 keys))) - (if (keywordp next) - (progn - (widget-put widget next (nth 1 keys)) - (setq keys (nthcdr 2 keys))) - (setq keys nil)))) + (setq keys (when (keywordp next) + (widget-put widget next (nth 1 keys)) + (nthcdr 2 keys))))) ;; Convert the :value to internal format. (if (widget-member widget :value) (widget-put widget @@ -972,7 +967,7 @@ and TO will be used as the widgets end points. If optional arguments BUTTON-FROM and BUTTON-TO are given, these will be used as the widgets button end points. Optional ARGS are extra keyword arguments for TYPE." - (let ((widget (apply 'widget-convert type :delete 'widget-leave-text args)) + (let ((widget (apply #'widget-convert type :delete 'widget-leave-text args)) (from (copy-marker from)) (to (copy-marker to))) (set-marker-insertion-type from t) @@ -989,7 +984,7 @@ Optional ARGS are extra keyword arguments for TYPE. No text will be inserted to the buffer, instead the text between FROM and TO will be used as the widgets end points, as well as the widgets button end points." - (apply 'widget-convert-text type from to from to args)) + (apply #'widget-convert-text type from to from to args)) (defun widget-leave-text (widget) "Remove markers and overlays from WIDGET and its children." @@ -1007,7 +1002,7 @@ button end points." (delete-overlay doc)) (when field (delete-overlay field)) - (mapc 'widget-leave-text (widget-get widget :children)))) + (mapc #'widget-leave-text (widget-get widget :children)))) (defun widget-text (widget) "Get the text representation of the widget." @@ -1022,7 +1017,7 @@ button end points." ;; Custom-mode) which key-binding of widget-keymap one wants to refer to. ;; https://lists.gnu.org/r/emacs-devel/2008-11/msg00480.html (define-obsolete-function-alias 'advertised-widget-backward - 'widget-backward "23.2") + #'widget-backward "23.2") ;;;###autoload (defvar widget-keymap @@ -1048,13 +1043,13 @@ Note that such modes will need to require wid-edit.") (defvar widget-field-keymap (let ((map (copy-keymap widget-keymap))) - (define-key map "\C-k" 'widget-kill-line) - (define-key map "\M-\t" 'widget-complete) - (define-key map "\C-m" 'widget-field-activate) + (define-key map "\C-k" #'widget-kill-line) + (define-key map "\M-\t" #'widget-complete) + (define-key map "\C-m" #'widget-field-activate) ;; Since the widget code uses a `field' property to identify fields, ;; ordinary beginning-of-line does the right thing. - ;; (define-key map "\C-a" 'widget-beginning-of-line) - (define-key map "\C-e" 'widget-end-of-line) + ;; (define-key map "\C-a" #'widget-beginning-of-line) + (define-key map "\C-e" #'widget-end-of-line) map) "Keymap used inside an editable field.") @@ -1062,8 +1057,8 @@ Note that such modes will need to require wid-edit.") (let ((map (copy-keymap widget-keymap))) ;; Since the widget code uses a `field' property to identify fields, ;; ordinary beginning-of-line does the right thing. - ;; (define-key map "\C-a" 'widget-beginning-of-line) - (define-key map "\C-e" 'widget-end-of-line) + ;; (define-key map "\C-a" #'widget-beginning-of-line) + (define-key map "\C-e" #'widget-end-of-line) map) "Keymap used inside a text field.") @@ -1304,7 +1299,7 @@ With optional ARG, move across that many fields." ;; Since the widget code uses a `field' property to identify fields, ;; ordinary beginning-of-line does the right thing. -(defalias 'widget-beginning-of-line 'beginning-of-line) +(defalias 'widget-beginning-of-line #'beginning-of-line) (defun widget-end-of-line () "Go to end of field or end of line, whichever is first. @@ -1382,17 +1377,14 @@ When not inside a field, signal an error." (defun widget-setup () "Setup current buffer so editing string widgets works." (widget--allow-insertion - (let (field) - (while widget-field-new - (setq field (car widget-field-new) - widget-field-new (cdr widget-field-new) - widget-field-list (cons field widget-field-list)) - (let ((from (car (widget-get field :field-overlay))) - (to (cdr (widget-get field :field-overlay)))) - (widget-specify-field field - (marker-position from) (marker-position to)) - (set-marker from nil) - (set-marker to nil))))) + (dolist (field widget-field-new) + (push field widget-field-list) + (let ((from (car (widget-get field :field-overlay))) + (to (cdr (widget-get field :field-overlay)))) + (widget-specify-field field + (marker-position from) (marker-position to)) + (set-marker from nil) + (set-marker to nil)))) (widget-clear-undo) (widget-add-change)) @@ -1467,11 +1459,8 @@ When not inside a field, signal an error." (defun widget-field-find (pos) "Return the field at POS. Unlike (get-char-property POS \\='field), this works with empty fields too." - (let ((fields widget-field-list) - field found) - (while fields - (setq field (car fields) - fields (cdr fields)) + (let (found) + (dolist (field widget-field-list) (when (and (<= (widget-field-start field) pos) (<= pos (widget-field-end field))) (when found @@ -1486,11 +1475,11 @@ Unlike (get-char-property POS \\='field), this works with empty fields too." (let ((from-field (widget-field-find from)) (to-field (widget-field-find to))) (cond ((not (eq from-field to-field)) - (add-hook 'post-command-hook 'widget-add-change nil t) + (add-hook 'post-command-hook #'widget-add-change nil t) (signal 'text-read-only '("Change should be restricted to a single field"))) ((null from-field) - (add-hook 'post-command-hook 'widget-add-change nil t) + (add-hook 'post-command-hook #'widget-add-change nil t) (signal 'text-read-only '("Attempt to change text outside editable field"))) (widget-field-use-before-change @@ -1498,9 +1487,9 @@ Unlike (get-char-property POS \\='field), this works with empty fields too." from-field (list 'before-change from to))))))) (defun widget-add-change () - (remove-hook 'post-command-hook 'widget-add-change t) - (add-hook 'before-change-functions 'widget-before-change nil t) - (add-hook 'after-change-functions 'widget-after-change nil t)) + (remove-hook 'post-command-hook #'widget-add-change t) + (add-hook 'before-change-functions #'widget-before-change nil t) + (add-hook 'after-change-functions #'widget-after-change nil t)) (defun widget-after-change (from to _old) "Adjust field size and text properties." @@ -1520,12 +1509,12 @@ Unlike (get-char-property POS \\='field), this works with empty fields too." (insert-char ?\s (- (+ begin size) end)))) ((> (- end begin) size) ;; Field too large and - (if (or (< (point) (+ begin size)) - (> (point) end)) - ;; Point is outside extra space. - (setq begin (+ begin size)) - ;; Point is within the extra space. - (setq begin (point))) + (setq begin (if (or (< (point) (+ begin size)) + (> (point) end)) + ;; Point is outside extra space. + (+ begin size) + ;; Point is within the extra space. + (point))) (save-excursion (goto-char end) (while (and (eq (preceding-char) ?\s) @@ -1545,9 +1534,9 @@ Optional EVENT is the event that triggered the action." (defun widget-children-value-delete (widget) "Delete all :children and :buttons in WIDGET." - (mapc 'widget-delete (widget-get widget :children)) + (mapc #'widget-delete (widget-get widget :children)) (widget-put widget :children nil) - (mapc 'widget-delete (widget-get widget :buttons)) + (mapc #'widget-delete (widget-get widget :buttons)) (widget-put widget :buttons nil)) (defun widget-children-validate (widget) @@ -1598,13 +1587,13 @@ The value of the :type attribute should be an unconverted widget type." (defun widget-types-copy (widget) "Copy :args as widget types in WIDGET." - (widget-put widget :args (mapcar 'widget-copy (widget-get widget :args))) + (widget-put widget :args (mapcar #'widget-copy (widget-get widget :args))) widget) ;; Made defsubst to speed up face editor creation. (defsubst widget-types-convert-widget (widget) "Convert :args as widget types in WIDGET." - (widget-put widget :args (mapcar 'widget-convert (widget-get widget :args))) + (widget-put widget :args (mapcar #'widget-convert (widget-get widget :args))) widget) (defun widget-value-convert-widget (widget) @@ -1659,17 +1648,18 @@ The value of the :type attribute should be an unconverted widget type." (defun widget-default-completions (widget) "Return completion data, like `completion-at-point-functions' would." (let ((completions (widget-get widget :completions))) - (if completions - (list (widget-field-start widget) - (max (point) (widget-field-text-end widget)) - completions) - (if (widget-get widget :complete) - (lambda () (widget-apply widget :complete)) - (if (widget-get widget :complete-function) - (lambda () - (let ((widget--completing-widget widget)) - (call-interactively - (widget-get widget :complete-function))))))))) + (cond + (completions + (list (widget-field-start widget) + (max (point) (widget-field-text-end widget)) + completions)) + ((widget-get widget :complete) + (lambda () (widget-apply widget :complete))) + ((widget-get widget :complete-function) + (lambda () + (let ((widget--completing-widget widget)) + (call-interactively + (widget-get widget :complete-function)))))))) (defun widget-default-create (widget) "Create WIDGET at point in the current buffer." @@ -1814,9 +1804,9 @@ The value of the :type attribute should be an unconverted widget type." (widget-put widget :value value) (widget-apply widget :create)) (if offset - (if (< offset 0) - (goto-char (+ (widget-get widget :to) offset 1)) - (goto-char (min (+ from offset) (1- (widget-get widget :to)))))))) + (goto-char (if (< offset 0) + (+ (widget-get widget :to) offset 1) + (min (+ from offset) (1- (widget-get widget :to)))))))) (defun widget-default-value-inline (widget) "Wrap value in a list unless it is inline." @@ -1979,8 +1969,8 @@ as the argument to `documentation-property'." ;; Only bind mouse-2, since mouse-1 will be translated accordingly to ;; the customization of `mouse-1-click-follows-link'. (define-key map [down-mouse-1] (lookup-key widget-global-map [down-mouse-1])) - (define-key map [down-mouse-2] 'widget-button-click) - (define-key map [mouse-2] 'widget-button-click) + (define-key map [down-mouse-2] #'widget-button-click) + (define-key map [mouse-2] #'widget-button-click) map) "Keymap used inside a link widget.") @@ -2328,13 +2318,10 @@ when he invoked the menu." ((and widget-choice-toggle (= (length args) 2) (memq old args)) - (if (eq old (nth 0 args)) - (nth 1 args) - (nth 0 args))) + (nth (if (eq old (nth 0 args)) 1 0) + args)) (t - (while args - (setq current (car args) - args (cdr args)) + (dolist (current args) (setq choices (cons (cons (widget-apply current :menu-tag-get) current) @@ -2427,9 +2414,8 @@ when he invoked the menu." (widget-toggle-action widget event) (let ((sibling (widget-get-sibling widget))) (when sibling - (if (widget-value widget) - (widget-apply sibling :activate) - (widget-apply sibling :deactivate)) + (widget-apply sibling + (if (widget-value widget) :activate :deactivate)) (widget-clear-undo)))) ;;; The `checklist' Widget. @@ -2478,7 +2464,7 @@ If the item is checked, CHOSEN is a cons whose cdr is the value." (cond ((eq escape ?%) (insert ?%)) ((eq escape ?b) - (setq button (apply 'widget-create-child-and-convert + (setq button (apply #'widget-create-child-and-convert widget 'checkbox :value (not (null chosen)) button-args))) @@ -2558,11 +2544,8 @@ Return an alist of (TYPE MATCH)." (defun widget-checklist-value-get (widget) ;; The values of all selected items. - (let ((children (widget-get widget :children)) - child result) - (while children - (setq child (car children) - children (cdr children)) + (let (result) + (dolist (child (widget-get widget :children)) (if (widget-value (widget-get child :button)) (setq result (append result (widget-apply child :value-inline))))) result)) @@ -2630,12 +2613,8 @@ Return an alist of (TYPE MATCH)." (defun widget-radio-value-create (widget) ;; Insert all values - (let ((args (widget-get widget :args)) - arg) - (while args - (setq arg (car args) - args (cdr args)) - (widget-radio-add-item widget arg)))) + (dolist (arg (widget-get widget :args)) + (widget-radio-add-item widget arg))) (defun widget-radio-add-item (widget type) "Add to radio widget WIDGET a new radio button item of type TYPE." @@ -2662,7 +2641,7 @@ Return an alist of (TYPE MATCH)." (cond ((eq escape ?%) (insert ?%)) ((eq escape ?b) - (setq button (apply 'widget-create-child-and-convert + (setq button (apply #'widget-create-child-and-convert widget 'radio-button :value (not (null chosen)) button-args))) @@ -2718,11 +2697,8 @@ Return an alist of (TYPE MATCH)." ;; We can't just delete and recreate a radio widget, since children ;; can be added after the original creation and won't be recreated ;; by `:create'. - (let ((children (widget-get widget :children)) - current found) - (while children - (setq current (car children) - children (cdr children)) + (let (found) + (dolist (current (widget-get widget :children)) (let* ((button (widget-get current :button)) (match (and (not found) (widget-apply current :match value)))) @@ -2749,13 +2725,9 @@ Return an alist of (TYPE MATCH)." (defun widget-radio-action (widget child event) ;; Check if a radio button was pressed. - (let ((children (widget-get widget :children)) - (buttons (widget-get widget :buttons)) - current) + (let ((buttons (widget-get widget :buttons))) (when (memq child buttons) - (while children - (setq current (car children) - children (cdr children)) + (dolist (current (widget-get widget :children)) (let* ((button (widget-get current :button))) (cond ((eq child button) (widget-value-set button t) @@ -2825,7 +2797,7 @@ Return an alist of (TYPE MATCH)." (and (widget--should-indent-p) (widget-get widget :indent) (insert-char ?\s (widget-get widget :indent))) - (apply 'widget-create-child-and-convert + (apply #'widget-create-child-and-convert widget 'insert-button (widget-get widget :append-button-args))) (t @@ -2845,9 +2817,9 @@ Return an alist of (TYPE MATCH)." (if answer (setq children (cons (widget-editable-list-entry-create widget - (if (widget-inline-p type t) - (car answer) - (car (car answer))) + (car (if (widget-inline-p type t) + answer + (car answer))) t) children) value (cdr answer)) @@ -2856,8 +2828,8 @@ Return an alist of (TYPE MATCH)." (defun widget-editable-list-value-get (widget) ;; Get value of the child widget. - (apply 'append (mapcar (lambda (child) (widget-apply child :value-inline)) - (widget-get widget :children)))) + (apply #'append (mapcar (lambda (child) (widget-apply child :value-inline)) + (widget-get widget :children)))) (defun widget-editable-list-match (widget value) ;; Value must be a list and all the members must match the type. @@ -2923,16 +2895,12 @@ Save CHILD into the :last-deleted list, so it can be inserted later." (widget-put widget :last-deleted lst)) ;; Delete child from list of children. (save-excursion - (let ((buttons (copy-sequence (widget-get widget :buttons))) - button) - (widget--allow-insertion - (while buttons - (setq button (car buttons) - buttons (cdr buttons)) - (when (eq (widget-get button :widget) child) - (widget-put widget - :buttons (delq button (widget-get widget :buttons))) - (widget-delete button))))) + (widget--allow-insertion + (dolist (button (copy-sequence (widget-get widget :buttons))) + (when (eq (widget-get button :widget) child) + (widget-put widget + :buttons (delq button (widget-get widget :buttons))) + (widget-delete button)))) (let ((entry-from (widget-get child :entry-from)) (entry-to (widget-get child :entry-to))) (widget--allow-insertion @@ -2962,19 +2930,17 @@ Save CHILD into the :last-deleted list, so it can be inserted later." (cond ((eq escape ?%) (insert ?%)) ((eq escape ?i) - (setq insert (apply 'widget-create-child-and-convert + (setq insert (apply #'widget-create-child-and-convert widget 'insert-button (widget-get widget :insert-button-args)))) ((eq escape ?d) - (setq delete (apply 'widget-create-child-and-convert + (setq delete (apply #'widget-create-child-and-convert widget 'delete-button (widget-get widget :delete-button-args)))) ((eq escape ?v) - (if conv - (setq child (widget-create-child-value - widget type value)) - (setq child (widget-create-child-value - widget type (widget-default-get type))))) + (setq child (widget-create-child-value + widget type + (if conv value (widget-default-get type))))) (t (error "Unknown escape `%c'" escape))))) (let ((buttons (widget-get widget :buttons))) @@ -3014,13 +2980,10 @@ Save CHILD into the :last-deleted list, so it can be inserted later." (defun widget-group-value-create (widget) ;; Create each component. - (let ((args (widget-get widget :args)) - (value (widget-get widget :value)) - arg answer children) - (while args - (setq arg (car args) - args (cdr args) - answer (widget-match-inline arg value) + (let ((value (widget-get widget :value)) + answer children) + (dolist (arg (widget-get widget :args)) + (setq answer (widget-match-inline arg value) value (cdr answer)) (and (widget--should-indent-p) (widget-get widget :indent) @@ -3036,7 +2999,7 @@ Save CHILD into the :last-deleted list, so it can be inserted later." (defun widget-group-default-get (widget) ;; Get the default of the components. - (mapcar 'widget-default-get (widget-get widget :args))) + (mapcar #'widget-default-get (widget-get widget :args))) (defun widget-group-match (widget vals) ;; Match if the components match. @@ -3094,20 +3057,20 @@ The following properties have special meanings for this widget: "Display documentation for WIDGET's value. Ignore optional argument EVENT." (let* ((string (widget-get widget :value)) (symbol (intern string))) - (if (and (fboundp symbol) (boundp symbol)) - ;; If there are two doc strings, give the user a way to pick one. - (apropos (concat "\\`" (regexp-quote string) "\\'")) - (cond - ((fboundp symbol) - (describe-function symbol)) - ((facep symbol) - (describe-face symbol)) - ((featurep symbol) - (describe-package symbol)) - ((or (boundp symbol) (get symbol 'variable-documentation)) - (describe-variable symbol)) - (t - (message "No documentation available for %s" symbol)))))) + (cond + ((and (fboundp symbol) (boundp symbol)) + ;; If there are two doc strings, give the user a way to pick one. + (apropos (concat "\\`" (regexp-quote string) "\\'"))) + ((fboundp symbol) + (describe-function symbol)) + ((facep symbol) + (describe-face symbol)) + ((featurep symbol) + (describe-package symbol)) + ((or (boundp symbol) (get symbol 'variable-documentation)) + (describe-variable symbol)) + (t + (message "No documentation available for %s" symbol))))) (defcustom widget-documentation-links t "Add hyperlinks to documentation strings when non-nil." @@ -3240,7 +3203,7 @@ Optional ARGS specifies additional keyword arguments for the (unless (or (numberp doc-indent) (null doc-indent)) (setq doc-indent 0)) (widget-put widget :buttons - (cons (apply 'widget-create-child-and-convert + (cons (apply #'widget-create-child-and-convert widget 'documentation-string :indent doc-indent (nconc args (list doc))) @@ -3352,18 +3315,18 @@ It reads a file name from an editable text field." (must-match (widget-get widget :must-match))) (read-file-name (format-prompt prompt value) dir nil must-match file))))) -;;;(defun widget-file-action (widget &optional event) -;;; ;; Read a file name from the minibuffer. -;;; (let* ((value (widget-value widget)) -;;; (dir (file-name-directory value)) -;;; (file (file-name-nondirectory value)) -;;; (menu-tag (widget-apply widget :menu-tag-get)) -;;; (must-match (widget-get widget :must-match)) -;;; (answer (read-file-name (format-prompt menu-tag value) -;;; dir nil must-match file))) -;;; (widget-value-set widget (abbreviate-file-name answer)) -;;; (widget-setup) -;;; (widget-apply widget :notify widget event))) +;;(defun widget-file-action (widget &optional event) +;; ;; Read a file name from the minibuffer. +;; (let* ((value (widget-value widget)) +;; (dir (file-name-directory value)) +;; (file (file-name-nondirectory value)) +;; (menu-tag (widget-apply widget :menu-tag-get)) +;; (must-match (widget-get widget :must-match)) +;; (answer (read-file-name (format-prompt menu-tag value) +;; dir nil must-match file))) +;; (widget-value-set widget (abbreviate-file-name answer)) +;; (widget-setup) +;; (widget-apply widget :notify widget event))) ;; Fixme: use file-name-as-directory. (define-widget 'directory 'file @@ -3552,7 +3515,7 @@ It reads a directory name from an editable text field." (if (stringp value) (if (string-match "\\`[[:space:]]*\\'" value) widget-key-sequence-default-value - (read-kbd-macro value)) + (key-parse value)) value)) @@ -3825,7 +3788,7 @@ or a list with the default value of each component of the list WIDGET." :format "%{%t%}:\n%v" :match 'widget-vector-match :value-to-internal (lambda (_widget value) (append value nil)) - :value-to-external (lambda (_widget value) (apply 'vector value))) + :value-to-external (lambda (_widget value) (apply #'vector value))) (defun widget-vector-match (widget value) (and (vectorp value) @@ -3840,7 +3803,7 @@ or a list with the default value of each component of the list WIDGET." :value-to-internal (lambda (_widget value) (list (car value) (cdr value))) :value-to-external (lambda (_widget value) - (apply 'cons value))) + (apply #'cons value))) (defun widget-cons-match (widget value) (and (consp value) @@ -3927,7 +3890,7 @@ example: (args (if options (list `(checklist :inline t :greedy t - ,@(mapcar 'widget-plist-convert-option + ,@(mapcar #'widget-plist-convert-option options)) other) (list other)))) @@ -3940,9 +3903,7 @@ example: (if (listp option) (let ((key (nth 0 option))) (setq value-type (nth 1 option)) - (if (listp key) - (setq key-type key) - (setq key-type `(const ,key)))) + (setq key-type (if (listp key) key `(const ,key)))) (setq key-type `(const ,option) value-type widget-plist-value-type)) `(group :format "Key: %v" :inline t ,key-type ,value-type))) @@ -3972,7 +3933,7 @@ example: (args (if options (list `(checklist :inline t :greedy t - ,@(mapcar 'widget-alist-convert-option + ,@(mapcar #'widget-alist-convert-option options)) other) (list other)))) @@ -3985,9 +3946,7 @@ example: (if (listp option) (let ((key (nth 0 option))) (setq value-type (nth 1 option)) - (if (listp key) - (setq key-type key) - (setq key-type `(const ,key)))) + (setq key-type (if (listp key) key `(const ,key)))) (setq key-type `(const ,option) value-type widget-alist-value-type)) `(cons :format "Key: %v" ,key-type ,value-type))) @@ -4045,17 +4004,13 @@ current choice is inline." ((and widget-choice-toggle (= (length args) 2) (memq old args)) - (if (eq old (nth 0 args)) - (nth 1 args) - (nth 0 args))) + (nth (if (eq old (nth 0 args)) 1 0) + args)) (t - (while args - (setq current (car args) - args (cdr args)) - (setq choices - (cons (cons (widget-apply current :menu-tag-get) - current) - choices))) + (dolist (current args) + (push (cons (widget-apply current :menu-tag-get) + current) + choices)) (let ((val (completing-read prompt choices nil t))) (if (stringp val) (let ((try (try-completion val choices))) @@ -4206,7 +4161,7 @@ is inline." (help-echo (and widget (widget-get widget :help-echo)))) (if (functionp help-echo) (setq help-echo (funcall help-echo widget))) - (if help-echo (message "%s" (eval help-echo))))) + (if help-echo (message "%s" (eval help-echo t))))) (define-obsolete-function-alias 'widget-sublist #'seq-subseq "28.1") (define-obsolete-function-alias 'widget-visibility-value-create -- cgit v1.2.3 From e819413e24d81875abaf81c281115e695ad5cc28 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 21 Mar 2024 12:28:54 -0400 Subject: Speed up `describe-char` when a property has a large value Doing `C-u C-x =` on a buffer position where the overlay/text properties hold large values (e.g. inside the profiler report) can be surprisingly slow because it pretty prints all those properties. Change the code to do the pretty printing more lazily. While at it, share that duplicated code between `descr-text.el` and `wid-browse.el`. * lisp/emacs-lisp/pp.el (pp-insert-short-sexp): New function. * lisp/descr-text.el (describe-text-sexp): Delete function. (describe-property-list): Use `pp-insert-short-sexp` instead. * lisp/wid-browse.el (widget-browse-sexp): Use `pp-insert-short-sexp` and `widget--allow-insertion`. --- lisp/descr-text.el | 52 +++++++++++++++++---------------------------------- lisp/emacs-lisp/pp.el | 17 +++++++++++++++++ lisp/wid-browse.el | 34 ++++++++++----------------------- 3 files changed, 44 insertions(+), 59 deletions(-) diff --git a/lisp/descr-text.el b/lisp/descr-text.el index eeab995c37d..524a6474cd4 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -42,26 +42,6 @@ (insert-text-button "(widget)Top" 'type 'help-info 'help-args '("(widget)Top"))) -(defun describe-text-sexp (sexp) - "Insert a short description of SEXP in the current buffer." - (let ((pp (condition-case signal - (pp-to-string sexp) - (error (prin1-to-string signal))))) - (when (string-match-p "\n\\'" pp) - (setq pp (substring pp 0 (1- (length pp))))) - - (if (and (not (string-search "\n" pp)) - (<= (length pp) (- (window-width) (current-column)))) - (insert pp) - (insert-text-button - "[Show]" - 'follow-link t - 'action (lambda (&rest _ignore) - (with-output-to-temp-buffer - "*Pp Eval Output*" - (princ pp))) - 'help-echo "mouse-2, RET: pretty print value in another buffer")))) - (defun describe-property-list (properties) "Insert a description of PROPERTIES in the current buffer. PROPERTIES should be a list of overlay or text properties. @@ -92,7 +72,9 @@ into help buttons that call `describe-text-category' or (format "%S" value) 'type 'help-face 'help-args (list value))) (t - (describe-text-sexp value)))) + (require 'pp) + (declare-function pp-insert-short-sexp "pp" (sexp &optional width)) + (pp-insert-short-sexp value)))) (insert "\n"))) ;;; Describe-Text Commands. @@ -522,24 +504,24 @@ The character information includes: (setcar composition (concat " with the surrounding characters \"" - (mapconcat 'describe-char-padded-string - (buffer-substring from pos) "") + (mapconcat #'describe-char-padded-string + (buffer-substring from pos)) "\" and \"" - (mapconcat 'describe-char-padded-string - (buffer-substring (1+ pos) to) "") + (mapconcat #'describe-char-padded-string + (buffer-substring (1+ pos) to)) "\"")) (setcar composition (concat " with the preceding character(s) \"" - (mapconcat 'describe-char-padded-string - (buffer-substring from pos) "") + (mapconcat #'describe-char-padded-string + (buffer-substring from pos)) "\""))) (if (< (1+ pos) to) (setcar composition (concat " with the following character(s) \"" - (mapconcat 'describe-char-padded-string - (buffer-substring (1+ pos) to) "") + (mapconcat #'describe-char-padded-string + (buffer-substring (1+ pos) to)) "\"")) (setcar composition nil))) (setcar (cdr composition) @@ -568,7 +550,7 @@ The character information includes: ("character" ,(format "%s (displayed as %s) (codepoint %d, #o%o, #x%x)" char-description - (apply 'propertize char-description + (apply #'propertize char-description (text-properties-at pos)) char char char)) ("charset" @@ -620,7 +602,7 @@ The character information includes: (if (consp key-list) (list "type" (concat "\"" - (mapconcat 'identity + (mapconcat #'identity key-list "\" or \"") "\"") "with" @@ -721,7 +703,7 @@ The character information includes: (let ((unicodedata (describe-char-unicode-data char))) (if unicodedata (cons (list "Unicode data" "") unicodedata)))))) - (setq max-width (apply 'max (mapcar (lambda (x) + (setq max-width (apply #'max (mapcar (lambda (x) (if (cadr x) (length (car x)) 0)) item-list))) (set-buffer src-buf) @@ -736,7 +718,7 @@ The character information includes: (dolist (clm (cdr elt)) (cond ((eq (car-safe clm) 'insert-text-button) (insert " ") - (eval clm)) + (eval clm t)) ((not (zerop (length clm))) (insert " " clm)))) (insert "\n")))) @@ -855,7 +837,7 @@ The character information includes: (insert "\n") (dolist (elt (cond ((eq describe-char-unidata-list t) - (nreverse (mapcar 'car char-code-property-alist))) + (nreverse (mapcar #'car char-code-property-alist))) ((< char 32) ;; Temporary fix (2016-05-22): The ;; decomposition item for \n corrupts the @@ -898,7 +880,7 @@ characters." (setq width (- width (length (car last)) 1))) (let ((ellipsis (and (cdr last) "..."))) (setcdr last nil) - (concat (mapconcat 'identity words " ") ellipsis))) + (concat (mapconcat #'identity words " ") ellipsis))) ""))) (defun describe-char-eldoc--format (ch &optional width) diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 569f70ca604..de7468b3e38 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -346,6 +346,23 @@ after OUT-BUFFER-NAME." (setq buffer-read-only nil) (setq-local font-lock-verbose nil))))) +(defun pp-insert-short-sexp (sexp &optional width) + "Insert a short description of SEXP in the current buffer. +WIDTH is the maximum width to use for it and it defaults to the +space available between point and the window margin." + (let ((printed (format "%S" sexp))) + (if (and (not (string-search "\n" printed)) + (<= (string-width printed) + (or width (- (window-width) (current-column))))) + (insert printed) + (insert-text-button + "[Show]" + 'follow-link t + 'action (lambda (&rest _ignore) + ;; FIXME: Why "eval output"? + (pp-display-expression sexp "*Pp Eval Output*")) + 'help-echo "mouse-2, RET: pretty print value in another buffer")))) + ;;;###autoload (defun pp-eval-expression (expression) "Evaluate EXPRESSION and pretty-print its value. diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el index bb56f3f62fb..d4000187bd1 100644 --- a/lisp/wid-browse.el +++ b/lisp/wid-browse.el @@ -141,7 +141,7 @@ The following commands are available: (setq key (nth 0 items) value (nth 1 items) printer (or (get key 'widget-keyword-printer) - 'widget-browse-sexp) + #'widget-browse-sexp) items (cdr (cdr items))) (widget-insert "\n" (symbol-name key) "\n\t") (funcall printer widget key value) @@ -204,24 +204,10 @@ VALUE is assumed to be a list of widgets." (defun widget-browse-sexp (_widget _key value) "Insert description of WIDGET's KEY VALUE. Nothing is assumed about value." - (let ((pp (condition-case signal - (pp-to-string value) - (error (prin1-to-string signal))))) - (when (string-match "\n\\'" pp) - (setq pp (substring pp 0 (1- (length pp))))) - (if (cond ((string-search "\n" pp) - nil) - ((> (length pp) (- (window-width) (current-column))) - nil) - (t t)) - (widget-insert pp) - (widget-create 'push-button - :tag "show" - :action (lambda (widget &optional _event) - (with-output-to-temp-buffer - "*Pp Eval Output*" - (princ (widget-get widget :value)))) - pp)))) + (require 'pp) + (declare-function pp-insert-short-sexp "pp" (sexp &optional width)) + (widget--allow-insertion + (pp-insert-short-sexp value))) (defun widget-browse-sexps (widget key value) "Insert description of WIDGET's KEY VALUE. @@ -235,11 +221,11 @@ VALUE is assumed to be a list of widgets." ;;; Keyword Printers. -(put :parent 'widget-keyword-printer 'widget-browse-widget) -(put :children 'widget-keyword-printer 'widget-browse-widgets) -(put :buttons 'widget-keyword-printer 'widget-browse-widgets) -(put :button 'widget-keyword-printer 'widget-browse-widget) -(put :args 'widget-keyword-printer 'widget-browse-sexps) +(put :parent 'widget-keyword-printer #'widget-browse-widget) +(put :children 'widget-keyword-printer #'widget-browse-widgets) +(put :buttons 'widget-keyword-printer #'widget-browse-widgets) +(put :button 'widget-keyword-printer #'widget-browse-widget) +(put :args 'widget-keyword-printer #'widget-browse-sexps) ;;; Widget Minor Mode. -- cgit v1.2.3 From afb7a23e7b914b4c3b72172ae86a5f7e63f2cfde Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 21 Mar 2024 21:35:24 +0200 Subject: ; Improve documentation of 'backup-by-copying' * doc/emacs/files.texi (Backup Copying): Recommend 'backup-by-copying' for files on file-hosting services. (Bug#69930) --- doc/emacs/files.texi | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 971483a6e4c..d074a55b762 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -779,6 +779,12 @@ operations typically break hard links, disconnecting the file name you visited from any alternate names for the same file. This has nothing to do with Emacs---the version control system does it. + Some file storage services support @dfn{file versioning}: they +record history of previous versions of files, and allow reverting to +those previous versions. If you want to be able to do that with files +hosted by those services when editing them with Emacs, customize +@code{backup-by-copying} to a non-@code{nil} value. + @node Customize Save @subsection Customizing Saving of Files -- cgit v1.2.3 From e95a8622263d8182e80777f87b7ca52cedbd1b28 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 21 Mar 2024 22:12:40 +0200 Subject: ; * lisp/keymap.el (key-parse): Fix processing of "[TAB]". (Bug#69893) --- lisp/keymap.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/keymap.el b/lisp/keymap.el index 065c59da74c..4bdf65d39fa 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -260,7 +260,7 @@ returned by \\[describe-key] (`describe-key')." (setq word (concat (match-string 1 word) (match-string 3 word))) (not (string-match - "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$" + "\\<\\(NUL\\|RET\\|LFD\\|TAB\\|ESC\\|SPC\\|DEL\\)$" word)))) (setq key (list (intern word)))) ((or (equal word "REM") (string-match "^;;" word)) -- cgit v1.2.3 From 05b8de54e30fdfccda78c5cfc2481828b897614b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 21 Mar 2024 18:16:41 -0400 Subject: byte-opt.el: Remove test that's not applicable any more * lisp/emacs-lisp/byte-opt.el: Remove left-over test for ancient byte-compiled representation. --- lisp/emacs-lisp/byte-opt.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index f75be3f71ad..f6df40a2d9b 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -3116,7 +3116,6 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; (eval-when-compile (or (compiled-function-p (symbol-function 'byte-optimize-form)) - (assq 'byte-code (symbol-function 'byte-optimize-form)) (let ((byte-optimize nil) (byte-compile-warnings nil)) (mapc (lambda (x) -- cgit v1.2.3 From 2000d6e0f27f9f34f343016f4aa93e09c29c8695 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 21 Mar 2024 18:27:03 -0400 Subject: (describe-symbol-backends): Fix addition of the "type" backend That backend was added from `cl-extra.el` with no autoload, so (describe-symbol `advice) failed to show the info about the `advice` type unless `cl-extra.el` had been loaded beforehand. `C-h o RET advice RET` worked by accident because the completion table uses `cl-some` which is autoloaded from `cl-extra.el`. * lisp/help-mode.el (describe-symbol-backends): Add the "type" backend. * lisp/emacs-lisp/cl-extra.el (describe-symbol-backends): Don't add the "type" backend here. --- lisp/emacs-lisp/cl-extra.el | 7 ------- lisp/help-mode.el | 3 +++ 2 files changed, 3 insertions(+), 7 deletions(-) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index c8eaca9a77c..d43c21d3eb9 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -711,13 +711,6 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (eval-when-compile (require 'cl-macs)) ;Explicitly, for cl--find-class. (require 'help-mode) -;; FIXME: We could go crazy and add another entry so describe-symbol can be -;; used with the slot names of CL structs (and/or EIEIO objects). -(add-to-list 'describe-symbol-backends - `(nil ,#'cl-find-class ,#'cl-describe-type) - ;; Document the `cons` function before the `cons` type. - t) - (defconst cl--typedef-regexp (concat "(" (regexp-opt '("defclass" "defstruct" "cl-defstruct" "cl-deftype" "deftype")) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index f9ec8a5cc2b..dd78342ace7 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -545,6 +545,9 @@ it does not already exist." (or (and (boundp symbol) (not (keywordp symbol))) (get symbol 'variable-documentation))) ,#'describe-variable) + ;; FIXME: We could go crazy and add another entry so describe-symbol can be + ;; used with the slot names of CL structs (and/or EIEIO objects). + ("type" ,#'cl-find-class ,#'cl-describe-type) ("face" ,#'facep ,(lambda (s _b _f) (describe-face s)))) "List of providers of information about symbols. Each element has the form (NAME TESTFUN DESCFUN) where: -- cgit v1.2.3 From c214fc9626c8b37e4d155a6d3caebe2e09fd0ab2 Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Thu, 21 Mar 2024 23:55:38 +0100 Subject: Update to Transient v0.6.0-1-gcaef3347 --- doc/misc/transient.texi | 28 +++-- lisp/transient.el | 279 +++++++++++++++++++++++++++++++----------------- 2 files changed, 202 insertions(+), 105 deletions(-) diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi index f76edc6b1e4..3a6486903bf 100644 --- a/doc/misc/transient.texi +++ b/doc/misc/transient.texi @@ -31,7 +31,7 @@ General Public License for more details. @finalout @titlepage @title Transient User and Developer Manual -@subtitle for version 0.5.2 +@subtitle for version 0.6.0 @author Jonas Bernoulli @page @vskip 0pt plus 1filll @@ -53,7 +53,7 @@ resource to get over that hurdle is Psionic K's interactive tutorial, available at @uref{https://github.com/positron-solutions/transient-showcase}. @noindent -This manual is for Transient version 0.5.2. +This manual is for Transient version 0.6.0. @insertcopying @end ifnottex @@ -554,7 +554,7 @@ state, you have to make sure that that state is currently active. @item @kbd{C-x a} (@code{transient-toggle-level-limit}) @kindex C-x a @findex transient-toggle-level-limit -This command toggle whether suffixes that are on levels lower than +This command toggle whether suffixes that are on levels higher than the level specified by @code{transient-default-level} are temporarily available anyway. @end table @@ -1206,9 +1206,19 @@ The returned children must have the same form as stored in the prefix's @code{transient--layout} property, but it is often more convenient to use the same form as understood by @code{transient-define-prefix}, described below. If you use the latter approach, you can use the -@code{transient-parse-child} and @code{transient-parse-children} functions to +@code{transient-parse-suffixes} and @code{transient-parse-suffix} functions to transform them from the convenient to the expected form. +If you explicitly specify children and then transform them using +@code{:setup-chilren}, then the class of the group is determined as usual, +based on explicitly specified children. + +If you do not explicitly specify children and thus rely solely on +@code{:setup-children}, then you must specify the class using @code{:class}. +For backward compatibility, if you fail to do so, @code{transient-column} +is used and a warning is displayed. This warning will eventually +be replaced with an error. + @item The boolean @code{:pad-keys} argument controls whether keys of all suffixes contained in a group are right padded, effectively aligning the @@ -1220,11 +1230,11 @@ The @var{ELEMENT}s are either all subgroups, or all suffixes and strings. subgroups with commands at the same level, though in principle there is nothing that prevents that.) -If the @var{ELEMENT}s are not subgroups, then they can be a mixture of lists -that specify commands and strings. Strings are inserted verbatim into -the buffer. The empty string can be used to insert gaps between -suffixes, which is particularly useful if the suffixes are outlined as -a table. +If the @var{ELEMENT}s are not subgroups, then they can be a mixture of +lists, which specify commands, and strings. Strings are inserted +verbatim into the buffer. The empty string can be used to insert gaps +between suffixes, which is particularly useful if the suffixes are +outlined as a table. Inside group specifications, including inside contained suffix specifications, nothing has to be quoted and quoting anyway is diff --git a/lisp/transient.el b/lisp/transient.el index bb35746e186..2d8566a3ac4 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -5,7 +5,7 @@ ;; Author: Jonas Bernoulli ;; URL: https://github.com/magit/transient ;; Keywords: extensions -;; Version: 0.5.2 +;; Version: 0.6.0 ;; SPDX-License-Identifier: GPL-3.0-or-later @@ -93,17 +93,20 @@ enclosed in a `progn' form. ELSE-FORMS may be empty." then-form (cons 'progn else-forms))) -(defmacro transient--with-emergency-exit (&rest body) +(defmacro transient--with-emergency-exit (id &rest body) (declare (indent defun)) + (unless (keywordp id) + (setq body (cons id body)) + (setq id nil)) `(condition-case err (let ((debugger #'transient--exit-and-debug)) ,(macroexp-progn body)) ((debug error) - (transient--emergency-exit) + (transient--emergency-exit ,id) (signal (car err) (cdr err))))) (defun transient--exit-and-debug (&rest args) - (transient--emergency-exit) + (transient--emergency-exit :debugger) (apply #'debug args)) ;;; Options @@ -668,6 +671,7 @@ If `transient-save-history' is nil, then do nothing." (incompatible :initarg :incompatible :initform nil) (suffix-description :initarg :suffix-description) (variable-pitch :initarg :variable-pitch :initform nil) + (column-widths :initarg :column-widths :initform nil) (unwind-suffix :documentation "Internal use." :initform nil)) "Transient prefix command. @@ -725,7 +729,8 @@ slot is non-nil." :abstract t) (defclass transient-suffix (transient-child) - ((key :initarg :key) + ((definition :allocation :class :initform nil) + (key :initarg :key) (command :initarg :command) (transient :initarg :transient) (format :initarg :format :initform " %k %d") @@ -946,7 +951,10 @@ ARGLIST. The infix arguments are usually accessed by using (pcase-let ((`(,class ,slots ,_ ,docstr ,body) (transient--expand-define-args args arglist))) `(progn - (defalias ',name (lambda ,arglist ,@body)) + (defalias ',name + ,(if (and (not body) class (oref-default class definition)) + `(oref-default ',class definition) + `(lambda ,arglist ,@body))) (put ',name 'interactive-only t) (put ',name 'function-documentation ,docstr) (put ',name 'transient--suffix @@ -997,7 +1005,7 @@ keyword. `(progn (defalias ',name #'transient--default-infix-command) (put ',name 'interactive-only t) - (put ',name 'command-modes (list 'not-a-mode)) + (put ',name 'completion-predicate #'transient--suffix-only) (put ',name 'function-documentation ,docstr) (put ',name 'transient--suffix (,(or class 'transient-switch) :command ',name ,@slots))))) @@ -1013,21 +1021,39 @@ example, sets a variable, use `transient-define-infix' instead. (defun transient--default-infix-command () ;; Most infix commands are but an alias for this command. - "Cannot show any documentation for this anonymous infix command. + "Cannot show any documentation for this transient infix command. + +When you request help for an infix command using `transient-help', that +usually shows the respective man-page and tries to jump to the location +where the respective argument is being described. -This infix command was defined anonymously, i.e., it was define -inside a call to `transient-define-prefix'. +If no man-page is specified for the containing transient menu, then the +docstring is displayed instead, if any. -When you request help for such an infix command, then we usually -show the respective man-page and jump to the location where the -respective argument is being described. This isn't possible in -this case, because the `man-page' slot was not set in this case." +If the infix command doesn't have a docstring, as is the case here, then +this docstring is displayed instead, because technically infix commands +are aliases for `transient--default-infix-command'. + +`describe-function' also shows the docstring of the infix command, +falling back to that of the same aliased command." (interactive) (let ((obj (transient-suffix-object))) (transient-infix-set obj (transient-infix-read obj))) (transient--show)) (put 'transient--default-infix-command 'interactive-only t) -(put 'transient--default-infix-command 'command-modes (list 'not-a-mode)) +(put 'transient--default-infix-command 'completion-predicate + #'transient--suffix-only) + +(defun transient--find-function-advised-original (fn func) + "Return nil instead of `transient--default-infix-command'. +When using `find-function' to jump to the definition of a transient +infix command/argument, then we want to actually jump to that, not to +the definition of `transient--default-infix-command', which all infix +commands are aliases for." + (let ((val (funcall fn func))) + (and val (not (eq val 'transient--default-infix-command)) val))) +(advice-add 'find-function-advised-original :around + #'transient--find-function-advised-original) (eval-and-compile (defun transient--expand-define-args (args &optional arglist) @@ -1056,7 +1082,8 @@ this case, because the `man-page' slot was not set in this case." args)))) (defun transient--parse-child (prefix spec) - (cl-etypecase spec + (cl-typecase spec + (null (error "Invalid transient--parse-child spec: %s" spec)) (symbol (let ((value (symbol-value spec))) (if (and (listp value) (or (listp (car value)) @@ -1065,7 +1092,8 @@ this case, because the `man-page' slot was not set in this case." (transient--parse-child prefix value)))) (vector (and-let* ((c (transient--parse-group prefix spec))) (list c))) (list (and-let* ((c (transient--parse-suffix prefix spec))) (list c))) - (string (list spec)))) + (string (list spec)) + (t (error "Invalid transient--parse-child spec: %s" spec)))) (defun transient--parse-group (prefix spec) (setq spec (append spec nil)) @@ -1086,12 +1114,16 @@ this case, because the `man-page' slot was not set in this case." (and (listp val) (not (eq (car val) 'lambda)))) (setq args (plist-put args key (macroexp-quote val)))) ((setq args (plist-put args key val)))))) + (unless (or spec class (not (plist-get args :setup-children))) + (message "WARNING: %s: When %s is used, %s must also be specified" + 'transient-define-prefix :setup-children :class)) (list 'vector (or level transient--default-child-level) - (or class - (if (vectorp car) - (quote 'transient-columns) - (quote 'transient-column))) + (cond (class) + ((or (vectorp car) + (and car (symbolp car))) + (quote 'transient-columns)) + ((quote 'transient-column))) (and args (cons 'list args)) (cons 'list (cl-mapcan (lambda (s) (transient--parse-child prefix s)) @@ -1130,14 +1162,15 @@ this case, because the `man-page' slot was not set in this case." (format "transient:%s:%s" prefix (let ((desc (plist-get args :description))) - (if (and desc (or (stringp desc) (symbolp desc))) + (if (and (stringp desc) + (length< desc 16)) desc (plist-get args :key))))))) (setq args (plist-put args :command `(prog1 ',sym (put ',sym 'interactive-only t) - (put ',sym 'command-modes (list 'not-a-mode)) + (put ',sym 'completion-predicate #'transient--suffix-only) (defalias ',sym ,(if (eq (car-safe cmd) 'lambda) cmd @@ -1160,7 +1193,7 @@ this case, because the `man-page' slot was not set in this case." args :command `(prog1 ',sym (put ',sym 'interactive-only t) - (put ',sym 'command-modes (list 'not-a-mode)) + (put ',sym 'completion-predicate #'transient--suffix-only) (defalias ',sym #'transient--default-infix-command)))) (cond ((and car (not (keywordp car))) (setq class 'transient-option) @@ -1198,12 +1231,33 @@ this case, because the `man-page' slot was not set in this case." (and (string-match "\\`\\(-[a-zA-Z]\\)\\(\\'\\|=\\)" arg) (match-string 1 arg)))) +(defun transient-command-completion-not-suffix-only-p (symbol _buffer) + "Say whether SYMBOL should be offered as a completion. +If the value of SYMBOL's `completion-predicate' property is +`transient--suffix-only', then return nil, otherwise return t. +This is the case when a command should only ever be used as a +suffix of a transient prefix command (as opposed to bindings +in regular keymaps or by using `execute-extended-command')." + (not (eq (get symbol 'completion-predicate) 'transient--suffix-only))) + +(defalias 'transient--suffix-only #'ignore + "Ignore ARGUMENTS, do nothing, and return nil. +Also see `transient-command-completion-not-suffix-only-p'. +Only use this alias as the value of the `completion-predicate' +symbol property.") + +(when (and (boundp 'read-extended-command-predicate) ; since Emacs 28.1 + (not read-extended-command-predicate)) + (setq read-extended-command-predicate + 'transient-command-completion-not-suffix-only-p)) + (defun transient-parse-suffix (prefix suffix) "Parse SUFFIX, to be added to PREFIX. PREFIX is a prefix command, a symbol. SUFFIX is a suffix command or a group specification (of the same forms as expected by `transient-define-prefix'). Intended for use in a group's `:setup-children' function." + (cl-assert (and prefix (symbolp prefix))) (eval (car (transient--parse-child prefix suffix)))) (defun transient-parse-suffixes (prefix suffixes) @@ -1212,6 +1266,7 @@ PREFIX is a prefix command, a symbol. SUFFIXES is a list of suffix command or a group specification (of the same forms as expected by `transient-define-prefix'). Intended for use in a group's `:setup-children' function." + (cl-assert (and prefix (symbolp prefix))) (mapcar (apply-partially #'transient-parse-suffix prefix) suffixes)) ;;; Edit @@ -1472,7 +1527,8 @@ drawing in the transient buffer.") (defvar transient--pending-suffix nil "The suffix that is currently being processed. -This is bound while the suffix predicate is being evaluated.") +This is bound while the suffix predicate is being evaluated, +and while functions that return faces are being evaluated.") (defvar transient--pending-group nil "The group that is currently being processed. @@ -1555,33 +1611,35 @@ probably use this instead: (get COMMAND \\='transient--suffix)" (when command (cl-check-type command command)) - (if (or transient--prefix - transient-current-prefix) - (let ((suffixes - (cl-remove-if-not - (lambda (obj) - (eq (oref obj command) - (or command - (if (eq this-command 'transient-set-level) - ;; This is how it can look up for which - ;; command it is setting the level. - this-original-command - this-command)))) - (or transient--suffixes - transient-current-suffixes)))) - (or (and (cdr suffixes) - (cl-find-if - (lambda (obj) - (equal (listify-key-sequence (transient--kbd (oref obj key))) - (listify-key-sequence (this-command-keys)))) - suffixes)) - (car suffixes))) - (and-let* ((obj (transient--suffix-prototype (or command this-command))) + (cond + (transient--pending-suffix) + ((or transient--prefix + transient-current-prefix) + (let ((suffixes + (cl-remove-if-not + (lambda (obj) + (eq (oref obj command) + (or command + (if (eq this-command 'transient-set-level) + ;; This is how it can look up for which + ;; command it is setting the level. + this-original-command + this-command)))) + (or transient--suffixes + transient-current-suffixes)))) + (or (and (cdr suffixes) + (cl-find-if + (lambda (obj) + (equal (listify-key-sequence (transient--kbd (oref obj key))) + (listify-key-sequence (this-command-keys)))) + suffixes)) + (car suffixes)))) + ((and-let* ((obj (transient--suffix-prototype (or command this-command))) (obj (clone obj))) (progn ; work around debbugs#31840 (transient-init-scope obj) (transient-init-value obj) - obj)))) + obj))))) (defun transient--suffix-prototype (command) (or (get command 'transient--suffix) @@ -1762,7 +1820,10 @@ of the corresponding object." ;; an unbound key, then Emacs calls the `undefined' command ;; but does not set `this-command', `this-original-command' ;; or `real-this-command' accordingly. Instead they are nil. - "" #'transient--do-warn) + "" #'transient--do-warn + ;; Bound to the `mouse-movement' event, this command is similar + ;; to `ignore'. + "" #'transient--do-noop) (defvar transient--transient-map nil) (defvar transient--predicate-map nil) @@ -1821,7 +1882,7 @@ of the corresponding object." (defun transient--make-predicate-map () (let* ((default (transient--resolve-pre-command (oref transient--prefix transient-suffix))) - (return (and transient-current-prefix (eq default t))) + (return (and transient--stack (eq default t))) (map (make-sparse-keymap))) (set-keymap-parent map transient-predicate-map) (when (or (and (slot-boundp transient--prefix 'transient-switch-frame) @@ -1912,7 +1973,7 @@ the \"scope\" of the transient (see `transient-define-prefix'). This function is also called internally in which case LAYOUT and EDIT may be non-nil." (transient--debug 'setup) - (transient--with-emergency-exit + (transient--with-emergency-exit :setup (cond ((not name) ;; Switching between regular and edit mode. @@ -2166,7 +2227,7 @@ value. Otherwise return CHILDREN as is." (defun transient--pre-command () (transient--debug 'pre-command) - (transient--with-emergency-exit + (transient--with-emergency-exit :pre-command ;; The use of `overriding-terminal-local-map' does not prevent the ;; lookup of command remappings in the overridden maps, which can ;; lead to a suffix being remapped to a non-suffix. We have to undo @@ -2228,14 +2289,14 @@ value. Otherwise return CHILDREN as is." (when (window-live-p transient--window) (let ((remain-in-minibuffer-window (and (minibuffer-selected-window) - (selected-window))) - (buf (window-buffer transient--window))) + (selected-window)))) ;; Only delete the window if it has never shown another buffer. (unless (eq (car (window-parameter transient--window 'quit-restore)) 'other) (with-demoted-errors "Error while exiting transient: %S" (delete-window transient--window))) - (kill-buffer buf) + (when-let ((buffer (get-buffer transient--buffer-name))) + (kill-buffer buffer)) (when remain-in-minibuffer-window (select-window remain-in-minibuffer-window))))) @@ -2253,7 +2314,10 @@ value. Otherwise return CHILDREN as is." ((and transient--prefix transient--redisplay-key) (setq transient--redisplay-key nil) (when transient--showp - (transient--show)))) + (if-let ((win (minibuffer-selected-window))) + (with-selected-window win + (transient--show)) + (transient--show))))) (transient--pop-keymap 'transient--transient-map) (transient--pop-keymap 'transient--redisplay-map) (remove-hook 'pre-command-hook #'transient--pre-command) @@ -2308,7 +2372,7 @@ value. Otherwise return CHILDREN as is." (remove-hook 'minibuffer-exit-hook ,exit))) ,@body))) -(static-if (>= emacs-major-version 30) +(static-if (>= emacs-major-version 30) ;transient--wrap-command (defun transient--wrap-command () (cl-assert (>= emacs-major-version 30) nil @@ -2316,27 +2380,31 @@ value. Otherwise return CHILDREN as is." (letrec ((prefix transient--prefix) (suffix this-command) - (advice (lambda (fn &rest args) - (interactive - (lambda (spec) - (let ((abort t)) - (unwind-protect - (prog1 (advice-eval-interactive-spec spec) - (setq abort nil)) - (when abort - (when-let ((unwind (oref prefix unwind-suffix))) - (transient--debug 'unwind-interactive) - (funcall unwind suffix)) - (advice-remove suffix advice) - (oset prefix unwind-suffix nil)))))) - (unwind-protect - (apply fn args) + (advice + (lambda (fn &rest args) + (interactive + (lambda (spec) + (let ((abort t)) + (unwind-protect + (prog1 (let ((debugger #'transient--exit-and-debug)) + (advice-eval-interactive-spec spec)) + (setq abort nil)) + (when abort (when-let ((unwind (oref prefix unwind-suffix))) - (transient--debug 'unwind-command) + (transient--debug 'unwind-interactive) (funcall unwind suffix)) (advice-remove suffix advice) - (oset prefix unwind-suffix nil))))) - (advice-add suffix :around advice '((depth . -99))))) + (oset prefix unwind-suffix nil)))))) + (unwind-protect + (let ((debugger #'transient--exit-and-debug)) + (apply fn args)) + (when-let ((unwind (oref prefix unwind-suffix))) + (transient--debug 'unwind-command) + (funcall unwind suffix)) + (advice-remove suffix advice) + (oset prefix unwind-suffix nil))))) + (when (symbolp this-command) + (advice-add suffix :around advice '((depth . -99)))))) (defun transient--wrap-command () (let* ((prefix transient--prefix) @@ -2346,7 +2414,8 @@ value. Otherwise return CHILDREN as is." (lambda (spec) (let ((abort t)) (unwind-protect - (prog1 (advice-eval-interactive-spec spec) + (prog1 (let ((debugger #'transient--exit-and-debug)) + (advice-eval-interactive-spec spec)) (setq abort nil)) (when abort (when-let ((unwind (oref prefix unwind-suffix))) @@ -2357,7 +2426,8 @@ value. Otherwise return CHILDREN as is." (advice-body (lambda (fn &rest args) (unwind-protect - (apply fn args) + (let ((debugger #'transient--exit-and-debug)) + (apply fn args)) (when-let ((unwind (oref prefix unwind-suffix))) (transient--debug 'unwind-command) (funcall unwind suffix)) @@ -2366,7 +2436,8 @@ value. Otherwise return CHILDREN as is." (setq advice `(lambda (fn &rest args) (interactive ,advice-interactive) (apply ',advice-body fn args))) - (advice-add suffix :around advice '((depth . -99)))))) + (when (symbolp this-command) + (advice-add suffix :around advice '((depth . -99))))))) (defun transient--premature-post-command () (and (equal (this-command-keys-vector) []) @@ -2385,7 +2456,7 @@ value. Otherwise return CHILDREN as is." (defun transient--post-command () (unless (transient--premature-post-command) (transient--debug 'post-command) - (transient--with-emergency-exit + (transient--with-emergency-exit :post-command (cond (transient--exitp (transient--post-exit)) ;; If `this-command' is the current transient prefix, then we ;; have already taken care of updating the transient buffer... @@ -2509,18 +2580,22 @@ value. Otherwise return CHILDREN as is." this-command)) (key-description (this-command-keys-vector)) transient--exitp - (cond ((stringp (car args)) + (cond ((keywordp (car args)) + (format ", from: %s" + (substring (symbol-name (car args)) 1))) + ((stringp (car args)) (concat ", " (apply #'format args))) - (args + ((functionp (car args)) (concat ", " (apply (car args) (cdr args)))) (""))) (apply #'message arg args))))) -(defun transient--emergency-exit () +(defun transient--emergency-exit (&optional id) "Exit the current transient command after an error occurred. When no transient is active (i.e., when `transient--prefix' is -nil) then do nothing." - (transient--debug 'emergency-exit) +nil) then do nothing. Optional ID is a keyword identifying the +exit." + (transient--debug 'emergency-exit id) (when transient--prefix (setq transient--stack nil) (setq transient--exitp t) @@ -2544,6 +2619,7 @@ nil) then do nothing." (defun transient--get-pre-command (&optional cmd enforce-type) (or (and (not (eq enforce-type 'non-suffix)) + (symbolp cmd) (lookup-key transient--predicate-map (vector cmd))) (and (not (eq enforce-type 'suffix)) (transient--resolve-pre-command @@ -3087,14 +3163,14 @@ infix command determines what the new value should be, based on the previous value.") (cl-defmethod transient-infix-read :around ((obj transient-infix)) - "Refresh the transient buffer buffer calling the next method. + "Refresh the transient buffer and call the next method. Also wrap `cl-call-next-method' with two macros: - `transient--with-suspended-override' allows use of minibuffer. - `transient--with-emergency-exit' arranges for the transient to be exited in case of an error." (transient--show) - (transient--with-emergency-exit + (transient--with-emergency-exit :infix-read (transient--with-suspended-override (cl-call-next-method obj)))) @@ -3176,8 +3252,10 @@ The last value is \"don't use any of these switches\"." "Elsewhere use the reader of the infix command COMMAND. Use this if you want to share an infix's history with a regular stand-alone command." - (cl-letf (((symbol-function #'transient--show) #'ignore)) - (transient-infix-read (transient--suffix-prototype command)))) + (if-let ((obj (transient--suffix-prototype command))) + (cl-letf (((symbol-function #'transient--show) #'ignore)) + (transient-infix-read obj)) + (error "Not a suffix command: `%s'" command))) ;;;; Readers @@ -3354,7 +3432,7 @@ the set, saved or default value for PREFIX." (transient--init-suffixes prefix))))) (defun transient-get-value () - (transient--with-emergency-exit + (transient--with-emergency-exit :get-value (cl-mapcan (lambda (obj) (and (or (not (slot-exists-p obj 'unsavable)) (not (oref obj unsavable))) @@ -3565,7 +3643,7 @@ have a history of their own.") (propertize "\n" 'face face 'line-height t)))) (defmacro transient-with-shadowed-buffer (&rest body) - "While in the transient buffer, temporarily make the shadowed buffer current." + "While in the transient buffer, temporarly make the shadowed buffer current." (declare (indent 0) (debug t)) `(with-current-buffer (or transient--shadowed-buffer (current-buffer)) ,@body)) @@ -3620,7 +3698,8 @@ have a history of their own.") (lambda (column) (transient--maybe-pad-keys column group) (transient-with-shadowed-buffer - (let ((rows (mapcar #'transient-format (oref column suffixes)))) + (let* ((transient--pending-group column) + (rows (mapcar #'transient-format (oref column suffixes)))) (when-let ((desc (transient-format-description column))) (push desc rows)) (flatten-tree rows)))) @@ -3629,10 +3708,15 @@ have a history of their own.") transient-align-variable-pitch)) (rs (apply #'max (mapcar #'length columns))) (cs (length columns)) - (cw (mapcar (lambda (col) - (apply #'max - (mapcar (if vp #'transient--pixel-width #'length) - col))) + (cw (mapcar (let ((widths (oref transient--prefix column-widths))) + (lambda (col) + (apply + #'max + (if-let ((min (pop widths))) + (if vp (* min (transient--pixel-width " ")) min) + 0) + (mapcar (if vp #'transient--pixel-width #'length) + col)))) columns)) (cc (transient--seq-reductions-from (apply-partially #'+ (* 3 (if vp (transient--pixel-width " ") 1))) @@ -3908,7 +3992,10 @@ If the OBJ's `key' is currently unreachable, then apply the face (face (slot-value obj slot))) (if (and (not (facep face)) (functionp face)) - (funcall face) + (let ((transient--pending-suffix obj)) + (if (= (car (func-arity face)) 1) + (funcall face obj) + (funcall face))) face))) (defun transient--key-face (&optional cmd enforce-type) -- cgit v1.2.3 From 946280365d40104dffd5329eebefc02329f72041 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 21 Mar 2024 19:26:33 -0400 Subject: (make-help-screen): Move most of the code out to a function This avoids problems like variable-name capture and lets compiler messages point to the actual source code. * lisp/help-macro.el (help--help-screen): New function, extracted from `make-help-screen`. (make-help-screen): Use it. --- lisp/help-macro.el | 275 +++++++++++++++++++++++++++-------------------------- 1 file changed, 140 insertions(+), 135 deletions(-) diff --git a/lisp/help-macro.el b/lisp/help-macro.el index cea8b379ec0..8a16e85a329 100644 --- a/lisp/help-macro.el +++ b/lisp/help-macro.el @@ -92,141 +92,146 @@ and then returns." `(defun ,fname () "Help command." (interactive) - (let ((line-prompt - (substitute-command-keys ,help-line)) - (help-buffer-under-preparation t)) - (when three-step-help - (message "%s" line-prompt)) - (let* ((help-screen ,help-text) - ;; We bind overriding-local-map for very small - ;; sections, *excluding* where we switch buffers - ;; and where we execute the chosen help command. - (local-map (make-sparse-keymap)) - (new-minor-mode-map-alist minor-mode-map-alist) - (prev-frame (selected-frame)) - config new-frame key char) - (when (string-match "%THIS-KEY%" help-screen) - (setq help-screen - (replace-match (help--key-description-fontified - (substring (this-command-keys) 0 -1)) - t t help-screen))) - (unwind-protect - (let ((minor-mode-map-alist nil)) - (setcdr local-map ,helped-map) - (define-key local-map [t] 'undefined) - ;; Make the scroll bar keep working normally. - (define-key local-map [vertical-scroll-bar] - (lookup-key global-map [vertical-scroll-bar])) - (if three-step-help - (progn - (setq key (let ((overriding-local-map local-map)) - (read-key-sequence nil))) - ;; Make the HELP key translate to C-h. - (if (lookup-key function-key-map key) - (setq key (lookup-key function-key-map key))) - (setq char (aref key 0))) - (setq char ??)) - (when (or (eq char ??) (eq char help-char) - (memq char help-event-list)) - (setq config (current-window-configuration)) - (pop-to-buffer (or ,buffer-name " *Metahelp*") nil t) - (and (fboundp 'make-frame) - (not (eq (window-frame) - prev-frame)) - (setq new-frame (window-frame) - config nil)) - (setq buffer-read-only nil) - (let ((inhibit-read-only t)) - (erase-buffer) - (insert (substitute-command-keys help-screen))) - (let ((minor-mode-map-alist new-minor-mode-map-alist)) - (help-mode) - (variable-pitch-mode) - (setq new-minor-mode-map-alist minor-mode-map-alist)) - (goto-char (point-min)) - (while (or (memq char (append help-event-list - (cons help-char '( ?? ?\C-v ?\s ?\177 ?\M-v ?\S-\s - deletechar backspace vertical-scroll-bar - home end next prior up down)))) - (eq (car-safe char) 'switch-frame) - (equal key "\M-v")) - (condition-case nil - (cond - ((eq (car-safe char) 'switch-frame) - (handle-switch-frame char)) - ((memq char '(?\C-v ?\s next end)) - (scroll-up)) - ((or (memq char '(?\177 ?\M-v ?\S-\s deletechar backspace prior home)) - (equal key "\M-v")) - (scroll-down)) - ((memq char '(down)) - (scroll-up 1)) - ((memq char '(up)) - (scroll-down 1))) - (error nil)) - (let ((cursor-in-echo-area t) - (overriding-local-map local-map)) - (frame-toggle-on-screen-keyboard (selected-frame) nil) - (setq key (read-key-sequence - (format "Type one of listed options%s: " - (if (pos-visible-in-window-p - (point-max)) - "" - (concat ", or " - (help--key-description-fontified (kbd "")) - "/" - (help--key-description-fontified (kbd "")) - "/" - (help--key-description-fontified (kbd "SPC")) - "/" - (help--key-description-fontified (kbd "DEL")) - " to scroll"))) - nil nil nil nil - ;; Disable ``text conversion''. OS - ;; input methods might otherwise chose - ;; to insert user input directly into - ;; a buffer. - t) - char (aref key 0))) - - ;; If this is a scroll bar command, just run it. - (when (eq char 'vertical-scroll-bar) - (command-execute (lookup-key local-map key) nil key)))) - ;; We don't need the prompt any more. - (message "") - ;; Mouse clicks are not part of the help feature, - ;; so reexecute them in the standard environment. - (if (listp char) - (setq unread-command-events - (cons char unread-command-events) - config nil) - (let ((defn (lookup-key local-map key))) - (if defn - (progn - (when config - (set-window-configuration config) - (setq config nil)) - ;; Temporarily rebind `minor-mode-map-alist' - ;; to `new-minor-mode-map-alist' (Bug#10454). - (let ((minor-mode-map-alist new-minor-mode-map-alist)) - ;; `defn' must make sure that its frame is - ;; selected, so we won't iconify it below. - (call-interactively defn)) - (when new-frame - ;; Do not iconify the selected frame. - (unless (eq new-frame (selected-frame)) - (iconify-frame new-frame)) - (setq new-frame nil))) - (unless (equal (key-description key) "C-g") - (message (substitute-command-keys - (format "No help command is bound to `\\`%s''" - (key-description key)))) - (ding)))))) - (when config - (set-window-configuration config)) - (when new-frame - (iconify-frame new-frame)) - (setq minor-mode-map-alist new-minor-mode-map-alist)))))) + (help--help-screen ,help-line ,help-text ,helped-map ,buffer-name))) + + +;;;###autoload +(defun help--help-screen (help-line help-text helped-map buffer-name) + (let ((line-prompt + (substitute-command-keys help-line)) + (help-buffer-under-preparation t)) + (when three-step-help + (message "%s" line-prompt)) + (let* ((help-screen help-text) + ;; We bind overriding-local-map for very small + ;; sections, *excluding* where we switch buffers + ;; and where we execute the chosen help command. + (local-map (make-sparse-keymap)) + (new-minor-mode-map-alist minor-mode-map-alist) + (prev-frame (selected-frame)) + config new-frame key char) + (when (string-match "%THIS-KEY%" help-screen) + (setq help-screen + (replace-match (help--key-description-fontified + (substring (this-command-keys) 0 -1)) + t t help-screen))) + (unwind-protect + (let ((minor-mode-map-alist nil)) + (setcdr local-map helped-map) + (define-key local-map [t] #'undefined) + ;; Make the scroll bar keep working normally. + (define-key local-map [vertical-scroll-bar] + (lookup-key global-map [vertical-scroll-bar])) + (if three-step-help + (progn + (setq key (let ((overriding-local-map local-map)) + (read-key-sequence nil))) + ;; Make the HELP key translate to C-h. + (if (lookup-key function-key-map key) + (setq key (lookup-key function-key-map key))) + (setq char (aref key 0))) + (setq char ??)) + (when (or (eq char ??) (eq char help-char) + (memq char help-event-list)) + (setq config (current-window-configuration)) + (pop-to-buffer (or buffer-name " *Metahelp*") nil t) + (and (fboundp 'make-frame) + (not (eq (window-frame) + prev-frame)) + (setq new-frame (window-frame) + config nil)) + (setq buffer-read-only nil) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (substitute-command-keys help-screen))) + (let ((minor-mode-map-alist new-minor-mode-map-alist)) + (help-mode) + (variable-pitch-mode) + (setq new-minor-mode-map-alist minor-mode-map-alist)) + (goto-char (point-min)) + (while (or (memq char (append help-event-list + (cons help-char '( ?? ?\C-v ?\s ?\177 ?\M-v ?\S-\s + deletechar backspace vertical-scroll-bar + home end next prior up down)))) + (eq (car-safe char) 'switch-frame) + (equal key "\M-v")) + (condition-case nil + (cond + ((eq (car-safe char) 'switch-frame) + (handle-switch-frame char)) + ((memq char '(?\C-v ?\s next end)) + (scroll-up)) + ((or (memq char '(?\177 ?\M-v ?\S-\s deletechar backspace prior home)) + (equal key "\M-v")) + (scroll-down)) + ((memq char '(down)) + (scroll-up 1)) + ((memq char '(up)) + (scroll-down 1))) + (error nil)) + (let ((cursor-in-echo-area t) + (overriding-local-map local-map)) + (frame-toggle-on-screen-keyboard (selected-frame) nil) + (setq key (read-key-sequence + (format "Type one of listed options%s: " + (if (pos-visible-in-window-p + (point-max)) + "" + (concat ", or " + (help--key-description-fontified (kbd "")) + "/" + (help--key-description-fontified (kbd "")) + "/" + (help--key-description-fontified (kbd "SPC")) + "/" + (help--key-description-fontified (kbd "DEL")) + " to scroll"))) + nil nil nil nil + ;; Disable ``text conversion''. OS + ;; input methods might otherwise chose + ;; to insert user input directly into + ;; a buffer. + t) + char (aref key 0))) + + ;; If this is a scroll bar command, just run it. + (when (eq char 'vertical-scroll-bar) + (command-execute (lookup-key local-map key) nil key)))) + ;; We don't need the prompt any more. + (message "") + ;; Mouse clicks are not part of the help feature, + ;; so reexecute them in the standard environment. + (if (listp char) + (setq unread-command-events + (cons char unread-command-events) + config nil) + (let ((defn (lookup-key local-map key))) + (if defn + (progn + (when config + (set-window-configuration config) + (setq config nil)) + ;; Temporarily rebind `minor-mode-map-alist' + ;; to `new-minor-mode-map-alist' (Bug#10454). + (let ((minor-mode-map-alist new-minor-mode-map-alist)) + ;; `defn' must make sure that its frame is + ;; selected, so we won't iconify it below. + (call-interactively defn)) + (when new-frame + ;; Do not iconify the selected frame. + (unless (eq new-frame (selected-frame)) + (iconify-frame new-frame)) + (setq new-frame nil))) + (unless (equal (key-description key) "C-g") + (message (substitute-command-keys + (format "No help command is bound to `\\`%s''" + (key-description key)))) + (ding)))))) + (when config + (set-window-configuration config)) + (when new-frame + (iconify-frame new-frame)) + (setq minor-mode-map-alist new-minor-mode-map-alist))))) (provide 'help-macro) -- cgit v1.2.3 From a1f8702e8345254e6898d35e554bdc06ab09c3ca Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 21 Mar 2024 19:40:20 -0400 Subject: (help-fns-function-name): New function Consolidate code used in profiler and help--describe-command, and improve it while we're at it. Also use #' to quote a few function names along the way. * lisp/help-fns.el (help-fns--function-numbers, help-fns--function-names): New vars. (help-fns--display-function): New aux function. (help-fns-function-name): New function, inspired from `help--describe-command`. * lisp/help.el (help--describe-command): Use `help-fns-function-name`. (help--for-help-make-sections): Remove redundant "" arg to `mapconcat`. * lisp/profiler.el (profiler-format-entry, profiler-fixup-entry): Delete functions. (profiler-report-make-entry-part): Use `help-fns-function-name` instead. (profiler-report-find-entry): Use `push-button`. * lisp/transient.el (transient--debug): Use `help-fns-function-name` when available. --- etc/NEWS | 6 +++++ lisp/bind-key.el | 1 + lisp/help-fns.el | 68 ++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/help.el | 44 ++++++++++----------------------- lisp/profiler.el | 74 ++++++++++++++++++++----------------------------------- lisp/transient.el | 22 +++++++++-------- 6 files changed, 127 insertions(+), 88 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index ba0e4c80fa0..eda84d588a8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1647,6 +1647,12 @@ values. * Lisp Changes in Emacs 30.1 +** New function 'help-fns-function-name'. +For named functions, it just returns the name and otherwise +it returns a short "unique" string that identifies the function. +In either case, the string is propertized so clicking on it gives +further details. + ** New function 'cl-type-of'. This function is like 'type-of' except that it sometimes returns a more precise type. For example, for nil and t it returns 'null' diff --git a/lisp/bind-key.el b/lisp/bind-key.el index 1e59c75566a..780314fecbd 100644 --- a/lisp/bind-key.el +++ b/lisp/bind-key.el @@ -468,6 +468,7 @@ other modes. See `override-global-mode'." ((and bind-key-describe-special-forms (functionp elem) (stringp (setq doc (documentation elem)))) doc) ;;FIXME: Keep only the first line? + ;; FIXME: Use `help-fns-function-name'? ((consp elem) (if (symbolp (car elem)) (format "#<%s>" (car elem)) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 15d87f9925c..422f6e9dddf 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -2448,6 +2448,74 @@ one of them returns non-nil." (setq buffer-undo-list nil) (texinfo-mode))) +(defconst help-fns--function-numbers + (make-hash-table :test 'equal :weakness 'value)) +(defconst help-fns--function-names (make-hash-table :weakness 'key)) + +(defun help-fns--display-function (function) + (cond + ((subr-primitive-p function) + (describe-function function)) + ((and (compiled-function-p function) + (not (and (fboundp 'kmacro-p) (kmacro-p function)))) + (disassemble function)) + (t + ;; FIXME: Use cl-print! + (pp-display-expression function "*Help Source*" (consp function))))) + +;;;###autoload +(defun help-fns-function-name (function) + "Return a short string representing FUNCTION." + ;; FIXME: For kmacros, should we print the key-sequence? + (cond + ((symbolp function) + (let ((name (if (eq (intern-soft (symbol-name function)) function) + (symbol-name function) + (concat "#:" (symbol-name function))))) + (if (not (fboundp function)) + name + (make-text-button name nil + 'type 'help-function + 'help-args (list function))))) + ((gethash function help-fns--function-names)) + ((subrp function) + (let ((name (subr-name function))) + ;; FIXME: For native-elisp-functions, should we use `help-function' + ;; or `disassemble'? + (format "#<%s %s>" + (cl-type-of function) + (make-text-button name nil + 'type 'help-function + ;; Let's hope the subr hasn't been redefined! + 'help-args (list (intern name)))))) + (t + (let ((type (or (oclosure-type function) + (if (consp function) + (car function) (cl-type-of function)))) + (hash (sxhash-eq function)) + ;; Use 3 digits minimum. + (mask #xfff) + name) + (while + (let* ((hex (format (concat "%0" + (number-to-string (1+ (/ (logb mask) 4))) + "X") + (logand mask hash))) + ;; FIXME: For kmacros, we don't want to `disassemble'! + (button (buttonize + hex #'help-fns--display-function function + ;; FIXME: Shouldn't `buttonize' add + ;; the "mouse-2, RET:" prefix? + "mouse-2, RET: Display the function's body"))) + (setq name (format "#<%s %s>" type button)) + (and (< mask (abs hash)) ; We can add more digits. + (gethash name help-fns--function-numbers))) + ;; Add a digit. + (setq mask (+ (ash mask 4) #x0f))) + (puthash name function help-fns--function-numbers) + (puthash function name help-fns--function-names) + name)))) + (provide 'help-fns) ;;; help-fns.el ends here diff --git a/lisp/help.el b/lisp/help.el index c6a1e3c6bd9..4171d0c57c7 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -301,6 +301,8 @@ Do not call this in the scope of `with-help-window'." (let ((first-message (cond ((or pop-up-frames + ;; FIXME: `special-display-p' is obsolete since + ;; the vars on which it depends are obsolete! (special-display-p (buffer-name standard-output))) (setq help-return-method (cons (selected-window) t)) ;; If the help output buffer is a special display buffer, @@ -382,9 +384,9 @@ Do not call this in the scope of `with-help-window'." (propertize title 'face 'help-for-help-header) "\n\n" (help--for-help-make-commands commands)))) - sections "")) + sections)) -(defalias 'help 'help-for-help) +(defalias 'help #'help-for-help) (make-help-screen help-for-help (purecopy "Type a help option: [abcCdefFgiIkKlLmnprstvw.] C-[cdefmnoptw] or ?") (concat @@ -876,7 +878,7 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer." (format "%s (translated from %s)" string otherstring)))))) (defun help--binding-undefined-p (defn) - (or (null defn) (integerp defn) (equal defn 'undefined))) + (or (null defn) (integerp defn) (equal defn #'undefined))) (defun help--analyze-key (key untranslated &optional buffer) "Get information about KEY its corresponding UNTRANSLATED events. @@ -1221,7 +1223,7 @@ appeared on the mode-line." (defun describe-minor-mode-completion-table-for-symbol () ;; In order to list up all minor modes, minor-mode-list ;; is used here instead of minor-mode-alist. - (delq nil (mapcar 'symbol-name minor-mode-list))) + (delq nil (mapcar #'symbol-name minor-mode-list))) (defun describe-minor-mode-from-symbol (symbol) "Display documentation of a minor mode given as a symbol, SYMBOL." @@ -1644,34 +1646,14 @@ Return nil if the key sequence is too long." (t value)))) (defun help--describe-command (definition &optional translation) - (cond ((symbolp definition) - (if (and (fboundp definition) - help-buffer-under-preparation) - (insert-text-button (symbol-name definition) - 'type 'help-function - 'help-args (list definition)) - (insert (symbol-name definition))) - (insert "\n")) - ((or (stringp definition) (vectorp definition)) + (cond ((or (stringp definition) (vectorp definition)) (if translation (insert (key-description definition nil) "\n") + ;; These should be rare nowadays, replaced by `kmacro's. (insert "Keyboard Macro\n"))) ((keymapp definition) (insert "Prefix Command\n")) - ((byte-code-function-p definition) - (insert (format "[%s]\n" - (buttonize "byte-code" #'disassemble definition)))) - ((and (consp definition) - (memq (car definition) '(closure lambda))) - (insert (format "[%s]\n" - (buttonize - (symbol-name (car definition)) - (lambda (_) - (pp-display-expression - definition "*Help Source*" t)) - nil "View definition")))) - (t - (insert "??\n")))) + (t (insert (help-fns-function-name definition) "\n")))) (define-obsolete-function-alias 'help--describe-translation #'help--describe-command "29.1") @@ -2011,8 +1993,8 @@ and some others." (if temp-buffer-resize-mode ;; `help-make-xrefs' may add a `back' button and thus increase the ;; text size, so `resize-temp-buffer-window' must be run *after* it. - (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append) - (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window))) + (add-hook 'temp-buffer-show-hook #'resize-temp-buffer-window 'append) + (remove-hook 'temp-buffer-show-hook #'resize-temp-buffer-window))) (defvar resize-temp-buffer-window-inhibit nil "Non-nil means `resize-temp-buffer-window' should not resize.") @@ -2256,7 +2238,7 @@ The `temp-buffer-window-setup-hook' hook is called." ;; Don't print to *Help*; that would clobber Help history. (defun help-form-show () "Display the output of a non-nil `help-form'." - (let ((msg (eval help-form))) + (let ((msg (eval help-form t))) (if (stringp msg) (with-output-to-temp-buffer " *Char Help*" (princ msg))))) @@ -2421,7 +2403,7 @@ the same names as used in the original source code, when possible." (t arg))) arglist))) -(define-obsolete-function-alias 'help-make-usage 'help--make-usage "25.1") +(define-obsolete-function-alias 'help-make-usage #'help--make-usage "25.1") (defun help--make-usage-docstring (fn arglist) (let ((print-escape-newlines t)) diff --git a/lisp/profiler.el b/lisp/profiler.el index 80f84037a63..4e02cd1d890 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -38,8 +38,7 @@ (defcustom profiler-sampling-interval 1000000 "Default sampling interval in nanoseconds." - :type 'natnum - :group 'profiler) + :type 'natnum) ;;; Utilities @@ -68,7 +67,7 @@ collect c into s do (cl-decf i) finally return - (apply 'string (if (eq (car s) ?,) (cdr s) s))) + (apply #'string (if (eq (car s) ?,) (cdr s) s))) (profiler-ensure-string number))) (defun profiler-format (fmt &rest args) @@ -76,7 +75,7 @@ for arg in args for str = (cond ((consp subfmt) - (apply 'profiler-format subfmt arg)) + (apply #'profiler-format subfmt arg)) ((stringp subfmt) (format subfmt arg)) ((and (symbolp subfmt) @@ -91,7 +90,8 @@ if (< width len) collect (progn (put-text-property (max 0 (- width 2)) len 'invisible 'profiler str) - str) into frags + str) + into frags else collect (let ((padding (make-string (max 0 (- width len)) ?\s))) @@ -100,32 +100,11 @@ (right (concat padding str)))) into frags finally return (apply #'concat frags))) - - -;;; Entries - -(defun profiler-format-entry (entry) - "Format ENTRY in human readable string. -ENTRY would be a function name of a function itself." - (cond ((memq (car-safe entry) '(closure lambda)) - (format "#" (sxhash entry))) - ((byte-code-function-p entry) - (format "#" (sxhash entry))) - ((or (subrp entry) (symbolp entry) (stringp entry)) - (format "%s" entry)) - (t - (format "#" (sxhash entry))))) - -(defun profiler-fixup-entry (entry) - (if (symbolp entry) - entry - (profiler-format-entry entry))) - ;;; Backtraces (defun profiler-fixup-backtrace (backtrace) - (apply 'vector (mapcar 'profiler-fixup-entry backtrace))) + (apply #'vector (mapcar #'help-fns-function-name backtrace))) ;;; Logs @@ -434,18 +413,15 @@ Optional argument MODE means only check for the specified mode (cpu or mem)." (defcustom profiler-report-closed-mark "+" "An indicator of closed calltrees." - :type 'string - :group 'profiler) + :type 'string) (defcustom profiler-report-open-mark "-" "An indicator of open calltrees." - :type 'string - :group 'profiler) + :type 'string) (defcustom profiler-report-leaf-mark " " "An indicator of calltree leaves." - :type 'string - :group 'profiler) + :type 'string) (defvar profiler-report-cpu-line-format '((17 right ((12 right) @@ -474,17 +450,18 @@ Do not touch this variable directly.") (let ((string (cond ((eq entry t) "Others") - ((and (symbolp entry) - (fboundp entry)) - (propertize (symbol-name entry) - 'face 'link - 'follow-link "\r" - 'mouse-face 'highlight - 'help-echo "\ + (t (propertize (help-fns-function-name entry) + ;; Override the `button-map' which + ;; otherwise adds RET, mouse-1, and TAB + ;; bindings we don't want. :-( + 'keymap '(make-sparse-keymap) + 'follow-link "\r" + ;; FIXME: The help-echo code gets confused + ;; by the `follow-link' property and rewrites + ;; `mouse-2' to `mouse-1' :-( + 'help-echo "\ mouse-2: jump to definition\n\ -RET: expand or collapse")) - (t - (profiler-format-entry entry))))) +RET: expand or collapse"))))) (propertize string 'profiler-entry entry))) (defun profiler-report-make-name-part (tree) @@ -719,10 +696,13 @@ point." (current-buffer)) (and event (setq event (event-end event)) (posn-set-point event)) - (let ((tree (profiler-report-calltree-at-point))) - (when tree - (let ((entry (profiler-calltree-entry tree))) - (find-function entry)))))) + (save-excursion + (forward-line 0) + (let ((eol (pos-eol))) + (forward-button 1) + (if (> (point) eol) + (error "No entry found") + (push-button)))))) (defun profiler-report-describe-entry () "Describe entry at point." diff --git a/lisp/transient.el b/lisp/transient.el index 2d8566a3ac4..c3b9448e2c4 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -1249,7 +1249,7 @@ symbol property.") (when (and (boundp 'read-extended-command-predicate) ; since Emacs 28.1 (not read-extended-command-predicate)) (setq read-extended-command-predicate - 'transient-command-completion-not-suffix-only-p)) + #'transient-command-completion-not-suffix-only-p)) (defun transient-parse-suffix (prefix suffix) "Parse SUFFIX, to be added to PREFIX. @@ -1258,7 +1258,7 @@ SUFFIX is a suffix command or a group specification (of the same forms as expected by `transient-define-prefix'). Intended for use in a group's `:setup-children' function." (cl-assert (and prefix (symbolp prefix))) - (eval (car (transient--parse-child prefix suffix)))) + (eval (car (transient--parse-child prefix suffix)) t)) (defun transient-parse-suffixes (prefix suffixes) "Parse SUFFIXES, to be added to PREFIX. @@ -1278,7 +1278,7 @@ Intended for use in a group's `:setup-children' function." (string suffix))) (mem (transient--layout-member loc prefix)) (elt (car mem))) - (setq suf (eval suf)) + (setq suf (eval suf t)) (cond ((not mem) (message "Cannot insert %S into %s; %s not found" @@ -1736,7 +1736,8 @@ to `transient-predicate-map'. Also see `transient-base-map'." "Hide common commands" "Show common permanently"))) (list "C-x l" "Show/hide suffixes" #'transient-set-level) - (list "C-x a" #'transient-toggle-level-limit)))))))) + (list "C-x a" #'transient-toggle-level-limit))))) + t))) (defvar-keymap transient-popup-navigation-map :doc "One of the keymaps used when popup navigation is enabled. @@ -2574,10 +2575,11 @@ value. Otherwise return CHILDREN as is." (if (symbolp arg) (message "-- %-22s (cmd: %s, event: %S, exit: %s%s)" arg - (or (and (symbolp this-command) this-command) - (if (byte-code-function-p this-command) - "#[...]" - this-command)) + (if (fboundp 'help-fns-function-name) + (help-fns-function-name this-command) + (if (byte-code-function-p this-command) + "#[...]" + this-command)) (key-description (this-command-keys-vector)) transient--exitp (cond ((keywordp (car args)) @@ -2982,7 +2984,7 @@ transient is active." (interactive) (transient-set-value (transient-prefix-object))) -(defalias 'transient-set-and-exit 'transient-set +(defalias 'transient-set-and-exit #'transient-set "Set active transient's value for this Emacs session and exit.") (defun transient-save () @@ -2990,7 +2992,7 @@ transient is active." (interactive) (transient-save-value (transient-prefix-object))) -(defalias 'transient-save-and-exit 'transient-save +(defalias 'transient-save-and-exit #'transient-save "Save active transient's value for this and future Emacs sessions and exit.") (defun transient-reset () -- cgit v1.2.3 From 60c9702972f3cef9e6dbbce5eaad8cc90ea7f8e8 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 21 Mar 2024 21:43:38 -0400 Subject: * lisp/help.el (help--analyze-key): Use `help-fns-function-name` --- lisp/help.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/help.el b/lisp/help.el index 4171d0c57c7..bafe6032942 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -926,7 +926,9 @@ in the selected window." (let ((key-desc (help-key-description key untranslated))) (if (help--binding-undefined-p defn) (format "%s%s is undefined" key-desc mouse-msg) - (format "%s%s runs the command %S" key-desc mouse-msg defn))) + (format "%s%s runs the command %s" key-desc mouse-msg + (if (symbolp defn) (prin1-to-string defn) + (help-fns-function-name defn))))) defn event mouse-msg))) (defun help--filter-info-list (info-list i) -- cgit v1.2.3 From 0c321ddbd3afcc821567fcb584e18e9f0dd49790 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 22 Mar 2024 15:24:28 +0800 Subject: Fix display of custom menus after putative cosmetic change * lisp/wid-edit.el (widget-setup): Restore version from before the previous commit. --- lisp/wid-edit.el | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index f69a3d3b05f..172da3db1e0 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1377,14 +1377,17 @@ When not inside a field, signal an error." (defun widget-setup () "Setup current buffer so editing string widgets works." (widget--allow-insertion - (dolist (field widget-field-new) - (push field widget-field-list) - (let ((from (car (widget-get field :field-overlay))) - (to (cdr (widget-get field :field-overlay)))) - (widget-specify-field field - (marker-position from) (marker-position to)) - (set-marker from nil) - (set-marker to nil)))) + (let (field) + (while widget-field-new + (setq field (car widget-field-new) + widget-field-new (cdr widget-field-new) + widget-field-list (cons field widget-field-list)) + (let ((from (car (widget-get field :field-overlay))) + (to (cdr (widget-get field :field-overlay)))) + (widget-specify-field field + (marker-position from) (marker-position to)) + (set-marker from nil) + (set-marker to nil))))) (widget-clear-undo) (widget-add-change)) -- cgit v1.2.3 From c1530a2e4973005633ebe00d447f1f3aa1200301 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 22 Mar 2024 09:54:37 +0200 Subject: ; * lisp/help-fns.el (help-fns-function-name): Doc fix. --- lisp/help-fns.el | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 422f6e9dddf..638af81ded8 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -2465,7 +2465,14 @@ one of them returns non-nil." ;;;###autoload (defun help-fns-function-name (function) - "Return a short string representing FUNCTION." + "Return a short buttonized string representing FUNCTION. +The string is propertized with a button; clicking on that +provides further details about FUNCTION. +FUNCTION can be a function, a built-in, a keyboard macro, +or a compile function. +This function is intended to be used to display various +callable symbols in buffers in a way that allows the user +to find out more details about the symbols." ;; FIXME: For kmacros, should we print the key-sequence? (cond ((symbolp function) -- cgit v1.2.3 From accd79c93935b50dddfcd6fe7fb6912c80bcddb1 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 21 Mar 2024 21:08:58 -0400 Subject: (help-fns-function-description-header): Print functions' type Instead of choosing English words to describe the kind of function, use the actual type of the function object (from `cl-type-of`) directly, and make it a button to display info about that type. * lisp/help-fns.el (help-fns-function-description-header): Use the function's type name in the description instead of "prose". Use `insert` instead of `princ`, so as to preserve the text-properties of the button. * lisp/emacs-lisp/cl-extra.el (cl-help-type): Move to `help-mode.el` and rename to `help-type`. (cl--describe-class): Adjust accordingly. * lisp/help-mode.el (help-type): New type, moved and renamed from `cl-extra.el`. --- lisp/emacs-lisp/cl-extra.el | 11 +++-------- lisp/help-fns.el | 31 ++++++++++++++----------------- lisp/help-mode.el | 5 +++++ 3 files changed, 22 insertions(+), 25 deletions(-) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index d43c21d3eb9..437dea2d6a9 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -720,11 +720,6 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (add-to-list 'find-function-regexp-alist '(define-type . cl--typedef-regexp))) -(define-button-type 'cl-help-type - :supertype 'help-function-def - 'help-function #'cl-describe-type - 'help-echo (purecopy "mouse-2, RET: describe this type")) - (define-button-type 'cl-type-definition :supertype 'help-function-def 'help-echo (purecopy "mouse-2, RET: find type definition")) @@ -777,7 +772,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'" (insert (symbol-name type) (substitute-command-keys " is a type (of kind `")) (help-insert-xref-button (symbol-name metatype) - 'cl-help-type metatype) + 'help-type metatype) (insert (substitute-command-keys "')")) (when location (insert (substitute-command-keys " in `")) @@ -796,7 +791,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'" (setq cur (cl--class-name cur)) (insert (substitute-quotes "`")) (help-insert-xref-button (symbol-name cur) - 'cl-help-type cur) + 'help-type cur) (insert (substitute-command-keys (if pl "', " "'")))) (insert ".\n"))) @@ -808,7 +803,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'" (while (setq cur (pop ch)) (insert (substitute-quotes "`")) (help-insert-xref-button (symbol-name cur) - 'cl-help-type cur) + 'help-type cur) (insert (substitute-command-keys (if ch "', " "'")))) (insert ".\n"))) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 638af81ded8..a291893e9a2 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1061,10 +1061,10 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." (concat "an autoloaded " (if (commandp def) "interactive ")) - (if (commandp def) "an interactive " "a ")))) - - ;; Print what kind of function-like object FUNCTION is. - (princ (cond ((or (stringp def) (vectorp def)) + (if (commandp def) "an interactive " "a "))) + ;; Print what kind of function-like object FUNCTION is. + (description + (cond ((or (stringp def) (vectorp def)) "a keyboard macro") ((and (symbolp function) (get function 'reader-construct)) @@ -1073,12 +1073,6 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." ;; aliases before functions. (aliased (format-message "an alias for `%s'" real-def)) - ((subr-native-elisp-p def) - (concat beg "native-compiled Lisp function")) - ((subrp def) - (concat beg (if (eq 'unevalled (cdr (subr-arity def))) - "special form" - "built-in function"))) ((autoloadp def) (format "an autoloaded %s" (cond @@ -1092,12 +1086,13 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." ;; need to check macros before functions. (macrop function)) (concat beg "Lisp macro")) - ((byte-code-function-p def) - (concat beg "byte-compiled Lisp function")) - ((module-function-p def) - (concat beg "module function")) - ((memq (car-safe def) '(lambda closure)) - (concat beg "Lisp function")) + ((atom def) + (let ((type (or (oclosure-type def) (cl-type-of def)))) + (concat beg (format "%s" + (make-text-button + (symbol-name type) nil + 'type 'help-type + 'help-args (list type)))))) ((keymapp def) (let ((is-full nil) (elts (cdr-safe def))) @@ -1107,7 +1102,9 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." elts nil)) (setq elts (cdr-safe elts))) (concat beg (if is-full "keymap" "sparse keymap")))) - (t ""))) + (t "")))) + (with-current-buffer standard-output + (insert description)) (if (and aliased (not (fboundp real-def))) (princ ",\nwhich is not defined.") diff --git a/lisp/help-mode.el b/lisp/help-mode.el index dd78342ace7..48433d899ab 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -177,6 +177,11 @@ The format is (FUNCTION ARGS...).") 'help-function 'describe-variable 'help-echo (purecopy "mouse-2, RET: describe this variable")) +(define-button-type 'help-type + :supertype 'help-xref + 'help-function #'cl-describe-type + 'help-echo (purecopy "mouse-2, RET: describe this type")) + (define-button-type 'help-face :supertype 'help-xref 'help-function 'describe-face -- cgit v1.2.3 From 7269a2f1586733bd03b569608bd77112b2e6487f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 22 Mar 2024 16:46:28 -0400 Subject: (pp-fill): Cut before parens and dots The `pp-fill` code sometimes end up generating things like: (foo . bar) instead of (foo . bar) so make sure we cut before rather than after the dot (and open parens while we're at it). * lisp/emacs-lisp/pp.el (pp-fill): Cut before parens and dots. * test/lisp/emacs-lisp/pp-tests.el (pp-tests--dimensions): New function. (pp-tests--cut-before): New test. --- lisp/emacs-lisp/pp.el | 14 +++++++++----- test/lisp/emacs-lisp/pp-tests.el | 30 ++++++++++++++++++++++++++++++ 2 files changed, 39 insertions(+), 5 deletions(-) diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index de7468b3e38..b48f44545bf 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -193,11 +193,15 @@ it inserts and pretty-prints that arg at point." (and (save-excursion (goto-char beg) - (if (save-excursion (skip-chars-backward " \t({[',") - (bolp)) - ;; The sexp was already on its own line. - nil - (skip-chars-backward " \t") + ;; We skip backward over open parens because cutting + ;; the line right after an open paren does not help + ;; reduce the indentation depth. + ;; Similarly, we prefer to cut before a "." than after + ;; it because it reduces the indentation depth. + (skip-chars-backward " \t({[',.") + (if (bolp) + ;; The sexp already starts on its own line. + (progn (goto-char beg) nil) (setq beg (copy-marker beg t)) (if paired (setq paired (copy-marker paired t))) ;; We could try to undo this insertion if it diff --git a/test/lisp/emacs-lisp/pp-tests.el b/test/lisp/emacs-lisp/pp-tests.el index b663fb365a8..7f7c798cde8 100644 --- a/test/lisp/emacs-lisp/pp-tests.el +++ b/test/lisp/emacs-lisp/pp-tests.el @@ -36,4 +36,34 @@ (ert-deftest test-indentation () (ert-test-erts-file (ert-resource-file "code-formats.erts"))) +(defun pp-tests--dimensions () + (save-excursion + (let ((width 0) + (height 0)) + (goto-char (point-min)) + (while (not (eobp)) + (end-of-line) + (setq height (1+ height)) + (setq width (max width (current-column))) + (forward-char 1)) + (cons width height)))) + +(ert-deftest pp-tests--cut-before () + (with-temp-buffer + (lisp-data-mode) + (pp '(1 (quite-a-long-package-name + . [(0 10 0) ((avy (0 5 0))) "Quickly switch windows." tar + ((:url . "https://github.com/abo-abo/ace-window") + (:maintainer "Oleh Krehel" . "ohwoeowho@gmail.com") + (:authors ("Oleh Krehel" . "ohwoeowho@gmail.com")) + (:keywords "window" "location"))])) + (current-buffer)) + ;; (message "Filled:\n%s" (buffer-string)) + (let ((dimensions (pp-tests--dimensions))) + (should (< (car dimensions) 80)) + (should (< (cdr dimensions) 8))) + (goto-char (point-min)) + (while (search-forward "." nil t) + (should (not (eolp)))))) + ;;; pp-tests.el ends here. -- cgit v1.2.3 From 3197d7015b854944e326d68c5307b38f0a0d2d53 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 22 Mar 2024 17:03:15 -0400 Subject: etc/NEWS: Document the new behavior of `describe-function` I pushed commit accd79c93935 by accident. Related to bug#69935 --- etc/NEWS | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index eda84d588a8..f4b4c30855c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -108,6 +108,12 @@ to your init: * Changes in Emacs 30.1 +** 'describe-function' now shows the type of the function object. +The text used to say things like "car is is a built-in function" +whereas it now says "car is a primitive-function" where "primitive-function" +is the symbol returned by `cl-type-of` and you can click on it to get +information about that type. + ** 'advice-remove' is now an interactive command. When called interactively, 'advice-remove' now prompts for an advised function to the advice to remove. -- cgit v1.2.3 From 7e32e8392ab77f9df08a1f11831cbba2242d721f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 22 Mar 2024 18:44:54 -0400 Subject: Fix recent test regressions * lisp/emacs-lisp/pp.el (pp-fill): Don't cut between `#` and `(`. * test/lisp/help-fns-tests.el (help-fns-test-built-in) (help-fns-test-interactive-built-in, help-fns-test-lisp-defun) (help-fns-test-lisp-defsubst): * test/src/emacs-module-tests.el (module/describe-function-1): Adjust tests to new wording in `describe-function`. --- lisp/emacs-lisp/pp.el | 5 ++++- test/lisp/help-fns-tests.el | 10 +++++----- test/src/emacs-module-tests.el | 2 +- 3 files changed, 10 insertions(+), 7 deletions(-) diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index b48f44545bf..26c77d6b047 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -198,7 +198,10 @@ it inserts and pretty-prints that arg at point." ;; reduce the indentation depth. ;; Similarly, we prefer to cut before a "." than after ;; it because it reduces the indentation depth. - (skip-chars-backward " \t({[',.") + (while (not (zerop (skip-chars-backward " \t({[',."))) + (and (memq (char-before) '(?# ?s ?f)) + (looking-back "#[sf]?" (- (point) 2)) + (goto-char (match-beginning 0)))) (if (bolp) ;; The sexp already starts on its own line. (progn (goto-char beg) nil) diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el index 7035c8b7773..1beeb77640c 100644 --- a/test/lisp/help-fns-tests.el +++ b/test/lisp/help-fns-tests.el @@ -48,12 +48,12 @@ Return first line of the output of (describe-function-1 FUNC)." (should (string-match regexp result)))) (ert-deftest help-fns-test-built-in () - (let ((regexp "a built-in function in .C source code") + (let ((regexp "a primitive-function in .C source code") (result (help-fns-tests--describe-function 'mapcar))) (should (string-match regexp result)))) (ert-deftest help-fns-test-interactive-built-in () - (let ((regexp "an interactive built-in function in .C source code") + (let ((regexp "an interactive primitive-function in .C source code") (result (help-fns-tests--describe-function 're-search-forward))) (should (string-match regexp result)))) @@ -64,13 +64,13 @@ Return first line of the output of (describe-function-1 FUNC)." (ert-deftest help-fns-test-lisp-defun () (let ((regexp (if (featurep 'native-compile) - "a native-compiled Lisp function in .+subr\\.el" - "a byte-compiled Lisp function in .+subr\\.el")) + "a subr-native-elisp in .+subr\\.el" + "a compiled-function in .+subr\\.el")) (result (help-fns-tests--describe-function 'last))) (should (string-match regexp result)))) (ert-deftest help-fns-test-lisp-defsubst () - (let ((regexp "a byte-compiled Lisp function in .+subr\\.el") + (let ((regexp "a compiled-function in .+subr\\.el") (result (help-fns-tests--describe-function 'posn-window))) (should (string-match regexp result)))) diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index fd0647275a0..052fd83dc85 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -315,7 +315,7 @@ local reference." (replace-match "`src/emacs-module-resources/")) (should (equal (buffer-substring-no-properties 1 (point-max)) - (format "a module function in `src/emacs-module-resources/mod-test%s'. + (format "a module-function in `src/emacs-module-resources/mod-test%s'. (mod-test-sum a b) -- cgit v1.2.3 From d3ca7c68c7e4c4c86341427fc34dd1af74f1a593 Mon Sep 17 00:00:00 2001 From: john muhl Date: Tue, 19 Mar 2024 19:46:12 -0500 Subject: ; Open inferior Lua buffer in a window, not a frame * lisp/progmodes/lua-ts-mode.el (lua-ts-inferior-lua): Replace 'display-buffer-pop-up-window' with 'display-buffer-pop-up-frame'. (bug#69909) --- lisp/progmodes/lua-ts-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 25fd7792f42..b6d6e90680c 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -628,7 +628,7 @@ Calls REPORT-FN directly." nil t))) (select-window (display-buffer lua-ts-inferior-buffer '((display-buffer-reuse-window - display-buffer-pop-up-frame) + display-buffer-pop-up-window) (reusable-frames . t)))) (get-buffer-process (current-buffer))) -- cgit v1.2.3 From f412892b79dae531ace081f61ec6f3874f9270bc Mon Sep 17 00:00:00 2001 From: john muhl Date: Tue, 12 Mar 2024 11:17:15 -0500 Subject: ; Remove unneeded group in lua-ts-mode defcustoms * lisp/progmodes/lua-ts-mode.el (lua-ts-mode-hook): (lua-ts-indent-offset): (lua-ts-luacheck-program): (lua-ts-inferior-buffer): (lua-ts-inferior-program): (lua-ts-inferior-options): (lua-ts-inferior-startfile): (lua-ts-inferior-prompt): (lua-ts-inferior-prompt-continue): (lua-ts-inferior-history): (lua-ts-indent-continuation-lines): Remove :group. (bug#69910) --- lisp/progmodes/lua-ts-mode.el | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index b6d6e90680c..407ef230c32 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -60,66 +60,56 @@ :options '(flymake-mode hs-minor-mode outline-minor-mode) - :group 'lua-ts :version "30.1") (defcustom lua-ts-indent-offset 4 "Number of spaces for each indentation step in `lua-ts-mode'." :type 'natnum :safe 'natnump - :group 'lua-ts :version "30.1") (defcustom lua-ts-luacheck-program "luacheck" "Location of the Luacheck program." :type '(choice (const :tag "None" nil) string) - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-buffer "*Lua*" "Name of the inferior Lua buffer." :type 'string :safe 'stringp - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-program "lua" "Program to run in the inferior Lua process." :type '(choice (const :tag "None" nil) string) - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-options '("-i") "Command line options for the inferior Lua process." :type '(repeat string) - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-startfile nil "File to load into the inferior Lua process at startup." :type '(choice (const :tag "None" nil) (file :must-match t)) - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-prompt ">" "Prompt used by the inferior Lua process." :type 'string :safe 'stringp - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-prompt-continue ">>" "Continuation prompt used by the inferior Lua process." :type 'string :safe 'stringp - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-history nil "File used to save command history of the inferior Lua process." :type '(choice (const :tag "None" nil) file) :safe 'string-or-null-p - :group 'lua-ts :version "30.1") (defcustom lua-ts-indent-continuation-lines t @@ -141,7 +131,6 @@ the statement: end" :type 'boolean :safe 'booleanp - :group 'lua-ts :version "30.1") (defvar lua-ts--builtins -- cgit v1.2.3 From e39cb515a108682b520e499c334a600ee634fbf6 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 23 Mar 2024 15:37:43 +0800 Subject: Correctly handle non-BMP characters in Android content file names * lisp/term/android-win.el (android-encode-jni) (android-decode-jni, android-jni): New coding system, for Android file names and runtime data. * src/androidterm.h (syms_of_androidvfs): New function. * src/androidvfs.c (struct android_special_vnode): New field special_coding_system. (android_saf_tree_readdir): Decode the file name using the android-jni coding system. (special_vnodes): : Specify a file name coding system. (android_vfs_convert_name): New function. (android_root_name): If a special coding system be specified for a special vnode, convert components to it before invoking its name function. (syms_of_androidvfs): New symbol Qandroid_jni. * src/emacs.c (android_emacs_init): Call syms_of_androidvfs. --- lisp/term/android-win.el | 89 ++++++++++++++++++++++++++++++ src/androidterm.h | 5 +- src/androidvfs.c | 137 +++++++++++++++++++++++++++++++++++++++++------ src/emacs.c | 1 + 4 files changed, 215 insertions(+), 17 deletions(-) diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index 8d262e5da98..6512ef81ff7 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -528,6 +528,95 @@ accessible to other programs." (setq url replacement-url)) (android-browse-url-internal url send)) + +;; Coding systems used by androidvfs.c. + +(define-ccl-program android-encode-jni + `(2 ((loop + (read r0) + (if (r0 < #x1) ; 0x0 is encoded specially in JNI environments. + ((write #xc0) + (write #x80)) + ((if (r0 < #x80) ; ASCII + ((write r0)) + (if (r0 < #x800) ; \u0080 - \u07ff + ((write ((r0 >> 6) | #xC0)) + (write ((r0 & #x3F) | #x80))) + ;; \u0800 - \uFFFF + (if (r0 < #x10000) + ((write ((r0 >> 12) | #xE0)) + (write (((r0 >> 6) & #x3F) | #x80)) + (write ((r0 & #x3F) | #x80))) + ;; Supplementary characters must be converted into + ;; surrogate pairs before encoding. + (;; High surrogate + (r1 = ((((r0 - #x10000) >> 10) & #x3ff) + #xD800)) + ;; Low surrogate. + (r2 = (((r0 - #x10000) & #x3ff) + #xDC00)) + ;; Write both surrogate characters. + (write ((r1 >> 12) | #xE0)) + (write (((r1 >> 6) & #x3F) | #x80)) + (write ((r1 & #x3F) | #x80)) + (write ((r2 >> 12) | #xE0)) + (write (((r2 >> 6) & #x3F) | #x80)) + (write ((r2 & #x3F) | #x80)))))))) + (repeat)))) + "Encode characters from the input buffer for Java virtual machines.") + +(define-ccl-program android-decode-jni + `(1 ((loop + ((read-if (r0 >= #x80) ; More than a one-byte sequence? + ((if (r0 < #xe0) + ;; Two-byte sequence; potentially a NULL + ;; character. + ((read r4) + (r4 &= #x3f) + (r0 = (((r0 & #x1f) << 6) | r4))) + (if (r0 < ?\xF0) + ;; Three-byte sequence, after which surrogate + ;; pairs should be processed. + ((read r4 r6) + (r4 = ((r4 & #x3f) << 6)) + (r6 &= #x3f) + (r0 = ((((r0 & #xf) << 12) | r4) | r6))) + ;; Four-byte sequences are not valid under the + ;; JVM specification, but Android produces them + ;; when encoding Emoji characters for being + ;; supposedly less of a surprise to applications. + ;; This is obviously not true of programs written + ;; to the letter of the documentation, but 50 + ;; million Frenchmen make a right (and this + ;; deviation from the norm is predictably absent + ;; from Android's documentation on the subject). + ((read r1 r4 r6) + (r1 = ((r1 & #x3f) << 12)) + (r4 = ((r4 & #x3f) << 6)) + (r6 &= #x3F) + (r0 = (((((r0 & #x07) << 18) | r1) | r4) | r6)))))))) + (if ((r0 & #xf800) == #xd800) + ;; High surrogate. + ((read-if (r2 >= #xe0) + ((r0 = ((r0 & #x3ff) << 10)) + (read r4 r6) + (r4 = ((r4 & #x3f) << 6)) + (r6 &= #x3f) + (r1 = ((((r2 & #xf) << 12) | r4) | r6)) + (r0 = (((r1 & #x3ff) | r0) + #xffff)))))) + (write r0) + (repeat)))) + "Decode JVM-encoded characters in the input buffer.") + +(define-coding-system 'android-jni + "CESU-8 based encoding for communication with the Android runtime." + :mnemonic ?J + :coding-type 'ccl + :eol-type 'unix + :ascii-compatible-p nil ; for \0 is encoded as a two-byte sequence. + :default-char ?\0 + :charset-list '(unicode) + :ccl-decoder 'android-decode-jni + :ccl-encoder 'android-encode-jni) + (provide 'android-win) ;; android-win.el ends here. diff --git a/src/androidterm.h b/src/androidterm.h index ca6929bef0e..fd4cc99f641 100644 --- a/src/androidterm.h +++ b/src/androidterm.h @@ -461,7 +461,7 @@ extern void sfntfont_android_shrink_scanline_buffer (void); extern void init_sfntfont_android (void); extern void syms_of_sfntfont_android (void); -/* Defined in androidselect.c */ +/* Defined in androidselect.c. */ #ifndef ANDROID_STUBIFY @@ -473,6 +473,9 @@ extern void android_notification_action (struct android_notification_event *, extern void init_androidselect (void); extern void syms_of_androidselect (void); +/* Defined in androidvfs.c. */ +extern void syms_of_androidvfs (void); + #endif diff --git a/src/androidvfs.c b/src/androidvfs.c index 9e3d5cab8cf..6a9ddb33c56 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -38,8 +38,10 @@ along with GNU Emacs. If not, see . */ #include #include "android.h" +#include "androidterm.h" #include "systime.h" #include "blockinput.h" +#include "coding.h" #if __ANDROID_API__ >= 9 #include @@ -248,8 +250,14 @@ struct android_special_vnode /* Function called to create the initial vnode from the rest of the component. */ struct android_vnode *(*initial) (char *, size_t); + + /* If non-nil, an encoding system into which file name buffers are to + be re-encoded before being handed to VFS functions. */ + Lisp_Object special_coding_system; }; +verify (NIL_IS_ZERO); /* special_coding_system above. */ + enum android_vnode_type { ANDROID_VNODE_UNIX, @@ -3867,7 +3875,8 @@ android_saf_root_readdir (struct android_vdir *vdir) NULL); android_exception_check_nonnull ((void *) chars, string); - /* Figure out how large it is, and then resize dirent to fit. */ + /* Figure out how large it is, and then resize dirent to fit--this + string is always ASCII. */ length = strlen (chars) + 1; size = offsetof (struct dirent, d_name) + length; dirent = xrealloc (dirent, size); @@ -5479,6 +5488,7 @@ android_saf_tree_readdir (struct android_vdir *vdir) jmethodID method; size_t length, size; const char *chars; + struct coding_system coding; dir = (struct android_saf_tree_vdir *) vdir; @@ -5526,9 +5536,25 @@ android_saf_tree_readdir (struct android_vdir *vdir) NULL); android_exception_check_nonnull ((void *) chars, d_name); - /* Figure out how large it is, and then resize dirent to fit. */ + /* Decode this JNI string into utf-8-emacs; see + android_vfs_convert_name for considerations regarding coding + systems. */ + length = strlen (chars); + setup_coding_system (Qandroid_jni, &coding); + coding.mode |= CODING_MODE_LAST_BLOCK; + coding.source = (const unsigned char *) chars; + coding.dst_bytes = 0; + coding.destination = NULL; + decode_coding_object (&coding, Qnil, 0, 0, length, length, Qnil); + + /* Release the string data and the local reference to STRING. */ + (*android_java_env)->ReleaseStringUTFChars (android_java_env, + (jstring) d_name, + chars); + + /* Resize dirent to accommodate the decoded text. */ length = strlen (chars) + 1; - size = offsetof (struct dirent, d_name) + length; + size = offsetof (struct dirent, d_name) + 1 + coding.produced; dirent = xrealloc (dirent, size); /* Clear dirent. */ @@ -5540,12 +5566,12 @@ android_saf_tree_readdir (struct android_vdir *vdir) dirent->d_off = 0; dirent->d_reclen = size; dirent->d_type = d_type ? DT_DIR : DT_UNKNOWN; - strcpy (dirent->d_name, chars); + memcpy (dirent->d_name, coding.destination, coding.produced); + dirent->d_name[coding.produced] = '\0'; + + /* Free the coding system destination buffer. */ + xfree (coding.destination); - /* Release the string data and the local reference to STRING. */ - (*android_java_env)->ReleaseStringUTFChars (android_java_env, - (jstring) d_name, - chars); ANDROID_DELETE_LOCAL_REF (d_name); return dirent; } @@ -6531,9 +6557,35 @@ static struct android_vops root_vfs_ops = static struct android_special_vnode special_vnodes[] = { { "assets", 6, android_afs_initial, }, - { "content", 7, android_content_initial, }, + { "content", 7, android_content_initial, + LISPSYM_INITIALLY (Qandroid_jni), }, }; +/* Convert the file name NAME from Emacs's internal character encoding + to CODING, and return a Lisp string with the data so produced. + + Calling this function creates an implicit assumption that + file-name-coding-system is compatible with utf-8-emacs, which is not + unacceptable as users with cause to modify file-name-coding-system + should be aware and prepared for consequences towards files stored on + different filesystems, including virtual ones. */ + +static Lisp_Object +android_vfs_convert_name (const char *name, Lisp_Object coding) +{ + Lisp_Object src_coding, name1; + + src_coding = Qutf_8_emacs; + + /* Convert the contents of the buffer after BUFFER_END + from the file name coding system to + special->special_coding_system. */ + AUTO_STRING (file_name, name); + name1 = code_convert_string_norecord (file_name, src_coding, false); + name1 = code_convert_string (name1, coding, Qt, true, true, true); + return name1; +} + static struct android_vnode * android_root_name (struct android_vnode *vnode, char *name, size_t length) @@ -6541,6 +6593,8 @@ android_root_name (struct android_vnode *vnode, char *name, char *component_end; struct android_special_vnode *special; size_t i; + Lisp_Object file_name; + struct android_vnode *vp; /* Skip any leading separator in NAME. */ @@ -6567,8 +6621,29 @@ android_root_name (struct android_vnode *vnode, char *name, if (component_end - name == special->length && !memcmp (special->name, name, special->length)) - return (*special->initial) (component_end, - length - special->length); + { + if (!NILP (special->special_coding_system)) + { + USE_SAFE_ALLOCA; + + file_name + = android_vfs_convert_name (component_end, + special->special_coding_system); + + /* Allocate a buffer and copy file_name into the same. */ + length = SBYTES (file_name) + 1; + name = SAFE_ALLOCA (length + 1); + + /* Copy the trailing NULL byte also. */ + memcpy (name, SDATA (file_name), length); + vp = (*special->initial) (name, length - 1); + SAFE_FREE (); + return vp; + } + + return (*special->initial) (component_end, + length - special->length); + } /* Detect the case where a special is named with a trailing directory separator. */ @@ -6576,9 +6651,30 @@ android_root_name (struct android_vnode *vnode, char *name, if (component_end - name == special->length + 1 && !memcmp (special->name, name, special->length) && name[special->length] == '/') - /* Make sure to include the directory separator. */ - return (*special->initial) (component_end - 1, - length - special->length); + { + if (!NILP (special->special_coding_system)) + { + USE_SAFE_ALLOCA; + + file_name + = android_vfs_convert_name (component_end - 1, + special->special_coding_system); + + /* Allocate a buffer and copy file_name into the same. */ + length = SBYTES (file_name) + 1; + name = SAFE_ALLOCA (length + 1); + + /* Copy the trailing NULL byte also. */ + memcpy (name, SDATA (file_name), length); + vp = (*special->initial) (name, length - 1); + SAFE_FREE (); + return vp; + } + + /* Make sure to include the directory separator. */ + return (*special->initial) (component_end - 1, + length - special->length); + } } /* Otherwise, continue searching for a vnode normally. */ @@ -6589,8 +6685,9 @@ android_root_name (struct android_vnode *vnode, char *name, /* File system lookup. */ -/* Look up the vnode that designates NAME, a file name that is at - least N bytes. +/* Look up the vnode that designates NAME, a file name that is at least + N bytes, converting between different file name coding systems as + necessary. NAME may be either an absolute file name or a name relative to the current working directory. It must not be longer than EMACS_PATH_MAX @@ -7605,3 +7702,11 @@ android_closedir (struct android_vdir *dirp) { return (*dirp->closedir) (dirp); } + + + +void +syms_of_androidvfs (void) +{ + DEFSYM (Qandroid_jni, "android-jni"); +} diff --git a/src/emacs.c b/src/emacs.c index f4bfb9a6bbd..87f12d3fa86 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2444,6 +2444,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #if !defined ANDROID_STUBIFY syms_of_androidfont (); syms_of_androidselect (); + syms_of_androidvfs (); syms_of_sfntfont (); syms_of_sfntfont_android (); #endif /* !ANDROID_STUBIFY */ -- cgit v1.2.3 From 6235212d736ca4f0b0a1900c42c30d82747d7798 Mon Sep 17 00:00:00 2001 From: Dionisio E Alonso Date: Wed, 20 Mar 2024 17:06:30 +0200 Subject: Add BasedPyright LSP server alternative for Eglot's 'python-mode' * lisp/progmodes/eglot.el (eglot-server-programs): Add BasedPyright, a new server for python, forked from the unmaintained 'pyright' LSP server. (Bug#69925) Copyright-paperwork-exempt: yes --- lisp/progmodes/eglot.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index b3fd104a227..7d2f1a55165 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -238,7 +238,8 @@ automatically)." (vimrc-mode . ("vim-language-server" "--stdio")) ((python-mode python-ts-mode) . ,(eglot-alternatives - '("pylsp" "pyls" ("pyright-langserver" "--stdio") + '("pylsp" "pyls" ("basedpyright-langserver" "--stdio") + ("pyright-langserver" "--stdio") "jedi-language-server" "ruff-lsp"))) ((js-json-mode json-mode json-ts-mode) . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") -- cgit v1.2.3 From e52bc9ef6f7942b15d876566aca52340210ac27c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Mar 2024 09:51:47 +0200 Subject: Avoid infinite recursion in 'image-mode--display' * lisp/image-mode.el (image-mode): Suspend major mode only if it is not already 'image-mode'. (Bug#69785) --- lisp/image-mode.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 355685e70fd..fa64f1ac03e 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -654,8 +654,9 @@ Key bindings: (unless (display-images-p) (error "Display does not support images")) - (major-mode-suspend) - (setq major-mode 'image-mode) + (unless (eq major-mode 'image-mode) + (major-mode-suspend) + (setq major-mode 'image-mode)) (setq image-transform-resize image-auto-resize) ;; Bail out early if we have no image data. -- cgit v1.2.3 From 2fb6f252bfe2cd06a49975bc97a794fb70392538 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Mar 2024 11:09:57 +0200 Subject: Improve support for preprocessor macros in 'c/c++-ts-mode' * lisp/progmodes/c-ts-mode.el (c-ts-mode--defun-name) (c-ts-base-mode): Support preprocessor macros as defuns. This fixes both navigation by defuns and add-log when cpp macros are at point. --- lisp/progmodes/c-ts-mode.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index a2e7f6fba2e..8383979a373 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -911,7 +911,8 @@ Return nil if NODE is not a defun node or doesn't have a name." t)) ((or "struct_specifier" "enum_specifier" "union_specifier" "class_specifier" - "namespace_definition") + "namespace_definition" + "preproc_def" "preproc_function_def") (treesit-node-child-by-field-name node "name")) ;; DEFUNs in Emacs sources. ("expression_statement" @@ -1205,7 +1206,9 @@ BEG and END are described in `treesit-range-rules'." "enum_specifier" "union_specifier" "class_specifier" - "namespace_definition") + "namespace_definition" + "preproc_def" + "preproc_function_def") (and c-ts-mode-emacs-sources-support '(;; DEFUN. "expression_statement" -- cgit v1.2.3 From 5769a1053087a278d48836e1f366e0bd87c95809 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Mar 2024 11:50:55 +0200 Subject: ; Fix doc strings of some treesit-related functions * lisp/treesit.el (treesit-defun-tactic) (treesit-defun-name-function, treesit-thing-at-point) (treesit-defun-at-point): * lisp/progmodes/c-ts-common.el (c-ts-common-statement-offset): * lisp/progmodes/c-ts-mode.el (c-ts-mode-toggle-comment-style) (c-ts-mode-indent-style, c-ts-mode-emacs-sources-support) (c-ts-mode--syntax-propertize, c-ts-mode--anchor-prev-sibling) (c-ts-mode--standalone-parent-skip-preproc) (c-ts-mode--standalone-grandparent, c-ts-mode--else-heuristic) (c-ts-mode--declarator-identifier) (c-ts-mode--fontify-declarator, c-ts-mode--fontify-variable) (c-ts-mode--defun-valid-p) (c-ts-mode--defun-for-class-in-imenu-p) (c-ts-mode--defun-skipper, c-ts-mode--emacs-defun-p) (c-ts-mode--emacs-defun-at-point) (c-ts-mode--emacs-current-defun-name, c-ts-mode--reverse-ranges) (c-ts-mode, c++-ts-mode, c-or-c++-ts-mode): Doc fixes. --- lisp/progmodes/c-ts-common.el | 2 +- lisp/progmodes/c-ts-mode.el | 64 ++++++++++++++++++++++--------------------- lisp/treesit.el | 21 +++++++------- 3 files changed, 44 insertions(+), 43 deletions(-) diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index 0095d83e302..e48bcc64f14 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -332,7 +332,7 @@ Assumes the anchor is (point-min), i.e., the 0th column. This function basically counts the number of block nodes (i.e., brackets) (see `c-ts-common-indent-type-regexp-alist') between NODE and the root node (not counting NODE itself), and -multiply that by `c-ts-common-indent-offset'. +multiplies that by `c-ts-common-indent-offset'. To support GNU style, on each block level, this function also checks whether the opening bracket { is on its own line, if so, diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 8383979a373..3a89f0f494b 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -97,7 +97,7 @@ "Toggle the comment style between block and line comments. Optional numeric ARG, if supplied, switches to block comment style when positive, to line comment style when negative, and -just toggles it when zero or left out." +just toggles it when zero or omitted." (interactive "P") (let ((prevstate-line (string= comment-start "// "))) (when (or (not arg) @@ -147,9 +147,9 @@ symbol." "Style used for indentation. The selected style could be one of GNU, K&R, LINUX or BSD. If -one of the supplied styles doesn't suffice, a function could be -set instead. This function is expected to return a list that -follows the form of `treesit-simple-indent-rules'." +one of the supplied styles doesn't suffice, the value could be +a function instead. This function is expected to return a list +that follows the form of `treesit-simple-indent-rules'." :version "29.1" :type '(choice (symbol :tag "Gnu" gnu) (symbol :tag "K&R" k&r) @@ -202,8 +202,8 @@ To set the default indent style globally, use (if (derived-mode-p 'c-ts-mode) 'c 'cpp)))))) (defcustom c-ts-mode-emacs-sources-support t - "Whether to enable Emacs source-specific features. -This enables detection of definitions of Lisp function using + "Whether to enable Emacs source-specific C features. +This enables detection of definitions of Lisp functions via the DEFUN macro. This needs to be set before enabling `c-ts-mode'; if you change the value after enabling `c-ts-mode', toggle the mode off and on @@ -243,7 +243,7 @@ again." < and > are usually punctuation, e.g., in ->. But when used for templates, they should be considered pairs. -This function checks for < and > in the changed RANGES and apply +This function checks for < and > in the changed RANGES and applies appropriate text property to alter the syntax of template delimiters < and >'s." (goto-char beg) @@ -284,9 +284,9 @@ is actually the parent of point at the moment of indentation." "Return the start of the previous named sibling of NODE. This anchor handles the special case where the previous sibling -is a labeled_statement, in that case, return the child of the +is a labeled_statement; in that case, return the child of the labeled statement instead. (Actually, recursively go down until -the node isn't a labeled_statement.) Eg, +the node isn't a labeled_statement.) E.g., label: int x = 1; @@ -295,10 +295,11 @@ label: The anchor of \"int y = 2;\" should be \"int x = 1;\" rather than the labeled_statement. -Return nil if a) there is no prev-sibling, or 2) prev-sibling +Return nil if a) there is no prev-sibling, or b) prev-sibling doesn't have a child. -PARENT and BOL are like other anchor functions." +PARENT is NODE's parent, BOL is the beginning of non-whitespace +characters of the current line." (when-let ((prev-sibling (or (treesit-node-prev-sibling node t) (treesit-node-prev-sibling @@ -336,7 +337,7 @@ PARENT and BOL are like other anchor functions." (defun c-ts-mode--standalone-parent-skip-preproc (_n parent &rest _) "Like the standalone-parent anchor but skips preproc nodes. -PARENT is the same as other anchor functions." +PARENT is the parent of the current node." (save-excursion (treesit-node-start (treesit-parent-until @@ -353,13 +354,15 @@ PARENT is the same as other anchor functions." (defun c-ts-mode--standalone-grandparent (_node parent bol &rest args) "Like the standalone-parent anchor but pass it the grandparent. -PARENT, BOL, ARGS are the same as other anchor functions." +PARENT is NODE's parent, BOL is the beginning of non-whitespace +characters of the current line." (apply (alist-get 'standalone-parent treesit-simple-indent-presets) parent (treesit-node-parent parent) bol args)) (defun c-ts-mode--else-heuristic (node parent bol &rest _) "Heuristic matcher for when \"else\" is followed by a closing bracket. -NODE, PARENT, and BOL are the same as in other matchers." +PARENT is NODE's parent, BOL is the beginning of non-whitespace +characters of the current line." (and (null node) (save-excursion (forward-line -1) @@ -757,7 +760,7 @@ MODE is either `c' or `cpp'." (defun c-ts-mode--declarator-identifier (node &optional qualified) "Return the identifier of the declarator node NODE. -If QUALIFIED is non-nil, include the names space part of the +If QUALIFIED is non-nil, include the namespace part of the identifier and return a qualified_identifier." (pcase (treesit-node-type node) ;; Recurse. @@ -782,7 +785,7 @@ identifier and return a qualified_identifier." node))) (defun c-ts-mode--fontify-declarator (node override start end &rest _args) - "Fontify a declarator (whatever under the \"declarator\" field). + "Fontify a declarator (whatever is under the \"declarator\" field). For NODE, OVERRIDE, START, END, and ARGS, see `treesit-font-lock-rules'." (let* ((identifier (c-ts-mode--declarator-identifier node)) @@ -817,7 +820,7 @@ For NODE, OVERRIDE, START, END, and ARGS, see (defun c-ts-mode--fontify-variable (node override start end &rest _) "Fontify an identifier node if it is a variable. -Don't fontify if it is a function identifier. For NODE, +Don't fontify it if it is a function identifier. For NODE, OVERRIDE, START, END, and ARGS, see `treesit-font-lock-rules'." (when (not (equal (treesit-node-type (treesit-node-parent node)) @@ -938,7 +941,7 @@ Return nil if NODE is not a defun node or doesn't have a name." (defun c-ts-mode--defun-valid-p (node) "Return non-nil if NODE is a valid defun node. -Ie, NODE is not nested." +That is, NODE is not nested." (let ((top-level-p (lambda (node) (not (treesit-node-top-level node (rx (or "function_definition" @@ -977,8 +980,7 @@ Basically, if NODE is a class, return non-nil; if NODE is a function but is under a class, return non-nil; if NODE is a top-level function, return nil. -This is for the Class subindex in -`treesit-simple-imenu-settings'." +This is for the Class subindex in `treesit-simple-imenu-settings'." (pcase (treesit-node-type node) ;; The Class subindex only has class_specifier and ;; function_definition. @@ -989,7 +991,7 @@ This is for the Class subindex in (defun c-ts-mode--defun-skipper () "Custom defun skipper for `c-ts-mode' and friends. -Structs in C ends with a semicolon, but the semicolon is not +Structs in C end with a semicolon, but the semicolon is not considered part of the struct node, so point would stop before the semicolon. This function skips the semicolon." (when (looking-at (rx (* (or " " "\t")) ";")) @@ -1009,7 +1011,7 @@ the semicolon. This function skips the semicolon." (list node parent bol))) (defun c-ts-mode--emacs-defun-p (node) - "Return non-nil if NODE is a Lisp function defined using DEFUN. + "Return non-nil if NODE is a Lisp function defined via DEFUN. This function detects Lisp primitives defined in Emacs source files using the DEFUN macro." (and (equal (treesit-node-type node) "expression_statement") @@ -1030,15 +1032,15 @@ files using the DEFUN macro." "Return the defun node at point. In addition to regular C functions, this function recognizes -definitions of Lisp primitrives in Emacs source files using DEFUN, -if `c-ts-mode-emacs-sources-support' is non-nil. +definitions of Lisp primitrives in Emacs source files defined +via DEFUN, if `c-ts-mode-emacs-sources-support' is non-nil. Note that DEFUN is parsed by tree-sitter as two separate nodes, one for the declaration and one for the body; this function returns the declaration node. If RANGE is non-nil, return (BEG . END) where BEG end END -encloses the whole defun. This is for when the entire defun +enclose the whole defun. This is for when the entire defun is required, not just the declaration part for DEFUN." (when-let* ((node (treesit-defun-at-point)) (defun-range (cons (treesit-node-start node) @@ -1067,7 +1069,7 @@ is required, not just the declaration part for DEFUN." "Return the name of the current defun. This is used for `add-log-current-defun-function'. In addition to regular C functions, this function also recognizes -Emacs primitives defined using DEFUN in Emacs sources, +Emacs primitives defined via DEFUN in Emacs sources, if `c-ts-mode-emacs-sources-support' is non-nil." (or (treesit-add-log-current-defun) (c-ts-mode--defun-name (c-ts-mode--emacs-defun-at-point)))) @@ -1145,7 +1147,7 @@ For BOL see `treesit-simple-indent-rules'." (defun c-ts-mode--reverse-ranges (ranges beg end) "Reverse RANGES and return the new ranges between BEG and END. -Positions that were included RANGES are not in the returned +Positions that were included in RANGES are not in the returned ranges, and vice versa. Return nil if RANGES is nil. This way, passing the returned @@ -1287,7 +1289,7 @@ BEG and END are described in `treesit-range-rules'." This mode is independent from the classic cc-mode.el based `c-mode', so configuration variables of that mode, like -`c-basic-offset', doesn't affect this mode. +`c-basic-offset', don't affect this mode. To use tree-sitter C/C++ modes by default, evaluate @@ -1296,7 +1298,7 @@ To use tree-sitter C/C++ modes by default, evaluate (add-to-list \\='major-mode-remap-alist \\='(c-or-c++-mode . c-or-c++-ts-mode)) -in your configuration." +in your init files." :group 'c :after-hook (c-ts-mode-set-modeline) @@ -1348,7 +1350,7 @@ To use tree-sitter C/C++ modes by default, evaluate (add-to-list \\='major-mode-remap-alist \\='(c-or-c++-mode . c-or-c++-ts-mode)) -in your configuration. +in your init files. Since this mode uses a parser, unbalanced brackets might cause some breakage in indentation/fontification. Therefore, it's @@ -1443,7 +1445,7 @@ matching on file name insufficient for detecting major mode that should be used. This function attempts to use file contents to determine whether -the code is C or C++ and based on that chooses whether to enable +the code is C or C++, and based on that chooses whether to enable `c-ts-mode' or `c++-ts-mode'." (declare (obsolete c-or-c++-mode "30.1")) (interactive) diff --git a/lisp/treesit.el b/lisp/treesit.el index fa82ad898a9..2b4893e6129 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2237,7 +2237,7 @@ for invalid node. This is used by `treesit-beginning-of-defun' and friends.") (defvar-local treesit-defun-tactic 'nested - "Determines how does Emacs treat nested defuns. + "Determines how Emacs treats nested defuns. If the value is `top-level', Emacs only moves across top-level defuns, if the value is `nested', Emacs recognizes nested defuns.") @@ -2253,9 +2253,8 @@ If the value is nil, no skipping is performed.") (defvar-local treesit-defun-name-function nil "A function that is called with a node and returns its defun name or nil. If the node is a defun node, return the defun name, e.g., the -function name of a function. If the node is not a defun node, or -the defun node doesn't have a name, or the node is nil, return -nil.") +name of a function. If the node is not a defun node, or the +defun node doesn't have a name, or the node is nil, return nil.") (defvar-local treesit-add-log-defun-delimiter "." "The delimiter used to connect several defun names. @@ -2728,12 +2727,12 @@ function is called recursively." ;; TODO: In corporate into thing-at-point. (defun treesit-thing-at-point (thing tactic) - "Return the THING at point or nil if none is found. + "Return the THING at point, or nil if none is found. -THING can be a symbol, regexp, a predicate function, and more, +THING can be a symbol, a regexp, a predicate function, and more; see `treesit-thing-settings' for details. -Return the top-level THING if TACTIC is `top-level', return the +Return the top-level THING if TACTIC is `top-level'; return the smallest enclosing THING as POS if TACTIC is `nested'." (let ((node (treesit--thing-at (point) thing))) @@ -2742,11 +2741,11 @@ smallest enclosing THING as POS if TACTIC is `nested'." node))) (defun treesit-defun-at-point () - "Return the defun node at point or nil if none is found. + "Return the defun node at point, or nil if none is found. -Respects `treesit-defun-tactic': return the top-level defun if it -is `top-level', return the immediate parent defun if it is -`nested'. +Respects `treesit-defun-tactic': returns the top-level defun if it +is `top-level', otherwise return the immediate parent defun if it +is `nested'. Return nil if `treesit-defun-type-regexp' isn't set and `defun' isn't defined in `treesit-thing-settings'." -- cgit v1.2.3 From 023a5fe5a3bd2f20eb168bc4763fa98e14201fff Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 23 Mar 2024 18:12:56 +0800 Subject: Minor adjustments to last change * src/androidvfs.c (android_vfs_convert_name): Simplify. (android_saf_tree_readdir, android_root_name): Remove redundant statements. --- src/androidvfs.c | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/src/androidvfs.c b/src/androidvfs.c index 6a9ddb33c56..a9035ae53c6 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -5553,7 +5553,6 @@ android_saf_tree_readdir (struct android_vdir *vdir) chars); /* Resize dirent to accommodate the decoded text. */ - length = strlen (chars) + 1; size = offsetof (struct dirent, d_name) + 1 + coding.produced; dirent = xrealloc (dirent, size); @@ -6573,15 +6572,11 @@ static struct android_special_vnode special_vnodes[] = static Lisp_Object android_vfs_convert_name (const char *name, Lisp_Object coding) { - Lisp_Object src_coding, name1; - - src_coding = Qutf_8_emacs; + Lisp_Object name1; - /* Convert the contents of the buffer after BUFFER_END - from the file name coding system to - special->special_coding_system. */ - AUTO_STRING (file_name, name); - name1 = code_convert_string_norecord (file_name, src_coding, false); + /* Convert the contents of the buffer after BUFFER_END from the file + name coding system to special->special_coding_system. */ + name1 = build_string (name); name1 = code_convert_string (name1, coding, Qt, true, true, true); return name1; } @@ -6632,7 +6627,7 @@ android_root_name (struct android_vnode *vnode, char *name, /* Allocate a buffer and copy file_name into the same. */ length = SBYTES (file_name) + 1; - name = SAFE_ALLOCA (length + 1); + name = SAFE_ALLOCA (length); /* Copy the trailing NULL byte also. */ memcpy (name, SDATA (file_name), length); @@ -6662,7 +6657,7 @@ android_root_name (struct android_vnode *vnode, char *name, /* Allocate a buffer and copy file_name into the same. */ length = SBYTES (file_name) + 1; - name = SAFE_ALLOCA (length + 1); + name = SAFE_ALLOCA (length); /* Copy the trailing NULL byte also. */ memcpy (name, SDATA (file_name), length); -- cgit v1.2.3 From 0e83cbd90ecdf793b2422d9219886d91ea4c385a Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 23 Mar 2024 18:14:12 +0800 Subject: Enable calling decode_coding_object with both SRC and DST_OBJECT Qnil * src/coding.c (growable_destination): A C destination is also reallocable. (produce_chars): Don't consider source and destination identical if they are EQ but Qnil. --- src/coding.c | 34 +++++++++++++++++++++++----------- 1 file changed, 23 insertions(+), 11 deletions(-) diff --git a/src/coding.c b/src/coding.c index ff7cf56c297..3f314b46d5e 100644 --- a/src/coding.c +++ b/src/coding.c @@ -614,10 +614,11 @@ inhibit_flag (int encoded_flag, bool var) static bool growable_destination (struct coding_system *coding) { - return STRINGP (coding->dst_object) || BUFFERP (coding->dst_object); + return (STRINGP (coding->dst_object) + || BUFFERP (coding->dst_object) + || NILP (coding->dst_object)); } - /* Safely get one byte from the source text pointed by SRC which ends at SRC_END, and set C to that byte. If there are not enough bytes in the source, it jumps to 'no_more_source'. If MULTIBYTEP, @@ -7005,7 +7006,6 @@ get_translation (Lisp_Object trans, int *buf, int *buf_end, ptrdiff_t *nchars) return Qnil; } - static int produce_chars (struct coding_system *coding, Lisp_Object translation_table, bool last_block) @@ -7063,7 +7063,10 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table, || ckd_add (&dst_size, dst_size, buf_end - buf)) memory_full (SIZE_MAX); dst = alloc_destination (coding, dst_size, dst); - if (EQ (coding->src_object, coding->dst_object)) + if (EQ (coding->src_object, coding->dst_object) + /* Input and output are not C buffers, which are safe to + assume to be different. */ + && !NILP (coding->src_object)) { coding_set_source (coding); dst_end = (((unsigned char *) coding->source) @@ -7098,7 +7101,10 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table, const unsigned char *src = coding->source; const unsigned char *src_end = src + coding->consumed; - if (EQ (coding->dst_object, coding->src_object)) + if (EQ (coding->dst_object, coding->src_object) + /* Input and output are not C buffers, which are safe to + assume to be different. */ + && !NILP (coding->src_object)) { eassert (growable_destination (coding)); dst_end = (unsigned char *) src; @@ -7119,7 +7125,8 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table, if (dst == dst_end) { eassert (growable_destination (coding)); - if (EQ (coding->src_object, coding->dst_object)) + if (EQ (coding->src_object, coding->dst_object) + && !NILP (coding->src_object)) dst_end = (unsigned char *) src; if (dst == dst_end) { @@ -7131,7 +7138,8 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table, coding_set_source (coding); src = coding->source + offset; src_end = coding->source + coding->consumed; - if (EQ (coding->src_object, coding->dst_object)) + if (EQ (coding->src_object, coding->dst_object) + && !NILP (coding->src_object)) dst_end = (unsigned char *) src; } } @@ -7150,14 +7158,16 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table, if (dst >= dst_end - 1) { eassert (growable_destination (coding)); - if (EQ (coding->src_object, coding->dst_object)) + if (EQ (coding->src_object, coding->dst_object) + && !NILP (coding->src_object)) dst_end = (unsigned char *) src; if (dst >= dst_end - 1) { ptrdiff_t offset = src - coding->source; ptrdiff_t more_bytes; - if (EQ (coding->src_object, coding->dst_object)) + if (EQ (coding->src_object, coding->dst_object) + && !NILP (coding->src_object)) more_bytes = ((src_end - src) / 2) + 2; else more_bytes = src_end - src + 2; @@ -7166,7 +7176,8 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table, coding_set_source (coding); src = coding->source + offset; src_end = coding->source + coding->consumed; - if (EQ (coding->src_object, coding->dst_object)) + if (EQ (coding->src_object, coding->dst_object) + && !NILP (coding->src_object)) dst_end = (unsigned char *) src; } } @@ -7175,7 +7186,8 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table, } else { - if (!EQ (coding->src_object, coding->dst_object)) + if (!EQ (coding->src_object, coding->dst_object) + && !NILP (coding->src_object)) { ptrdiff_t require = coding->src_bytes - coding->dst_bytes; -- cgit v1.2.3 From 8d7a3ed3495968fd3e95a6126e7c23e25b7c495f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Mar 2024 18:54:39 +0200 Subject: * src/coding.c (produce_chars): Fix a thinko (bug#69966). --- src/coding.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/coding.c b/src/coding.c index 3f314b46d5e..c51ceb95475 100644 --- a/src/coding.c +++ b/src/coding.c @@ -7186,8 +7186,8 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table, } else { - if (!EQ (coding->src_object, coding->dst_object) - && !NILP (coding->src_object)) + if (!(EQ (coding->src_object, coding->dst_object) + && !NILP (coding->src_object))) { ptrdiff_t require = coding->src_bytes - coding->dst_bytes; -- cgit v1.2.3 From abc2d39e0102f8bb554d89da3c0ffe57188220ff Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Sat, 16 Mar 2024 17:11:24 +0000 Subject: Use 'regexp-opt' in 'dired-omit-regexp' In my benchmarking, for large dired buffers, using 'regexp-opt' provides around a 3x speedup in omitting. 'regexp-opt' takes around 5 milliseconds, so to avoid slowing down omitting in small dired buffers we cache the return value. Since omitting is now 3x faster, increase 'dired-omit-size-limit' by 3x. Also, document 'dired-omit-size-limit' better. * doc/misc/dired-x.texi (Omitting Variables): Document 'dired-omit-size-limit'. * etc/NEWS: Announce increase of 'dired-omit-size-limit'. * lisp/dired-x.el (dired-omit--extension-regexp-cache): Add. (dired-omit-regexp): Use 'regexp-opt'. (Bug#69775) (dired-omit-size-limit): Increase and improve docs. --- doc/misc/dired-x.texi | 9 +++++++++ etc/NEWS | 6 ++++++ lisp/dired-x.el | 26 ++++++++++++++++++++------ 3 files changed, 35 insertions(+), 6 deletions(-) diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index 4cad016a0f6..726b6653d0d 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -346,6 +346,15 @@ only match against the non-directory part of the file name. Set it to match the file name relative to the buffer's top-level directory. @end defvar +@defvar dired-omit-size-limit +If non-@code{nil}, @code{dired-omit-mode} will be effectively disabled +in directories whose listing has size (in bytes) larger than the value +of this option. Since omitting can be slow for very large directories, +this avoids having to wait before seeing the directory. This variable +is ignored when @code{dired-omit-mode} is called interactively, such as +by @code{C-x M-o}, so you can still enable omitting in the directory +after the initial display. + @cindex omitting additional files @defvar dired-omit-marker-char Temporary marker used by Dired to implement omitting. Should never be used diff --git a/etc/NEWS b/etc/NEWS index f4b4c30855c..e9cb455aa40 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -705,6 +705,12 @@ marked or clicked on files according to the OS conventions. For example, on systems supporting XDG, this runs 'xdg-open' on the files. +*** The default value of 'dired-omit-size-limit' was increased. +After performance improvements to omitting in large directories, the new +default value is 300k, up from 100k. This means 'dired-omit-mode' will +omit files in directories whose directory listing is up to 300 kilobytes +in size. + +++ *** 'dired-listing-switches' handles connection-local values if exist. This allows to customize different switches for different remote machines. diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 62fdd916e69..753d3054d2f 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -77,12 +77,17 @@ files not writable by you are visited read-only." (other :tag "non-writable only" if-file-read-only)) :group 'dired-x) -(defcustom dired-omit-size-limit 100000 - "Maximum size for the \"omitting\" feature. +(defcustom dired-omit-size-limit 300000 + "Maximum buffer size for `dired-omit-mode'. + +Omitting will be disabled if the directory listing exceeds this size in +bytes. This variable is ignored when `dired-omit-mode' is called +interactively. + If nil, there is no maximum size." :type '(choice (const :tag "no maximum" nil) integer) :group 'dired-x - :version "29.1") + :version "30.1") (defcustom dired-omit-case-fold 'filesystem "Determine whether \"omitting\" patterns are case-sensitive. @@ -506,14 +511,23 @@ status message." (re-search-forward dired-re-mark nil t)))) count))) +(defvar dired-omit--extension-regexp-cache + nil + "A cache of `regexp-opt' applied to `dired-omit-extensions'. + +This is a cons whose car is a list of strings and whose cdr is a +regexp produced by `regexp-opt'.") + (defun dired-omit-regexp () + (unless (equal dired-omit-extensions (car dired-omit--extension-regexp-cache)) + (setq dired-omit--extension-regexp-cache + (cons dired-omit-extensions (regexp-opt dired-omit-extensions)))) (concat (if dired-omit-files (concat "\\(" dired-omit-files "\\)") "") (if (and dired-omit-files dired-omit-extensions) "\\|" "") (if dired-omit-extensions (concat ".";; a non-extension part should exist - "\\(" - (mapconcat 'regexp-quote dired-omit-extensions "\\|") - "\\)$") + (cdr dired-omit--extension-regexp-cache) + "$") ""))) ;; Returns t if any work was done, nil otherwise. -- cgit v1.2.3 From af1e36d0c66350113869df9e840e5f21b750ce9d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Mar 2024 19:10:17 +0200 Subject: ; * doc/misc/dired-x.texi (Omitting Variables): Fix markup. --- doc/misc/dired-x.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index 726b6653d0d..ee0bcdb76c4 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -352,7 +352,7 @@ in directories whose listing has size (in bytes) larger than the value of this option. Since omitting can be slow for very large directories, this avoids having to wait before seeing the directory. This variable is ignored when @code{dired-omit-mode} is called interactively, such as -by @code{C-x M-o}, so you can still enable omitting in the directory +by @kbd{C-x M-o}, so you can still enable omitting in the directory after the initial display. @cindex omitting additional files -- cgit v1.2.3 From 72972118e6f5831f200108cd7b80bf86538c265e Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Sun, 17 Mar 2024 12:01:59 -0700 Subject: Allow toggling "readable" mode in EWW Additionally, add an option to prevent adding a new history entry for each call of 'eww-readable' (bug#68254). * lisp/net/eww.el (eww-retrieve): * lisp/net/eww.el (eww-readable-adds-to-history): New option. (eww-retrieve): Make sure we call CALLBACK in all configurations. (eww-render): Simplify how to pass encoding. (eww--parse-html-region, eww-display-document): New functions, extracted from... (eww-display-html): ... here. (eww-document-base): New function. (eww-readable): Toggle "readable" mode interactively, like with a minor mode. Consult 'eww-readable-adds-to-history'. (eww-reload): Use 'eshell-display-document'. * test/lisp/net/eww-tests.el (eww-test--with-mock-retrieve): Fix indent. (eww-test/display/html, eww-test/readable/toggle-display): New tests. * doc/misc/eww.texi (Basics): Describe the new behavior. * etc/NEWS: Announce this change. --- doc/misc/eww.texi | 5 ++ etc/NEWS | 12 +++++ lisp/net/eww.el | 127 +++++++++++++++++++++++++++++---------------- test/lisp/net/eww-tests.el | 57 +++++++++++++++++++- 4 files changed, 155 insertions(+), 46 deletions(-) diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index d31fcf1802b..522034c874d 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -146,6 +146,11 @@ a new tab is created on the frame tab bar. which part of the document contains the ``readable'' text, and will only display this part. This usually gets rid of menus and the like. + When called interactively, this command toggles the display of the +readable parts. With a positive prefix argument, this command always +displays the readable parts, and with a zero or negative prefix, it +always displays the full page. + @findex eww-toggle-fonts @vindex shr-use-fonts @kindex F diff --git a/etc/NEWS b/etc/NEWS index e9cb455aa40..30eaaf40385 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1066,6 +1066,18 @@ entries newer than the current page. To change the behavior when browsing from "historical" pages, you can customize 'eww-before-browse-history-function'. ++++ +*** 'eww-readable' now toggles display of the readable parts of a web page. +When called interactively, 'eww-readable' toggles whether to display +only the readable parts of a page or the full page. With a positive +prefix argument, it always displays the readable parts, and with a zero +or negative prefix, it always displays the full page. + +--- +*** New option 'eww-readable-adds-to-history'. +When non-nil (the default), calling 'eww-readable' adds a new entry to +the EWW page history. + ** go-ts-mode +++ diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 54847bdf396..54b65d35164 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -275,6 +275,11 @@ parameter, and should return the (possibly) transformed URL." :type '(repeat function) :version "29.1") +(defcustom eww-readable-adds-to-history t + "If non-nil, calling `eww-readable' adds a new entry to the history." + :type 'boolean + :version "30.1") + (defface eww-form-submit '((((type x w32 ns haiku pgtk android) (class color)) ; Like default mode line :box (:line-width 2 :style released-button) @@ -464,11 +469,11 @@ For more information, see Info node `(eww) Top'." (defun eww-retrieve (url callback cbargs) (cond ((null eww-retrieve-command) - (url-retrieve url #'eww-render cbargs)) + (url-retrieve url callback cbargs)) ((eq eww-retrieve-command 'sync) (let ((data-buffer (url-retrieve-synchronously url))) (with-current-buffer data-buffer - (apply #'eww-render nil cbargs)))) + (apply callback nil cbargs)))) (t (let ((buffer (generate-new-buffer " *eww retrieve*")) (error-buffer (generate-new-buffer " *eww error*"))) @@ -673,9 +678,9 @@ The renaming scheme is performed in accordance with (insert (format "Direct link to the document" url)) (goto-char (point-min)) - (eww-display-html charset url nil point buffer encode)) + (eww-display-html (or encode charset) url nil point buffer)) ((eww-html-p (car content-type)) - (eww-display-html charset url nil point buffer encode)) + (eww-display-html (or encode charset) url nil point buffer)) ((equal (car content-type) "application/pdf") (eww-display-pdf)) ((string-match-p "\\`image/" (car content-type)) @@ -726,34 +731,40 @@ The renaming scheme is performed in accordance with (declare-function libxml-parse-html-region "xml.c" (start end &optional base-url discard-comments)) -(defun eww-display-html (charset url &optional document point buffer encode) +(defun eww--parse-html-region (start end &optional coding-system) + "Parse the HTML between START and END, returning the DOM as an S-expression. +Use CODING-SYSTEM to decode the region; if nil, decode as UTF-8. + +This replaces the region with the preprocessed HTML." + (setq coding-system (or coding-system 'utf-8)) + (with-restriction start end + (condition-case nil + (decode-coding-region (point-min) (point-max) coding-system) + (coding-system-error nil)) + ;; Remove CRLF and replace NUL with � before parsing. + (while (re-search-forward "\\(\r$\\)\\|\0" nil t) + (replace-match (if (match-beginning 1) "" "�") t t)) + (eww--preprocess-html (point-min) (point-max)) + (libxml-parse-html-region (point-min) (point-max)))) + +(defsubst eww-document-base (url dom) + `(base ((href . ,url)) ,dom)) + +(defun eww-display-document (document &optional point buffer) (unless (fboundp 'libxml-parse-html-region) (error "This function requires Emacs to be compiled with libxml2")) + (setq buffer (or buffer (current-buffer))) (unless (buffer-live-p buffer) (error "Buffer %s doesn't exist" buffer)) ;; There should be a better way to abort loading images ;; asynchronously. (setq url-queue nil) - (let ((document - (or document - (list - 'base (list (cons 'href url)) - (progn - (setq encode (or encode charset 'utf-8)) - (condition-case nil - (decode-coding-region (point) (point-max) encode) - (coding-system-error nil)) - (save-excursion - ;; Remove CRLF and replace NUL with � before parsing. - (while (re-search-forward "\\(\r$\\)\\|\0" nil t) - (replace-match (if (match-beginning 1) "" "�") t t))) - (eww--preprocess-html (point) (point-max)) - (libxml-parse-html-region (point) (point-max)))))) - (source (and (null document) - (buffer-substring (point) (point-max))))) + (let ((url (when (eq (car document) 'base) + (alist-get 'href (cadr document))))) + (unless url + (error "Document is missing base URL")) (with-current-buffer buffer (setq bidi-paragraph-direction nil) - (plist-put eww-data :source source) (plist-put eww-data :dom document) (let ((inhibit-read-only t) (inhibit-modification-hooks t) @@ -794,6 +805,16 @@ The renaming scheme is performed in accordance with (forward-line 1))))) (eww-size-text-inputs)))) +(defun eww-display-html (charset url &optional document point buffer) + (let ((source (buffer-substring (point) (point-max)))) + (with-current-buffer buffer + (plist-put eww-data :source source))) + (eww-display-document + (or document + (eww-document-base + url (eww--parse-html-region (point) (point-max) charset))) + point buffer)) + (defun eww-handle-link (dom) (let* ((rel (dom-attr dom 'rel)) (href (dom-attr dom 'href)) @@ -1055,30 +1076,47 @@ The renaming scheme is performed in accordance with "automatic" bidi-paragraph-direction))) -(defun eww-readable () - "View the main \"readable\" parts of the current web page. +(defun eww-readable (&optional arg) + "Toggle display of only the main \"readable\" parts of the current web page. This command uses heuristics to find the parts of the web page that -contains the main textual portion, leaving out navigation menus and -the like." - (interactive nil eww-mode) +contain the main textual portion, leaving out navigation menus and the +like. + +If called interactively, toggle the display of the readable parts. If +the prefix argument is positive, display the readable parts, and if it +is zero or negative, display the full page. + +If called from Lisp, toggle the display of the readable parts if ARG is +`toggle'. Display the readable parts if ARG is nil, omitted, or is a +positive number. Display the full page if ARG is a negative number. + +When `eww-readable-adds-to-history' is non-nil, calling this function +adds a new entry to `eww-history'." + (interactive (list (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + 'toggle)) + eww-mode) (let* ((old-data eww-data) - (dom (with-temp-buffer + (make-readable (cond + ((eq arg 'toggle) + (not (plist-get old-data :readable))) + ((and (numberp arg) (< arg 1)) + nil) + (t t))) + (dom (with-temp-buffer (insert (plist-get old-data :source)) - (condition-case nil - (decode-coding-region (point-min) (point-max) 'utf-8) - (coding-system-error nil)) - (eww--preprocess-html (point-min) (point-max)) - (libxml-parse-html-region (point-min) (point-max)))) + (eww--parse-html-region (point-min) (point-max)))) (base (plist-get eww-data :url))) - (eww-score-readability dom) - (eww-save-history) - (eww--before-browse) - (eww-display-html nil nil - (list 'base (list (cons 'href base)) - (eww-highest-readability dom)) - nil (current-buffer)) - (dolist (elem '(:source :url :title :next :previous :up :peer)) - (plist-put eww-data elem (plist-get old-data elem))) + (when make-readable + (eww-score-readability dom) + (setq dom (eww-highest-readability dom))) + (when eww-readable-adds-to-history + (eww-save-history) + (eww--before-browse) + (dolist (elem '(:source :url :title :next :previous :up :peer)) + (plist-put eww-data elem (plist-get old-data elem)))) + (eww-display-document (eww-document-base base dom)) + (plist-put eww-data :readable make-readable) (eww--after-page-change))) (defun eww-score-readability (node) @@ -1398,8 +1436,7 @@ just re-display the HTML already fetched." (if local (if (null (plist-get eww-data :dom)) (error "No current HTML data") - (eww-display-html 'utf-8 url (plist-get eww-data :dom) - (point) (current-buffer))) + (eww-display-document (plist-get eww-data :dom) (point))) (let ((parsed (url-generic-parse-url url))) (if (equal (url-type parsed) "file") ;; Use Tramp instead of url.el for files (since url.el diff --git a/test/lisp/net/eww-tests.el b/test/lisp/net/eww-tests.el index bd00893d503..a09e0a4f279 100644 --- a/test/lisp/net/eww-tests.el +++ b/test/lisp/net/eww-tests.el @@ -33,7 +33,7 @@ body.") "Evaluate BODY with a mock implementation of `eww-retrieve'. This avoids network requests during our tests. Additionally, prepare a temporary EWW buffer for our tests." - (declare (indent 1)) + (declare (indent 0)) `(cl-letf (((symbol-function 'eww-retrieve) (lambda (url callback args) (with-temp-buffer @@ -48,6 +48,24 @@ temporary EWW buffer for our tests." ;;; Tests: +(ert-deftest eww-test/display/html () + "Test displaying a simple HTML page." + (eww-test--with-mock-retrieve + (let ((eww-test--response-function + (lambda (url) + (concat "Content-Type: text/html\n\n" + (format "

Hello

%s" + url))))) + (eww "example.invalid") + ;; Check that the buffer contains the rendered HTML. + (should (equal (buffer-string) "Hello\n\n\nhttp://example.invalid/\n")) + (should (equal (get-text-property (point-min) 'face) + '(shr-text shr-h1))) + ;; Check that the DOM includes the `base'. + (should (equal (pcase (plist-get eww-data :dom) + (`(base ((href . ,url)) ,_) url)) + "http://example.invalid/"))))) + (ert-deftest eww-test/history/new-page () "Test that when visiting a new page, the previous one goes into the history." (eww-test--with-mock-retrieve @@ -176,5 +194,42 @@ This sets `eww-before-browse-history-function' to "http://one.invalid/"))) (should (= eww-history-position 0))))) +(ert-deftest eww-test/readable/toggle-display () + "Test toggling the display of the \"readable\" parts of a web page." + (eww-test--with-mock-retrieve + (let* ((shr-width most-positive-fixnum) + (shr-use-fonts nil) + (words (string-join + (make-list + 20 "All work and no play makes Jack a dull boy.") + " ")) + (eww-test--response-function + (lambda (_url) + (concat "Content-Type: text/html\n\n" + "" + "This is an uninteresting sentence." + "
" + words + "
" + "")))) + (eww "example.invalid") + ;; Make sure EWW renders the whole document. + (should-not (plist-get eww-data :readable)) + (should (string-prefix-p + "This is an uninteresting sentence." + (buffer-substring-no-properties (point-min) (point-max)))) + (eww-readable 'toggle) + ;; Now, EWW should render just the "readable" parts. + (should (plist-get eww-data :readable)) + (should (string-match-p + (concat "\\`" (regexp-quote words) "\n*\\'") + (buffer-substring-no-properties (point-min) (point-max)))) + (eww-readable 'toggle) + ;; Finally, EWW should render the whole document again. + (should-not (plist-get eww-data :readable)) + (should (string-prefix-p + "This is an uninteresting sentence." + (buffer-substring-no-properties (point-min) (point-max))))))) + (provide 'eww-tests) ;; eww-tests.el ends here -- cgit v1.2.3 From 4b0f5cdb01fbd05c8184a89fa8543eb5600fb4f8 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Mon, 18 Mar 2024 16:52:34 -0700 Subject: Add 'eww-readable-urls' * lisp/net/eww.el (eww-readable-urls): New option. (eww-default-readable-p): New function... (eww-display-html): ... use it. * test/lisp/net/eww-tests.el (eww-test/readable/default-readable): New test. * doc/misc/eww.texi (Basics): Document 'eww-readable-urls'. * etc/NEWS: Announce this change (bug#68254). --- doc/misc/eww.texi | 16 ++++++++++++++++ etc/NEWS | 6 ++++++ lisp/net/eww.el | 43 ++++++++++++++++++++++++++++++++++++++----- test/lisp/net/eww-tests.el | 12 ++++++++++++ 4 files changed, 72 insertions(+), 5 deletions(-) diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index 522034c874d..eec6b3c3299 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -151,6 +151,22 @@ readable parts. With a positive prefix argument, this command always displays the readable parts, and with a zero or negative prefix, it always displays the full page. +@vindex eww-readable-urls + If you want EWW to render a certain page in ``readable'' mode by +default, you can add a regular expression matching its URL to +@code{eww-readable-urls}. Each entry can either be a regular expression +in string form or a cons cell of the form +@w{@code{(@var{regexp} . @var{readability})}}. If @var{readability} is +non-@code{nil}, this behaves the same as the string form; otherwise, +URLs matching @var{regexp} will never be displayed in readable mode by +default. For example, you can use this to make all pages default to +readable mode, except for a few outliers: + +@example +(setq eww-readable-urls '(("https://example\\.com/" . nil) + ".*")) +@end example + @findex eww-toggle-fonts @vindex shr-use-fonts @kindex F diff --git a/etc/NEWS b/etc/NEWS index 30eaaf40385..c6b654a9d3b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1073,6 +1073,12 @@ only the readable parts of a page or the full page. With a positive prefix argument, it always displays the readable parts, and with a zero or negative prefix, it always displays the full page. ++++ +*** New option 'eww-readable-urls'. +This is a list of regular expressions matching the URLs where EWW should +display only the readable parts by default. For more details, see +"(eww) Basics" in the EWW manual. + --- *** New option 'eww-readable-adds-to-history'. When non-nil (the default), calling 'eww-readable' adds a new entry to diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 54b65d35164..39ea964d47a 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -275,6 +275,22 @@ parameter, and should return the (possibly) transformed URL." :type '(repeat function) :version "29.1") +(defcustom eww-readable-urls nil + "A list of regexps matching URLs to display in readable mode by default. +EWW will display matching URLs using `eww-readable' (which see). + +Each element can be one of the following forms: a regular expression in +string form or a cons cell of the form (REGEXP . READABILITY). If +READABILITY is non-nil, this behaves the same as the string form; +otherwise, URLs matching REGEXP will never be displayed in readable mode +by default." + :type '(repeat (choice (string :tag "Readable URL") + (cons :tag "URL and Readability" + (string :tag "URL") + (radio (const :tag "Readable" t) + (const :tag "Non-readable" nil))))) + :version "30.1") + (defcustom eww-readable-adds-to-history t "If non-nil, calling `eww-readable' adds a new entry to the history." :type 'boolean @@ -809,11 +825,15 @@ This replaces the region with the preprocessed HTML." (let ((source (buffer-substring (point) (point-max)))) (with-current-buffer buffer (plist-put eww-data :source source))) - (eww-display-document - (or document - (eww-document-base - url (eww--parse-html-region (point) (point-max) charset))) - point buffer)) + (unless document + (let ((dom (eww--parse-html-region (point) (point-max) charset))) + (when (eww-default-readable-p url) + (eww-score-readability dom) + (setq dom (eww-highest-readability dom)) + (with-current-buffer buffer + (plist-put eww-data :readable t))) + (setq document (eww-document-base url dom)))) + (eww-display-document document point buffer)) (defun eww-handle-link (dom) (let* ((rel (dom-attr dom 'rel)) @@ -1159,6 +1179,19 @@ adds a new entry to `eww-history'." (setq result highest)))) result)) +(defun eww-default-readable-p (url) + "Return non-nil if URL should be displayed in readable mode by default. +This consults the entries in `eww-readable-urls' (which see)." + (catch 'found + (let (result) + (dolist (regexp eww-readable-urls) + (if (consp regexp) + (setq result (cdr regexp) + regexp (car regexp)) + (setq result t)) + (when (string-match regexp url) + (throw 'found result)))))) + (defvar-keymap eww-mode-map "g" #'eww-reload ;FIXME: revert-buffer-function instead! "G" #'eww diff --git a/test/lisp/net/eww-tests.el b/test/lisp/net/eww-tests.el index a09e0a4f279..b83435e0bd9 100644 --- a/test/lisp/net/eww-tests.el +++ b/test/lisp/net/eww-tests.el @@ -231,5 +231,17 @@ This sets `eww-before-browse-history-function' to "This is an uninteresting sentence." (buffer-substring-no-properties (point-min) (point-max))))))) +(ert-deftest eww-test/readable/default-readable () + "Test that EWW displays readable parts of pages by default when applicable." + (eww-test--with-mock-retrieve + (let* ((eww-test--response-function + (lambda (_url) + (concat "Content-Type: text/html\n\n" + "Hello there"))) + (eww-readable-urls '("://example\\.invalid/"))) + (eww "example.invalid") + ;; Make sure EWW uses "readable" mode. + (should (plist-get eww-data :readable))))) + (provide 'eww-tests) ;; eww-tests.el ends here -- cgit v1.2.3 From 79c758187cef7fc1f93fd525b9d81be81ee2b2cc Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Thu, 7 Mar 2024 21:55:00 -0800 Subject: Recompute :map when image :scale, :rotation, or :flip changes Now, when transforming an image, its :map is recomputed to fit. Image map coordinates are integers, so when computing :map, coordinates are rounded. To prevent an image from drifting from its map after repeated transformations, 'create-image' now adds a new image property :original-map, which is combined with the image's transformation parameters to recompute :map. * lisp/image.el (image-recompute-map-p): Add user option to control whether :map is recomputed when an image is transformed. (create-image): Create :map from :original-map and vice versa. (image--delayed-change-size): Fix comment. (image--change-size, image-rotate, image-flip-horizontally, image-flip-vertically): Recompute image map after transformation and mention 'image-recompute-map-p' in docstring. (image--compute-map): Add function to compute a map from original map. (image--compute-original-map): Add function to compute an original map from map. (image--scale-map): Add function to scale a map based on :scale. (image--rotate-map): Add function to rotate a map based on :rotation. (image--rotate-coord): Add function to rotate a map coordinate pair. (image--flip-map): Add function to flip a map based on :flip. (image-increase-size, image-decrease-size, image-mouse-increase-size) (image-mouse-decrease-size): Mention 'image-recompute-map-p' in docstrings. * etc/NEWS: Add NEWS entry. * doc/lispref/display.texi (Image Descriptors): Document :original-map and new user option 'image-recompute-map-p'. * test/lisp/image-tests.el (image--compute-map-and-original-map): Test 'image--compute-map' and 'image--compute-original-map'. (image-tests--map-equal): Add equality predicate to compare image maps. (image-create-image-with-map): Test that 'create-image' adds :map and/or :original-map as appropriate. (image-transform-map): Test functions related to transforming maps. (Bug#69602) --- doc/lispref/display.texi | 24 +++++ etc/NEWS | 12 +++ lisp/image.el | 221 ++++++++++++++++++++++++++++++++++++++++++++--- test/lisp/image-tests.el | 144 ++++++++++++++++++++++++++++++ 4 files changed, 389 insertions(+), 12 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index beca470d68a..b497967c445 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -6056,6 +6056,30 @@ to make things match up, you should either specify @code{:scale 1.0} when creating the image, or use the result of @code{image-compute-scaling-factor} to compute the elements of the map. + +When an image's @code{:scale}, @code{:rotation}, or @code{:flip} is +changed, @code{:map} will be recomputed based on the value of +@code{:original-map} and the values of those transformation. + +@item :original-map @var{original-map} +@cindex original image map +This specifies the untransformed image map which will be used to +recompute @code{:map} after the image's @code{:scale}, @code{:rotation}, +or @code{:flip} is changed. + +If @code{:original-map} is not specified when creating an image with +@code{create-image}, it will be computed based on the supplied +@code{:map}, as well as any of @code{:scale}, @code{:rotation}, or +@code{:flip} which are non-nil. + +Conversely, if @code{:original-map} is specified but @code{:map} is not, +@code{:map} will be computed based on @code{:original-map}, +@code{:scale}, @code{:rotation}, and @code{:flip}. + +@defopt image-recompute-map-p +Set this user option to nil to prevent Emacs from automatically +recomputing an image @code{:map} based on its @code{:original-map}. +@end defopt @end table @defun image-mask-p spec &optional frame diff --git a/etc/NEWS b/etc/NEWS index c6b654a9d3b..19588fe8eeb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1368,6 +1368,18 @@ without specifying a file, like this: (notifications-notify :title "I am playing music" :app-icon 'multimedia-player) +** Image + ++++ +*** Image :map property is now recomputed when image is transformed. +Now images with clickable maps work as expected after you run commands +such as `image-increase-size', `image-decrease-size', `image-rotate', +`image-flip-horizontally', and `image-flip-vertically'. + ++++ +*** New user option 'image-recompute-map-p' +Set this option to nil to prevent Emacs from recomputing image maps. + ** Image Dired *** New user option 'image-dired-thumb-naming'. diff --git a/lisp/image.el b/lisp/image.el index c13fea6c45c..55340ea03dc 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -560,6 +560,16 @@ Images should not be larger than specified by `max-image-size'." ('t t) ('nil nil) (func (funcall func image))))))) + ;; Add original map from map. + (when (and (plist-get props :map) + (not (plist-get props :original-map))) + (setq image (nconc image (list :original-map + (image--compute-original-map image))))) + ;; Add map from original map. + (when (and (plist-get props :original-map) + (not (plist-get props :map))) + (setq image (nconc image (list :map + (image--compute-map image))))) image))) (defun image--default-smoothing (image) @@ -1208,7 +1218,10 @@ has no effect." If N is 3, then the image size will be increased by 30%. More generally, the image size is multiplied by 1 plus N divided by 10. N defaults to 2, which increases the image size by 20%. -POSITION can be a buffer position or a marker, and defaults to point." +POSITION can be a buffer position or a marker, and defaults to point. + +When user option `image-recompute-map-p' is non-nil, the image's `:map' +is recomputed to fit the newly transformed image." (interactive "P") (image--delayed-change-size (if n (1+ (/ (prefix-numeric-value n) 10.0)) @@ -1220,7 +1233,7 @@ POSITION can be a buffer position or a marker, and defaults to point." (defun image--delayed-change-size (size position) ;; Wait for a bit of idle-time before actually performing the change, ;; so as to batch together sequences of closely consecutive size changes. - ;; `image--change-size' just changes one value in a plist. The actual + ;; `image--change-size' just changes two values in a plist. The actual ;; image resizing happens later during redisplay. So if those ;; consecutive calls happen without any redisplay between them, ;; the costly operation of image resizing should happen only once. @@ -1231,7 +1244,10 @@ POSITION can be a buffer position or a marker, and defaults to point." If N is 3, then the image size will be decreased by 30%. More generally, the image size is multiplied by 1 minus N divided by 10. N defaults to 2, which decreases the image size by 20%. -POSITION can be a buffer position or a marker, and defaults to point." +POSITION can be a buffer position or a marker, and defaults to point. + +When user option `image-recompute-map-p' is non-nil, the image's `:map' +is recomputed to fit the newly transformed image." (interactive "P") (image--delayed-change-size (if n (- 1 (/ (prefix-numeric-value n) 10.0)) @@ -1243,7 +1259,10 @@ POSITION can be a buffer position or a marker, and defaults to point." (defun image-mouse-increase-size (&optional event) "Increase the image size using the mouse-gesture EVENT. This increases the size of the image at the position specified by -EVENT, if any, by the default factor used by `image-increase-size'." +EVENT, if any, by the default factor used by `image-increase-size'. + +When user option `image-recompute-map-p' is non-nil, the image's `:map' +is recomputed to fit the newly transformed image." (interactive "e") (when (listp event) (save-window-excursion @@ -1253,7 +1272,10 @@ EVENT, if any, by the default factor used by `image-increase-size'." (defun image-mouse-decrease-size (&optional event) "Decrease the image size using the mouse-gesture EVENT. This decreases the size of the image at the position specified by -EVENT, if any, by the default factor used by `image-decrease-size'." +EVENT, if any, by the default factor used by `image-decrease-size'. + +When user option `image-recompute-map-p' is non-nil, the image's `:map' +is recomputed to fit the newly transformed image." (interactive "e") (when (listp event) (save-window-excursion @@ -1304,7 +1326,9 @@ POSITION can be a buffer position or a marker, and defaults to point." (new-image (image--image-without-parameters image)) (scale (image--current-scaling image new-image))) (setcdr image (cdr new-image)) - (plist-put (cdr image) :scale (* scale factor)))) + (plist-put (cdr image) :scale (* scale factor)) + (when (and (image-property image :original-map) image-recompute-map-p) + (setf (image-property image :map) (image--compute-map image))))) (defun image--image-without-parameters (image) (cons (pop image) @@ -1331,7 +1355,10 @@ POSITION can be a buffer position or a marker, and defaults to point." If nil, ANGLE defaults to 90. Interactively, rotate the image 90 degrees clockwise with no prefix argument, and counter-clockwise with a prefix argument. Note that most image types support -rotations by only multiples of 90 degrees." +rotations by only multiples of 90 degrees. + +When user option `image-recompute-map-p' is non-nil, the image's `:map' +is recomputed to fit the newly transformed image." (interactive (and current-prefix-arg '(-90))) (let ((image (image--get-imagemagick-and-warn))) (setf (image-property image :rotation) @@ -1339,7 +1366,9 @@ rotations by only multiples of 90 degrees." (or angle 90)) ;; We don't want to exceed 360 degrees rotation, ;; because it's not seen as valid in Exif data. - 360)))) + 360))) + (when (and (image-property image :original-map) image-recompute-map-p) + (setf (image-property image :map) (image--compute-map image)))) (set-transient-map image--repeat-map nil nil "Use %k for further adjustments")) @@ -1360,23 +1389,191 @@ changing the displayed image size does not affect the saved image." (read-file-name "Write image to file: "))))) (defun image-flip-horizontally () - "Horizontally flip the image under point." + "Horizontally flip the image under point. + +When user option `image-recompute-map-p' is non-nil, the image's `:map' +is recomputed to fit the newly transformed image." (interactive) (let ((image (image--get-image))) (image-flush image) (setf (image-property image :flip) - (not (image-property image :flip))))) + (not (image-property image :flip))) + (when (and (image-property image :original-map) image-recompute-map-p) + (setf (image-property image :map) (image--compute-map image))))) (defun image-flip-vertically () - "Vertically flip the image under point." + "Vertically flip the image under point. + +When user option `image-recompute-map-p' is non-nil, the image's `:map' +is recomputed to fit the newly transformed image." (interactive) (let ((image (image--get-image))) (image-rotate 180) (setf (image-property image :flip) - (not (image-property image :flip))))) + (not (image-property image :flip))) + (when (and (image-property image :original-map) image-recompute-map-p) + (setf (image-property image :map) (image--compute-map image))))) (define-obsolete-function-alias 'image-refresh #'image-flush "29.1") +;;; Map transformation + +(defcustom image-recompute-map-p t + "Recompute image map when scaling, rotating, or flipping an image." + :type 'boolean + :version "30.1") + +(defun image--compute-map (image) + "Compute map for IMAGE suitable to be used as its :map property. +Return a copy of :original-image transformed based on IMAGE's :scale, +:rotation, and :flip. When IMAGE's :original-map is nil, return nil. +When :rotation is not a multiple of 90, return copy of :original-map." + (pcase-let* ((original-map (image-property image :original-map)) + (map (copy-tree original-map t)) + (scale (or (image-property image :scale) 1)) + (rotation (or (image-property image :rotation) 0)) + (flip (image-property image :flip)) + ((and size `(,width . ,height)) (image-size image t))) + (when (and ; Handle only 90-degree rotations + (zerop (mod rotation 1)) + (zerop (% (truncate rotation) 90))) + ;; SIZE fits MAP after transformations. Scale MAP before + ;; flip and rotate operations, since both need MAP to fit SIZE. + (image--scale-map map scale) + ;; In rendered images, rotation is always applied before flip. + (image--rotate-map + map rotation (if (or (= 90 rotation) (= 270 rotation)) + ;; If rotated ±90°, swap width and height. + (cons height width) + size)) + ;; After rotation, there's no need to swap width and height. + (image--flip-map map flip size)) + map)) + +(defun image--compute-original-map (image) + "Return original map for IMAGE. +If IMAGE lacks :map property, return nil. +When :rotation is not a multiple of 90, return copy of :map." + (when (image-property image :map) + (let* ((image-copy (copy-tree image t)) + (map (image-property image-copy :map)) + (scale (or (image-property image-copy :scale) 1)) + (rotation (or (image-property image-copy :rotation) 0)) + (flip (image-property image-copy :flip)) + (size (image-size image-copy t))) + (when (and ; Handle only 90-degree rotations + (zerop (mod rotation 1)) + (zerop (% (truncate rotation) 90))) + ;; In rendered images, rotation is always applied before flip. + ;; To undo the transformation, flip before rotating. + ;; SIZE fits MAP before it is transformed back to ORIGINAL-MAP. + ;; Therefore, scale MAP after flip and rotate operations, since + ;; both need MAP to fit SIZE. + (image--flip-map map flip size) + (image--rotate-map map (- rotation) size) + (image--scale-map map (/ 1.0 scale))) + map))) + +(defun image--scale-map (map scale) + "Scale MAP according to SCALE. +Destructively modifies and returns MAP." + (unless (= 1 scale) + (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map) + (pcase-exhaustive type + ('rect + (setf (caar coords) (round (* (caar coords) scale))) + (setf (cdar coords) (round (* (cdar coords) scale))) + (setf (cadr coords) (round (* (cadr coords) scale))) + (setf (cddr coords) (round (* (cddr coords) scale)))) + ('circle + (setf (caar coords) (round (* (caar coords) scale))) + (setf (cdar coords) (round (* (cdar coords) scale))) + (setcdr coords (round (* (cdr coords) scale)))) + ('poly + (dotimes (i (length coords)) + (aset coords i + (round (* (aref coords i) scale)))))))) + map) + +(defun image--rotate-map (map rotation size) + "Rotate MAP according to ROTATION and SIZE. +Destructively modifies and returns MAP." + (unless (zerop rotation) + (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map) + (pcase-exhaustive type + ('rect + (let ( x0 y0 ; New upper left corner + x1 y1) ; New bottom right corner + (pcase (truncate (mod rotation 360)) ; Set new corners to... + (90 ; ...old bottom left and upper right + (setq x0 (caar coords) y0 (cddr coords) + x1 (cadr coords) y1 (cdar coords))) + (180 ; ...old bottom right and upper left + (setq x0 (cadr coords) y0 (cddr coords) + x1 (caar coords) y1 (cdar coords))) + (270 ; ...old upper right and bottom left + (setq x0 (cadr coords) y0 (cdar coords) + x1 (caar coords) y1 (cddr coords)))) + (setcar coords (image--rotate-coord x0 y0 rotation size)) + (setcdr coords (image--rotate-coord x1 y1 rotation size)))) + ('circle + (setcar coords (image--rotate-coord + (caar coords) (cdar coords) rotation size))) + ('poly + (dotimes (i (length coords)) + (when (= 0 (% i 2)) + (pcase-let ((`(,x . ,y) + (image--rotate-coord + (aref coords i) (aref coords (1+ i)) rotation size))) + (aset coords i x) + (aset coords (1+ i) y)))))))) + map) + +(defun image--rotate-coord (x y angle size) + "Rotate coordinates X and Y by ANGLE in image of SIZE. +ANGLE must be a multiple of 90. Returns a cons cell of rounded +coordinates (X1 Y1)." + (pcase-let* ((radian (* (/ angle 180.0) float-pi)) + (`(,width . ,height) size) + ;; y is positive, but we are in the bottom-right quadrant + (y (- y)) + ;; Rotate clockwise + (x1 (+ (* (sin radian) y) (* (cos radian) x))) + (y1 (- (* (cos radian) y) (* (sin radian) x))) + ;; Translate image back into bottom-right quadrant + (`(,x1 . ,y1) + (pcase (truncate (mod angle 360)) + (90 ; Translate right by height + (cons (+ x1 height) y1)) + (180 ; Translate right by width and down by height + (cons (+ x1 width) (- y1 height))) + (270 ; Translate down by width + (cons x1 (- y1 width))))) + ;; Invert y1 to make both x1 and y1 positive + (y1 (- y1))) + (cons (round x1) (round y1)))) + +(defun image--flip-map (map flip size) + "Horizontally flip MAP according to FLIP and SIZE. +Destructively modifies and returns MAP." + (when flip + (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map) + (pcase-exhaustive type + ('rect + (let ((x0 (- (car size) (cadr coords))) + (y0 (cdar coords)) + (x1 (- (car size) (caar coords))) + (y1 (cddr coords))) + (setcar coords (cons x0 y0)) + (setcdr coords (cons x1 y1)))) + ('circle + (setf (caar coords) (- (car size) (caar coords)))) + ('poly + (dotimes (i (length coords)) + (when (= 0 (% i 2)) + (aset coords i (- (car size) (aref coords i))))))))) + map) + (provide 'image) ;;; image.el ends here diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el index 80142d6d6de..6a5f03e38a0 100644 --- a/test/lisp/image-tests.el +++ b/test/lisp/image-tests.el @@ -153,4 +153,148 @@ (image-rotate -154.5) (should (equal image '(image :rotation 91.0))))) +;;;; Transforming maps + +(ert-deftest image-create-image-with-map () + "Test that `create-image' correctly adds :map and/or :original-map." + (skip-unless (display-images-p)) + (let ((data "foo") + (map '(((circle (1 . 1) . 1) a))) + (original-map '(((circle (2 . 2) . 2) a))) + (original-map-other '(((circle (3 . 3) . 3) a)))) + ;; Generate :original-map from :map. + (let* ((image (create-image data 'svg t :map map :scale 0.5)) + (got-original-map (image-property image :original-map))) + (should (equal got-original-map original-map))) + ;; Generate :map from :original-map. + (let* ((image (create-image + data 'svg t :original-map original-map :scale 0.5)) + (got-map (image-property image :map))) + (should (equal got-map map))) + ;; Use :original-map if both it and :map are specified. + (let* ((image (create-image + data 'svg t :map map + :original-map original-map-other :scale 0.5)) + (got-original-map (image-property image :original-map))) + (should (equal got-original-map original-map-other))))) + +(defun image-tests--map-equal (a b &optional tolerance) + "Return t if maps A and B have the same coordinates within TOLERANCE. +Since image sizes calculations vary on different machines, this function +allows for each image map coordinate in A to be within TOLERANCE to the +corresponding coordinate in B. When nil, TOLERANCE defaults to 5." + (unless tolerance (setq tolerance 5)) + (catch 'different + (cl-labels ((check-tolerance + (coord-a coord-b) + (unless (>= tolerance (abs (- coord-a coord-b))) + (throw 'different nil)))) + (dotimes (i (length a)) + (pcase-let ((`((,type-a . ,coords-a) ,_id ,_plist) (nth i a)) + (`((,type-b . ,coords-b) ,_id ,_plist) (nth i b))) + (unless (eq type-a type-b) + (throw 'different nil)) + (pcase-exhaustive type-a + ('rect + (check-tolerance (caar coords-a) (caar coords-b)) + (check-tolerance (cdar coords-a) (cdar coords-b)) + (check-tolerance (cadr coords-a) (cadr coords-b)) + (check-tolerance (cddr coords-a) (cddr coords-b))) + ('circle + (check-tolerance (caar coords-a) (caar coords-b)) + (check-tolerance (cdar coords-a) (cdar coords-b)) + (check-tolerance (cdar coords-a) (cdar coords-b))) + ('poly + (dotimes (i (length coords-a)) + (check-tolerance (aref coords-a i) (aref coords-b i)))))))) + t)) + +(ert-deftest image--compute-map-and-original-map () + "Test `image--compute-map' and `image--compute-original-map'." + (skip-unless (display-images-p)) + (let* ((svg-string "ABC") + (original-map + '(((circle (41 . 29) . 24) "a" (help-echo "A")) + ((rect (5 . 101) 77 . 149) "b" (help-echo "B")) + ((poly . [161 29 160 22 154 15 146 10 136 7 125 5 114 7 104 10 96 15 91 22 89 29 91 37 96 43 104 49 114 52 125 53 136 52 146 49 154 43 160 37]) "c" (help-echo "C")))) + (scaled-map + '(((circle (82 . 58) . 48) "a" (help-echo "A")) + ((rect (10 . 202) 154 . 298) "b" (help-echo "B")) + ((poly . [322 58 320 44 308 30 292 20 272 14 250 10 228 14 208 20 192 30 182 44 178 58 182 74 192 86 208 98 228 104 250 106 272 104 292 98 308 86 320 74]) "c" (help-echo "C")))) + (flipped-map + '(((circle (125 . 29) . 24) "a" (help-echo "A")) + ((rect (89 . 101) 161 . 149) "b" (help-echo "B")) + ((poly . [5 29 6 22 12 15 20 10 30 7 41 5 52 7 62 10 70 15 75 22 77 29 75 37 70 43 62 49 52 52 41 53 30 52 20 49 12 43 6 37]) "c" (help-echo "C")))) + (rotated-map + '(((circle (126 . 41) . 24) "a" (help-echo "A")) + ((rect (6 . 5) 54 . 77) "b" (help-echo "B")) + ((poly . [126 161 133 160 140 154 145 146 148 136 150 125 148 114 145 104 140 96 133 91 126 89 118 91 112 96 106 104 103 114 102 125 103 136 106 146 112 154 118 160]) "c" (help-echo "C")))) + (scaled-rotated-flipped-map + '(((circle (58 . 82) . 48) "a" (help-echo "A")) + ((rect (202 . 10) 298 . 154) "b" (help-echo "B")) + ((poly . [58 322 44 320 30 308 20 292 14 272 10 250 14 228 20 208 30 192 44 182 58 178 74 182 86 192 98 208 104 228 106 250 104 272 98 292 86 308 74 320]) "c" (help-echo "C")))) + (image (create-image svg-string 'svg t :map scaled-rotated-flipped-map + :scale 2 :rotation 90 :flip t))) + ;; Test that `image--compute-original-map' correctly generates + ;; original-map when creating an already transformed image. + (should (image-tests--map-equal (image-property image :original-map) + original-map)) + (setf (image-property image :flip) nil) + (setf (image-property image :rotation) 0) + (setf (image-property image :scale) 2) + (should (image-tests--map-equal (image--compute-map image) + scaled-map)) + (setf (image-property image :scale) 1) + (setf (image-property image :rotation) 90) + (should (image-tests--map-equal (image--compute-map image) + rotated-map)) + (setf (image-property image :rotation) 0) + (setf (image-property image :flip) t) + (should (image-tests--map-equal (image--compute-map image) + flipped-map)) + (setf (image-property image :scale) 2) + (setf (image-property image :rotation) 90) + (should (image-tests--map-equal (image--compute-map image) + scaled-rotated-flipped-map)) + + ;; Uncomment to test manually by interactively transforming the + ;; image and checking the map boundaries by hovering them. + + ;; (with-current-buffer (get-buffer-create "*test image map*") + ;; (erase-buffer) + ;; (insert-image image) + ;; (goto-char (point-min)) + ;; (pop-to-buffer (current-buffer))) + )) + +(ert-deftest image-transform-map () + "Test functions related to transforming image maps." + (let ((map '(((circle (4 . 3) . 2) "circle") + ((rect (3 . 6) 8 . 8) "rect") + ((poly . [6 11 7 13 2 14]) "poly"))) + (width 10) + (height 15)) + (should (equal (image--scale-map (copy-tree map t) 2) + '(((circle (8 . 6) . 4) "circle") + ((rect (6 . 12) 16 . 16) "rect") + ((poly . [12 22 14 26 4 28]) "poly")))) + (should (equal (image--rotate-map (copy-tree map t) 90 `(,width . ,height)) + '(((circle (12 . 4) . 2) "circle") + ((rect (7 . 3) 9 . 8) "rect") + ((poly . [4 6 2 7 1 2]) "poly")))) + (should (equal (image--flip-map (copy-tree map t) t `(,width . ,height)) + '(((circle (6 . 3) . 2) "circle") + ((rect (2 . 6) 7 . 8) "rect") + ((poly . [4 11 3 13 8 14]) "poly")))) + (let ((copy (copy-tree map t))) + (image--scale-map copy 2) + ;; Scale size because the map has been scaled. + (image--rotate-map copy 90 `(,(* 2 width) . ,(* 2 height))) + ;; Swap width and height because the map has been flipped. + (image--flip-map copy t `(,(* 2 height) . ,(* 2 width))) + (should (equal copy + '(((circle (6 . 8) . 4) "circle") + ((rect (12 . 6) 16 . 16) "rect") + ((poly . [22 12 26 14 28 4]) "poly"))))))) + ;;; image-tests.el ends here -- cgit v1.2.3 From 8578652b5b0958aaa92c99667a9ccd72cc412bd6 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sat, 23 Mar 2024 20:15:40 +0100 Subject: ; Fix markup in recent change to dired-x.texi. --- doc/misc/dired-x.texi | 1 + 1 file changed, 1 insertion(+) diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index ee0bcdb76c4..e23ce3792e0 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -354,6 +354,7 @@ this avoids having to wait before seeing the directory. This variable is ignored when @code{dired-omit-mode} is called interactively, such as by @kbd{C-x M-o}, so you can still enable omitting in the directory after the initial display. +@end defvar @cindex omitting additional files @defvar dired-omit-marker-char -- cgit v1.2.3 From 0f04aa06a69cb82eb66d5ffd46700ffdbd58b8f3 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 23 Mar 2024 16:11:07 -0400 Subject: (describe-package-1): Fix bug#69712 * lisp/emacs-lisp/package.el (describe-package-1): Improve the test to determine if `maintainers` contains a single cons or a list of conses. --- lisp/emacs-lisp/package.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index fe7b10f569a..ab1731aeb54 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2941,7 +2941,7 @@ Helper function for `describe-package'." (insert " ")) (insert "\n")) (when maintainers - (unless (proper-list-p maintainers) + (when (stringp (car maintainers)) (setq maintainers (list maintainers))) (package--print-help-section (if (cdr maintainers) "Maintainers" "Maintainer")) -- cgit v1.2.3 From 44be4fa8e652f08cad0cd6a85abcd54c691a7c27 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 19 Mar 2024 23:51:46 -0700 Subject: Remove unused faces from various erc-goodies tests ; A note to anyone running ERC's test suite while bisecting and ; unlucky enough to land on this commit: apologies for the ; inconvenience. It fails because it includes adjustments for fixes ; only introduced by the subsequent commit. This is obviously ; objectionable but was done knowingly in order to duck the ; copyright-exemption threshold for new contributors. * test/lisp/erc/erc-goodies-tests.el (erc-controls-highlight--spoilers) (erc-controls-highlight--inverse): Remove all mention of stricken faces `erc-control-default-fg' and `erc-control-default-bg'. (erc-controls-highlight/default-foreground) (erc-controls-highlight/default-background): New tests. (Bug#69860) --- test/lisp/erc/erc-goodies-tests.el | 127 +++++++++++++++++++++++++++++++++---- 1 file changed, 116 insertions(+), 11 deletions(-) diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index c8fb0544a72..7cbaa39d3f7 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -167,15 +167,13 @@ '(fg:erc-color-face1 bg:erc-color-face1)) ;; Masked in all black. (erc-goodies-tests--assert-face - 20 "BlackOnBlack" '(fg:erc-color-face1 bg:erc-color-face1) - '(erc-control-default-fg erc-control-default-bg)) + 20 "BlackOnBlack" '(fg:erc-color-face1 bg:erc-color-face1) nil) ;; Explicit "default" code ignoerd. (erc-goodies-tests--assert-face - 34 "Default" '(erc-control-default-fg erc-control-default-bg) + 34 "Default" '(erc-default-face) '(fg:erc-color-face1 bg:erc-color-face1)) (erc-goodies-tests--assert-face - 43 "END" 'erc-default-face - '(erc-control-default-bg erc-control-default-fg)))) + 43 "END" 'erc-default-face nil))) (when noninteractive (erc-tests-common-kill-buffers))) @@ -214,17 +212,124 @@ nil) ;; The inverse of `default' because reverse still in effect. (erc-goodies-tests--assert-face - 32 "ReversedDefault" '(erc-inverse-face erc-control-default-fg - erc-control-default-bg) + 32 "ReversedDefault" '(erc-inverse-face erc-default-face) '(fg:erc-color-face3 bg:erc-color-face13)) (erc-goodies-tests--assert-face - 49 "NormalDefault" '(erc-control-default-fg - erc-control-default-bg) + 49 "NormalDefault" '(erc-default-face) '(erc-inverse-face fg:erc-color-face1 bg:erc-color-face1)) (erc-goodies-tests--assert-face 64 "END" 'erc-default-face - '( erc-control-default-fg erc-control-default-bg - fg:erc-color-face0 bg:erc-color-face0)))) + '(fg:erc-color-face0 bg:erc-color-face0)))) + (when noninteractive + (erc-tests-common-kill-buffers))) + +;; This is meant to assert two behavioral properties: +;; +;; 1) The background is preserved when only a new foreground is +;; defined, in accordance with this bit from the spec: "If only the +;; foreground color is set, the background color stays the same." +;; https://modern.ircdocs.horse/formatting#color +;; +;; 2) The same holds true for a new, lone foreground of 99. Rather +;; than prepend `erc-default-face', this causes the removal of an +;; existing foreground face and likewise doesn't clobber the +;; existing background. +(ert-deftest erc-controls-highlight/default-foreground () + (should (eq t erc-interpret-controls-p)) + (erc-tests-common-make-server-buf) + (with-current-buffer (erc--open-target "#chan") + (setq-local erc-interpret-mirc-color t) + (defvar erc-fill-column) + (let ((erc-fill-column 90)) + (erc-display-message nil nil (current-buffer) + (erc-format-privmessage + "bob" (concat "BEGIN " + "\C-c03,08 GreenOnYellow " + "\C-c99 BlackOnYellow " + "\C-o END") + nil t))) + (forward-line -1) + (should (search-forward " " nil t)) + (should (erc-tests-common-equal-with-props + (erc--remove-text-properties + (buffer-substring (point) (line-end-position))) + #("BEGIN GreenOnYellow BlackOnYellow END" + 0 6 (font-lock-face erc-default-face) + 6 21 (font-lock-face (fg:erc-color-face3 + bg:erc-color-face8 + erc-default-face)) + 21 36 (font-lock-face (bg:erc-color-face8 + erc-default-face)) + 36 40 (font-lock-face (erc-default-face))))) + (should (search-forward "BlackOnYellow")) + (let ((faces (get-text-property (point) 'font-lock-face))) + (should (equal (face-background (car faces) nil (cdr faces)) + "yellow"))) + + ;; Redefine background color alongside default foreground. + (let ((erc-fill-column 90)) + (erc-display-message nil nil (current-buffer) + (erc-format-privmessage + "bob" (concat "BEGIN " + "\C-c03,08 GreenOnYellow " + "\C-c99,07 BlackOnOrange " + "\C-o END") + nil t))) + (should (search-forward " " nil t)) + (should (erc-tests-common-equal-with-props + (erc--remove-text-properties + (buffer-substring (point) (line-end-position))) + #("BEGIN GreenOnYellow BlackOnOrange END" + 0 6 (font-lock-face erc-default-face) + 6 21 (font-lock-face (fg:erc-color-face3 + bg:erc-color-face8 + erc-default-face)) + 21 36 (font-lock-face (bg:erc-color-face7 + erc-default-face)) + 36 40 (font-lock-face (erc-default-face))))) + (should (search-forward "BlackOnOrange")) + (let ((faces (get-text-property (point) 'font-lock-face))) + (should (equal (face-background (car faces) nil (cdr faces)) + "orange")))) ; as opposed to white or black + (when noninteractive + (erc-tests-common-kill-buffers))) + +;; This merely asserts our current interpretation of "default faces": +;; that they reflect the foreground and background exhibited by normal +;; chat messages before any control-code formatting is applied (rather +;; than, e.g., some sort of negation or no-op). +(ert-deftest erc-controls-highlight/default-background () + (should (eq t erc-interpret-controls-p)) + (erc-tests-common-make-server-buf) + (with-current-buffer (erc--open-target "#chan") + (setq-local erc-interpret-mirc-color t) + (defvar erc-fill-column) + (let ((erc-fill-column 90)) + (erc-display-message nil nil (current-buffer) + (erc-format-privmessage + "bob" (concat "BEGIN " + "\C-c03,08 GreenOnYellow " + "\C-c05,99 BrownOnWhite " + "\C-o END") + nil t))) + (forward-line -1) + (should (search-forward " " nil t)) + (should (erc-tests-common-equal-with-props + (erc--remove-text-properties + (buffer-substring (point) (line-end-position))) + #("BEGIN GreenOnYellow BrownOnWhite END" + 0 6 (font-lock-face erc-default-face) + 6 21 (font-lock-face (fg:erc-color-face3 + bg:erc-color-face8 + erc-default-face)) + 21 35 (font-lock-face (fg:erc-color-face5 + erc-default-face)) + 35 39 (font-lock-face (erc-default-face))))) + ;; Ensure the background is white or black, rather than yellow. + (should (search-forward "BrownOnWhite")) + (let ((faces (get-text-property (point) 'font-lock-face))) + (should (equal (face-background (car faces) nil `(,@(cdr faces) default)) + (face-background 'default))))) (when noninteractive (erc-tests-common-kill-buffers))) -- cgit v1.2.3 From 525bc083155030b58de08c8716fec9db1496aa9d Mon Sep 17 00:00:00 2001 From: "F. Moukayed" Date: Sun, 17 Mar 2024 16:43:36 +0000 Subject: Remove mishandled erc-control-default-{fg,bg} faces Partially revert those portions of 7b4ca9e609e "Leverage inverse-video for erc-inverse-face" that introduced and managed explicit faces for the "default" 99 color code. * lisp/erc/erc-goodies.el (erc-control-default-fg) (erc-control-default-bg): Remove unused faces originally meant to be new in ERC 5.6. (erc-get-fg-color-face, erc-get-bg-color-face): Return nil for n=99. (erc-controls-interpret, erc-controls-highlight): Preserve an interval's existing background so "if only the foreground color is set, the background color stays the same," as explained by https://modern.ircdocs.horse/formatting#color. (Bug#69860) Copyright-paperwork-exempt: yes --- lisp/erc/erc-goodies.el | 16 ++++------------ 1 file changed, 4 insertions(+), 12 deletions(-) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index da14f5bd728..883f64d3109 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -673,14 +673,6 @@ The value `erc-interpret-controls-p' must also be t for this to work." "ERC underline face." :group 'erc-faces) -(defface erc-control-default-fg '((t :inherit default)) - "ERC foreground face for the \"default\" color code." - :group 'erc-faces) - -(defface erc-control-default-bg '((t :inherit default)) - "ERC background face for the \"default\" color code." - :group 'erc-faces) - ;; FIXME rename these to something like `erc-control-color-N-fg', ;; and deprecate the old names via `define-obsolete-face-alias'. (defface fg:erc-color-face0 '((t :foreground "White")) @@ -812,7 +804,7 @@ The value `erc-interpret-controls-p' must also be t for this to work." (intern (concat "bg:erc-color-face" (number-to-string n)))) ((< 15 n 99) (list :background (aref erc--controls-additional-colors (- n 16)))) - (t (erc-log (format " Wrong color: %s" n)) 'erc-control-default-fg)))) + (t (erc-log (format " Wrong color: %s" n)) nil)))) (defun erc-get-fg-color-face (n) "Fetches the right face for foreground color N (0-15)." @@ -828,7 +820,7 @@ The value `erc-interpret-controls-p' must also be t for this to work." (intern (concat "fg:erc-color-face" (number-to-string n)))) ((< 15 n 99) (list :foreground (aref erc--controls-additional-colors (- n 16)))) - (t (erc-log (format " Wrong color: %s" n)) 'erc-control-default-bg)))) + (t (erc-log (format " Wrong color: %s" n)) nil)))) ;;;###autoload(autoload 'erc-irccontrols-mode "erc-goodies" nil t) (define-erc-module irccontrols nil @@ -883,7 +875,7 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options." (setq s (replace-match "" nil nil s 1)) (cond ((and erc-interpret-mirc-color (or fg-color bg-color)) (setq fg fg-color) - (setq bg bg-color)) + (when bg-color (setq bg bg-color))) ((string= control "\C-b") (setq boldp (not boldp))) ((string= control "\C-]") @@ -944,7 +936,7 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'." (replace-match "" nil nil nil 1) (cond ((and erc-interpret-mirc-color (or fg-color bg-color)) (setq fg fg-color) - (setq bg bg-color)) + (when bg-color (setq bg bg-color))) ((string= control "\C-b") (setq boldp (not boldp))) ((string= control "\C-]") -- cgit v1.2.3 From b9bd78f78d62383f2ff84ceecf8e490193594f17 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 10 Mar 2024 23:09:59 -0700 Subject: Restore leading space to right-margin stamps in ERC * lisp/erc/erc-stamp.el (erc-insert-timestamp-right): Insert a single space character immediately before right-side stamps managed by `erc-stamp--display-margin-mode'. Include it as part of the `timestamp' field. This behavior was originally present in an earlier draft of the changes for bug#60936, mainly to favor symmetry between hard-wrapped fill styles and fill-wrap with regard to stamps. It was subsequently removed to simplify management, so that the `field' and `display' intervals aligned. * test/lisp/erc/erc-stamp-tests.el (erc-stamp--display-margin-mode--right): Update expected output. ; test/lisp/erc/resources/fill/snapshots/merge-01-start.eld: Add space. ; test/lisp/erc/resources/fill/snapshots/merge-02-right.eld: Add space. ; test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld: Add space. ; test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld: ; Add space. ; test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld: ; Add space. ; test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld: Add space. ; test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld: Add space. ; test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld: Add space. ; test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld: Add space. ; test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld: Add space. --- lisp/erc/erc-stamp.el | 1 + test/lisp/erc/erc-stamp-tests.el | 16 ++++++++-------- .../lisp/erc/resources/fill/snapshots/merge-01-start.eld | 2 +- .../lisp/erc/resources/fill/snapshots/merge-02-right.eld | 2 +- test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld | 2 +- .../fill/snapshots/merge-wrap-indicator-post-01.eld | 2 +- .../fill/snapshots/merge-wrap-indicator-pre-01.eld | 2 +- .../erc/resources/fill/snapshots/monospace-01-start.eld | 2 +- .../erc/resources/fill/snapshots/monospace-02-right.eld | 2 +- .../erc/resources/fill/snapshots/monospace-03-left.eld | 2 +- .../erc/resources/fill/snapshots/monospace-04-reset.eld | 2 +- .../erc/resources/fill/snapshots/spacing-01-mono.eld | 2 +- 12 files changed, 19 insertions(+), 18 deletions(-) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 44f92c5a7e2..bcb9b4aafef 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -623,6 +623,7 @@ printed just after each line's text (no alignment)." ((guard erc-stamp--display-margin-mode) (let ((s (propertize (substring-no-properties string) 'invisible erc-stamp--invisible-property))) + (insert " ") (put-text-property 0 (length string) 'display `((margin right-margin) ,s) string))) diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index a49173ffa2f..5fee21ec28f 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -168,11 +168,11 @@ (put-text-property 0 (length msg) 'wrap-prefix 10 msg) (erc-display-message nil nil (current-buffer) msg))) (goto-char (point-min)) - ;; Space not added (treated as opaque string). - (should (search-forward "msg one[" nil t)) - ;; Field covers stamp alone + ;; Leading space added as part of the stamp's field. + (should (search-forward "msg one [" nil t)) + ;; Field covers stamp and space. (should (eql ?e (char-before (field-beginning (point))))) - ;; Vanity props extended + ;; Vanity props extended. (should (get-text-property (field-beginning (point)) 'wrap-prefix)) (should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix)) (should (get-text-property (1- (field-end (point))) 'wrap-prefix)) @@ -183,10 +183,10 @@ (erc-timestamp-right-column 20)) (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t))) (erc-display-message nil nil (current-buffer) msg))) - ;; No hard wrap - (should (search-forward "oooo[" nil t)) - ;; Field starts at format string (right bracket) - (should (eql ?\[ (char-after (field-beginning (point))))) + ;; No hard wrap. + (should (search-forward "oooo [" nil t)) + ;; Field starts at managed space before format string. + (should (eql ?\s (char-after (field-beginning (point))))) (should (eql ?\n (char-after (field-end (point))))))))) ;; This concerns a proposed partial reversal of the changes resulting diff --git a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld index 3c32719a052..6ff7af218c0 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero.[07:00]\n one.\n two.\n three.\n four.\n five.\n six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n one.\n two.\n three.\n four.\n five.\n six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #5#) 460 467 (wrap-prefix #1# line-prefix #5#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #5#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 (8)))) 477 482 (wrap-prefix #1# line-prefix #7#) 482 488 (wrap-prefix #1# line-prefix #7#) 489 490 (erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 490 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 497 (wrap-prefix #1# line-prefix #8# display #9#) 497 501 (wrap-prefix #1# line-prefix #8#) 502 503 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 503 506 (wrap-prefix #1# line-prefix #10#) 506 514 (wrap-prefix #1# line-prefix #10#) 515 516 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 516 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 521 (wrap-prefix #1# line-prefix #11# display #9#) 521 526 (wrap-prefix #1# line-prefix #11#) 527 528 (erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 528 533 (wrap-prefix #1# line-prefix #12#) 533 540 (wrap-prefix #1# line-prefix #12#) 541 542 (erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 542 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 549 (wrap-prefix #1# line-prefix #13# display #9#) 549 553 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld index e2064b914c4..7d9822c80bc 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero.[07:00]\n one.\n two.\n three.\n four.\n five.\n six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18))) field erc-timestamp) 21 22 (wrap-prefix #1# line-prefix #2=(space :width (- 29 (4))) erc--msg notice erc--ts 0) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (wrap-prefix #1# line-prefix #2# field erc-timestamp display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (wrap-prefix #1# line-prefix #3=(space :width (- 29 (8))) erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix (space :width (- 29 (8)))) 349 350 (wrap-prefix #1# line-prefix #4=(space :width (- 29 (6))) erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (wrap-prefix #1# line-prefix (space :width (- 29 (18))) field erc-timestamp) 455 456 (wrap-prefix #1# line-prefix #5=(space :width (- 29 (6))) erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (wrap-prefix #1# line-prefix #5# field erc-timestamp display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (wrap-prefix #1# line-prefix #7=(space :width (- 29 (8))) erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (wrap-prefix #1# line-prefix #10=(space :width (- 29 (6))) erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (wrap-prefix #1# line-prefix #12=(space :width (- 29 (8))) erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n one.\n two.\n three.\n four.\n five.\n six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18))) field erc-timestamp) 21 22 (wrap-prefix #1# line-prefix #2=(space :width (- 29 (4))) erc--msg notice erc--ts 0) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (wrap-prefix #1# line-prefix #2# field erc-timestamp) 184 191 (wrap-prefix #1# line-prefix #2# field erc-timestamp display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (wrap-prefix #1# line-prefix #3=(space :width (- 29 (8))) erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix (space :width (- 29 (8)))) 350 351 (wrap-prefix #1# line-prefix #4=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (wrap-prefix #1# line-prefix (space :width (- 29 (18))) field erc-timestamp) 456 457 (wrap-prefix #1# line-prefix #5=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG) 457 460 (wrap-prefix #1# line-prefix #5#) 460 467 (wrap-prefix #1# line-prefix #5#) 467 468 (wrap-prefix #1# line-prefix #5# field erc-timestamp) 468 475 (wrap-prefix #1# line-prefix #5# field erc-timestamp display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (wrap-prefix #1# line-prefix #7=(space :width (- 29 (8))) erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG) 477 482 (wrap-prefix #1# line-prefix #7#) 482 488 (wrap-prefix #1# line-prefix #7#) 489 490 (wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG display #9="") 490 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 497 (wrap-prefix #1# line-prefix #8# display #9#) 497 501 (wrap-prefix #1# line-prefix #8#) 502 503 (wrap-prefix #1# line-prefix #10=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG) 503 506 (wrap-prefix #1# line-prefix #10#) 506 514 (wrap-prefix #1# line-prefix #10#) 515 516 (wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG display #9#) 516 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 521 (wrap-prefix #1# line-prefix #11# display #9#) 521 526 (wrap-prefix #1# line-prefix #11#) 527 528 (wrap-prefix #1# line-prefix #12=(space :width (- 29 (8))) erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG) 528 533 (wrap-prefix #1# line-prefix #12#) 533 540 (wrap-prefix #1# line-prefix #12#) 541 542 (wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG display #9#) 542 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 549 (wrap-prefix #1# line-prefix #13# display #9#) 549 553 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld index feaba85ec90..2d0e5a5965f 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero.[07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #10#) 499 505 (wrap-prefix #1# line-prefix #10#) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 507 510 (wrap-prefix #1# line-prefix #11# display #8#) 510 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 515 (wrap-prefix #1# line-prefix #11#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #12#) 518 521 (wrap-prefix #1# line-prefix #12#) 521 527 (wrap-prefix #1# line-prefix #12#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #13#) 532 539 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 477 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 482 (wrap-prefix #1# line-prefix #7# display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #10#) 501 507 (wrap-prefix #1# line-prefix #10#) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 509 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 514 (wrap-prefix #1# line-prefix #11# display #8#) 514 517 (wrap-prefix #1# line-prefix #11#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #12#) 520 523 (wrap-prefix #1# line-prefix #12#) 523 529 (wrap-prefix #1# line-prefix #12#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #13#) 534 541 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld index ed1488c8595..e019e60bb26 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero.[07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #10#) 499 505 (wrap-prefix #1# line-prefix #10#) 505 506 (display #("~\n" 0 2 (font-lock-face shadow))) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 507 510 (wrap-prefix #1# line-prefix #11# display #8#) 510 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 515 (wrap-prefix #1# line-prefix #11#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #12#) 518 521 (wrap-prefix #1# line-prefix #12#) 521 527 (wrap-prefix #1# line-prefix #12#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #13#) 532 539 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 477 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 482 (wrap-prefix #1# line-prefix #7# display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #10#) 501 507 (wrap-prefix #1# line-prefix #10#) 507 508 (display #("~\n" 0 2 (font-lock-face shadow))) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 509 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 514 (wrap-prefix #1# line-prefix #11# display #8#) 514 517 (wrap-prefix #1# line-prefix #11#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #12#) 520 523 (wrap-prefix #1# line-prefix #12#) 523 529 (wrap-prefix #1# line-prefix #12#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #13#) 534 541 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld index a3530a6c44d..615de982b1e 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero.[07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 #10=(2))) display #8=#("> " 0 1 (font-lock-face shadow))) 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #11#) 499 505 (wrap-prefix #1# line-prefix #11#) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 #10#)) display #8#) 507 510 (wrap-prefix #1# line-prefix #12# display #8#) 510 512 (wrap-prefix #1# line-prefix #12# display #8#) 512 515 (wrap-prefix #1# line-prefix #12#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #13=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #13#) 518 521 (wrap-prefix #1# line-prefix #13#) 521 527 (wrap-prefix #1# line-prefix #13#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #14=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #14#) 532 539 (wrap-prefix #1# line-prefix #14#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 #10=(2))) display #8=#("> " 0 1 (font-lock-face shadow))) 477 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 482 (wrap-prefix #1# line-prefix #7# display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #11#) 501 507 (wrap-prefix #1# line-prefix #11#) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 #10#)) display #8#) 509 512 (wrap-prefix #1# line-prefix #12# display #8#) 512 514 (wrap-prefix #1# line-prefix #12# display #8#) 514 517 (wrap-prefix #1# line-prefix #12#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #13=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #13#) 520 523 (wrap-prefix #1# line-prefix #13#) 523 529 (wrap-prefix #1# line-prefix #13#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #14=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #14#) 534 541 (wrap-prefix #1# line-prefix #14#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld index c94629cf357..0228e716731 100644 --- a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld +++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld index 127c0b29bc9..9ab89041b53 100644 --- a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld +++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 29 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 29 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 29 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 29 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld index a9f3f1d1904..87ea4692d9d 100644 --- a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld +++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 25 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 25 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 25 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 25 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld index c94629cf357..0228e716731 100644 --- a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld +++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld index 754d7989cea..ae364accdea 100644 --- a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld +++ b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n This buffer is for text.\n*** one two three\n*** four five six\n Somebody stop me\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 190 191 (line-spacing 0.5) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 348 349 (line-spacing 0.5) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 435 436 (line-spacing 0.5) 436 437 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 437 440 (wrap-prefix #1# line-prefix #5# display #6#) 440 442 (wrap-prefix #1# line-prefix #5# display #6#) 442 466 (wrap-prefix #1# line-prefix #5#) 466 467 (line-spacing 0.5) 467 468 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 468 484 (wrap-prefix #1# line-prefix #7#) 485 486 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 486 502 (wrap-prefix #1# line-prefix #8#) 502 503 (line-spacing 0.5) 503 504 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 504 507 (wrap-prefix #1# line-prefix #9#) 507 525 (wrap-prefix #1# line-prefix #9#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n This buffer is for text.\n*** one two three\n*** four five six\n Somebody stop me\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (line-spacing 0.5) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 349 350 (line-spacing 0.5) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 436 437 (line-spacing 0.5) 437 438 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 438 441 (wrap-prefix #1# line-prefix #5# display #6#) 441 443 (wrap-prefix #1# line-prefix #5# display #6#) 443 467 (wrap-prefix #1# line-prefix #5#) 467 468 (line-spacing 0.5) 468 469 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 469 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 487 503 (wrap-prefix #1# line-prefix #8#) 503 504 (line-spacing 0.5) 504 505 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 505 508 (wrap-prefix #1# line-prefix #9#) 508 526 (wrap-prefix #1# line-prefix #9#)) \ No newline at end of file -- cgit v1.2.3 From a46789b56af05e4cd31ab90495c9f2a4492a9b19 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 10 Mar 2024 23:09:59 -0700 Subject: Reuse command-indicator code for script lines in ERC * lisp/erc/erc-goodies.el (erc-load-irc-script-lines): Move here from main file and rework to always use `command-indicator' instead of only partially, when available. Also use internal "send-action" and "send-message" interfaces to defer command-handler output until command lines have been inserted. * lisp/erc/erc.el (erc-process-input-line): Redo doc string. (erc-process-script-line): Fold exceptionally overlong line. (erc-load-irc-script-lines): Move to erc-goodies.el. (Bug#67032) --- lisp/erc/erc-goodies.el | 42 +++++++++++++++++++++++++++++++++++ lisp/erc/erc.el | 58 +++++++++++++------------------------------------ 2 files changed, 57 insertions(+), 43 deletions(-) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 883f64d3109..fe44c3bdfcb 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -625,6 +625,48 @@ Do nothing if the variable `erc-command-indicator' is nil." erc--msg-props)))) (erc--refresh-prompt)))) +;;;###autoload +(defun erc-load-irc-script-lines (lines &optional force noexpand) + "Process a list of LINES as prompt input submissions. +If optional NOEXPAND is non-nil, do not expand script-specific +substitution sequences via `erc-process-script-line' and instead +process LINES as literal prompt input. With FORCE, bypass flood +protection." + ;; The various erc-cmd-CMDs were designed to return non-nil when + ;; their command line should be echoed. But at some point, these + ;; handlers began displaying their own output, which naturally + ;; appeared *above* the echoed command. This tries to intercept + ;; these insertions, deferring them until the command has returned + ;; and its command line has been printed. + (cl-assert (eq 'erc-mode major-mode)) + (let ((args (and erc-script-args + (if (string-match "^ " erc-script-args) + (substring erc-script-args 1) + erc-script-args)))) + (with-silent-modifications + (dolist (line lines) + (erc-log (concat "erc-load-script: CMD: " line)) + (unless (string-match (rx bot (* (syntax whitespace)) eot) line) + (unless noexpand + (setq line (erc-process-script-line line args))) + (let ((erc--current-line-input-split (erc--make-input-split line)) + calls insertp) + (add-function :around (local 'erc--send-message-nested-function) + (lambda (&rest args) (push args calls)) + '((name . erc-script-lines-fn) (depth . -80))) + (add-function :around (local 'erc--send-action-function) + (lambda (&rest args) (push args calls)) + '((name . erc-script-lines-fn) (depth . -80))) + (setq insertp + (unwind-protect (erc-process-input-line line force) + (remove-function (local 'erc--send-action-function) + 'erc-script-lines-fn) + (remove-function (local 'erc--send-message-nested-function) + 'erc-script-lines-fn))) + (when (and insertp erc-script-echo) + (erc--command-indicator-display line) + (dolist (call calls) + (apply (car call) (cdr call)))))))))) ;;; IRC control character processing. (defgroup erc-control-characters nil diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 3cc9bd54228..0750463a4e7 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4004,17 +4004,19 @@ erc-cmd-FOO, this returns a string /FOO." command-name))) (defun erc-process-input-line (line &optional force no-command) - "Translate LINE to an RFC1459 command and send it based. -Returns non-nil if the command is actually sent to the server, and nil -otherwise. - -If the command in the LINE is not bound as a function `erc-cmd-', -it is passed to `erc-cmd-default'. If LINE is not a command (i.e. doesn't -start with /) then it is sent as a message. - -An optional FORCE argument forces sending the line when flood -protection is in effect. The optional NO-COMMAND argument prohibits -this function from interpreting the line as a command." + "Dispatch a slash-command or chat-input handler from user-input LINE. +If simplistic validation fails, print an error and return nil. +Otherwise, defer to an appropriate handler. For \"slash\" commands, +like \"/JOIN\", expect a handler, like `erc-cmd-JOIN', to return non-nil +if LINE is fit for echoing as a command line when executing scripts. +For normal chat input, expect a handler to return non-nil if a message +was successfully processed as an outgoing \"PRIVMSG\". If LINE is a +slash command, and ERC can't find a corresponding handler of the form +`erc-cmd-', pass LINE to `erc-cmd-default', treating it as a +catch-all handler. Otherwise, for normal chat input, pass LINE and the +boolean argument FORCE to `erc-send-input-line-function'. With a +non-nil NO-COMMAND, always treat LINE as normal chat input rather than a +slash command." (let ((command-list (erc-extract-command-from-line line))) (if (and command-list (not no-command)) @@ -8512,7 +8514,8 @@ and so on." ((string-match "^%[Ss]$" esc) server) ((string-match "^%[Nn]$" esc) nick) ((string-match "^%\\(.\\)$" esc) (match-string 1 esc)) - (t (erc-log (format "BUG in erc-process-script-line: bad escape sequence: %S\n" esc)) + (t (erc-log (format "Bad escape sequence in %s: %S\n" + 'erc-process-script-line esc)) (message "BUG IN ERC: esc=%S" esc) ""))) (setq line tail) @@ -8531,37 +8534,6 @@ and so on." (buffer-string)))) (erc-load-irc-script-lines (erc-split-multiline-safe str) force))) -(defun erc-load-irc-script-lines (lines &optional force noexpand) - "Load IRC script LINES (a list of strings). - -If optional NOEXPAND is non-nil, do not expand script-specific -sequences, process the lines verbatim. Use this for multiline -user input." - (let* ((cb (current-buffer)) - (s "") - (sp (or (and (bound-and-true-p erc-command-indicator-mode) - (fboundp 'erc-command-indicator) - (erc-command-indicator)) - (erc-prompt))) - (args (and (boundp 'erc-script-args) erc-script-args))) - (if (and args (string-match "^ " args)) - (setq args (substring args 1))) - ;; prepare the prompt string for echo - (erc-put-text-property 0 (length sp) - 'font-lock-face 'erc-command-indicator-face sp) - (while lines - (setq s (car lines)) - (erc-log (concat "erc-load-script: CMD: " s)) - (unless (string-match "^\\s-*$" s) - (let ((line (if noexpand s (erc-process-script-line s args)))) - (if (and (erc-process-input-line line force) - erc-script-echo) - (progn - (erc-put-text-property 0 (length line) - 'font-lock-face 'erc-input-face line) - (erc-display-line (concat sp line) cb))))) - (setq lines (cdr lines))))) - ;; authentication (defun erc--unfun (maybe-fn) -- cgit v1.2.3 From ef859d8b1b285fd22b083955a0e878a74d72ff41 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 23 Mar 2024 19:21:26 -0400 Subject: edebug.el: Better strip instrumentation from backtraces Rework the code that "cleans" the backtrace for `edebug-pop-to-backtrace`. The main changes are the following: - Strip instrumentation from "everywhere" rather than trying to limit the effect to "code" and leave "data" untouched. This is a worthy goal, but it is quite difficult to do since code contains data (so we ended up touching data anyway) and data can also contain code. The risk of accidentally removing something because it happens to look like instrumentation is very low, whereas it was very common for instrumentation to remain in the backtrace. - Use a global hash-table to remember the work done, instead of using separate hash-table for each element. By using a weak hash-table we avoid the risk of leaks, and save a lot of work since there's often a lot of subexpressions that appear several times in the backtrace. * lisp/emacs-lisp/edebug.el (edebug-make-enter-wrapper): Tweak code layout so the comments are more clear. (edebug-unwrap): Remove redundant patterns for `closure` and `lambda`. Add `:closure-dont-trim-context` to the `edebug-enter` pattern, so it also gets removed (this should have been done in commit 750bc57cbb8d). (edebug--unwrap-cache): New var. (edebug-unwrap*): Use it. (edebug--unwrap1): Delete function. Merged into `edebug-unwrap*`. Also apply unwrapping to the contents of byte-code functions since they can refer to lambda expressions captured by the closure. (edebug--symbol-prefixed-p): Rename from `edebug--symbol-not-prefixed-p` and adjust meaning accordingly. (edebug--strip-instrumentation): Adjust accordingly and simplify a bit by unifying the "lambda" case and the "everything else" case. (edebug--unwrap-frame): Use `cl-callf` and unwrap arguments even if they've already been evaluated. --- lisp/emacs-lisp/edebug.el | 143 +++++++++++++++++++++++----------------------- 1 file changed, 73 insertions(+), 70 deletions(-) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 1d3db4a588d..b27ffbca908 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1229,10 +1229,12 @@ purpose by adding an entry to this alist, and setting ;; But the list will just be reversed. ,@(nreverse edebug-def-args)) 'nil) - ;; Make sure `forms' is not nil so we don't accidentally return - ;; the magic keyword. Mark the closure so we don't throw away - ;; unused vars (bug#59213). - #'(lambda () :closure-dont-trim-context ,@(or forms '(nil))))) + #'(lambda () + ;; Mark the closure so we don't throw away unused vars (bug#59213). + :closure-dont-trim-context + ;; Make sure `forms' is not nil so we don't accidentally return + ;; the magic keyword. + ,@(or forms '(nil))))) (defvar edebug-form-begin-marker) ; the mark for def being instrumented @@ -1270,55 +1272,48 @@ Does not unwrap inside vectors, records, structures, or hash tables." (pcase sexp (`(edebug-after ,_before-form ,_after-index ,form) form) - (`(lambda ,args (edebug-enter ',_sym ,_arglist - (function (lambda nil . ,body)))) - `(lambda ,args ,@body)) - (`(closure ,env ,args (edebug-enter ',_sym ,_arglist - (function (lambda nil . ,body)))) - `(closure ,env ,args ,@body)) - (`(edebug-enter ',_sym ,_args (function (lambda nil . ,body))) + (`(edebug-enter ',_sym ,_args + #'(lambda nil :closure-dont-trim-context . ,body)) (macroexp-progn body)) (_ sexp))) +(defconst edebug--unwrap-cache + (make-hash-table :test 'eq :weakness 'key) + "Hash-table containing the results of unwrapping cons cells. +These results are reused to avoid redundant work but also to avoid +infinite loops when the code/environment contains a circular object.") + (defun edebug-unwrap* (sexp) "Return the SEXP recursively unwrapped." - (let ((ht (make-hash-table :test 'eq))) - (edebug--unwrap1 sexp ht))) - -(defun edebug--unwrap1 (sexp hash-table) - "Unwrap SEXP using HASH-TABLE of things already unwrapped. -HASH-TABLE contains the results of unwrapping cons cells within -SEXP, which are reused to avoid infinite loops when SEXP is or -contains a circular object." - (let ((new-sexp (edebug-unwrap sexp))) - (while (not (eq sexp new-sexp)) - (setq sexp new-sexp - new-sexp (edebug-unwrap sexp))) - (if (consp new-sexp) - (let ((result (gethash new-sexp hash-table nil))) - (unless result - (let ((remainder new-sexp) - current) - (setq result (cons nil nil) - current result) - (while - (progn - (puthash remainder current hash-table) - (setf (car current) - (edebug--unwrap1 (car remainder) hash-table)) - (setq remainder (cdr remainder)) - (cond - ((atom remainder) - (setf (cdr current) - (edebug--unwrap1 remainder hash-table)) - nil) - ((gethash remainder hash-table nil) - (setf (cdr current) (gethash remainder hash-table nil)) - nil) - (t (setq current - (setf (cdr current) (cons nil nil))))))))) - result) - new-sexp))) + (while (not (eq sexp (setq sexp (edebug-unwrap sexp))))) + (cond + ((consp sexp) + (or (gethash sexp edebug--unwrap-cache nil) + (let ((remainder sexp) + (current (cons nil nil))) + (prog1 current + (while + (progn + (puthash remainder current edebug--unwrap-cache) + (setf (car current) + (edebug-unwrap* (car remainder))) + (setq remainder (cdr remainder)) + (cond + ((atom remainder) + (setf (cdr current) + (edebug-unwrap* remainder)) + nil) + ((gethash remainder edebug--unwrap-cache nil) + (setf (cdr current) (gethash remainder edebug--unwrap-cache nil)) + nil) + (t (setq current + (setf (cdr current) (cons nil nil))))))))))) + ((byte-code-function-p sexp) + (apply #'make-byte-code + (aref sexp 0) (aref sexp 1) + (vconcat (mapcar #'edebug-unwrap* (aref sexp 2))) + (nthcdr 3 (append sexp ())))) + (t sexp))) (defun edebug-defining-form (cursor form-begin form-end speclist) @@ -4239,13 +4234,13 @@ Remove frames for Edebug's functions and the lambdas in and after-index fields in both FRAMES and the returned list of deinstrumented frames, for those frames where the source code location is known." - (let (skip-next-lambda def-name before-index after-index results - (index (length frames))) + (let ((index (length frames)) + skip-next-lambda def-name before-index after-index results) (dolist (frame (reverse frames)) (let ((new-frame (copy-edebug--frame frame)) (fun (edebug--frame-fun frame)) (args (edebug--frame-args frame))) - (cl-decf index) + (cl-decf index) ;; FIXME: Not used? (pcase fun ('edebug-enter (setq skip-next-lambda t @@ -4255,38 +4250,46 @@ code location is known." (nth 1 (nth 0 args)) (nth 0 args)) after-index (nth 1 args))) - ((pred edebug--symbol-not-prefixed-p) - (edebug--unwrap-frame new-frame) - (edebug--add-source-info new-frame def-name before-index after-index) - (edebug--add-source-info frame def-name before-index after-index) - (push new-frame results) - (setq before-index nil - after-index nil)) - (`(,(or 'lambda 'closure) . ,_) + ;; Just skip all our own frames. + ((pred edebug--symbol-prefixed-p) nil) + (_ + (when (and skip-next-lambda + (not (memq (car-safe fun) '(closure lambda)))) + (warn "Edebug--strip-instrumentation expected an interpreted function:\n%S" fun)) (unless skip-next-lambda (edebug--unwrap-frame new-frame) - (edebug--add-source-info frame def-name before-index after-index) (edebug--add-source-info new-frame def-name before-index after-index) + (edebug--add-source-info frame def-name before-index after-index) (push new-frame results)) - (setq before-index nil + (setq before-index nil after-index nil skip-next-lambda nil))))) results)) -(defun edebug--symbol-not-prefixed-p (sym) - "Return non-nil if SYM is a symbol not prefixed by \"edebug-\"." +(defun edebug--symbol-prefixed-p (sym) + "Return non-nil if SYM is a symbol prefixed by \"edebug-\"." (and (symbolp sym) - (not (string-prefix-p "edebug-" (symbol-name sym))))) + (string-prefix-p "edebug-" (symbol-name sym)))) (defun edebug--unwrap-frame (frame) "Remove Edebug's instrumentation from FRAME. Strip it from the function and any unevaluated arguments." - (setf (edebug--frame-fun frame) (edebug-unwrap* (edebug--frame-fun frame))) - (unless (edebug--frame-evald frame) - (let (results) - (dolist (arg (edebug--frame-args frame)) - (push (edebug-unwrap* arg) results)) - (setf (edebug--frame-args frame) (nreverse results))))) + (cl-callf edebug-unwrap* (edebug--frame-fun frame)) + ;; We used to try to be careful to apply `edebug-unwrap' only to source + ;; expressions and not to values, so we did not apply unwrap to the arguments + ;; of the frame if they had already been evaluated. + ;; But this was not careful enough since `edebug-unwrap*' gleefully traverses + ;; its argument without paying attention to its syntactic structure so it + ;; also "mistakenly" descends into the values contained within the "source + ;; code". In practice this *very* rarely leads to undesired results. + ;; On the contrary, it's often useful to descend into values because they + ;; may contain interpreted closures and hence source code where we *do* + ;; want to apply `edebug-unwrap'. + ;; So based on this experience, we now also apply `edebug-unwrap*' to + ;; the already evaluated arguments. + ;;(unless (edebug--frame-evald frame) + (cl-callf (lambda (xs) (mapcar #'edebug-unwrap* xs)) + (edebug--frame-args frame))) (defun edebug--add-source-info (frame def-name before-index after-index) "Update FRAME with the additional info needed by an edebug--frame. -- cgit v1.2.3 From 044558766a77b1c9b8a7e6d757ca65730a88b88d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 23 Mar 2024 22:27:34 -0400 Subject: * doc/emacs/help.texi (Name Help): Mention buttons (bug#69935) --- doc/emacs/help.texi | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 05457a3f34f..d60310456ff 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -310,6 +310,13 @@ name is defined as a Lisp function. Type @kbd{C-g} to cancel the @kbd{C-h f} command if you don't really want to view the documentation. + The function's documentation displayed by @code{describe-function} +includes more than just the documentation string and the signature of +the function. It also shows auxiliary information such as its type, the +file where it was defined, whether it has been declared obsolete, and +yet further information is often reachable by clicking or typing +@key{RET} on emphasized parts of the text. + @vindex help-enable-symbol-autoload If you request help for an autoloaded function whose @code{autoload} form (@pxref{Autoload,,, elisp, The Emacs Lisp Reference Manual}) -- cgit v1.2.3 From a496378c94176930583e63ef5c95477f092a872b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 23 Mar 2024 22:48:17 -0400 Subject: cl-preloaded.el: Improve docstrings of "kinds" * lisp/emacs-lisp/cl-preloaded.el (cl--class): Improve the docstring. (built-in-class): Add a docstring. --- lisp/emacs-lisp/cl-preloaded.el | 4 +++- lisp/emacs-lisp/cl-print.el | 2 +- lisp/emacs-lisp/nadvice.el | 2 +- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index f7757eae9c0..8428ec4beb7 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -260,7 +260,7 @@ (cl-defstruct (cl--class (:constructor nil) (:copier nil)) - "Type of descriptors for any kind of structure-like data." + "Abstract supertype of all type descriptors." ;; Intended to be shared between defstruct and defclass. (name nil :type symbol) ;The type name. (docstring nil :type string) @@ -306,6 +306,8 @@ (:constructor nil) (:constructor built-in-class--make (name docstring parents)) (:copier nil)) + "Type descriptors for built-in types. +The `slots' (and hence `index-table') are currently unused." ) (defmacro cl--define-built-in-type (name parents &optional docstring &rest slots) diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index c35353ec3d0..5e5eee1da9e 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -444,7 +444,7 @@ primitives such as `prin1'.") (defun cl-print--preprocess (object) (let ((print-number-table (make-hash-table :test 'eq :rehash-size 2.0))) - (if (fboundp 'print--preprocess) + (if (fboundp 'print--preprocess) ;Emacs≥26 ;; Use the predefined C version if available. (print--preprocess object) ;Fill print-number-table! (let ((cl-print--number-index 0)) diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 7524ab18e58..5326c520601 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -189,7 +189,7 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.") if (cl-assert (eq 'interactive (car if))) (let ((form (cadr if))) - (if (macroexp-const-p form) + (if (macroexp-const-p form) ;Common case: a string. if ;; The interactive is expected to be run in the static context ;; that the function captured. -- cgit v1.2.3 From 2be41da38ef5432b6038058fcb0c284164fcb370 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 24 Mar 2024 10:59:54 +0800 Subject: Improve consistency of content file name handling * java/org/gnu/emacs/EmacsService.java (getDisplayNameHash): Always encode file names as modified UTF-8, as insurance against future changes to undocumented behavior of the JVM. --- java/org/gnu/emacs/EmacsService.java | 48 +++++++++++++++++++++++++++++------- 1 file changed, 39 insertions(+), 9 deletions(-) diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 785163c713c..07bfb525be9 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -19,6 +19,7 @@ along with GNU Emacs. If not, see . */ package org.gnu.emacs; +import java.io.ByteArrayOutputStream; import java.io.FileNotFoundException; import java.io.IOException; import java.io.UnsupportedEncodingException; @@ -1041,17 +1042,46 @@ public final class EmacsService extends Service getDisplayNameHash (String string) { byte[] encoded; - - try + ByteArrayOutputStream stream; + int i, ch; + + /* Much of the VFS code expects file names to be encoded as modified + UTF-8 data, but Android's JNI implementation produces (while not + accepting!) regular UTF-8 sequences for all characters, even + non-Emoji ones. With no documentation to this effect, save for + two comments nestled in the source code of the Java virtual + machine, it is not sound to assume that this behavior will not be + revised in future or modified releases of Android, and as such, + encode STRING into modified UTF-8 by hand, to protect against + future changes in this respect. */ + + stream = new ByteArrayOutputStream (); + + for (i = 0; i < string.length (); ++i) { - encoded = string.getBytes ("UTF-8"); - return EmacsNative.displayNameHash (encoded); - } - catch (UnsupportedEncodingException exception) - { - /* This should be impossible. */ - return "error"; + ch = string.charAt (i); + + if (ch != 0 && ch <= 127) + stream.write (ch); + else if (ch <= 2047) + { + stream.write (0xc0 | (0x1f & (ch >> 6))); + stream.write (0x80 | (0x3f & ch)); + } + else + { + stream.write (0xe0 | (0x0f & (ch >> 12))); + stream.write (0x80 | (0x3f & (ch >> 6))); + stream.write (0x80 | (0x3f & ch)); + } } + + encoded = stream.toByteArray (); + + /* Closing a ByteArrayOutputStream has no effect. + encoded.close (); */ + + return EmacsNative.displayNameHash (encoded); } /* Build a content file name for URI. -- cgit v1.2.3 From 7206a620af2de7281d9c9299582241a10e79e1a3 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 24 Mar 2024 11:02:34 +0800 Subject: Don't define user-ptr type when user-ptrp is not present * lisp/emacs-lisp/cl-preloaded.el (user-ptr): Condition on presence of predicate function. --- lisp/emacs-lisp/cl-preloaded.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 8428ec4beb7..f27933ed054 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -356,8 +356,10 @@ The `slots' (and hence `index-table') are currently unused." (cl--define-built-in-type tree-sitter-compiled-query atom) (cl--define-built-in-type tree-sitter-node atom) (cl--define-built-in-type tree-sitter-parser atom) -(cl--define-built-in-type user-ptr atom - nil :predicate user-ptrp) ;; FIXME: Shouldn't it be called `user-ptr-p'? +(declare-function user-ptrp "data.c") +(unless (fboundp 'user-ptrp) + (cl--define-built-in-type user-ptr atom nil + :predicate user-ptrp)) ;; FIXME: Shouldn't it be called `user-ptr-p'? (cl--define-built-in-type font-object atom) (cl--define-built-in-type font-entity atom) (cl--define-built-in-type font-spec atom) -- cgit v1.2.3 From 30b1b0d7cd8e4d46a601e9737350cda970f6bab0 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 24 Mar 2024 11:05:31 +0800 Subject: ; * lisp/emacs-lisp/cl-preloaded.el (user-ptr): Fix typo. Author: --- lisp/emacs-lisp/cl-preloaded.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index f27933ed054..35a8d79a1cd 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -357,9 +357,11 @@ The `slots' (and hence `index-table') are currently unused." (cl--define-built-in-type tree-sitter-node atom) (cl--define-built-in-type tree-sitter-parser atom) (declare-function user-ptrp "data.c") -(unless (fboundp 'user-ptrp) +(when (fboundp 'user-ptrp) (cl--define-built-in-type user-ptr atom nil - :predicate user-ptrp)) ;; FIXME: Shouldn't it be called `user-ptr-p'? + ;; FIXME: Shouldn't it be called + ;; `user-ptr-p'? + :predicate user-ptrp)) (cl--define-built-in-type font-object atom) (cl--define-built-in-type font-entity atom) (cl--define-built-in-type font-spec atom) -- cgit v1.2.3 From c5de73a95a6ecefe46fe1ac07da8e83032be7f5b Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 24 Mar 2024 11:29:37 +0100 Subject: Fix native compilation for circular immediates (bug#67883) * test/src/comp-resources/comp-test-funcs.el (comp-test-67883-1-f): New function. * lisp/emacs-lisp/comp.el (comp--collect-rhs) (comp--ssa-rename-insn): Handle setimm aside to avoid unnecessary immediate manipulation. (comp--copy-insn-rec): Rename. (comp--copy-insn): New function. (comp--dead-assignments-func): Handle setimm aside to avoid unnecessary. --- lisp/emacs-lisp/comp.el | 18 +++++++++++++++--- test/src/comp-resources/comp-test-funcs.el | 3 +++ 2 files changed, 18 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 1df1e3b3ddb..4ddf90349d1 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1788,7 +1788,9 @@ into the C code forwarding the compilation unit." for insn in (comp-block-insns b) for (op . args) = insn if (comp--assign-op-p op) - do (comp--collect-mvars (cdr args)) + do (comp--collect-mvars (if (eq op 'setimm) + (cl-first args) + (cdr args))) else do (comp--collect-mvars args)))) @@ -2442,6 +2444,8 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." (setf (comp-vec-aref frame slot-n) mvar (cadr insn) mvar)))) (pcase insn + (`(setimm ,(pred targetp) ,_imm) + (new-lvalue)) (`(,(pred comp--assign-op-p) ,(pred targetp) . ,_) (let ((mvar (comp-vec-aref frame slot-n))) (setf (cddr insn) (cl-nsubst-if mvar #'targetp (cddr insn)))) @@ -2545,7 +2549,7 @@ Return t when one or more block was removed, nil otherwise." ;; native compiling all Emacs code-base. "Max number of scanned insn before giving-up.") -(defun comp--copy-insn (insn) +(defun comp--copy-insn-rec (insn) "Deep copy INSN." ;; Adapted from `copy-tree'. (if (consp insn) @@ -2562,6 +2566,13 @@ Return t when one or more block was removed, nil otherwise." (copy-comp-mvar insn) insn))) +(defun comp--copy-insn (insn) + "Deep copy INSN." + (pcase insn + (`(setimm ,mvar ,imm) + `(setimm ,(copy-comp-mvar mvar) ,imm)) + (_ (comp--copy-insn-rec insn)))) + (defmacro comp--apply-in-env (func &rest args) "Apply FUNC to ARGS in the current compilation environment." `(let ((env (cl-loop @@ -2903,7 +2914,8 @@ Return the list of m-var ids nuked." for (op arg0 . rest) = insn if (comp--assign-op-p op) do (push (comp-mvar-id arg0) l-vals) - (setf r-vals (nconc (comp--collect-mvar-ids rest) r-vals)) + (unless (eq op 'setimm) + (setf r-vals (nconc (comp--collect-mvar-ids rest) r-vals))) else do (setf r-vals (nconc (comp--collect-mvar-ids insn) r-vals)))) ;; Every l-value appearing that does not appear as r-value has no right to diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el index dc4abf50767..54f339f6373 100644 --- a/test/src/comp-resources/comp-test-funcs.el +++ b/test/src/comp-resources/comp-test-funcs.el @@ -559,6 +559,9 @@ (let ((time (make-comp-test-time :unix (time-convert (current-time) 'integer)))) (comp-test-67239-0-f "%F" time))) +(defun comp-test-67883-1-f () + '#1=(1 . #1#)) + ;;;;;;;;;;;;;;;;;;;; ;; Tromey's tests ;; -- cgit v1.2.3 From 8d8253f89915f1d9b45791d46cf974c6bdcc1457 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 24 Mar 2024 08:19:29 -0400 Subject: * etc/NEWS: Update for Emacs 29.3 --- etc/NEWS | 34 +++++++++++++++------------------- 1 file changed, 15 insertions(+), 19 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 06086e9bdfb..3f94b0d4634 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -15,32 +15,28 @@ in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' with a prefix argument or by typing 'C-u C-h C-n'. - -* Installation Changes in Emacs 29.3 - - -* Startup Changes in Emacs 29.3 - * Changes in Emacs 29.3 +Emacs 29.3 is an emergency bugfix release intended to fix several +security vulnerabilities described below. - -* Editing Changes in Emacs 29.3 +** Arbitrary Lisp code is no longer evaluated as part of turning on Org mode. +This is for security reasons, to avoid evaluating malicious Lisp code. - -* Changes in Specialized Modes and Packages in Emacs 29.3 +** New buffer-local variable 'untrusted-content'. +When this is non-nil, Lisp programs should treat buffer contents with +extra caution. - -* New Modes and Packages in Emacs 29.3 +** Gnus now treats inline MIME contents as untrusted. +To get back previous insecure behavior, 'untrusted-content' should be +reset to nil in the buffer. - -* Incompatible Lisp Changes in Emacs 29.3 +** LaTeX preview is now by default disabled for email attachments. +To get back previous insecure behavior, set the variable +'org--latex-preview-when-risky' to a non-nil value. - -* Lisp Changes in Emacs 29.3 - - -* Changes in Emacs 29.3 on Non-Free Operating Systems +** Org mode now considers contents of remote files to be untrusted. +Remote files are recognized by calling 'file-remote-p'. * Installation Changes in Emacs 29.2 -- cgit v1.2.3 From 3221d8d46116fdefb19742be916d0e352dfab761 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 24 Mar 2024 08:36:44 -0400 Subject: * admin/authors.el (authors-aliases): Add ignored authors. --- admin/authors.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/admin/authors.el b/admin/authors.el index 3764c16adf0..88c01f14120 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -198,8 +198,10 @@ files.") ("Miha Rihtaršič" "Miha Rihtarsic" "miha@kamnitnik\\.top" "miha") ("Mikio Nakajima" "Nakajima Mikio") (nil "montag451@laposte\\.net") - (nil "na@aisrntairetnraoitn") ("Morgan Smith" "Morgan J\\. Smith") + ("Mou Tong" "mou\\.tong@outlook\\.com") + (nil "na@aisrntairetnraoitn") + (nil "nibon7@163\\.com") ("Nelson Jose dos Santos Ferreira" "Nelson Ferreira") ("Noah Peart" "noah\\.v\\.peart@gmail\\.com") ("Noorul Islam" "Noorul Islam K M") -- cgit v1.2.3 From befa9fcaae29a6c9a283ba371c3c5234c7f644eb Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 20 Feb 2024 12:19:46 +0300 Subject: org-macro--set-templates: Prevent code evaluation * lisp/org/org-macro.el (org-macro--set-templates): Get rid of any risk to evaluate code when `org-macro--set-templates' is called as a part of major mode initialization. This way, no code evaluation is ever triggered when user merely opens the file or when `mm-display-org-inline' invokes Org major mode to fontify mime part preview in email messages. --- lisp/org/org-macro.el | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el index 776d162be12..0be51eec512 100644 --- a/lisp/org/org-macro.el +++ b/lisp/org/org-macro.el @@ -109,6 +109,13 @@ previous one, unless VALUE is nil. Return the updated list." (let ((new-templates nil)) (pcase-dolist (`(,name . ,value) templates) (let ((old-definition (assoc name new-templates))) + ;; This code can be evaluated unconditionally, as a part of + ;; loading Org mode. We *must not* evaluate any code present + ;; inside the Org buffer while loading. Org buffers may come + ;; from various sources, like received email messages from + ;; potentially malicious senders. Org mode might be used to + ;; preview such messages and no code evaluation from inside the + ;; received Org text should ever happen without user consent. (when (and (stringp value) (string-match-p "\\`(eval\\>" value)) ;; Pre-process the evaluation form for faster macro expansion. (let* ((args (org-macro--makeargs value)) @@ -121,7 +128,7 @@ previous one, unless VALUE is nil. Return the updated list." (cadr (read value)) (error (user-error "Invalid definition for macro %S" name))))) - (setq value (eval (macroexpand-all `(lambda ,args ,body)) t)))) + (setq value `(lambda ,args ,body)))) (cond ((and value old-definition) (setcdr old-definition value)) (old-definition) (t (push (cons name (or value "")) new-templates))))) -- cgit v1.2.3 From ccc188fcf98ad9166ee551fac9d94b2603c3a51b Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 20 Feb 2024 12:43:51 +0300 Subject: * lisp/files.el (untrusted-content): New variable. The new variable is to be used when buffer contents comes from untrusted source. --- lisp/files.el | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/lisp/files.el b/lisp/files.el index c0d26b2343c..5536af014f6 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -695,6 +695,14 @@ Also see the `permanently-enabled-local-variables' variable." Some modes may wish to set this to nil to prevent directory-local settings being applied, but still respect file-local ones.") +(defvar-local untrusted-content nil + "Non-nil means that current buffer originated from an untrusted source. +Email clients and some other modes may set this non-nil to mark the +buffer contents as untrusted. + +This variable might be subject to change without notice.") +(put 'untrusted-content 'permanent-local t) + ;; This is an odd variable IMO. ;; You might wonder why it is needed, when we could just do: ;; (setq-local enable-local-variables nil) -- cgit v1.2.3 From 937b9042ad7426acdcca33e3d931d8f495bdd804 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 20 Feb 2024 12:44:30 +0300 Subject: * lisp/gnus/mm-view.el (mm-display-inline-fontify): Mark contents untrusted. --- lisp/gnus/mm-view.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 2e1261c4c9c..5f234e5c006 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -504,6 +504,7 @@ If MODE is not set, try to find mode automatically." (setq coding-system (mm-find-buffer-file-coding-system))) (setq text (buffer-string)))) (with-temp-buffer + (setq untrusted-content t) (insert (cond ((eq charset 'gnus-decoded) (with-current-buffer (mm-handle-buffer handle) (buffer-string))) -- cgit v1.2.3 From 6f9ea396f49cbe38c2173e0a72ba6af3e03b271c Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 20 Feb 2024 12:47:24 +0300 Subject: org-latex-preview: Add protection when `untrusted-content' is non-nil * lisp/org/org.el (org--latex-preview-when-risky): New variable controlling how to handle LaTeX previews in Org files from untrusted origin. (org-latex-preview): Consult `org--latex-preview-when-risky' before generating previews. This patch adds a layer of protection when LaTeX preview is requested for an email attachment, where `untrusted-content' is set to non-nil. --- lisp/org/org.el | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/lisp/org/org.el b/lisp/org/org.el index c75afbf5a67..0f5d17deee2 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -1140,6 +1140,24 @@ the following lines anywhere in the buffer: :package-version '(Org . "8.0") :type 'boolean) +(defvar untrusted-content) ; defined in files.el +(defvar org--latex-preview-when-risky nil + "If non-nil, enable LaTeX preview in Org buffers from unsafe source. + +Some specially designed LaTeX code may generate huge pdf or log files +that may exhaust disk space. + +This variable controls how to handle LaTeX preview when rendering LaTeX +fragments that originate from incoming email messages. It has no effect +when Org mode is unable to determine the origin of the Org buffer. + +An Org buffer is considered to be from unsafe source when the +variable `untrusted-content' has a non-nil value in the buffer. + +If this variable is non-nil, LaTeX previews are rendered unconditionally. + +This variable may be renamed or changed in the future.") + (defcustom org-insert-mode-line-in-empty-file nil "Non-nil means insert the first line setting Org mode in empty files. When the function `org-mode' is called interactively in an empty file, this @@ -15695,6 +15713,7 @@ fragments in the buffer." (interactive "P") (cond ((not (display-graphic-p)) nil) + ((and untrusted-content (not org--latex-preview-when-risky)) nil) ;; Clear whole buffer. ((equal arg '(64)) (org-clear-latex-preview (point-min) (point-max)) -- cgit v1.2.3 From 2bc865ace050ff118db43f01457f95f95112b877 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 20 Feb 2024 14:59:20 +0300 Subject: org-file-contents: Consider all remote files unsafe * lisp/org/org.el (org-file-contents): When loading files, consider all remote files (like TRAMP-fetched files) unsafe, in addition to URLs. --- lisp/org/org.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/org/org.el b/lisp/org/org.el index 0f5d17deee2..76559c91cd3 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -4576,12 +4576,16 @@ from file or URL, and return nil. If NOCACHE is non-nil, do a fresh fetch of FILE even if cached version is available. This option applies only if FILE is a URL." (let* ((is-url (org-url-p file)) + (is-remote (condition-case nil + (file-remote-p file) + ;; In case of error, be safe. + (t t))) (cache (and is-url (not nocache) (gethash file org--file-cache)))) (cond (cache) - (is-url + ((or is-url is-remote) (if (org--should-fetch-remote-resource-p file) (condition-case error (with-current-buffer (url-retrieve-synchronously file) -- cgit v1.2.3 From 7a5d7be52c5f0690ee47f30bfad973827261abf2 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Fri, 23 Feb 2024 12:56:58 +0300 Subject: org--confirm-resource-safe: Fix prompt when prompting in non-file Org buffers * lisp/org/org.el (org--confirm-resource-safe): When called from non-file buffer, do not put stray "f" in the prompt. --- lisp/org/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org/org.el b/lisp/org/org.el index 76559c91cd3..154388f79c6 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -4671,9 +4671,9 @@ returns non-nil if any of them match." (propertize domain 'face '(:inherit org-link :weight normal)) ") as safe.\n ") "") - (propertize "f" 'face 'success) (if current-file (concat + (propertize "f" 'face 'success) " to download this resource, and permanently mark all resources in " (propertize current-file 'face 'underline) " as safe.\n ") -- cgit v1.2.3 From 0dab0c0d688faf22adf48a429702bf906a38697b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 24 Mar 2024 09:05:17 -0400 Subject: Bump Emacs version to 29.3 * README: * configure.ac: * nt/README.W32: * msdos/sed2v2.inp: Bump Emacs version to 29.3. --- README | 2 +- configure.ac | 2 +- msdos/sed2v2.inp | 2 +- nt/README.W32 | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/README b/README index a968b29f71c..877ebb3c642 100644 --- a/README +++ b/README @@ -2,7 +2,7 @@ Copyright (C) 2001-2024 Free Software Foundation, Inc. See the end of the file for license conditions. -This directory tree holds version 29.2.50 of GNU Emacs, the extensible, +This directory tree holds version 29.3 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. The file INSTALL in this directory says how to build and install GNU diff --git a/configure.ac b/configure.ac index 34a5a89bea9..473ae06833c 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ dnl along with GNU Emacs. If not, see . AC_PREREQ([2.65]) dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el. -AC_INIT([GNU Emacs], [29.2.50], [bug-gnu-emacs@gnu.org], [], +AC_INIT([GNU Emacs], [29.3], [bug-gnu-emacs@gnu.org], [], [https://www.gnu.org/software/emacs/]) dnl Set emacs_config_options to the options of 'configure', quoted for the shell, diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index 8ca5bbf74d9..8e6f42ebee4 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -67,7 +67,7 @@ /^#undef PACKAGE_NAME/s/^.*$/#define PACKAGE_NAME ""/ /^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/ /^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/ -/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "29.2.50"/ +/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "29.3"/ /^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/ /^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/ /^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/ diff --git a/nt/README.W32 b/nt/README.W32 index a450c2e84f0..83ef00b8eba 100644 --- a/nt/README.W32 +++ b/nt/README.W32 @@ -1,7 +1,7 @@ Copyright (C) 2001-2024 Free Software Foundation, Inc. See the end of the file for license conditions. - Emacs version 29.2.50 for MS-Windows + Emacs version 29.3 for MS-Windows This README file describes how to set up and run a precompiled distribution of the latest version of GNU Emacs for MS-Windows. You -- cgit v1.2.3 From ff6cc3d2cf0e17fc44ac7dfd259c74f96eafa1c4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 24 Mar 2024 09:36:24 -0400 Subject: * lisp/ldefs-boot.el: Regenerate. --- lisp/ldefs-boot.el | 45 +++++++++++++++++++++++++++++---------------- 1 file changed, 29 insertions(+), 16 deletions(-) diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 16a9df2c92e..60e7f6811bc 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -6961,13 +6961,22 @@ or call the function `desktop-save-mode'.") (autoload 'desktop-save-mode "desktop" "\ Toggle desktop saving (Desktop Save mode). -When Desktop Save mode is enabled, the state of Emacs is saved from -one session to another. In particular, Emacs will save the desktop when -it exits (this may prompt you; see the option `desktop-save'). The next -time Emacs starts, if this mode is active it will restore the desktop. +When Desktop Save mode is enabled, the state of Emacs is saved from one +session to another. The saved Emacs \"desktop configuration\" includes the +buffers, their file names, major modes, buffer positions, window and frame +configuration, and some important global variables. -To manually save the desktop at any time, use the command `\\[desktop-save]'. -To load it, use `\\[desktop-read]'. +To enable this feature for future sessions, customize `desktop-save-mode' +to t, or add this line in your init file: + + (desktop-save-mode 1) + +When this mode is enabled, Emacs will save the desktop when it exits +(this may prompt you, see the option `desktop-save'). The next time +Emacs starts, if this mode is active it will restore the desktop. + +To manually save the desktop at any time, use the command \\[desktop-save]. +To load it, use \\[desktop-read]. Once a desktop file exists, Emacs will auto-save it according to the option `desktop-auto-save-timeout'. @@ -13023,7 +13032,7 @@ For instance: (?l . \"ls\"))) Each %-spec may contain optional flag, width, and precision -modifiers, as follows: +specifiers, as follows: %character @@ -13036,7 +13045,7 @@ The following flags are allowed: * ^: Convert to upper case. * _: Convert to lower case. -The width and truncation modifiers behave like the corresponding +The width and precision specifiers behave like the corresponding ones in `format' when applied to %s. For example, \"%<010b\" means \"substitute into the output the @@ -17261,9 +17270,13 @@ use its file extension as image type. Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data. Optional PROPS are additional image attributes to assign to the image, -like, e.g. `:mask MASK'. If the property `:scale' is not given and the -display has a high resolution (more exactly, when the average width of a -character in the default font is more than 10 pixels), the image is +like, e.g. `:mask MASK'. See Info node `(elisp)Image Descriptors' for +the list of supported properties; see the nodes following that node +for properties specific to certain image types. + +If the property `:scale' is not given and the display has a high +resolution (more exactly, when the average width of a character +in the default font is more than 10 pixels), the image is automatically scaled up in proportion to the default font. Value is the image created, or nil if images of type TYPE are not supported. @@ -23870,8 +23883,8 @@ As with `pcase-let', BINDINGS are of the form (PATTERN EXP), but the EXP in each binding in BINDINGS can use the results of the destructuring bindings that precede it in BINDINGS' order. -Each EXP should match (i.e. be of compatible structure) to its -respective PATTERN; a mismatch may signal an error or may go +Each EXP should match its respective PATTERN (i.e. be of structure +compatible to PATTERN); a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil. (fn BINDINGS &rest BODY)" nil t) @@ -23884,8 +23897,8 @@ All EXPs are evaluated first, and then used to perform destructuring bindings by matching each EXP against its respective PATTERN. Then BODY is evaluated with those bindings in effect. -Each EXP should match (i.e. be of compatible structure) to its -respective PATTERN; a mismatch may signal an error or may go +Each EXP should match its respective PATTERN (i.e. be of structure +compatible to PATTERN); a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil. (fn BINDINGS &rest BODY)" nil t) @@ -32878,7 +32891,7 @@ Add archive file name handler to `file-name-handler-alist'." (when (and tramp-ar ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 6 2 29 2)) package--builtin-versions) +(push (purecopy '(tramp 2 6 3 -1)) package--builtin-versions) (register-definition-prefixes "trampver" '("tramp-")) -- cgit v1.2.3 From ae8f815613c2e072e92aa8fe7b4bcf2fdabc7408 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 24 Mar 2024 09:37:03 -0400 Subject: Update files for Emacs 29.3 * ChangeLog.4: * etc/AUTHORS: * etc/HISTORY: Update for Emacs 29.3. --- ChangeLog.4 | 594 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- etc/AUTHORS | 50 ++--- etc/HISTORY | 2 + 3 files changed, 624 insertions(+), 22 deletions(-) diff --git a/ChangeLog.4 b/ChangeLog.4 index 74d6887376b..4b806c21124 100644 --- a/ChangeLog.4 +++ b/ChangeLog.4 @@ -1,3 +1,595 @@ +2024-03-24 Ihor Radchenko + + org--confirm-resource-safe: Fix prompt when prompting in non-file Org buffers + + * lisp/org/org.el (org--confirm-resource-safe): When called from + non-file buffer, do not put stray "f" in the prompt. + + org-file-contents: Consider all remote files unsafe + + * lisp/org/org.el (org-file-contents): When loading files, consider all + remote files (like TRAMP-fetched files) unsafe, in addition to URLs. + + org-latex-preview: Add protection when `untrusted-content' is non-nil + + * lisp/org/org.el (org--latex-preview-when-risky): New variable + controlling how to handle LaTeX previews in Org files from untrusted + origin. + (org-latex-preview): Consult `org--latex-preview-when-risky' before + generating previews. + This patch adds a layer of protection when LaTeX preview is requested + for an email attachment, where `untrusted-content' is set to non-nil. + + * lisp/gnus/mm-view.el (mm-display-inline-fontify): Mark contents untrusted. + * lisp/files.el (untrusted-content): New variable. + + The new variable is to be used when buffer contents comes from untrusted + source. + + org-macro--set-templates: Prevent code evaluation + + * lisp/org/org-macro.el (org-macro--set-templates): Get rid of any + risk to evaluate code when `org-macro--set-templates' is called as a + part of major mode initialization. This way, no code evaluation is + ever triggered when user merely opens the file or when + `mm-display-org-inline' invokes Org major mode to fontify mime part + preview in email messages. + +2024-03-24 Eli Zaretskii + + * admin/authors.el (authors-aliases): Add ignored authors. + + * etc/NEWS: Update for Emacs 29.3 + +2024-03-21 Andrea Corallo + + * Fix missing `comp-files-queue' update (bug#63415). + + * lisp/emacs-lisp/comp.el (native--compile-async): Update + `comp-files-queue' for real. + +2024-03-21 Basil L. Contovounesios + + Clarify description of format-spec truncation + + * doc/lispref/strings.texi (Custom Format Strings): Mention that + precision specifier affects both '<' and '>' truncation (bug#69822). + * lisp/format-spec.el (format-spec, format-spec--do-flags): Use same + terminology as 'format', especially when referring to its behavior. + +2024-03-21 Eli Zaretskii + + More accurate documentation of 'rmail-mail-new-frame' + + * doc/emacs/rmail.texi (Rmail Reply): More accurate documentation + of the effects of 'rmail-mail-new-frame'. (Bug#69738) + +2024-03-20 Eli Zaretskii + + Fix documentation of M-SPC in user manual + + * doc/emacs/killing.texi (Deletion): Fix documentation of + 'cycle-spacing'. (Bug#69905) + +2024-03-17 Michael Albinus + + * admin/notes/bugtracker: Minor copyedit. + +2024-03-16 Theodor Thornhill + + Tweak regexp for object initializers in csharp-mode (bug#69571) + + * lisp/progmodes/csharp-mode.el (csharp-guess-basic-syntax): Add + handling to not consider ended statements as object init openers. + * test/lisp/progmodes/csharp-mode-resources/indent.erts: New test + resources. + * test/lisp/progmodes/csharp-mode-tests.el: Add test for this particular + issue. + +2024-03-16 Konstantin Kharlamov + + `term-mode': mention the keymap to add keybindings to + + A user typically expects a keymap for mode `foo' to be called + `foo-mode-map'. term-mode has `term-mode-map' too, but for + user-defined bindings to have effect they have to be put to + `term-raw-map' instead. So let's mention that. + * lisp/term.el (term-mode) (term-mode-map) (term-raw-map): Mention + the keymaps to add keybindings to for `term-mode'. (Bug#69786) + +2024-03-16 Eli Zaretskii + + Fix 'shortdoc-copy-function-as-kill' + + * lisp/emacs-lisp/shortdoc.el (shortdoc-copy-function-as-kill): + Fix handling of functions with no arguments. (Bug#69720) + +2024-03-16 Eli Zaretskii + + Improve documentation of 'edebug-print-*' variables + + * lisp/emacs-lisp/edebug.el (edebug-print-length) + (edebug-print-level): Fix doc strings and customization labels. + Suggested by Matt Trzcinski . (Bug#69745) + +2024-03-11 F. Jason Park + + Fix 'with-sqlite-transaction' + + * lisp/sqlite.el (with-sqlite-transaction): Tuck misplaced body + of else form back into feature-test control structure whence it + escaped. (Bug#67142) + + * test/lisp/sqlite-tests.el: New file to accompany + test/src/sqlite-tests.el. + +2024-03-01 Dan Jacobson (tiny change) + + Fix typos in vnvni.el. + + * lisp/leim/quail/vnvni.el ("vietnamese-vni"): Fix typos. (Bug#69485) + +2024-02-27 Eli Zaretskii + + Avoid assertion violations in bidi.c + + * src/bidi.c (bidi_resolve_brackets): Move assertion about + 'resolved_level' to where it belongs. This avoids unnecessary + aborts when the character is not a bracket type and doesn't need + BPA resolution. (Bug#69421) + +2024-02-25 Stefan Monnier + + * lisp/files.el (hack-one-local-variable): Use `set-auto-mode-0` + + This fixes bug#69373. + +2024-02-24 Eli Zaretskii + + Fix infinite recursion in gdb-mi.el + + * lisp/progmodes/gdb-mi.el: (gdb-clear-partial-output) + (gdb-clear-inferior-io): Set inhibit-read-only, to avoid + signaling errors in process filter. (Bug#69327) + +2024-02-24 Eli Zaretskii + + Fix 'help-quick-toggle' + + * lisp/help.el (help-quick-sections): Fix "kill-region" command. + Add a doc string. (Bug#69345) + +2024-02-21 Juri Linkov + + * doc/lispref/modes.texi (Tabulated List Mode): Update. + + In the description of 'tabulated-list-format' document + the missing value 'props' that was added long ago. + +2024-02-21 Michael Albinus + + * lisp/net/tramp.el (tramp-methods): Fix typo in docstring. (Bug#69294) + +2024-02-17 Dmitry Gutov + + java-ts-mode: Indentation for opening brace on a separate line + + * lisp/progmodes/java-ts-mode.el (java-ts-mode--indent-rules): + Support putting the opening brace on a separate line (bug#67556). + + * test/lisp/progmodes/java-ts-mode-resources/indent.erts: + Add a test. + +2024-02-17 Philip Kaludercic + + Removed decommissioned PGP keyservers + + * lisp/epa-ks.el (epa-keyserver): Update the user option type of + `epa-keyserver'. + + See https://mail.gnu.org/archive/html/emacs-devel/2023-11/msg00857.html. + +2024-02-17 Ihor Radchenko + + org: Fix security prompt for downloading remote resource + + * lisp/org/org.el (org--confirm-resource-safe): Do not assume that + resource is safe when user replies "n" (do not download). + + Reported-by: Max Nikulin + Link: https://orgmode.org/list/upj6uk$b7o$1@ciao.gmane.io + +2024-02-17 Eli Zaretskii + + Revert "Update to Org 9.6.19" + + This reverts commit 07a392f445eb21c5e4681027eee9d981300a4309. + It was installed by mistake. + +2024-02-17 Kyle Meyer + + Update to Org 9.6.19 + +2024-02-15 Philipp Stephani + + Remove references to phst@google.com. + + I don't work for Google any more, so I'll use my private address going + forward. + + * .mailmap: Remove references to phst@google.com. + +2024-02-14 Stefan Kangas + + * BUGS: Note how to report critical security issues. + +2024-02-14 Stefan Kangas + + Add cross-reference to ELisp manual Caveats + + * doc/lispref/intro.texi (Caveats): Add cross-reference to Emacs manual. + Talking about "contributing code" makes little sense in a section about + reporting mistakes in the ELisp manual, so skip that part. + +2024-02-14 Joseph Turner + + Improve directory prompt used by package-vc-checkout + + * lisp/emacs-lisp/package-vc.el (package-vc--read-package-name): Use + read-directory-name instead of read-file-name. (Bug#66114) + +2024-02-14 Michael Albinus + + Minor Tramp doc adaption + + * doc/misc/tramp.texi (Frequently Asked Questions): Be more + precise with FIDO2 keys. + + * lisp/net/tramp.el: Adapt comments. + +2024-02-12 Daniel Martín + + ;; Fix typo in the Tramp documentation + +2024-02-11 Andrea Corallo + + * Improve reproducibility of inferred values by native comp + + * lisp/emacs-lisp/comp-cstr.el (comp-normalize-valset): Do not try to + reorder conses using 'sxhash-equal' as its behavior is not reproducible + over different sessions. + +2024-02-10 Loïc Lemaître (tiny change) + + Handle typescript ts grammar breaking change for function_expression + + Starting from version 0.20.4 of the typescript/tsx grammar, "function" + becomes "function_expression". The right expression is used depending + on the grammar version. + + * lisp/progmodes/typescript-ts-mode.el + (tsx-ts-mode--font-lock-compatibility-function-expression): + New function (bug#69024). + (typescript-ts-mode--font-lock-settings): Use it. + +2024-02-10 Eli Zaretskii + + Don't quote 't' in doc strings + + * lisp/outline.el (outline-minor-mode-use-buttons): Doc fix. + Patch by Arash Esbati . (Bug#69012) + +2024-02-09 Michael Albinus + + Tramp: Handle PIN requests from security keys (don't merge) + + * doc/misc/tramp.texi (Frequently Asked Questions): Clarify FIDO entry. + + * lisp/net/tramp-sh.el (tramp-actions-before-shell) + (tramp-actions-copy-out-of-band): + Use `tramp-security-key-pin-regexp'. + + * lisp/net/tramp.el (tramp-security-key-pin-regexp): New defcustom. + (tramp-action-otp-password, tramp-read-passwd): Trim password prompt. + (tramp-action-show-and-confirm-message): Expand for PIN requests. + +2024-02-08 Stefan Kangas + + * admin/notes/kind-communication: New file. + +2024-02-08 Eli Zaretskii + + Don't skip links to "." and ".." in Dired when marking files + + * lisp/dired.el (dired-mark): Skip "." and "..", but not symlinks + to those two. (Bug#38729) (Bug#68814) + +2024-02-06 Joseph Turner + + Pass unquoted filename to user-supplied MUSTMATCH predicate + + * lisp/minibuffer.el (read-file-name-default): Pass REQUIRE-MATCH + argument through substitute-in-file-name. + * lisp/minibuffer.el (read-file-name): Update docstring. + + Resolves bug#68815. + +2024-02-04 Juri Linkov + + * doc/lispref/parsing.texi (Retrieving Nodes): Improve documentation. + + Update optional arguments 'predicate' and 'include-node' + of 'treesit-node-top-level'. + +2024-02-03 Vincenzo Pupillo + + Fix incompatibility with tree-sitter-javascript >= 0.20.2 + + Starting from version 0.20.2 the grammar's primary expression + "function" has been renamed to "function_expression". A new + function checks if the new primary expression is available, + and if so, it returns the correct rules. + * lisp/progmodes/js.el + (js--treesit-font-lock-compatibility-definition-feature): New + function. + (js--treesit-font-lock-settings): Use it. (Bug#68879) + +2024-02-03 Eli Zaretskii + + Avoid signaling errors from 'pixel-fill-region' + + * lisp/textmodes/pixel-fill.el (pixel-fill-region): Make sure the + selected window displays the current buffer. This is important + when this function is called inside 'with-current-buffer' or + similar forms which temporarily change the buffer displayed in the + selected window. (Bug#67791) + +2024-02-02 nibon7 + + eglot: Add nushell language server + + * lisp/progmodes/eglot.el (eglot-server-programs): Add nushell + language server. (Bug#68823) + +2024-02-02 Piotr Kwiecinski (tiny change) + + eglot: Add php-ts-mode to eglot-server-programs + + * lisp/progmodes/eglot.el (eglot-server-programs): Add + php-ts-mode. (Bug#68870) + +2024-02-02 dalu (tiny change) + + Support kotlin-ts-mode in Eglot + + * lisp/progmodes/eglot.el (eglot-server-programs): Support + kotlin-ts-mode. (Bug#68865) + +2024-02-01 Michael Albinus + + Fix stale cache in Tramp (do not merge with master) + + * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): + Flush file properties when needed. (Bug#68805) + +2024-02-01 Ulrich Müller + + * configure.ac: Include X11/Xlib.h for XOpenDisplay. (Bug#68842) + + Do not merge to master. + +2024-02-01 Stefan Kangas + + Improve `desktop-save-mode` docstring + + * lisp/desktop.el (desktop-save-mode): Improve docstring. + +2024-01-28 Joseph Turner + + Fix completing-read functional REQUIRE-MATCH behavior + + * lisp/minibuffer.el (completion--complete-and-exit): If + minibuffer-completion-confirm is a function which returns nil, + immediately fail to complete. + + See bug#66187. + +2024-01-28 Eli Zaretskii + + Fix "emacs -nw" on MS-Windows + + * src/w32term.c (w32_flip_buffers_if_dirty): Do nothing if F is + not a GUI frame. This avoids rare crashes in "emacs -nw". + * src/w32console.c (initialize_w32_display): Set the + ENABLE_EXTENDED_FLAGS bit in 'prev_console_mode'. + + (cherry picked from commit e1970c99f097715fc5bb3b88154799bfe13de90f) + +2024-01-28 Michael Albinus + + Handle wrong login program in Tramp + + * lisp/net/tramp-sh.el (tramp-maybe-open-connection): Exit remote + shell when login fails. + +2024-01-27 Jim Porter + + * doc/lispref/package.texi (Multi-file Packages): Document ".elpaignore". + + (cherry picked from commit 744a10a4d722a361bc21561b4162045e4ec97ed6) + +2024-01-27 Eshel Yaron + + Avoid signaling errors in emoji.el on empty input + + * lisp/international/emoji.el (emoji--read-emoji): Signal + user-error on empty input. (Bug#68671) + + Do not merge to master. + +2024-01-27 Eli Zaretskii + + Fix description of when "\xNNN" is considered a unibyte character + + * doc/lispref/objects.texi (Non-ASCII in Strings): More accurate + description of when a hexadecimal escape sequence yields a unibyte + character. (Bug#68751) + +2024-01-26 Randy Taylor + + Simplify imenu setup for {cmake,dockerfile}-ts-modes + + * lisp/progmodes/cmake-ts-mode.el (treesit-induce-sparse-tree, + treesit-node-child, treesit-node-start, cmake-ts-mode--imenu, + cmake-ts-mode--imenu-1): Remove. + (treesit-search-subtree): Declare. + (cmake-ts-mode--function-name): New function. + (cmake-ts-mode): Use it. + + * lisp/progmodes/dockerfile-ts-mode.el (treesit-induce-sparse-tree, + treesit-node-start, dockerfile-ts-mode--imenu, + dockerfile-ts-mode--imenu-1): Remove. + (dockerfile-ts-mode--stage-name): New function. + (dockerfile-ts-mode): Use it. + +2024-01-24 Eli Zaretskii + + Improve documentation of profiler commands + + * doc/lispref/debugging.texi (Profiling): Document more commands. + Improve indexing. (Bug#68693) + +2024-01-23 Basil L. Contovounesios + + Fix broken links to Freedesktop notifications spec + + * doc/lispref/os.texi (Desktop Notifications): + * lisp/notifications.el: Replace broken developer.gnome.org links + with specifications.freedesktop.org (bug#67939). + +2024-01-22 Michael Albinus + + Fix nasty cut'n'waste error in Tramp + + * lisp/net/tramp.el (tramp-parse-passwd): Use `tramp-parse-passwd-group'. + Reported by Tim Landscheidt . + +2024-01-21 Stefan Kangas + + Fix image-dired-tags-db-file void variable error + + * lisp/image/image-dired-tags.el (image-dired-sane-db-file): + Require 'image-dired'. (Bug#68636) + +2024-01-21 Matthew Smith (tiny change) + + typescript-ts-mode: Skip test if tsx grammar missing + + typescript-ts-mode-test-indentation depends on both the tree-sitter + typescript grammar, and the tree-sitter tsx grammar. If only the + typescript is installed, the tests will run and then fail unexpectedly + after tsx fails to load. + + * test/lisp/progmodes/typescript-ts-mode-tests.el + (typescript-ts-mode-test-indentation): Skip test if tsx grammar is + missing. + +2024-01-20 Stefan Kangas + + * admin/README: Document the run-codespell script. + + * admin/README: Fix entry on coccinelle subdirectory. + +2024-01-20 Stefan Kangas + + Add script admin/run-codespell and supporting files + + * admin/codespell/README: + * admin/codespell/codespell.dictionary: + * admin/codespell/codespell.exclude: + * admin/codespell/codespell.ignore: + * admin/codespell/codespell.rc: + * admin/run-codespell: New files. + +2024-01-20 Michael Albinus + + Sync with Tramp 2.6.3-pre (don't merge with master) + + * doc/misc/tramp.texi (Obtaining @value{tramp}): Mention the ELPA + Tramp manual. + (Remote processes): Adapt index. + + * doc/misc/trampver.texi: + * lisp/net/trampver.el (tramp-version): Set to "2.6.3-pre". + + * lisp/net/tramp.el (tramp-local-host-regexp): Extend. Adapt :version. + (tramp-signal-process): PROCESS can also be a string. + (tramp-skeleton-directory-files): + * lisp/net/tramp-cache.el (with-tramp-saved-file-property) + (with-tramp-saved-file-properties) + (with-tramp-saved-connection-property) + (with-tramp-saved-connection-properties): Use `setf' but `setq' in macro. + + * lisp/net/tramp-compat.el (tramp-compat-funcall): Declare debug. + + * lisp/net/tramp-crypt.el (tramp-crypt-file-name-p): Exclude lock files. + (tramp-crypt-file-name-handler-alist): Use `identity' for + `abbreviate-file-name'. + (tramp-crypt-add-directory, tramp-crypt-remove-directory): + Adapt docstrings. + (tramp-crypt-cleanup-connection): New defun. Add it to + `tramp-cleanup-connection-hook' + + * lisp/net/tramp.el (tramp-skeleton-file-name-all-completions): + Handle "." and "..". + + * lisp/net/tramp-adb.el (tramp-adb-handle-file-name-all-completions): + * lisp/net/tramp-fuse.el (tramp-fuse-handle-file-name-all-completions): + * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-name-all-completions): + Remove special handling of "." an "..". + + * lisp/net/tramp-sh.el (tramp-pipe-stty-settings): New defcustom. + (tramp-sh-handle-make-process): Use it. (Bug#62093) + + * test/lisp/net/tramp-tests.el (tramp-test18-file-attributes): + Adapt test. + (tramp-test31-signal-process): Extend. + +2024-01-20 Eli Zaretskii (tiny change) + + Update Polish translation of tutorial + + * etc/tutorials/TUTORIAL.pl: Update text about scroll bar. New + text by Christopher Yeleighton . + (Bug#68599) + +2024-01-19 Michael Albinus + + * doc/misc/gnus.texi (Summary Mail Commands): Fix command name. + +2024-01-18 Eli Zaretskii + + Bump Emacs version to 29.2.50. + + * README: + * configure.ac: + * nt/README.W32: + * msdos/sed2v2.inp: + * etc/NEWS: Bump Emacs version to 29.2.50. + +2024-01-18 Eli Zaretskii + + * Update etc/HISTORY and ChangeLog.4 for 29.2 release. + +2024-01-18 Eli Zaretskii + + Bump Emacs version to 29.2 + + * README: + * configure.ac: + * nt/README.W32: + * msdos/sed2v2.inp: Bump Emacs version to 29.2. + 2024-01-18 Eli Zaretskii * Version 29.2 released. @@ -120914,7 +121506,7 @@ This file records repository revisions from commit f2ae39829812098d8269eafbc0fcb98959ee5bb7 (exclusive) to -commit 92a7132bd6c76a43860fa01ca3363857d8dfc8f3 (inclusive). +commit 8d8253f89915f1d9b45791d46cf974c6bdcc1457 (inclusive). See ChangeLog.3 for earlier changes. ;; Local Variables: diff --git a/etc/AUTHORS b/etc/AUTHORS index 193a3db6760..8a541e8a7e2 100644 --- a/etc/AUTHORS +++ b/etc/AUTHORS @@ -585,7 +585,7 @@ Bartosz Duszel: changed allout.el bib-mode.el cc-cmds.el hexl.el icon.el Basil L. Contovounesios: changed simple.el subr.el message.el eww.el modes.texi custom.el text.texi bibtex.el gnus-sum.el internals.texi js.el customize.texi display.texi files.texi gnus-group.el gnus-win.el - gnus.texi gravatar.el json.el map.el shr.el and 345 other files + gnus.texi gravatar.el json.el map.el shr.el and 346 other files Bastian Beischer: changed semantic/complete.el calc-yank.el include.el mru-bookmark.el refs.el senator.el @@ -1246,6 +1246,8 @@ Dani Moncayo: changed msys-to-w32 Makefile.in configure.ac buffers.texi dired.texi display.texi emacs-lisp-intro.texi files.texi killing.texi make-dist mark.texi msysconfig.sh simple.el text.texi version.el +Dan Jacobson: changed vnvni.el + Dan Nicolaescu: wrote iris-ansi.el romanian.el vc-dir.el and co-wrote hideshow.el and changed vc.el configure.ac vc-hg.el vc-git.el src/Makefile.in @@ -1576,7 +1578,7 @@ and changed xref.el ruby-mode.el project.el vc-git.el ruby-ts-mode.el elisp-mode.el js.el etags.el ruby-mode-tests.el vc.el package.el vc-hg.el symref/grep.el treesit.el dired-aux.el progmodes/python.el ruby-ts-mode-tests.el simple.el typescript-ts-mode.el log-edit.el - ruby-ts.rb and 158 other files + ruby-ts.rb and 159 other files Dmitry Kurochkin: changed isearch.el @@ -1675,7 +1677,7 @@ Eli Zaretskii: wrote [bidirectional display in xdisp.c] chartab-tests.el coding-tests.el etags-tests.el rxvt.el tty-colors.el and co-wrote help-tests.el and changed xdisp.c display.texi w32.c msdos.c simple.el w32fns.c - files.el fileio.c keyboard.c emacs.c text.texi configure.ac w32term.c + files.el fileio.c keyboard.c emacs.c configure.ac text.texi w32term.c dispnew.c frames.texi w32proc.c files.texi xfaces.c window.c dispextern.h lisp.h and 1341 other files @@ -1823,7 +1825,7 @@ Ernesto Alfonso: changed simple.el E Sabof: changed hi-lock.el image-dired.el -Eshel Yaron: changed eglot.el emacs.texi eww.el indent.texi +Eshel Yaron: changed eglot.el emacs.texi emoji.el eww.el indent.texi Espen Skoglund: wrote pascal.el @@ -1935,7 +1937,7 @@ F. Jason Park: changed erc.el erc-backend.el erc-tests.el foonet.eld barnet.eld erc-scenarios-misc.el erc-services.el erc-common.el erc-networks-tests.el erc-scenarios-base-reconnect.el erc-scenarios-common.el socks-tests.el auth-source-pass-tests.el - auth-source-pass.el erc-join.el erc-sasl-tests.el and 104 other files + auth-source-pass.el erc-join.el erc-sasl-tests.el and 106 other files Flemming Hoejstrup Hansen: changed forms.el @@ -2356,7 +2358,7 @@ Igor Saprykin: changed ftfont.c Ihor Radchenko: wrote org-fold-core.el org-fold.el org-persist.el and changed ox.el fns.c emacsclient.desktop help-mode.el oc.el - org-element.el + org-element.el org.el Iku Iwasa: changed auth-source-pass-tests.el auth-source-pass.el @@ -2780,7 +2782,7 @@ Jim Porter: changed eshell.texi esh-cmd.el esh-var-tests.el esh-util.el eshell-tests-helpers.el em-pred.el esh-arg.el esh-cmd-tests.el tramp.el em-pred-tests.el em-dirs-tests.el server.el em-basic.el em-extpipe-tests.el esh-opt-tests.el esh-opt.el - and 93 other files + and 94 other files Jim Radford: changed gnus-start.el @@ -3059,7 +3061,7 @@ and changed xterm.c xfns.c keyboard.c screen.c dispnew.c xdisp.c window.c Joseph M. Kelsey: changed fileio.c skeleton.el -Joseph Turner: changed package-vc.el subr.el +Joseph Turner: changed package-vc.el minibuffer.el subr.el Josh Elsasser: changed eglot.el README.md configure.ac @@ -3435,7 +3437,7 @@ Konstantin Kharlamov: changed smerge-mode.el diff-mode.el files.el ada-mode.el autorevert.el calc-aent.el calc-ext.el calc-lang.el cc-mode.el cperl-mode.el css-mode.el cua-rect.el dnd.el ebnf-abn.el ebnf-dtd.el ebnf-ebx.el emacs-module-tests.el epg.el faces.el - gnus-art.el gtkutil.c and 27 other files + gnus-art.el gtkutil.c and 28 other files Konstantin Kliakhandler: changed org-agenda.el @@ -3611,6 +3613,8 @@ Lluís Vilanova: changed ede/linux.el Logan Perkins: changed keyboard.c +Loïc Lemaître: changed typescript-ts-mode.el + Luca Capello: changed mm-encode.el Lucas Werkmeister: changed emacs.c emacs.service nxml-mode.el @@ -3950,6 +3954,8 @@ Matthew Mundell: changed calendar.texi diary-lib.el files.texi Matthew Newton: changed imenu.el +Matthew Smith: changed typescript-ts-mode-tests.el + Matthew Tromp: changed ielm.el Matthew White: changed buffer.c bookmark-tests.el bookmark.el @@ -4275,10 +4281,8 @@ Mohsin Kaleem: changed eglot.el Mon Key: changed animate.el imap.el syntax.el -Morgan J. Smith: changed gnus-group-tests.el url-vars.el - -Morgan Smith: changed image-dired.el doc-view.el minibuffer-tests.el - minibuffer.el vc-git.el window.el +Morgan Smith: changed image-dired.el doc-view.el gnus-group-tests.el + minibuffer-tests.el minibuffer.el url-vars.el vc-git.el window.el Morten Welinder: wrote [many MS-DOS files] arc-mode.el desktop.el dosfns.c internal.el msdos.h pc-win.el @@ -4291,6 +4295,8 @@ Mosur Mohan: changed etags.c Motorola: changed buff-menu.el +Mou Tong: changed eglot.el + Muchenxuan Tong: changed org-agenda.el org-mobile.el org-timer.el Murata Shuuichirou: changed coding.c @@ -4823,7 +4829,7 @@ and changed emacs-module.c emacs-module-tests.el configure.ac json.c process.c eval.c internals.texi json-tests.el process-tests.el pdumper.c alloc.c emacs-module.h.in emacs.c lread.c nsterm.m bytecomp.el lisp.h seccomp-filter.c callproc.c cl-macs.el gtkutil.c - and 188 other files + and 189 other files Phillip Dixon: changed eglot.el @@ -4872,6 +4878,8 @@ Piet van Oostrum: changed data.c fileio.c flyspell.el smtpmail.el Pinku Surana: changed sql.el +Piotr Kwiecinski: changed eglot.el + Piotr Trojanek: changed gnutls.c process.c Piotr Zieliński: wrote org-mouse.el @@ -4967,8 +4975,8 @@ Randall Smith: changed dired.el Randal Schwartz: wrote pp.el -Randy Taylor: changed build.sh eglot.el batch.sh dockerfile-ts-mode.el - rust-ts-mode.el go-ts-mode.el c-ts-mode.el cmake-ts-mode.el +Randy Taylor: changed build.sh dockerfile-ts-mode.el eglot.el batch.sh + rust-ts-mode.el cmake-ts-mode.el go-ts-mode.el c-ts-mode.el cus-theme.el font-lock.el java-ts-mode.el js.el json-ts-mode.el modes.texi progmodes/python.el project.el sh-script.el typescript-ts-mode.el yaml-ts-mode.el @@ -5550,7 +5558,7 @@ and co-wrote help-tests.el keymap-tests.el and changed image-dired.el efaq.texi package.el cperl-mode.el help.el subr.el checkdoc.el bookmark.el simple.el dired.el files.el gnus.texi dired-x.el keymap.c image-mode.el erc.el ediff-util.el speedbar.el - woman.el browse-url.el bytecomp-tests.el and 1683 other files + woman.el browse-url.el bytecomp-tests.el and 1690 other files Stefan Merten: co-wrote rst.el @@ -5815,9 +5823,9 @@ Theodore Jump: changed makefile.nt makefile.def w32-win.el w32faces.c Theodor Thornhill: changed typescript-ts-mode.el java-ts-mode.el c-ts-mode.el eglot.el csharp-mode.el js.el css-mode.el project.el indent.erts json-ts-mode.el treesit.el c-ts-common.el eglot-tests.el - EGLOT-NEWS README.md c-ts-mode-tests.el compile-tests.el go-ts-mode.el - indent-bsd.erts java-ts-mode-tests.el maintaining.texi - and 8 other files + EGLOT-NEWS README.md c-ts-mode-tests.el compile-tests.el + csharp-mode-tests.el go-ts-mode.el indent-bsd.erts + java-ts-mode-tests.el and 9 other files Theresa O'Connor: wrote json.el and changed erc.el erc-viper.el erc-log.el erc-track.el viper.el @@ -6185,7 +6193,7 @@ Vincent Bernat: changed gnus-int.el nnimap.el xsettings.c Vincent Del Vecchio: changed info.el mh-utils.el -Vincenzo Pupillo: changed cmake-ts-mode.el js.el typescript-ts-mode.el +Vincenzo Pupillo: changed js.el cmake-ts-mode.el typescript-ts-mode.el java-ts-mode.el Vince Salvino: changed msdos.texi w32.c w32fns.c diff --git a/etc/HISTORY b/etc/HISTORY index afa14cb2350..cfd4f1f6873 100644 --- a/etc/HISTORY +++ b/etc/HISTORY @@ -235,6 +235,8 @@ GNU Emacs 29.1 (2023-07-30) emacs-29.1 GNU Emacs 29.2 (2024-01-18) emacs-29.2 +GNU Emacs 29.3 (2024-03-24) emacs-29.3 + ---------------------------------------------------------------------- This file is part of GNU Emacs. -- cgit v1.2.3 From 96fb71994246508f9bcaae95395d44042941f02d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 24 Mar 2024 10:38:01 -0400 Subject: Bump Emacs version to 29.3.50 * README: * configure.ac: * nt/README.W32: * msdos/sed2v2.inp: * etc/NEWS: Bump Emacs version to 29.3.50. --- README | 2 +- configure.ac | 2 +- etc/NEWS | 27 +++++++++++++++++++++++++++ msdos/sed2v2.inp | 2 +- nt/README.W32 | 2 +- 5 files changed, 31 insertions(+), 4 deletions(-) diff --git a/README b/README index 877ebb3c642..b972a53e9f3 100644 --- a/README +++ b/README @@ -2,7 +2,7 @@ Copyright (C) 2001-2024 Free Software Foundation, Inc. See the end of the file for license conditions. -This directory tree holds version 29.3 of GNU Emacs, the extensible, +This directory tree holds version 29.3.50 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. The file INSTALL in this directory says how to build and install GNU diff --git a/configure.ac b/configure.ac index 473ae06833c..f2a7463dfe8 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ dnl along with GNU Emacs. If not, see . AC_PREREQ([2.65]) dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el. -AC_INIT([GNU Emacs], [29.3], [bug-gnu-emacs@gnu.org], [], +AC_INIT([GNU Emacs], [29.3.50], [bug-gnu-emacs@gnu.org], [], [https://www.gnu.org/software/emacs/]) dnl Set emacs_config_options to the options of 'configure', quoted for the shell, diff --git a/etc/NEWS b/etc/NEWS index 3f94b0d4634..4695bcc5334 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -15,6 +15,33 @@ in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' with a prefix argument or by typing 'C-u C-h C-n'. + +* Installation Changes in Emacs 29.4 + + +* Startup Changes in Emacs 29.4 + + +* Changes in Emacs 29.4 + + +* Editing Changes in Emacs 29.4 + + +* Changes in Specialized Modes and Packages in Emacs 29.4 + + +* New Modes and Packages in Emacs 29.4 + + +* Incompatible Lisp Changes in Emacs 29.4 + + +* Lisp Changes in Emacs 29.4 + + +* Changes in Emacs 29.4 on Non-Free Operating Systems + * Changes in Emacs 29.3 Emacs 29.3 is an emergency bugfix release intended to fix several diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index 8e6f42ebee4..34b382df8fe 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -67,7 +67,7 @@ /^#undef PACKAGE_NAME/s/^.*$/#define PACKAGE_NAME ""/ /^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/ /^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/ -/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "29.3"/ +/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "29.3.50"/ /^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/ /^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/ /^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/ diff --git a/nt/README.W32 b/nt/README.W32 index 83ef00b8eba..a1838f66988 100644 --- a/nt/README.W32 +++ b/nt/README.W32 @@ -1,7 +1,7 @@ Copyright (C) 2001-2024 Free Software Foundation, Inc. See the end of the file for license conditions. - Emacs version 29.3 for MS-Windows + Emacs version 29.3.50 for MS-Windows This README file describes how to set up and run a precompiled distribution of the latest version of GNU Emacs for MS-Windows. You -- cgit v1.2.3 From 83a6e80d66a4c6333e2bbb21d0428c432ddca881 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 24 Mar 2024 22:13:44 -0400 Subject: (byte-optimize-form-code-walker): Simplify a bit Eliminate a case that matches very rarely and where the default handling works just as well anyway. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Remove redundant case. --- lisp/emacs-lisp/byte-opt.el | 3 --- 1 file changed, 3 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index f6df40a2d9b..54997205edb 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -482,9 +482,6 @@ There can be multiple entries for the same NAME if it has several aliases.") (push name byte-optimize--dynamic-vars) `(,fn ,name . ,optimized-rest))) - (`(,(pred byte-code-function-p) . ,exps) - (cons fn (mapcar #'byte-optimize-form exps))) - ((guard (when for-effect (if-let ((tmp (byte-opt--fget fn 'side-effect-free))) (or byte-compile-delete-errors -- cgit v1.2.3 From ba96c4ec56a9978fce155c0af34a0412aee817b2 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 25 Mar 2024 15:42:23 +0800 Subject: Port restart-emacs to Android 4.3 and earlier * java/org/gnu/emacs/EmacsService.java (restartEmacs): Run Emacs from an alarm if required. --- java/org/gnu/emacs/EmacsService.java | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 07bfb525be9..4e863c750d3 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -46,9 +46,11 @@ import android.view.KeyEvent; import android.view.inputmethod.CursorAnchorInfo; import android.view.inputmethod.ExtractedText; +import android.app.AlarmManager; import android.app.Notification; -import android.app.NotificationManager; import android.app.NotificationChannel; +import android.app.NotificationManager; +import android.app.PendingIntent; import android.app.Service; import android.content.ClipboardManager; @@ -724,11 +726,29 @@ public final class EmacsService extends Service restartEmacs () { Intent intent; + PendingIntent pending; + AlarmManager manager; intent = new Intent (this, EmacsActivity.class); intent.addFlags (Intent.FLAG_ACTIVITY_NEW_TASK | Intent.FLAG_ACTIVITY_CLEAR_TASK); - startActivity (intent); + + if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.KITKAT) + startActivity (intent); + else + { + /* Experimentation has established that Android 4.3 and earlier + versions do not attempt to recreate a process when it crashes + immediately after requesting that an intent for itself be + started. Schedule an intent to start some time after Emacs + exits instead. */ + + pending = PendingIntent.getActivity (this, 0, intent, 0); + manager = (AlarmManager) getSystemService (Context.ALARM_SERVICE); + manager.set (AlarmManager.RTC, System.currentTimeMillis () + 100, + pending); + } + System.exit (0); } -- cgit v1.2.3 From f54b1d9f7b7a977ee4856c778a309c900ce9e8fa Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 25 Mar 2024 09:45:08 +0200 Subject: * lisp/vc/diff-mode.el (diff-setup-buffer-type): Remove "\n" from regexp. Remove extra "\n" from the end of the "diff --git.*" part of 'diff-outline-regexp' because "\n" is not used in outline-regexp and causes problems in such cases like when killing hunks in the diff buffer with outline-minor-mode that loses the outline icons because outline--fix-buttons-after-change and outline--fix-up-all-buttons are limited to the single line and can't match an outline line with a regexp that ends with "\n". --- lisp/vc/diff-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 0f393ba86a2..66043059d14 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -1619,7 +1619,7 @@ modified lines of the diff." nil))) (when (eq diff-buffer-type 'git) (setq diff-outline-regexp - (concat "\\(^diff --git.*\n\\|" diff-hunk-header-re "\\)"))) + (concat "\\(^diff --git.*\\|" diff-hunk-header-re "\\)"))) (setq-local outline-level #'diff--outline-level) (setq-local outline-regexp diff-outline-regexp)) -- cgit v1.2.3 From a79b424f7fdecf577e46c5fea6ee3d921e606596 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 25 Mar 2024 14:53:23 +0200 Subject: Document the 'I' command in buffer-menu * doc/emacs/buffers.texi (Several Buffers): Document 'I'. Fix indexing. (List Buffers): Mention 'I'. (Bug#69987) * etc/NEWS: Mark 'I' as documented. --- doc/emacs/buffers.texi | 62 ++++++++++++++++++++++++++++---------------------- etc/NEWS | 2 +- 2 files changed, 36 insertions(+), 28 deletions(-) diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi index 00160afd844..2786ff6ad65 100644 --- a/doc/emacs/buffers.texi +++ b/doc/emacs/buffers.texi @@ -223,8 +223,10 @@ the directory @file{~/cvs/emacs/src/}. You can list only buffers that are visiting files by giving the command a prefix argument, as in @kbd{C-u C-x C-b}. - @code{list-buffers} omits buffers whose names begin with a space, -unless they visit files: such buffers are used internally by Emacs. + By default, @code{list-buffers} omits buffers whose names begin with a +space, unless they visit files: such buffers are used internally by +Emacs (but the @kbd{I} command countermands that, @pxref{Several +Buffers}). @node Misc Buffer @section Miscellaneous Buffer Operations @@ -401,57 +403,57 @@ cursor motion commands can be used in this buffer. The following commands apply to the buffer described on the current line: @table @kbd -@item d @findex Buffer-menu-delete @kindex d @r{(Buffer Menu)} +@item d Flag the buffer for deletion (killing), then move point to the next line (@code{Buffer-menu-delete}). The deletion flag is indicated by the character @samp{D} on the line, before the buffer name. The deletion occurs only when you type the @kbd{x} command (see below). -@item C-d @findex Buffer-menu-delete-backwards @kindex C-d @r{(Buffer Menu)} +@item C-d Like @kbd{d}, but move point up instead of down (@code{Buffer-menu-delete-backwards}). -@item s @findex Buffer-menu-save @kindex s @r{(Buffer Menu)} +@item s Flag the buffer for saving (@code{Buffer-menu-save}). The save flag is indicated by the character @samp{S} on the line, before the buffer name. The saving occurs only when you type @kbd{x}. You may request both saving and deletion for the same buffer. -@item x @findex Buffer-menu-execute @kindex x @r{(Buffer Menu)} +@item x Perform all flagged deletions and saves (@code{Buffer-menu-execute}). -@item u @findex Buffer-menu-unmark @kindex u @r{(Buffer Menu)} +@item u Remove all flags from the current line, and move down (@code{Buffer-menu-unmark}). With a prefix argument, moves up after removing the flags. -@item @key{DEL} @findex Buffer-menu-backup-unmark @kindex DEL @r{(Buffer Menu)} +@item @key{DEL} Move to the previous line and remove all flags on that line (@code{Buffer-menu-backup-unmark}). -@item M-@key{DEL} @findex Buffer-menu-unmark-all-buffers @kindex M-DEL @r{(Buffer Menu)} +@item M-@key{DEL} Remove a particular flag from all lines (@code{Buffer-menu-unmark-all-buffers}). This asks for a single character, and unmarks buffers marked with that character; typing @key{RET} removes all marks. -@item U @findex Buffer-menu-unmark-all @kindex U @r{(Buffer Menu)} +@item U Remove all flags from all the lines (@code{Buffer-menu-unmark-all}). @end table @@ -465,21 +467,21 @@ the current line. They also accept a numeric argument as a repeat count. @table @kbd -@item ~ @findex Buffer-menu-not-modified @kindex ~ @r{(Buffer Menu)} +@item ~ Mark the buffer as unmodified (@code{Buffer-menu-not-modified}). @xref{Save Commands}. -@item % @findex Buffer-menu-toggle-read-only @kindex % @r{(Buffer Menu)} +@item % Toggle the buffer's read-only status (@code{Buffer-menu-toggle-read-only}). @xref{Misc Buffer}. -@item t @findex Buffer-menu-visit-tags-table @kindex t @r{(Buffer Menu)} +@item t Visit the buffer as a tags table (@code{Buffer-menu-visit-tags-table}). @xref{Select Tags Table}. @end table @@ -487,63 +489,63 @@ Visit the buffer as a tags table The following commands are used to select another buffer or buffers: @table @kbd -@item q @findex quit-window @kindex q @r{(Buffer Menu)} +@item q Quit the Buffer Menu (@code{quit-window}). The most recent formerly visible buffer is displayed in its place. -@item @key{RET} -@itemx f @findex Buffer-menu-this-window @kindex f @r{(Buffer Menu)} @kindex RET @r{(Buffer Menu)} +@item @key{RET} +@itemx f Select this line's buffer, replacing the @file{*Buffer List*} buffer in its window (@code{Buffer-menu-this-window}). -@item o @findex Buffer-menu-other-window @kindex o @r{(Buffer Menu)} +@item o Select this line's buffer in another window, as if by @kbd{C-x 4 b}, leaving @file{*Buffer List*} visible (@code{Buffer-menu-other-window}). -@item C-o @findex Buffer-menu-switch-other-window @kindex C-o @r{(Buffer Menu)} +@item C-o Display this line's buffer in another window, without selecting it (@code{Buffer-menu-switch-other-window}). -@item 1 @findex Buffer-menu-1-window @kindex 1 @r{(Buffer Menu)} +@item 1 Select this line's buffer in a full-frame window (@code{Buffer-menu-1-window}). -@item 2 @findex Buffer-menu-2-window @kindex 2 @r{(Buffer Menu)} +@item 2 Set up two windows on the current frame, with this line's buffer selected in one, and a previously current buffer (aside from @file{*Buffer List*}) in the other (@code{Buffer-menu-2-window}). -@item b @findex Buffer-menu-bury @kindex b @r{(Buffer Menu)} +@item b Bury this line's buffer (@code{Buffer-menu-bury}) (i.e., move it to the end of the buffer list). -@item m @findex Buffer-menu-mark @kindex m @r{(Buffer Menu)} +@item m Mark this line's buffer to be displayed in another window if you exit with the @kbd{v} command (@code{Buffer-menu-mark}). The display flag is indicated by the character @samp{>} at the beginning of the line. (A single buffer may not have both deletion and display flags.) -@item v @findex Buffer-menu-select @kindex v @r{(Buffer Menu)} +@item v Select this line's buffer, and also display in other windows any buffers flagged with the @kbd{m} command (@code{Buffer-menu-select}). If you have not flagged any buffers, this command is equivalent to @@ -553,31 +555,37 @@ If you have not flagged any buffers, this command is equivalent to The following commands affect the entire buffer list: @table @kbd -@item S @findex tabulated-list-sort @kindex S @r{(Buffer Menu)} +@item S Sort the Buffer Menu entries according to their values in the column at point. With a numeric prefix argument @var{n}, sort according to the @var{n}-th column (@code{tabulated-list-sort}). -@item @} @kindex @} @r{(Buffer Menu)} @findex tabulated-list-widen-current-column +@item @} Widen the current column width by @var{n} (the prefix numeric argument) characters. -@item @{ @kindex @{ @r{(Buffer Menu)} @findex tabulated-list-narrow-current-column +@item @{ Narrow the current column width by @var{n} (the prefix numeric argument) characters. -@item T @findex Buffer-menu-toggle-files-only @kindex T @r{(Buffer Menu)} +@item T Delete, or reinsert, lines for non-file buffers (@code{Buffer-menu-toggle-files-only}). This command toggles the inclusion of such buffers in the buffer list. + +@findex Buffer-menu-toggle-internal +@kindex I @r{(Buffer Menu)} +@item I +Toggle display of internal buffers, those whose names begin with a +space. @end table Normally, the buffer @file{*Buffer List*} is not updated diff --git a/etc/NEWS b/etc/NEWS index 19588fe8eeb..73af6ab773e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1453,7 +1453,7 @@ chat buffers use by default. It controls how buffers are divided into groups that are displayed with headings using Outline minor mode. ---- ++++ *** New command 'Buffer-menu-toggle-internal'. This command toggles the display of internal buffers in Buffer Menu mode; that is, buffers not visiting a file and whose names start with a space. -- cgit v1.2.3 From 9d3d77f12dac21c633cf10f111b0e4e574036b30 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 25 Mar 2024 15:12:42 +0200 Subject: Fix documentation of 'other-window-for-scrolling' * src/window.c (Fother_window_for_scrolling): More accurate documentation of how "the other" window is looked for. Suggested by Karthik Chikmagalur . --- src/window.c | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/src/window.c b/src/window.c index 8d4bde8d6db..3a8f864ec69 100644 --- a/src/window.c +++ b/src/window.c @@ -6452,13 +6452,16 @@ When calling from a program, supply as argument a number, nil, or `-'. */) } DEFUN ("other-window-for-scrolling", Fother_window_for_scrolling, Sother_window_for_scrolling, 0, 0, 0, - doc: /* Return the other window for \"other window scroll\" commands. -If in the minibuffer, `minibuffer-scroll-window' if non-nil -specifies the window. -Otherwise, if `other-window-scroll-buffer' is non-nil, a window -showing that buffer is used, popping the buffer up if necessary. -Finally, look for a neighboring window on the selected frame, -followed by all visible frames on the current terminal. */) + doc: /* Return \"the other\" window for \"other window scroll\" commands. +If in the minibuffer, and `minibuffer-scroll-window' is non-nil, +it specifies the window to use. +Otherwise, if `other-window-scroll-buffer' is a buffer, a window +showing that buffer is the window to use, popping it up if necessary. +Otherwise, if `other-window-scroll-default' is a function, call it, +and the window it returns is the window to use. +Finally, the function looks for a neighboring window on the selected +frame, followed by windows on all the visible frames on the current +terminal. */) (void) { Lisp_Object window; -- cgit v1.2.3 From 7fba25cf5344f5c3507aedf59e6ae099e7662508 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 25 Mar 2024 15:51:07 +0200 Subject: Fix removal of bookmark's fringe mark in Info and Dired * lisp/bookmark.el (bookmark-buffer-file-name): Support Info buffers. (bookmark--remove-fringe-mark): Call 'bookmark-buffer-file-name' instead of using 'buffer-file-name', which could be nil. (Bug#69974) --- lisp/bookmark.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 60dd61a5ac8..bf2357207d8 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -515,10 +515,11 @@ See user option `bookmark-fringe-mark'." (non-essential t) overlays found temp) (when (and pos filename) - (setq filename (expand-file-name filename)) + (setq filename (abbreviate-file-name (expand-file-name filename))) (dolist (buf (buffer-list)) (with-current-buffer buf - (when (equal filename buffer-file-name) + (when (equal filename + (ignore-errors (bookmark-buffer-file-name))) (setq overlays (save-excursion (goto-char pos) @@ -1192,6 +1193,8 @@ it to the name of the bookmark currently being set, advancing (if (stringp dired-directory) dired-directory (car dired-directory))) + ((and (boundp 'Info-current-file) (stringp Info-current-file)) + Info-current-file) (t (error "Buffer not visiting a file or directory"))))) (defvar bookmark--watch-already-asked-mtime nil -- cgit v1.2.3 From 38faacf353fb4c8efb027019a4619a386edfe62c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 25 Mar 2024 21:49:55 +0200 Subject: Improve documentation of in user manual * doc/emacs/basic.texi (Erasing): Document that deletes entire grapheme clusters. --- doc/emacs/basic.texi | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index f64b3995d25..abdfcb1ab8a 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -406,8 +406,8 @@ Delete the character before point, or the region if it is active (@code{delete-backward-char}). @item @key{Delete} -Delete the character after point, or the region if it is active -(@code{delete-forward-char}). +Delete the character or grapheme cluster after point, or the region if +it is active (@code{delete-forward-char}). @item C-d Delete the character after point (@code{delete-char}). @@ -438,11 +438,18 @@ with the @key{Delete} key; we will discuss @key{Delete} momentarily.) On some text terminals, Emacs may not recognize the @key{DEL} key properly. @xref{DEL Does Not Delete}, if you encounter this problem. +@cindex grapheme cluster, deletion +@cindex delete entire grapheme cluster The @key{Delete} (@code{delete-forward-char}) command deletes in the opposite direction: it deletes the character after point, i.e., the character under the cursor. If point was at the end of a line, this joins the following line onto this one. Like @kbd{@key{DEL}}, it deletes the text in the region if the region is active (@pxref{Mark}). +If the character after point is composed with following characters and +displayed as a single display unit, a so-called @dfn{grapheme cluster} +representing the entire sequence, @key{Delete} deletes the entire +sequence in one go. This is in contrast to @key{DEL} which always +deletes a single character, even if the character is composed. @kbd{C-d} (@code{delete-char}) deletes the character after point, similar to @key{Delete}, but regardless of whether the region is -- cgit v1.2.3 From 728bf2c9e5353e68b16808ae455223549c16efc6 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 26 Mar 2024 10:11:26 +0800 Subject: Prevent passwords from being recorded during text conversion * doc/lispref/commands.texi (Misc Events): Document new value of text-conversion-style. * java/org/gnu/emacs/EmacsService.java (EmacsService) : New constant. * java/org/gnu/emacs/EmacsView.java (onCreateInputConnection): Set TYPE_TEXT_VARIATION_PASSWORD and IME_FLAG_FORCE_ASII if mode is IC_MODE_PASSWORD. * lisp/subr.el (read-passwd): Set text-conversion-style to `password'. * src/androidgui.h (enum android_ic_mode): New value ANDROID_IC_MODE_PASSWORD. * src/androidterm.c (android_reset_conversion): Handle `password'. * src/buffer.c (syms_of_buffer) <&BVAR (current_buffer, text_conversion_style)>: Update doc string. * src/textconv.c (syms_of_textconv) : New DEFSYM. : Fix typos in doc string. --- doc/lispref/commands.texi | 9 ++++++++- java/org/gnu/emacs/EmacsService.java | 7 ++++--- java/org/gnu/emacs/EmacsView.java | 9 ++++++++- lisp/subr.el | 16 ++++++++++------ src/androidgui.h | 7 ++++--- src/androidterm.c | 2 ++ src/buffer.c | 7 +++++++ src/textconv.c | 3 ++- 8 files changed, 45 insertions(+), 15 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 6c8d42337d0..9ecdd23716c 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2464,7 +2464,7 @@ buffer-local variable @code{text-conversion-style}, which determines how an input method that wishes to make edits to buffer contents will behave. -This variable can have one of three values: +This variable can have one of four values: @table @code @item nil @@ -2475,6 +2475,13 @@ events will be sent instead of text conversion events. This means that the input method will be enabled, but @key{RET} will be sent whenever the input method wants to insert a new line. +@item password +This is largely identical to @code{action}, but also requests an input +method capable of inserting ASCII characters and instructs it not to +save input in locations from whence it might be subsequently retrieved +by features of the input method unfit to handle sensitive information, +such as text suggestions. + @item t This, or any other value, means that the input method will be enabled and make edits followed by @code{text-conversion} events. diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 4e863c750d3..446cd26a3dd 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -114,9 +114,10 @@ public final class EmacsService extends Service private ContentResolver resolver; /* Keep this in synch with androidgui.h. */ - public static final int IC_MODE_NULL = 0; - public static final int IC_MODE_ACTION = 1; - public static final int IC_MODE_TEXT = 2; + public static final int IC_MODE_NULL = 0; + public static final int IC_MODE_ACTION = 1; + public static final int IC_MODE_TEXT = 2; + public static final int IC_MODE_PASSWORD = 3; /* Display metrics used by font backends. */ public DisplayMetrics metrics; diff --git a/java/org/gnu/emacs/EmacsView.java b/java/org/gnu/emacs/EmacsView.java index 8398e4b784c..5b922212c0b 100644 --- a/java/org/gnu/emacs/EmacsView.java +++ b/java/org/gnu/emacs/EmacsView.java @@ -838,9 +838,16 @@ public final class EmacsView extends ViewGroup EmacsNative.requestSelectionUpdate (window.handle); } - if (mode == EmacsService.IC_MODE_ACTION) + if (mode == EmacsService.IC_MODE_ACTION + || mode == EmacsService.IC_MODE_PASSWORD) info.imeOptions |= EditorInfo.IME_ACTION_DONE; + if (mode == EmacsService.IC_MODE_PASSWORD) + { + info.imeOptions |= EditorInfo.IME_FLAG_FORCE_ASCII; + info.inputType |= InputType.TYPE_TEXT_VARIATION_PASSWORD; + } + /* Set the initial selection fields. */ info.initialSelStart = selection[0]; info.initialSelEnd = selection[1]; diff --git a/lisp/subr.el b/lisp/subr.el index 3de4412637f..90dbfc75d52 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3405,6 +3405,10 @@ with Emacs. Do not call it directly in your own packages." (+ i beg) (+ 1 i beg) 'help-echo "C-u: Clear password\nTAB: Toggle password visibility")))) +;; Actually in textconv.c. +(defvar overriding-text-conversion-style) +(declare-function set-text-conversion-style "textconv.c") + (defun read-passwd (prompt &optional confirm default) "Read a password, prompting with PROMPT, and return it. If optional CONFIRM is non-nil, read the password twice to make sure. @@ -3445,7 +3449,8 @@ by doing (clear-string STRING)." (add-hook 'post-command-hook #'read-passwd--hide-password nil t)) (unwind-protect (let ((enable-recursive-minibuffers t) - (read-hide-char (or read-hide-char ?*))) + (read-hide-char (or read-hide-char ?*)) + (overriding-text-conversion-style 'password)) (read-string prompt nil t default)) ; t = "no history" (when (buffer-live-p minibuf) (with-current-buffer minibuf @@ -3457,7 +3462,10 @@ by doing (clear-string STRING)." #'read-passwd--hide-password 'local) (kill-local-variable 'post-self-insert-hook) ;; And of course, don't keep the sensitive data around. - (erase-buffer)))))))) + (erase-buffer) + ;; Then restore the previous text conversion style. + (when (fboundp 'set-text-conversion-style) + (set-text-conversion-style text-conversion-style))))))))) (defvar read-number-history nil "The default history for the `read-number' function.") @@ -3867,10 +3875,6 @@ confusing to some users.") from--tty-menu-p) ; invoked via TTY menu use-dialog-box))) -;; Actually in textconv.c. -(defvar overriding-text-conversion-style) -(declare-function set-text-conversion-style "textconv.c") - (defun y-or-n-p (prompt) "Ask user a \"y or n\" question. Return t if answer is \"y\" and nil if it is \"n\". diff --git a/src/androidgui.h b/src/androidgui.h index d89aee51055..f941c7cc577 100644 --- a/src/androidgui.h +++ b/src/androidgui.h @@ -618,9 +618,10 @@ enum android_lookup_status enum android_ic_mode { - ANDROID_IC_MODE_NULL = 0, - ANDROID_IC_MODE_ACTION = 1, - ANDROID_IC_MODE_TEXT = 2, + ANDROID_IC_MODE_NULL = 0, + ANDROID_IC_MODE_ACTION = 1, + ANDROID_IC_MODE_TEXT = 2, + ANDROID_IC_MODE_PASSWORD = 3, }; enum android_stack_mode diff --git a/src/androidterm.c b/src/androidterm.c index ba9b6d3b8a9..c920375fdbe 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -6276,6 +6276,8 @@ android_reset_conversion (struct frame *f) if (NILP (style) || conversion_disabled_p ()) mode = ANDROID_IC_MODE_NULL; + else if (EQ (style, Qpassword)) + mode = ANDROID_IC_MODE_PASSWORD; else if (EQ (style, Qaction) || EQ (f->selected_window, f->minibuffer_window)) mode = ANDROID_IC_MODE_ACTION; diff --git a/src/buffer.c b/src/buffer.c index 07d19dfc078..9f954e1aba9 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5900,12 +5900,19 @@ Use Custom to set this variable and update the display. */); text_conversion_style), Qnil, doc: /* How the on screen keyboard's input method should insert in this buffer. + When nil, the input method will be disabled and an ordinary keyboard will be displayed in its place. + When the symbol `action', the input method will insert text directly, but will send `return' key events instead of inserting new line characters. Any other value means that the input method will insert text directly. +When the symbol `password', an input method capable of ASCII input will +be enabled, and will not save entered text where it will be retrieved +for text suggestions or other features not suited to handling sensitive +information, in addition to reporting `return' as when `action'. + If you need to make non-buffer local changes to this variable, use `overriding-text-conversion-style', which see. diff --git a/src/textconv.c b/src/textconv.c index 0941848dd09..9625c884e16 100644 --- a/src/textconv.c +++ b/src/textconv.c @@ -2318,6 +2318,7 @@ void syms_of_textconv (void) { DEFSYM (Qaction, "action"); + DEFSYM (Qpassword, "password"); DEFSYM (Qtext_conversion, "text-conversion"); DEFSYM (Qpush_mark, "push-mark"); DEFSYM (Qunderline, "underline"); @@ -2325,7 +2326,7 @@ syms_of_textconv (void) "overriding-text-conversion-style"); DEFVAR_LISP ("text-conversion-edits", Vtext_conversion_edits, - doc: /* List of buffers that were last edited as result of text conversion. + doc: /* List of buffers last edited as a result of text conversion. This list can be used while handling a `text-conversion' event to determine which changes have taken place. -- cgit v1.2.3 From b7b9a0a5c1afae07b8168e85dcf1fc37d29e98ef Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 26 Mar 2024 10:54:39 +0800 Subject: Prevent focus "stalemates" on Android * java/org/gnu/emacs/EmacsActivity.java (invalidateFocus1): New argument resetWhenChildless. (invalidateFocus): If a toplevel window has no focus window, transfer focus to the toplevel itself. --- java/org/gnu/emacs/EmacsActivity.java | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/java/org/gnu/emacs/EmacsActivity.java b/java/org/gnu/emacs/EmacsActivity.java index 06b9c0f005d..6ab6a709bef 100644 --- a/java/org/gnu/emacs/EmacsActivity.java +++ b/java/org/gnu/emacs/EmacsActivity.java @@ -84,7 +84,7 @@ public class EmacsActivity extends Activity }; public static void - invalidateFocus1 (EmacsWindow window) + invalidateFocus1 (EmacsWindow window, boolean resetWhenChildless) { if (window.view.isFocused ()) focusedWindow = window; @@ -92,7 +92,18 @@ public class EmacsActivity extends Activity synchronized (window.children) { for (EmacsWindow child : window.children) - invalidateFocus1 (child); + invalidateFocus1 (child, false); + + /* If no focused window was previously detected among WINDOW's + children and RESETWHENCHILDLESS is set (implying it is a + toplevel window), request that it be focused, to avoid + creating a situation where no windows exist focused or can be + transferred the input focus by user action. */ + if (focusedWindow == null && resetWhenChildless) + { + window.view.requestFocus (); + focusedWindow = window; + } } } @@ -110,7 +121,7 @@ public class EmacsActivity extends Activity for (EmacsActivity activity : focusedActivities) { if (activity.window != null) - invalidateFocus1 (activity.window); + invalidateFocus1 (activity.window, focusedWindow == null); } /* Send focus in- and out- events to the previous and current -- cgit v1.2.3 From 95d9e6eb6b48b9b51a0b9d7de4a0c4eeed6c7a70 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 26 Mar 2024 08:20:54 +0100 Subject: * Don't install unnecessary trampolines (bug#69573) (don't merge) * lisp/emacs-lisp/comp.el (comp-subr-trampoline-install): Check that subr-name actually matches the target subr. --- lisp/emacs-lisp/comp.el | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 6b65a375ea0..a3c6bb59469 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -714,13 +714,15 @@ This are essential for the trampoline machinery to work properly.") (when (memq subr-name comp-warn-primitives) (warn "Redefining `%s' might break native compilation of trampolines." subr-name)) - (unless (or (null native-comp-enable-subr-trampolines) - (memq subr-name native-comp-never-optimize-functions) - (gethash subr-name comp-installed-trampolines-h)) - (cl-assert (subr-primitive-p (symbol-function subr-name))) - (when-let ((trampoline (or (comp-trampoline-search subr-name) - (comp-trampoline-compile subr-name)))) - (comp--install-trampoline subr-name trampoline)))) + (let ((subr (symbol-function subr-name))) + (unless (or (not (string= subr-name (subr-name subr))) ;; (bug#69573) + (null native-comp-enable-subr-trampolines) + (memq subr-name native-comp-never-optimize-functions) + (gethash subr-name comp-installed-trampolines-h)) + (cl-assert (subr-primitive-p subr)) + (when-let ((trampoline (or (comp-trampoline-search subr-name) + (comp-trampoline-compile subr-name)))) + (comp--install-trampoline subr-name trampoline))))) (cl-defstruct (comp-vec (:copier nil)) -- cgit v1.2.3 From 8cc67dbcec0753c5579e63bf82bfe247debe222c Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 26 Mar 2024 11:14:08 +0100 Subject: Fix native comp prediction on null functionp tested objects * lisp/emacs-lisp/comp.el (comp-known-predicates) (comp-known-predicates-h): Update. (comp--pred-to-pos-cstr, comp--pred-to-neg-cstr): New functions. (comp--add-cond-cstrs): Make use of them. * test/src/comp-tests.el (comp-tests-type-spec-tests): Add a test. --- lisp/emacs-lisp/comp.el | 101 +++++++++++++++++++++++++++--------------------- test/src/comp-tests.el | 9 ++++- 2 files changed, 64 insertions(+), 46 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 4ddf90349d1..9976a58f893 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -193,49 +193,52 @@ Useful to hook into pass checkers.") ;; cl-macs.el. We can't use `cl-deftype-satisfies' directly as the ;; relation type <-> predicate is not bijective (bug#45576). (defconst comp-known-predicates - '((arrayp . array) - (atom . atom) - (bool-vector-p . bool-vector) - (booleanp . boolean) - (bufferp . buffer) - (char-table-p . char-table) - (characterp . fixnum) - (consp . cons) - (floatp . float) - (framep . frame) - (functionp . (or function symbol cons)) - (hash-table-p . hash-table) - (integer-or-marker-p . integer-or-marker) - (integerp . integer) - (keywordp . keyword) - (listp . list) - (markerp . marker) - (natnump . (integer 0 *)) - (null . null) - (number-or-marker-p . number-or-marker) - (numberp . number) - (numberp . number) - (obarrayp . obarray) - (overlayp . overlay) - (processp . process) - (sequencep . sequence) - (stringp . string) - (subrp . subr) - (symbol-with-pos-p . symbol-with-pos) - (symbolp . symbol) - (vectorp . vector) - (windowp . window)) - "Alist predicate -> matched type specifier.") + '((arrayp array) + (atom atom) + (bool-vector-p bool-vector) + (booleanp boolean) + (bufferp buffer) + (char-table-p char-table) + (characterp fixnum) + (consp cons) + (floatp float) + (framep frame) + (functionp (or function symbol cons) (not function)) + (hash-table-p hash-table) + (integer-or-marker-p integer-or-marker) + (integerp integer) + (keywordp keyword) + (listp list) + (markerp marker) + (natnump (integer 0 *)) + (null null) + (number-or-marker-p number-or-marker) + (numberp number) + (numberp number) + (obarrayp obarray) + (overlayp overlay) + (processp process) + (sequencep sequence) + (stringp string) + (subrp subr) + (symbol-with-pos-p symbol-with-pos) + (symbolp symbol) + (vectorp vector) + (windowp window)) + "(PREDICATE TYPE-IF-SATISFIED ?TYPE-IF-NOT-SATISFIED).") (defconst comp-known-predicates-h (cl-loop with comp-ctxt = (make-comp-cstr-ctxt) with h = (make-hash-table :test #'eq) - for (pred . type-spec) in comp-known-predicates - for cstr = (comp-type-spec-to-cstr type-spec) - do (puthash pred cstr h) + for (pred . type-specs) in comp-known-predicates + for pos-cstr = (comp-type-spec-to-cstr (car type-specs)) + for neg-cstr = (if (length> type-specs 1) + (comp-type-spec-to-cstr (cl-second type-specs)) + (comp-cstr-negation-make pos-cstr)) + do (puthash pred (cons pos-cstr neg-cstr) h) finally return h) - "Hash table function -> `comp-constraint'.") + "Hash table FUNCTION -> (POS-CSTR . NEG-CSTR).") (defun comp--known-predicate-p (predicate) "Return t if PREDICATE is known." @@ -243,10 +246,14 @@ Useful to hook into pass checkers.") (gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt))) t)) -(defun comp--pred-to-cstr (predicate) - "Given PREDICATE, return the corresponding constraint." - ;; FIXME: Unify those two hash tables? - (or (gethash predicate comp-known-predicates-h) +(defun comp--pred-to-pos-cstr (predicate) + "Given PREDICATE, return the corresponding positive constraint." + (or (car-safe (gethash predicate comp-known-predicates-h)) + (gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt)))) + +(defun comp--pred-to-neg-cstr (predicate) + "Given PREDICATE, return the corresponding negative constraint." + (or (cdr-safe (gethash predicate comp-known-predicates-h)) (gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt)))) (defconst comp-symbol-values-optimizable '(most-positive-fixnum @@ -2033,7 +2040,6 @@ TARGET-BB-SYM is the symbol name of the target block." (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks)) (cl-loop with target-mvar = (comp--cond-cstrs-target-mvar op (car insns-seq) b) - with cstr = (comp--pred-to-cstr fun) for branch-target-cell on blocks for branch-target = (car branch-target-cell) for negated in '(t nil) @@ -2041,7 +2047,10 @@ TARGET-BB-SYM is the symbol name of the target block." do (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) - (comp--emit-assume 'and target-mvar cstr block-target negated)) + (comp--emit-assume 'and target-mvar (if negated + (comp--pred-to-neg-cstr fun) + (comp--pred-to-pos-cstr fun)) + block-target nil)) finally (cl-return-from in-the-basic-block))) ;; Match predicate on the negated branch (unless). (`((set ,(and (pred comp-mvar-p) cmp-res) @@ -2052,7 +2061,6 @@ TARGET-BB-SYM is the symbol name of the target block." (cond-jump ,neg-cmp-res ,(pred comp-mvar-p) . ,blocks)) (cl-loop with target-mvar = (comp--cond-cstrs-target-mvar op (car insns-seq) b) - with cstr = (comp--pred-to-cstr fun) for branch-target-cell on blocks for branch-target = (car branch-target-cell) for negated in '(nil t) @@ -2060,7 +2068,10 @@ TARGET-BB-SYM is the symbol name of the target block." do (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) - (comp--emit-assume 'and target-mvar cstr block-target negated)) + (comp--emit-assume 'and target-mvar (if negated + (comp--pred-to-neg-cstr fun) + (comp--pred-to-pos-cstr fun)) + block-target nil)) finally (cl-return-from in-the-basic-block)))) (setf prev-insns-seq insns-seq)))) diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index fbcb6ca9560..b2fd2f68826 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -1496,7 +1496,14 @@ Return a list of results." (if (comp-foo-p x) x (error ""))) - 'comp-foo))) + 'comp-foo) + + ;; 80 + ((defun comp-tests-ret-type-spec-f (x) + (if (functionp x) + (error "") + x)) + '(not function)))) (defun comp-tests-define-type-spec-test (number x) `(comp-deftest ,(intern (format "ret-type-spec-%d" number)) () -- cgit v1.2.3 From 351d98535dc10f8338b8a418e331cc0af488087b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 26 Mar 2024 14:24:16 +0200 Subject: ; Fix recently-changed documentation * src/buffer.c (syms_of_buffer) : * doc/lispref/commands.texi (Misc Events): Fix wording and punctuation of the documentation. --- doc/lispref/commands.texi | 8 ++++---- src/buffer.c | 21 ++++++++++++--------- 2 files changed, 16 insertions(+), 13 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 9ecdd23716c..4fe4969c0db 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2477,10 +2477,10 @@ be sent whenever the input method wants to insert a new line. @item password This is largely identical to @code{action}, but also requests an input -method capable of inserting ASCII characters and instructs it not to -save input in locations from whence it might be subsequently retrieved -by features of the input method unfit to handle sensitive information, -such as text suggestions. +method capable of inserting ASCII characters, and instructs it not to +save input in locations from which it might be subsequently retrieved +by features of the input method that cannot handle sensitive +information, such as text suggestions. @item t This, or any other value, means that the input method will be enabled diff --git a/src/buffer.c b/src/buffer.c index 9f954e1aba9..291c7d3f911 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5901,24 +5901,27 @@ Use Custom to set this variable and update the display. */); Qnil, doc: /* How the on screen keyboard's input method should insert in this buffer. -When nil, the input method will be disabled and an ordinary keyboard +If nil, the input method will be disabled and an ordinary keyboard will be displayed in its place. -When the symbol `action', the input method will insert text directly, but -will send `return' key events instead of inserting new line characters. -Any other value means that the input method will insert text directly. +If the value is the symbol `action', the input method will insert text +directly, but will send `return' key events instead of inserting new +line characters. + +If the value is the symbol `password', an input method capable of ASCII +input will be enabled, and will not save the entered text where it will +be retrieved for text suggestions or other features not suitable for +handling sensitive information, in addition to reporting `return' as +when `action'. -When the symbol `password', an input method capable of ASCII input will -be enabled, and will not save entered text where it will be retrieved -for text suggestions or other features not suited to handling sensitive -information, in addition to reporting `return' as when `action'. +Any other value means that the input method will insert text directly. If you need to make non-buffer local changes to this variable, use `overriding-text-conversion-style', which see. This variable does not take immediate effect when set; rather, it takes effect upon the next redisplay after the selected window or -buffer changes. */); +its buffer changes. */); DEFVAR_LISP ("kill-buffer-query-functions", Vkill_buffer_query_functions, doc: /* List of functions called with no args to query before killing a buffer. -- cgit v1.2.3 From 004f2493a542dd0b804a30e97fc612884ca440f4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 26 Mar 2024 13:14:15 -0400 Subject: cl-preloaded.el: Fix the type lattice We generally want types to form not just a DAG but a lattice. If objects can be both `keyword` and `symbol-with-pos`, this means there should be a more precise type describing this intersection. If we ever find the need for such a refinement, we could add such a `keyword-with-pos` type, but here I took the simpler route of treating `keyword` not as a proper built-in type but as a second-class type like `natnum`. While fixing this problem, also fix the problem we had where `functionp` was not quite adequate to characterize objects of type `function`, by introducing a new predicate `cl-functionp` for that. * lisp/emacs-lisp/cl-preloaded.el (cl-functionp): New function. (function): Use it. (keyword): Don't declare it as a built-in type. (user-ptrp): Remove redundant declaration. * lisp/emacs-lisp/cl-generic.el (cl--generic--unreachable-types): Delete constant. (cl-generic-generalizers): Remove corresponding test. * lisp/emacs-lisp/cl-macs.el (cl-deftype-satisfies): Add entry for `keyword` type. * lisp/emacs-lisp/comp.el (comp-known-predicates): Fix type for negative result of `characterp`. Remove duplicate `numberp` entry. Fix types for `keywordp` now that `keyword` is not a built-in type any more. * test/src/data-tests.el (data-tests--cl-type-of): Add a few cases. Remove workaround for `function`. --- etc/NEWS | 8 +++++--- lisp/emacs-lisp/cl-generic.el | 11 ++--------- lisp/emacs-lisp/cl-macs.el | 1 + lisp/emacs-lisp/cl-preloaded.el | 17 +++++++++++------ lisp/emacs-lisp/comp.el | 6 +++--- test/src/data-tests.el | 30 +++++++++++++++--------------- 6 files changed, 37 insertions(+), 36 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 73af6ab773e..25c4efa590f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1700,9 +1700,11 @@ This function is like 'type-of' except that it sometimes returns a more precise type. For example, for nil and t it returns 'null' and 'boolean' respectively, instead of just 'symbol'. -** New function `primitive-function-p`. -This is like `subr-primitive-p` except that it returns t only if the -argument is a function rather than a special-form. +** New functions `primitive-function-p` and `cl-functionp`. +`primitive-function-p` is like `subr-primitive-p` except that it returns +t only if the argument is a function rather than a special-form, +and `cl-functionp` is like `functionp` except it return nil +for lists and symbols. ** Built-in types have now corresponding classes. At the Lisp level, this means that things like (cl-find-class 'integer) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 62abe8d1589..8bda857afdd 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1332,11 +1332,6 @@ These match if the argument is `eql' to VAL." ;;; Dispatch on "normal types". -(defconst cl--generic--unreachable-types - ;; FIXME: Try to make that list empty? - '(keyword) - "Built-in classes on which we cannot dispatch for technical reasons.") - (defun cl--generic-type-specializers (tag &rest _) (and (symbolp tag) (let ((class (cl--find-class tag))) @@ -1350,14 +1345,12 @@ These match if the argument is `eql' to VAL." (cl-defmethod cl-generic-generalizers :extra "typeof" (type) "Support for dispatch on types. This currently works for built-in types and types built on top of records." - ;; FIXME: Add support for other types accepted by `cl-typep' such - ;; as `character', `face', `function', ... + ;; FIXME: Add support for other "types" accepted by `cl-typep' such + ;; as `character', `face', `keyword', ...? (or (and (symbolp type) (not (eq type t)) ;; Handled by the `t-generalizer'. (let ((class (cl--find-class type))) - (when (memq type cl--generic--unreachable-types) - (error "Dispatch on %S is currently not supported" type)) (memq (type-of class) '(built-in-class cl-structure-class eieio--class))) (list cl--generic-typeof-generalizer)) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index ab31946d8ab..051cd992fc1 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3467,6 +3467,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." '((base-char . characterp) ;Could be subtype of `fixnum'. (character . natnump) ;Could be subtype of `fixnum'. (command . commandp) ;Subtype of closure & subr. + (keyword . keywordp) ;Would need `keyword-with-pos`. (natnum . natnump) ;Subtype of fixnum & bignum. (real . numberp) ;Not clear where it would fit. )) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 35a8d79a1cd..6128db05c61 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -349,6 +349,14 @@ The `slots' (and hence `index-table') are currently unused." ;; so the DAG of OClosure types is "orthogonal" to the distinction ;; between interpreted and compiled functions. +(defun cl-functionp (object) + "Return non-nil if OBJECT is a member of type `function'. +This is like `functionp' except that it returns nil for all lists and symbols, +regardless if `funcall' would accept to call them." + (memq (cl-type-of object) + '(primitive-function subr-native-elisp module-function + interpreted-function byte-code-function))) + (cl--define-built-in-type t nil "Abstract supertype of everything.") (cl--define-built-in-type atom t "Abstract supertype of anything but cons cells." :predicate atom) @@ -356,11 +364,9 @@ The `slots' (and hence `index-table') are currently unused." (cl--define-built-in-type tree-sitter-compiled-query atom) (cl--define-built-in-type tree-sitter-node atom) (cl--define-built-in-type tree-sitter-parser atom) -(declare-function user-ptrp "data.c") (when (fboundp 'user-ptrp) (cl--define-built-in-type user-ptr atom nil - ;; FIXME: Shouldn't it be called - ;; `user-ptr-p'? + ;; FIXME: Shouldn't it be called `user-ptr-p'? :predicate user-ptrp)) (cl--define-built-in-type font-object atom) (cl--define-built-in-type font-entity atom) @@ -410,8 +416,6 @@ The `slots' (and hence `index-table') are currently unused." The size depends on the Emacs version and compilation options. For this build of Emacs it's %dbit." (1+ (logb (1+ most-positive-fixnum))))) -(cl--define-built-in-type keyword (symbol) - "Type of those symbols whose first char is `:'.") (cl--define-built-in-type boolean (symbol) "Type of the canonical boolean values, i.e. either nil or t.") (cl--define-built-in-type symbol-with-pos (symbol) @@ -431,7 +435,8 @@ For this build of Emacs it's %dbit." ;; Example of slots we could document. (car car) (cdr cdr)) (cl--define-built-in-type function (atom) - "Abstract supertype of function values.") + "Abstract supertype of function values." + :predicate cl-functionp) (cl--define-built-in-type compiled-function (function) "Abstract type of functions that have been compiled.") (cl--define-built-in-type byte-code-function (compiled-function) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 9976a58f893..2544be85bb2 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -193,13 +193,14 @@ Useful to hook into pass checkers.") ;; cl-macs.el. We can't use `cl-deftype-satisfies' directly as the ;; relation type <-> predicate is not bijective (bug#45576). (defconst comp-known-predicates + ;; FIXME: Auto-generate (most of) it from `cl-deftype-satifies'? '((arrayp array) (atom atom) (bool-vector-p bool-vector) (booleanp boolean) (bufferp buffer) (char-table-p char-table) - (characterp fixnum) + (characterp fixnum t) (consp cons) (floatp float) (framep frame) @@ -207,14 +208,13 @@ Useful to hook into pass checkers.") (hash-table-p hash-table) (integer-or-marker-p integer-or-marker) (integerp integer) - (keywordp keyword) + (keywordp symbol t) (listp list) (markerp marker) (natnump (integer 0 *)) (null null) (number-or-marker-p number-or-marker) (numberp number) - (numberp number) (obarrayp obarray) (overlayp overlay) (processp process) diff --git a/test/src/data-tests.el b/test/src/data-tests.el index daa49e671b5..753d74c02ec 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -845,10 +845,12 @@ comparing the subr with a much slower Lisp implementation." ;; Note: This doesn't work for list/vector structs since those types ;; are too difficult/unreliable to detect (so `cl-type-of' only says ;; it's a `cons' or a `vector'). - (dolist (val (list -2 10 (expt 2 128) nil t 'car + (dolist (val (list -2 10 (expt 2 128) nil t 'car :car (symbol-function 'car) (symbol-function 'progn) - (position-symbol 'car 7))) + (eval '(lambda (x) (+ x 1)) t) + (position-symbol 'car 7) + (position-symbol :car 7))) (let* ((type (cl-type-of val)) (class (cl-find-class type)) (alltypes (cl--class-allparents class)) @@ -858,19 +860,17 @@ comparing the subr with a much slower Lisp implementation." (dolist (parent alltypes) (should (cl-typep val parent)) (dolist (subtype (cl--class-children (cl-find-class parent))) - (unless (memq subtype alltypes) - (unless (memq subtype - ;; FIXME: Some types don't have any associated - ;; predicate, - '( font-spec font-entity font-object - finalizer condvar terminal - native-comp-unit interpreted-function - tree-sitter-compiled-query - tree-sitter-node tree-sitter-parser - ;; `functionp' also matches things of type - ;; `symbol' and `cons'. - function)) - (should-not (cl-typep val subtype))))))))) + (when (and (not (memq subtype alltypes)) + (built-in-class-p (cl-find-class subtype)) + (not (memq subtype + ;; FIXME: Some types don't have any associated + ;; predicate, + '( font-spec font-entity font-object + finalizer condvar terminal + native-comp-unit interpreted-function + tree-sitter-compiled-query + tree-sitter-node tree-sitter-parser)))) + (should-not (cl-typep val subtype)))))))) ;;; data-tests.el ends here -- cgit v1.2.3 From ed85132740b39c147647be1831abb64a3f514d57 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Tue, 26 Mar 2024 20:59:43 +0000 Subject: CC Mode: Handle C++20's if consteval * lisp/progmodes/cc-engine.el (c-after-conditional): Handle the new keyword in place of a paren sexp after `if'. * lisp/progmodes/cc-langs.el (c-negation-op-re) (c-paren-clause-kwds, c-paren-clause-key) (c-block-stmt-with-kwds, c-block-stmt-with-key): New lang-consts/vars. * if-11.cc, if-11.res: New test files. --- lisp/progmodes/cc-engine.el | 22 +++++++++++++++------- lisp/progmodes/cc-langs.el | 30 ++++++++++++++++++++++++++++++ 2 files changed, 45 insertions(+), 7 deletions(-) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index ea4ee3d7b7c..8c505e9556a 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -12346,13 +12346,21 @@ comment at the start of cc-engine.el for more info." (zerop (c-backward-token-2 1 t lim)) t) (or (looking-at c-block-stmt-1-key) - (and (eq (char-after) ?\() - (zerop (c-backward-token-2 1 t lim)) - (if (looking-at c-block-stmt-hangon-key) - (zerop (c-backward-token-2 1 t lim)) - t) - (or (looking-at c-block-stmt-2-key) - (looking-at c-block-stmt-1-2-key)))) + (or + (and + (eq (char-after) ?\() + (zerop (c-backward-token-2 1 t lim)) + (if (looking-at c-block-stmt-hangon-key) + (zerop (c-backward-token-2 1 t lim)) + t) + (or (looking-at c-block-stmt-2-key) + (looking-at c-block-stmt-1-2-key))) + (and (looking-at c-paren-clause-key) + (zerop (c-backward-token-2 1 t lim)) + (if (looking-at c-negation-op-re) + (zerop (c-backward-token-2 1 t lim)) + t) + (looking-at c-block-stmt-with-key)))) (point)))) (defun c-after-special-operator-id (&optional lim) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index ae2389c75c2..06b919f26fd 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -1599,6 +1599,12 @@ operators." (c-lang-defvar c-assignment-op-regexp (c-lang-const c-assignment-op-regexp)) +(c-lang-defconst c-negation-op-re + ;; Regexp matching the negation operator. + t "!\\([^=]\\|$\\)") + +(c-lang-defvar c-negation-op-re (c-lang-const c-negation-op-re)) + (c-lang-defconst c-arithmetic-operators "List of all arithmetic operators, including \"+=\", etc." ;; Note: in the following, there are too many operators for AWK and IDL. @@ -3163,6 +3169,30 @@ Keywords here should also be in `c-block-stmt-1-kwds'." (c-lang-const c-block-stmt-2-kwds))))) (c-lang-defvar c-opt-block-stmt-key (c-lang-const c-opt-block-stmt-key)) +(c-lang-defconst c-paren-clause-kwds + "Keywords which can stand in the place of paren sexps in conditionals. +This applies only to conditionals in `c-block-stmt-with-kwds'." + t nil + c++ '("consteval")) + +(c-lang-defconst c-paren-clause-key + ;; Regexp matching a keyword in `c-paren-clause-kwds'. + t (c-make-keywords-re t + (c-lang-const c-paren-clause-kwds))) +(c-lang-defvar c-paren-clause-key (c-lang-const c-paren-clause-key)) + +(c-lang-defconst c-block-stmt-with-kwds + "Statement keywords which can be followed by a keyword instead of a parens. +Such a keyword is a member of `c-paren-clause-kwds." + t nil + c++ '("if")) + +(c-lang-defconst c-block-stmt-with-key + ;; Regexp matching a keyword in `c-block-stmt-with-kwds'. + t (c-make-keywords-re t + (c-lang-const c-block-stmt-with-kwds))) +(c-lang-defvar c-block-stmt-with-key (c-lang-const c-block-stmt-with-key)) + (c-lang-defconst c-simple-stmt-kwds "Statement keywords followed by an expression or nothing." t '("break" "continue" "goto" "return") -- cgit v1.2.3 From e5d824b632a68430535f6e94d911871eb0f3f772 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 26 Mar 2024 17:27:29 -0400 Subject: cl-preloaded.el: Partly revert last change The change caused type-check errors in auth-source where they use `:type function` constraints on object slots and expect those to be able to hold symbols. * lisp/emacs-lisp/cl-preloaded.el (function): Revert last change. * test/src/data-tests.el (data-tests--cl-type-of): Use `cl-functionp` rather than `functionp` to test `function`. --- lisp/emacs-lisp/cl-preloaded.el | 6 +++++- test/src/data-tests.el | 4 +++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 6128db05c61..260478c3a39 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -436,7 +436,11 @@ For this build of Emacs it's %dbit." (car car) (cdr cdr)) (cl--define-built-in-type function (atom) "Abstract supertype of function values." - :predicate cl-functionp) + ;; FIXME: Historically, (cl-typep FOO 'function) called `functionp', + ;; so while `cl-functionp' would be the more correct predicate, it + ;; would breaks existing code :-( + ;; :predicate cl-functionp + ) (cl--define-built-in-type compiled-function (function) "Abstract type of functions that have been compiled.") (cl--define-built-in-type byte-code-function (compiled-function) diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 753d74c02ec..a1959f62fd3 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -870,7 +870,9 @@ comparing the subr with a much slower Lisp implementation." native-comp-unit interpreted-function tree-sitter-compiled-query tree-sitter-node tree-sitter-parser)))) - (should-not (cl-typep val subtype)))))))) + (cond + ((eq subtype 'function) (cl-functionp val)) + (t (should-not (cl-typep val subtype)))))))))) ;;; data-tests.el ends here -- cgit v1.2.3 From 48b6e6bd80f2783c6320db1f7e8fb0b3f44e2e9d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 26 Mar 2024 17:41:42 -0400 Subject: * lisp/help.el (help-function-arglist): Don't `substitute-command-keys` --- lisp/help.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/help.el b/lisp/help.el index bafe6032942..1ef46e394f3 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -2353,7 +2353,7 @@ the same names as used in the original source code, when possible." ((or (and (byte-code-function-p def) (integerp (aref def 0))) (subrp def) (module-function-p def)) (or (when preserve-names - (let* ((doc (condition-case nil (documentation def) (error nil))) + (let* ((doc (condition-case nil (documentation def 'raw) (error nil))) (docargs (if doc (car (help-split-fundoc doc nil)))) (arglist (if docargs (cdar (read-from-string (downcase docargs))))) -- cgit v1.2.3 From 5a7c46355be1b5a9a8dbfb36ba44969963a3f558 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 27 Mar 2024 10:03:15 +0800 Subject: Remove IME_FLAG_FORCE_ASCII from password input IME flags * java/org/gnu/emacs/EmacsView.java (onCreateInputConnection): Passwords might also be non-ASCII, and this flag apparently requests an IME limited to ASCII characters, rather than just capable of ASCII input. --- java/org/gnu/emacs/EmacsView.java | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/java/org/gnu/emacs/EmacsView.java b/java/org/gnu/emacs/EmacsView.java index 5b922212c0b..109208b2518 100644 --- a/java/org/gnu/emacs/EmacsView.java +++ b/java/org/gnu/emacs/EmacsView.java @@ -843,10 +843,7 @@ public final class EmacsView extends ViewGroup info.imeOptions |= EditorInfo.IME_ACTION_DONE; if (mode == EmacsService.IC_MODE_PASSWORD) - { - info.imeOptions |= EditorInfo.IME_FLAG_FORCE_ASCII; - info.inputType |= InputType.TYPE_TEXT_VARIATION_PASSWORD; - } + info.inputType |= InputType.TYPE_TEXT_VARIATION_PASSWORD; /* Set the initial selection fields. */ info.initialSelStart = selection[0]; -- cgit v1.2.3 From 5efa2ddf62d4876fb62f23b571f4cc0af5885639 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Tue, 26 Mar 2024 08:44:25 -0400 Subject: Correctly check buffer mtime when displaying xref matches This was just a typo: we were checking the modification time of current-buffer instead of checking the modification time of the passed-in buffer. This caused matches to not be shown if they weren't present in the current in-Emacs state of the buffer. This was easily reproduced by writing a string to a file outside Emacs, then searching for that string with e.g. project-find-regexp. The string would seemingly not be found, although in reality it was found, just not displayed. * lisp/progmodes/xref.el (xref--find-file-buffer): Check buf, not current-buffer (bug#70008). --- lisp/progmodes/xref.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 717b837a2e5..755c3db04fd 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -2176,7 +2176,7 @@ Such as the current syntax table and the applied syntax properties." (or (buffer-modified-p buf) (unless xref--hits-remote-id - (not (verify-visited-file-modtime (current-buffer)))))) + (not (verify-visited-file-modtime buf))))) ;; We can't use buffers whose contents diverge from disk (bug#54025). (setq buf nil)) (setq xref--last-file-buffer (cons file buf)))) -- cgit v1.2.3 From 1552f8345d8cbea282d171bffe5a22e330eeed37 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 28 Mar 2024 05:41:52 +0200 Subject: (project-current): Add binding for 'non-essential' * lisp/progmodes/project.el (project-current): Add binding for 'non-essential' (bug#69584). --- lisp/progmodes/project.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index ac18aceadcf..a10e24f3e28 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -229,7 +229,8 @@ See the doc string of `project-find-functions' for the general form of the project instance object." (unless directory (setq directory (or project-current-directory-override default-directory))) - (let ((pr (project--find-in-directory directory))) + (let ((pr (project--find-in-directory directory)) + (non-essential (not maybe-prompt))) (cond (pr) ((unless project-current-directory-override -- cgit v1.2.3 From f1fe13ea057237f5426c93876488cb95be86156c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 28 Mar 2024 00:06:00 -0400 Subject: (pcase-mutually-exclusive): Use auto-generated table MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The `pcase-mutually-exclusive-predicates` table was not very efficient since it grew like O(N²) with the number of predicates. Replace it with an O(N) table that's auto-generated from the `built-in-class` objects. * lisp/emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates): Delete variable. (pcase--subtype-bitsets): New function and constant. (pcase--mutually-exclusive-p): Use them. * lisp/emacs-lisp/cl-preloaded.el (built-in-class): Don't inline. --- lisp/emacs-lisp/cl-preloaded.el | 1 + lisp/emacs-lisp/pcase.el | 134 +++++++++++++++++++++--------------- test/lisp/emacs-lisp/pcase-tests.el | 14 ++++ 3 files changed, 93 insertions(+), 56 deletions(-) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 260478c3a39..d23ad3972a9 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -303,6 +303,7 @@ (cl-defstruct (built-in-class (:include cl--class) + (:noinline t) (:constructor nil) (:constructor built-in-class--make (name docstring parents)) (:copier nil)) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 40d917795e3..e2d0c0dc068 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -623,62 +623,83 @@ recording whether the var has been referenced by earlier parts of the match." (defun pcase--and (match matches) (if matches `(and ,match ,@matches) match)) -(defconst pcase-mutually-exclusive-predicates - '((symbolp . integerp) - (symbolp . numberp) - (symbolp . consp) - (symbolp . arrayp) - (symbolp . vectorp) - (symbolp . stringp) - (symbolp . byte-code-function-p) - (symbolp . compiled-function-p) - (symbolp . recordp) - (null . integerp) - (null . numberp) - (null . numberp) - (null . consp) - (null . arrayp) - (null . vectorp) - (null . stringp) - (null . byte-code-function-p) - (null . compiled-function-p) - (null . recordp) - (integerp . consp) - (integerp . arrayp) - (integerp . vectorp) - (integerp . stringp) - (integerp . byte-code-function-p) - (integerp . compiled-function-p) - (integerp . recordp) - (numberp . consp) - (numberp . arrayp) - (numberp . vectorp) - (numberp . stringp) - (numberp . byte-code-function-p) - (numberp . compiled-function-p) - (numberp . recordp) - (consp . arrayp) - (consp . atom) - (consp . vectorp) - (consp . stringp) - (consp . byte-code-function-p) - (consp . compiled-function-p) - (consp . recordp) - (arrayp . byte-code-function-p) - (arrayp . compiled-function-p) - (vectorp . byte-code-function-p) - (vectorp . compiled-function-p) - (vectorp . recordp) - (stringp . vectorp) - (stringp . recordp) - (stringp . byte-code-function-p) - (stringp . compiled-function-p))) - +(defun pcase--subtype-bitsets () + (let ((built-in-types ())) + (mapatoms (lambda (sym) + (let ((class (get sym 'cl--class))) + (when (and (built-in-class-p class) + (get sym 'cl-deftype-satisfies)) + (push (list sym + (get sym 'cl-deftype-satisfies) + (cl--class-allparents class)) + built-in-types))))) + ;; The "true" predicate for `function' type is `cl-functionp'. + (setcar (nthcdr 1 (assq 'function built-in-types)) 'cl-functionp) + ;; Sort the types from deepest in the hierarchy so all children + ;; are processed before their parent. It also gives lowest + ;; numbers to those types that are subtypes of the largest number + ;; of types, which minimize the need to use bignums. + (setq built-in-types (sort built-in-types + (lambda (x y) + (> (length (nth 2 x)) (length (nth 2 y)))))) + + (let ((bitsets (make-hash-table)) + (i 1)) + (dolist (x built-in-types) + ;; Don't dedicate any bit to those predicates which already + ;; have a bitset, since it means they're already represented + ;; by their subtypes. + (unless (and (nth 1 x) (gethash (nth 1 x) bitsets)) + (dolist (parent (nth 2 x)) + (let ((pred (nth 1 (assq parent built-in-types)))) + (unless (or (eq parent t) (null pred)) + (puthash pred (+ i (gethash pred bitsets 0)) + bitsets)))) + (setq i (+ i i)))) + + ;; Extra predicates that don't have matching types. + (dolist (pred-types '((functionp cl-functionp consp symbolp) + (keywordp symbolp) + (characterp fixnump) + (natnump integerp) + (facep symbolp stringp) + (plistp listp) + (cl-struct-p recordp) + ;; ;; FIXME: These aren't quite in the same + ;; ;; category since they'll signal errors. + (fboundp symbolp) + )) + (puthash (car pred-types) + (apply #'logior + (mapcar (lambda (pred) + (gethash pred bitsets)) + (cdr pred-types))) + bitsets)) + bitsets))) + +(defconst pcase--subtype-bitsets + (if (fboundp 'built-in-class-p) + (pcase--subtype-bitsets) + ;; Early bootstrap: we don't have the built-in classes yet, so just + ;; use an empty table for now. + (prog1 (make-hash-table) + ;; The empty table leads to significantly worse code, so upgrade + ;; to the real table as soon as possible (most importantly: before we + ;; start compiling code, and hence baking the result into files). + (with-eval-after-load 'cl-preloaded + (defconst pcase--subtype-bitsets (pcase--subtype-bitsets))))) + "Table mapping predicates to their set of types. +These are the set of built-in types for which they may return non-nil. +The sets are represented as bitsets (integers) where each bit represents +a specific leaf type. Which bit represents which type is unspecified.") + +;; Extra predicates (defun pcase--mutually-exclusive-p (pred1 pred2) - (or (member (cons pred1 pred2) - pcase-mutually-exclusive-predicates) - (member (cons pred2 pred1) - pcase-mutually-exclusive-predicates))) + (let ((subtypes1 (gethash pred1 pcase--subtype-bitsets))) + (when subtypes1 + (let ((subtypes2 (gethash pred2 pcase--subtype-bitsets))) + (when subtypes2 + (zerop (logand subtypes1 subtypes2))))))) (defun pcase--split-match (sym splitter match) (cond @@ -814,7 +835,8 @@ A and B can be one of: ((vectorp (cadr pat)) #'vectorp) ((compiled-function-p (cadr pat)) #'compiled-function-p)))) - (pcase--mutually-exclusive-p (cadr upat) otherpred)) + (and otherpred + (pcase--mutually-exclusive-p (cadr upat) otherpred))) '(:pcase--fail . nil)) ;; Since we turn (or 'a 'b 'c) into (pred (memq _ '(a b c))) ;; try and preserve the info we get from that memq test. diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el index d062965952a..c79adcdfec5 100644 --- a/test/lisp/emacs-lisp/pcase-tests.el +++ b/test/lisp/emacs-lisp/pcase-tests.el @@ -160,4 +160,18 @@ (should-error (pcase-setq a) :type '(wrong-number-of-arguments))) +(ert-deftest pcase-tests-mutually-exclusive () + (dolist (x '((functionp consp nil) + (functionp stringp t) + (compiled-function-p consp t) + (keywordp symbolp nil) + (keywordp symbol-with-pos-p nil) + (keywordp stringp t))) + (if (nth 2 x) + (should (pcase--mutually-exclusive-p (nth 0 x) (nth 1 x))) + (should-not (pcase--mutually-exclusive-p (nth 0 x) (nth 1 x)))) + (if (nth 2 x) + (should (pcase--mutually-exclusive-p (nth 1 x) (nth 0 x))) + (should-not (pcase--mutually-exclusive-p (nth 1 x) (nth 0 x)))))) + ;;; pcase-tests.el ends here. -- cgit v1.2.3 From 35ae2c576b8570da7b2e791991ad852c648be896 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 28 Mar 2024 11:34:25 +0200 Subject: ; * lisp/emacs-lisp/pcase.el (pcase--subtype-bitsets): Doc fix. --- lisp/emacs-lisp/pcase.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index e2d0c0dc068..23f1bac600c 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -688,8 +688,9 @@ recording whether the var has been referenced by earlier parts of the match." ;; start compiling code, and hence baking the result into files). (with-eval-after-load 'cl-preloaded (defconst pcase--subtype-bitsets (pcase--subtype-bitsets))))) - "Table mapping predicates to their set of types. -These are the set of built-in types for which they may return non-nil. + "Hash table mapping type predicates to their sets of types. +The table maps each type predicate, such as `numberp' and `stringp', +to the set of built-in types for which the predicate may return non-nil. The sets are represented as bitsets (integers) where each bit represents a specific leaf type. Which bit represents which type is unspecified.") -- cgit v1.2.3 From cdd7093e17a33a6efc4721af461af180e5af602d Mon Sep 17 00:00:00 2001 From: Vladimir Kazanov Date: Tue, 12 Mar 2024 11:14:54 +0000 Subject: Improve ert-font-lock assertion parser (Bug#69714) Fail on files with no assertions, parser now accepts multiple carets per line and face lists: * lisp/emacs-lisp/ert-font-lock.el: Assertion parser fix. * test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js: * test/lisp/emacs-lisp/ert-font-lock-tests.el (test-parse-comments--no-assertion-error) (test-syntax-highlight-inline--caret-negated-wrong-face) (test-macro-test--file-no-asserts): New test cases. * doc/misc/ert.texi (Syntax Highlighting Tests): More syntax examples. --- doc/misc/ert.texi | 45 +++++- lisp/emacs-lisp/ert-font-lock.el | 73 ++++++++-- .../ert-font-lock-resources/no-asserts.js | 2 + test/lisp/emacs-lisp/ert-font-lock-tests.el | 153 +++++++++++++++++---- 4 files changed, 228 insertions(+), 45 deletions(-) create mode 100644 test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi index bd2ad495142..8767de71496 100644 --- a/doc/misc/ert.texi +++ b/doc/misc/ert.texi @@ -951,11 +951,13 @@ that assigns face properties to parts of the buffer. The @code{ert-font-lock} package makes it possible to introduce unit tests checking face assignment. Test assertions are included in code-level comments directly and can be read either from inline strings or files. +The parser expects the input string to contain at least one assertion. Test assertion parser extracts tests from comment-only lines. Every -comment assertion line starts either with a caret (@samp{^}) or an -arrow (@samp{<-}). A caret/arrow should be followed immediately by the -name of a face to be checked. +comment assertion line starts either with a caret (@samp{^}) or an arrow +(@samp{<-}). A single caret/arrow or carets should be followed +immediately by the name of a face or a list of faces to be checked +against the @code{:face} property at point. The test then checks if the first non-assertion column above the caret contains a face expected by the assertion: @@ -967,10 +969,43 @@ var variable = 11; // ^ font-lock-punctuation-face // this is not an assertion, it's just a comment // ^ font-lock-comment-face + +// multiple carets per line +// ^^^^ ^ ^ font-lock-comment-face +@end example + +Both symbol-only @code{:face} property values and assertion face values +are normalized to single element lists so assertions below are +equivalent: + +@example +// single +// ^ font-lock-comment-face +// single +// ^ (font-lock-comment-face) +@end example + +Assertions can be negated: + +@example +var variable = 11; +// ^ !font-lock-comment-face +@end example + +It is possible to specify face lists in assertions: + +@example +// TODO +// ^^^^ (font-lock-comment-face hl-todo) + var test = 1; +// ^ () +// ^ nil +// negation works as expected +// ^ !nil @end example -The arrow means that the first non-empty column of the assertion line -will be used for the check: +The arrow (@samp{<-}) means that the first non-empty column of the +assertion line will be used for the check: @example var variable = 1; diff --git a/lisp/emacs-lisp/ert-font-lock.el b/lisp/emacs-lisp/ert-font-lock.el index 29114712f92..e77c8945dc3 100644 --- a/lisp/emacs-lisp/ert-font-lock.el +++ b/lisp/emacs-lisp/ert-font-lock.el @@ -39,16 +39,33 @@ (require 'newcomment) (require 'pcase) -(defconst ert-font-lock--assertion-re +(defconst ert-font-lock--face-symbol-re + (rx (one-or-more (or alphanumeric "-" "_" "."))) + "A face symbol matching regex.") + +(defconst ert-font-lock--face-symbol-list-re + (rx "(" + (* whitespace) + (one-or-more + (seq (regexp ert-font-lock--face-symbol-re) + (* whitespace))) + ")") + "A face symbol list matching regex.") + +(defconst ert-font-lock--assertion-line-re (rx - ;; column specifiers + ;; leading column assertion (arrow/caret) (group (or "^" "<-")) - (one-or-more " ") + (zero-or-more whitespace) + ;; possible to have many carets on an assertion line + (group (zero-or-more (seq "^" (zero-or-more whitespace)))) ;; optional negation of the face specification (group (optional "!")) - ;; face symbol name - (group (one-or-more (or alphanumeric "-" "_" ".")))) - "An ert-font-lock assertion regex.") + (zero-or-more whitespace) + ;; face symbol name or a list of symbols + (group (or (regexp ert-font-lock--face-symbol-re) + (regexp ert-font-lock--face-symbol-list-re)))) + "An ert-font-lock assertion line regex.") (defun ert-font-lock--validate-major-mode (mode) "Validate if MODE is a valid major mode." @@ -212,7 +229,7 @@ be used through `ert'. (save-excursion (beginning-of-line) (skip-syntax-forward " ") - (re-search-forward ert-font-lock--assertion-re + (re-search-forward ert-font-lock--assertion-line-re (line-end-position) t 1))) (defun ert-font-lock--goto-first-char () @@ -252,8 +269,8 @@ be used through `ert'. (throw 'nextline t)) - ;; Collect the assertion - (when (re-search-forward ert-font-lock--assertion-re + ;; Collect the first line assertion (caret or arrow) + (when (re-search-forward ert-font-lock--assertion-line-re (line-end-position) t 1) (unless (> linetocheck -1) @@ -266,21 +283,38 @@ be used through `ert'. (- (match-beginning 1) (line-beginning-position)) (ert-font-lock--get-first-char-column))) ;; negate the face? - (negation (string-equal (match-string-no-properties 2) "!")) + (negation (string-equal (match-string-no-properties 3) "!")) ;; the face that is supposed to be in the position specified - (face (match-string-no-properties 3))) + (face (read (match-string-no-properties 4)))) + ;; Collect the first assertion on the line (push (list :line-checked linetocheck :line-assert curline :column-checked column-checked :face face :negation negation) - tests)))) + tests) + + ;; Collect all the other line carets (if present) + (goto-char (match-beginning 2)) + (while (equal (following-char) ?^) + (setq column-checked (- (point) (line-beginning-position))) + (push (list :line-checked linetocheck + :line-assert curline + :column-checked column-checked + :face face + :negation negation) + tests) + (forward-char) + (skip-syntax-forward " "))))) ;; next line (setq curline (1+ curline)) (forward-line 1)) + (unless tests + (user-error "No test assertions found")) + (reverse tests))) (defun ert-font-lock--point-at-line-and-column (line column) @@ -307,21 +341,30 @@ The function is meant to be run from within an ERT test." (let* ((line-checked (plist-get test :line-checked)) (line-assert (plist-get test :line-assert)) (column-checked (plist-get test :column-checked)) - (expected-face (intern (plist-get test :face))) + (expected-face (plist-get test :face)) (negation (plist-get test :negation)) (actual-face (get-text-property (ert-font-lock--point-at-line-and-column line-checked column-checked) 'face)) (line-str (ert-font-lock--get-line line-checked)) (line-assert-str (ert-font-lock--get-line line-assert))) - (when (not (eq actual-face expected-face)) + ;; normalize both expected and resulting face - these can be + ;; either symbols, nils or lists of symbols + (when (not (listp actual-face)) + (setq actual-face (list actual-face))) + (when (not (listp expected-face)) + (setq expected-face (list expected-face))) + + ;; fail when lists are not 'equal and the assertion is *not negated* + (when (and (not negation) (not (equal actual-face expected-face))) (ert-fail (list (format "Expected face %S, got %S on line %d column %d" expected-face actual-face line-checked column-checked) :line line-str :assert line-assert-str))) - (when (and negation (eq actual-face expected-face)) + ;; fail when lists are 'equal and the assertion is *negated* + (when (and negation (equal actual-face expected-face)) (ert-fail (list (format "Did not expect face %S face on line %d, column %d" actual-face line-checked column-checked) diff --git a/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js b/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js new file mode 100644 index 00000000000..5eae9af212f --- /dev/null +++ b/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js @@ -0,0 +1,2 @@ +var abc = function(d) { +}; diff --git a/test/lisp/emacs-lisp/ert-font-lock-tests.el b/test/lisp/emacs-lisp/ert-font-lock-tests.el index e0ba1e949b2..fa2e5dc4db7 100644 --- a/test/lisp/emacs-lisp/ert-font-lock-tests.el +++ b/test/lisp/emacs-lisp/ert-font-lock-tests.el @@ -138,13 +138,24 @@ print(\"Hello, world!\")" (forward-line) (should (ert-font-lock--line-comment-p)))) +(ert-deftest test-parse-comments--no-assertion-error () + (let* ((str " +not_an_assertion +random_symbol +")) + (with-temp-buffer + (insert str) + (javascript-mode) + + (should-error (ert-font-lock--parse-comments) :type 'user-error)))) + (ert-deftest test-parse-comments--single-line-error () (let* ((str "// ^ face.face1")) (with-temp-buffer (insert str) (javascript-mode) - (should-error (ert-font-lock--parse-comments))))) + (should-error (ert-font-lock--parse-comments) :type 'user-error)))) (ert-deftest test-parse-comments--single-line-single-caret () (let* ((str " @@ -159,7 +170,46 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 1)) (should (equal (car asserts) - '(:line-checked 2 :line-assert 3 :column-checked 3 :face "face.face1" :negation nil)))))) + '(:line-checked 2 :line-assert 3 :column-checked 3 :face face.face1 :negation nil)))))) + +(ert-deftest test-parse-comments--single-line-many-carets () + (let* ((str " +multiplecarets +//^^^ ^^ ^ face.face1 +") + asserts) + (with-temp-buffer + (insert str) + (javascript-mode) + + (setq asserts (ert-font-lock--parse-comments)) + (should (eql (length asserts) 6)) + (should (equal asserts + '((:line-checked 2 :line-assert 3 :column-checked 2 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 3 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 4 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 6 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 7 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 9 :face face.face1 :negation nil))))))) + +(ert-deftest test-parse-comments--face-list () + (let* ((str " +facelist +// ^ (face1 face2) +// ^ !(face3 face4) +// ^ (face5) +") + asserts) + (with-temp-buffer + (insert str) + (javascript-mode) + + (setq asserts (ert-font-lock--parse-comments)) + (should (eql (length asserts) 3)) + (should (equal asserts + '((:line-checked 2 :line-assert 3 :column-checked 3 :face (face1 face2) :negation nil) + (:line-checked 2 :line-assert 4 :column-checked 3 :face (face3 face4) :negation t) + (:line-checked 2 :line-assert 5 :column-checked 3 :face (face5) :negation nil))))))) (ert-deftest test-parse-comments--caret-negation () (let* ((str " @@ -175,11 +225,11 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 2)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face" :negation t) - (:line-checked 2 :line-assert 4 :column-checked 3 :face "face" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 3 :face face :negation t) + (:line-checked 2 :line-assert 4 :column-checked 3 :face face :negation nil))))))) -(ert-deftest test-parse-comments--single-line-multiple-carets () +(ert-deftest test-parse-comments--single-line-multiple-assert-lines () (let* ((str " first // ^ face1 @@ -196,12 +246,12 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 4)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face1" :negation nil) - (:line-checked 2 :line-assert 4 :column-checked 7 :face "face.face2" :negation nil) - (:line-checked 2 :line-assert 5 :column-checked 7 :face "face-face.face3" :negation nil) - (:line-checked 2 :line-assert 6 :column-checked 7 :face "face_face.face4" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 3 :face face1 :negation nil) + (:line-checked 2 :line-assert 4 :column-checked 7 :face face.face2 :negation nil) + (:line-checked 2 :line-assert 5 :column-checked 7 :face face-face.face3 :negation nil) + (:line-checked 2 :line-assert 6 :column-checked 7 :face face_face.face4 :negation nil))))))) -(ert-deftest test-parse-comments--multiple-line-multiple-carets () +(ert-deftest test-parse-comments--multiple-line-multiple-assert-lines () (let* ((str " first // ^ face1 @@ -218,9 +268,9 @@ third (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 3)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face1" :negation nil) - (:line-checked 4 :line-assert 5 :column-checked 3 :face "face2" :negation nil) - (:line-checked 4 :line-assert 6 :column-checked 5 :face "face3" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 3 :face face1 :negation nil) + (:line-checked 4 :line-assert 5 :column-checked 3 :face face2 :negation nil) + (:line-checked 4 :line-assert 6 :column-checked 5 :face face3 :negation nil))))))) (ert-deftest test-parse-comments--arrow-single-line-single () @@ -236,7 +286,7 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 1)) (should (equal (car asserts) - '(:line-checked 2 :line-assert 3 :column-checked 0 :face "face1" :negation nil)))))) + '(:line-checked 2 :line-assert 3 :column-checked 0 :face face1 :negation nil)))))) (ert-deftest test-parse-comments-arrow-multiple-line-single () @@ -254,9 +304,9 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 3)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 0 :face "face1" :negation nil) - (:line-checked 2 :line-assert 4 :column-checked 2 :face "face2" :negation nil) - (:line-checked 2 :line-assert 5 :column-checked 4 :face "face3" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 0 :face face1 :negation nil) + (:line-checked 2 :line-assert 4 :column-checked 2 :face face2 :negation nil) + (:line-checked 2 :line-assert 5 :column-checked 4 :face face3 :negation nil))))))) (ert-deftest test-parse-comments--non-assert-comment-single () (let* ((str " @@ -271,7 +321,7 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 1)) (should (equal (car asserts) - '(:line-checked 2 :line-assert 3 :column-checked 4 :face "comment-face" :negation nil)))))) + '(:line-checked 2 :line-assert 3 :column-checked 4 :face comment-face :negation nil)))))) (ert-deftest test-parse-comments--non-assert-comment-multiple () (let* ((str " @@ -288,9 +338,9 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 3)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 4 :face "comment-face" :negation nil) - (:line-checked 2 :line-assert 4 :column-checked 10 :face "comment-face" :negation nil) - (:line-checked 2 :line-assert 5 :column-checked 18 :face "comment-face" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 4 :face comment-face :negation nil) + (:line-checked 2 :line-assert 4 :column-checked 10 :face comment-face :negation nil) + (:line-checked 2 :line-assert 5 :column-checked 18 :face comment-face :negation nil))))))) (ert-deftest test-parse-comments--multiline-comment-single () @@ -308,7 +358,7 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 1)) (should (equal (car asserts) - '(:line-checked 3 :line-assert 4 :column-checked 3 :face "comment-face" :negation nil)))))) + '(:line-checked 3 :line-assert 4 :column-checked 3 :face comment-face :negation nil)))))) (ert-deftest test-parse-comments--multiline-comment-multiple () (let* ((str " @@ -327,13 +377,47 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 2)) (should (equal asserts - '((:line-checked 3 :line-assert 4 :column-checked 3 :face "comment-face" :negation nil) - (:line-checked 5 :line-assert 6 :column-checked 4 :face "comment-face" :negation nil))))))) + '((:line-checked 3 :line-assert 4 :column-checked 3 :face comment-face :negation nil) + (:line-checked 5 :line-assert 6 :column-checked 4 :face comment-face :negation nil))))))) ;;; Syntax highlighting assertion tests ;; -(ert-deftest test-syntax-highlight-inline--caret-multiple-faces () +(ert-deftest test-syntax-highlight-inline--nil-list () + (let ((str " +var abc = function(d) { +// ^ nil +// ^ !nil +}; + +")) + (with-temp-buffer + (insert str) + (javascript-mode) + (font-lock-ensure) + + (ert-font-lock--check-faces + (ert-font-lock--parse-comments))))) + +(ert-deftest test-syntax-highlight-inline--face-list () + (let ((str " +var abc = function(d) { +// ^ (test-face-2 test-face-1 font-lock-variable-name-face) +}; + +")) + (with-temp-buffer + (insert str) + (javascript-mode) + (font-lock-ensure) + + (add-face-text-property (point-min) (point-max) 'test-face-1) + (add-face-text-property (point-min) (point-max) 'test-face-2) + + (ert-font-lock--check-faces + (ert-font-lock--parse-comments))))) + +(ert-deftest test-syntax-highlight-inline--caret-multiple-assertions () (let ((str " var abc = function(d) { // ^ font-lock-variable-name-face @@ -364,6 +448,19 @@ var abc = function(d) { (should-error (ert-font-lock--check-faces (ert-font-lock--parse-comments)))))) +(ert-deftest test-syntax-highlight-inline--caret-negated-wrong-face () + (let* ((str " +var abc = function(d) { +// ^ !not-a-face +}; +")) + (with-temp-buffer + (insert str) + (javascript-mode) + (font-lock-ensure) + + (ert-font-lock--check-faces + (ert-font-lock--parse-comments))))) (ert-deftest test-syntax-highlight-inline--comment-face () (let* ((str " @@ -455,6 +552,12 @@ var abc = function(d) { javascript-mode "correct.js") +(ert-font-lock-deftest-file test-macro-test--file-no-asserts + "Check failing on files without assertions" + :expected-result :failed + javascript-mode + "no-asserts.js") + (ert-font-lock-deftest-file test-macro-test--file-failing "Test reading wrong assertions from a file" :expected-result :failed -- cgit v1.2.3 From b2793febcaa31bf21caff2d6461fd328f0892ad2 Mon Sep 17 00:00:00 2001 From: Rahguzar Date: Fri, 15 Mar 2024 18:46:46 +0100 Subject: Allow for auto updating only visible proced buffers (bug#69784) * lisp/proced.el (proced-auto-update-flag): Document 'visible' value and add it to the custom type. (proced-auto-update-timer, proced-toggle-auto-update): Take 'visible' value into account. --- lisp/proced.el | 46 +++++++++++++++++++++++++++++++--------------- 1 file changed, 31 insertions(+), 15 deletions(-) diff --git a/lisp/proced.el b/lisp/proced.el index 7d7de1e2ce3..1d257b6bd4d 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -362,9 +362,13 @@ of `proced-grammar-alist'." :type 'integer) (defcustom proced-auto-update-flag nil - "Non-nil for auto update of a Proced buffer. -Can be changed interactively via `proced-toggle-auto-update'." - :type 'boolean) + "Non-nil means auto update proced buffers. +Special value `visible' means only update proced buffers that are currently +displayed in a window. Can be changed interactively via +`proced-toggle-auto-update'." + :type '(radio (const :tag "Don't auto update" nil) + (const :tag "Only update visible proced buffers" visible) + (const :tag "Update all proced buffers" t))) (make-variable-buffer-local 'proced-auto-update-flag) (defcustom proced-tree-flag nil @@ -951,28 +955,40 @@ Proced buffers." "Auto-update Proced buffers using `run-at-time'. If there are no proced buffers, cancel the timer." - (unless (seq-filter (lambda (buf) - (with-current-buffer buf - (when (eq major-mode 'proced-mode) - (if proced-auto-update-flag - (proced-update t t)) - t))) - (buffer-list)) + (if-let (buffers (match-buffers '(derived-mode . proced-mode))) + (dolist (buf buffers) + (when-let ((flag (buffer-local-value 'proced-auto-update-flag buf)) + ((or (not (eq flag 'visible)) + (get-buffer-window buf 'visible)))) + (with-current-buffer buf + (proced-update t t)))) (cancel-timer proced-auto-update-timer) (setq proced-auto-update-timer nil))) (defun proced-toggle-auto-update (arg) "Change whether this Proced buffer is updated automatically. With prefix ARG, update this buffer automatically if ARG is positive, -otherwise do not update. Sets the variable `proced-auto-update-flag'. -The time interval for updates is specified via `proced-auto-update-interval'." +update the buffer only when the buffer is displayed in a window if ARG is 0, +otherwise do not update. Sets the variable `proced-auto-update-flag' by +cycling between nil, `visible' and t. The time interval for updates is +specified via `proced-auto-update-interval'." (interactive (list (or current-prefix-arg 'toggle)) proced-mode) (setq proced-auto-update-flag - (cond ((eq arg 'toggle) (not proced-auto-update-flag)) - (arg (> (prefix-numeric-value arg) 0)) + (cond ((eq arg 'toggle) + (cond ((not proced-auto-update-flag) 'visible) + ((eq proced-auto-update-flag 'visible) t) + (t nil))) + (arg + (setq arg (prefix-numeric-value arg)) + (message "%s" arg) + (cond ((> arg 0) t) + ((eq arg 0) 'visible) + (t nil))) (t (not proced-auto-update-flag)))) (message "Proced auto update %s" - (if proced-auto-update-flag "enabled" "disabled"))) + (cond ((eq proced-auto-update-flag 'visible) "enabled (only when buffer is visible)") + (proced-auto-update-flag "enabled (unconditionally)") + (t "disabled")))) ;;; Mark -- cgit v1.2.3 From f021c3dbcd08eb1b0e3215ba6fd4e56364e6915f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 28 Mar 2024 11:50:22 +0200 Subject: ; * etc/NEWS: Announce new feature of Proced. (Bug#69784) --- etc/NEWS | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 25c4efa590f..696d744e342 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1430,6 +1430,14 @@ When this is non-nil, the lines of key sequences are displayed with the most recent line first. This is can be useful when working with macros with many lines, such as from 'kmacro-edit-lossage'. +** Proced + +--- +*** More control on automatic update of Proced buffers. +The user option 'proced-auto-update-flag' can now be set to 2 additional +values, which control automatic updates of Proced buffers that are not +displayed in some window. + ** Miscellaneous --- -- cgit v1.2.3 From a4da3971f2580c90fb3c6957eea2d0dbfb695879 Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Sat, 23 Mar 2024 13:29:17 -0700 Subject: copy-tree just image map, not entire image * lisp/image.el (image--compute-original-map): Copy only the image map. (Bug#69602) --- lisp/image.el | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) diff --git a/lisp/image.el b/lisp/image.el index 55340ea03dc..d7496485aca 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -1455,24 +1455,23 @@ When :rotation is not a multiple of 90, return copy of :original-map." If IMAGE lacks :map property, return nil. When :rotation is not a multiple of 90, return copy of :map." (when (image-property image :map) - (let* ((image-copy (copy-tree image t)) - (map (image-property image-copy :map)) - (scale (or (image-property image-copy :scale) 1)) - (rotation (or (image-property image-copy :rotation) 0)) - (flip (image-property image-copy :flip)) - (size (image-size image-copy t))) + (let* ((original-map (copy-tree (image-property image :map) t)) + (scale (or (image-property image :scale) 1)) + (rotation (or (image-property image :rotation) 0)) + (flip (image-property image :flip)) + (size (image-size image t))) (when (and ; Handle only 90-degree rotations (zerop (mod rotation 1)) (zerop (% (truncate rotation) 90))) ;; In rendered images, rotation is always applied before flip. - ;; To undo the transformation, flip before rotating. - ;; SIZE fits MAP before it is transformed back to ORIGINAL-MAP. - ;; Therefore, scale MAP after flip and rotate operations, since - ;; both need MAP to fit SIZE. - (image--flip-map map flip size) - (image--rotate-map map (- rotation) size) - (image--scale-map map (/ 1.0 scale))) - map))) + ;; To undo the transformation, flip before rotating. SIZE fits + ;; ORIGINAL-MAP before transformations are applied. Therefore, + ;; scale ORIGINAL-MAP after flip and rotate operations, since + ;; both need ORIGINAL-MAP to fit SIZE. + (image--flip-map original-map flip size) + (image--rotate-map original-map (- rotation) size) + (image--scale-map original-map (/ 1.0 scale))) + original-map))) (defun image--scale-map (map scale) "Scale MAP according to SCALE. -- cgit v1.2.3 From 6c1a11078b194ed536db17381aad9e159e486fee Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 28 Mar 2024 12:15:13 +0200 Subject: Fix a typo in flymake.el * lisp/progmodes/flymake.el (flymake--update-eol-overlays): Use 'save-restriction', not 'save-excursion'. (Bug#69984) --- lisp/progmodes/flymake.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index db00cc59c0e..779c612f479 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -744,7 +744,7 @@ associated `flymake-category' return DEFAULT." (defun flymake--update-eol-overlays () "Update the `before-string' property of end-of-line overlays." - (save-excursion + (save-restriction (widen) (dolist (o (overlays-in (point-min) (point-max))) (when (overlay-get o 'flymake--eol-overlay) -- cgit v1.2.3 From de9e913f9e2a1e01e5d091a553e98d75404a2246 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 28 Mar 2024 12:27:54 -0400 Subject: * lisp/emacs-lisp/cl-macs.el (list): Predefine predicate by hand --- lisp/emacs-lisp/cl-macs.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 051cd992fc1..a84ef4a34b2 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3470,6 +3470,10 @@ Of course, we really can't know that for sure, so it's just a heuristic." (keyword . keywordp) ;Would need `keyword-with-pos`. (natnum . natnump) ;Subtype of fixnum & bignum. (real . numberp) ;Not clear where it would fit. + ;; This one is redundant, but we keep it to silence a + ;; warning during the early bootstrap when `cl-seq.el' gets + ;; loaded before `cl-preloaded.el' is defined. + (list . listp) )) (put type 'cl-deftype-satisfies pred)) -- cgit v1.2.3 From bcf6dd6e266222a293e359430afdf3a2dc18369c Mon Sep 17 00:00:00 2001 From: Noah Peart Date: Tue, 26 Mar 2024 22:44:48 -0700 Subject: Add typescript-ts-mode indentation for interface bodies (bug#70023) * lisp/progmodes/typescript-ts-mode.el (typescript-ts-mode--indent-rules): Add indentation rule for interface bodies. --- lisp/progmodes/typescript-ts-mode.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 7021f012dcd..9c4c388c6b1 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -124,6 +124,7 @@ Argument LANGUAGE is either `typescript' or `tsx'." ((parent-is "object_type") parent-bol typescript-ts-mode-indent-offset) ((parent-is "enum_body") parent-bol typescript-ts-mode-indent-offset) ((parent-is "class_body") parent-bol typescript-ts-mode-indent-offset) + ((parent-is "interface_body") parent-bol typescript-ts-mode-indent-offset) ((parent-is "arrow_function") parent-bol typescript-ts-mode-indent-offset) ((parent-is "parenthesized_expression") parent-bol typescript-ts-mode-indent-offset) ((parent-is "binary_expression") parent-bol typescript-ts-mode-indent-offset) -- cgit v1.2.3 From fbf6830299998a1e99b99c69cb90b637a3d26f12 Mon Sep 17 00:00:00 2001 From: Theodor Thornhill Date: Thu, 28 Mar 2024 19:02:09 +0100 Subject: Add test for previous change (bug#70023) * test/lisp/progmodes/typescript-ts-mode-resources/indent.erts: Add test. --- .../progmodes/typescript-ts-mode-resources/indent.erts | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts index 7b6185e0386..bec96ad82e0 100644 --- a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts @@ -110,3 +110,17 @@ const foo = (props) => { ); } =-=-= + +Name: Interface body fields are indented + +=-= +interface Foo { +foo: string; +bar?: boolean; +} +=-= +interface Foo { + foo: string; + bar?: boolean; +} +=-=-= -- cgit v1.2.3 From 4cee95815b9d7d56f6f77abb1cc17e346c038685 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 28 Mar 2024 15:31:04 -0400 Subject: pp.el: Try and fix bug#70039 * lisp/emacs-lisp/pp.el (pp-fill): Avoid splitting `#N#` or `#[`. * test/lisp/emacs-lisp/pp-tests.el (pp-tests--sanity): New test. --- lisp/emacs-lisp/pp.el | 27 +++++++++++++++++---------- test/lisp/emacs-lisp/pp-tests.el | 19 +++++++++++++++++++ 2 files changed, 36 insertions(+), 10 deletions(-) diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 26c77d6b047..d586fc59939 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -166,12 +166,19 @@ it inserts and pretty-prints that arg at point." (interactive "r") (if (null end) (pp--object beg #'pp-fill) (goto-char beg) - (let ((end (copy-marker end t)) - (newline (lambda () - (skip-chars-forward ")]}") - (unless (save-excursion (skip-chars-forward " \t") (eolp)) - (insert "\n") - (indent-according-to-mode))))) + (let* ((end (copy-marker end t)) + (avoid-unbreakable + (lambda () + (and (memq (char-before) '(?# ?s ?f)) + (memq (char-after) '(?\[ ?\()) + (looking-back "#[sf]?" (- (point) 2)) + (goto-char (match-beginning 0))))) + (newline (lambda () + (skip-chars-forward ")]}") + (unless (save-excursion (skip-chars-forward " \t") (eolp)) + (funcall avoid-unbreakable) + (insert "\n") + (indent-according-to-mode))))) (while (progn (forward-comment (point-max)) (< (point) end)) (let ((beg (point)) @@ -198,10 +205,10 @@ it inserts and pretty-prints that arg at point." ;; reduce the indentation depth. ;; Similarly, we prefer to cut before a "." than after ;; it because it reduces the indentation depth. - (while (not (zerop (skip-chars-backward " \t({[',."))) - (and (memq (char-before) '(?# ?s ?f)) - (looking-back "#[sf]?" (- (point) 2)) - (goto-char (match-beginning 0)))) + (while + (progn + (funcall avoid-unbreakable) + (not (zerop (skip-chars-backward " \t({[',."))))) (if (bolp) ;; The sexp already starts on its own line. (progn (goto-char beg) nil) diff --git a/test/lisp/emacs-lisp/pp-tests.el b/test/lisp/emacs-lisp/pp-tests.el index 7f7c798cde8..7606183d645 100644 --- a/test/lisp/emacs-lisp/pp-tests.el +++ b/test/lisp/emacs-lisp/pp-tests.el @@ -66,4 +66,23 @@ (while (search-forward "." nil t) (should (not (eolp)))))) +(ert-deftest pp-tests--sanity () + (with-temp-buffer + (lisp-data-mode) + (let ((testdata "(a b c #1=#[0 \"\" [] 0] #s(foo #1# bar))")) + (let ((res (car (read-from-string testdata)))) + (dotimes (i (length testdata)) + (erase-buffer) + (insert testdata) + (let ((fill-column i)) + (pp-fill (point-min) (point-max)) + (goto-char (point-min)) + (condition-case err + (should (equal (read (current-buffer)) res)) + (invalid-read-syntax + (message "Invalid fill result with i=%d:\n%s" + i (buffer-string)) + (signal (car err) (cdr err)) + )))))))) + ;;; pp-tests.el ends here. -- cgit v1.2.3 From 755665d95adbba07335f400f1090e53b66c41ff5 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 28 Mar 2024 19:56:31 +0800 Subject: Prevent Android OS task trimming from deleting Emacs frames * doc/emacs/android.texi (Android Windowing): Document proviso on Android 7.0 and later. * java/org/gnu/emacs/EmacsActivity.java (EmacsActivity) : New field. (onStop, onResume): Set and clear timeOfLastInteraction. (isReallyFinishing): New function. (onDestroy): Don't delete frame even in the event isFinishing returns true if more than 4 hours have elapsed since the activity last moved into the background. --- doc/emacs/android.texi | 12 ++++++++ java/org/gnu/emacs/EmacsActivity.java | 55 ++++++++++++++++++++++++++++++++++- 2 files changed, 66 insertions(+), 1 deletion(-) diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi index b367515cb35..01732961998 100644 --- a/doc/emacs/android.texi +++ b/doc/emacs/android.texi @@ -858,6 +858,18 @@ When the user closes the window created during application startup, and the window was not previously closed by the system in order to save resources, Emacs deletes any frame displayed within that window. +However, on Android 7.0 and later, such frames are not deleted if the +window is closed four or more hours after the window moves into the +background, as the system automatically removes open windows once a +certain period of inactivity elapses when the number of windows retained +by the window manager surpasses a specific threshold, and window +deletion by this mechanism is indistinguishable from window deletion by +the user. Emacs begins to ignore window deletion after two hours less +than the default value of this threshold both to err on the side of +caution, in case the system's record of inactivity and Emacs's differ, +and for the reason that this threshold is open to customization by OS +distributors. + @item When the user or the system closes any window created by Emacs on behalf of a specific frame, Emacs deletes the frame displayed within diff --git a/java/org/gnu/emacs/EmacsActivity.java b/java/org/gnu/emacs/EmacsActivity.java index 6ab6a709bef..f5b05a9c184 100644 --- a/java/org/gnu/emacs/EmacsActivity.java +++ b/java/org/gnu/emacs/EmacsActivity.java @@ -20,9 +20,12 @@ along with GNU Emacs. If not, see . */ package org.gnu.emacs; import java.lang.IllegalStateException; + import java.util.List; import java.util.ArrayList; +import java.util.concurrent.TimeUnit; + import android.app.Activity; import android.content.ContentResolver; @@ -31,6 +34,7 @@ import android.content.Intent; import android.os.Build; import android.os.Bundle; +import android.os.SystemClock; import android.util.Log; @@ -78,6 +82,9 @@ public class EmacsActivity extends Activity /* The last context menu to be closed. */ private static Menu lastClosedMenu; + /* The time of the most recent call to onStop. */ + private static long timeOfLastInteraction; + static { focusedActivities = new ArrayList (); @@ -271,6 +278,50 @@ public class EmacsActivity extends Activity syncFullscreenWith (window); } + @Override + public final void + onStop () + { + timeOfLastInteraction = SystemClock.elapsedRealtime (); + + super.onStop (); + } + + /* Return whether the task is being finished in response to explicit + user action. That is to say, Activity.isFinished, but as + documented. */ + + public final boolean + isReallyFinishing () + { + long atime, dtime; + int hours; + + if (Build.VERSION.SDK_INT < Build.VERSION_CODES.NOUGAT) + return isFinishing (); + + /* When the number of tasks retained in the recents list exceeds a + threshold, Android 7 and later so destroy activities in trimming + them from recents on the expiry of a timeout that isFinishing + returns true, in direct contradiction to the documentation. This + timeout is generally 6 hours, but admits of customization by + individual system distributors, so to err on the side of the + caution, the timeout Emacs applies is a more conservative figure + of 4 hours. */ + + if (timeOfLastInteraction == 0) + return isFinishing (); + + atime = timeOfLastInteraction; + + /* Compare atime with the current system time. */ + dtime = SystemClock.elapsedRealtime () - atime; + if (dtime + 1000000 < TimeUnit.HOURS.toMillis (4)) + return isFinishing (); + + return false; + } + @Override public final void onDestroy () @@ -283,7 +334,8 @@ public class EmacsActivity extends Activity /* The activity will die shortly hereafter. If there is a window attached, close it now. */ isMultitask = this instanceof EmacsMultitaskActivity; - manager.removeWindowConsumer (this, isMultitask || isFinishing ()); + manager.removeWindowConsumer (this, (isMultitask + || isReallyFinishing ())); focusedActivities.remove (this); invalidateFocus (2); @@ -340,6 +392,7 @@ public class EmacsActivity extends Activity onResume () { isPaused = false; + timeOfLastInteraction = 0; EmacsWindowAttachmentManager.MANAGER.noticeDeiconified (this); super.onResume (); -- cgit v1.2.3 From c3684b97885c5a1f4d0713ff45c7395e9a4c6e8a Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 28 Mar 2024 19:57:22 +0800 Subject: ; * java/org/gnu/emacs/EmacsActivity.java (isReallyFinishing): Fix typo. --- java/org/gnu/emacs/EmacsActivity.java | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/java/org/gnu/emacs/EmacsActivity.java b/java/org/gnu/emacs/EmacsActivity.java index f5b05a9c184..e380b7bfc2a 100644 --- a/java/org/gnu/emacs/EmacsActivity.java +++ b/java/org/gnu/emacs/EmacsActivity.java @@ -297,7 +297,7 @@ public class EmacsActivity extends Activity long atime, dtime; int hours; - if (Build.VERSION.SDK_INT < Build.VERSION_CODES.NOUGAT) + if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N) return isFinishing (); /* When the number of tasks retained in the recents list exceeds a -- cgit v1.2.3 From 1232ab31c656b8564984a758957466f90ac10501 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 10 Mar 2024 13:18:22 +0100 Subject: Add `value<` (bug#69709) It's a general-purpose polymorphic ordering function, like `<` but for any two values of the same type. * src/data.c (syms_of_data): Add the `type-mismatch` error. (bits_word_to_host_endian): Move... * src/lisp.h (bits_word_to_host_endian): ...here, and declare inline. * src/fns.c (Fstring_lessp): Extract the bulk of this function to... (string_cmp): ...this 3-way comparison function, for use elsewhere. (bool_vector_cmp, value_cmp, Fvaluelt): New. * lisp/emacs-lisp/byte-opt.el (side-effect-free-fns, pure-fns): Add `value<`, which is pure and side-effect-free. * test/src/fns-tests.el (fns-value<-ordered, fns-value<-unordered) (fns-value<-type-mismatch, fns-value<-symbol-with-pos) (fns-value<-circle, ert-deftest fns-value<-bool-vector): New tests. * doc/lispref/sequences.texi (Sequence Functions): * doc/lispref/numbers.texi (Comparison of Numbers): * doc/lispref/strings.texi (Text Comparison): Document the new value< function. * etc/NEWS: Announce. --- doc/lispref/numbers.texi | 1 + doc/lispref/sequences.texi | 35 ++++++ doc/lispref/strings.texi | 1 + etc/NEWS | 10 ++ lisp/emacs-lisp/byte-opt.el | 4 +- src/data.c | 26 +--- src/fns.c | 280 ++++++++++++++++++++++++++++++++++++++++---- src/lisp.h | 24 ++++ test/src/fns-tests.el | 218 ++++++++++++++++++++++++++++++++++ 9 files changed, 552 insertions(+), 47 deletions(-) diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 99b456043b9..2c093ccd6bd 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -476,6 +476,7 @@ This function tests whether its arguments are numerically equal, and returns @code{t} if they are not, and @code{nil} if they are. @end defun +@anchor{definition of <} @defun < number-or-marker &rest number-or-markers This function tests whether each argument is strictly less than the following argument. It returns @code{t} if so, @code{nil} otherwise. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 74719d4779f..5bdf71fe02e 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -436,6 +436,41 @@ but their relative order is also preserved: @end example @end defun +@cindex comparing values +@cindex standard sorting order +@defun value< a b +This function returns non-@code{nil} if @var{a} comes before @var{b} in +the standard sorting order; this means that it returns @code{nil} when +@var{b} comes before @var{a}, or if they are equal or unordered. + +@var{a} and @var{b} must have the same type. Specifically: + +@itemize @bullet +@item +Numbers are compared using @code{<} (@pxref{definition of <}). +@item +Strings and symbols are compared using @code{string<} +(@pxref{definition of string<}). +@item +Conses, lists, vectors and records are compared lexicographically. +@item +Markers are compared first by buffer, then by position. +@item +Buffers and processes are compared by name. +@item +Other types are considered unordered and the return value will be @code{nil}. +@end itemize + +Examples: +@example +(value< -4 3.5) @result{} t +(value< "dog" "cat") @result{} nil +(value< 'yip 'yip) @result{} nil +(value< '(3 2) '(3 2 0)) @result{} t +(value< [3 2 1] [3 2 0]) @result{} nil +@end example +@end defun + 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 diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index a2285098aad..6a9dd589237 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -612,6 +612,7 @@ that collation implements. @end defun @cindex lexical comparison of strings +@anchor{definition of string<} @defun string< string1 string2 @c (findex string< causes problems for permuted index!!) This function compares two strings a character at a time. It diff --git a/etc/NEWS b/etc/NEWS index 696d744e342..73ffff9f2d3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1760,6 +1760,16 @@ precedence over the variable when present. Mostly used internally to do a kind of topological sort of inheritance hierarchies. ++++ +** New polymorphic comparison function 'value<'. +This function returns non-nil if the first argument is less than the +second. It works for any two values of the same type with reasonable +ordering for numbers, strings, symbols, bool-vectors, markers, buffers +and processes. Conses, lists, vectors and records are ordered +lexicographically. +It is intended as a convenient ordering predicate for sorting, and is +likely to be faster than hand-written Lisp functions. + ** 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 diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 54997205edb..ea163723a3e 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1772,7 +1772,7 @@ See Info node `(elisp) Integer Basics'." string-version-lessp substring substring-no-properties sxhash-eq sxhash-eql sxhash-equal sxhash-equal-including-properties - take vconcat + take value< vconcat ;; frame.c frame-ancestor-p frame-bottom-divider-width frame-char-height frame-char-width frame-child-frame-border-width frame-focus @@ -1973,7 +1973,7 @@ See Info node `(elisp) Integer Basics'." hash-table-p identity length length< length= length> member memq memql nth nthcdr proper-list-p rassoc rassq safe-length string-bytes string-distance string-equal string-lessp - string-search string-version-lessp take + string-search string-version-lessp take value< ;; search.c regexp-quote ;; syntax.c diff --git a/src/data.c b/src/data.c index 69b990bed76..a86f86c52f5 100644 --- a/src/data.c +++ b/src/data.c @@ -3835,30 +3835,6 @@ count_trailing_zero_bits (bits_word val) } } -static bits_word -bits_word_to_host_endian (bits_word val) -{ -#ifndef WORDS_BIGENDIAN - return val; -#else - if (BITS_WORD_MAX >> 31 == 1) - return bswap_32 (val); - if (BITS_WORD_MAX >> 31 >> 31 >> 1 == 1) - return bswap_64 (val); - { - int i; - bits_word r = 0; - for (i = 0; i < sizeof val; i++) - { - r = ((r << 1 << (CHAR_BIT - 1)) - | (val & ((1u << 1 << (CHAR_BIT - 1)) - 1))); - val = val >> 1 >> (CHAR_BIT - 1); - } - return r; - } -#endif -} - DEFUN ("bool-vector-exclusive-or", Fbool_vector_exclusive_or, Sbool_vector_exclusive_or, 2, 3, 0, doc: /* Return A ^ B, bitwise exclusive or. @@ -4072,6 +4048,7 @@ syms_of_data (void) DEFSYM (Qminibuffer_quit, "minibuffer-quit"); DEFSYM (Qwrong_length_argument, "wrong-length-argument"); DEFSYM (Qwrong_type_argument, "wrong-type-argument"); + DEFSYM (Qtype_mismatch, "type-mismatch") DEFSYM (Qargs_out_of_range, "args-out-of-range"); DEFSYM (Qvoid_function, "void-function"); DEFSYM (Qcyclic_function_indirection, "cyclic-function-indirection"); @@ -4163,6 +4140,7 @@ syms_of_data (void) PUT_ERROR (Quser_error, error_tail, ""); PUT_ERROR (Qwrong_length_argument, error_tail, "Wrong length argument"); PUT_ERROR (Qwrong_type_argument, error_tail, "Wrong type argument"); + PUT_ERROR (Qtype_mismatch, error_tail, "Types do not match"); PUT_ERROR (Qargs_out_of_range, error_tail, "Args out of range"); PUT_ERROR (Qvoid_function, error_tail, "Symbol's function definition is void"); diff --git a/src/fns.c b/src/fns.c index 0a64e515402..7faf25b9088 100644 --- a/src/fns.c +++ b/src/fns.c @@ -27,6 +27,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include "lisp.h" #include "bignum.h" @@ -466,21 +467,10 @@ load_unaligned_size_t (const void *p) return x; } -DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0, - doc: /* Return non-nil if STRING1 is less than STRING2 in lexicographic order. -Case is significant. -Symbols are also allowed; their print names are used instead. */) - (Lisp_Object string1, Lisp_Object string2) +/* Return -1/0/1 to indicate the relation between string1 and string2. */ +static int +string_cmp (Lisp_Object string1, Lisp_Object string2) { - if (SYMBOLP (string1)) - string1 = SYMBOL_NAME (string1); - else - CHECK_STRING (string1); - if (SYMBOLP (string2)) - string2 = SYMBOL_NAME (string2); - else - CHECK_STRING (string2); - ptrdiff_t n = min (SCHARS (string1), SCHARS (string2)); if ((!STRING_MULTIBYTE (string1) || SCHARS (string1) == SBYTES (string1)) @@ -489,7 +479,9 @@ Symbols are also allowed; their print names are used instead. */) /* Each argument is either unibyte or all-ASCII multibyte: we can compare bytewise. */ int d = memcmp (SSDATA (string1), SSDATA (string2), n); - return d < 0 || (d == 0 && n < SCHARS (string2)) ? Qt : Qnil; + if (d) + return d; + return n < SCHARS (string2) ? -1 : n > SCHARS (string2); } else if (STRING_MULTIBYTE (string1) && STRING_MULTIBYTE (string2)) { @@ -523,7 +515,7 @@ Symbols are also allowed; their print names are used instead. */) if (b >= nb) /* One string is a prefix of the other. */ - return b < nb2 ? Qt : Qnil; + return b < nb2 ? -1 : b > nb2; /* Now back up to the start of the differing characters: it's the last byte not having the bit pattern 10xxxxxx. */ @@ -535,7 +527,7 @@ Symbols are also allowed; their print names are used instead. */) ptrdiff_t i1_byte = b, i2_byte = b; int c1 = fetch_string_char_advance_no_check (string1, &i1, &i1_byte); int c2 = fetch_string_char_advance_no_check (string2, &i2, &i2_byte); - return c1 < c2 ? Qt : Qnil; + return c1 < c2 ? -1 : c1 > c2; } else if (STRING_MULTIBYTE (string1)) { @@ -546,9 +538,9 @@ Symbols are also allowed; their print names are used instead. */) int c1 = fetch_string_char_advance_no_check (string1, &i1, &i1_byte); int c2 = SREF (string2, i2++); if (c1 != c2) - return c1 < c2 ? Qt : Qnil; + return c1 < c2 ? -1 : 1; } - return i1 < SCHARS (string2) ? Qt : Qnil; + return i1 < SCHARS (string2) ? -1 : i1 > SCHARS (string2); } else { @@ -559,12 +551,30 @@ Symbols are also allowed; their print names are used instead. */) int c1 = SREF (string1, i1++); int c2 = fetch_string_char_advance_no_check (string2, &i2, &i2_byte); if (c1 != c2) - return c1 < c2 ? Qt : Qnil; + return c1 < c2 ? -1 : 1; } - return i1 < SCHARS (string2) ? Qt : Qnil; + return i1 < SCHARS (string2) ? -1 : i1 > SCHARS (string2); } } +DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0, + doc: /* Return non-nil if STRING1 is less than STRING2 in lexicographic order. +Case is significant. +Symbols are also allowed; their print names are used instead. */) + (Lisp_Object string1, Lisp_Object string2) +{ + if (SYMBOLP (string1)) + string1 = SYMBOL_NAME (string1); + else + CHECK_STRING (string1); + if (SYMBOLP (string2)) + string2 = SYMBOL_NAME (string2); + else + CHECK_STRING (string2); + + return string_cmp (string1, string2) < 0 ? Qt : Qnil; +} + DEFUN ("string-version-lessp", Fstring_version_lessp, Sstring_version_lessp, 2, 2, 0, doc: /* Return non-nil if S1 is less than S2, as version strings. @@ -2908,6 +2918,233 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, return false; } + +/* Return -1/0/1 for the lexicographic relation between bool-vectors. */ +static int +bool_vector_cmp (Lisp_Object a, Lisp_Object b) +{ + ptrdiff_t na = bool_vector_size (a); + ptrdiff_t nb = bool_vector_size (b); + /* Skip equal words. */ + ptrdiff_t words_min = min (na, nb) / BITS_PER_BITS_WORD; + bits_word *ad = bool_vector_data (a); + bits_word *bd = bool_vector_data (b); + ptrdiff_t i = 0; + while (i < words_min && ad[i] == bd[i]) + i++; + na -= i * BITS_PER_BITS_WORD; + nb -= i * BITS_PER_BITS_WORD; + eassume (na >= 0 && nb >= 0); + if (nb == 0) + return na != 0; + if (na == 0) + return -1; + + bits_word aw = bits_word_to_host_endian (ad[i]); + bits_word bw = bits_word_to_host_endian (bd[i]); + bits_word xw = aw ^ bw; + if (xw == 0) + return na < nb ? -1 : na > nb; + + bits_word d = xw & -xw; /* Isolate first difference. */ + eassume (d != 0); + return (d & aw) ? 1 : -1; +} + +/* Return -1, 0 or 1 to indicate whether ab in the sense of value<. + In particular 0 does not mean equality in the sense of Fequal, only + that the arguments cannot be ordered yet they can be compared (same + type). */ +static int +value_cmp (Lisp_Object a, Lisp_Object b, int maxdepth) +{ + if (maxdepth < 0) + error ("Maximum depth exceeded in comparison"); + + tail_recurse: + /* Shortcut for a common case. */ + if (BASE_EQ (a, b)) + return 0; + + switch (XTYPE (a)) + { + case_Lisp_Int: + { + EMACS_INT ia = XFIXNUM (a); + if (FIXNUMP (b)) + return ia < XFIXNUM (b) ? -1 : 1; /* we know that a≠b */ + if (FLOATP (b)) + return ia < XFLOAT_DATA (b) ? -1 : ia > XFLOAT_DATA (b); + if (BIGNUMP (b)) + return -mpz_sgn (*xbignum_val (b)); + } + goto type_mismatch; + + case Lisp_Symbol: + if (BARE_SYMBOL_P (b)) + return string_cmp (XBARE_SYMBOL (a)->u.s.name, + XBARE_SYMBOL (b)->u.s.name); + if (CONSP (b) && NILP (a)) + return -1; + if (SYMBOLP (b)) + /* Slow-path branch when B is a symbol-with-pos. */ + return string_cmp (XBARE_SYMBOL (a)->u.s.name, XSYMBOL (b)->u.s.name); + goto type_mismatch; + + case Lisp_String: + if (STRINGP (b)) + return string_cmp (a, b); + goto type_mismatch; + + case Lisp_Cons: + /* FIXME: Optimise for difference in the first element? */ + FOR_EACH_TAIL (b) + { + int cmp = value_cmp (XCAR (a), XCAR (b), maxdepth - 1); + if (cmp != 0) + return cmp; + a = XCDR (a); + if (!CONSP (a)) + { + b = XCDR (b); + goto tail_recurse; + } + } + if (NILP (b)) + return 1; + else + goto type_mismatch; + goto tail_recurse; + + case Lisp_Vectorlike: + if (VECTORLIKEP (b)) + { + enum pvec_type ta = PSEUDOVECTOR_TYPE (XVECTOR (a)); + enum pvec_type tb = PSEUDOVECTOR_TYPE (XVECTOR (b)); + if (ta == tb) + switch (ta) + { + case PVEC_NORMAL_VECTOR: + case PVEC_RECORD: + { + ptrdiff_t len_a = ASIZE (a); + ptrdiff_t len_b = ASIZE (b); + if (ta == PVEC_RECORD) + { + len_a &= PSEUDOVECTOR_SIZE_MASK; + len_b &= PSEUDOVECTOR_SIZE_MASK; + } + ptrdiff_t len_min = min (len_a, len_b); + for (ptrdiff_t i = 0; i < len_min; i++) + { + int cmp = value_cmp (AREF (a, i), AREF (b, i), + maxdepth - 1); + if (cmp != 0) + return cmp; + } + return len_a < len_b ? -1 : len_a > len_b; + } + + case PVEC_BOOL_VECTOR: + return bool_vector_cmp (a, b); + + case PVEC_MARKER: + { + Lisp_Object buf_a = Fmarker_buffer (a); + Lisp_Object buf_b = Fmarker_buffer (b); + if (NILP (buf_a)) + return NILP (buf_b) ? 0 : -1; + if (NILP (buf_b)) + return 1; + int cmp = value_cmp (buf_a, buf_b, maxdepth - 1); + if (cmp != 0) + return cmp; + ptrdiff_t pa = XMARKER (a)->charpos; + ptrdiff_t pb = XMARKER (b)->charpos; + return pa < pb ? -1 : pa > pb; + } + + case PVEC_PROCESS: + a = Fprocess_name (a); + b = Fprocess_name (b); + goto tail_recurse; + + case PVEC_BUFFER: + { + /* Killed buffers lack names and sort before those alive. */ + Lisp_Object na = Fbuffer_name (a); + Lisp_Object nb = Fbuffer_name (b); + if (NILP (na)) + return NILP (nb) ? 0 : -1; + if (NILP (nb)) + return 1; + a = na; + b = nb; + goto tail_recurse; + } + + case PVEC_BIGNUM: + return mpz_cmp (*xbignum_val (a), *xbignum_val (b)); + + case PVEC_SYMBOL_WITH_POS: + /* Compare by name, enabled or not. */ + a = XSYMBOL_WITH_POS_SYM (a); + b = XSYMBOL_WITH_POS_SYM (b); + goto tail_recurse; + + default: + /* Treat other types as unordered. */ + return 0; + } + } + else if (BIGNUMP (a)) + return -value_cmp (b, a, maxdepth); + else if (SYMBOL_WITH_POS_P (a) && symbols_with_pos_enabled) + { + a = XSYMBOL_WITH_POS_SYM (a); + goto tail_recurse; + } + + goto type_mismatch; + + case Lisp_Float: + { + double fa = XFLOAT_DATA (a); + if (FLOATP (b)) + return fa < XFLOAT_DATA (b) ? -1 : fa > XFLOAT_DATA (b); + if (FIXNUMP (b)) + return fa < XFIXNUM (b) ? -1 : fa > XFIXNUM (b); + if (BIGNUMP (b)) + { + if (isnan (fa)) + return 0; + return -mpz_cmp_d (*xbignum_val (b), fa); + } + } + goto type_mismatch; + + default: + eassume (0); + } + type_mismatch: + xsignal2 (Qtype_mismatch, a, b); +} + +DEFUN ("value<", Fvaluelt, Svaluelt, 2, 2, 0, + doc: /* Return non-nil if A precedes B in standard value order. +A and B must have the same basic type. +Numbers are compared with `<'. +Strings and symbols are compared with `string-lessp'. +Lists, vectors, bool-vectors and records are compared lexicographically. +Markers are compared lexicographically by buffer and position. +Buffers and processes are compared by name. +Other types are considered unordered and the return value will be `nil'. */) + (Lisp_Object a, Lisp_Object b) +{ + int maxdepth = 20; /* FIXME: arbitrary value */ + return value_cmp (a, b, maxdepth) < 0 ? Qt : Qnil; +} + DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0, @@ -6589,6 +6826,7 @@ For best results this should end in a space. */); defsubr (&Seql); defsubr (&Sequal); defsubr (&Sequal_including_properties); + defsubr (&Svaluelt); defsubr (&Sfillarray); defsubr (&Sclear_string); defsubr (&Snconc); diff --git a/src/lisp.h b/src/lisp.h index f86758c88fb..5583a7e2e8e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1882,6 +1882,30 @@ bool_vector_bytes (EMACS_INT size) return (size + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR; } +INLINE bits_word +bits_word_to_host_endian (bits_word val) +{ +#ifndef WORDS_BIGENDIAN + return val; +#else + if (BITS_WORD_MAX >> 31 == 1) + return bswap_32 (val); + if (BITS_WORD_MAX >> 31 >> 31 >> 1 == 1) + return bswap_64 (val); + { + int i; + bits_word r = 0; + for (i = 0; i < sizeof val; i++) + { + r = ((r << 1 << (CHAR_BIT - 1)) + | (val & ((1u << 1 << (CHAR_BIT - 1)) - 1))); + val = val >> 1 >> (CHAR_BIT - 1); + } + return r; + } +#endif +} + INLINE bool BOOL_VECTOR_P (Lisp_Object a) { diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 7437c07f156..844000cdc76 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -1513,4 +1513,222 @@ (should-error (copy-alist "abc") :type 'wrong-type-argument)) +(ert-deftest fns-value<-ordered () + ;; values (X . Y) where X nil: `b' is now always a proper prefix of `a'. + (should-not (value< a b)) + (should (value< b a))) + (t + ;; nil -> t: `a' is now less than `b'. + (should (value< a b)) + (should-not (value< b a)))) + ;; Undo the flip. + (aset b i val))))))))))) + ;;; fns-tests.el ends here -- cgit v1.2.3 From a52f1121a3589af8f89828e04d66f1215c361bcf Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 18 Mar 2024 19:56:20 +0100 Subject: Add back timsort key function handling (bug#69709) The original timsort code did provide for a key (accessor) function along with the necessary storage management, but we dropped it because our `sort` function didn't need it. Now it's been put back since it seems that it will come in handy after all. * src/fns.c (sort_list, sort_vector, Fsort): Pass Qnil as key function to tim_sort. * src/sort.c (reverse_slice, sortslice_copy) (sortslice_copy_incr, sortslice_copy_decr, sortslice_memcpy) (sortslice_memmove, sortslice_advance): New functions. (sortslice): New type. (struct stretch, struct reloc, merge_state) (binarysort, merge_init, merge_markmem, cleanup_mem) (merge_register_cleanup, merge_getmem, merge_lo, merge_hi, merge_at) (found_new_run, reverse_sortslice, resolve_fun, tim_sort): Merge back previously discarded parts from the upstreams timsort code that dealt with key functions, and adapt them to fit in. --- src/fns.c | 12 +- src/lisp.h | 2 +- src/sort.c | 413 ++++++++++++++++++++++++++++++++++++++++++++----------------- 3 files changed, 309 insertions(+), 118 deletions(-) diff --git a/src/fns.c b/src/fns.c index 7faf25b9088..a3ef99f67a8 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2353,7 +2353,7 @@ See also the function `nreverse', which is used more often. */) is destructively reused to hold the sorted result. */ static Lisp_Object -sort_list (Lisp_Object list, Lisp_Object predicate) +sort_list (Lisp_Object list, Lisp_Object predicate, Lisp_Object keyfunc) { ptrdiff_t length = list_length (list); if (length < 2) @@ -2369,7 +2369,7 @@ sort_list (Lisp_Object list, Lisp_Object predicate) result[i] = Fcar (tail); tail = XCDR (tail); } - tim_sort (predicate, result, length); + tim_sort (predicate, keyfunc, result, length); ptrdiff_t i = 0; tail = list; @@ -2388,13 +2388,13 @@ sort_list (Lisp_Object list, Lisp_Object predicate) algorithm. */ static void -sort_vector (Lisp_Object vector, Lisp_Object predicate) +sort_vector (Lisp_Object vector, Lisp_Object predicate, Lisp_Object keyfunc) { ptrdiff_t length = ASIZE (vector); if (length < 2) return; - tim_sort (predicate, XVECTOR (vector)->contents, length); + tim_sort (predicate, keyfunc, XVECTOR (vector)->contents, length); } DEFUN ("sort", Fsort, Ssort, 2, 2, 0, @@ -2406,9 +2406,9 @@ the second. */) (Lisp_Object seq, Lisp_Object predicate) { if (CONSP (seq)) - seq = sort_list (seq, predicate); + seq = sort_list (seq, predicate, Qnil); else if (VECTORP (seq)) - sort_vector (seq, predicate); + sort_vector (seq, predicate, Qnil); else if (!NILP (seq)) wrong_type_argument (Qlist_or_vector_p, seq); return seq; diff --git a/src/lisp.h b/src/lisp.h index 5583a7e2e8e..14c0b8e4d1c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4299,7 +4299,7 @@ extern void syms_of_fns (void); extern void mark_fns (void); /* Defined in sort.c */ -extern void tim_sort (Lisp_Object, Lisp_Object *, const ptrdiff_t); +extern void tim_sort (Lisp_Object, Lisp_Object, Lisp_Object *, const ptrdiff_t); /* Defined in floatfns.c. */ verify (FLT_RADIX == 2 || FLT_RADIX == 16); diff --git a/src/sort.c b/src/sort.c index 2f98bfa648c..d91993c8c65 100644 --- a/src/sort.c +++ b/src/sort.c @@ -34,6 +34,90 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" +/* Reverse a slice of a vector in place, from lo up to (exclusive) hi. */ +static void +reverse_slice(Lisp_Object *lo, Lisp_Object *hi) +{ + eassert (lo && hi); + + --hi; + while (lo < hi) { + Lisp_Object t = *lo; + *lo = *hi; + *hi = t; + ++lo; + --hi; + } +} + +/* A sortslice contains a pointer to an array of keys and a pointer to + an array of corresponding values. In other words, keys[i] + corresponds with values[i]. If values == NULL, then the keys are + also the values. + + Several convenience routines are provided here, so that keys and + values are always moved in sync. */ + +typedef struct { + Lisp_Object *keys; + Lisp_Object *values; +} sortslice; + +/* FIXME: Instead of values=NULL, can we set values=keys, so that they + are both moved in lockstep and we avoid a lot of branches? + We may do some useless work but it might be cheaper overall. */ + +static inline void +sortslice_copy (sortslice *s1, ptrdiff_t i, sortslice *s2, ptrdiff_t j) +{ + s1->keys[i] = s2->keys[j]; + if (s1->values != NULL) + s1->values[i] = s2->values[j]; +} + +static inline void +sortslice_copy_incr (sortslice *dst, sortslice *src) +{ + *dst->keys++ = *src->keys++; + if (dst->values != NULL) + *dst->values++ = *src->values++; +} + +static inline void +sortslice_copy_decr (sortslice *dst, sortslice *src) +{ + *dst->keys-- = *src->keys--; + if (dst->values != NULL) + *dst->values-- = *src->values--; +} + + +static inline void +sortslice_memcpy (sortslice *s1, ptrdiff_t i, sortslice *s2, ptrdiff_t j, + ptrdiff_t n) +{ + memcpy (&s1->keys[i], &s2->keys[j], sizeof s1->keys[0] * n); + if (s1->values != NULL) + memcpy (&s1->values[i], &s2->values[j], sizeof s1->values[0] * n); +} + +static inline void +sortslice_memmove (sortslice *s1, ptrdiff_t i, sortslice *s2, ptrdiff_t j, + ptrdiff_t n) +{ + memmove (&s1->keys[i], &s2->keys[j], sizeof s1->keys[0] * n); + if (s1->values != NULL) + memmove (&s1->values[i], &s2->values[j], sizeof s1->values[0] * n); +} + +static inline void +sortslice_advance (sortslice *slice, ptrdiff_t n) +{ + slice->keys += n; + if (slice->values != NULL) + slice->values += n; +} + /* MAX_MERGE_PENDING is the maximum number of entries in merge_state's pending-stretch stack. For a list with n elements, this needs at most floor(log2(n)) + 1 entries even if we didn't force runs to a @@ -54,15 +138,15 @@ along with GNU Emacs. If not, see . */ struct stretch { - Lisp_Object *base; + sortslice base; ptrdiff_t len; int power; }; struct reloc { - Lisp_Object **src; - Lisp_Object **dst; + sortslice *src; + sortslice *dst; ptrdiff_t *size; int order; /* -1 while in merge_lo; +1 while in merg_hi; 0 otherwise. */ }; @@ -70,7 +154,8 @@ struct reloc typedef struct { - Lisp_Object *listbase; + Lisp_Object *basekeys; + Lisp_Object *allocated_keys; /* heap-alloc'ed key array or NULL */ ptrdiff_t listlen; /* PENDING is a stack of N pending stretches yet to be merged. @@ -91,7 +176,7 @@ typedef struct with merges. 'A' initially points to TEMPARRAY, and subsequently to newly allocated memory if needed. */ - Lisp_Object *a; + sortslice a; ptrdiff_t alloced; specpdl_ref count; Lisp_Object temparray[MERGESTATE_TEMP_SIZE]; @@ -124,17 +209,17 @@ inorder (const Lisp_Object predicate, const Lisp_Object a, const Lisp_Object b) permutation of the input (nothing is lost or duplicated). */ static void -binarysort (merge_state *ms, Lisp_Object *lo, const Lisp_Object *hi, +binarysort (merge_state *ms, sortslice lo, const Lisp_Object *hi, Lisp_Object *start) { Lisp_Object pred = ms->predicate; - eassume (lo <= start && start <= hi); - if (lo == start) + eassume (lo.keys <= start && start <= hi); + if (lo.keys == start) ++start; for (; start < hi; ++start) { - Lisp_Object *l = lo; + Lisp_Object *l = lo.keys; Lisp_Object *r = start; Lisp_Object pivot = *r; @@ -150,6 +235,17 @@ binarysort (merge_state *ms, Lisp_Object *lo, const Lisp_Object *hi, for (Lisp_Object *p = start; p > l; --p) p[0] = p[-1]; *l = pivot; + + if (lo.values != NULL) + { + ptrdiff_t offset = lo.values - lo.keys; + Lisp_Object *p = start + offset; + pivot = *p; + l += offset; + for (Lisp_Object *p = start + offset; p > l; --p) + p[0] = p[-1]; + *l = pivot; + } } } @@ -378,21 +474,46 @@ gallop_right (merge_state *ms, const Lisp_Object key, Lisp_Object *a, } +static void merge_register_cleanup (merge_state *ms); + static void -merge_init (merge_state *ms, const ptrdiff_t list_size, Lisp_Object *lo, - const Lisp_Object predicate) +merge_init (merge_state *ms, const ptrdiff_t list_size, + Lisp_Object *allocated_keys, sortslice *lo, Lisp_Object predicate) { eassume (ms != NULL); - ms->a = ms->temparray; - ms->alloced = MERGESTATE_TEMP_SIZE; + if (lo->values != NULL) + { + /* The temporary space for merging will need at most half the list + size rounded up. Use the minimum possible space so we can use the + rest of temparray for other things. In particular, if there is + enough extra space, if will be used to store the keys. */ + ms->alloced = (list_size + 1) / 2; + + /* ms->alloced describes how many keys will be stored at + ms->temparray, but we also need to store the values. Hence, + ms->alloced is capped at half of MERGESTATE_TEMP_SIZE. */ + if (MERGESTATE_TEMP_SIZE / 2 < ms->alloced) + ms->alloced = MERGESTATE_TEMP_SIZE / 2; + ms->a.values = &ms->temparray[ms->alloced]; + } + else + { + ms->alloced = MERGESTATE_TEMP_SIZE; + ms->a.values = NULL; + } + ms->a.keys = ms->temparray; ms->n = 0; ms->min_gallop = GALLOP_WIN_MIN; ms->listlen = list_size; - ms->listbase = lo; + ms->basekeys = lo->keys; + ms->allocated_keys = allocated_keys; ms->predicate = predicate; ms->reloc = (struct reloc){NULL, NULL, NULL, 0}; + ms->count = make_invalid_specpdl_ref (); + if (allocated_keys != NULL) + merge_register_cleanup (ms); } @@ -408,8 +529,10 @@ merge_markmem (void *arg) if (ms->reloc.size != NULL && *ms->reloc.size > 0) { - eassume (ms->reloc.src != NULL); - mark_objects (*ms->reloc.src, *ms->reloc.size); + Lisp_Object *src = (ms->reloc.src->values + ? ms->reloc.src->values : ms->reloc.src->keys); + eassume (src != NULL); + mark_objects (src, *ms->reloc.size); } } @@ -432,16 +555,37 @@ cleanup_mem (void *arg) if (ms->reloc.order != 0 && *ms->reloc.size > 0) { - eassume (*ms->reloc.src != NULL && *ms->reloc.dst != NULL); + Lisp_Object *src = (ms->reloc.src->values + ? ms->reloc.src->values : ms->reloc.src->keys); + Lisp_Object *dst = (ms->reloc.dst->values + ? ms->reloc.dst->values : ms->reloc.dst->keys); + eassume (src != NULL && dst != NULL); ptrdiff_t n = *ms->reloc.size; ptrdiff_t shift = ms->reloc.order == -1 ? 0 : n - 1; - memcpy (*ms->reloc.dst - shift, *ms->reloc.src, n * word_size); + memcpy (dst - shift, src, n * word_size); } /* Free any remaining temp storage. */ - xfree (ms->a); + if (ms->a.keys != ms->temparray) + { + xfree (ms->a.keys); + ms->a.keys = NULL; + } + + if (ms->allocated_keys != NULL) + { + xfree (ms->allocated_keys); + ms->allocated_keys = NULL; + } } +static void +merge_register_cleanup (merge_state *ms) +{ + specpdl_ref count = SPECPDL_INDEX (); + record_unwind_protect_ptr_mark (cleanup_mem, ms, merge_markmem); + ms->count = count; +} /* Allocate enough temp memory for NEED array slots. Any previously allocated memory is first freed, and a cleanup routine is @@ -453,13 +597,12 @@ merge_getmem (merge_state *ms, const ptrdiff_t need) { eassume (ms != NULL); - if (ms->a == ms->temparray) + if (ms->a.keys == ms->temparray) { /* We only get here if alloc is needed and this is the first time, so we set up the unwind protection. */ - specpdl_ref count = SPECPDL_INDEX (); - record_unwind_protect_ptr_mark (cleanup_mem, ms, merge_markmem); - ms->count = count; + if (!specpdl_ref_valid_p (ms->count)) + merge_register_cleanup (ms); } else { @@ -467,10 +610,13 @@ merge_getmem (merge_state *ms, const ptrdiff_t need) what's in the block we don't use realloc which would waste cycles copying the old data. We just free and alloc again. */ - xfree (ms->a); + xfree (ms->a.keys); } - ms->a = xmalloc (need * word_size); + ptrdiff_t bytes = (need * word_size) << (ms->a.values != NULL ? 1 : 0); + ms->a.keys = xmalloc (bytes); ms->alloced = need; + if (ms->a.values != NULL) + ms->a.values = &ms->a.keys[need]; } @@ -488,21 +634,21 @@ needmem (merge_state *ms, ptrdiff_t na) NB. */ static void -merge_lo (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, Lisp_Object *ssb, - ptrdiff_t nb) +merge_lo (merge_state *ms, sortslice ssa, ptrdiff_t na, + sortslice ssb, ptrdiff_t nb) { Lisp_Object pred = ms->predicate; - eassume (ms && ssa && ssb && na > 0 && nb > 0); - eassume (ssa + na == ssb); + eassume (ms && ssa.keys && ssb.keys && na > 0 && nb > 0); + eassume (ssa.keys + na == ssb.keys); needmem (ms, na); - memcpy (ms->a, ssa, na * word_size); - Lisp_Object *dest = ssa; + sortslice_memcpy (&ms->a, 0, &ssa, 0, na); + sortslice dest = ssa; ssa = ms->a; ms->reloc = (struct reloc){&ssa, &dest, &na, -1}; - *dest++ = *ssb++; + sortslice_copy_incr (&dest, &ssb); --nb; if (nb == 0) goto Succeed; @@ -519,9 +665,9 @@ merge_lo (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, Lisp_Object *ssb, for (;;) { eassume (na > 1 && nb > 0); - if (inorder (pred, *ssb, *ssa)) + if (inorder (pred, ssb.keys[0], ssa.keys[0])) { - *dest++ = *ssb++ ; + sortslice_copy_incr (&dest, &ssb); ++bcount; acount = 0; --nb; @@ -532,7 +678,7 @@ merge_lo (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, Lisp_Object *ssb, } else { - *dest++ = *ssa++; + sortslice_copy_incr (&dest, &ssa); ++acount; bcount = 0; --na; @@ -552,13 +698,13 @@ merge_lo (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, Lisp_Object *ssb, eassume (na > 1 && nb > 0); min_gallop -= min_gallop > 1; ms->min_gallop = min_gallop; - ptrdiff_t k = gallop_right (ms, ssb[0], ssa, na, 0); + ptrdiff_t k = gallop_right (ms, ssb.keys[0], ssa.keys, na, 0); acount = k; if (k) { - memcpy (dest, ssa, k * word_size); - dest += k; - ssa += k; + sortslice_memcpy (&dest, 0, &ssa, 0, k); + sortslice_advance (&dest, k); + sortslice_advance (&ssa, k); na -= k; if (na == 1) goto CopyB; @@ -567,23 +713,23 @@ merge_lo (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, Lisp_Object *ssb, if (na == 0) goto Succeed; } - *dest++ = *ssb++ ; + sortslice_copy_incr (&dest, &ssb); --nb; if (nb == 0) goto Succeed; - k = gallop_left (ms, ssa[0], ssb, nb, 0); + k = gallop_left (ms, ssa.keys[0], ssb.keys, nb, 0); bcount = k; if (k) { - memmove (dest, ssb, k * word_size); - dest += k; - ssb += k; + sortslice_memmove (&dest, 0, &ssb, 0, k); + sortslice_advance (&dest, k); + sortslice_advance (&ssb, k); nb -= k; if (nb == 0) goto Succeed; } - *dest++ = *ssa++; + sortslice_copy_incr (&dest, &ssa); --na; if (na == 1) goto CopyB; @@ -595,15 +741,15 @@ merge_lo (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, Lisp_Object *ssb, ms->reloc = (struct reloc){NULL, NULL, NULL, 0}; if (na) - memcpy (dest, ssa, na * word_size); + sortslice_memcpy(&dest, 0, &ssa, 0, na); return; CopyB: eassume (na == 1 && nb > 0); ms->reloc = (struct reloc){NULL, NULL, NULL, 0}; /* The last element of ssa belongs at the end of the merge. */ - memmove (dest, ssb, nb * word_size); - dest[nb] = ssa[0]; + sortslice_memmove (&dest, 0, &ssb, 0, nb); + sortslice_copy (&dest, nb, &ssa, 0); } @@ -613,25 +759,27 @@ merge_lo (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, Lisp_Object *ssb, NB. */ static void -merge_hi (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, - Lisp_Object *ssb, ptrdiff_t nb) +merge_hi (merge_state *ms, sortslice ssa, ptrdiff_t na, + sortslice ssb, ptrdiff_t nb) { Lisp_Object pred = ms->predicate; - eassume (ms && ssa && ssb && na > 0 && nb > 0); - eassume (ssa + na == ssb); + eassume (ms && ssa.keys && ssb.keys && na > 0 && nb > 0); + eassume (ssa.keys + na == ssb.keys); needmem (ms, nb); - Lisp_Object *dest = ssb; - dest += nb - 1; - memcpy(ms->a, ssb, nb * word_size); - Lisp_Object *basea = ssa; - Lisp_Object *baseb = ms->a; - ssb = ms->a + nb - 1; - ssa += na - 1; + sortslice dest = ssb; + sortslice_advance (&dest, nb-1); + sortslice_memcpy (&ms->a, 0, &ssb, 0, nb); + sortslice basea = ssa; + sortslice baseb = ms->a; + ssb.keys = ms->a.keys + nb - 1; + if (ssb.values != NULL) + ssb.values = ms->a.values + nb - 1; + sortslice_advance (&ssa, na - 1); ms->reloc = (struct reloc){&baseb, &dest, &nb, 1}; - *dest-- = *ssa--; + sortslice_copy_decr (&dest, &ssa); --na; if (na == 0) goto Succeed; @@ -645,9 +793,9 @@ merge_hi (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, for (;;) { eassume (na > 0 && nb > 1); - if (inorder (pred, *ssb, *ssa)) + if (inorder (pred, ssb.keys[0], ssa.keys[0])) { - *dest-- = *ssa--; + sortslice_copy_decr (&dest, &ssa); ++acount; bcount = 0; --na; @@ -658,7 +806,7 @@ merge_hi (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, } else { - *dest-- = *ssb--; + sortslice_copy_decr (&dest, &ssb); ++bcount; acount = 0; --nb; @@ -677,31 +825,31 @@ merge_hi (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, eassume (na > 0 && nb > 1); min_gallop -= min_gallop > 1; ms->min_gallop = min_gallop; - ptrdiff_t k = gallop_right (ms, ssb[0], basea, na, na - 1); + ptrdiff_t k = gallop_right (ms, ssb.keys[0], basea.keys, na, na - 1); k = na - k; acount = k; if (k) { - dest += -k; - ssa += -k; - memmove(dest + 1, ssa + 1, k * word_size); + sortslice_advance (&dest, -k); + sortslice_advance (&ssa, -k); + sortslice_memmove (&dest, 1, &ssa, 1, k); na -= k; if (na == 0) goto Succeed; } - *dest-- = *ssb--; + sortslice_copy_decr(&dest, &ssb); --nb; if (nb == 1) goto CopyA; - k = gallop_left (ms, ssa[0], baseb, nb, nb - 1); + k = gallop_left (ms, ssa.keys[0], baseb.keys, nb, nb - 1); k = nb - k; bcount = k; if (k) { - dest += -k; - ssb += -k; - memcpy(dest + 1, ssb + 1, k * word_size); + sortslice_advance (&dest, -k); + sortslice_advance (&ssb, -k); + sortslice_memcpy (&dest, 1, &ssb, 1, k); nb -= k; if (nb == 1) goto CopyA; @@ -710,7 +858,7 @@ merge_hi (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, if (nb == 0) goto Succeed; } - *dest-- = *ssa--; + sortslice_copy_decr (&dest, &ssa); --na; if (na == 0) goto Succeed; @@ -721,16 +869,16 @@ merge_hi (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, Succeed: ms->reloc = (struct reloc){NULL, NULL, NULL, 0}; if (nb) - memcpy (dest - nb + 1, baseb, nb * word_size); + sortslice_memcpy (&dest, -(nb-1), &baseb, 0, nb); return; CopyA: eassume (nb == 1 && na > 0); ms->reloc = (struct reloc){NULL, NULL, NULL, 0}; /* The first element of ssb belongs at the front of the merge. */ - memmove (dest + 1 - na, ssa + 1 - na, na * word_size); - dest += -na; - ssa += -na; - dest[0] = ssb[0]; + sortslice_memmove (&dest, 1-na, &ssa, 1-na, na); + sortslice_advance (&dest, -na); + sortslice_advance (&ssa, -na); + sortslice_copy (&dest, 0, &ssb, 0); } @@ -744,12 +892,12 @@ merge_at (merge_state *ms, const ptrdiff_t i) eassume (i >= 0); eassume (i == ms->n - 2 || i == ms->n - 3); - Lisp_Object *ssa = ms->pending[i].base; + sortslice ssa = ms->pending[i].base; ptrdiff_t na = ms->pending[i].len; - Lisp_Object *ssb = ms->pending[i + 1].base; + sortslice ssb = ms->pending[i + 1].base; ptrdiff_t nb = ms->pending[i + 1].len; eassume (na > 0 && nb > 0); - eassume (ssa + na == ssb); + eassume (ssa.keys + na == ssb.keys); /* Record the length of the combined runs. The current run i+1 goes away after the merge. If i is the 3rd-last run now, slide the @@ -761,16 +909,16 @@ merge_at (merge_state *ms, const ptrdiff_t i) /* Where does b start in a? Elements in a before that can be ignored (they are already in place). */ - ptrdiff_t k = gallop_right (ms, *ssb, ssa, na, 0); + ptrdiff_t k = gallop_right (ms, *ssb.keys, ssa.keys, na, 0); eassume (k >= 0); - ssa += k; + sortslice_advance (&ssa, k); na -= k; if (na == 0) return; /* Where does a end in b? Elements in b after that can be ignored (they are already in place). */ - nb = gallop_left (ms, ssa[na - 1], ssb, nb, nb - 1); + nb = gallop_left (ms, ssa.keys[na - 1], ssb.keys, nb, nb - 1); if (nb == 0) return; eassume (nb > 0); @@ -841,7 +989,7 @@ found_new_run (merge_state *ms, const ptrdiff_t n2) { eassume (ms->n > 0); struct stretch *p = ms->pending; - ptrdiff_t s1 = p[ms->n - 1].base - ms->listbase; + ptrdiff_t s1 = p[ms->n - 1].base.keys - ms->basekeys; ptrdiff_t n1 = p[ms->n - 1].len; int power = powerloop (s1, n1, n2, ms->listlen); while (ms->n > 1 && p[ms->n - 2].power > power) @@ -898,39 +1046,81 @@ merge_compute_minrun (ptrdiff_t n) static void -reverse_vector (Lisp_Object *s, const ptrdiff_t n) +reverse_sortslice (sortslice *s, const ptrdiff_t n) { - for (ptrdiff_t i = 0; i < n >> 1; i++) + reverse_slice(s->keys, &s->keys[n]); + if (s->values != NULL) + reverse_slice(s->values, &s->values[n]); +} + +static Lisp_Object +resolve_fun (Lisp_Object fun) +{ + if (SYMBOLP (fun)) { - Lisp_Object tem = s[i]; - s[i] = s[n - i - 1]; - s[n - i - 1] = tem; + /* Attempt to resolve the function as far as possible ahead of time, + to avoid having to do it for each call. */ + Lisp_Object f = XSYMBOL (fun)->u.s.function; + if (SYMBOLP (f)) + /* Function was an alias; use slow-path resolution. */ + f = indirect_function (f); + /* Don't resolve to an autoload spec; that would be very slow. */ + if (!NILP (f) && !(CONSP (f) && EQ (XCAR (f), Qautoload))) + fun = f; } + return fun; } /* Sort the array SEQ with LENGTH elements in the order determined by PREDICATE. */ void -tim_sort (Lisp_Object predicate, Lisp_Object *seq, const ptrdiff_t length) +tim_sort (Lisp_Object predicate, Lisp_Object keyfunc, + Lisp_Object *seq, const ptrdiff_t length) { - if (SYMBOLP (predicate)) + /* FIXME: optimise for the predicate being value<; at the very + least we'd go without the Lisp funcall overhead. */ + predicate = resolve_fun (predicate); + + sortslice lo; + Lisp_Object *keys; + Lisp_Object *allocated_keys = NULL; + merge_state ms; + + /* FIXME: hoist this to the caller? */ + if (EQ (keyfunc, Qidentity)) + keyfunc = Qnil; + + /* FIXME: consider a built-in reverse sorting flag: we would reverse + the input in-place here and reverse it back just before + returning. */ + + if (NILP (keyfunc)) { - /* Attempt to resolve the function as far as possible ahead of time, - to avoid having to do it for each call. */ - Lisp_Object fun = XSYMBOL (predicate)->u.s.function; - if (SYMBOLP (fun)) - /* Function was an alias; use slow-path resolution. */ - fun = indirect_function (fun); - /* Don't resolve to an autoload spec; that would be very slow. */ - if (!NILP (fun) && !(CONSP (fun) && EQ (XCAR (fun), Qautoload))) - predicate = fun; + keys = NULL; + lo.keys = seq; + lo.values = NULL; } + else + { + keyfunc = resolve_fun (keyfunc); + if (length < MERGESTATE_TEMP_SIZE / 2) + keys = &ms.temparray[length + 1]; + else + keys = allocated_keys = xmalloc (length * word_size); - merge_state ms; - Lisp_Object *lo = seq; + for (ptrdiff_t i = 0; i < length; i++) + keys[i] = call1 (keyfunc, seq[i]); + + lo.keys = keys; + lo.values = seq; + } + + /* FIXME: This is where we would check the keys for interesting + properties for more optimised comparison (such as all being fixnums + etc). */ - merge_init (&ms, length, lo, predicate); + merge_init (&ms, length, allocated_keys, &lo, predicate); /* March over the array once, left to right, finding natural runs, and extending short natural runs to minrun elements. */ @@ -940,18 +1130,19 @@ tim_sort (Lisp_Object predicate, Lisp_Object *seq, const ptrdiff_t length) bool descending; /* Identify the next run. */ - ptrdiff_t n = count_run (&ms, lo, lo + nremaining, &descending); + ptrdiff_t n = count_run (&ms, lo.keys, lo.keys + nremaining, &descending); if (descending) - reverse_vector (lo, n); + reverse_sortslice (&lo, n); /* If the run is short, extend it to min(minrun, nremaining). */ if (n < minrun) { const ptrdiff_t force = min (nremaining, minrun); - binarysort (&ms, lo, lo + force, lo + n); + binarysort (&ms, lo, lo.keys + force, lo.keys + n); n = force; } - eassume (ms.n == 0 || ms.pending[ms.n - 1].base + - ms.pending[ms.n - 1].len == lo); + eassume (ms.n == 0 + || (ms.pending[ms.n - 1].base.keys + ms.pending[ms.n - 1].len + == lo.keys)); found_new_run (&ms, n); /* Push the new run on to the stack. */ eassume (ms.n < MAX_MERGE_PENDING); @@ -959,7 +1150,7 @@ tim_sort (Lisp_Object predicate, Lisp_Object *seq, const ptrdiff_t length) ms.pending[ms.n].len = n; ++ms.n; /* Advance to find the next run. */ - lo += n; + sortslice_advance(&lo, n); nremaining -= n; } while (nremaining); @@ -968,6 +1159,6 @@ tim_sort (Lisp_Object predicate, Lisp_Object *seq, const ptrdiff_t length) eassume (ms.pending[0].len == length); lo = ms.pending[0].base; - if (ms.a != ms.temparray) + if (ms.a.keys != ms.temparray || allocated_keys != NULL) unbind_to (ms.count, Qnil); } -- cgit v1.2.3 From ae5f2c02bd2fc269e2cc32c8039d95fbf4225e69 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Tue, 19 Mar 2024 13:03:47 +0100 Subject: New `sort` keyword arguments (bug#69709) Add the :key, :lessp, :reverse and :in-place keyword arguments. The old calling style remains available and is unchanged. * src/fns.c (sort_list, sort_vector, Fsort): * src/sort.c (tim_sort): Add keyword arguments with associated new features. All callers of Fsort adapted. * test/src/fns-tests.el (fns-tests--shuffle-vector, fns-tests-sort-kw): New test. * doc/lispref/sequences.texi (Sequence Functions): Update manual. * etc/NEWS: Announce. --- doc/lispref/sequences.texi | 131 +++++++++++++++++++++++---------------------- etc/NEWS | 25 +++++++++ src/dired.c | 2 +- src/fns.c | 92 ++++++++++++++++++++++++++----- src/lisp.h | 3 +- src/pdumper.c | 6 +-- src/sort.c | 14 ++--- test/src/fns-tests.el | 43 +++++++++++++++ 8 files changed, 229 insertions(+), 87 deletions(-) diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 5bdf71fe02e..6322f17e77b 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -350,94 +350,99 @@ encouraged to treat strings as immutable even when they are mutable. @end defun -@defun sort sequence predicate +@defun sort sequence &rest keyword-args @cindex stable sort @cindex sorting lists @cindex sorting vectors -This function sorts @var{sequence} stably. Note that this function doesn't work -for all sequences; it may be used only for lists and vectors. If @var{sequence} -is a list, it is modified destructively. This functions returns the sorted -@var{sequence} and compares elements using @var{predicate}. A stable sort is -one in which elements with equal sort keys maintain their relative order before -and after the sort. Stability is important when successive sorts are used to -order elements according to different criteria. +This function sorts @var{sequence}, which must be a list or vector, and +returns a sorted sequence of the same type. +The sort is stable, which means that elements with equal sort keys maintain +their relative order. It takes the following optional keyword arguments: -The argument @var{predicate} must be a function that accepts two -arguments. It is called with two elements of @var{sequence}. To get an -increasing order sort, the @var{predicate} should return non-@code{nil} if the -first element is ``less'' than the second, or @code{nil} if not. +@table @asis +@item :key @var{keyfunc} +Use @var{keyfunc}, a function that takes a single element from +@var{sequence} and returns its key value, to generate the keys used in +comparison. If this argument is absent or if @var{keyfunc} is +@code{nil} then @code{identity} is assumed; that is, the elements +themselves are used as sorting keys. + +@item :lessp @var{predicate} +Use @var{predicate} to order the keys. @var{predicate} is a function +that takes two sort keys as arguments and returns non-@code{nil} if the +first should come before the second. If this argument is absent or +@var{predicate} is @code{nil}, then @code{value<} is used, which +is applicable to many different Lisp types and generally sorts in +ascending order (@pxref{definition of value<}). + +For consistency, any predicate must obey the following rules: +@itemize @bullet +@item +It must be @dfn{antisymmetric}: it cannot both order @var{a} before +@var{b} and @var{b} before @var{a}. +@item +It must be @dfn{transitive}: if it orders @var{a} before @var{b} and +@var{b} before @var{c}, then it must also order @var{a} before @var{c}. +@end itemize -The comparison function @var{predicate} must give reliable results for -any given pair of arguments, at least within a single call to -@code{sort}. It must be @dfn{antisymmetric}; that is, if @var{a} is -less than @var{b}, @var{b} must not be less than @var{a}. It must be -@dfn{transitive}---that is, if @var{a} is less than @var{b}, and @var{b} -is less than @var{c}, then @var{a} must be less than @var{c}. If you -use a comparison function which does not meet these requirements, the -result of @code{sort} is unpredictable. +@item :reverse @var{flag} +If @var{flag} is non-@code{nil}, the sorting order is reversed. With +the default @code{:lessp} predicate this means sorting in descending order. -The destructive aspect of @code{sort} for lists is that it reuses the -cons cells forming @var{sequence} by changing their contents, possibly -rearranging them in a different order. This means that the value of -the input list is undefined after sorting; only the list returned by -@code{sort} has a well-defined value. Example: +@item :in-place @var{flag} +If @var{flag} is non-@code{nil}, then @var{sequence} is sorted in-place +(destructively) and returned. If @code{nil}, or if this argument is not +given, a sorted copy of the input is returned and @var{sequence} itself +remains unmodified. In-place sorting is slightly faster, but the +original sequence is lost. +@end table + +If the default behaviour is not suitable for your needs, it is usually +easier and faster to supply a new @code{:key} function than a different +@code{:lessp} predicate. For example, consider sorting these strings: @example -@group -(setq nums (list 2 1 4 3 0)) -(sort nums #'<) - @result{} (0 1 2 3 4) - ; nums is unpredictable at this point -@end group +(setq numbers '("one" "two" "three" "four" "five" "six")) +(sort numbers) + @result{} ("five" "four" "one" "six" "three" "two") @end example -Most often we store the result back into the variable that held the -original list: +You can sort the strings by length instead by supplying a different key +function: @example -(setq nums (sort nums #'<)) +(sort numbers :key #'length) + @result{} ("one" "two" "six" "four" "five" "three") @end example -If you wish to make a sorted copy without destroying the original, -copy it first and then sort: +Note how strings of the same length keep their original order, thanks to +the sorting stability. Now suppose you want to sort by length, but use +the string contents to break ties. The easiest way is to specify a key +function that transforms an element to a value that is sorted this way. +Since @code{value<} orders compound objects (conses, lists, +vectors and records) lexicographically, you could do: @example -@group -(setq nums (list 2 1 4 3 0)) -(sort (copy-sequence nums) #'<) - @result{} (0 1 2 3 4) -@end group -@group -nums - @result{} (2 1 4 3 0) -@end group +(sort numbers :key (lambda (x) (cons (length x) x))) + @result{} ("one" "six" "two" "five" "four" "three") @end example -For the better understanding of what stable sort is, consider the following -vector example. After sorting, all items whose @code{car} is 8 are grouped -at the beginning of @code{vector}, but their relative order is preserved. -All items whose @code{car} is 9 are grouped at the end of @code{vector}, -but their relative order is also preserved: +because @code{(3 . "six")} is ordered before @code{(3 . "two")} and so on. + +For compatibility with old versions of Emacs, the @code{sort} function +can also be called using the fixed two-argument form @example -@group -(setq - vector - (vector '(8 . "xxx") '(9 . "aaa") '(8 . "bbb") '(9 . "zzz") - '(9 . "ppp") '(8 . "ttt") '(8 . "eee") '(9 . "fff"))) - @result{} [(8 . "xxx") (9 . "aaa") (8 . "bbb") (9 . "zzz") - (9 . "ppp") (8 . "ttt") (8 . "eee") (9 . "fff")] -@end group -@group -(sort vector (lambda (x y) (< (car x) (car y)))) - @result{} [(8 . "xxx") (8 . "bbb") (8 . "ttt") (8 . "eee") - (9 . "aaa") (9 . "zzz") (9 . "ppp") (9 . "fff")] -@end group +(@code{sort} @var{sequence} @var{predicate}) @end example + +where @var{predicate} is the @code{:lessp} argument. When using this +form, sorting is always done in-place. @end defun @cindex comparing values @cindex standard sorting order +@anchor{definition of value<} @defun value< a b This function returns non-@code{nil} if @var{a} comes before @var{b} in the standard sorting order; this means that it returns @code{nil} when diff --git a/etc/NEWS b/etc/NEWS index 73ffff9f2d3..4018df1fecb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1770,6 +1770,31 @@ lexicographically. It is intended as a convenient ordering predicate for sorting, and is likely to be faster than hand-written Lisp functions. ++++ +** New 'sort' arguments and features. +The 'sort' function can now be called using the signature + + (sort SEQ &rest KEYWORD-ARGUMENTS) + +where arguments after the first are keyword/value pairs, all optional: +':key' specifies a function that produces the sorting key from an element, +':lessp' specifies the ordering predicate, defaulting to 'value<', +':reverse' is used to reverse the sorting order, +':in-place is used for in-place sorting, as the default is now to +sort a copy of the input. + +The new signature is less error-prone and reduces the need to write +ordering predicates by hand. We recommend that you use the ':key' +argument instead of ':lessp' unless a suitable ordering predicate is +already available. This can also be used for multi-key sorting: + + (sort seq :key (lambda (x) (list (age x) (size x) (cost x)))) + +sorts by the return value of 'age', then by 'size', then by 'cost'. + +The old signature, '(sort SEQ PREDICATE)', can still be used and sorts +its input in-place as before. + ** 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 diff --git a/src/dired.c b/src/dired.c index 9a372201ae0..bfbacf70917 100644 --- a/src/dired.c +++ b/src/dired.c @@ -351,7 +351,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, specpdl_ptr = specpdl_ref_to_ptr (count); if (NILP (nosort)) - list = Fsort (Fnreverse (list), + list = CALLN (Fsort, Fnreverse (list), attrs ? Qfile_attributes_lessp : Qstring_lessp); (void) directory_volatile; diff --git a/src/fns.c b/src/fns.c index a3ef99f67a8..7eacf99cbba 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2353,7 +2353,8 @@ See also the function `nreverse', which is used more often. */) is destructively reused to hold the sorted result. */ static Lisp_Object -sort_list (Lisp_Object list, Lisp_Object predicate, Lisp_Object keyfunc) +sort_list (Lisp_Object list, Lisp_Object predicate, Lisp_Object keyfunc, + bool reverse) { ptrdiff_t length = list_length (list); if (length < 2) @@ -2369,7 +2370,7 @@ sort_list (Lisp_Object list, Lisp_Object predicate, Lisp_Object keyfunc) result[i] = Fcar (tail); tail = XCDR (tail); } - tim_sort (predicate, keyfunc, result, length); + tim_sort (predicate, keyfunc, result, length, reverse); ptrdiff_t i = 0; tail = list; @@ -2388,27 +2389,86 @@ sort_list (Lisp_Object list, Lisp_Object predicate, Lisp_Object keyfunc) algorithm. */ static void -sort_vector (Lisp_Object vector, Lisp_Object predicate, Lisp_Object keyfunc) +sort_vector (Lisp_Object vector, Lisp_Object predicate, Lisp_Object keyfunc, + bool reverse) { ptrdiff_t length = ASIZE (vector); if (length < 2) return; - tim_sort (predicate, keyfunc, XVECTOR (vector)->contents, length); + tim_sort (predicate, keyfunc, XVECTOR (vector)->contents, length, reverse); } -DEFUN ("sort", Fsort, Ssort, 2, 2, 0, - doc: /* Sort SEQ, stably, comparing elements using PREDICATE. -Returns the sorted sequence. SEQ should be a list or vector. SEQ is -modified by side effects. PREDICATE is called with two elements of -SEQ, and should return non-nil if the first element should sort before -the second. */) - (Lisp_Object seq, Lisp_Object predicate) +DEFUN ("sort", Fsort, Ssort, 1, MANY, 0, + doc: /* Sort SEQ, stably, and return the sorted sequence. +SEQ should be a list or vector. +Optional arguments are specified as keyword/argument pairs. The following +arguments are defined: + +:key FUNC -- FUNC is a function that takes a single element from SEQ and + returns the key value to be used in comparison. If absent or nil, + `identity' is used. + +:lessp FUNC -- FUNC is a function that takes two arguments and returns + non-nil if the first element should come before the second. + If absent or nil, `value<' is used. + +:reverse BOOL -- if BOOL is non-nil, the sorting order implied by FUNC is + reversed. This does not affect stability: equal elements still retain + their order in the input sequence. + +:in-place BOOL -- if BOOL is non-nil, SEQ is sorted in-place and returned. + Otherwise, a sorted copy of SEQ is returned and SEQ remains unmodified; + this is the default. + +For compatibility, the calling convention (sort SEQ LESSP) can also be used; +in this case, sorting is always done in-place. + +usage: (sort SEQ &key KEY LESSP REVERSE IN-PLACE) */) + (ptrdiff_t nargs, Lisp_Object *args) { + Lisp_Object seq = args[0]; + Lisp_Object key = Qnil; + Lisp_Object lessp = Qnil; + bool inplace = false; + bool reverse = false; + if (nargs == 2) + { + /* old-style invocation without keywords */ + lessp = args[1]; + inplace = true; + } + else if ((nargs & 1) == 0) + error ("Invalid argument list"); + else + for (ptrdiff_t i = 1; i < nargs - 1; i += 2) + { + if (EQ (args[i], QCkey)) + key = args[i + 1]; + else if (EQ (args[i], QClessp)) + lessp = args[i + 1]; + else if (EQ (args[i], QCin_place)) + inplace = !NILP (args[i + 1]); + else if (EQ (args[i], QCreverse)) + reverse = !NILP (args[i + 1]); + else + signal_error ("Invalid keyword argument", args[i]); + } + + if (NILP (lessp)) + /* FIXME: normalise it as Qnil instead, and special-case it in tim_sort? + That would remove the funcall overhead for the common case. */ + lessp = Qvaluelt; + + /* FIXME: for lists it may be slightly faster to make the copy after + sorting? Measure. */ + if (!inplace) + seq = Fcopy_sequence (seq); + if (CONSP (seq)) - seq = sort_list (seq, predicate, Qnil); + seq = sort_list (seq, lessp, key, reverse); else if (VECTORP (seq)) - sort_vector (seq, predicate, Qnil); + sort_vector (seq, lessp, key, reverse); else if (!NILP (seq)) wrong_type_argument (Qlist_or_vector_p, seq); return seq; @@ -6860,4 +6920,10 @@ For best results this should end in a space. */); DEFSYM (Qfrom__tty_menu_p, "from--tty-menu-p"); DEFSYM (Qyes_or_no_p, "yes-or-no-p"); DEFSYM (Qy_or_n_p, "y-or-n-p"); + + DEFSYM (QCkey, ":key"); + DEFSYM (QClessp, ":lessp"); + DEFSYM (QCin_place, ":in-place"); + DEFSYM (QCreverse, ":reverse"); + DEFSYM (Qvaluelt, "value<"); } diff --git a/src/lisp.h b/src/lisp.h index 14c0b8e4d1c..6226ab33244 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4299,7 +4299,8 @@ extern void syms_of_fns (void); extern void mark_fns (void); /* Defined in sort.c */ -extern void tim_sort (Lisp_Object, Lisp_Object, Lisp_Object *, const ptrdiff_t); +extern void tim_sort (Lisp_Object, Lisp_Object, Lisp_Object *, const ptrdiff_t, + bool); /* Defined in floatfns.c. */ verify (FLT_RADIX == 2 || FLT_RADIX == 16); diff --git a/src/pdumper.c b/src/pdumper.c index c7ebb38dea5..ac8bf6f31f4 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -3368,7 +3368,7 @@ dump_sort_copied_objects (struct dump_context *ctx) file and the copy into Emacs in-order, where prefetch will be most effective. */ ctx->copied_queue = - Fsort (Fnreverse (ctx->copied_queue), + CALLN (Fsort, Fnreverse (ctx->copied_queue), Qdump_emacs_portable__sort_predicate_copied); } @@ -3935,7 +3935,7 @@ drain_reloc_list (struct dump_context *ctx, { struct dump_flags old_flags = ctx->flags; ctx->flags.pack_objects = true; - Lisp_Object relocs = Fsort (Fnreverse (*reloc_list), + Lisp_Object relocs = CALLN (Fsort, Fnreverse (*reloc_list), Qdump_emacs_portable__sort_predicate); *reloc_list = Qnil; dump_align_output (ctx, max (alignof (struct dump_reloc), @@ -4057,7 +4057,7 @@ static void dump_do_fixups (struct dump_context *ctx) { dump_off saved_offset = ctx->offset; - Lisp_Object fixups = Fsort (Fnreverse (ctx->fixups), + Lisp_Object fixups = CALLN (Fsort, Fnreverse (ctx->fixups), Qdump_emacs_portable__sort_predicate); Lisp_Object prev_fixup = Qnil; ctx->fixups = Qnil; diff --git a/src/sort.c b/src/sort.c index d91993c8c65..a0f127c35b3 100644 --- a/src/sort.c +++ b/src/sort.c @@ -1072,11 +1072,11 @@ resolve_fun (Lisp_Object fun) } /* Sort the array SEQ with LENGTH elements in the order determined by - PREDICATE. */ - + PREDICATE (where Qnil means value<) and KEYFUNC (where Qnil means identity), + optionally reversed. */ void tim_sort (Lisp_Object predicate, Lisp_Object keyfunc, - Lisp_Object *seq, const ptrdiff_t length) + Lisp_Object *seq, const ptrdiff_t length, bool reverse) { /* FIXME: optimise for the predicate being value<; at the very least we'd go without the Lisp funcall overhead. */ @@ -1091,9 +1091,8 @@ tim_sort (Lisp_Object predicate, Lisp_Object keyfunc, if (EQ (keyfunc, Qidentity)) keyfunc = Qnil; - /* FIXME: consider a built-in reverse sorting flag: we would reverse - the input in-place here and reverse it back just before - returning. */ + if (reverse) + reverse_slice (seq, seq + length); /* preserve stability */ if (NILP (keyfunc)) { @@ -1159,6 +1158,9 @@ tim_sort (Lisp_Object predicate, Lisp_Object keyfunc, eassume (ms.pending[0].len == length); lo = ms.pending[0].base; + if (reverse) + reverse_slice (seq, seq + length); + if (ms.a.keys != ms.temparray || allocated_keys != NULL) unbind_to (ms.count, Qnil); } diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 844000cdc76..1b13785a9fc 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -375,6 +375,49 @@ (should (equal (should-error (sort "cba" #'<) :type 'wrong-type-argument) '(wrong-type-argument list-or-vector-p "cba")))) +(defun fns-tests--shuffle-vector (vect) + "Shuffle VECT in place." + (let ((n (length vect))) + (dotimes (i (1- n)) + (let* ((j (+ i (random (- n i)))) + (vi (aref vect i))) + (aset vect i (aref vect j)) + (aset vect j vi))))) + +(ert-deftest fns-tests-sort-kw () + ;; Test the `sort' keyword calling convention by comparing with + ;; the results from using the old (positional) style tested above. + (random "my seed") + (dolist (size '(0 1 2 3 10 100 1000)) + ;; Use a vector with both positive and negative numbers (asymmetric). + (let ((numbers (vconcat + (number-sequence (- (/ size 3)) (- size 1 (/ size 3)))))) + (fns-tests--shuffle-vector numbers) + ;; Test both list and vector input. + (dolist (input (list (append numbers nil) numbers)) + (dolist (in-place '(nil t)) + (dolist (reverse '(nil t)) + (dolist (key '(nil abs)) + (dolist (lessp '(nil >)) + (let* ((seq (copy-sequence input)) + (res (sort seq :key key :lessp lessp + :in-place in-place :reverse reverse)) + (pred (or lessp #'value<)) + (exp-in (copy-sequence input)) + (exp-out + (sort (if reverse (reverse exp-in) exp-in) + (if key + (lambda (a b) + (funcall pred + (funcall key a) (funcall key b))) + pred))) + (expected (if reverse (reverse exp-out) exp-out))) + (should (equal res expected)) + (if in-place + (should (eq res seq)) + (should-not (and (> size 0) (eq res seq))) + (should (equal seq input)))))))))))) + (defvar w32-collate-ignore-punctuation) (ert-deftest fns-tests-collate-sort () -- cgit v1.2.3 From deae311281522864ebabaf56adafbe37032cc8a9 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 21 Mar 2024 19:35:15 +0100 Subject: Speed up `sort` by special-casing the `value<` ordering This gives a 1.5x-2x speed-up when using the default :lessp value, by eliminating the Ffuncall overhead. * src/sort.c (order_pred_lisp, order_pred_valuelt): New. (merge_state, inorder, binarysort, count_run, gallop_left, gallop_right) (merge_init, merge_lo, merge_hi, tim_sort): * src/fns.c (Fsort): When using value<, call it directly. --- src/fns.c | 5 ---- src/sort.c | 79 +++++++++++++++++++++++++++++++------------------------------- 2 files changed, 40 insertions(+), 44 deletions(-) diff --git a/src/fns.c b/src/fns.c index 7eacf99cbba..bf7c0920750 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2455,11 +2455,6 @@ usage: (sort SEQ &key KEY LESSP REVERSE IN-PLACE) */) signal_error ("Invalid keyword argument", args[i]); } - if (NILP (lessp)) - /* FIXME: normalise it as Qnil instead, and special-case it in tim_sort? - That would remove the funcall overhead for the common case. */ - lessp = Qvaluelt; - /* FIXME: for lists it may be slightly faster to make the copy after sorting? Measure. */ if (!inplace) diff --git a/src/sort.c b/src/sort.c index a0f127c35b3..527d5550342 100644 --- a/src/sort.c +++ b/src/sort.c @@ -152,7 +152,7 @@ struct reloc }; -typedef struct +typedef struct merge_state { Lisp_Object *basekeys; Lisp_Object *allocated_keys; /* heap-alloc'ed key array or NULL */ @@ -187,20 +187,32 @@ typedef struct struct reloc reloc; - /* PREDICATE is the lisp comparison predicate for the sort. */ + /* The C ordering (less-than) predicate. */ + bool (*pred_fun) (struct merge_state *ms, Lisp_Object a, Lisp_Object b); + /* The Lisp ordering predicate; Qnil means value<. */ Lisp_Object predicate; } merge_state; -/* Return true iff (PREDICATE A B) is non-nil. */ +static bool +order_pred_lisp (merge_state *ms, Lisp_Object a, Lisp_Object b) +{ + return !NILP (call2 (ms->predicate, a, b)); +} -static inline bool -inorder (const Lisp_Object predicate, const Lisp_Object a, const Lisp_Object b) +static bool +order_pred_valuelt (merge_state *ms, Lisp_Object a, Lisp_Object b) { - return !NILP (call2 (predicate, a, b)); + return !NILP (Fvaluelt (a, b)); } +/* Return true iff A < B according to the order predicate. */ +static inline bool +inorder (merge_state *ms, Lisp_Object a, Lisp_Object b) +{ + return ms->pred_fun (ms, a, b); +} /* Sort the list starting at LO and ending at HI using a stable binary insertion sort algorithm. On entry the sublist [LO, START) (with @@ -212,8 +224,6 @@ static void binarysort (merge_state *ms, sortslice lo, const Lisp_Object *hi, Lisp_Object *start) { - Lisp_Object pred = ms->predicate; - eassume (lo.keys <= start && start <= hi); if (lo.keys == start) ++start; @@ -226,7 +236,7 @@ binarysort (merge_state *ms, sortslice lo, const Lisp_Object *hi, eassume (l < r); do { Lisp_Object *p = l + ((r - l) >> 1); - if (inorder (pred, pivot, *p)) + if (inorder (ms, pivot, *p)) r = p; else l = p + 1; @@ -263,8 +273,6 @@ static ptrdiff_t count_run (merge_state *ms, Lisp_Object *lo, const Lisp_Object *hi, bool *descending) { - Lisp_Object pred = ms->predicate; - eassume (lo < hi); *descending = 0; ++lo; @@ -273,12 +281,12 @@ count_run (merge_state *ms, Lisp_Object *lo, const Lisp_Object *hi, return n; n = 2; - if (inorder (pred, lo[0], lo[-1])) + if (inorder (ms, lo[0], lo[-1])) { *descending = 1; for (lo = lo + 1; lo < hi; ++lo, ++n) { - if (!inorder (pred, lo[0], lo[-1])) + if (!inorder (ms, lo[0], lo[-1])) break; } } @@ -286,7 +294,7 @@ count_run (merge_state *ms, Lisp_Object *lo, const Lisp_Object *hi, { for (lo = lo + 1; lo < hi; ++lo, ++n) { - if (inorder (pred, lo[0], lo[-1])) + if (inorder (ms, lo[0], lo[-1])) break; } } @@ -319,21 +327,19 @@ static ptrdiff_t gallop_left (merge_state *ms, const Lisp_Object key, Lisp_Object *a, const ptrdiff_t n, const ptrdiff_t hint) { - Lisp_Object pred = ms->predicate; - eassume (a && n > 0 && hint >= 0 && hint < n); a += hint; ptrdiff_t lastofs = 0; ptrdiff_t ofs = 1; - if (inorder (pred, *a, key)) + if (inorder (ms, *a, key)) { /* When a[hint] < key, gallop right until a[hint + lastofs] < key <= a[hint + ofs]. */ const ptrdiff_t maxofs = n - hint; /* This is one after the end of a. */ while (ofs < maxofs) { - if (inorder (pred, a[ofs], key)) + if (inorder (ms, a[ofs], key)) { lastofs = ofs; eassume (ofs <= (PTRDIFF_MAX - 1) / 2); @@ -355,7 +361,7 @@ gallop_left (merge_state *ms, const Lisp_Object key, Lisp_Object *a, const ptrdiff_t maxofs = hint + 1; /* Here &a[0] is lowest. */ while (ofs < maxofs) { - if (inorder (pred, a[-ofs], key)) + if (inorder (ms, a[-ofs], key)) break; /* Here key <= a[hint - ofs]. */ lastofs = ofs; @@ -380,7 +386,7 @@ gallop_left (merge_state *ms, const Lisp_Object key, Lisp_Object *a, { ptrdiff_t m = lastofs + ((ofs - lastofs) >> 1); - if (inorder (pred, a[m], key)) + if (inorder (ms, a[m], key)) lastofs = m + 1; /* Here a[m] < key. */ else ofs = m; /* Here key <= a[m]. */ @@ -403,21 +409,19 @@ static ptrdiff_t gallop_right (merge_state *ms, const Lisp_Object key, Lisp_Object *a, const ptrdiff_t n, const ptrdiff_t hint) { - Lisp_Object pred = ms->predicate; - eassume (a && n > 0 && hint >= 0 && hint < n); a += hint; ptrdiff_t lastofs = 0; ptrdiff_t ofs = 1; - if (inorder (pred, key, *a)) + if (inorder (ms, key, *a)) { /* When key < a[hint], gallop left until a[hint - ofs] <= key < a[hint - lastofs]. */ const ptrdiff_t maxofs = hint + 1; /* Here &a[0] is lowest. */ while (ofs < maxofs) { - if (inorder (pred, key, a[-ofs])) + if (inorder (ms, key, a[-ofs])) { lastofs = ofs; eassume (ofs <= (PTRDIFF_MAX - 1) / 2); @@ -440,7 +444,7 @@ gallop_right (merge_state *ms, const Lisp_Object key, Lisp_Object *a, const ptrdiff_t maxofs = n - hint; /* Here &a[n-1] is highest. */ while (ofs < maxofs) { - if (inorder (pred, key, a[ofs])) + if (inorder (ms, key, a[ofs])) break; /* Here a[hint + ofs] <= key. */ lastofs = ofs; @@ -464,7 +468,7 @@ gallop_right (merge_state *ms, const Lisp_Object key, Lisp_Object *a, { ptrdiff_t m = lastofs + ((ofs - lastofs) >> 1); - if (inorder (pred, key, a[m])) + if (inorder (ms, key, a[m])) ofs = m; /* Here key < a[m]. */ else lastofs = m + 1; /* Here a[m] <= key. */ @@ -509,6 +513,7 @@ merge_init (merge_state *ms, const ptrdiff_t list_size, ms->listlen = list_size; ms->basekeys = lo->keys; ms->allocated_keys = allocated_keys; + ms->pred_fun = NILP (predicate) ? order_pred_valuelt : order_pred_lisp; ms->predicate = predicate; ms->reloc = (struct reloc){NULL, NULL, NULL, 0}; ms->count = make_invalid_specpdl_ref (); @@ -637,8 +642,6 @@ static void merge_lo (merge_state *ms, sortslice ssa, ptrdiff_t na, sortslice ssb, ptrdiff_t nb) { - Lisp_Object pred = ms->predicate; - eassume (ms && ssa.keys && ssb.keys && na > 0 && nb > 0); eassume (ssa.keys + na == ssb.keys); needmem (ms, na); @@ -665,7 +668,7 @@ merge_lo (merge_state *ms, sortslice ssa, ptrdiff_t na, for (;;) { eassume (na > 1 && nb > 0); - if (inorder (pred, ssb.keys[0], ssa.keys[0])) + if (inorder (ms, ssb.keys[0], ssa.keys[0])) { sortslice_copy_incr (&dest, &ssb); ++bcount; @@ -762,8 +765,6 @@ static void merge_hi (merge_state *ms, sortslice ssa, ptrdiff_t na, sortslice ssb, ptrdiff_t nb) { - Lisp_Object pred = ms->predicate; - eassume (ms && ssa.keys && ssb.keys && na > 0 && nb > 0); eassume (ssa.keys + na == ssb.keys); needmem (ms, nb); @@ -793,7 +794,7 @@ merge_hi (merge_state *ms, sortslice ssa, ptrdiff_t na, for (;;) { eassume (na > 0 && nb > 1); - if (inorder (pred, ssb.keys[0], ssa.keys[0])) + if (inorder (ms, ssb.keys[0], ssa.keys[0])) { sortslice_copy_decr (&dest, &ssa); ++acount; @@ -1078,19 +1079,19 @@ void tim_sort (Lisp_Object predicate, Lisp_Object keyfunc, Lisp_Object *seq, const ptrdiff_t length, bool reverse) { - /* FIXME: optimise for the predicate being value<; at the very - least we'd go without the Lisp funcall overhead. */ - predicate = resolve_fun (predicate); + /* FIXME: hoist this to the caller? */ + if (EQ (predicate, Qvaluelt)) + predicate = Qnil; + if (!NILP (predicate)) + predicate = resolve_fun (predicate); + if (EQ (keyfunc, Qidentity)) + keyfunc = Qnil; sortslice lo; Lisp_Object *keys; Lisp_Object *allocated_keys = NULL; merge_state ms; - /* FIXME: hoist this to the caller? */ - if (EQ (keyfunc, Qidentity)) - keyfunc = Qnil; - if (reverse) reverse_slice (seq, seq + length); /* preserve stability */ -- cgit v1.2.3 From 45941a62c799f9685fae296079304ae0898920cc Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 22 Mar 2024 11:54:09 +0100 Subject: Faster non-destructive list sorting Postpone the creation of a new list to after sorting which turns out to be a lot faster (1.1x - 1.5x speedup). * src/fns.c (sort_list, sort_vector, Fsort): Create the new list when moving the data out from the temporary array. --- src/fns.c | 65 ++++++++++++++++++++++++++++++++++----------------------------- 1 file changed, 35 insertions(+), 30 deletions(-) diff --git a/src/fns.c b/src/fns.c index bf7c0920750..8d8783713ab 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2347,18 +2347,17 @@ See also the function `nreverse', which is used more often. */) } -/* Stably sort LIST ordered by PREDICATE using the TIMSORT - algorithm. This converts the list to a vector, sorts the vector, - and returns the result converted back to a list. The input list - is destructively reused to hold the sorted result. */ - +/* Stably sort LIST ordered by PREDICATE and KEYFUNC, optionally reversed. + This converts the list to a vector, sorts the vector, and returns the + result converted back to a list. If INPLACE, the input list is + reused to hold the sorted result; otherwise a new list is returned. */ static Lisp_Object sort_list (Lisp_Object list, Lisp_Object predicate, Lisp_Object keyfunc, - bool reverse) + bool reverse, bool inplace) { ptrdiff_t length = list_length (list); if (length < 2) - return list; + return inplace ? list : list1 (XCAR (list)); else { Lisp_Object *result; @@ -2372,31 +2371,40 @@ sort_list (Lisp_Object list, Lisp_Object predicate, Lisp_Object keyfunc, } tim_sort (predicate, keyfunc, result, length, reverse); - ptrdiff_t i = 0; - tail = list; - while (CONSP (tail)) + if (inplace) { - XSETCAR (tail, result[i]); - tail = XCDR (tail); - i++; + /* Copy sorted vector contents back onto the original list. */ + ptrdiff_t i = 0; + tail = list; + while (CONSP (tail)) + { + XSETCAR (tail, result[i]); + tail = XCDR (tail); + i++; + } + } + else + { + /* Create a new list for the sorted vector contents. */ + list = Qnil; + for (ptrdiff_t i = length - 1; i >= 0; i--) + list = Fcons (result[i], list); } SAFE_FREE (); return list; } } -/* Stably sort VECTOR ordered by PREDICATE using the TIMSORT - algorithm. */ - -static void +/* Stably sort VECTOR in-place ordered by PREDICATE and KEYFUNC, + optionally reversed. */ +static Lisp_Object sort_vector (Lisp_Object vector, Lisp_Object predicate, Lisp_Object keyfunc, bool reverse) { ptrdiff_t length = ASIZE (vector); - if (length < 2) - return; - - tim_sort (predicate, keyfunc, XVECTOR (vector)->contents, length, reverse); + if (length >= 2) + tim_sort (predicate, keyfunc, XVECTOR (vector)->contents, length, reverse); + return vector; } DEFUN ("sort", Fsort, Ssort, 1, MANY, 0, @@ -2455,18 +2463,15 @@ usage: (sort SEQ &key KEY LESSP REVERSE IN-PLACE) */) signal_error ("Invalid keyword argument", args[i]); } - /* FIXME: for lists it may be slightly faster to make the copy after - sorting? Measure. */ - if (!inplace) - seq = Fcopy_sequence (seq); - if (CONSP (seq)) - seq = sort_list (seq, lessp, key, reverse); + return sort_list (seq, lessp, key, reverse, inplace); + else if (NILP (seq)) + return seq; else if (VECTORP (seq)) - sort_vector (seq, lessp, key, reverse); - else if (!NILP (seq)) + return sort_vector (inplace ? seq : Fcopy_sequence (seq), + lessp, key, reverse); + else wrong_type_argument (Qlist_or_vector_p, seq); - return seq; } Lisp_Object -- cgit v1.2.3 From 92d659ce6cd2e79231f1011202abb39606d6f06b Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 22 Mar 2024 15:08:50 +0100 Subject: Use new-style `sort` signature in Lisp manual examples * doc/lispref/help.texi (Accessing Documentation): * doc/lispref/strings.texi (Text Comparison): Use the new sort calling convention (bug#69709). --- doc/lispref/help.texi | 2 +- doc/lispref/strings.texi | 7 ++++--- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index a76bac011b7..4236fa75bf0 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -231,7 +231,7 @@ in the *Help* buffer." (help-setup-xref (list 'describe-symbols pattern) (called-interactively-p 'interactive)) (with-help-window (help-buffer) - (mapcar describe-func (sort sym-list 'string<))))) + (mapcar describe-func (sort sym-list))))) @end group @end smallexample diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 6a9dd589237..7f640255a7a 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -692,7 +692,8 @@ for sorting (@pxref{Sequence Functions}): @example @group -(sort (list "11" "12" "1 1" "1 2" "1.1" "1.2") 'string-collate-lessp) +(sort '("11" "12" "1 1" "1 2" "1.1" "1.2") + :lessp #'string-collate-lessp) @result{} ("11" "1 1" "1.1" "12" "1 2" "1.2") @end group @end example @@ -709,8 +710,8 @@ systems. The @var{locale} value of @code{"POSIX"} or @code{"C"} lets @example @group -(sort (list "11" "12" "1 1" "1 2" "1.1" "1.2") - (lambda (s1 s2) (string-collate-lessp s1 s2 "POSIX"))) +(sort '("11" "12" "1 1" "1 2" "1.1" "1.2") + :lessp (lambda (s1 s2) (string-collate-lessp s1 s2 "POSIX"))) @result{} ("1 1" "1 2" "1.1" "1.2" "11" "12") @end group @end example -- cgit v1.2.3 From cbd862865ff0a08d1214ac33590e7af80d10a0ac Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 22 Mar 2024 15:06:27 +0100 Subject: Remove `sort-on` (bug#69709) * lisp/sort.el (sort-on): * doc/lispref/sequences.texi (Sequence Functions): * etc/NEWS: Remove the `sort-on` function which is now completely superseded by the extended `sort` in features, ease of use, and performance. --- doc/lispref/sequences.texi | 40 ++++------------------------------------ etc/NEWS | 5 ----- lisp/sort.el | 21 --------------------- 3 files changed, 4 insertions(+), 62 deletions(-) diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 6322f17e77b..de83b96d748 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -440,6 +440,10 @@ where @var{predicate} is the @code{:lessp} argument. When using this form, sorting is always done in-place. @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 comparing values @cindex standard sorting order @anchor{definition of value<} @@ -476,42 +480,6 @@ Examples: @end example @end defun -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 -or vector element exactly once. - -@cindex decorate-sort-undecorate -@cindex Schwartzian transform -@defun sort-on sequence predicate accessor -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}. - -This function implements what is known as @dfn{decorate-sort-undecorate} -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 -original @var{sequence} 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 4018df1fecb..6cefe11a2cc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1795,11 +1795,6 @@ sorts by the return value of 'age', then by 'size', then by 'cost'. The old signature, '(sort SEQ PREDICATE)', can still be used and sorts its input in-place as before. -** 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 4f0d759ef8a..2ee76b6e1e3 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -478,27 +478,6 @@ 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 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 -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 -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) -- cgit v1.2.3 From b20866c4b3aa1446efda252bd5c3fa54f68c5d7f Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 24 Mar 2024 18:18:41 +0100 Subject: Better `sort` ignored-return-value warning * lisp/emacs-lisp/bytecomp.el (byte-compile-form) (bytecomp--actually-important-return-value-p): Special handling of `sort` that takes into account that it may return an important value depending on the :in-place keyword argument. --- lisp/emacs-lisp/bytecomp.el | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 7af568cfe34..2b5eb34e571 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3445,6 +3445,7 @@ lambda-expression." ((and (or sef (function-get (car form) 'important-return-value)) ;; Don't warn for arguments to `ignore'. (not (eq byte-compile--for-effect 'for-effect-no-warn)) + (bytecomp--actually-important-return-value-p form) (byte-compile-warning-enabled-p 'ignored-return-value (car form))) (byte-compile-warn-x @@ -3471,6 +3472,15 @@ lambda-expression." (if byte-compile--for-effect (byte-compile-discard))))) +(defun bytecomp--actually-important-return-value-p (form) + "Whether FORM is really a call with a return value that should not go unused. +This assumes the function has the `important-return-value' property." + (cond ((eq (car form) 'sort) + ;; For `sort', we only care about non-destructive uses. + (and (zerop (% (length form) 2)) ; new-style call + (not (plist-get (cddr form) :in-place)))) + (t t))) + (let ((important-return-value-fns '( ;; These functions are side-effect-free except for the @@ -3478,9 +3488,11 @@ lambda-expression." mapcar mapcan mapconcat assoc plist-get plist-member - ;; It's safe to ignore the value of `sort' and `nreverse' + ;; It's safe to ignore the value of `nreverse' ;; when used on arrays, but most calls pass lists. - nreverse sort + nreverse + + sort ; special handling (non-destructive calls only) match-data -- cgit v1.2.3 From 2f0df93d8ca0a8d4d6b040458661b8eb21fc39e9 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 29 Mar 2024 11:53:56 +0100 Subject: ; * test/lisp/vc/vc-git-tests.el: bend doc string quote --- test/lisp/vc/vc-git-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/lisp/vc/vc-git-tests.el b/test/lisp/vc/vc-git-tests.el index bbf0c4277dd..f15a0f52e8c 100644 --- a/test/lisp/vc/vc-git-tests.el +++ b/test/lisp/vc/vc-git-tests.el @@ -91,7 +91,7 @@ will be bound to that directory's file name. Once BODY exits, the directory will be deleted. Some dummy environment variables will be set for the duration of BODY to -allow 'git commit' to determine identities for authors and committers." +allow `git commit' to determine identities for authors and committers." (declare (indent 1)) `(ert-with-temp-directory ,name (let ((default-directory ,name) -- cgit v1.2.3 From 1f19ddec5b06720086c67d5d8b7d2184e9eef288 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 29 Mar 2024 15:03:44 +0300 Subject: ; * doc/lispref/sequences.texi (Sequence Functions): Fix markup and examples. --- doc/lispref/sequences.texi | 31 ++++++++++++++++++++++--------- 1 file changed, 22 insertions(+), 9 deletions(-) diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index de83b96d748..4a4241b92c9 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -359,7 +359,7 @@ returns a sorted sequence of the same type. The sort is stable, which means that elements with equal sort keys maintain their relative order. It takes the following optional keyword arguments: -@table @asis +@table @code @item :key @var{keyfunc} Use @var{keyfunc}, a function that takes a single element from @var{sequence} and returns its key value, to generate the keys used in @@ -373,7 +373,7 @@ that takes two sort keys as arguments and returns non-@code{nil} if the first should come before the second. If this argument is absent or @var{predicate} is @code{nil}, then @code{value<} is used, which is applicable to many different Lisp types and generally sorts in -ascending order (@pxref{definition of value<}). +ascending order (@pxref{definition of value<}, below). For consistency, any predicate must obey the following rules: @itemize @bullet @@ -402,19 +402,24 @@ easier and faster to supply a new @code{:key} function than a different @code{:lessp} predicate. For example, consider sorting these strings: @example +@group (setq numbers '("one" "two" "three" "four" "five" "six")) (sort numbers) @result{} ("five" "four" "one" "six" "three" "two") +@end group @end example You can sort the strings by length instead by supplying a different key function: @example +@group (sort numbers :key #'length) @result{} ("one" "two" "six" "four" "five" "three") +@end group @end example +@noindent Note how strings of the same length keep their original order, thanks to the sorting stability. Now suppose you want to sort by length, but use the string contents to break ties. The easiest way is to specify a key @@ -423,19 +428,23 @@ Since @code{value<} orders compound objects (conses, lists, vectors and records) lexicographically, you could do: @example +@group (sort numbers :key (lambda (x) (cons (length x) x))) @result{} ("one" "six" "two" "five" "four" "three") +@end group @end example +@noindent because @code{(3 . "six")} is ordered before @code{(3 . "two")} and so on. -For compatibility with old versions of Emacs, the @code{sort} function -can also be called using the fixed two-argument form +For compatibility with previous versions of Emacs, the @code{sort} +function can also be called using the fixed two-argument form: @example (@code{sort} @var{sequence} @var{predicate}) @end example +@noindent where @var{predicate} is the @code{:lessp} argument. When using this form, sorting is always done in-place. @end defun @@ -452,22 +461,26 @@ This function returns non-@code{nil} if @var{a} comes before @var{b} in the standard sorting order; this means that it returns @code{nil} when @var{b} comes before @var{a}, or if they are equal or unordered. -@var{a} and @var{b} must have the same type. Specifically: +the arguments @var{a} and @var{b} must have the same type. +Specifically: @itemize @bullet @item Numbers are compared using @code{<} (@pxref{definition of <}). @item -Strings and symbols are compared using @code{string<} -(@pxref{definition of string<}). +Strings are compared using @code{string<} (@pxref{definition of +string<}) and symbols are compared by comparing their names as strings. @item Conses, lists, vectors and records are compared lexicographically. @item Markers are compared first by buffer, then by position. @item -Buffers and processes are compared by name. +Buffers and processes are compared by comparing their names as strings. +Dead buffers (whose name is @code{nil}) will compare before any live +buffer. @item -Other types are considered unordered and the return value will be @code{nil}. +Other types are considered unordered and the return value will be +@code{nil}. @end itemize Examples: -- cgit v1.2.3 From 6f7cb96543285dc8e37135abaec87d0b9a40e2e2 Mon Sep 17 00:00:00 2001 From: Sam Steingold Date: Fri, 29 Mar 2024 10:36:43 -0400 Subject: Support `shell-resync-dirs' on msys bash (Bug#70012) * lisp/shell.el (w32-application-type): Declare. (shell-mode): Set `shell-dirstack-query' to `pwd -W` when using msys bash. --- lisp/shell.el | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/lisp/shell.el b/lisp/shell.el index c5cfbd985ed..8a5218ae847 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -606,6 +606,9 @@ Shell buffers. It implements `shell-completion-execonly' for (defvar sh-shell-file) +(declare-function w32-application-type nil ; "src/w32proc.c" + (program) t) + (define-derived-mode shell-mode comint-mode "Shell" "Major mode for interacting with an inferior shell. \\ @@ -754,6 +757,11 @@ command." ((string-equal shell "ksh") "echo $PWD ~-") ;; Bypass any aliases. TODO all shells could use this. ((string-equal shell "bash") "command dirs") + ((and (string-equal shell "bash.exe") + (eq system-type 'windows-nt) + (eq (w32-application-type (executable-find "bash.exe")) + 'msys)) + "command pwd -W") ((string-equal shell "zsh") "dirs -l") (t "dirs"))) ;; Bypass a bug in certain versions of bash. -- cgit v1.2.3 From d2d5e514397c453bbaa6e7fc3441af2d538eb3cf Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 29 Mar 2024 15:23:56 +0100 Subject: * src/fns.c (Fvaluelt): More generous depth limit (20 -> 200). This gives `value<` the same limit as `equal` which seems about right. --- src/fns.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fns.c b/src/fns.c index 8d8783713ab..db5e856d5bd 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3201,7 +3201,7 @@ Buffers and processes are compared by name. Other types are considered unordered and the return value will be `nil'. */) (Lisp_Object a, Lisp_Object b) { - int maxdepth = 20; /* FIXME: arbitrary value */ + int maxdepth = 200; /* FIXME: arbitrary value */ return value_cmp (a, b, maxdepth) < 0 ? Qt : Qnil; } -- cgit v1.2.3 From f04bd5568708f96dfad0e8240c7f8f23c90b6813 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 29 Mar 2024 15:25:22 +0100 Subject: `value<` manual entry adjustments (bug#69709) * doc/lispref/sequences.texi (Sequence Functions): Explain lexicographical ordering. Note the dual nature of `nil`. Mention the depth limit. --- doc/lispref/sequences.texi | 24 +++++++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 4a4241b92c9..c9e47624878 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -461,7 +461,7 @@ This function returns non-@code{nil} if @var{a} comes before @var{b} in the standard sorting order; this means that it returns @code{nil} when @var{b} comes before @var{a}, or if they are equal or unordered. -the arguments @var{a} and @var{b} must have the same type. +The arguments @var{a} and @var{b} must have the same type. Specifically: @itemize @bullet @@ -471,7 +471,11 @@ Numbers are compared using @code{<} (@pxref{definition of <}). Strings are compared using @code{string<} (@pxref{definition of string<}) and symbols are compared by comparing their names as strings. @item -Conses, lists, vectors and records are compared lexicographically. +Conses, lists, vectors and records are compared lexicographically. This +means that the two sequences are compared element-wise from left to +right until they differ, and the result is then that of @code{value<} on +the first pair of differing elements. If one sequence runs out of +elements before the other, the shorter sequence comes before the longer. @item Markers are compared first by buffer, then by position. @item @@ -489,8 +493,22 @@ Examples: (value< "dog" "cat") @result{} nil (value< 'yip 'yip) @result{} nil (value< '(3 2) '(3 2 0)) @result{} t -(value< [3 2 1] [3 2 0]) @result{} nil +(value< [3 2 "a"] [3 2 "b"]) @result{} t @end example + +@noindent +Note that @code{nil} is treated as either a symbol or an empty list, +depending on what it is compared against: + +@example +(value< nil '(0)) @result{} t +(value< 'nib nil) @result{} t +@end example + +@noindent +There is no limit to the length of sequences (lists, vectors and so on) +that can be compared, but @code{value<} may fail with an error if used +to compare circular or deeply nested data structures. @end defun @cindex sequence functions in seq -- cgit v1.2.3 From 42322257ba9abdb8bcc2aceb34a27f261df070aa Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 29 Mar 2024 18:26:38 +0300 Subject: ; * lisp/shell.el (w32-application-type): Fix 'declare-function'. --- lisp/shell.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/shell.el b/lisp/shell.el index 8a5218ae847..cd49d289403 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -606,7 +606,7 @@ Shell buffers. It implements `shell-completion-execonly' for (defvar sh-shell-file) -(declare-function w32-application-type nil ; "src/w32proc.c" +(declare-function w32-application-type "w32proc.c" (program) t) (define-derived-mode shell-mode comint-mode "Shell" -- cgit v1.2.3 From dd3e13469d75851f3d7907e3373d45032382a5f5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 29 Mar 2024 15:32:48 -0400 Subject: * lisp/cedet/semantic/tag.el (semantic-tag): New type --- lisp/cedet/semantic/tag.el | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el index 18a0b4caee2..a0843dd5df9 100644 --- a/lisp/cedet/semantic/tag.el +++ b/lisp/cedet/semantic/tag.el @@ -349,6 +349,9 @@ If TAG is unlinked, but has a :filename property, then that is used." ;; If an error occurs, then it most certainly is not a tag. (error nil))) +;; Used in `semantic-utest-ia.el'. +(cl-deftype semantic-tag () `(satisfies semantic-tag-p)) + (defsubst semantic-tag-of-class-p (tag class) "Return non-nil if class of TAG is CLASS." (eq (semantic-tag-class tag) class)) -- cgit v1.2.3 From 717e7edc2ac1e4e04019319da19c5386077dfbea Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 29 Mar 2024 15:36:45 -0400 Subject: * lisp/emacs-lisp/comp.el (comp--add-cond-cstrs): Consolidate 2 cases --- lisp/emacs-lisp/comp.el | 36 +++++++++++------------------------- 1 file changed, 11 insertions(+), 25 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 2544be85bb2..2ec55ed98ee 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -2036,37 +2036,23 @@ TARGET-BB-SYM is the symbol name of the target block." (,(pred comp--call-op-p) ,(and (pred comp--known-predicate-p) fun) ,op)) - ;; (comment ,_comment-str) - (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks)) - (cl-loop - with target-mvar = (comp--cond-cstrs-target-mvar op (car insns-seq) b) - for branch-target-cell on blocks - for branch-target = (car branch-target-cell) - for negated in '(t nil) - when (comp--mvar-used-p target-mvar) - do - (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) - (setf (car branch-target-cell) (comp-block-name block-target)) - (comp--emit-assume 'and target-mvar (if negated - (comp--pred-to-neg-cstr fun) - (comp--pred-to-pos-cstr fun)) - block-target nil)) - finally (cl-return-from in-the-basic-block))) - ;; Match predicate on the negated branch (unless). - (`((set ,(and (pred comp-mvar-p) cmp-res) - (,(pred comp--call-op-p) - ,(and (pred comp--known-predicate-p) fun) - ,op)) - (set ,neg-cmp-res (call eq ,cmp-res ,(pred comp-cstr-null-p))) - (cond-jump ,neg-cmp-res ,(pred comp-mvar-p) . ,blocks)) + . ,(or + ;; (comment ,_comment-str) + (and `((cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks)) + (let negated-branch nil)) + (and `((set ,neg-cmp-res + (call eq ,cmp-res ,(pred comp-cstr-null-p))) + (cond-jump ,neg-cmp-res ,(pred comp-mvar-p) . ,blocks)) + (let negated-branch t)))) (cl-loop with target-mvar = (comp--cond-cstrs-target-mvar op (car insns-seq) b) for branch-target-cell on blocks for branch-target = (car branch-target-cell) - for negated in '(nil t) + for negated in (if negated-branch '(nil t) '(t nil)) when (comp--mvar-used-p target-mvar) do - (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) + (let ((block-target (comp--add-cond-cstrs-target-block + b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) (comp--emit-assume 'and target-mvar (if negated (comp--pred-to-neg-cstr fun) -- cgit v1.2.3 From bfbddf65245e179ef25c3b9b2699515b2d33ecca Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 30 Mar 2024 08:58:59 +0800 Subject: Fix building the SFNT font driver * src/sfntfont.c (sfntfont_list, sfntfont_list_family): Update calls to Fsort for the new calling convention. --- src/sfntfont.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/sfntfont.c b/src/sfntfont.c index 3be770f650e..fb3feaeaf79 100644 --- a/src/sfntfont.c +++ b/src/sfntfont.c @@ -2029,7 +2029,7 @@ sfntfont_list (struct frame *f, Lisp_Object font_spec) caller) ordered first. */ XSETSUBR (compare_font_entities, &Scompare_font_entities.s); - matching = Fsort (matching, compare_font_entities); + matching = CALLN (Fsort, matching, compare_font_entities); return matching; } @@ -3779,7 +3779,7 @@ sfntfont_list_family (struct frame *f) families = Fcons (desc->family, families); /* Sort families in preparation for removing duplicates. */ - families = Fsort (families, Qstring_lessp); + families = CALLN (Fsort, families, Qstring_lessp); /* Remove each duplicate within families. */ -- cgit v1.2.3 From 4c9926fed157810199695167ba8542af13b04ad3 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 30 Mar 2024 09:59:36 +0800 Subject: Rationalize java/Makefile.in * java/Makefile.in: (emacs.apk-in): Bring commentary up to date, and package classes.dex at this stage of the process. ($(APK_NAME)): Adjust to match. --- java/Makefile.in | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/java/Makefile.in b/java/Makefile.in index 60bd2ea086b..c23b52ed44e 100644 --- a/java/Makefile.in +++ b/java/Makefile.in @@ -256,15 +256,15 @@ install_temp/assets/build_info: install_temp emacs.apk-in: install_temp install_temp/assets/directory-tree \ AndroidManifest.xml install_temp/assets/version \ - install_temp/assets/build_info -# Package everything. Specifying the assets on this command line is -# necessary for AAssetManager_getNextFileName to work on old versions -# of Android. Make sure not to generate R.java, as it's already been -# generated. + install_temp/assets/build_info classes.dex +# Package everything. Redirect the generated R.java to install_temp, as +# it must already have been generated as a prerequisite of +# classes.dex's. $(AM_V_AAPT) $(AAPT) p -I "$(ANDROID_JAR)" -F $@ \ -f -M AndroidManifest.xml $(AAPT_ASSET_ARGS) \ -A install_temp/assets \ -S $(top_srcdir)/java/res -J install_temp + $(AM_V_SILENT) $(AAPT) a $@ classes.dex $(AM_V_SILENT) pushd install_temp &> /dev/null; \ $(AAPT) add ../$@ `find lib -type f`; \ popd &> /dev/null @@ -311,10 +311,9 @@ classes.dex: $(CLASS_FILES) .PHONY: clean maintainer-clean -$(APK_NAME): classes.dex emacs.apk-in $(srcdir)/emacs.keystore +$(APK_NAME): emacs.apk-in $(srcdir)/emacs.keystore $(AM_V_GEN) $(AM_V_SILENT) cp -f emacs.apk-in $@.unaligned - $(AM_V_SILENT) $(AAPT) add $@.unaligned classes.dex $(AM_V_SILENT) $(JARSIGNER) $(SIGN_EMACS) $@.unaligned "Emacs keystore" $(AM_V_SILENT) $(ZIPALIGN) -f 4 $@.unaligned $@ # Signing must happen after alignment! -- cgit v1.2.3 From 946d4aad1dfb244352dfd0845a8bc3078fe9bca4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 30 Mar 2024 10:00:02 +0300 Subject: Avoid errors in Info-search-case-sensitively in DIR buffers * lisp/info.el (Info-search): Don't run the "try other subfiles" code if there are no subfiles. This happens, for example, in DIR files. (Bug#70058) --- lisp/info.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/info.el b/lisp/info.el index 1c6df9a6ee5..5817737ca92 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -2056,7 +2056,7 @@ If DIRECTION is `backward', search in the reverse direction." (re-search-forward regexp nil t)) (signal 'user-search-failed (list regexp)))))) - (if (and bound (not found)) + (if (and (or bound (not Info-current-subfile)) (not found)) (signal 'user-search-failed (list regexp))) (unless (or found bound) -- cgit v1.2.3 From 21af3a9d9706baa417298e70260efa3fce72c6f1 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 30 Mar 2024 15:05:30 +0800 Subject: Disable VC in special directories on Android * lisp/vc/vc-hooks.el (vc-registered, vc-backend): Return nil without invoking any backend if FILE or FILE-OR-LIST sits within /content or /assets. --- lisp/vc/vc-hooks.el | 80 +++++++++++++++++++++++++++++++---------------------- 1 file changed, 47 insertions(+), 33 deletions(-) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 75f68dd80d1..8f212e96933 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -326,30 +326,37 @@ This function performs the check each time it is called. To rely on the result of a previous call, use `vc-backend' instead. If the file was previously registered under a certain backend, then that backend is tried first." - (let (handler) - (cond - ((and (file-name-directory file) - (string-match vc-ignore-dir-regexp (file-name-directory file))) - nil) - ((setq handler (find-file-name-handler file 'vc-registered)) - ;; handler should set vc-backend and return t if registered - (funcall handler 'vc-registered file)) - (t - ;; There is no file name handler. - ;; Try vc-BACKEND-registered for each handled BACKEND. - (catch 'found - (let ((backend (vc-file-getprop file 'vc-backend))) - (mapc - (lambda (b) - (and (vc-call-backend b 'registered file) - (vc-file-setprop file 'vc-backend b) - (throw 'found t))) - (if (or (not backend) (eq backend 'none)) - vc-handled-backends - (cons backend vc-handled-backends)))) - ;; File is not registered. - (vc-file-setprop file 'vc-backend 'none) - nil))))) + ;; Subprocesses (and with them, VC backends) can't run from /contents + ;; or /actions, which are fictions maintained by Emacs that do not + ;; exist in the filesystem. + (if (and (eq system-type 'android) + (string-match-p "/\\(content\\|assets\\)[/$]" + (expand-file-name file))) + nil + (let (handler) + (cond + ((and (file-name-directory file) + (string-match vc-ignore-dir-regexp (file-name-directory file))) + nil) + ((setq handler (find-file-name-handler file 'vc-registered)) + ;; handler should set vc-backend and return t if registered + (funcall handler 'vc-registered file)) + (t + ;; There is no file name handler. + ;; Try vc-BACKEND-registered for each handled BACKEND. + (catch 'found + (let ((backend (vc-file-getprop file 'vc-backend))) + (mapc + (lambda (b) + (and (vc-call-backend b 'registered file) + (vc-file-setprop file 'vc-backend b) + (throw 'found t))) + (if (or (not backend) (eq backend 'none)) + vc-handled-backends + (cons backend vc-handled-backends)))) + ;; File is not registered. + (vc-file-setprop file 'vc-backend 'none) + nil)))))) (defun vc-backend (file-or-list) "Return the version control type of FILE-OR-LIST, nil if it's not registered. @@ -357,15 +364,22 @@ If the argument is a list, the files must all have the same back end." ;; `file' can be nil in several places (typically due to the use of ;; code like (vc-backend buffer-file-name)). (cond ((stringp file-or-list) - (let ((property (vc-file-getprop file-or-list 'vc-backend))) - ;; Note that internally, Emacs remembers unregistered - ;; files by setting the property to `none'. - (cond ((eq property 'none) nil) - (property) - ;; vc-registered sets the vc-backend property - (t (if (vc-registered file-or-list) - (vc-file-getprop file-or-list 'vc-backend) - nil))))) + ;; Subprocesses (and with them, VC backends) can't run from + ;; /contents or /actions, which are fictions maintained by + ;; Emacs that do not exist in the filesystem. + (if (and (eq system-type 'android) + (string-match-p "/\\(content\\|assets\\)[/$]" + (expand-file-name file-or-list))) + nil + (let ((property (vc-file-getprop file-or-list 'vc-backend))) + ;; Note that internally, Emacs remembers unregistered + ;; files by setting the property to `none'. + (cond ((eq property 'none) nil) + (property) + ;; vc-registered sets the vc-backend property + (t (if (vc-registered file-or-list) + (vc-file-getprop file-or-list 'vc-backend) + nil)))))) ((and file-or-list (listp file-or-list)) (vc-backend (car file-or-list))) (t -- cgit v1.2.3 From a5df4d92e37a176396577ac901b85025a6952376 Mon Sep 17 00:00:00 2001 From: Géza Herman Date: Wed, 6 Mar 2024 13:14:50 +0100 Subject: Replace libjansson JSON parser with a custom one * src/json.c (json_parse_error, json_to_lisp) (json_read_buffer_callback): Remove functions. (struct json_parser): New struct. (json_signal_error, json_parser_init, json_parser_done) (json_make_object_workspace_for_slow_path) (json_make_object_workspace_for, json_byte_workspace_reset) (json_byte_workspace_put_slow_path, json_byte_workspace_put) (json_input_at_eof, json_input_switch_to_secondary) (json_input_get_slow_path, json_input_get) (json_input_get_if_possible, json_input_put_back) (json_skip_whitespace_internal, json_skip_whitespace) (json_skip_whitespace_if_possible, json_hex_value) (json_parse_unicode, json_handle_utf8_tail_bytes) (json_parse_string, json_create_integer, json_create_float) (json_parse_number, json_parse_array) (json_parse_object_member_value, json_parse_object) (json_is_token_char, json_parse_value, json_parse): New functions. (Fjson_parse_buffer, Fjson_parse_string): Adjust to changes in the parser. (syms_of_json): DEFSYM new symbols and define_error new errors. --- src/json.c | 1364 +++++++++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 1122 insertions(+), 242 deletions(-) diff --git a/src/json.c b/src/json.c index e849ccaf722..bdb9e4cdd58 100644 --- a/src/json.c +++ b/src/json.c @@ -23,6 +23,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include @@ -237,41 +238,6 @@ json_out_of_memory (void) xsignal0 (Qjson_out_of_memory); } -/* Signal a Lisp error corresponding to the JSON ERROR. */ - -static AVOID -json_parse_error (const json_error_t *error) -{ - Lisp_Object symbol; -#if JSON_HAS_ERROR_CODE - switch (json_error_code (error)) - { - case json_error_premature_end_of_input: - symbol = Qjson_end_of_file; - break; - case json_error_end_of_input_expected: - symbol = Qjson_trailing_content; - break; - default: - symbol = Qjson_parse_error; - break; - } -#else - if (json_has_suffix (error->text, "expected near end of file")) - symbol = Qjson_end_of_file; - else if (json_has_prefix (error->text, "end of file expected")) - symbol = Qjson_trailing_content; - else - symbol = Qjson_parse_error; -#endif - xsignal (symbol, - list5 (build_string_from_utf8 (error->text), - build_string_from_utf8 (error->source), - INT_TO_INTEGER (error->line), - INT_TO_INTEGER (error->column), - INT_TO_INTEGER (error->position))); -} - static void json_release_object (void *object) { @@ -794,145 +760,1087 @@ usage: (json-insert OBJECT &rest ARGS) */) return unbind_to (count, Qnil); } -/* Convert a JSON object to a Lisp object. */ +#define JSON_PARSER_INTERNAL_OBJECT_WORKSPACE_SIZE 64 +#define JSON_PARSER_INTERNAL_BYTE_WORKSPACE_SIZE 512 + +struct json_parser +{ + /* Because of a possible gap in the input (an emacs buffer can have + a gap), the input is described by [input_begin;input_end) and + [secondary_input_begin;secondary_input_end). If the input is + continuous, then secondary_input_begin and secondary_input_end + should be NULL */ + const unsigned char *input_current; + const unsigned char *input_begin; + const unsigned char *input_end; + + const unsigned char *secondary_input_begin; + const unsigned char *secondary_input_end; + + ptrdiff_t current_line; + ptrdiff_t current_column; + ptrdiff_t point_of_current_line; + + /* The parser has a maximum allowed depth. available_depth + decreases at each object/array begin. If reaches zero, then an + error is generated */ + int available_depth; + + struct json_configuration conf; + + size_t additional_bytes_count; + + /* Lisp_Objects are collected in this area during object/array + parsing. To avoid allocations, initially + internal_object_workspace is used. If it runs out of space then + we switch to allocated space. Important note: with this design, + GC must not run during JSON parsing, otherwise Lisp_Objects in + the workspace may get incorrectly collected. */ + Lisp_Object internal_object_workspace + [JSON_PARSER_INTERNAL_OBJECT_WORKSPACE_SIZE]; + Lisp_Object *object_workspace; + size_t object_workspace_size; + size_t object_workspace_current; + + /* String and number parsing uses this workspace. The idea behind + internal_byte_workspace is the same as the idea behind + internal_object_workspace */ + unsigned char + internal_byte_workspace[JSON_PARSER_INTERNAL_BYTE_WORKSPACE_SIZE]; + unsigned char *byte_workspace; + unsigned char *byte_workspace_end; + unsigned char *byte_workspace_current; +}; + +static AVOID +json_signal_error (struct json_parser *parser, Lisp_Object error) +{ + xsignal3 (error, INT_TO_INTEGER (parser->current_line), + INT_TO_INTEGER (parser->current_column), + INT_TO_INTEGER (parser->point_of_current_line + + parser->current_column)); +} + +static void +json_parser_init (struct json_parser *parser, + struct json_configuration conf, + const unsigned char *input, + const unsigned char *input_end, + const unsigned char *secondary_input, + const unsigned char *secondary_input_end) +{ + if (secondary_input >= secondary_input_end) + { + secondary_input = NULL; + secondary_input_end = NULL; + } + + if (input < input_end) + { + parser->input_begin = input; + parser->input_end = input_end; + + parser->secondary_input_begin = secondary_input; + parser->secondary_input_end = secondary_input_end; + } + else + { + parser->input_begin = secondary_input; + parser->input_end = secondary_input_end; + + parser->secondary_input_begin = NULL; + parser->secondary_input_end = NULL; + } + + parser->input_current = parser->input_begin; + + parser->current_line = 1; + parser->current_column = 0; + parser->point_of_current_line = 0; + parser->available_depth = 10000; + parser->conf = conf; + + parser->additional_bytes_count = 0; + + parser->object_workspace = parser->internal_object_workspace; + parser->object_workspace_size + = JSON_PARSER_INTERNAL_OBJECT_WORKSPACE_SIZE; + parser->object_workspace_current = 0; + + parser->byte_workspace = parser->internal_byte_workspace; + parser->byte_workspace_end + = (parser->byte_workspace + + JSON_PARSER_INTERNAL_BYTE_WORKSPACE_SIZE); +} + +static void +json_parser_done (void *parser) +{ + struct json_parser *p = (struct json_parser *) parser; + if (p->object_workspace != p->internal_object_workspace) + xfree (p->object_workspace); + if (p->byte_workspace != p->internal_byte_workspace) + xfree (p->byte_workspace); +} + +/* Makes sure that the object_workspace has 'size' available space for + Lisp_Objects */ +NO_INLINE static void +json_make_object_workspace_for_slow_path (struct json_parser *parser, + size_t size) +{ + size_t needed_workspace_size + = (parser->object_workspace_current + size); + size_t new_workspace_size = parser->object_workspace_size; + while (new_workspace_size < needed_workspace_size) + { + if (ckd_mul (&new_workspace_size, new_workspace_size, 2)) + { + json_signal_error (parser, Qjson_out_of_memory); + } + } + + Lisp_Object *new_workspace_ptr; + if (parser->object_workspace_size + == JSON_PARSER_INTERNAL_OBJECT_WORKSPACE_SIZE) + { + new_workspace_ptr + = xnmalloc (new_workspace_size, sizeof (Lisp_Object)); + memcpy (new_workspace_ptr, parser->object_workspace, + (sizeof (Lisp_Object) + * parser->object_workspace_current)); + } + else + { + new_workspace_ptr + = xnrealloc (parser->object_workspace, new_workspace_size, + sizeof (Lisp_Object)); + } + + parser->object_workspace = new_workspace_ptr; + parser->object_workspace_size = new_workspace_size; +} + +INLINE void +json_make_object_workspace_for (struct json_parser *parser, + size_t size) +{ + if (parser->object_workspace_size - parser->object_workspace_current + < size) + { + json_make_object_workspace_for_slow_path (parser, size); + } +} + +static void +json_byte_workspace_reset (struct json_parser *parser) +{ + parser->byte_workspace_current = parser->byte_workspace; +} + +/* Puts 'value' into the byte_workspace. If there is no space + available, it allocates space */ +NO_INLINE static void +json_byte_workspace_put_slow_path (struct json_parser *parser, + unsigned char value) +{ + size_t new_workspace_size + = parser->byte_workspace_end - parser->byte_workspace; + if (ckd_mul (&new_workspace_size, new_workspace_size, 2)) + { + json_signal_error (parser, Qjson_out_of_memory); + } + + size_t offset + = parser->byte_workspace_current - parser->byte_workspace; + + if (parser->byte_workspace == parser->internal_byte_workspace) + { + parser->byte_workspace = xmalloc (new_workspace_size); + memcpy (parser->byte_workspace, parser->internal_byte_workspace, + offset); + } + else + { + parser->byte_workspace + = xrealloc (parser->byte_workspace, new_workspace_size); + } + parser->byte_workspace_end + = parser->byte_workspace + new_workspace_size; + parser->byte_workspace_current = parser->byte_workspace + offset; + *parser->byte_workspace_current++ = value; +} + +INLINE void +json_byte_workspace_put (struct json_parser *parser, + unsigned char value) +{ + if (parser->byte_workspace_current < parser->byte_workspace_end) + { + *parser->byte_workspace_current++ = value; + } + else + { + json_byte_workspace_put_slow_path (parser, value); + } +} + +static bool +json_input_at_eof (struct json_parser *parser) +{ + if (parser->input_current < parser->input_end) + return false; + return parser->secondary_input_end == NULL; +} + +/* If there is a secondary buffer, this switches to it */ +static int +json_input_switch_to_secondary (struct json_parser *parser) +{ + if (parser->secondary_input_begin < parser->secondary_input_end) + { + parser->additional_bytes_count + = parser->input_end - parser->input_begin; + parser->input_begin = parser->secondary_input_begin; + parser->input_end = parser->secondary_input_end; + parser->input_current = parser->secondary_input_begin; + parser->secondary_input_begin = NULL; + parser->secondary_input_end = NULL; + return 0; + } + else + return -1; +} + +/* Reads a byte from the JSON input stream */ +NO_INLINE static unsigned char +json_input_get_slow_path (struct json_parser *parser) +{ + if (json_input_switch_to_secondary (parser) < 0) + json_signal_error (parser, Qjson_end_of_file); + return *parser->input_current++; +} + +static unsigned char +json_input_get (struct json_parser *parser) +{ + if (parser->input_current < parser->input_end) + return *parser->input_current++; + return json_input_get_slow_path (parser); +} + +/* Reads a byte from the JSON input stream, if the stream is not at + * eof. At eof, returns -1 */ +static int +json_input_get_if_possible (struct json_parser *parser) +{ + if (parser->input_current >= parser->input_end + && json_input_switch_to_secondary (parser) < 0) + return -1; + return *parser->input_current++; +} + +/* Puts back the last read input byte. Only one byte can be put back, + because otherwise this code would need to handle switching from + the secondary buffer to the initial */ +static void +json_input_put_back (struct json_parser *parser) +{ + parser->input_current--; +} + +static bool +json_skip_whitespace_internal (struct json_parser *parser, int c) +{ + parser->current_column++; + if (c == 0x20 || c == 0x09 || c == 0x0d) + return false; + else if (c == 0x0a) + { + parser->current_line++; + parser->point_of_current_line += parser->current_column; + parser->current_column = 0; + return false; + } + else + return true; +} + +/* Skips JSON whitespace, and returns with the first non-whitespace + * character */ +static int +json_skip_whitespace (struct json_parser *parser) +{ + for (;;) + { + int c = json_input_get (parser); + if (json_skip_whitespace_internal (parser, c)) + return c; + } +} + +/* Skips JSON whitespace, and returns with the first non-whitespace + * character, if possible. If there is no non-whitespace character + * (because we reached the end), it returns -1 */ +static int +json_skip_whitespace_if_possible (struct json_parser *parser) +{ + for (;;) + { + int c = json_input_get_if_possible (parser); + if (c < 0) + return c; + if (json_skip_whitespace_internal (parser, c)) + return c; + } +} + +static int +json_hex_value (int c) +{ + if (c >= '0' && c <= '9') + return c - '0'; + else if (c >= 'A' && c <= 'F') + return c - 'A' + 10; + else if (c >= 'a' && c <= 'f') + return c - 'a' + 10; + else + return -1; +} + +/* Parses the CCCC part of the unicode escape sequence \uCCCC */ +static int +json_parse_unicode (struct json_parser *parser) +{ + unsigned char v[4]; + for (int i = 0; i < 4; i++) + { + int c = json_hex_value (json_input_get (parser)); + parser->current_column++; + if (c < 0) + json_signal_error (parser, Qjson_escape_sequence_error); + v[i] = c; + } + + return v[0] << 12 | v[1] << 8 | v[2] << 4 | v[3]; +} + +/* Parses an utf-8 code-point encoding (except the first byte), and + returns the numeric value of the code-point (without considering + the first byte) */ +static int +json_handle_utf8_tail_bytes (struct json_parser *parser, int n) +{ + int v = 0; + for (int i = 0; i < n; i++) + { + int c = json_input_get (parser); + json_byte_workspace_put (parser, c); + if ((c & 0xc0) != 0x80) + json_signal_error (parser, Qjson_utf8_decode_error); + v = (v << 6) | (c & 0x3f); + } + return v; +} + +/* Reads a JSON string, and puts the result into the byte workspace */ +static void +json_parse_string (struct json_parser *parser) +{ + /* a single_uninteresting byte can be simply copied from the input + to output, it doesn't need any extra care. This means all the + characters between [0x20;0x7f], except the double quote and + the backslash */ + static const char is_single_uninteresting[256] = { + /* 0 1 2 3 4 5 6 7 8 9 a b c d e f */ + /* 0 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + /* 1 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + /* 2 */ 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + /* 3 */ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + /* 4 */ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + /* 5 */ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, + /* 6 */ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + /* 7 */ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + /* 8 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + /* 9 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + /* a */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + /* b */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + /* c */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + /* d */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + /* e */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + /* f */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + }; + + for (;;) + { + /* This if is only here for a possible speedup. If there are 4 + bytes available, and all of them are single_uninteresting, + then we can just copy these 4 bytes to output */ + if (parser->input_end - parser->input_current >= 4) + { + int c0 = parser->input_current[0]; + int c1 = parser->input_current[1]; + int c2 = parser->input_current[2]; + int c3 = parser->input_current[3]; + bool v0 = is_single_uninteresting[c0]; + bool v1 = is_single_uninteresting[c1]; + bool v2 = is_single_uninteresting[c2]; + bool v3 = is_single_uninteresting[c3]; + if (v0 && v1 && v2 && v3) + { + json_byte_workspace_put (parser, c0); + json_byte_workspace_put (parser, c1); + json_byte_workspace_put (parser, c2); + json_byte_workspace_put (parser, c3); + parser->input_current += 4; + parser->current_column += 4; + continue; + } + } + + int c = json_input_get (parser); + parser->current_column++; + if (is_single_uninteresting[c]) + { + json_byte_workspace_put (parser, c); + continue; + } + + if (c == '"') + return; + else if (c & 0x80) + { + /* Handle utf-8 encoding */ + json_byte_workspace_put (parser, c); + if (c < 0xc0) + json_signal_error (parser, Qjson_utf8_decode_error); + else if (c < 0xe0) + { + int n = ((c & 0x1f) << 6 + | json_handle_utf8_tail_bytes (parser, 1)); + if (n < 0x80) + json_signal_error (parser, Qjson_utf8_decode_error); + } + else if (c < 0xf0) + { + int n = ((c & 0xf) << 12 + | json_handle_utf8_tail_bytes (parser, 2)); + if (n < 0x800 || (n >= 0xd800 && n < 0xe000)) + json_signal_error (parser, Qjson_utf8_decode_error); + } + else if (c < 0xf8) + { + int n = ((c & 0x7) << 18 + | json_handle_utf8_tail_bytes (parser, 3)); + if (n < 0x10000 || n > 0x10ffff) + json_signal_error (parser, Qjson_utf8_decode_error); + } + else + json_signal_error (parser, Qjson_utf8_decode_error); + } + else if (c == '\\') + { + /* Handle escape sequences */ + c = json_input_get (parser); + parser->current_column++; + if (c == '"') + json_byte_workspace_put (parser, '"'); + else if (c == '\\') + json_byte_workspace_put (parser, '\\'); + else if (c == '/') + json_byte_workspace_put (parser, '/'); + else if (c == 'b') + json_byte_workspace_put (parser, '\b'); + else if (c == 'f') + json_byte_workspace_put (parser, '\f'); + else if (c == 'n') + json_byte_workspace_put (parser, '\n'); + else if (c == 'r') + json_byte_workspace_put (parser, '\r'); + else if (c == 't') + json_byte_workspace_put (parser, '\t'); + else if (c == 'u') + { + int num = json_parse_unicode (parser); + /* is the first half of the surrogate pair */ + if (num >= 0xd800 && num < 0xdc00) + { + parser->current_column++; + if (json_input_get (parser) != '\\') + json_signal_error (parser, + Qjson_invalid_surrogate_error); + parser->current_column++; + if (json_input_get (parser) != 'u') + json_signal_error (parser, + Qjson_invalid_surrogate_error); + int num2 = json_parse_unicode (parser); + if (num2 < 0xdc00 || num2 >= 0xe000) + json_signal_error (parser, + Qjson_invalid_surrogate_error); + num = (0x10000 + + ((num - 0xd800) << 10 | (num2 - 0xdc00))); + } + else if (num >= 0xdc00 && num < 0xe000) + /* is the second half of the surrogate pair without + the first half */ + json_signal_error (parser, + Qjson_invalid_surrogate_error); + + /* utf-8 encode the code-point */ + if (num < 0x80) + json_byte_workspace_put (parser, num); + else if (num < 0x800) + { + json_byte_workspace_put (parser, 0xc0 | num >> 6); + json_byte_workspace_put (parser, + 0x80 | (num & 0x3f)); + } + else if (num < 0x10000) + { + json_byte_workspace_put (parser, 0xe0 | num >> 12); + json_byte_workspace_put (parser, + (0x80 + | ((num >> 6) & 0x3f))); + json_byte_workspace_put (parser, + 0x80 | (num & 0x3f)); + } + else + { + json_byte_workspace_put (parser, 0xf0 | num >> 18); + json_byte_workspace_put (parser, + (0x80 + | ((num >> 12) & 0x3f))); + json_byte_workspace_put (parser, + (0x80 + | ((num >> 6) & 0x3f))); + json_byte_workspace_put (parser, + 0x80 | (num & 0x3f)); + } + } + else + json_signal_error (parser, Qjson_escape_sequence_error); + } + else + json_signal_error (parser, Qjson_parse_error); + } +} + +/* If there was no integer overflow during parsing the integer, this + puts 'value' to the output. Otherwise this calls string_to_number + to parse integer on the byte workspace. This could just always + call string_to_number, but for performance reasons, during parsing + the code tries to calculate the value, so in most cases, we can + save call of string_to_number */ +static Lisp_Object +json_create_integer (struct json_parser *parser, + bool integer_overflow, bool negative, + EMACS_UINT value) +{ + if (!integer_overflow) + { + if (negative) + { + uintmax_t v = value; + if (v <= (uintmax_t) INTMAX_MAX + 1) + return INT_TO_INTEGER ((intmax_t) -v); + } + else + return INT_TO_INTEGER (value); + } + + json_byte_workspace_put (parser, 0); + ptrdiff_t len; + Lisp_Object result + = string_to_number ((const char *) parser->byte_workspace, 10, + &len); + if (len + != parser->byte_workspace_current - parser->byte_workspace - 1) + json_signal_error (parser, Qjson_error); + return result; +} + +/* Parses a float using the byte workspace */ +static Lisp_Object +json_create_float (struct json_parser *parser) +{ + json_byte_workspace_put (parser, 0); + errno = 0; + char *e; + double value = strtod ((const char *) parser->byte_workspace, &e); + bool out_of_range + = (errno != 0 && (value == HUGE_VAL || value == -HUGE_VAL)); + if (out_of_range) + json_signal_error (parser, Qjson_number_out_of_range); + else if ((const unsigned char *) e + != parser->byte_workspace_current - 1) + json_signal_error (parser, Qjson_error); + else + return make_float (value); +} + +/* Parses a number. The first character is the input parameter 'c'. + */ +static Lisp_Object +json_parse_number (struct json_parser *parser, int c) +{ + json_byte_workspace_reset (parser); + json_byte_workspace_put (parser, c); + + bool negative = false; + if (c == '-') + { + negative = true; + c = json_input_get (parser); + json_byte_workspace_put (parser, c); + parser->current_column++; + } + if (c < '0' || c > '9') + json_signal_error (parser, Qjson_parse_error); + + /* The idea is that during finding the last character of the + number, the for loop below also tries to calculate the value. If + the parsed number is an integer which fits into unsigned long, + then the parser can use the value of 'integer' right away, + instead of having to re-parse the byte workspace later. + Ideally, this integer should have the same size as a CPU general + purpose register. */ + EMACS_UINT integer = c - '0'; + bool integer_overflow = false; + + if (integer == 0) + { + if (json_input_at_eof (parser)) + return INT_TO_INTEGER (0); + c = json_input_get (parser); + } + else + { + for (;;) + { + if (json_input_at_eof (parser)) + return json_create_integer (parser, integer_overflow, + negative, integer); + c = json_input_get (parser); + if (c < '0' || c > '9') + break; + json_byte_workspace_put (parser, c); + parser->current_column++; + + integer_overflow |= ckd_mul (&integer, integer, 10); + integer_overflow |= ckd_add (&integer, integer, c - '0'); + } + } + + bool is_float = false; + if (c == '.') + { + json_byte_workspace_put (parser, c); + parser->current_column++; + + is_float = true; + c = json_input_get (parser); + json_byte_workspace_put (parser, c); + parser->current_column++; + if (c < '0' || c > '9') + json_signal_error (parser, Qjson_parse_error); + for (;;) + { + if (json_input_at_eof (parser)) + return json_create_float (parser); + c = json_input_get (parser); + if (c < '0' || c > '9') + break; + json_byte_workspace_put (parser, c); + parser->current_column++; + } + } + if (c == 'e' || c == 'E') + { + json_byte_workspace_put (parser, c); + parser->current_column++; + + is_float = true; + c = json_input_get (parser); + json_byte_workspace_put (parser, c); + parser->current_column++; + if (c == '-' || c == '+') + { + c = json_input_get (parser); + json_byte_workspace_put (parser, c); + parser->current_column++; + } + if (c < '0' || c > '9') + json_signal_error (parser, Qjson_parse_error); + for (;;) + { + if (json_input_at_eof (parser)) + return json_create_float (parser); + c = json_input_get (parser); + if (c < '0' || c > '9') + break; + json_byte_workspace_put (parser, c); + parser->current_column++; + } + } + + /* 'c' contains a character which is not part of the number, + so it is need to be put back */ + json_input_put_back (parser); + + if (is_float) + return json_create_float (parser); + else + return json_create_integer (parser, integer_overflow, negative, + integer); +} + +static Lisp_Object json_parse_value (struct json_parser *parser, + int c); -static Lisp_Object ARG_NONNULL ((1)) -json_to_lisp (json_t *json, const struct json_configuration *conf) +/* Parses a JSON array. */ +static Lisp_Object +json_parse_array (struct json_parser *parser) { - switch (json_typeof (json)) + int c = json_skip_whitespace (parser); + + const size_t first = parser->object_workspace_current; + Lisp_Object result = Qnil; + + if (c != ']') + { + parser->available_depth--; + if (parser->available_depth < 0) + json_signal_error (parser, Qjson_object_too_deep); + + size_t number_of_elements = 0; + Lisp_Object *cdr = &result; + /* This loop collects the array elements in the object workspace + */ + for (;;) + { + Lisp_Object element = json_parse_value (parser, c); + switch (parser->conf.array_type) + { + case json_array_array: + json_make_object_workspace_for (parser, 1); + parser->object_workspace[parser->object_workspace_current] + = element; + parser->object_workspace_current++; + break; + case json_array_list: + { + Lisp_Object nc = Fcons (element, Qnil); + *cdr = nc; + cdr = xcdr_addr (nc); + break; + } + default: + emacs_abort (); + } + + c = json_skip_whitespace (parser); + + number_of_elements++; + if (c == ']') + { + parser->available_depth++; + break; + } + + if (c != ',') + json_signal_error (parser, Qjson_parse_error); + + c = json_skip_whitespace (parser); + } + } + + switch (parser->conf.array_type) { - case JSON_NULL: - return conf->null_object; - case JSON_FALSE: - return conf->false_object; - case JSON_TRUE: - return Qt; - case JSON_INTEGER: + case json_array_array: { - json_int_t i = json_integer_value (json); - return INT_TO_INTEGER (i); + size_t number_of_elements + = parser->object_workspace_current - first; + result = make_vector (number_of_elements, Qnil); + for (size_t i = 0; i < number_of_elements; i++) + { + rarely_quit (i); + ASET (result, i, parser->object_workspace[first + i]); + } + parser->object_workspace_current = first; + break; } - case JSON_REAL: - return make_float (json_real_value (json)); - case JSON_STRING: - return make_string_from_utf8 (json_string_value (json), - json_string_length (json)); - case JSON_ARRAY: + case json_array_list: + break; + default: + emacs_abort (); + } + + return result; +} + +/* Parses the ": value" part of a JSON object member. */ +static Lisp_Object +json_parse_object_member_value (struct json_parser *parser) +{ + int c = json_skip_whitespace (parser); + if (c != ':') + json_signal_error (parser, Qjson_parse_error); + + c = json_skip_whitespace (parser); + + return json_parse_value (parser, c); +} + +/* Parses a JSON object. */ +static Lisp_Object +json_parse_object (struct json_parser *parser) +{ + int c = json_skip_whitespace (parser); + + const size_t first = parser->object_workspace_current; + Lisp_Object result = Qnil; + + if (c != '}') + { + parser->available_depth--; + if (parser->available_depth < 0) + json_signal_error (parser, Qjson_object_too_deep); + + Lisp_Object *cdr = &result; + + /* This loop collects the object members (key/value pairs) in + * the object workspace */ + for (;;) + { + if (c != '"') + json_signal_error (parser, Qjson_parse_error); + + json_byte_workspace_reset (parser); + switch (parser->conf.object_type) + { + case json_object_hashtable: + { + json_parse_string (parser); + Lisp_Object key + = make_string_from_utf8 ((char *) + parser->byte_workspace, + (parser->byte_workspace_current + - parser->byte_workspace)); + Lisp_Object value + = json_parse_object_member_value (parser); + json_make_object_workspace_for (parser, 2); + parser->object_workspace[parser->object_workspace_current] + = key; + parser->object_workspace_current++; + parser->object_workspace[parser->object_workspace_current] + = value; + parser->object_workspace_current++; + break; + } + case json_object_alist: + { + json_parse_string (parser); + Lisp_Object key + = Fintern (make_string_from_utf8 ( + (char *) parser->byte_workspace, + (parser->byte_workspace_current + - parser->byte_workspace)), + Qnil); + Lisp_Object value + = json_parse_object_member_value (parser); + Lisp_Object nc = Fcons (Fcons (key, value), Qnil); + *cdr = nc; + cdr = xcdr_addr (nc); + break; + } + case json_object_plist: + { + json_byte_workspace_put (parser, ':'); + json_parse_string (parser); + Lisp_Object key + = intern_1 ((char *) parser->byte_workspace, + (parser->byte_workspace_current + - parser->byte_workspace)); + Lisp_Object value + = json_parse_object_member_value (parser); + Lisp_Object nc = Fcons (key, Qnil); + *cdr = nc; + cdr = xcdr_addr (nc); + + nc = Fcons (value, Qnil); + *cdr = nc; + cdr = xcdr_addr (nc); + break; + } + default: + emacs_abort (); + } + + c = json_skip_whitespace (parser); + + if (c == '}') + { + parser->available_depth++; + break; + } + + if (c != ',') + json_signal_error (parser, Qjson_parse_error); + + c = json_skip_whitespace (parser); + } + } + + switch (parser->conf.object_type) + { + case json_object_hashtable: { - if (++lisp_eval_depth > max_lisp_eval_depth) - xsignal0 (Qjson_object_too_deep); - size_t size = json_array_size (json); - if (PTRDIFF_MAX < size) - overflow_error (); - Lisp_Object result; - switch (conf->array_type) - { - case json_array_array: - { - result = make_vector (size, Qunbound); - for (ptrdiff_t i = 0; i < size; ++i) - { - rarely_quit (i); - ASET (result, i, - json_to_lisp (json_array_get (json, i), conf)); - } - break; - } - case json_array_list: - { - result = Qnil; - for (ptrdiff_t i = size - 1; i >= 0; --i) - { - rarely_quit (i); - result = Fcons (json_to_lisp (json_array_get (json, i), conf), - result); - } - break; - } - default: - /* Can't get here. */ - emacs_abort (); - } - --lisp_eval_depth; - return result; + result + = CALLN (Fmake_hash_table, QCtest, Qequal, QCsize, + make_fixed_natnum ( + (parser->object_workspace_current - first) / 2)); + struct Lisp_Hash_Table *h = XHASH_TABLE (result); + for (size_t i = first; i < parser->object_workspace_current; + i += 2) + { + hash_hash_t hash; + Lisp_Object key = parser->object_workspace[i]; + Lisp_Object value = parser->object_workspace[i + 1]; + ptrdiff_t i = hash_lookup_get_hash (h, key, &hash); + if (i < 0) + hash_put (h, key, value, hash); + else + set_hash_value_slot (h, i, value); + } + parser->object_workspace_current = first; + break; } - case JSON_OBJECT: + case json_object_alist: + case json_object_plist: + break; + default: + emacs_abort (); + } + + return result; +} + +/* Token-char is not a JSON terminology. When parsing + null/false/true, this function tells the character set that is need + to be considered as part of a token. For example, if the input is + "truesomething", then the parser shouldn't consider it as "true", + and an additional later "something" token. An additional example: + if the input is "truetrue", then calling (json-parse-buffer) twice + shouldn't produce two successful calls which return t, but a + parsing error */ +static bool +json_is_token_char (int c) +{ + return ((c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') + || (c >= '0' && c <= '9') || (c == '-')); +} + +/* This is the entry point to the value parser, this parses a JSON + * value */ +Lisp_Object +json_parse_value (struct json_parser *parser, int c) +{ + if (c == '{') + return json_parse_object (parser); + else if (c == '[') + return json_parse_array (parser); + else if (c == '"') + { + json_byte_workspace_reset (parser); + json_parse_string (parser); + Lisp_Object result + = make_string_from_utf8 ((const char *) + parser->byte_workspace, + (parser->byte_workspace_current + - parser->byte_workspace)); + return result; + } + else if ((c >= '0' && c <= '9') || (c == '-')) + return json_parse_number (parser, c); + else + { + int c2 = json_input_get (parser); + int c3 = json_input_get (parser); + int c4 = json_input_get (parser); + int c5 = json_input_get_if_possible (parser); + + if (c == 't' && c2 == 'r' && c3 == 'u' && c4 == 'e' + && (c5 < 0 || !json_is_token_char (c5))) + { + if (c5 >= 0) + json_input_put_back (parser); + parser->current_column += 3; + return Qt; + } + if (c == 'n' && c2 == 'u' && c3 == 'l' && c4 == 'l' + && (c5 < 0 || !json_is_token_char (c5))) + { + if (c5 >= 0) + json_input_put_back (parser); + parser->current_column += 3; + return parser->conf.null_object; + } + if (c == 'f' && c2 == 'a' && c3 == 'l' && c4 == 's' + && c5 == 'e') + { + int c6 = json_input_get_if_possible (parser); + if (c6 < 0 || !json_is_token_char (c6)) + { + if (c6 >= 0) + json_input_put_back (parser); + parser->current_column += 4; + return parser->conf.false_object; + } + } + + json_signal_error (parser, Qjson_parse_error); + } +} + +enum ParseEndBehavior + { + PARSEENDBEHAVIOR_CheckForGarbage, + PARSEENDBEHAVIOR_MovePoint + }; + +static Lisp_Object +json_parse (struct json_parser *parser, + enum ParseEndBehavior parse_end_behavior) +{ + int c = json_skip_whitespace (parser); + + Lisp_Object result = json_parse_value (parser, c); + + switch (parse_end_behavior) + { + case PARSEENDBEHAVIOR_CheckForGarbage: + c = json_skip_whitespace_if_possible (parser); + if (c >= 0) + json_signal_error (parser, Qjson_trailing_content); + break; + case PARSEENDBEHAVIOR_MovePoint: { - if (++lisp_eval_depth > max_lisp_eval_depth) - xsignal0 (Qjson_object_too_deep); - Lisp_Object result; - switch (conf->object_type) - { - case json_object_hashtable: - { - size_t size = json_object_size (json); - if (FIXNUM_OVERFLOW_P (size)) - overflow_error (); - result = CALLN (Fmake_hash_table, QCtest, Qequal, QCsize, - make_fixed_natnum (size)); - struct Lisp_Hash_Table *h = XHASH_TABLE (result); - const char *key_str; - json_t *value; - json_object_foreach (json, key_str, value) - { - Lisp_Object key = build_string_from_utf8 (key_str); - hash_hash_t hash; - ptrdiff_t i = hash_lookup_get_hash (h, key, &hash); - /* Keys in JSON objects are unique, so the key can't - be present yet. */ - eassert (i < 0); - hash_put (h, key, json_to_lisp (value, conf), hash); - } - break; - } - case json_object_alist: - { - result = Qnil; - const char *key_str; - json_t *value; - json_object_foreach (json, key_str, value) - { - Lisp_Object key - = Fintern (build_string_from_utf8 (key_str), Qnil); - result - = Fcons (Fcons (key, json_to_lisp (value, conf)), - result); - } - result = Fnreverse (result); - break; - } - case json_object_plist: - { - result = Qnil; - const char *key_str; - json_t *value; - json_object_foreach (json, key_str, value) - { - USE_SAFE_ALLOCA; - ptrdiff_t key_str_len = strlen (key_str); - char *keyword_key_str = SAFE_ALLOCA (1 + key_str_len + 1); - keyword_key_str[0] = ':'; - strcpy (&keyword_key_str[1], key_str); - Lisp_Object key = intern_1 (keyword_key_str, key_str_len + 1); - /* Build the plist as value-key since we're going to - reverse it in the end.*/ - result = Fcons (key, result); - result = Fcons (json_to_lisp (value, conf), result); - SAFE_FREE (); - } - result = Fnreverse (result); - break; - } - default: - /* Can't get here. */ - emacs_abort (); - } - --lisp_eval_depth; - return result; + ptrdiff_t byte + = (PT_BYTE + parser->input_current - parser->input_begin + + parser->additional_bytes_count); + ptrdiff_t position; + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) + position = byte; + else + position + = PT + parser->point_of_current_line + parser->current_column; + + SET_PT_BOTH (position, byte); + break; } } - /* Can't get here. */ - emacs_abort (); + + return result; } DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY, @@ -950,7 +1858,9 @@ The arguments ARGS are a list of keyword/argument pairs: The keyword argument `:object-type' specifies which Lisp type is used to represent objects; it can be `hash-table', `alist' or `plist'. It -defaults to `hash-table'. +defaults to `hash-table'. If an object has members with the same +key, `hash-table' keeps only the last value of such keys, while +`alist' and `plist' keep all the members. The keyword argument `:array-type' specifies which Lisp type is used to represent arrays; it can be `array' (the default) or `list'. @@ -961,62 +1871,27 @@ to represent a JSON null value. It defaults to `:null'. The keyword argument `:false-object' specifies which object to use to represent a JSON false value. It defaults to `:false'. usage: (json-parse-string STRING &rest ARGS) */) - (ptrdiff_t nargs, Lisp_Object *args) +(ptrdiff_t nargs, Lisp_Object *args) { specpdl_ref count = SPECPDL_INDEX (); -#ifdef WINDOWSNT - ensure_json_available (); -#endif - Lisp_Object string = args[0]; CHECK_STRING (string); Lisp_Object encoded = json_encode (string); - check_string_without_embedded_nulls (encoded); - struct json_configuration conf = - {json_object_hashtable, json_array_array, QCnull, QCfalse}; + struct json_configuration conf + = { json_object_hashtable, json_array_array, QCnull, QCfalse }; json_parse_args (nargs - 1, args + 1, &conf, true); - json_error_t error; - json_t *object - = json_loads (SSDATA (encoded), JSON_DECODE_ANY | JSON_ALLOW_NUL, &error); - if (object == NULL) - json_parse_error (&error); + struct json_parser p; + const unsigned char *begin + = (const unsigned char *) SSDATA (encoded); + json_parser_init (&p, conf, begin, begin + SBYTES (encoded), NULL, + NULL); + record_unwind_protect_ptr (json_parser_done, &p); - /* Avoid leaking the object in case of further errors. */ - if (object != NULL) - record_unwind_protect_ptr (json_release_object, object); - - return unbind_to (count, json_to_lisp (object, &conf)); -} - -struct json_read_buffer_data -{ - /* Byte position of position to read the next chunk from. */ - ptrdiff_t point; -}; - -/* Callback for json_load_callback that reads from the current buffer. - DATA must point to a structure of type json_read_buffer_data. - data->point must point to the byte position to read from; after - reading, data->point is advanced accordingly. The buffer point - itself is ignored. This function may not exit nonlocally. */ - -static size_t -json_read_buffer_callback (void *buffer, size_t buflen, void *data) -{ - struct json_read_buffer_data *d = data; - - /* First, parse from point to the gap or the end of the accessible - portion, whatever is closer. */ - ptrdiff_t point = d->point; - ptrdiff_t end = BUFFER_CEILING_OF (point) + 1; - ptrdiff_t count = end - point; - if (buflen < count) - count = buflen; - memcpy (buffer, BYTE_POS_ADDR (point), count); - d->point += count; - return count; + return unbind_to (count, + json_parse (&p, + PARSEENDBEHAVIOR_CheckForGarbage)); } DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer, @@ -1038,7 +1913,9 @@ The arguments ARGS are a list of keyword/argument pairs: The keyword argument `:object-type' specifies which Lisp type is used to represent objects; it can be `hash-table', `alist' or `plist'. It -defaults to `hash-table'. +defaults to `hash-table'. If an object has members with the same +key, `hash-table' keeps only the last value of such keys, while +`alist' and `plist' keep all the members. The keyword argument `:array-type' specifies which Lisp type is used to represent arrays; it can be `array' (the default) or `list'. @@ -1049,42 +1926,33 @@ to represent a JSON null value. It defaults to `:null'. The keyword argument `:false-object' specifies which object to use to represent a JSON false value. It defaults to `:false'. usage: (json-parse-buffer &rest args) */) - (ptrdiff_t nargs, Lisp_Object *args) +(ptrdiff_t nargs, Lisp_Object *args) { specpdl_ref count = SPECPDL_INDEX (); -#ifdef WINDOWSNT - ensure_json_available (); -#endif - - struct json_configuration conf = - {json_object_hashtable, json_array_array, QCnull, QCfalse}; + struct json_configuration conf + = { json_object_hashtable, json_array_array, QCnull, QCfalse }; json_parse_args (nargs, args, &conf, true); - ptrdiff_t point = PT_BYTE; - struct json_read_buffer_data data = {.point = point}; - json_error_t error; - json_t *object - = json_load_callback (json_read_buffer_callback, &data, - JSON_DECODE_ANY - | JSON_DISABLE_EOF_CHECK - | JSON_ALLOW_NUL, - &error); - - if (object == NULL) - json_parse_error (&error); - - /* Avoid leaking the object in case of further errors. */ - record_unwind_protect_ptr (json_release_object, object); - - /* Convert and then move point only if everything succeeded. */ - Lisp_Object lisp = json_to_lisp (object, &conf); + struct json_parser p; + unsigned char *begin = PT_ADDR; + unsigned char *end = GPT_ADDR; + unsigned char *secondary_begin = NULL; + unsigned char *secondary_end = NULL; + if (GPT_ADDR < Z_ADDR) + { + secondary_begin = GAP_END_ADDR; + if (secondary_begin < PT_ADDR) + secondary_begin = PT_ADDR; + secondary_end = Z_ADDR; + } - /* Adjust point by how much we just read. */ - point += error.position; - SET_PT_BOTH (BYTE_TO_CHAR (point), point); + json_parser_init (&p, conf, begin, end, secondary_begin, + secondary_end); + record_unwind_protect_ptr (json_parser_done, &p); - return unbind_to (count, lisp); + return unbind_to (count, + json_parse (&p, PARSEENDBEHAVIOR_MovePoint)); } void @@ -1102,6 +1970,10 @@ syms_of_json (void) DEFSYM (Qjson_end_of_file, "json-end-of-file"); DEFSYM (Qjson_trailing_content, "json-trailing-content"); DEFSYM (Qjson_object_too_deep, "json-object-too-deep"); + DEFSYM (Qjson_utf8_decode_error, "json-utf8-decode-error") + DEFSYM (Qjson_invalid_surrogate_error, "json-invalid-surrogate-error") + DEFSYM (Qjson_number_out_of_range, "json-number-out-of-range-error") + DEFSYM (Qjson_escape_sequence_error, "json-escape-sequence-error") DEFSYM (Qjson_unavailable, "json-unavailable"); define_error (Qjson_error, "generic JSON error", Qerror); define_error (Qjson_out_of_memory, @@ -1113,6 +1985,14 @@ syms_of_json (void) Qjson_parse_error); define_error (Qjson_object_too_deep, "object cyclic or Lisp evaluation too deep", Qjson_error); + define_error (Qjson_utf8_decode_error, + "invalid utf-8 encoding", Qjson_error); + define_error (Qjson_invalid_surrogate_error, + "invalid surrogate pair", Qjson_error); + define_error (Qjson_number_out_of_range, + "number out of range", Qjson_error); + define_error (Qjson_escape_sequence_error, + "invalid escape sequence", Qjson_parse_error); DEFSYM (Qpure, "pure"); DEFSYM (Qside_effect_free, "side-effect-free"); -- cgit v1.2.3 From c2d21bda6182511f453f7bea2cbff2e0640625c9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 30 Mar 2024 10:37:09 +0300 Subject: Clean up removal of libjansson parser * src/json.c (json_has_suffix, json_has_prefix): Remove unused functions. (json_object_key_to_iter, json_array_get, json_loads) (json_load_callback, json_object_iter, json_object_iter_value) (json_string_value, json_object_size, json_object_iter_key) (json_object_iter_next, json_real_value, json_string_length) (json_integer_value) [WINDOWSNT]: Don't DEF_DLL_FN, don't LOAD_DLL_FN, and don't define a macro for unused libjansson functions. (JSON_HAS_ERROR_CODE): Remove: not used. --- src/json.c | 67 -------------------------------------------------------------- 1 file changed, 67 deletions(-) diff --git a/src/json.c b/src/json.c index bdb9e4cdd58..afc48c59d5a 100644 --- a/src/json.c +++ b/src/json.c @@ -31,8 +31,6 @@ along with GNU Emacs. If not, see . */ #include "buffer.h" #include "coding.h" -#define JSON_HAS_ERROR_CODE (JANSSON_VERSION_HEX >= 0x020B00) - #ifdef WINDOWSNT # include # include "w32common.h" @@ -57,23 +55,7 @@ DEF_DLL_FN (char *, json_dumps, (const json_t *json, size_t flags)); DEF_DLL_FN (int, json_dump_callback, (const json_t *json, json_dump_callback_t callback, void *data, size_t flags)); -DEF_DLL_FN (json_int_t, json_integer_value, (const json_t *integer)); -DEF_DLL_FN (double, json_real_value, (const json_t *real)); -DEF_DLL_FN (const char *, json_string_value, (const json_t *string)); -DEF_DLL_FN (size_t, json_string_length, (const json_t *string)); -DEF_DLL_FN (json_t *, json_array_get, (const json_t *array, size_t index)); DEF_DLL_FN (json_t *, json_object_get, (const json_t *object, const char *key)); -DEF_DLL_FN (size_t, json_object_size, (const json_t *object)); -DEF_DLL_FN (const char *, json_object_iter_key, (void *iter)); -DEF_DLL_FN (void *, json_object_iter, (json_t *object)); -DEF_DLL_FN (json_t *, json_object_iter_value, (void *iter)); -DEF_DLL_FN (void *, json_object_key_to_iter, (const char *key)); -DEF_DLL_FN (void *, json_object_iter_next, (json_t *object, void *iter)); -DEF_DLL_FN (json_t *, json_loads, - (const char *input, size_t flags, json_error_t *error)); -DEF_DLL_FN (json_t *, json_load_callback, - (json_load_callback_t callback, void *data, size_t flags, - json_error_t *error)); /* This is called by json_decref, which is an inline function. */ void json_delete(json_t *json) @@ -106,20 +88,7 @@ init_json_functions (void) LOAD_DLL_FN (library, json_stringn); LOAD_DLL_FN (library, json_dumps); LOAD_DLL_FN (library, json_dump_callback); - LOAD_DLL_FN (library, json_integer_value); - LOAD_DLL_FN (library, json_real_value); - LOAD_DLL_FN (library, json_string_value); - LOAD_DLL_FN (library, json_string_length); - LOAD_DLL_FN (library, json_array_get); LOAD_DLL_FN (library, json_object_get); - LOAD_DLL_FN (library, json_object_size); - LOAD_DLL_FN (library, json_object_iter_key); - LOAD_DLL_FN (library, json_object_iter); - LOAD_DLL_FN (library, json_object_iter_value); - LOAD_DLL_FN (library, json_object_key_to_iter); - LOAD_DLL_FN (library, json_object_iter_next); - LOAD_DLL_FN (library, json_loads); - LOAD_DLL_FN (library, json_load_callback); init_json (); @@ -140,20 +109,7 @@ init_json_functions (void) #define json_stringn fn_json_stringn #define json_dumps fn_json_dumps #define json_dump_callback fn_json_dump_callback -#define json_integer_value fn_json_integer_value -#define json_real_value fn_json_real_value -#define json_string_value fn_json_string_value -#define json_string_length fn_json_string_length -#define json_array_get fn_json_array_get #define json_object_get fn_json_object_get -#define json_object_size fn_json_object_size -#define json_object_iter_key fn_json_object_iter_key -#define json_object_iter fn_json_object_iter -#define json_object_iter_value fn_json_object_iter_value -#define json_object_key_to_iter fn_json_object_key_to_iter -#define json_object_iter_next fn_json_object_iter_next -#define json_loads fn_json_loads -#define json_load_callback fn_json_load_callback #endif /* WINDOWSNT */ @@ -191,29 +147,6 @@ init_json (void) json_set_alloc_funcs (json_malloc, json_free); } -#if !JSON_HAS_ERROR_CODE - -/* Return whether STRING starts with PREFIX. */ - -static bool -json_has_prefix (const char *string, const char *prefix) -{ - return strncmp (string, prefix, strlen (prefix)) == 0; -} - -/* Return whether STRING ends with SUFFIX. */ - -static bool -json_has_suffix (const char *string, const char *suffix) -{ - size_t string_len = strlen (string); - size_t suffix_len = strlen (suffix); - return string_len >= suffix_len - && memcmp (string + string_len - suffix_len, suffix, suffix_len) == 0; -} - -#endif - /* Note that all callers of make_string_from_utf8 and build_string_from_utf8 below either pass only value UTF-8 strings or use the functionf for formatting error messages; in the latter case correctness isn't -- cgit v1.2.3 From 86c4e5a2fb3fd6b7acb8a3fc10e1e7c2eb8012a9 Mon Sep 17 00:00:00 2001 From: Andreas Schwab Date: Sat, 30 Mar 2024 08:29:52 +0100 Subject: Fix implicit declaration of bswap_{32,64} * src/data.c: Move include of ... * src/lisp.h: ... here. --- src/data.c | 1 - src/lisp.h | 1 + 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/src/data.c b/src/data.c index a86f86c52f5..c4b9cff8ae0 100644 --- a/src/data.c +++ b/src/data.c @@ -23,7 +23,6 @@ along with GNU Emacs. If not, see . */ #include #include -#include #include #include #include diff --git a/src/lisp.h b/src/lisp.h index 6226ab33244..f066c876619 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -36,6 +36,7 @@ along with GNU Emacs. If not, see . */ #endif #include +#include #include #include #include -- cgit v1.2.3 From 06882a2d768241a814d7f9da24e1e5436207c0d8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 30 Mar 2024 10:52:00 +0300 Subject: ; Fix last change in inclusion of byteswap.h header * src/w32uniscribe.c (w32hb_get_font_table): Avoid warning due to redefinition of 'bswap_32'. --- src/w32uniscribe.c | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c index 84d0d95b2ab..b3112912c76 100644 --- a/src/w32uniscribe.c +++ b/src/w32uniscribe.c @@ -33,11 +33,6 @@ along with GNU Emacs. If not, see . */ #ifdef HAVE_HARFBUZZ # include # include /* for hb_ot_font_set_funcs */ -# if GNUC_PREREQ (4, 3, 0) -# define bswap_32(v) __builtin_bswap32(v) -# else -# include -# endif #endif #include "lisp.h" @@ -1270,7 +1265,11 @@ w32hb_get_font_table (hb_face_t *face, hb_tag_t tag, void *data) HFONT old_font = SelectObject (context, (HFONT) data); char *font_data = NULL; DWORD font_data_size = 0, val; +#if GNUC_PREREQ (4, 3, 0) + DWORD table = __builtin_bswap32 (tag); +#else DWORD table = bswap_32 (tag); +#endif hb_blob_t *blob = NULL; val = GetFontData (context, table, 0, font_data, font_data_size); -- cgit v1.2.3