commit 6dacb60bb135dbb002c2ce1c70f70430c5d1bbff (HEAD, refs/remotes/origin/master) Author: Basil L. Contovounesios Date: Mon Mar 4 07:19:22 2024 +0100 ; Fix last major-mode-remap-defaults change. 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)))) commit 2b5d43081a30f816dd38a16c7b5bfbad712a779b Author: Stefan Monnier Date: Sun Mar 3 23:08:16 2024 -0500 (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. 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) commit f5c65dae099485f4df128b61d36ae9e5af8518a8 Author: Po Lu Date: Mon Mar 4 11:21:53 2024 +0800 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. 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)) commit 445f376e4e613ebee94d2844926269bfa8793858 Author: Stefan Monnier Date: Sun Mar 3 22:09:24 2024 -0500 Revert "ox-texinfo:: Require only TEXINFO_DIR_CATEGORY" This reverts commit 5254c582efb3e7171e955dde653e7530d2d3ffef. 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))) commit 1a37fe3a66930bb8151a29c722dbe3bebc20d033 Author: Stefan Monnier Date: Sun Mar 3 22:09:19 2024 -0500 Revert "Set org-macro-templates more lazily" This reverts commit 99483e214fdafa76e8001c7009dff13a76c33f32. 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) commit 1d9d07fb00e6b62641c07af68f986e700b5f6cee Author: Stefan Monnier Date: Sun Mar 3 18:08:50 2024 -0500 (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. 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)))) commit 99483e214fdafa76e8001c7009dff13a76c33f32 Author: Stefan Monnier Date: Sat Mar 2 15:23:17 2024 -0500 Set org-macro-templates more lazily 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) commit 5254c582efb3e7171e955dde653e7530d2d3ffef Author: Stefan Monnier Date: Sat Mar 2 14:48:29 2024 -0500 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. 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))) commit db7b87867b3002d72444f06110e3625aa8de680e Author: Juri Linkov Date: Sun Mar 3 19:49:36 2024 +0200 * 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). 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") commit 23c984a7dea950e15b969fe5b7ca0395315f207a Author: Juri Linkov Date: Sun Mar 3 18:58:47 2024 +0200 * 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) 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) commit f677b4499964c9449d760c4c6e60130b103ed5a8 Author: Andrea Corallo Date: Sun Mar 3 16:58:25 2024 +0100 * test/lisp/emacs-lisp/comp-cstr-tests.el (comp-cstr-test-62): Revert change. 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 commit 8d11b7e4275affdf66f28ec4a719fc8124252a3d Author: Andrea Corallo Date: Sun Mar 3 16:33:53 2024 +0100 * 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. 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)) commit 7f8717c6fd3e19b41048ce9a391d59540886cdee Author: Eric Abrahamsen Date: Sat Mar 2 18:07:36 2024 -0800 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. 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 commit 5f543fb4b2f24639c7a6215991b14fca24daf194 Author: Juri Linkov Date: Sat Mar 2 19:31:07 2024 +0200 * 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. 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)) commit ebab7276139888266ae0f27bd3b2874e2ed8c077 Author: Juri Linkov Date: Sat Mar 2 19:22:30 2024 +0200 * lisp/replace.el (perform-replace): Accept default bindings in lookup-key. 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)’. 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 commit 7b4c4e68464272cc7941cb53b4421cf0e3d3c3cd Author: Juri Linkov Date: Sat Mar 2 19:15:14 2024 +0200 * lisp/buff-menu.el (Buffer-menu-marked-buffers): Add save-excursion. 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." commit 51b560b45b0653e126d17cfe278aa46e6604c867 Author: Juri Linkov Date: Sat Mar 2 19:12:29 2024 +0200 * doc/lispref/modes.texi (Tabulated List Mode): Unindent example. 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 commit 170c6557922dad7e6e9bc0d6dadf6c080108fd42 Merge: c3dc64a1071 ae80192d97b Author: Eli Zaretskii Date: Sat Mar 2 03:43:14 2024 -0500 Merge from origin/emacs-29 ae80192d97b ; * src/buffer.c (Fmake_indirect_buffer): Doc fix. 2549eabc97f Fix typos in vnvni.el. 647cecc853e ; * lisp/vc/vc.el (vc-clone): Fix wording of doc string. 383ccf6d51f Avoid assertion violations in bidi.c b7cef701cb5 * lisp/files.el (hack-one-local-variable): Use `set-auto-... 05308001759 Fix infinite recursion in gdb-mi.el commit c3dc64a1071acc1f622094f91d8f046afedb7b45 Author: Yoshiku Onu Date: Thu Feb 29 13:29:44 2024 +0500 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 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. commit e581c111165c4d138b72b6493717ed22fcb68a8e Author: Kazuhiro Ito Date: Sat Mar 2 08:49:15 2024 +0900 * lisp/language/japanese.el (map): Fix typo (bug#69494). 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)) commit f89cb6b63612a3dce113fa454fece82953fb5d5c Author: Kazuhiro Ito Date: Sat Mar 2 08:44:56 2024 +0900 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) 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)) commit 5e20b114ef32d504f4429fd35ecd0d5dcf3bd8db Author: Po Lu Date: Sat Mar 2 14:04:56 2024 +0800 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) 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. */ commit 8b96503b6e8514f1f9f92895a0707c78b1bbd1fd Author: Andrea Corallo Date: Fri Mar 1 18:56:02 2024 +0100 * lisp/emacs-lisp/cl-preloaded.el (cl--typeof-types): Define as var. 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 commit b2d18ff944ae374fa03579ca2574f1fba8ae2e4b Author: Wilson Snyder Date: Fri Mar 1 12:11:07 2024 -0500 Verilog-mode update from upstream https://github.com/veripool/verilog-mode * 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. 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, commit 31a4bec609578afd453caf232f78e275c3a075bc Author: Eli Zaretskii Date: Fri Mar 1 10:52:50 2024 +0200 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. 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}. commit ae80192d97b8d0e54a9429091cd84190bdbeb49e (refs/remotes/origin/emacs-29) Author: Eli Zaretskii Date: Fri Mar 1 10:32:32 2024 +0200 ; * src/buffer.c (Fmake_indirect_buffer): Doc fix. 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) { commit c55694785e93212d1da5f96123288e596cb24f53 Merge: 4dd4f145b85 4372a056fef Author: Andrea Corallo Date: Fri Mar 1 09:30:44 2024 +0100 Merge branch 'feature/type-hierarchy' into 'master' commit 4372a056fef90e5927d1a627fe0eb2bb01eb0dfb Author: Andrea Corallo Date: Fri Mar 1 09:27:22 2024 +0100 * doc/lispref/objects.texi (Type Hierarchy): Small improvements 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}. commit 0567f3b817ba25c8e216347cc7118fa7786039d9 Author: Andrea Corallo Date: Fri Mar 1 09:16:38 2024 +0100 * Fix compilation warning in 'cl--supertypes-for-typeof-types' * lisp/emacs-lisp/cl-preloaded.el (cl--supertypes-for-typeof-types): Fix warning. 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'. commit 2549eabc97f191ecea65d88d59cf21e5e0c81be8 Author: Dan Jacobson Date: Fri Mar 1 12:44:44 2024 +0800 Fix typos in vnvni.el. * lisp/leim/quail/vnvni.el ("vietnamese-vni"): Fix typos. (Bug#69485) Copyright-paperwork-exempt: yes 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"]) ;("$$$" ["$$"]) commit 4dd4f145b8528d5a742af4268073c24d629801d8 Author: Eli Zaretskii Date: Thu Feb 29 20:57:12 2024 +0200 ; 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. 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) commit 8305d0e0c909a5dd91a21cc1daea6298aae9eda7 Author: Juri Linkov Date: Thu Feb 29 19:50:04 2024 +0200 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. 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 commit e68f95e634f7b7248253979f47aaabd46d422e95 Merge: e18a6fbb44a 093c2e1ab9d Author: Eli Zaretskii Date: Thu Feb 29 18:35:03 2024 +0200 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit e18a6fbb44ac48998a1aebe25136a59e5a419b57 Author: Eli Zaretskii Date: Thu Feb 29 18:25:12 2024 +0200 ; Tweak recently-added NEWS entry. 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'. commit 093c2e1ab9db5e0309bf9bbb5deb9a7dcbad6267 Author: Basil L. Contovounesios Date: Thu Feb 29 16:21:05 2024 +0100 ; Fix some wording in recent obarray changes. 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) commit 39239982403f01a37d42d1cd8db0b2ed0b48b50c Author: Eli Zaretskii Date: Thu Feb 29 15:37:19 2024 +0200 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. 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) commit 62bdd307a7fd6c319529b7b20425b993a2945043 Author: Andrea Corallo Date: Thu Feb 29 14:15:30 2024 +0100 * etc/TODO (Native compiler improvements): Remove an entry as completed. 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. commit 8e5baaddec2d6a7f48ca0a08e0a95a51c6cbb151 Author: Andrea Corallo Date: Thu Feb 29 11:25:00 2024 +0100 * Add 'native-comp-async-report-warnings-errors-kind' * lisp/emacs-lisp/comp-run.el (native-comp-async-report-warnings-errors-kind): Add new customize. 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))) commit b8ba3cb7f00504ec58fda867a44631cc14b3343d Author: Andrea Corallo Date: Thu Feb 29 11:04:07 2024 +0100 * Improve 'native-comp-async-report-warnings-errors' tag * lisp/emacs-lisp/comp-run.el (native-comp-async-report-warnings-errors): Improve tag. 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 commit 862dfef88d8e62d12bac3ca2e44e035a2ff5b298 Author: Robert Pluim Date: Thu Feb 29 09:29:04 2024 +0100 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. 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. commit 15ed441fd53ddb476a2a21c8717697a74cf094e1 Author: Po Lu Date: Thu Feb 29 10:59:09 2024 +0800 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. 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) commit f8311e8b4491b5658b9d5d1bebad29478c7b95b7 (refs/remotes/origin/feature/type-hierarchy) Author: Andrea Corallo Date: Wed Feb 28 20:48:49 2024 +0100 Run syncdoc-type-hierarchy.el to follow obarray type introduction * doc/lispref/type_hierarchy.jpg: Update. * doc/lispref/type_hierarchy.txt: Likewise. 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 | commit 1fbe56c32761efdc8d268df80a97a9102d00e109 Merge: 6de60f33ed5 05195e129fc Author: Andrea Corallo Date: Wed Feb 28 20:47:57 2024 +0100 Merge remote-tracking branch 'origin/master' into 'feature/type-hierarchy' commit 05195e129fc933db32c9e08a155a94bfa4d75b54 Author: Andrea Corallo Date: Wed Feb 28 20:38:30 2024 +0100 * lisp/emacs-lisp/cl-macs.el (cl-deftype-satisfies): Add 'symbol-with-pos'. 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? commit 91b90885aca17b5140b56fa3b5c4960baf8672a1 Author: Andrea Corallo Date: Wed Feb 28 20:38:02 2024 +0100 * lisp/emacs-lisp/comp.el (comp-known-predicates): Add 'symbol-with-pos-p'. 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)) commit bca3c9b466e24aacd561c818f2d19665af6efc11 Author: Basil L. Contovounesios Date: Wed Feb 28 17:02:41 2024 +0100 ; Fix :type of text-mode-ispell-word-completion. 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) commit f7c2fe3337bb5e5721d17f40f79dbc1275e17b0d Author: Basil L. Contovounesios Date: Wed Feb 28 16:38:21 2024 +0100 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. 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") commit e490d2f8724c5e47d83c40c388f60e84f541dae5 Author: Michael Albinus Date: Wed Feb 28 16:31:25 2024 +0100 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. 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) commit 1ddd9c8e29f721fcf6fcb17ef7a07fac0421c4f7 Author: Basil L. Contovounesios Date: Wed Feb 28 15:30:41 2024 +0100 ; * .mailmap: Fix GitHub address (bug#68559#170). 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 commit 8a2d013be37d8c3d3a25cfe1da505cd2e27dda5c Author: Liu Hui Date: Wed Feb 21 12:40:06 2024 +0800 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) 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 commit 3412b64ac8851a0fa8e55c6319d2e710ae27a74c Author: Basil L. Contovounesios Date: Wed Feb 28 11:35:04 2024 +0100 ; Update Lisp_Obarray hash for CHECK_STRUCTS This follows commit 462d8ba813 of 2024-02-23 "Add a proper type for obarrays". 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); commit 977a56d5c7d71b958767dbae05b75c5e5cb87571 Author: Po Lu Date: Wed Feb 28 12:23:32 2024 +0800 ; 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. 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 commit f1db8cf9a0595f7db29b548b38ce98196f36e09b Author: Po Lu Date: Wed Feb 28 12:05:59 2024 +0800 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. 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) commit 6a77355527b2f7f1dca9c2296c2684033c9aa875 Author: Stefan Monnier Date: Tue Feb 27 08:24:45 2024 -0500 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. 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 commit 647cecc853e53a3be0bb2cf5328cd19e677217c9 Author: Eli Zaretskii Date: Tue Feb 27 15:11:58 2024 +0200 ; * lisp/vc/vc.el (vc-clone): Fix wording of doc string. 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 commit 6de60f33ed5cc438e20400aee83e1e2032773811 Author: Andrea Corallo Date: Tue Feb 27 12:20:31 2024 +0100 ; * src/data.c (Ftype_of): Update comment. 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; commit 383ccf6d51fd7af65dbcc1ce159a03369a48d27f Author: Eli Zaretskii Date: Tue Feb 27 13:12:15 2024 +0200 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) 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. */ commit b59d7094b6cb1a09f46f933807e9cd00a8bd1547 Author: Philip Kaludercic Date: Tue Feb 27 10:32:08 2024 +0100 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. 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 commit 32b4f9d21b14190f1ed1611515751abe4b90fa68 Author: Po Lu Date: Tue Feb 27 10:05:56 2024 +0800 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. 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. commit b3eb49a4661e31306555e82bdf24db6c36d67ad2 Author: Stefan Monnier Date: Mon Feb 26 14:32:08 2024 -0500 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. 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) commit a67b8d7f448804d34bce85d2b6ab8d022f14161f Author: Mattias Engdegård Date: Mon Feb 26 18:42:44 2024 +0100 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). 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 = commit 25cfccfb8b5bced05d5547f3eabb4d0508a575c8 Author: Stefan Monnier Date: Mon Feb 26 12:33:35 2024 -0500 (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`. 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)." commit 76fa7f1f2fb7fbc3dcbd0be7928d0ec112e532e7 Author: Eli Zaretskii Date: Mon Feb 26 19:26:04 2024 +0200 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) 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 commit 1687adcb5c93b490e2e7edcd14615af295e791ed Author: Po Lu Date: Mon Feb 26 14:13:49 2024 +0800 ; Delete trailing whitespace * lisp/net/tramp-androidsu.el (tramp-androidsu-maybe-open-connection): Delete trailing whitespace. 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) commit babe6a5e948985f961ffd36f64323950abd98b7f Author: Po Lu Date: Mon Feb 26 14:13:14 2024 +0800 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. 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 commit c6f2add964ce1ac69ba6705bc869ee2f447da3cb Author: Stefan Monnier Date: Sun Feb 25 13:18:08 2024 -0500 * lisp/vc/vc-hooks.el (vc-mode): Give a body to the function (bug#69387) 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))) commit b7cef701cb587ecb66f192e4d41aa202645560e0 Author: Stefan Monnier Date: Sun Feb 25 11:35:44 2024 -0500 * lisp/files.el (hack-one-local-variable): Use `set-auto-mode-0` This fixes bug#69373. 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))) commit e02c4a864f02787f0e194c9e8a6d4ab0b18ca39f Author: Michael Albinus Date: Sun Feb 25 15:37:06 2024 +0100 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. 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.") commit 39e3fce0d5e0f5db00e44905bcd2590170098d63 Author: Michael Albinus Date: Sun Feb 25 10:06:09 2024 +0100 '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'. 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)))))))) commit 67ba629a91aee3db39f3c81744e88c02ee710bdc Author: Michael Heerdegen Date: Sun Feb 18 02:27:56 2024 +0100 ; * lisp/subr.el (if-let, and-let*): Tweak doc strings. (Bug#69108) 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 commit e680827e814e155cf79175d87ff7c6ee3a08b69a Author: Michael Heerdegen Date: Fri Feb 16 22:07:18 2024 +0100 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. 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 commit 6b800f9adf3506bf113539cf22cd07c7cda9f7b8 Author: Juri Linkov Date: Sun Feb 25 09:32:45 2024 +0200 * 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). 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))) commit 782ff2f826e2fde75f6491f3a6cf0d7fcd5510b2 Author: Eli Zaretskii Date: Sun Feb 25 08:20:44 2024 +0200 * nt/cmdproxy.c (_snprintf) [_UCRT]: Redirect to 'snprintf'. 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, ...); commit 05116eac0c199b0c8409a32b349a42a21b5a0fb0 Author: Po Lu Date: Sun Feb 25 11:41:02 2024 +0800 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. 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) commit 9a801f0b4621a46149ccf650ed1dc27942157562 Author: Stefan Monnier Date: Sat Feb 24 17:52:14 2024 -0500 * lisp/progmodes/elisp-mode.el (eval-last-sexp, eval-defun): Fix thinko 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 commit 0503657a9cffbe3a5fc4f0023ee9985073e62d2c Author: Stefan Monnier Date: Sat Feb 24 13:12:20 2024 -0500 * etc/NEWS.25: Add 'obarrayp' as well 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 commit 5fa6042c739b2b0abb320964d5391704c8fbb5a6 Author: Stefan Monnier Date: Sat Feb 24 12:49:20 2024 -0500 * etc/NEWS.25: Add missing announcement of 'obarray' package 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 commit de6b1e1efb1a36c69e7a6e09297e1de5b1477121 Author: Mattias Engdegård Date: Sat Feb 24 17:47:37 2024 +0100 Replace XSETSYMBOL with make_lisp_symbol * src/lisp.h (XSETSYMBOL): Remove. All callers changed to use make_lisp_symbol. 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. commit 56beeff14365d8e802ab7b4888aa7e95b2cf9509 Author: Stefan Monnier Date: Sat Feb 24 12:23:41 2024 -0500 * src/editfns.c (Fget_pos_property): Fix thinko (bug#69358) 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); commit 68096a716bfe3c212a68b3d285a0386ea0867130 Author: Stefan Monnier Date: Sat Feb 24 11:02:37 2024 -0500 (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. 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. commit 3076e79a6a11f9df33c5bcaa7aa58955550aeef0 Author: Eli Zaretskii Date: Sat Feb 24 17:13:47 2024 +0200 ; Fix a recent change in diff-mode.el * lisp/vc/diff-mode.el (diff-refine-nonmodified): Doc fix. * etc/NEWS: Improve wording. 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) commit 0530800175913769cb55ae7997ee4487a755a0a4 Author: Eli Zaretskii Date: Sat Feb 24 15:12:57 2024 +0200 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) 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 commit 229b3edb072de490f458cf986bf34bc1ffc87837 Merge: eeb89a5cb29 01ebc95114f Author: Eli Zaretskii Date: Sat Feb 24 06:35:16 2024 -0500 Merge from origin/emacs-29 01ebc95114f Fix 'help-quick-toggle' afe49c7e2a2 ; * admin/authors.el (authors-aliases): Fix last change. 8b1f10f8cf4 ; Normalize Morgan Smith's attributions. 70cf4b694b3 ; * etc/PROBLEMS: Describe input lags due to GTK IM (bug#... f28a557c7d4 * doc/lispref/modes.texi (Tabulated List Mode): Update. d6131b5902a * lisp/net/tramp.el (tramp-methods): Fix typo in docstrin... 2eb85a9de1a ; * lisp/emacs-lisp/pcase.el (pcase-let*, pcase-let): Ano... 4c6653f23ae ; * lisp/emacs-lisp/pcase.el (pcase-let*, pcase-let): Doc... 5a64d2c7595 java-ts-mode: Indentation for opening brace on a separate... 9e56bd5ed87 Removed decommissioned PGP keyservers e56f0ef51bf org: Fix security prompt for downloading remote resource 65ba3274652 Revert "Update to Org 9.6.19" 07a392f445e Update to Org 9.6.19 commit eeb89a5cb292bffe40ba7d0b0cf81f82f8452bf8 Author: Mattias Engdegård Date: Sat Feb 24 12:08:09 2024 +0100 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. 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 commit 4eed2768b10d074612853b68248a4b255a5c7d58 Author: Eli Zaretskii Date: Sat Feb 24 13:03:11 2024 +0200 ; Fix last change. 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. commit 1972beda6de3d6895cc197dc292721ca963b234c Author: Mattias Engdegård Date: Sat Feb 24 11:43:28 2024 +0100 ; * etc/NEWS: Recommend obarray-make as correct replacement. 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. commit 477eb882b57b3defd43ea8dd9510cfdf5fd9ee79 Author: Philip Kaludercic Date: Tue Feb 13 10:38:48 2024 +0100 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). 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 commit 01ebc95114fe89ef623bc7ebdd3c3e1b9ef06b4e Author: Eli Zaretskii Date: Sat Feb 24 11:59:30 2024 +0200 Fix 'help-quick-toggle' * lisp/help.el (help-quick-sections): Fix "kill-region" command. Add a doc string. (Bug#69345) 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)) commit 03fce8401639a1d60bb66bf374d3d44b3331ac8a Author: Eli Zaretskii Date: Sat Feb 24 11:27:12 2024 +0200 ; Fix last change in lisp.h. 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; commit 526c262149839702b94253d5eff195054ac5cd9e Author: Spencer Baugh Date: Tue Feb 13 12:20:39 2024 -0500 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. 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; commit a8fe17e49a5c4ec1490966271c68a1b8add8d41a Merge: 0bdd2eb9af1 d1fe392f93c Author: Eli Zaretskii Date: Sat Feb 24 11:23:20 2024 +0200 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 0bdd2eb9af171fa9d825bc6d09e0ad5d114684c4 Author: Spencer Baugh Date: Wed Feb 14 11:09:33 2024 -0500 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) 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) commit d1fe392f93ce7e71cd378326814ec4e3a4143f0c Author: Arash Esbati Date: Sat Feb 24 09:30:16 2024 +0100 ; Fix compiler warning * lisp/textmodes/reftex-vars.el (reftex-cite-format-builtin): Fix character escaping in the docstring. (bug#69341) 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.") commit afe49c7e2a2340432418df264f93d8ac88bca95f Author: Eli Zaretskii Date: Sat Feb 24 09:32:06 2024 +0200 ; * admin/authors.el (authors-aliases): Fix last change. 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") commit 8b1f10f8cf473cdc57e780845393d8681ee2ed4c Author: Morgan Smith Date: Fri Feb 23 19:03:13 2024 -0500 ; Normalize Morgan Smith's attributions. 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") commit 15b6d72599b961ebe23e820e44ba2ffc12e49c31 Author: Eli Zaretskii Date: Sat Feb 24 09:21:35 2024 +0200 ; * etc/NEWS: How to fix old code that uses vectors as obarrays. 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. commit c7a2b7d023dfef78f6cb6f00fc8194ce8eaaf8a4 Author: Po Lu Date: Sat Feb 24 11:09:05 2024 +0800 * configure.ac: Detect renameat2 with gl_CHECK_FUNCS_ANDROID. 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 commit 15a140a24664e96620838136640d660f842dfa49 Author: Emanuel Berg Date: Tue Jan 23 14:21:49 2024 +0100 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) 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.")) commit 56706254a8ee09e651097fb5075cae75b3bd4e22 Author: F. Jason Park Date: Wed Feb 21 20:08:37 2024 -0800 ; 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. 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. commit 8d5983aa78e36afa815325e7bce85a81d314e67b Author: Po Lu Date: Sat Feb 24 10:01:57 2024 +0800 Fix bug#69321 * java/org/gnu/emacs/EmacsWindow.java (onKeyDown, onKeyUp): Provide Right Alt (Alt Gr) masks to system keymap routines. (bug#69321) 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 @@ private static class Coordinate 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 @@ private static class Coordinate 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 @@ private static class Coordinate 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); commit 65d4bf711055dc8d23cea9b2ec8a57cdbfa6cf05 Author: Po Lu Date: Sat Feb 24 10:01:03 2024 +0800 ; * .dir-locals.el (java-mode): Transfer suitable c-mode options. 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) commit 26290870b3505b8971c73fe3a82b69e3c4e86b88 Author: Stefan Monnier Date: Fri Feb 23 17:03:10 2024 -0500 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. 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)) commit 84f72f19e514db8f8f6e469340fb5fa0719d40b6 Author: Stefan Monnier Date: Fri Feb 23 16:46:01 2024 -0500 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`. 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 commit c0d7f7fc54f6c67f409e75f20ebb4420d96c71a6 Merge: 3599a9a1cf1 2b7dc7fef81 Author: Stefan Monnier Date: Fri Feb 23 11:39:26 2024 -0500 Merge remote-tracking branch 'refs/remotes/origin/master' commit 3599a9a1cf1f8bed7c7f00fd8f00b2bfc0c4271f Author: Stefan Monnier Date: Fri Feb 23 11:38:48 2024 -0500 * lisp/mail/rmail.el (rmail-resend): Use `with-syntax-table` 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)))) commit 048eaadd8cc97faf0f3e70a8d81d06f915c52081 Author: Stefan Monnier Date: Fri Feb 23 11:37:24 2024 -0500 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. 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 commit 0b855e1465b26f69156a35befebb4167145cdccf Author: Stefan Monnier Date: Fri Feb 23 11:31:43 2024 -0500 (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. 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.") commit 2b7dc7fef814753f1c6d4c352fe69bb6e167cd07 Author: Robert A. Burks Date: Fri Feb 16 18:17:52 2024 -0500 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 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] commit 90d3b3408e404aba383302c3147d3ca614619986 Author: Mattias Engdegård Date: Fri Feb 23 13:57:04 2024 +0100 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. 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) commit a8f167547bc15eacaf5fbc07c1e75f603e70862d Author: Mattias Engdegård Date: Fri Feb 23 13:14:18 2024 +0100 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. 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") "$"))))) commit 6803b70c1972bc82f7dc1f1d6bbb2a60b6f40367 Author: Mattias Engdegård Date: Sat Feb 17 13:27:25 2024 +0100 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. 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 commit 3ea77c735de975ebda707e0e1e8bb5e0adad2bf5 Author: Mattias Engdegård Date: Sun Feb 11 15:11:21 2024 +0100 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. 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); commit 462d8ba813e07a25b71f5c1b38810a29e21f784c Author: Mattias Engdegård Date: Sat Feb 10 21:14:09 2024 +0100 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. 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))) commit 6a182658a533acab94d8fa0aec3e2b7a4f7d6a93 Author: Mattias Engdegård Date: Sun Feb 11 18:30:22 2024 +0100 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. 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 commit 3beaa3131e78bea618cb93d03c5d8b0f8977fb94 Author: Mattias Engdegård Date: Sat Feb 10 20:59:42 2024 +0100 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. 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)))) commit aa82fe9931851e66aa335e96ae35fd967951b281 Author: Mattias Engdegård Date: Thu Feb 8 18:23:00 2024 +0100 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. 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) commit 32843c7b36b8bf3dc9ac82059a1c3cab03cd8c98 Author: Andrea Corallo Date: Fri Feb 23 01:07:46 2024 +0100 * src/pdumper.c (dump_subr): Rename 'native_comp' -> 'non_primitive'. 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], commit 6a53836a245a8154f1f176ce2a787c24aa7409cb Author: Mattias Engdegård Date: Fri Feb 23 11:26:45 2024 +0100 * src/fns.c (sxhash_bignum): Include sign bit in hash. 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)); commit 53e60fb004c0e8b40b01fcfcf7f406557e35aa3e Author: Mattias Engdegård Date: Thu Feb 22 20:15:33 2024 +0100 * 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. 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; commit f85280503a3a67e1618069b1c7d6810efa924fe8 Author: Mattias Engdegård Date: Thu Feb 22 17:20:58 2024 +0100 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. 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." commit b868690feff44c7242c942490d1d8bc6d2811fa2 Author: Po Lu Date: Fri Feb 23 10:18:17 2024 +0800 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) 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)); } } commit 58ca91fe0723c861d53375f52e5b6dd54a49a2e3 Author: Andrea Corallo Date: Thu Feb 22 20:40:57 2024 +0100 * Fix 'parse-colon-path' entry in 'comp-known-type-specifiers' * lisp/emacs-lisp/comp-common.el (comp-known-type-specifiers): Fix 'parse-colon-path'. 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)) commit cc58626f643c1b19e66bab9c6a39026c7e419ab9 Author: Juri Linkov Date: Thu Feb 22 19:38:17 2024 +0200 * 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. 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)) commit 70cf4b694b317b367a046b0b03746c56e23fcb91 Author: Eli Zaretskii Date: Thu Feb 22 15:15:53 2024 +0200 ; * etc/PROBLEMS: Describe input lags due to GTK IM (bug#69246). 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 commit 6b6761d534259ab4d5409e72754e46af13623dda Author: Jörg Bornemann Date: Sat Feb 17 21:18:02 2024 +0100 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. 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. commit 8e0f134653b2951e80cd5659fba5c36e416931fa Author: Po Lu Date: Thu Feb 22 13:30:18 2024 +0800 ; Insert missing JNI prologues * src/android.c (shouldForwardMultimediaButtons) (shouldForwardCtrlSpace, notifyPixelsChanged, setupSystemThread): * src/androidvfs.c (safSyncAndReadInput, safSync, safPostRequest) (ftruncate): Insert absent JNI prologues. 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; commit ee6343556a53770cd2c7730b48ce1731423d8825 Author: Po Lu Date: Thu Feb 22 10:21:12 2024 +0800 ; * admin/CPP-DEFINES: Fix typos. 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. commit f024b63ecf8d4ebfd518beb4c2dfc853d725ec19 Author: Po Lu Date: Thu Feb 22 10:08:12 2024 +0800 ; * admin/CPP-DEFINES: Update with Android defines. 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.) commit 39a84232700c40fa74305970dd16cd5cb8b8bea0 Author: Po Lu Date: Thu Feb 22 09:53:48 2024 +0800 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. 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; commit b214cb2843851c410d603e7fb487a462d5f7bee1 Author: Andrea Corallo Date: Wed Feb 21 21:38:11 2024 +0100 ; * lisp/emacs-lisp/comp-run.el: Fix typo. 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. commit f28a557c7d4b39f302630ed2b19a73fc375e7ff4 Author: Juri Linkov Date: Wed Feb 21 19:43:28 2024 +0200 * 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. 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 commit 44d5c667d7775f881473c7c6f7d9bdef7594bd79 Author: Andrea Corallo Date: Wed Feb 21 17:45:41 2024 +0100 * lisp/emacs-lisp/comp.el (comp--compute-function-types): Fix missing doc. 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))) commit e6882a5cc89d9375dfa73156db6836af19ef7b8a Author: Eshel Yaron Date: Thu Feb 1 12:30:24 2024 +0100 ; 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) 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 commit 35d99b1ec7c56d4a5c09af36e6bbd7f0f959cccc Author: john muhl Date: Wed Feb 21 10:14:05 2024 -0600 ; 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) 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") \ commit 88abbf00af69cf7e5f36e318e6935f7d1500af7f Author: Andrea Corallo Date: Wed Feb 21 15:45:40 2024 +0100 ; 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. 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) commit c65a59a9e90524efa23d9151c31dad66a08ccb90 Author: Andrea Corallo Date: Wed Feb 21 15:45:10 2024 +0100 * 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. 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 commit 5aeea8dc2c0bdd01de3ad271723e9d1737d8a056 Author: Andrea Corallo Date: Wed Feb 21 15:06:18 2024 +0100 * lisp/emacs-lisp/comp-cstr.el (comp-cstr): Rename constructors. 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) commit 1e1d3f3acd8567addc0dab4bc34dc5c7f2405556 Author: Andrea Corallo Date: Wed Feb 21 11:18:28 2024 +0100 ; * lisp/emacs-lisp/comp.el (native-comp-debug): Fix spacing. 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. commit 7215c63fc0f9d7f48ac20578d310a8b3d86b0eae Author: Andrea Corallo Date: Wed Feb 21 11:18:06 2024 +0100 * 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. 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 commit 8987e1b093b07756d18c861d1c7febb85fe88bef Author: Eli Zaretskii Date: Wed Feb 21 17:16:45 2024 +0200 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'. 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 commit a2eb123fb606af2a62ad6d0d0162255d7f0601e1 Author: Mattias Engdegård Date: Wed Feb 21 15:22:21 2024 +0100 ; * src/lisp.h: Add Lisp_Object tagging scheme overview 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. */ commit d5757178464ca51f79c7fc1ab199a1582e92ab32 Author: kobarity Date: Fri Feb 16 22:52:06 2024 +0900 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) 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 commit 0a4d4781ddc079509cb256edf803d663439dcf92 Author: Po Lu Date: Wed Feb 21 21:49:35 2024 +0800 * java/org/gnu/emacs/EmacsContextMenu.java (display): Reduce timeout. 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 @@ private static final class Item implements MenuItem.OnMenuItemClickListener 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; } commit 3b34c5e4a583dd88f476570cbd58655a18e9a6b4 Author: Stefan Monnier Date: Wed Feb 21 08:49:15 2024 -0500 * lisp/emacs-lisp/map.el (map--make-pcase-bindings): Fix use in Emacs<30 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) commit d6131b5902a70339305285f9861bdfd24c567eab Author: Michael Albinus Date: Wed Feb 21 09:02:33 2024 +0100 * lisp/net/tramp.el (tramp-methods): Fix typo in docstring. (Bug#69294) 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 commit 7b0d75018885d8d34ff7c4427a83a21a4808282c Author: Po Lu Date: Wed Feb 21 11:49:47 2024 +0800 Work around premature dismissals of submenus under Android * java/org/gnu/emacs/EmacsContextMenu.java (display): If between HONEYCOMB and N, set wasSubmenuSelected. 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 @@ private static final class Item implements MenuItem.OnMenuItemClickListener 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; } }); commit 1acc7cb851417b83ae90fe4d0ee9f01af2e03722 Author: Jonas Bernoulli Date: Tue Feb 20 22:49:07 2024 +0100 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) 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) commit 167d9b9040333a5bff64325423750243c60edfa1 Author: Jonas Bernoulli Date: Tue Feb 20 18:49:20 2024 +0100 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. 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. commit bbf0b7d0407883ea0a59c09b501c6e550bb8e10c Author: Andrea Corallo Date: Tue Feb 20 19:47:29 2024 +0100 * Fix missing entry in 'cl--typeof-types' * lisp/emacs-lisp/cl-preloaded.el (cl--typeof-types): Add 'native-comp-unit'. 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. commit 2eb85a9de1a5068d09b21464601dbd3263e55c85 Author: Eli Zaretskii Date: Tue Feb 20 19:15:38 2024 +0200 ; * lisp/emacs-lisp/pcase.el (pcase-let*, pcase-let): Another doc fix. 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)) commit 4c6653f23aef097e3a6ed687e21decea6c790b5e Author: Eli Zaretskii Date: Tue Feb 20 15:44:13 2024 +0200 ; * lisp/emacs-lisp/pcase.el (pcase-let*, pcase-let): Doc fix. 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*)) commit d9afa1f30fdf9d00b447fea0a8343397333e172f Author: Jonas Bernoulli Date: Mon Feb 19 23:36:17 2024 +0100 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. 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-\\|$\\|[()]\\)") commit d5775ae4d3ac8a1a4d2625e05307c9296df28d6f Author: Michael Albinus Date: Tue Feb 20 12:53:15 2024 +0100 ; Copyedits 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 commit 4e9993cada32a866a75b458092de0028db2f5f41 Author: Michael Albinus Date: Tue Feb 20 12:52:40 2024 +0100 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'. 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 commit a1cbc4d810bc1b525fa46b23249b414c1ad6b031 Author: Eli Zaretskii Date: Mon Feb 19 21:34:43 2024 +0200 ; * doc/misc/gnus.texi (Other modes): Fix last change. 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 commit 6893106fe9302b1be68dd04034441799e6d29b68 Author: Philip Kaludercic Date: Thu Feb 15 12:10:12 2024 +0100 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) 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)) commit 6a2b43c5692e7427be0ddc6b084052f283b77d65 Author: Andrea Corallo Date: Mon Feb 19 17:47:45 2024 +0100 * etc/syncdoc-type-hierarchy.el (syncdoc-lispref-dir): Clean-up. 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) commit afed7f959a39c077aba6dc585cdfc0edcf05ddc8 Author: Andrea Corallo Date: Mon Feb 19 17:42:14 2024 +0100 * etc/syncdoc-type-hierarchy.el: Update comment. 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: commit 0393bfdc912912e3368b786d062894f3069d210b Author: Andrea Corallo Date: Mon Feb 19 17:40:04 2024 +0100 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. 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 commit 23793600778c4efe5615b646f2d3895624c23ef0 Author: Mattias Engdegård Date: Mon Feb 19 14:42:55 2024 +0100 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. 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; commit 188fe6bffa69e08b60a7d65709998bd803b7ada5 Author: Mattias Engdegård Date: Mon Feb 19 11:44:53 2024 +0100 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. 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 commit ddfba511c190e5bb44e44a50aef5ab8c08e3d798 Author: Mattias Engdegård Date: Mon Feb 19 10:27:02 2024 +0100 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. 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" commit 70dc1700562309c2612a71be35f9c71e9e1641b8 Author: Eli Zaretskii Date: Mon Feb 19 15:19:54 2024 +0200 ; Further copyedits of doc/translations/README. 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. commit 5d3ecd7358252349dd26e6015a83054893af4474 Author: Jean-Christophe Helary Date: Mon Feb 19 20:05:14 2024 +0900 ; Proofreading changes in doc/translations/README. 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 commit be8f3e68a88a00bc12f1cc405a8a341666c41858 Author: Ihor Radchenko Date: Tue Jan 2 12:06:16 2024 +0100 * test/src/eval-tests.el (eval-tests/default-value): Add new test case. Bug#66117 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. commit 8f260bb93f534b24d9a93d3315804ffe0c1fec4f Author: Yuan Fu Date: Sun Feb 18 21:39:31 2024 -0800 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. 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)) commit f6743099cc907f1f2847f028ff8f3712288c559f Author: Eric Abrahamsen Date: Sun Feb 18 18:08:51 2024 -0800 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. 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 commit 24e8fceb960e0b3b7e270211bd7f460c4c871008 Author: Andrea Corallo Date: Sun Feb 18 20:03:53 2024 +0100 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. 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) commit 4a8d3c5b75b28167300d2df061d053935809d43e Author: Paul Eggert Date: Sun Feb 18 00:12:28 2024 -0800 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. 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 commit 659770fdf535ca683a97d965d2e4ed0f9f321145 Author: Paul Eggert Date: Sat Feb 17 23:48:20 2024 -0800 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. 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 commit 42c6cf4e5804312defa9d9caac8882500bd38179 Author: Paul Eggert Date: Sat Feb 17 23:38:30 2024 -0800 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. 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; commit f8d27a8a1fd5bdc8e25569cc05a9298e186a8c63 Author: Paul Eggert Date: Sat Feb 17 23:12:18 2024 -0800 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. 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 commit d80f1352d80938bb4ef61c5d74aa056902abd9b4 Author: Eli Zaretskii Date: Sun Feb 18 09:56:14 2024 +0200 ; Fix punctuation and encoding of doc/translations/README * doc/translations/README: Fix non-ASCII characters and punctuation. Add local variables section. 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: commit 42179750c5f3f722b1ce2f82d2b2e73bba8e4de8 Author: Eli Zaretskii Date: Sun Feb 18 09:49:16 2024 +0200 Move translations-related files to do/translations/. diff --git a/doc/README b/doc/translations/README similarity index 100% rename from doc/README rename to doc/translations/README diff --git a/doc/fr/misc/ses-fr.texi b/doc/translations/fr/misc/ses-fr.texi similarity index 100% rename from doc/fr/misc/ses-fr.texi rename to doc/translations/fr/misc/ses-fr.texi commit a58bcb96ac898d218b3169e76db798f192107d52 Author: Jean-Christophe Helary Date: Sun Feb 18 00:02:09 2024 +0900 Move French translations to the top-level doc/ directory. diff --git a/doc/lang/fr/misc/ses-fr.texi b/doc/fr/misc/ses-fr.texi similarity index 100% rename from doc/lang/fr/misc/ses-fr.texi rename to doc/fr/misc/ses-fr.texi commit aa8baf77b47e3de114f5dc5e9aaa987bb96ed248 Author: Jean-Christophe Helary Date: Sun Feb 18 00:04:18 2024 +0900 Add README file about translations of Emacs manuals * doc/README: New file. 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. commit c2d714886ef139f601d89463675b0d5b49d18ff9 Author: Po Lu Date: Sun Feb 18 12:48:41 2024 +0800 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. 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.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 @@ private static class Coordinate requestViewLayout (); } + /* Return WM layout parameters for an override redirect window with + the geometry provided here. */ + private WindowManager.LayoutParams getWindowLayoutParams () { @@ -384,15 +389,15 @@ private static class Coordinate 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 @@ private static class Coordinate { EmacsWindowAttachmentManager manager; WindowManager windowManager; - Context ctx; + Activity ctx; Object tem; WindowManager.LayoutParams params; @@ -447,11 +452,23 @@ private static class Coordinate 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 */ } commit bd0e281a6a27c048b12847811bc0385acbaa1eec Author: Paul Eggert Date: Sat Feb 17 15:58:03 2024 -0800 Update from Gnulib by running admin/merge-gnulib 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]) { commit 37bb33dae791e5f59f1d0d27c0221db3b3b4c16d Author: Paul Eggert Date: Thu Feb 15 18:45:29 2024 -0800 Adjust to yesterday’s Gnulib nstrftime changes 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. 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 commit 5a64d2c7595dc393504c6eee9321d74dbd8ae9e2 Author: Dmitry Gutov Date: Sat Feb 17 22:34:55 2024 +0200 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. 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; + } + } +} +=-=-= commit 9e56bd5ed8775f53c3025b114525cee7c578e2d0 Author: Philip Kaludercic Date: Sun Feb 11 18:38:13 2024 +0100 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. 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") commit 20997aa20728a6fc2a3de736e9fc718b97dcef99 Author: Philip Kaludercic Date: Sat Feb 17 19:20:42 2024 +0100 ; Fix typo from commit 32c5bdfa971 * lisp/gnus/gnus-util.el (gnus-not-ignore): Quote the argument to defalias. 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. commit 32c5bdfa971220bae37991a298628605c82f866c Author: Jakub Ječmínek Date: Sat Feb 17 09:34:36 2024 -0800 Provide better default value for date in Gnus scoring 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". 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) commit db5e84af202532b138918295ea6dd1b0ea910d78 Author: Eric Abrahamsen Date: Sat Feb 17 09:31:50 2024 -0800 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' 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. commit e56f0ef51bfdd0e03e817670754bc813fb3702a2 Author: Ihor Radchenko Date: Fri Feb 2 20:59:41 2024 +0100 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 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) commit c14a67a80f4263c13db55b6a79fb545b82a8b5b7 Author: Eli Zaretskii Date: Sat Feb 17 18:57:12 2024 +0200 ; Fix markup in last change (bug#68929). 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. commit 52d554d5d8964943c65ecf140fdcc4bd6bccf855 Author: Jeremy Bryant Date: Sun Feb 11 21:26:41 2024 +0000 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. 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 commit 65ba3274652a4dac37f41f872330e391cd511ae1 Author: Eli Zaretskii Date: Sat Feb 17 18:53:05 2024 +0200 Revert "Update to Org 9.6.19" This reverts commit 07a392f445eb21c5e4681027eee9d981300a4309. It was installed by mistake. 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: Sat Feb 17 10:17:41 2024 -0500 Update to Org 9.6.19 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 Feb 17 12:15:11 2024 +0200 ; Don't use non-ASCII characters in C comments in xdisp.c. 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. */ commit e6dae47d718dfd2167554a1adfe28c5c744b9b2b Merge: d85461ac61c 45f9af61b8e Author: Eli Zaretskii Date: Sat Feb 17 04:54:48 2024 -0500 Merge from origin/emacs-29 45f9af61b8e Remove references to phst@google.com. 7256690a3ca * BUGS: Note how to report critical security issues. 1035669b38b Add cross-reference to ELisp manual Caveats 61a14507627 Improve directory prompt used by package-vc-checkout 0c7c8210cb6 Minor Tramp doc adaption df243f785d4 Merge branch 'emacs-29' of git.sv.gnu.org:/srv/git/emacs ... 17a395e04c6 ;; Fix typo in the Tramp documentation 614b244a7fa * Improve reproducibility of inferred values by native comp 9f9da26e0dc Handle typescript ts grammar breaking change for function... 717d8c4285f Don't quote 't' in doc strings commit d85461ac61c5ea99ea194f99c771de1efdabbef4 Author: Eli Zaretskii Date: Sat Feb 17 11:31:20 2024 +0200 ; 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). 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 commit 6477be93bd8a29cba8ce383f9ea3fba23c45f225 Author: Aleksandr Vityazev Date: Thu Feb 15 22:51:24 2024 +0300 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) 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 commit 84e4f1259b54442f52183c1ccee72a417e0a2658 Author: john muhl Date: Mon Feb 12 18:46:51 2024 -0600 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) 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)) commit c64e650fb346d92294703d22f8cd7deb7c47b49e Author: Kévin Le Gouguec Date: Sat Feb 10 17:56:57 2024 +0100 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. 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'" commit ecb9641ecb5f42899042ff9c164ec7dbb8e166fe Author: Kévin Le Gouguec Date: Sat Feb 10 17:37:35 2024 +0100 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. 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'" commit de6f7f3c86ea0e52e8f9825585c726a7f93fa9cf Author: Kévin Le Gouguec Date: Sat Feb 10 16:14:08 2024 +0100 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. 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'" commit 3d87e343276081247102838b827b8a1f5e9e0c54 Author: F. Jason Park Date: Sun Feb 11 20:01:54 2024 -0800 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) 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") commit 25d15391f2683ea95c4d7ee291fb82e0c9858d73 Author: F. Jason Park Date: Sun Feb 11 17:15:14 2024 -0800 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) 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)) commit d7c18a7b4f218de8c4d2178c9124ea26c7dc5b6b Author: F. Jason Park Date: Sun Feb 11 20:42:18 2024 -0800 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. 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))) commit 9668b4f97c2fc6bfff83258861d455a6d02516a8 Author: F. Jason Park Date: Mon Nov 13 12:07:36 2023 -0800 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) 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) commit 1a36d52413c784750f650ccba95436e4f76ab104 Author: F. Jason Park Date: Sat Feb 3 17:17:48 2024 -0800 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) 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 commit a43b062ee57fd9b7c410e741946e51281db5b92a Author: F. Jason Park Date: Thu Feb 8 19:19:53 2024 -0800 ; 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'. 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 _) ""))) commit e288e1b2f352952e826727967a406c8675fd5594 Author: F. Jason Park Date: Thu Feb 15 20:17:20 2024 -0800 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'. 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)) commit 537914561eb3809e34b9daf8c2b4719ae9b30a6b Author: Po Lu Date: Sat Feb 17 10:33:54 2024 +0800 * java/debug.sh: Print errors correctly if device is ambiguous. 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"` commit 5b65c2ad7526ec081ac37d32c87e9b58e787d66a Author: Po Lu Date: Sat Feb 17 10:27:26 2024 +0800 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. 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 commit 4b89fb08bdd7d0249698bc0ed578555d6755724d Author: Po Lu Date: Fri Feb 16 22:17:01 2024 +0800 * src/androidvfs.c (android_scan_directory_tree): Get rid of xstrdup. 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. */ commit 44a1721156ec29e5799da94f7918f217f52fd751 Author: Stefan Monnier Date: Fri Feb 16 09:04:46 2024 -0500 * lisp/loadup.el (lexical-binding): Add a comment 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)) commit 572d58b5e8d0f1f1244b9ccab8f02c4f50ca8d12 Author: Tomas Volf <~@wolfsden.cz> Date: Thu Feb 15 18:23:23 2024 -0800 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 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. commit 45f9af61b8ecbe500de915f63de53e9c598184b9 Author: Philipp Stephani Date: Mon Jan 8 19:38:33 2024 +0100 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. 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 commit cea72c1757cc45b42baf3a35fb4d963f3e722b9c Author: Stefan Monnier Date: Thu Feb 15 15:09:13 2024 -0500 (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. 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)))) commit 4dbc3bbcc568182380d4646310a652285e210876 Author: Andrea Corallo Date: Thu Feb 15 19:17:07 2024 +0100 ; * lisp/emacs-lisp/comp.el (comp--write-bytecode-file): Add comment. 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 commit 7b34bb5c928798e0d40fce062c1b6d4b2ce06979 Author: Dmitry Gutov Date: Thu Feb 15 19:36:05 2024 +0200 project-or-external-find-regexp: Fix the docstring * lisp/progmodes/project.el (project-or-external-find-regexp): Fix the docstring (bug#68958). 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)) commit 80dce18a393a3267b72901328bf24e518d0a6fc9 Author: Andrea Corallo Date: Thu Feb 15 19:10:35 2024 +0100 * lisp/emacs-lisp/cl-preloaded.el (cl--direct-subtypes-of-type): Remove. 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. commit 4a0d430bdc3650ca3dfd8bdd14781764fbcbdc7e Author: Andrea Corallo Date: Thu Feb 15 17:48:43 2024 +0100 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. 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) commit aa849984896ce393afe92dd4fb7fbce494e131a4 Author: Andrea Corallo Date: Thu Feb 15 16:13:16 2024 +0100 * 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. 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." commit 74f060230f70ba986a1c78e4e0d1181492567597 Author: Andrea Corallo Date: Thu Feb 15 16:10:59 2024 +0100 * Add initial "Type Hierarchy" node to the elisp manual * doc/lispref/objects.texi (Lisp Data Types, Type Hierarchy): Add Type Hierarchy node. 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}. commit 3211825fe7cab2c330d703a9e77090d551854d53 Author: Andrea Corallo Date: Thu Feb 15 16:09:07 2024 +0100 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. 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 commit 8a63e50036f0d4284f21660efb5dd20b63748d1b Author: Andrea Corallo Date: Thu Feb 15 16:08:00 2024 +0100 * 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. 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)))) commit e058380324e462c234bb3407d504807f22d825b0 Author: Po Lu Date: Thu Feb 15 22:11:14 2024 +0800 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. 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 commit 3d6137116f6be8ee38f9f49c9811b97ef92e0e58 Author: Eli Zaretskii Date: Thu Feb 15 12:04:07 2024 +0200 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 . 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 commit 60cff1ac9d216e5abcb350ea5e623ab0b377c131 Author: Simen Heggestøyl Date: Tue Jan 16 08:21:41 2024 +0100 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. 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 commit 783a511d1e31b5c9e5f9cb8ec27fd91d1b9078c9 Author: Po Lu Date: Thu Feb 15 14:23:43 2024 +0800 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. 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); commit 377e4212e9df293ba2021238bae2bdccf5c8b8d3 Author: Paul Eggert Date: Wed Feb 14 21:18:25 2024 -0800 Update from Gnulib by running admin/merge-gnulib * lib/strftime.c: New file, copied from Gnulib. 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 @@ % 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 @@ % 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 @@ % 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 @@ % 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 @@ \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" ;; commit 7c32f3bcd6d390510d9463b3100255cecab41e1c Author: Paul Eggert Date: Wed Feb 14 21:18:25 2024 -0800 Adjust to recent Gnulib nstrftime changes * admin/merge-gnulib (AVOIDED_MODULES): Add localename. * configure.ac (REQUIRE_GNUISH_STRFTIME_AM_PM): Define. 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. commit 7256690a3ca4840e0f682a552d45321a1b710398 Author: Stefan Kangas Date: Thu Feb 15 00:51:05 2024 +0100 * BUGS: Note how to report critical security issues. 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. commit 1035669b38b5aa2aa277e7423837c80534332c19 Author: Stefan Kangas Date: Thu Feb 15 00:39:00 2024 +0100 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. 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 commit fbef8ff2a4106ff7f0f3d026071fb8096280cc61 Author: Stefan Monnier Date: Wed Feb 14 17:18:50 2024 -0500 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. 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'." commit 61a145076275a9da79d0372d50def4aaf5117587 Author: Joseph Turner Date: Tue Jan 30 00:52:39 2024 -0800 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) 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)) commit 0c7c8210cb6a87a06b61451d19f3601975569946 Author: Michael Albinus Date: Wed Feb 14 17:27:43 2024 +0100 Minor Tramp doc adaption * doc/misc/tramp.texi (Frequently Asked Questions): Be more precise with FIDO2 keys. * lisp/net/tramp.el: Adapt comments. 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. commit 3a93e301ddc913758abe05c876aa3016e8b23af8 Author: Mattias Engdegård Date: Tue Feb 13 14:52:39 2024 +0100 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. 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; commit decfdd4f1a1e3b1539eafdaaf11191e8477f0636 Author: Gerd Möllmann Date: Wed Feb 14 08:54:04 2024 +0100 Take file-local variables into account in elint-file (bug#69076) * lisp/emacs-lisp/elint.el (elint-file): Use hack-local-variables. 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) commit fa74c7f88a8f3216665ea386c5b6355e3660fb79 Author: Juri Linkov Date: Wed Feb 14 09:20:48 2024 +0200 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). 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 commit b54db9c9ac7599fc84f108eb6f469e2af4834bed Author: Eli Zaretskii Date: Wed Feb 14 05:24:36 2024 +0200 ; * lisp/progmodes/elisp-mode.el (emacs-lisp-native-compile): Fix typo. 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. commit 70d6f6c41c9b1985e0ec70b45aeeac6982a050bb Author: Stefan Monnier Date: Tue Feb 13 20:35:05 2024 -0500 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. 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))) commit 7c23234b4ea43a033e06eb466008e0dc8485920b Author: Steven Allen Date: Sat Feb 10 10:05:11 2024 -0800 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) 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 commit 160165e8a97cfa3f3ffd803be373a3b34ed87597 Author: Jim Porter Date: Tue Feb 13 12:27:38 2024 -0800 ; 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. 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 () commit 371ccf09fea26892a2fada028d27fb4b596636df Author: Philip Kaludercic Date: Mon Feb 12 18:29:50 2024 +0100 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) 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) commit 10bf810e845061a83d466cd7367ab7d220653296 Author: Eli Zaretskii Date: Tue Feb 13 21:59:03 2024 +0200 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 . 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. commit a4a99405d00b98aeb86040117402ed0e1f954833 Author: Paul Eggert Date: Tue Feb 13 09:54:51 2024 -0800 Simplify position-symbol * src/data.c (Fposition_symbol): Simplify by calling Fbare_symbol rather than open-coding it. 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)) commit d202f1b9e74107c0e51c5d2fdbe094cbe1baaadb Author: Paul Eggert Date: Tue Feb 13 09:54:51 2024 -0800 XSYMBOL eassume speedups * 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%. 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); commit 10c6aea4434b1c9ccea30a1f87f301ab2c9bade6 Author: Paul Eggert Date: Tue Feb 13 09:54:51 2024 -0800 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. 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)) commit 473dac880105cf6055a185eb3b9764243f27697c Author: Paul Eggert Date: Tue Feb 13 09:54:51 2024 -0800 Remove lisp_h_XCONS etc 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. 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 commit 231af322b07447d87b4c250aa601219a4005d9a5 Author: Paul Eggert Date: Tue Feb 13 09:54:51 2024 -0800 Remove lisp_h_PSEUDOVECTORP etc * 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. 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 commit efdcd7b8f78ef22c0213ea770a552fb69b789381 Author: Paul Eggert Date: Tue Feb 13 09:54:51 2024 -0800 Remove BASE2_EQ * 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. 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 { commit 08c1863257469b4cb85e97a276ba635d44b22666 Author: Paul Eggert Date: Tue Feb 13 09:54:51 2024 -0800 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%. 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)) \ commit d2a5d7534c7dcdc4432bf5456cb8a76680f7aa14 Author: Paul Eggert Date: Tue Feb 13 09:54:50 2024 -0800 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%. 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)) \ commit d61145cc8cfb31ca170cd1b5deab59f0a5cbea63 Author: Juri Linkov Date: Tue Feb 13 19:02:21 2024 +0200 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'. 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))) commit 07bd7a0150eab1084a41f230cf59e620811e1778 Author: Michael Albinus Date: Tue Feb 13 17:12:34 2024 +0100 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. 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) commit 6ef8d29f221e010705184092600ac124bd0a14fd Author: Jörg Bornemann Date: Mon Feb 12 21:56:42 2024 +0100 ; 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 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))))) commit acc6732ca1d39352f1aae3074ad04564178c0954 Author: Philip Kaludercic Date: Tue Feb 13 11:18:16 2024 +0100 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. 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) commit d570864bebf9f038f696768f2da571ed272f0058 Author: Jim Porter Date: Thu Feb 1 13:58:20 2024 -0800 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). 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 commit 6a18da80c2a3ff4bdede91bd3c28ecd41703ff98 Author: Po Lu Date: Tue Feb 13 09:47:24 2024 +0800 ; * src/lread.c (Finternal__obarray_buckets): Fix coding style. 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); commit 40994d2bafafa53464d3678b06f391fd13c884ec Author: Stefan Monnier Date: Mon Feb 12 17:42:28 2024 -0500 (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. 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." commit 3b90e5052ce1eea47430c85c0c35741e25269ce2 Author: Juri Linkov Date: Mon Feb 12 20:16:35 2024 +0200 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'. 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))) commit 39cce137ba83713c960c201d8c3d8cf5079eee3b Author: Mattias Engdegård Date: Thu Feb 8 14:11:02 2024 +0100 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. 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. commit bb77944306d3fbbbdf61ba4f3c9ef1bcb9b4b989 Author: Mattias Engdegård Date: Thu Feb 8 19:04:23 2024 +0100 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. 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"))) commit 79cfc1eaa0b93f49559d74b6f7a76bf97e70ad2a Author: Mattias Engdegård Date: Wed Feb 7 21:50:03 2024 +0100 Internal function for obarray performance analysis (bug#68244) * src/lread.c (Finternal__obarray_buckets): New function. 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'. commit 6aeeae68885e09a7253a0076d0f81cc46b37f20d Author: Philip Kaludercic Date: Mon Feb 12 17:37:16 2024 +0100 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. 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) commit df243f785d4ce23bf49e84c8517d673a66fa0089 Merge: 17a395e04c6 614b244a7fa Author: Michael Albinus Date: Mon Feb 12 13:21:53 2024 +0100 Merge branch 'emacs-29' of git.sv.gnu.org:/srv/git/emacs into emacs-29 commit 17a395e04c62d6c6c3f3ff4c4889f03e427e00d3 Author: Daniel Martín Date: Mon Feb 12 13:21:08 2024 +0100 ;; Fix typo in the Tramp documentation 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 commit 2f7d662dd4636a84e157a2af8f843c0589bc5dda Author: Basil L. Contovounesios Date: Mon Feb 12 12:07:37 2024 +0100 ; 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". 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); commit bc6c55c5cf3fc5bd248232c6332ea7cca19ffe91 Author: Po Lu Date: Mon Feb 12 11:16:47 2024 +0800 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. 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 */ commit 57544fa2a2e1f2d04aa6b6bdf49bde71141b945d Author: Stefan Monnier Date: Sun Feb 11 22:19:49 2024 -0500 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. 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)) commit 806759dc0a6a3b049ce35d0497011464e5fc4dcb Author: Stefan Monnier Date: Sun Feb 11 22:00:44 2024 -0500 (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. 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. commit 9ebc91795f22ca52ea019b8ce7fb1f6e4c8df826 Author: Stefan Kangas Date: Mon Feb 12 02:38:30 2024 +0100 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 . 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))) commit 9a1522197fb16986c2f641f777d6bef41c348567 Author: Stefan Monnier Date: Sun Feb 11 18:13:27 2024 -0500 (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. 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 commit 052c2ce0284c5193c9d6768a45a9b3508af51230 Author: Stefan Monnier Date: Sun Feb 11 17:43:37 2024 -0500 (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. 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))))) commit 998f9d98c3b0611b472f4be963d24a96c0a9e197 Author: Philip Kaludercic Date: Tue Feb 6 20:12:15 2024 +0100 Tolerate errors while recompiling all packages * lisp/emacs-lisp/package.el (package-recompile-all): Demote errors raised by 'package-recompile'. (Bug#68678) 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 () commit db195116a4279521e9cf03c52b7026032461e3e1 Author: Philip Kaludercic Date: Wed Sep 13 12:26:22 2023 +0200 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) 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) commit c0f656617d6848b94413b79b390788565d338fcd Author: Dmitry Gutov Date: Sun Feb 11 22:32:44 2024 +0200 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. 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); commit faa46eb8667c11a0725500a50e957eb78021c99f Author: Andrea Corallo Date: Sun Feb 11 12:31:13 2024 +0100 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. 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))) commit 67486ab4158655dd8bfe0ddf7dabadc6dd21a3c1 Author: Eli Zaretskii Date: Sun Feb 11 15:21:14 2024 +0200 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) 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 commit 614b244a7fa03fcb27d76757e14ef0fa895d6f23 Author: Andrea Corallo Date: Sun Feb 11 10:43:57 2024 +0100 * 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. 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))))))) commit 30b4d902326546ca2b383d56caadbe0adaf0fe89 Author: Mekeor Melire Date: Fri Feb 9 23:30:52 2024 +0100 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. 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 commit 9f9da26e0dcb242327af7cd8414fad7afedbbaa9 Author: Loïc Lemaître Date: Sun Feb 11 05:00:38 2024 +0200 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 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" commit e67e7185ce81e59c90741f92c2ba3209412f417e Author: Po Lu Date: Sun Feb 11 10:00:33 2024 +0800 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. 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; } commit 7a0ee5d65f214102734dd22edb641b164a1b73af Author: Eric Abrahamsen Date: Sat Feb 10 10:33:51 2024 -0800 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. 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. commit 3e5aba883770312536ca7a8f289bf679e55802f5 Author: Juri Linkov Date: Sat Feb 10 19:56:39 2024 +0200 * 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). 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." commit 0a01b998d13027e5672592f9e60919aa683bad9e Author: Juri Linkov Date: Sat Feb 10 19:34:23 2024 +0200 * 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. 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" commit 939187fd7a07249a1a76d98e8d91051fa76b8727 Author: Eshel Yaron Date: Sat Feb 10 17:30:27 2024 +0100 ; 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. 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") commit 55b4a743b6f3d452d98f135763b00965caba5240 Author: Steven Allen Date: Sat Jan 27 08:17:08 2024 -0800 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) 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) commit 7e8b1863af8c820c2969c1a4666ae4451cbcea92 Author: Damien Cassou Date: Wed Feb 7 20:41:44 2024 +0100 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) 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))) commit 717d8c4285fa6eecc0bbec9b5910f028f02aab59 Author: Eli Zaretskii Date: Sat Feb 10 13:00:51 2024 +0200 Don't quote 't' in doc strings * lisp/outline.el (outline-minor-mode-use-buttons): Doc fix. Patch by Arash Esbati . (Bug#69012) 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. commit cbf2c297b8b32e366f45c86ebf653cee129343d4 Merge: 22d500ce21d f1e7b5230ad Author: Eli Zaretskii Date: Sat Feb 10 05:09:30 2024 -0500 ; Merge from origin/emacs-29 The following commit was skipped: f1e7b5230ad Tramp: Handle PIN requests from security keys (don't merge) commit 22d500ce21de56d1f17231ce8030dc5de12f021f Merge: 7f3baf352ba 7d3a1444864 Author: Eli Zaretskii Date: Sat Feb 10 05:07:56 2024 -0500 Merge from origin/emacs-29 7d3a1444864 ; Mention defface's and their :version tags in CONTRIBUTE. 09c53b717d4 * admin/notes/kind-communication: New file. 31ca4e5501f ; And another fix of CONTRIBUTE. d65499e7908 ; Another clarification in CONTRIBUTE. 571ec583d64 ; Clarify "ChangeLog entries" in CONTRIBUTE. e2682316867 Don't skip links to "." and ".." in Dired when marking files e25d11314d8 Pass unquoted filename to user-supplied MUSTMATCH predicate 47496993703 * doc/lispref/parsing.texi (Retrieving Nodes): Improve do... d0673ea0d42 ; * etc/PROBLEMS: Workaround for Windows key "stuck" (bug... * lisp/emacs-lisp/trace.el: * java/org/gnu/emacs/EmacsWindow.java (onDragEvent): Remove training whitespace. commit 7f3baf352bad03de50135556a561af0c7fb1bd6a Author: Eli Zaretskii Date: Sat Feb 10 11:22:01 2024 +0200 ; * etc/NEWS: Announce support of 'lzip' compressed Info files (bug#69004). 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. commit 13ee21eb48bedc1779985c3f60010aadbbd99630 Author: Eli Zaretskii Date: Sat Feb 10 11:20:22 2024 +0200 Support Info files compressed by 'lzip' * lisp/info.el (Info-suffix-list): Support lzip compression of Info files. (Bug#69004) 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 commit 86c5b7c49c0b61413e41f8a95a2f0c7f09cd1db7 Author: Eli Zaretskii Date: Sat Feb 10 11:10:08 2024 +0200 * lisp/bind-key.el (personal-keybindings): Autoload it (bug#68999). 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'. commit 20f7a022f817eaed5f6889d9a892c22fc46f0d2f Author: Eli Zaretskii Date: Sat Feb 10 11:04:22 2024 +0200 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) 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))) commit 55aea7967604112343ff67597cbe9fc20acd9196 Author: Michael Albinus Date: Sat Feb 10 09:50:12 2024 +0100 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. 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)) commit 59b849d1eaffb8babb208f6a39c5e0dbc73e3127 Author: Eli Zaretskii Date: Sat Feb 10 10:35:18 2024 +0200 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) 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 commit 4330eb2864181e49ace5736665c45d8683a5ce1d Author: john muhl Date: Thu Jan 25 21:23:45 2024 -0600 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) 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))))) commit 6195a57b8e8ebff4eaaf4ff8d62719cbd55f579f Author: Eli Zaretskii Date: Sat Feb 10 09:28:11 2024 +0200 ; 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) 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. commit e7d1b12878ed83ad8c6995d8443f3367750ff0c9 Author: Po Lu Date: Sat Feb 10 15:02:39 2024 +0800 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. 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 @@ invocation of app_process (through android-emacs) can 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 @@ invocation of app_process (through android-emacs) can /* 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 @@ invocation of app_process (through android-emacs) can String name, mode; ParcelFileDescriptor fd; int i; - ContentResolver resolver; - - resolver = getUsefulContentResolver (); /* Figure out the file access mode. */ @@ -1045,12 +985,8 @@ invocation of app_process (through android-emacs) can 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 @@ invocation of app_process (through android-emacs) can 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 @@ invocation of app_process (through android-emacs) can 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); } commit 6568a9a0099e7745bfd142a0fd16b4d7215c0250 Author: Mekeor Melire Date: Wed Feb 7 23:00:08 2024 +0100 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. 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." commit de5acc3b0d854aeb7dbf104c0977efe2f2266e1a Author: Jim Porter Date: Thu Feb 8 11:44:05 2024 -0800 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. 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, commit b5b80de49c5a37778945d7a0234090b09acc104f Author: Jim Porter Date: Thu Feb 8 11:31:17 2024 -0800 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'. 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. commit 7a13e705b1aead8f527dfa5407d9f87301b1f252 Author: Jim Porter Date: Wed Feb 7 17:58:31 2024 -0800 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. 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 commit efedb8f479f1f2cf4d7ce703c6411dd756d2843d Author: Stefan Monnier Date: Fri Feb 9 14:22:14 2024 -0500 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 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.") commit 3c3702b9bbc79f63026606dc0f391da3d795226d Author: Stefan Monnier Date: Fri Feb 9 14:13:29 2024 -0500 * lisp/subr.el (with-output-to-temp-buffer): Add `indent` rule 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) commit c4ec6d0472beac2a0cb4f5c8baec79e39dfc410b Author: Stefan Monnier Date: Fri Feb 9 14:08:51 2024 -0500 * lisp/subr.el (read-char-from-minibuffer): Fix bug#68995 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)) commit 8d6a8e573f9a1e4eb9ebbc0ec244907263e61bb8 Author: Michael Albinus Date: Fri Feb 9 11:21:05 2024 +0100 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. 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))) commit f1e7b5230ad93aab20af1fd7b09931a746a89d5d Author: Michael Albinus Date: Fri Feb 9 11:05:14 2024 +0100 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. 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))) commit 8d09e1def55e57a8c627ba704289f796c48a085d Author: Paul Eggert Date: Thu Feb 8 23:17:04 2024 -0800 Port to GNU Make 03ecd94488b85adc38746ec3e7c2a297a522598e 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 ‘$ ’. 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 commit 7d3a144486461869b943f04a45e84c0c3d926732 Author: Eli Zaretskii Date: Fri Feb 9 08:49:55 2024 +0200 ; Mention defface's and their :version tags in CONTRIBUTE. 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 commit 4e5068b7b3a06aaba6b93dff759a93b385ab8fd0 Author: Dominique Quatravaux Date: Thu Feb 8 10:19:10 2024 +0100 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 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). */ commit b3821357696d44e3f553af14c209a21e69187c32 Author: Po Lu Date: Fri Feb 9 13:15:57 2024 +0800 Set adstyle within sfnt font objects * src/sfntfont.c (sfntfont_open): Don't incorrectly clear desc->adstyle. 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)); } } commit 5af4e346b0b078d6e8f3dd90bb66899d3ed99810 Author: Po Lu Date: Fri Feb 9 10:43:48 2024 +0800 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. 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); } commit 8290a1bacb019f5026caa08334a7087802ebc6f9 Author: Po Lu Date: Fri Feb 9 09:53:33 2024 +0800 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. 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"); } commit 09c53b717d4941e2ddd113f3f6817bf65ae196f4 Author: Stefan Kangas Date: Thu Feb 8 22:19:40 2024 +0100 * admin/notes/kind-communication: New file. 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. commit 31ca4e5501ffa7c80f114c1145ae0ea55fb76d11 Author: Eli Zaretskii Date: Thu Feb 8 22:28:08 2024 +0200 ; And another fix of CONTRIBUTE. 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 commit d65499e79083fb764517447d4d40ea3222ea2fa2 Author: Eli Zaretskii Date: Thu Feb 8 21:26:36 2024 +0200 ; Another clarification in CONTRIBUTE. 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 commit 571ec583d644b718ce52f938f111d4aa98192471 Author: Eli Zaretskii Date: Thu Feb 8 21:07:10 2024 +0200 ; Clarify "ChangeLog entries" in CONTRIBUTE. 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". commit 0b9c7148fd681c8ad63fd0eb3895db44403e9f8c Author: Liu Hui Date: Thu Jan 18 12:00:00 2024 +0800 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) 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 commit ebf4ef2022a5f0a69cdd881eb41104e7b59d698e Author: USAMI Kenta Date: Sun Feb 4 03:20:24 2024 +0900 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) 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 commit e2682316867ecb22ee1db5e3028a8150d95d1a80 Author: Eli Zaretskii Date: Thu Feb 8 13:51:55 2024 +0200 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) 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)))))))) commit bc099295dd24d059d3358acf5653ced9c9292e41 Author: Eshel Yaron Date: Wed Jan 31 21:37:18 2024 +0100 ; 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) 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 commit 08c81db7c8e522278fb2c8de8fbe556d109c135f Author: Michael Albinus Date: Thu Feb 8 11:17:22 2024 +0100 `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) 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 commit d6c7092ff0713087f38b9492d53be0177af67514 Author: Eli Zaretskii Date: Thu Feb 8 08:56:42 2024 +0200 ; 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. 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. commit a48cf0c94ca4a4e3fe045be6149025955e9dfa4f Author: Eli Zaretskii Date: Thu Feb 8 08:48:20 2024 +0200 ; * src/keyboard.c (echo_dash): Mention F1 in echo_keystrokes_help. 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))); commit 1db2255c7c7fc232e371d379cb60827a9931e24d Author: Po Lu Date: Thu Feb 8 13:20:28 2024 +0800 * lisp/touch-screen.el (touch-screen): Fix defgroup version. 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. commit ed2450e79b597e0306f14b542e934a90dfd9786f Author: Po Lu Date: Thu Feb 8 10:32:28 2024 +0800 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. 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; } commit 1f9781ee7816ad3ec786ca7e10b4e82d1ad989c5 Author: Po Lu Date: Thu Feb 8 10:01:57 2024 +0800 Fix earlier change to keyboard.c * src/keyboard.c (echo_dash): Do not pass automatic string to Lisp! (syms_of_keyboard) : Improve doc string. 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, commit e34ebc0ccc6c27e7e1217baad9ca74dd7bea4c37 Author: Paul Eggert Date: Wed Feb 7 13:17:57 2024 -0800 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 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. commit f444786e58737a4ae6071957dfc60075bbd96edc Author: Dmitry Gutov Date: Wed Feb 7 21:50:37 2024 +0200 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. 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. commit 2ecaa60f0521446c9d2c054a3493faaf46275223 Author: Eli Zaretskii Date: Wed Feb 7 19:14:20 2024 +0200 Improve wording of message in buff-menu.el * lisp/buff-menu.el (Buffer-menu--selection-message): Improve wording of selection messages. 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. commit f9ffa0148c3fb9e07671fae8f8ca72dd2d403163 Author: Stefan Monnier Date: Wed Feb 7 11:20:46 2024 -0500 (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. 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) commit 12fb298e21d877c772a19fc8f2fec68a40bcda14 Author: Stefan Monnier Date: Wed Feb 7 11:17:35 2024 -0500 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 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. commit 2f3c435056dac17242b2d147bc73df8742c3e374 Author: Stefan Monnier Date: Wed Feb 7 11:15:59 2024 -0500 * test/lisp/minibuffer-tests.el (completion-test--pcm-bug38458): New test 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 commit cc5d4f15f96f97b6c4eb8b58144d0a0f217d393a Author: Stefan Monnier Date: Wed Feb 7 11:13:56 2024 -0500 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. 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.") commit b068725d40dd1ab918178b3cbca7b5672037210f Author: Stefan Monnier Date: Wed Feb 7 11:11:38 2024 -0500 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. 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 commit ef3fed1a4898c3e3d6012ba01006d827a4aba0ef Author: Mattias Engdegård Date: Wed Feb 7 14:35:44 2024 +0100 ; 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. 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. commit d03f3a827d80e2a0962128216223bab21998cf0a Author: Eli Zaretskii Date: Wed Feb 7 15:33:51 2024 +0200 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. 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 commit e5cb268b2cf612492dfaf39d28f43357710003a6 Author: Po Lu Date: Wed Feb 7 21:09:18 2024 +0800 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. 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 @@ invocation of app_process (through android-emacs) can { 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" commit ccae58a425674c36cb6f17bcebc4416d34f23a37 Author: Michael Albinus Date: Wed Feb 7 13:19:27 2024 +0100 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. 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. commit 9ccaa09a63548770ca8902758985aeb2c609f5ad Author: Po Lu Date: Wed Feb 7 10:48:27 2024 +0800 ; .dir-locals.el (log-edit-mode) : Set to 64. 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))) commit 8a39216ce920d82b86a40471429e30d75c6ee42d Author: Wilhelm Kirschbaum Date: Wed Feb 7 04:18:30 2024 +0200 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). 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 commit eb90fb52b08a16ae2bdc8bad6929492b9e693f72 Author: Dmitry Gutov Date: Wed Feb 7 03:54:29 2024 +0200 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). 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))) commit c1cdbb987299f6878072fec539bd363e2c3ca015 Author: Wilhelm Kirschbaum Date: Fri Dec 29 17:09:00 2023 +0200 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). 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 commit a45e1237b290a9c04b416703825b105321139608 Author: Po Lu Date: Wed Feb 7 09:24:32 2024 +0800 ; Fix typo in configure.ac * configure.ac: Fix typo. Reported by Juri Linkov . 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" commit e25d11314d84cc3e606515d6551e878cec4cfee4 Author: Joseph Turner Date: Tue Jan 30 22:08:50 2024 -0800 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. 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. commit 77f240012f1e9a7cfee60adedebc8e6a230ce49b Author: Stefan Monnier Date: Tue Feb 6 15:36:18 2024 -0500 (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. 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)) commit ab318cce1e97f4b9c78adc3290784105b78f0728 Author: Eli Zaretskii Date: Tue Feb 6 21:55:57 2024 +0200 ; 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) 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 commit a2201a2034a86b4cc90132ab2d920456866c11e3 Author: Stefan Monnier Date: Tue Feb 6 13:21:22 2024 -0500 (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. 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) commit ce7365b591852dd5556e0a4bf6a0ba63a8733802 Author: Juri Linkov Date: Tue Feb 6 19:55:41 2024 +0200 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). 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 commit 05e3183ede3a08993a7d209fb14153abaed0c74e Author: Mattias Engdegård Date: Tue Feb 6 15:23:53 2024 +0100 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. 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 commit e66870400d45e3d08265df9f6acd4631a5712139 Author: Mattias Engdegård Date: Mon Jan 15 09:25:02 2024 +0100 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. 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; } commit f6225d125c07bbde8c828b40eb6e81333e051c2a Author: Mattias Engdegård Date: Tue Feb 6 12:39:11 2024 +0100 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. 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) commit 42db7292c3e05920bc9f2fa5c3478eb2ba835c5c Author: Po Lu Date: Tue Feb 6 17:52:33 2024 +0800 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. 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; commit 0d2b7120783255fbb0f8e98717573c35425f4df6 Author: Po Lu Date: Tue Feb 6 13:10:57 2024 +0800 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. 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.pm.PackageManager; import android.content.res.AssetManager; +import android.content.res.Configuration; import android.hardware.input.InputManager; @@ -581,6 +582,15 @@ invocation of app_process (through android-emacs) can 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); commit cebd26b2e16d75a939e2a9f91becc6ec702122a7 Author: Yuan Fu Date: Mon Feb 5 23:12:36 2024 -0800 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. 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)) commit 10faaa3c91045390755791c21349cd562546fdea Author: Stefan Monnier Date: Mon Feb 5 17:58:47 2024 -0500 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. 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; } commit aedfb4f04837ef7b6f50d6a9d833a3ec0f33b11d Author: Stefan Monnier Date: Mon Feb 5 14:50:45 2024 -0500 (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. 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) commit 5e69376292994ffe69b7f8f52ae1ad85c60c2d29 Author: Mattias Engdegård Date: Mon Feb 5 17:56:11 2024 +0100 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. 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))) commit 95c8bfb11ec82e67652e5903495c1fcb5c61ace2 Author: Stefan Monnier Date: Mon Feb 5 10:13:56 2024 -0500 (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. 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 commit 798310f0100e7819bc79fb7f9bdcf59b8f534b4b Author: Michael Albinus Date: Mon Feb 5 12:56:36 2024 +0100 ; * etc/NEWS: Fix typos. 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'. commit dbc5fafa311823f3a78d4ad5a395e4d87d31d9bd Author: Michael Albinus Date: Mon Feb 5 12:55:27 2024 +0100 * lisp/net/tramp.el (tramp-local-host-regexp): Adapt :version. 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"))) commit edf61edfd6f04ab97785dca92fc68e8e5783586e Author: Michael Albinus Date: Mon Feb 5 12:54:56 2024 +0100 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. 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) commit c7539a363b8b109d24457aaeb60fb51bd0a03e4f Author: Michael Albinus Date: Mon Feb 5 12:54:03 2024 +0100 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) 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. commit c1f8fe09e6641cc6c1195edcb8666ace1e6e8829 Author: Po Lu Date: Mon Feb 5 18:34:22 2024 +0800 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. 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 @@ private static class Coordinate } } - EmacsActivity.invalidateFocus (); + EmacsActivity.invalidateFocus (4); if (!children.isEmpty ()) throw new IllegalStateException ("Trying to destroy window with " @@ -760,7 +760,7 @@ private static class Coordinate public void onFocusChanged (boolean gainFocus) { - EmacsActivity.invalidateFocus (); + EmacsActivity.invalidateFocus (gainFocus ? 6 : 5); } /* Notice that the activity has been detached or destroyed. commit 98d62c5f7675b24ad66e010765ce3012046f2ff8 Author: Po Lu Date: Mon Feb 5 17:17:51 2024 +0800 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. 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); commit ea53a26d03da8d03652696939431b3a7e63053d7 Author: Stefan Kangas Date: Mon Feb 5 08:30:31 2024 +0100 ; Fix last change * lisp/filesets.el (filesets-quote): Resurrect as obsolete alias for 'shell-quote-argument'. 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 commit 7756e9c73611c25002a90194b4a32c23051cb234 Author: Xi Lu Date: Thu Feb 23 20:58:00 2023 +0800 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) 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)))) commit 5c43ef86bf169a79b87bd082d2f884757f7c2efc Author: Jim Porter Date: Tue Aug 15 18:51:20 2023 -0700 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. 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))) commit be6de56906f0d1c09a0fad4f5165d864dddbc3ee Author: Yuan Fu Date: Sun Feb 4 19:26:42 2024 -0800 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. 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 commit 9dbbf93a4a08f71cf5f2278ec2a22a722fe0e0f7 Author: Yuan Fu Date: Sat Feb 3 21:24:29 2024 -0800 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. 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) commit b2d350cfc0bf8f0e3198bffcebe60a43341fb340 Author: Stefan Monnier Date: Sun Feb 4 14:39:02 2024 -0500 * lisp/emacs-lisp/comp.el (comp--native-compile): Use `error-message-string` 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 commit 7d3c3cad9392d3f8e59f85522053c249aff062e5 Author: Stefan Monnier Date: Sun Feb 4 13:51:13 2024 -0500 * 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. 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 commit 52abeaf1333427f156a23f0acf057e81bcc5e9e2 Author: Stefan Monnier Date: Sun Feb 4 12:58:56 2024 -0500 * src/lread.c (build_load_history): Be careful with in-place updates Don't leave a "broken" value in `Vcurrent_load_list`. 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 commit a1aa9028f83e5d3da71bdb5877d8baa5d6c1e98a Author: Stefan Monnier Date: Sun Feb 4 12:52:01 2024 -0500 * src/window.c (set_window_buffer): Flush the `base_line_number` cache 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); commit 57024e1e9314501b103a4d36b9b166761a2ad756 Author: Stefan Monnier Date: Sun Feb 4 12:50:55 2024 -0500 (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! 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); } commit 4749699370370a6bf0d50612dafe871dbaf52924 Author: Juri Linkov Date: Sun Feb 4 19:22:21 2024 +0200 * doc/lispref/parsing.texi (Retrieving Nodes): Improve documentation. Update optional arguments 'predicate' and 'include-node' of 'treesit-node-top-level'. 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 commit d0673ea0d42048c140f4e5c6db18f78a43303256 Author: Eli Zaretskii Date: Sun Feb 4 16:11:20 2024 +0200 ; * etc/PROBLEMS: Workaround for Windows key "stuck" (bug#68914). 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. commit a4587646fabf2b7f0cb19a7e0bee090f9106a73a Author: Stefan Kangas Date: Sun Feb 4 13:20:15 2024 +0100 ; Fix my last commit 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) commit 70c10204f0025eac844a88b0ef85cfca44cff61c Author: Stefan Kangas Date: Sun Feb 4 13:16:59 2024 +0100 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. 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) commit 4d57187a248d3243dcc8b5da5d8365cb1b54a347 Author: Mattias Engdegård Date: Sat Feb 3 16:46:59 2024 +0100 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. 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 commit e44b9f35793d642d5155fde035e3bc92102d13a1 Author: Stefan Kangas Date: Sun Feb 4 11:26:43 2024 +0100 * lisp/speedbar.el (imenu): Require unconditionally. 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) commit 9bbf8232dba746db90b90285e9e4ed6d299d251a Author: Stefan Kangas Date: Sun Feb 4 10:28:40 2024 +0100 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. 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)) commit 56d0fbd99a87858717e08488df57db7fc08a2891 Author: Stefan Kangas Date: Sun Feb 4 10:28:18 2024 +0100 Add alias progress-reporter-make * lisp/subr.el (progress-reporter-make): New alias for 'make-progress-reporter'. 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. commit fc8b09484a2fbe182a0351c47afc3bf71f3b2a1b Author: Stefan Kangas Date: Sun Feb 4 09:48:04 2024 +0100 ; Fix typos 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) commit dd81e767b7782c275af4221fe258fa3d2948724a Author: Eli Zaretskii Date: Sun Feb 4 11:45:15 2024 +0200 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) 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 commit 45125e019c3698ff74ccb2183b789c25f9d3f574 Author: Stefan Monnier Date: Sat Feb 3 23:05:03 2024 -0500 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. 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) commit 4ebded3f5ee8617ac6b1debaa01706cd78206f39 Author: Stefan Monnier Date: Sat Feb 3 18:22:41 2024 -0500 * lisp/emacs-lisp/easy-mmode.el (easy-mmode--mode-docstring): Add comment 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) commit ecf3488477c6a4382737b97698443fdf26db8bd1 Author: Stefan Monnier Date: Sat Feb 3 18:22:05 2024 -0500 * doc/emacs/buffers.texi (List Buffers): Update example 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/ commit b0049c942b8fa4093a02a9bb4ffc9c5da2261765 Author: Richard M. Stallman Date: Sat Feb 3 17:47:02 2024 -0500 bytecomp.el: Warn for `,' not within backquote construct (bytecomp--report-comma): New function with `compiler-macro' property. 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) commit d41cdceb133e30c71a95fe893d70645472b326e3 Author: Stefan Monnier Date: Sat Feb 3 16:07:24 2024 -0500 textconv.c: Fix warnings with-wide-int * src/textconv.c (set_composing_region, textconv_set_point_and_mark): Use `min/max`. 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; commit 8fc7e8c2b0cb33b0e8e9822f116e6dbb530ab1b6 Author: Eli Zaretskii Date: Sat Feb 3 18:09:35 2024 +0200 ; * lisp/files.el (hack-local-variables--find-variables): Fix comment. 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)))))) commit ecb69c8bd8c3dba205187c6296c8cac9b6a65121 Author: Eli Zaretskii Date: Sat Feb 3 18:05:55 2024 +0200 ; Fix a comment in loaddefs-gen.el 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))) commit f266622cdb34044f364976796a4e7ac003d7a1b3 Author: Joseph Turner Date: Sat Feb 3 08:32:37 2024 -0600 ; Optimize shorthand insertion in loaddefs-generate--parse-file * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--parse-file): Optimize. 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 commit 9a51fbb69fc9dc4aa415308889ae667ee65660d7 Author: João Távora Date: Sat Feb 3 08:27:27 2024 -0600 ; Also consider shorthands in check-declare-scan (bug#67523) * lisp/emacs-lisp/check-declare.el (check-declare-scan): Also consider shorthands here. 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. commit 817140a852e79c5ef3cf7dc5e4c50aa710e8c4a2 Author: João Távora Date: Thu Nov 30 07:32:50 2023 -0600 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): 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) commit c52d17d91ade6c789d8672dbd1301ba86ba4d7d1 Author: João Távora Date: Wed Nov 29 20:09:57 2023 -0600 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. 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). commit 0f715f9c154a47de57a2f24f19b4a402604e6dc0 Author: João Távora Date: Wed Nov 29 16:48:34 2023 -0600 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): 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) commit 17c3610c56155dd5b1efd5b7e8d6a58112f43a59 Author: João Távora Date: Wed Nov 29 06:21:29 2023 -0600 Consider read-symbol-shorthands in check-declare.el (bug#67523) * lisp/emacs-lisp/check-declare.el (check-declare-verify): Consider read-symbol-shorthands. 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 commit c2aaa8f15aa8fb3415a6c9f421f539ee34b7f52c Author: João Távora Date: Thu Nov 30 06:00:38 2023 -0600 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. 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 commit 5e4a0a29fa3562ce9b2b8e497c6e71e6bc169082 Author: João Távora Date: Thu Nov 30 06:00:44 2023 -0600 Make sure read-symbol-shorthands is permanently local bug#63480, bug#67390 * lisp/files.el (permanently-enabled-local-variables): Add read-symbol-shorthands. 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.") commit 25bf8d3cdc6ce31e97b124a27be8c550d5525a55 Merge: 8080c7895b8 b91f0ee2fcc Author: Eli Zaretskii Date: Sat Feb 3 06:49:53 2024 -0500 Merge from origin/emacs-29 b91f0ee2fcc ; Fix last change 2f69353e4a7 Fix incompatibility with tree-sitter-javascript >= 0.20.2 d49124fc14b Avoid signaling errors from 'pixel-fill-region' a3987127618 eglot: Add nushell language server 5f56bc1cdfc eglot: Add php-ts-mode to eglot-server-programs c14c978e3b1 Support kotlin-ts-mode in Eglot commit 8080c7895b8613664754243bc88fa56cd5636360 Merge: 94fc8d53376 caecbf3e8db Author: Eli Zaretskii Date: Sat Feb 3 06:48:04 2024 -0500 ; Merge from origin/emacs-29 The following commits were skipped: caecbf3e8db Fix stale cache in Tramp (do not merge with master) 5f3b46c61e2 * configure.ac: Include X11/Xlib.h for XOpenDisplay. (Bu... commit 94fc8d533769d68795cdbc560b182c54020e0db5 Merge: a7ad6c503a3 5ce02c91bc1 Author: Eli Zaretskii Date: Sat Feb 3 06:47:06 2024 -0500 Merge from origin/emacs-29 5ce02c91bc1 Improve `desktop-save-mode` docstring 2f98b13ed05 ; Fix doc strings of splash-screen data structures 77f5d4d523a Fix completing-read functional REQUIRE-MATCH behavior commit a7ad6c503a3da2b71143cfafd0357bbfaefc1b12 Merge: 492e16f2ff3 c22d0ae2dd8 Author: Eli Zaretskii Date: Sat Feb 3 06:40:08 2024 -0500 ; Merge from origin/emacs-29 The following commits were skipped: c22d0ae2dd8 Fix "emacs -nw" on MS-Windows 396b49871aa ; Fix last change in package.texi commit 492e16f2ff33e7ff65ff965e9cd2ba658c9f9a45 Author: Eli Zaretskii Date: Sat Feb 3 13:00:15 2024 +0200 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) 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) commit 37efb63a3df969fb2eeed70dfe7fcf6c187e05be Author: Eli Zaretskii Date: Sat Feb 3 11:52:30 2024 +0200 ; * lisp/eshell/em-unix.el (eshell/cp, eshell/ln): Delete extra space. Bug#68862. 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 commit b91f0ee2fcc52b6ef2d747c5fc7f37573adc7ca5 Author: Eli Zaretskii Date: Sat Feb 3 11:20:11 2024 +0200 ; Fix last change * lisp/progmodes/js.el (js--treesit-font-lock-compatibility-definition-feature): Fix comments. 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 commit 2f69353e4a756cf53459c14c5618bd262331b568 Author: Vincenzo Pupillo Date: Thu Feb 1 16:57:39 2024 +0100 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) 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 commit d49124fc14b0bb37617b34b5839f873cea3817c8 Author: Eli Zaretskii Date: Sat Feb 3 11:09:36 2024 +0200 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) 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))) commit a3987127618b9fe49b88807f0268ec9abcc7396f Author: nibon7 Date: Thu Jan 18 00:01:48 2024 +0800 eglot: Add nushell language server * lisp/progmodes/eglot.el (eglot-server-programs): Add nushell language server. (Bug#68823) 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")) commit 5f56bc1cdfcd474dd9cfad07240df6c252abd35c Author: Piotr Kwiecinski Date: Thu Feb 1 14:02:20 2024 +0100 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 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")))) commit c14c978e3b1be9802a5c1fdf1b29e0ee48e16364 Author: dalu Date: Thu Feb 1 11:45:13 2024 +0800 Support kotlin-ts-mode in Eglot * lisp/progmodes/eglot.el (eglot-server-programs): Support kotlin-ts-mode. (Bug#68865) Copyright-paperwork-exempt: yes 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" commit caecbf3e8db57d93715b8d20587b2ed54064cadb Author: Michael Albinus Date: Thu Feb 1 17:17:36 2024 +0100 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) 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 commit 5f3b46c61e23786295e8e532f7eadeee8cd4340b Author: Ulrich Müller Date: Wed Jan 31 08:49:36 2024 +0100 * configure.ac: Include X11/Xlib.h for XOpenDisplay. (Bug#68842) Do not merge to master. 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]) commit 5ce02c91bc128f390bcf0beb82e37a3fa7f251ba Author: Stefan Kangas Date: Thu Feb 1 09:08:19 2024 +0100 Improve `desktop-save-mode` docstring * lisp/desktop.el (desktop-save-mode): Improve docstring. 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'. commit 2f98b13ed0522ef37c7bb2ca37f24b1be2f9fde5 Author: Eli Zaretskii Date: Mon Jan 29 14:56:40 2024 +0200 ; Fix doc strings of splash-screen data structures * lisp/startup.el (fancy-startup-text, fancy-about-text): Doc fixes. (Bug#68788) 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 () commit 77f5d4d523a406650036b7cd0d872d39a114a9ac Author: Joseph Turner Date: Sun Nov 12 13:21:50 2023 -0800 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. 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 commit c22d0ae2dd899ebc1f74e4e67f098216899ea202 Author: Eli Zaretskii Date: Sun Jan 28 10:19:48 2024 +0200 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) 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); commit 396b49871aa5432e2ff00230868013a22b180656 Author: Eli Zaretskii Date: Sun Jan 28 07:43:25 2024 +0200 ; Fix last change in package.texi * doc/lispref/package.texi (Multi-file Packages): Fix wording and markup. (Bug#65027) (cherry picked from commit 6d76e3991241905b0841effc6f8cd42394d9aa64) 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