From 1a677d1429d1f9fea2d6b2bc9dd5644a5564cc27 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Tue, 2 Jan 2024 15:32:03 +0200 Subject: treesit--pre-syntax-ppss: Fix args-out-of-range in internal--syntax-propertize * lisp/treesit.el (treesit--pre-syntax-ppss): Make sure the lower bound is still within the current restriction (bug#67977). --- lisp/treesit.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index b656040958d..c63bf510a24 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1150,7 +1150,7 @@ START and END mark the current to-be-propertized region." (if (and new-start (< new-start start)) (progn (setq treesit--syntax-propertize-start nil) - (cons new-start end)) + (cons (max new-start (point-min)) end)) nil))) ;;; Indent -- cgit v1.2.3 From bdfa49502a84f46999c4f207249562f33a119d36 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 4 Jan 2024 03:44:23 +0200 Subject: New feature: etags-regen-mode * lisp/progmodes/etags-regen.el: New file (bug#67687). * etc/NEWS: Mention the addition. * .dir-locals.el: Add this project's settings for etags-regen-regexp-alist and etags-regen-ignores. --- .dir-locals.el | 6 + etc/NEWS | 5 + lisp/progmodes/etags-regen.el | 431 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 442 insertions(+) create mode 100644 lisp/progmodes/etags-regen.el (limited to 'lisp') diff --git a/.dir-locals.el b/.dir-locals.el index e087aa89cd1..ce7febca851 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -8,6 +8,12 @@ (vc-git-annotate-switches . "-w") (bug-reference-url-format . "https://debbugs.gnu.org/%s") (diff-add-log-use-relative-names . t) + (etags-regen-regexp-alist + . + ((("c" "objc") . + ("/[ \t]*DEFVAR_[A-Z_ \t(]+\"\\([^\"]+\\)\"/\\1/" + "/[ \t]*DEFVAR_[A-Z_ \t(]+\"[^\"]+\",[ \t]\\([A-Za-z0-9_]+\\)/\\1/")))) + (etags-regen-ignores . ("test/manual/etags/")) (vc-prepare-patches-separately . nil))) (c-mode . ((c-file-style . "GNU") (c-noise-macro-names . ("INLINE" "NO_INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" diff --git a/etc/NEWS b/etc/NEWS index a6b0beb6ee5..1cdb12c3958 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1265,6 +1265,11 @@ the needs of users with red-green or blue-yellow color deficiency. The Info manual "(modus-themes) Top" describes the details and showcases all their customization options. +** New global minor mode 'etags-regen-mode'. +This minor mode generates the tags table automatically based on the +current project configuration, and later updates it as you edit the +files and save the changes. + * Incompatible Lisp Changes in Emacs 30.1 diff --git a/lisp/progmodes/etags-regen.el b/lisp/progmodes/etags-regen.el new file mode 100644 index 00000000000..6cd78d3577a --- /dev/null +++ b/lisp/progmodes/etags-regen.el @@ -0,0 +1,431 @@ +;;; etags-regen.el --- Auto-(re)regenerating tags -*- lexical-binding: t -*- + +;; Copyright (C) 2021-2023 Free Software Foundation, Inc. + +;; Author: Dmitry Gutov +;; Keywords: tools + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Simple automatic tags generation with updates on save. +;; +;; This mode provides automatic indexing for Emacs "go to definition" +;; feature, the `xref-go-forward' command (bound to `M-.' by default). +;; +;; At the moment reindexing works off before/after-save-hook, but to +;; handle more complex changes (for example, the user switching to +;; another branch from the terminal) we can look into plugging into +;; something like `filenotify'. +;; +;; Note that this feature disables itself if the user has some tags +;; table already visited (with `M-x visit-tags-table', or through an +;; explicit prompt triggered by some feature that requires tags). + +;;; Code: + +(require 'cl-lib) + +(defgroup etags-regen nil + "Auto-(re)generating tags." + :group 'tools) + +(defvar etags-regen--tags-file nil) +(defvar etags-regen--tags-root nil) +(defvar etags-regen--new-file nil) + +(declare-function project-root "project") +(declare-function project-files "project") +(declare-function dired-glob-regexp "dired") + +(defcustom etags-regen-program (executable-find "etags") + "Name of the etags program used by `etags-regen-mode'. + +If you only have `ctags' installed, you can also set this to +\"ctags -e\". Some features might not be supported this way." + ;; Always having our 'etags' here would be easier, but we can't + ;; always rely on it being installed. So it might be ctags's etags. + :type 'file + :version "30.1") + +(defcustom etags-regen-tags-file "TAGS" + "Name of the tags file to create inside the project by `etags-regen-mode'. + +The value should either be a simple file name (no directory +specified), or a function that accepts the project root directory +and returns a distinct absolute file name for its tags file. The +latter possibility is useful when you prefer to store the tag +files somewhere else, for example in `temporary-file-directory'." + :type '(choice (string :tag "File name") + (function :tag "Function that returns file name")) + :version "30.1") + +(defcustom etags-regen-program-options nil + "List of additional options for etags program invoked by `etags-regen-mode'." + :type '(repeat string) + :version "30.1") + +(defcustom etags-regen-regexp-alist nil + "Mapping of languages to etags regexps for `etags-regen-mode'. + +These regexps are used in addition to the tags made with the +standard parsing based on the language. + +The value must be a list where each element has the +form (LANGUAGES . TAG-REGEXPS) where both LANGUAGES and +TAG-REGEXPS are lists of strings. + +Each language should be one of the recognized by etags, see +`etags --help'. Each tag regexp should be a string in the format +documented for the `--regex' arguments (without `{language}'). + +We currently support only Emacs's etags program with this option." + :type '(repeat + (cons + :tag "Languages group" + (repeat (string :tag "Language name")) + (repeat (string :tag "Tag Regexp")))) + :version "30.1") + +;;;###autoload +(put 'etags-regen-regexp-alist 'safe-local-variable + (lambda (value) + (and (listp value) + (seq-every-p + (lambda (group) + (and (consp group) + (listp (car group)) + (listp (cdr group)) + (seq-every-p #'stringp (car group)) + (seq-every-p #'stringp (cdr group)))) + value)))) + +;; We have to list all extensions: etags falls back to Fortran +;; when it cannot determine the type of the file. +;; http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00323.html +(defcustom etags-regen-file-extensions + '("rb" "js" "py" "pl" "el" "c" "cpp" "cc" "h" "hh" "hpp" + "java" "go" "cl" "lisp" "prolog" "php" "erl" "hrl" + "F" "f" "f90" "for" "cs" "a" "asm" "ads" "adb" "ada") + "Code file extensions for `etags-regen-mode'. + +File extensions to generate the tags for." + :type '(repeat (string :tag "File extension")) + :version "30.1") + +;;;###autoload +(put 'etags-regen-file-extensions 'safe-local-variable + (lambda (value) (and (listp value) (seq-every-p #'stringp value)))) + +;; FIXME: We don't support root anchoring yet. +(defcustom etags-regen-ignores nil + "Additional ignore rules, in the format of `project-ignores'." + :type '(repeat + (string :tag "Glob to ignore")) + :version "30.1") + +;;;###autoload +(put 'etags-regen-ignores 'safe-local-variable + (lambda (value) (and (listp value) (seq-every-p #'stringp value)))) + +(defvar etags-regen--errors-buffer-name "*etags-regen-tags-errors*") + +(defvar etags-regen--rescan-files-limit 100) + +(defun etags-regen--all-mtimes (proj) + (let ((files (etags-regen--all-files proj)) + (mtimes (make-hash-table :test 'equal)) + file-name-handler-alist) + (dolist (f files) + (condition-case nil + (puthash f + (file-attribute-modification-time + (file-attributes f)) + mtimes) + (file-missing nil))) + mtimes)) + +(defun etags-regen--choose-tags-file (proj) + (if (functionp etags-regen-tags-file) + (funcall etags-regen-tags-file (project-root proj)) + (expand-file-name etags-regen-tags-file (project-root proj)))) + +(defun etags-regen--refresh (proj) + (save-excursion + (let* ((tags-file (etags-regen--choose-tags-file proj)) + (tags-mtime (file-attribute-modification-time + (file-attributes tags-file))) + (all-mtimes (etags-regen--all-mtimes proj)) + added-files + changed-files + removed-files) + (etags-regen--visit-table tags-file (project-root proj)) + (set-buffer (get-file-buffer tags-file)) + (dolist (file (tags-table-files)) + (let ((mtime (gethash file all-mtimes))) + (cond + ((null mtime) + (push file removed-files)) + ((time-less-p tags-mtime mtime) + (push file changed-files) + (remhash file all-mtimes)) + (t + (remhash file all-mtimes))))) + (maphash + (lambda (key _value) + (push key added-files)) + all-mtimes) + (if (> (+ (length added-files) + (length changed-files) + (length removed-files)) + etags-regen--rescan-files-limit) + (progn + (message "etags-regen: Too many changes, falling back to full rescan") + (etags-regen--tags-cleanup)) + (dolist (file (nconc removed-files changed-files)) + (etags-regen--remove-tag file)) + (when (or changed-files added-files) + (apply #'etags-regen--append-tags + (nconc changed-files added-files))) + (when (or changed-files added-files removed-files) + (let ((save-silently t) + (message-log-max nil)) + (save-buffer 0))))))) + +(defun etags-regen--maybe-generate () + (let (proj) + (when (and etags-regen--tags-root + (not (file-in-directory-p default-directory + etags-regen--tags-root))) + (etags-regen--tags-cleanup)) + (when (and (not etags-regen--tags-root) + ;; If existing table is visited that's not generated by + ;; this mode, skip all functionality. + (not (or tags-file-name + tags-table-list)) + (file-exists-p (etags-regen--choose-tags-file + (setq proj (project-current))))) + (message "Found existing tags table, refreshing...") + (etags-regen--refresh proj)) + (when (and (not (or tags-file-name + tags-table-list)) + (setq proj (or proj (project-current)))) + (message "Generating new tags table...") + (let ((start (time-to-seconds))) + (etags-regen--tags-generate proj) + (message "...done (%.2f s)" (- (time-to-seconds) start)))))) + +(defun etags-regen--all-files (proj) + (let* ((root (project-root proj)) + (default-directory root) + ;; TODO: Make the scanning more efficient, e.g. move the + ;; filtering by glob to project (project-files-filtered...). + (files (project-files proj)) + (match-re (concat + "\\." + (regexp-opt etags-regen-file-extensions) + "\\'")) + (ir-start (1- (length root))) + (ignores-regexps + (mapcar #'etags-regen--ignore-regexp + etags-regen-ignores))) + (cl-delete-if + (lambda (f) (or (not (string-match-p match-re f)) + (string-match-p "/\\.#" f) ;Backup files. + (cl-some (lambda (ignore) (string-match ignore f ir-start)) + ignores-regexps))) + files))) + +(defun etags-regen--ignore-regexp (ignore) + (require 'dired) + ;; It's somewhat brittle to rely on Dired. + (let ((re (dired-glob-regexp ignore))) + ;; We could implement root anchoring here, but \\= doesn't work in + ;; string-match :-(. + (concat (unless (eq ?/ (aref re 3)) "/") + ;; Cutting off the anchors added by `dired-glob-regexp'. + (substring re 2 (- (length re) 2)) + ;; This way we allow a glob to match against a directory + ;; name, or a file name. And when it ends with / already, + ;; no need to add the anchoring. + (unless (eq ?/ (aref re (- (length re) 3))) + ;; Either match a full name segment, or eos. + "\\(?:/\\|\\'\\)")))) + +(defun etags-regen--tags-generate (proj) + (let* ((root (project-root proj)) + (default-directory root) + (files (etags-regen--all-files proj)) + (tags-file (etags-regen--choose-tags-file proj)) + (ctags-p (etags-regen--ctags-p)) + (command (format "%s %s %s - -o %s" + etags-regen-program + (mapconcat #'identity + (etags-regen--build-program-options ctags-p) + " ") + ;; ctags's etags requires '-L' for stdin input. + (if ctags-p "-L" "") + tags-file))) + (with-temp-buffer + (mapc (lambda (f) + (insert f "\n")) + files) + (shell-command-on-region (point-min) (point-max) command + nil nil etags-regen--errors-buffer-name t)) + (etags-regen--visit-table tags-file root))) + +(defun etags-regen--visit-table (tags-file root) + ;; Invalidate the scanned tags after any change is written to disk. + (add-hook 'after-save-hook #'etags-regen--update-file) + (add-hook 'before-save-hook #'etags-regen--mark-as-new) + (setq etags-regen--tags-file tags-file + etags-regen--tags-root root) + (visit-tags-table etags-regen--tags-file)) + +(defun etags-regen--ctags-p () + (string-search "Ctags" + (shell-command-to-string + (format "%s --version" etags-regen-program)))) + +(defun etags-regen--build-program-options (ctags-p) + (when (and etags-regen-regexp-alist ctags-p) + (user-error "etags-regen-regexp-alist is not supported with Ctags")) + (nconc + (mapcan + (lambda (group) + (mapcan + (lambda (lang) + (mapcar (lambda (regexp) + (concat "--regex=" + (shell-quote-argument + (format "{%s}%s" lang regexp)))) + (cdr group))) + (car group))) + etags-regen-regexp-alist) + (mapcar #'shell-quote-argument + etags-regen-program-options))) + +(defun etags-regen--update-file () + ;; TODO: Maybe only do this when Emacs is idle for a bit. Or defer + ;; the updates and do them later in bursts when the table is used. + (let* ((file-name buffer-file-name) + (tags-file-buf (and etags-regen--tags-root + (get-file-buffer etags-regen--tags-file))) + (relname (concat "/" (file-relative-name file-name + etags-regen--tags-root))) + (ignores etags-regen-ignores) + pr should-scan) + (save-excursion + (when tags-file-buf + (cond + ((and etags-regen--new-file + (kill-local-variable 'etags-regen--new-file) + (setq pr (project-current)) + (equal (project-root pr) etags-regen--tags-root) + (member file-name (project-files pr))) + (set-buffer tags-file-buf) + (setq should-scan t)) + ((progn (set-buffer tags-file-buf) + (etags-regen--remove-tag file-name)) + (setq should-scan t)))) + (when (and should-scan + (not (cl-some + (lambda (ignore) + (string-match-p + (etags-regen--ignore-regexp ignore) + relname)) + ignores))) + (etags-regen--append-tags file-name) + (let ((save-silently t) + (message-log-max nil)) + (save-buffer 0)))))) + +(defun etags-regen--remove-tag (file-name) + (goto-char (point-min)) + (when (search-forward (format "\f\n%s," file-name) nil t) + (let ((start (match-beginning 0))) + (search-forward "\f\n" nil 'move) + (let ((inhibit-read-only t)) + (delete-region start + (if (eobp) + (point) + (- (point) 2))))) + t)) + +(defun etags-regen--append-tags (&rest file-names) + (goto-char (point-max)) + (let ((options (etags-regen--build-program-options (etags-regen--ctags-p))) + (inhibit-read-only t)) + ;; XXX: call-process is significantly faster, though. + ;; Like 10ms vs 20ms here. But `shell-command' makes it easy to + ;; direct stderr to a separate buffer. + (shell-command + (format "%s %s %s -o -" + etags-regen-program (mapconcat #'identity options " ") + (mapconcat #'identity file-names " ")) + t etags-regen--errors-buffer-name)) + ;; FIXME: Is there a better way to do this? + ;; Completion table is the only remaining place where the + ;; update is not incremental. + (setq-default tags-completion-table nil)) + +(defun etags-regen--mark-as-new () + (when (and etags-regen--tags-root + (not buffer-file-number)) + (setq-local etags-regen--new-file t))) + +(defun etags-regen--tags-cleanup () + (when etags-regen--tags-file + (let ((buffer (get-file-buffer etags-regen--tags-file))) + (and buffer + (kill-buffer buffer))) + (tags-reset-tags-tables) + (setq tags-file-name nil + tags-table-list nil + etags-regen--tags-file nil + etags-regen--tags-root nil)) + (remove-hook 'after-save-hook #'etags-regen--update-file) + (remove-hook 'before-save-hook #'etags-regen--mark-as-new)) + +(defvar etags-regen-mode-map (make-sparse-keymap)) + +;;;###autoload +(define-minor-mode etags-regen-mode + "Minor mode to automatically generate and update tags tables. + +This minor mode generates the tags table automatically based on +the current project configuration, and later updates it as you +edit the files and save the changes. + +If you select a tags table manually (for example, using +\\[visit-tags-table]), then this mode will be effectively +disabled for the entire session. Use \\[tags-reset-tags-tables] +to countermand the effect of a previous \\[visit-tags-table]." + :global t + (if etags-regen-mode + (progn + (advice-add 'etags--xref-backend :before + #'etags-regen--maybe-generate) + (advice-add 'tags-completion-at-point-function :before + #'etags-regen--maybe-generate)) + (advice-remove 'etags--xref-backend #'etags-regen--maybe-generate) + (advice-remove 'tags-completion-at-point-function #'etags-regen--maybe-generate) + (etags-regen--tags-cleanup))) + +(provide 'etags-regen) + +;;; etags-regen.el ends here -- cgit v1.2.3 From a2a6619b2825c3c3d159610f0cd6fd89b791bd3f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 4 Jan 2024 10:17:30 +0200 Subject: Provide decent documentation for 'help-quick' * lisp/help.el (help-quick, help-quick-toggle): Doc fix. * doc/emacs/help.texi (Help Summary, Misc Help): Document 'help-quick-toggle'. --- doc/emacs/help.texi | 15 +++++++++++++++ lisp/help.el | 13 ++++++++++--- 2 files changed, 25 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 68299c057d7..1330717b758 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -115,6 +115,9 @@ Display a list of commands whose names match @var{topics} Display all active key bindings; minor mode bindings first, then those of the major mode, then global bindings (@code{describe-bindings}). @xref{Misc Help}. +@item C-h C-q +Toggle display of a window showing popular commands and their key +bindings. @xref{Misc Help}. @item C-h c @var{key} Show the name of the command that the key sequence @var{key} is bound to (@code{describe-key-briefly}). Here @kbd{c} stands for @@ -700,6 +703,18 @@ displays the contents of the syntax table, with explanations of each character's syntax (@pxref{Syntax Tables,, Syntax Tables, elisp, The Emacs Lisp Reference Manual}). +@kindex C-h C-q +@findex help-quick-toggle +@findex help-quick +@cindex cheat sheet of popular Emacs commands + @kbd{C-h C-q} (@code{help-quick-toggle}) toggles on and off the +display of a buffer showing the most popular Emacs commands and their +respective key bindings (a.k.a.@: ``cheat sheet''). The contents of +that buffer are created by the command @code{help-quick}. Each key +binding shown in this buffer is a button: click on it with +@kbd{mouse-1} or @kbd{mouse-2} to show the documentation of the +command bound to that key sequence. + @findex describe-prefix-bindings You can get a list of subcommands for a particular prefix key by typing @kbd{C-h}, @kbd{?}, or @key{F1} diff --git a/lisp/help.el b/lisp/help.el index fe80dd3a72d..accd01e56f5 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -171,7 +171,10 @@ buffer.") ;; Inspired by a mg fork (https://github.com/troglobit/mg) (defun help-quick () - "Display a quick-help buffer." + "Display a quick-help buffer showing popular commands and their bindings. +The window showing quick-help can be toggled using \\[help-quick-toggle]. +You can click on a key binding shown in the quick-help buffer to display +the documentation of the command bound to that key sequence." (interactive) (with-current-buffer (get-buffer-create "*Quick Help*") (let ((inhibit-read-only t) (padding 2) blocks) @@ -244,10 +247,14 @@ buffer.") ;; ... and shrink it immediately. (fit-window-to-buffer)) (message - (substitute-command-keys "Toggle the quick help buffer using \\[help-quick-toggle].")))) + (substitute-command-keys "Toggle display of quick-help buffer using \\[help-quick-toggle].")))) (defun help-quick-toggle () - "Toggle the quick-help window." + "Toggle display of a window showing popular commands and their bindings. +This toggles on and off the display of the quick-help buffer, which shows +popular commands and their bindings as produced by `help-quick'. +You can click on a key binding shown in the quick-help buffer to display +the documentation of the command bound to that key sequence." (interactive) (if (and-let* ((window (get-buffer-window "*Quick Help*"))) (quit-window t window)) -- cgit v1.2.3 From 5765cc3a5a32bdecfb6b28180afda97d4b74ee6a Mon Sep 17 00:00:00 2001 From: Morgan Willcock Date: Sun, 31 Dec 2023 20:47:17 +0000 Subject: Ensure indent-region argument order in tempo.el is correct * lisp/tempo.el (tempo-insert): Call 'indent-region' with the stored region markers to ensure that the start and end arguments are used in the correct order. (Bug#68185) --- lisp/tempo.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/tempo.el b/lisp/tempo.el index df78690bd31..f32313d80d0 100644 --- a/lisp/tempo.el +++ b/lisp/tempo.el @@ -333,7 +333,8 @@ possible." (`(r> . ,rest) (if on-region (progn (goto-char tempo-region-stop) - (indent-region (mark) (point) nil)) + (indent-region tempo-region-start + tempo-region-stop)) (tempo-insert-prompt-compat rest))) (`(s ,name) (tempo-insert-named name)) (`(l . ,rest) (dolist (elt rest) (tempo-insert elt on-region))) @@ -344,7 +345,7 @@ possible." ('r> (if on-region (progn (goto-char tempo-region-stop) - (indent-region (mark) (point) nil)) + (indent-region tempo-region-start tempo-region-stop)) (tempo-insert-mark (point-marker)))) ('> (indent-according-to-mode)) ('& (if (not (or (= (current-column) 0) -- cgit v1.2.3 From d69fb6dab28e55447516341cf28f1b6d06937ad6 Mon Sep 17 00:00:00 2001 From: Morgan Willcock Date: Sun, 31 Dec 2023 20:47:17 +0000 Subject: Fix last change in tempo.el * lisp/tempo.el: Set marker type for tempo-region-start to move when text is inserted at its position. This prevents the template from inserting text into the region. (Bug#68185) --- lisp/tempo.el | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lisp') diff --git a/lisp/tempo.el b/lisp/tempo.el index f32313d80d0..513e778e4ef 100644 --- a/lisp/tempo.el +++ b/lisp/tempo.el @@ -198,6 +198,10 @@ This is an abnormal hook where the functions are called with one argument (defvar-local tempo-region-start (make-marker) "Region start when inserting around the region.") +;; Insertion by the template at the region start position should move +;; the marker to preserve the original region contents. +(set-marker-insertion-type tempo-region-start t) + (defvar-local tempo-region-stop (make-marker) "Region stop when inserting around the region.") -- cgit v1.2.3 From dc99be8e633fa0d8594b72f41584a53590939fde Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 4 Jan 2024 19:20:30 +0200 Subject: Support display-sort-function in completion-category-overrides (bug#68214) * doc/lispref/minibuf.texi (Completion Variables): Add 'display-sort-function' to the table of 'completion-category-overrides'. * lisp/calendar/calendar.el (calendar-read-date): Add metadata category 'calendar-month' for completing-read reading a month name. * lisp/minibuffer.el (completion-category-defaults): Add 'display-sort-function' with identity for the category 'calendar-month'. (completion-category-overrides): Add customization for completion sorting with 'display-sort-function' and a choice like in 'completions-sort'. (completion-metadata-override-get): New function. (minibuffer-completion-help): Use 'completion-metadata-override-get' instead of 'completion-metadata-get' to get sort-fun from 'display-sort-function'. --- doc/lispref/minibuf.texi | 6 ++++++ etc/NEWS | 6 ++++++ lisp/calendar/calendar.el | 6 +++++- lisp/minibuffer.el | 30 +++++++++++++++++++++++++++--- 4 files changed, 44 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 5c5edf62a8d..65272627660 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1878,6 +1878,12 @@ The value should be a list of completion styles (symbols). The value should be a value for @code{completion-cycle-threshold} (@pxref{Completion Options,,, emacs, The GNU Emacs Manual}) for this category. + +@item display-sort-function +The possible values are: @code{nil} that means to use either the sorting +function from metadata or if it's nil then fall back to @code{completions-sort}; +@code{identity} that means to not use any sorting to keep the original order; +and other values are the same as in @code{completions-sort}. @end table @noindent diff --git a/etc/NEWS b/etc/NEWS index 713581cdcf4..6239af3e138 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -740,6 +740,12 @@ When 'completions-sort' is set to 'historical', completion candidates will be first sorted alphabetically, and then re-sorted by their order in the minibuffer history, with more recent candidates appearing first. ++++ +*** 'completion-category-overrides' supports 'display-sort-function'. +You can now customize the sorting order for any category in +'completion-category-overrides' that will override the sorting order +defined in the metadata or in 'completions-sort'. + ** Pcomplete --- diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index a25684f7b5d..e01d5d792a6 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -2339,7 +2339,11 @@ returned is (month year)." (month (cdr (assoc-string (completing-read (format-prompt "Month name" defmon) - (append month-array nil) + (lambda (string pred action) + (if (eq action 'metadata) + '(metadata (category . calendar-month)) + (complete-with-action + action (append month-array nil) string pred))) nil t nil nil defmon) (calendar-make-alist month-array 1) t))) (defday (calendar-extract-day default-date)) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index fa2dcb4f698..6ead11d81c8 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1135,12 +1135,14 @@ styles for specific categories, such as files, buffers, etc." (project-file (styles . (substring))) (xref-location (styles . (substring))) (info-menu (styles . (basic substring))) - (symbol-help (styles . (basic shorthand substring)))) + (symbol-help (styles . (basic shorthand substring))) + (calendar-month (display-sort-function . identity))) "Default settings for specific completion categories. Each entry has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: - `styles': the list of `completion-styles' to use for that category. - `cycle': the `completion-cycle-threshold' to use for that category. +- `display-sort-function': the sorting function. Categories are symbols such as `buffer' and `file', used when completing buffer and file names, respectively. @@ -1148,10 +1150,16 @@ Also see `completion-category-overrides'.") (defcustom completion-category-overrides nil "List of category-specific user overrides for completion styles. + Each override has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: - `styles': the list of `completion-styles' to use for that category. - `cycle': the `completion-cycle-threshold' to use for that category. +- `display-sort-function': where `nil' means to use either the sorting +function from metadata or if it's nil then fall back to `completions-sort'; +`identity' means to not use any sorting to keep the original order; +and other values are the same as in `completions-sort'. + Categories are symbols such as `buffer' and `file', used when completing buffer and file names, respectively. @@ -1171,12 +1179,28 @@ overrides the default specified in `completion-category-defaults'." ,completion--styles-type) (cons :tag "Completion Cycling" (const :tag "Select one value from the menu." cycle) - ,completion--cycling-threshold-type)))) + ,completion--cycling-threshold-type) + (cons :tag "Completion Sorting" + (const :tag "Select one value from the menu." + display-sort-function) + (choice (const :tag "Use default" nil) + (const :tag "No sorting" identity) + (const :tag "Alphabetical sorting" + minibuffer-sort-alphabetically) + (const :tag "Historical sorting" + minibuffer-sort-by-history) + (function :tag "Custom function")))))) (defun completion--category-override (category tag) (or (assq tag (cdr (assq category completion-category-overrides))) (assq tag (cdr (assq category completion-category-defaults))))) +(defun completion-metadata-override-get (metadata prop) + (if-let ((cat (completion-metadata-get metadata 'category)) + (over (completion--category-override cat prop))) + (cdr over) + (completion-metadata-get metadata prop))) + (defun completion--styles (metadata) (let* ((cat (completion-metadata-get metadata 'category)) (over (completion--category-override cat 'styles))) @@ -2522,7 +2546,7 @@ The candidate will still be chosen by `choose-completion' unless (aff-fun (or (completion-metadata-get all-md 'affixation-function) (plist-get completion-extra-properties :affixation-function))) - (sort-fun (completion-metadata-get all-md 'display-sort-function)) + (sort-fun (completion-metadata-override-get all-md 'display-sort-function)) (group-fun (completion-metadata-get all-md 'group-function)) (mainbuf (current-buffer)) ;; If the *Completions* buffer is shown in a new -- cgit v1.2.3 From df505804ab6e7dc869cfc9db6308a8c568eddd6a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 4 Jan 2024 20:47:06 +0200 Subject: ; Fix documentation of last change * lisp/minibuffer.el (completion-category-overrides): Doc fix. * doc/emacs/mini.texi (Completion Options): Update documentation of 'completions-sort'. * doc/lispref/minibuf.texi (Completion Variables): Fox wording. Add a cross-reference to where 'completions-sort' is documented. --- doc/emacs/mini.texi | 4 +++- doc/lispref/minibuf.texi | 10 ++++++---- lisp/minibuffer.el | 8 ++++---- 3 files changed, 13 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index 30a61a02f06..aa7144610a6 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -709,7 +709,9 @@ will use just one column. The @code{completions-sort} user option controls the order in which the completions are sorted in the @samp{*Completions*} buffer. The default is @code{alphabetical}, which sorts in alphabetical order. -The value @code{nil} disables sorting. The value can also be a +The value @code{nil} disables sorting; the value @code{historical} +sorts alphabetically first, and then rearranges according to the order +of the candidates in the minibuffer history. The value can also be a function, which will be called with the list of completions, and should return the list in the desired order. diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 65272627660..8aed1515764 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1880,10 +1880,12 @@ The value should be a value for @code{completion-cycle-threshold} category. @item display-sort-function -The possible values are: @code{nil} that means to use either the sorting -function from metadata or if it's nil then fall back to @code{completions-sort}; -@code{identity} that means to not use any sorting to keep the original order; -and other values are the same as in @code{completions-sort}. +The possible values are: @code{nil}, which means to use either the +sorting function from metadata or if that is @code{nil}, fall back to +@code{completions-sort}; @code{identity}, which means not to sort at +all, leaving the original order; or any other value out of those used +in @code{completions-sort} (@pxref{Completion Options,,, emacs, The +GNU Emacs Manual}). @end table @noindent diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 6ead11d81c8..b7aebae63a8 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1155,10 +1155,10 @@ Each override has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: - `styles': the list of `completion-styles' to use for that category. - `cycle': the `completion-cycle-threshold' to use for that category. -- `display-sort-function': where `nil' means to use either the sorting -function from metadata or if it's nil then fall back to `completions-sort'; -`identity' means to not use any sorting to keep the original order; -and other values are the same as in `completions-sort'. +- `display-sort-function': nil means to use either the sorting +function from metadata, or if that is nil, fall back to `completions-sort'; +`identity' disables sorting and keeps the original order; and other +possible values are the same as in `completions-sort'. Categories are symbols such as `buffer' and `file', used when completing buffer and file names, respectively. -- cgit v1.2.3 From 225710ba79c10b53b6ba320327ca31192ca72387 Mon Sep 17 00:00:00 2001 From: Antero Mejr Date: Thu, 4 Jan 2024 19:49:23 +0000 Subject: Add file completion for "git blame" to pcomplete * lisp/pcmpl-git.el (pcomplete/git): Add "blame" to the tracked files clause. (Bug#68245) --- lisp/pcmpl-git.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/pcmpl-git.el b/lisp/pcmpl-git.el index facca4107a1..95b6859dd23 100644 --- a/lisp/pcmpl-git.el +++ b/lisp/pcmpl-git.el @@ -88,7 +88,7 @@ Files listed by `git ls-files ARGS' satisfy the predicate." (pcomplete-entries nil (pcmpl-git--tracked-file-predicate "-m")))) ;; Complete all tracked files - ((or "mv" "rm" "grep" "status") + ((or "mv" "rm" "grep" "status" "blame") (pcomplete-here (pcomplete-entries nil (pcmpl-git--tracked-file-predicate)))) ;; Complete revisions -- cgit v1.2.3 From 5ba75e183c60aff50949587c21066e876dabfbda Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 25 Dec 2023 22:32:17 -0500 Subject: New special form `handler-bind` AFAIK, this provides the same semantics as Common Lisp's `handler-bind`, modulo the differences about how error objects and conditions are represented. * lisp/subr.el (handler-bind): New macro. * src/eval.c (pop_handler): New function. (Fhandler_Bind_1): New function. (signal_or_quit): Handle new handlertypes `HANDLER` and `SKIP_CONDITIONS`. (find_handler_clause): Simplify. (syms_of_eval): Defsubr `Fhandler_bind_1`. * doc/lispref/control.texi (Handling Errors): Add `handler-bind`. * test/src/eval-tests.el (eval-tests--handler-bind): New test. * lisp/emacs-lisp/lisp-mode.el (lisp-font-lock-keywords): Move 'handler-bind' from CL-only to generic Lisp. (handler-bind): Remove indentation setting, it now lives in the macro definition. --- doc/lispref/control.texi | 38 +++++++++++++++++ etc/NEWS | 7 ++++ lisp/emacs-lisp/lisp-mode.el | 5 +-- lisp/subr.el | 22 ++++++++++ src/eval.c | 97 ++++++++++++++++++++++++++++++++++++++------ src/lisp.h | 41 +++++++++++++++++-- test/src/eval-tests.el | 37 +++++++++++++++++ 7 files changed, 227 insertions(+), 20 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index acf9be5c3ff..6cc25dcdaee 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -2293,6 +2293,44 @@ should be robust if one does occur. Note that this macro uses @code{condition-case-unless-debug} rather than @code{condition-case}. @end defmac +Occasionally, we want to catch some errors and record some information +about the conditions in which they occurred, such as the full +backtrace, or the current buffer. This kinds of information is sadly +not available in the handlers of a @code{condition-case} because the +stack is unwound before running that handler, so the handler is run in +the dynamic context of the @code{condition-case} rather than that of +the place where the error was signaled. For those circumstances, you +can use the following form: + +@defmac handler-bind handlers body@dots{} +This special form runs @var{body} and if it executes without error, +the value it returns becomes the value of the @code{handler-bind} +form. In this case, the @code{handler-bind} has no effect. + +@var{handlers} should be a list of elements of the form +@code{(@var{conditions} @var{handler})} where @var{conditions} is an +error condition name to be handled, or a list of condition names, and +@var{handler} should be a form whose evaluation should return a function. + +Before running @var{body}, @code{handler-bind} evaluates all the +@var{handler} forms and installs those handlers to be active during +the evaluation of @var{body}. These handlers are searched together +with those installed by @code{condition-case}. When the innermost +matching handler is one installed by @code{handler-bind}, the +@var{handler} function is called with a single argument holding the +error description. + +@var{handler} is called in the dynamic context where the error +happened, without first unwinding the stack, meaning that all the +dynamic bindings are still in effect, except that all the error +handlers between the code that signaled the error and the +@code{handler-bind} are temporarily suspended. Like any normal +function, @var{handler} can exit non-locally, typically via +@code{throw}, or it can return normally. If @var{handler} returns +normally, it means the handler @emph{declined} to handle the error and +the search for an error handler is continued where it left off. +@end defmac + @node Error Symbols @subsubsection Error Symbols and Condition Names @cindex error symbol diff --git a/etc/NEWS b/etc/NEWS index 6239af3e138..db3b838c380 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1395,6 +1395,13 @@ This is like 'require', but it checks whether the argument 'feature' is already loaded, in which case it either signals an error or forcibly reloads the file that defines the feature. ++++ +** New special form 'handler-bind'. +Provides a functionality similar to `condition-case` except it runs the +handler code without unwinding the stack, such that we can record the +backtrace and other dynamic state at the point of the error. +See the Info node "(elisp) Handling Errors". + +++ ** New 'pop-up-frames' action alist entry for 'display-buffer'. This has the same effect as the variable of the same name and takes diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 1bb9c2fdc2e..ca207ff548d 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -343,7 +343,7 @@ This will generate compile-time constants from BINDINGS." (lisp-vdefs '("defvar")) (lisp-kw '("cond" "if" "while" "let" "let*" "progn" "prog1" "prog2" "lambda" "unwind-protect" "condition-case" - "when" "unless" "with-output-to-string" + "when" "unless" "with-output-to-string" "handler-bind" "ignore-errors" "dotimes" "dolist" "declare")) (lisp-errs '("warn" "error" "signal")) ;; Elisp constructs. Now they are update dynamically @@ -376,7 +376,7 @@ This will generate compile-time constants from BINDINGS." (cl-kw '("block" "break" "case" "ccase" "compiler-let" "ctypecase" "declaim" "destructuring-bind" "do" "do*" "ecase" "etypecase" "eval-when" "flet" "flet*" - "go" "handler-case" "handler-bind" "in-package" ;; "inline" + "go" "handler-case" "in-package" ;; "inline" "labels" "letf" "locally" "loop" "macrolet" "multiple-value-bind" "multiple-value-prog1" "proclaim" "prog" "prog*" "progv" @@ -1346,7 +1346,6 @@ Lisp function does not specify a special indentation." (put 'catch 'lisp-indent-function 1) (put 'condition-case 'lisp-indent-function 2) (put 'handler-case 'lisp-indent-function 1) ;CL -(put 'handler-bind 'lisp-indent-function 1) ;CL (put 'unwind-protect 'lisp-indent-function 1) (put 'with-output-to-temp-buffer 'lisp-indent-function 1) (put 'closure 'lisp-indent-function 2) diff --git a/lisp/subr.el b/lisp/subr.el index d2b8ea17f74..0519e56e057 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -7497,6 +7497,28 @@ predicate conditions in CONDITION." (push buf bufs))) bufs)) +(defmacro handler-bind (handlers &rest body) + "Setup error HANDLERS around execution of BODY. +HANDLERS is a list of (CONDITIONS HANDLER) where +CONDITIONS should be a list of condition names (symbols) or +a single condition name, and HANDLER is a form whose evaluation +returns a function. +When an error is signaled during execution of BODY, if that +error matches CONDITIONS, then the associated HANDLER +function is called with the error object as argument. +HANDLERs can either transfer the control via a non-local exit, +or return normally. If a handler returns normally, the search for an +error handler continues from where it left off." + ;; FIXME: Completion support as in `condition-case'? + (declare (indent 1) (debug ((&rest (sexp form)) body))) + (let ((args '())) + (dolist (cond+handler handlers) + (let ((handler (car (cdr cond+handler))) + (conds (car cond+handler))) + (push `',(ensure-list conds) args) + (push handler args))) + `(handler-bind-1 (lambda () ,@body) ,@(nreverse args)))) + (defmacro with-memoization (place &rest code) "Return the value of CODE and stash it in PLACE. If PLACE's value is non-nil, then don't bother evaluating CODE diff --git a/src/eval.c b/src/eval.c index 7f67b5a9db8..595267f7686 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1198,6 +1198,12 @@ usage: (catch TAG BODY...) */) #define clobbered_eassert(E) verify (sizeof (E) != 0) +static void +pop_handler (void) +{ + handlerlist = handlerlist->next; +} + /* Set up a catch, then call C function FUNC on argument ARG. FUNC should return a Lisp_Object. This is how catches are done from within C code. */ @@ -1361,6 +1367,43 @@ usage: (condition-case VAR BODYFORM &rest HANDLERS) */) return internal_lisp_condition_case (var, bodyform, handlers); } +DEFUN ("handler-bind-1", Fhandler_bind_1, Shandler_bind_1, 1, MANY, 0, + doc: /* Setup error handlers around execution of BODYFUN. +BODYFUN be a function and it is called with no arguments. +CONDITIONS should be a list of condition names (symbols). +When an error is signaled during executon of BODYFUN, if that +error matches one of CONDITIONS, then the associated HANDLER is +called with the error as argument. +HANDLER should either transfer the control via a non-local exit, +or return normally. +If it returns normally, the search for an error handler continues +from where it left off. + +usage: (handler-bind BODYFUN [CONDITIONS HANDLER]...) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + eassert (nargs >= 1); + Lisp_Object bodyfun = args[0]; + int count = 0; + if (nargs % 2 == 0) + error ("Trailing CONDITIONS withount HANDLER in `handler-bind`"); + for (ptrdiff_t i = nargs - 2; i > 0; i -= 2) + { + Lisp_Object conditions = args[i], handler = args[i + 1]; + if (NILP (conditions)) + continue; + else if (!CONSP (conditions)) + conditions = Fcons (conditions, Qnil); + struct handler *c = push_handler (conditions, HANDLER_BIND); + c->val = handler; + c->bytecode_dest = count++; + } + Lisp_Object ret = call0 (bodyfun); + for (; count > 0; count--) + pop_handler (); + return ret; +} + /* Like Fcondition_case, but the args are separate rather than passed in a list. Used by Fbyte_code. */ @@ -1737,6 +1780,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) = (NILP (error_symbol) ? Fcar (data) : error_symbol); Lisp_Object clause = Qnil; struct handler *h; + int skip; if (gc_in_progress || waiting_for_input) emacs_abort (); @@ -1759,6 +1803,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) /* Edebug takes care of restoring these variables when it exits. */ max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 20); + /* FIXME: 'handler-bind' makes `signal-hook-function' obsolete? */ call2 (Vsignal_hook_function, error_symbol, data); } @@ -1778,16 +1823,42 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) Vsignaling_function = backtrace_function (pdl); } - for (h = handlerlist; h; h = h->next) + for (skip = 0, h = handlerlist; h; skip++, h = h->next) { - if (h->type == CATCHER_ALL) + switch (h->type) { + case CATCHER_ALL: clause = Qt; break; - } - if (h->type != CONDITION_CASE) - continue; - clause = find_handler_clause (h->tag_or_ch, conditions); + case CATCHER: + continue; + case CONDITION_CASE: + clause = find_handler_clause (h->tag_or_ch, conditions); + break; + case HANDLER_BIND: + { + if (!NILP (find_handler_clause (h->tag_or_ch, conditions))) + { + Lisp_Object error_data + = (NILP (error_symbol) + ? data : Fcons (error_symbol, data)); + push_handler (make_fixnum (skip + h->bytecode_dest), + SKIP_CONDITIONS); + call1 (h->val, error_data); + pop_handler (); + } + continue; + } + case SKIP_CONDITIONS: + { + int toskip = XFIXNUM (h->tag_or_ch); + while (toskip-- >= 0) + h = h->next; + continue; + } + default: + abort (); + } if (!NILP (clause)) break; } @@ -1804,7 +1875,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) || (CONSP (clause) && !NILP (Fmemq (Qdebug, clause))) /* Special handler that means "print a message and run debugger if requested". */ - || EQ (h->tag_or_ch, Qerror))) + || EQ (clause, Qerror))) { debugger_called = maybe_call_debugger (conditions, error_symbol, data); @@ -1818,8 +1889,9 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) with debugging. Make sure to use `debug-early' unconditionally to not interfere with ERT or other packages that install custom debuggers. */ + /* FIXME: This could be turned into a `handler-bind` at toplevel? */ if (!debugger_called && !NILP (error_symbol) - && (NILP (clause) || EQ (h->tag_or_ch, Qerror)) + && (NILP (clause) || EQ (clause, Qerror)) && noninteractive && backtrace_on_error_noninteractive && NILP (Vinhibit_debugger) && !NILP (Ffboundp (Qdebug_early))) @@ -1833,6 +1905,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) /* If an error is signaled during a Lisp hook in redisplay, write a backtrace into the buffer *Redisplay-trace*. */ + /* FIXME: Turn this into a `handler-bind` installed during redisplay? */ if (!debugger_called && !NILP (error_symbol) && backtrace_on_redisplay_error && (NILP (clause) || h == redisplay_deep_handler) @@ -2058,13 +2131,10 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions) register Lisp_Object h; /* t is used by handlers for all conditions, set up by C code. */ - if (EQ (handlers, Qt)) - return Qt; - /* error is used similarly, but means print an error message and run the debugger if that is enabled. */ - if (EQ (handlers, Qerror)) - return Qt; + if (!CONSP (handlers)) + return handlers; for (h = handlers; CONSP (h); h = XCDR (h)) { @@ -4494,6 +4564,7 @@ alist of active lexical bindings. */); defsubr (&Sthrow); defsubr (&Sunwind_protect); defsubr (&Scondition_case); + defsubr (&Shandler_bind_1); DEFSYM (QCsuccess, ":success"); defsubr (&Ssignal); defsubr (&Scommandp); diff --git a/src/lisp.h b/src/lisp.h index 10018e4dde7..2b30326abfc 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3543,7 +3543,8 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) } /* This structure helps implement the `catch/throw' and `condition-case/signal' - control structures. A struct handler contains all the information needed to + control structures as well as 'handler-bind'. + A struct handler contains all the information needed to restore the state of the interpreter after a non-local jump. Handler structures are chained together in a doubly linked list; the `next' @@ -3564,9 +3565,41 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) state. Members are volatile if their values need to survive _longjmp when - a 'struct handler' is a local variable. */ - -enum handlertype { CATCHER, CONDITION_CASE, CATCHER_ALL }; + a 'struct handler' is a local variable. + + When running the HANDLER of a 'handler-bind', we need to + temporarily "mute" the CONDITION_CASEs and HANDLERs that are "below" + the current handler, but without hiding any CATCHERs. We do that by + installing a SKIP_CONDITIONS which tells the search to skip the + N next conditions. */ + +enum handlertype { + CATCHER, /* Entry for 'catch'. + 'tag_or_ch' holds the catch's tag. + 'val' holds the retval during longjmp. */ + CONDITION_CASE, /* Entry for 'condition-case'. + 'tag_or_ch' holds the list of conditions. + 'val' holds the retval during longjmp. */ + CATCHER_ALL, /* Wildcard which catches all 'throw's. + 'tag_or_ch' is unused. + 'val' holds the retval during longjmp. */ + HANDLER_BIND, /* Entry for 'handler-bind'. + 'tag_or_ch' holds the list of conditions. + 'val' holds the handler function. + The rest of the handler is unused, + except for 'bytecode_dest' that holds + the number of preceding HANDLER_BIND + entries which belong to the same + 'handler-bind' (and hence need to + be muted together). */ + SKIP_CONDITIONS /* Mask out the N preceding entries. + Used while running the handler of + a HANDLER_BIND to hides the condition + handlers underneath (and including) + the 'handler-bind'. + 'tag_or_ch' holds that number, the rest + is unused. */ +}; enum nonlocal_exit { diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index e4b18ec7849..9ac117859dd 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -303,4 +303,41 @@ expressions works for identifiers starting with period." (should (eq 'bar (default-value 'eval-tests/buffer-local-var))) (should (eq 'bar eval-tests/buffer-local-var))))) +(ert-deftest eval-tests--handler-bind () + ;; A `handler-bind' has no effect if no error is signaled. + (should (equal (catch 'tag + (handler-bind ((error (lambda (_err) (throw 'tag 'wow)))) + 'noerror)) + 'noerror)) + ;; The handler is called from within the dynamic extent where the + ;; error is signaled, unlike `condition-case'. + (should (equal (catch 'tag + (handler-bind ((error (lambda (_err) (throw 'tag 'err)))) + (list 'inner-catch + (catch 'tag + (user-error "hello"))))) + '(inner-catch err))) + ;; But inner condition handlers are temporarily muted. + (should (equal (condition-case nil + (handler-bind + ((error (lambda (_err) + (signal 'wrong-type-argument nil)))) + (list 'result + (condition-case nil + (user-error "hello") + (wrong-type-argument 'inner-handler)))) + (wrong-type-argument 'wrong-type-argument)) + 'wrong-type-argument)) + ;; Handlers do not apply to the code run within the handlers. + (should (equal (condition-case nil + (handler-bind + ((error (lambda (_err) + (signal 'wrong-type-argument nil))) + (wrong-type-argument + (lambda (_err) (user-error "wrong-type-argument")))) + (user-error "hello")) + (wrong-type-argument 'wrong-type-argument) + (error 'plain-error)) + 'wrong-type-argument))) + ;;; eval-tests.el ends here -- cgit v1.2.3 From 7959a63ce258c90eb3c7947ab3318c5531eb37d9 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 18 Dec 2023 23:47:56 -0500 Subject: (eval-expression): Fix bug#67196 * lisp/simple.el (eval-expression--debug): New function. (eval-expression): Use it together with `handler-bind` instead of let-binding `debug-on-error`. --- lisp/simple.el | 29 +++++++++++++---------------- 1 file changed, 13 insertions(+), 16 deletions(-) (limited to 'lisp') diff --git a/lisp/simple.el b/lisp/simple.el index 4f6d2ee12c3..692c0dacefc 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2087,6 +2087,9 @@ of the prefix argument for `eval-expression' and ((= num -1) most-positive-fixnum) (t eval-expression-print-maximum-character))))) +(defun eval-expression--debug (err) + (funcall debugger 'error err :backtrace-base #'eval-expression--debug)) + ;; We define this, rather than making `eval' interactive, ;; for the sake of completion of names like eval-region, eval-buffer. (defun eval-expression (exp &optional insert-value no-truncate char-print-limit) @@ -2120,23 +2123,17 @@ this command arranges for all errors to enter the debugger." (cons (read--expression "Eval: ") (eval-expression-get-print-arguments current-prefix-arg))) - (let (result) + (let* (result + (runfun + (lambda () + (setq result + (values--store-value + (eval (let ((lexical-binding t)) (macroexpand-all exp)) + t)))))) (if (null eval-expression-debug-on-error) - (setq result - (values--store-value - (eval (let ((lexical-binding t)) (macroexpand-all exp)) t))) - (let ((old-value (make-symbol "t")) new-value) - ;; Bind debug-on-error to something unique so that we can - ;; detect when evalled code changes it. - (let ((debug-on-error old-value)) - (setq result - (values--store-value - (eval (let ((lexical-binding t)) (macroexpand-all exp)) t))) - (setq new-value debug-on-error)) - ;; If evalled code has changed the value of debug-on-error, - ;; propagate that change to the global binding. - (unless (eq old-value new-value) - (setq debug-on-error new-value)))) + (funcall runfun) + (handler-bind ((error #'eval-expression--debug)) + (funcall runfun))) (let ((print-length (unless no-truncate eval-expression-print-length)) (print-level (unless no-truncate eval-expression-print-level)) -- cgit v1.2.3 From fe0f15dbc962b37d98507a494fd7720bad584a7a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 18 Dec 2023 23:57:45 -0500 Subject: ert.el: Use `handler-bind` to record backtraces * lisp/emacs-lisp/ert.el (ert--should-signal-hook): Delete function. (ert--expand-should-1): Don't bind `signal-hook-function`. (ert--test-execution-info): Remove `next-debugger` slot. (ert--run-test-debugger): Adjust to new calling convention. Pass the `:backtrace-base` info to the debugger. (ert--run-test-internal): Use `handler-bind` rather than let-binding `debugger` and `debug-on-error`. * lisp/emacs-lisp/ert-x.el (ert-remote-temporary-file-directory): Don't use `defconst` if it's not meant to stay constant (e.g. we let-bind it in tramp-tests.el). --- lisp/emacs-lisp/ert-x.el | 2 +- lisp/emacs-lisp/ert.el | 139 ++++++++++++++++++----------------------------- 2 files changed, 55 insertions(+), 86 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 05da0f1844e..a6d2fe4a1da 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -543,7 +543,7 @@ The same keyword arguments are supported as in ;; If this defconst is used in a test file, `tramp' shall be loaded ;; prior `ert-x'. There is no default value on w32 systems, which ;; could work out of the box. -(defconst ert-remote-temporary-file-directory +(defvar ert-remote-temporary-file-directory (when (featurep 'tramp) (cond ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY")) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 353c1bd09d2..8ab57d2b238 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -278,14 +278,6 @@ DATA is displayed to the user and should state the reason for skipping." (when ert--should-execution-observer (funcall ert--should-execution-observer form-description))) -;; See Bug#24402 for why this exists -(defun ert--should-signal-hook (error-symbol data) - "Stupid hack to stop `condition-case' from catching ert signals. -It should only be stopped when ran from inside `ert--run-test-internal'." - (when (and (not (symbolp debugger)) ; only run on anonymous debugger - (memq error-symbol '(ert-test-failed ert-test-skipped))) - (funcall debugger 'error (cons error-symbol data)))) - (defun ert--special-operator-p (thing) "Return non-nil if THING is a symbol naming a special operator." (and (symbolp thing) @@ -324,8 +316,7 @@ It should only be stopped when ran from inside `ert--run-test-internal'." (default-value (gensym "ert-form-evaluation-aborted-"))) `(let* ((,fn (function ,fn-name)) (,args (condition-case err - (let ((signal-hook-function #'ert--should-signal-hook)) - (list ,@arg-forms)) + (list ,@arg-forms) (error (progn (setq ,fn #'signal) (list (car err) (cdr err))))))) @@ -728,78 +719,68 @@ in front of the value of MESSAGE-FORM." ;; value and test execution should be terminated. Should not ;; return. (exit-continuation (cl-assert nil)) - ;; The binding of `debugger' outside of the execution of the test. - next-debugger ;; The binding of `ert-debug-on-error' that is in effect for the ;; execution of the current test. We store it to avoid being ;; affected by any new bindings the test itself may establish. (I ;; don't remember whether this feature is important.) ert-debug-on-error) -(defun ert--run-test-debugger (info args) - "During a test run, `debugger' is bound to a closure that calls this function. +(defun ert--run-test-debugger (info condition debugfun) + "Error handler used during the test run. This function records failures and errors and either terminates the test silently or calls the interactive debugger, as appropriate. -INFO is the ert--test-execution-info corresponding to this test -run. ARGS are the arguments to `debugger'." - (cl-destructuring-bind (first-debugger-arg &rest more-debugger-args) - args - (cl-ecase first-debugger-arg - ((lambda debug t exit nil) - (apply (ert--test-execution-info-next-debugger info) args)) - (error - (let* ((condition (car more-debugger-args)) - (type (cl-case (car condition) - ((quit) 'quit) - ((ert-test-skipped) 'skipped) - (otherwise 'failed))) - ;; We store the backtrace in the result object for - ;; `ert-results-pop-to-backtrace-for-test-at-point'. - ;; This means we have to limit `print-level' and - ;; `print-length' when printing result objects. That - ;; might not be worth while when we can also use - ;; `ert-results-rerun-test-at-point-debugging-errors', - ;; (i.e., when running interactively) but having the - ;; backtrace ready for printing is important for batch - ;; use. - ;; - ;; Grab the frames above the debugger. - (backtrace (cdr (backtrace-get-frames debugger))) - (infos (reverse ert--infos))) - (setf (ert--test-execution-info-result info) - (cl-ecase type - (quit - (make-ert-test-quit :condition condition - :backtrace backtrace - :infos infos)) - (skipped - (make-ert-test-skipped :condition condition - :backtrace backtrace - :infos infos)) - (failed - (make-ert-test-failed :condition condition - :backtrace backtrace - :infos infos)))) - ;; Work around Emacs's heuristic (in eval.c) for detecting - ;; errors in the debugger. - (cl-incf num-nonmacro-input-events) - ;; FIXME: We should probably implement more fine-grained - ;; control a la non-t `debug-on-error' here. - (cond - ((ert--test-execution-info-ert-debug-on-error info) - (apply (ert--test-execution-info-next-debugger info) args)) - (t)) - (funcall (ert--test-execution-info-exit-continuation info))))))) +INFO is the `ert--test-execution-info' corresponding to this test run. +ERR is the error object." + (let* ((type (cl-case (car condition) + ((quit) 'quit) + ((ert-test-skipped) 'skipped) + (otherwise 'failed))) + ;; We store the backtrace in the result object for + ;; `ert-results-pop-to-backtrace-for-test-at-point'. + ;; This means we have to limit `print-level' and + ;; `print-length' when printing result objects. That + ;; might not be worth while when we can also use + ;; `ert-results-rerun-test-at-point-debugging-errors', + ;; (i.e., when running interactively) but having the + ;; backtrace ready for printing is important for batch + ;; use. + ;; + ;; Grab the frames above ourselves. + (backtrace (cdr (backtrace-get-frames debugfun))) + (infos (reverse ert--infos))) + (setf (ert--test-execution-info-result info) + (cl-ecase type + (quit + (make-ert-test-quit :condition condition + :backtrace backtrace + :infos infos)) + (skipped + (make-ert-test-skipped :condition condition + :backtrace backtrace + :infos infos)) + (failed + (make-ert-test-failed :condition condition + :backtrace backtrace + :infos infos)))) + ;; FIXME: We should probably implement more fine-grained + ;; control a la non-t `debug-on-error' here. + (cond + ((ert--test-execution-info-ert-debug-on-error info) + ;; The `debugfun' arg tells `debug' which backtrace frame starts + ;; the "entering the debugger" code so it can hide those frames + ;; from the backtrace. + (funcall debugger 'error condition :backtrace-base debugfun)) + (t)) + (funcall (ert--test-execution-info-exit-continuation info)))) (defun ert--run-test-internal (test-execution-info) "Low-level function to run a test according to TEST-EXECUTION-INFO. This mainly sets up debugger-related bindings." - (setf (ert--test-execution-info-next-debugger test-execution-info) debugger - (ert--test-execution-info-ert-debug-on-error test-execution-info) + (setf (ert--test-execution-info-ert-debug-on-error test-execution-info) ert-debug-on-error) (catch 'ert--pass ;; For now, each test gets its own temp buffer and its own @@ -807,26 +788,14 @@ This mainly sets up debugger-related bindings." ;; too expensive, we can remove it. (with-temp-buffer (save-window-excursion - ;; FIXME: Use `signal-hook-function' instead of `debugger' to - ;; handle ert errors. Once that's done, remove - ;; `ert--should-signal-hook'. See Bug#24402 and Bug#11218 for - ;; details. - (let ((lexical-binding t) - (debugger (lambda (&rest args) - (ert--run-test-debugger test-execution-info - args))) - (debug-on-error t) - ;; Don't infloop if the error being called is erroring - ;; out, and we have `debug-on-error' bound to nil inside - ;; the test. - (backtrace-on-error-noninteractive nil) - (debug-on-quit t) - ;; FIXME: Do we need to store the old binding of this - ;; and consider it in `ert--run-test-debugger'? - (debug-ignored-errors nil) + (let ((lexical-binding t) ;;FIXME: Why? (ert--infos '())) - (funcall (ert-test-body (ert--test-execution-info-test - test-execution-info)))))) + (letrec ((debugfun (lambda (err) + (ert--run-test-debugger test-execution-info + err debugfun)))) + (handler-bind (((error quit) debugfun)) + (funcall (ert-test-body (ert--test-execution-info-test + test-execution-info)))))))) (ert-pass)) (setf (ert--test-execution-info-result test-execution-info) (make-ert-test-passed)) -- cgit v1.2.3 From 80b081a0ac72a5a9e459af6c96f5b0226a79894f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 19 Dec 2023 19:46:47 -0500 Subject: startup.el: Use `handler-bind` to implement `--debug-init` This provides a more reliable fix for bug#65267 since we don't touch `debug-on-error` nor `debug-ignore-errors` any more. * lisp/startup.el (startup--debug): New function. (startup--load-user-init-file): Use it and `handler-bind` instead of let-binding `debug-on-error`. --- lisp/startup.el | 221 +++++++++++++++++++++++++------------------------------- 1 file changed, 97 insertions(+), 124 deletions(-) (limited to 'lisp') diff --git a/lisp/startup.el b/lisp/startup.el index 1abbb260e30..4040d5d3774 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -393,7 +393,7 @@ If this is nil, Emacs uses `system-name'." "The email address of the current user. This defaults to either: the value of EMAIL environment variable; or user@host, using `user-login-name' and `mail-host-address' (or `system-name')." - :initialize 'custom-initialize-delay + :initialize #'custom-initialize-delay :set-after '(mail-host-address) :type 'string :group 'mail) @@ -492,7 +492,7 @@ DIRS are relative." (setq tail (cdr tail))) ;;Splice the new section in. (when tail - (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail)))))) + (setcdr tail (append (mapcar #'expand-file-name dirs) (cdr tail)))))) ;; The default location for XDG-convention Emacs init files. (defconst startup--xdg-config-default "~/.config/emacs/") @@ -1019,6 +1019,9 @@ If STYLE is nil, display appropriately for the terminal." (when standard-display-table (aset standard-display-table char nil))))))) +(defun startup--debug (err) + (funcall debugger 'error err :backtrace-base #'startup--debug)) + (defun startup--load-user-init-file (filename-function &optional alternate-filename-function load-defaults) "Load a user init-file. @@ -1032,124 +1035,94 @@ is non-nil. This function sets `user-init-file' to the name of the loaded init-file, or to a default value if loading is not possible." - (let ((debug-on-error-from-init-file nil) - (debug-on-error-should-be-set nil) - (debug-on-error-initial - (if (eq init-file-debug t) - 'startup--witness ;Dummy but recognizable non-nil value. - init-file-debug)) - (d-i-e-from-init-file nil) - (d-i-e-initial - ;; Use (startup--witness) instead of nil, so we can detect when the - ;; init files set `debug-ignored-errors' to nil. - (if init-file-debug '(startup--witness) debug-ignored-errors)) - (d-i-e-standard debug-ignored-errors) - ;; The init file might contain byte-code with embedded NULs, - ;; which can cause problems when read back, so disable nul - ;; byte detection. (Bug#52554) - (inhibit-null-byte-detection t)) - (let ((debug-on-error debug-on-error-initial) - ;; If they specified --debug-init, enter the debugger - ;; on any error whatsoever. - (debug-ignored-errors d-i-e-initial)) - (condition-case-unless-debug error - (when init-file-user - (let ((init-file-name (funcall filename-function))) - - ;; If `user-init-file' is t, then `load' will store - ;; the name of the file that it loads into - ;; `user-init-file'. - (setq user-init-file t) - (when init-file-name - (load (if (equal (file-name-extension init-file-name) - "el") - (file-name-sans-extension init-file-name) - init-file-name) - 'noerror 'nomessage)) - - (when (and (eq user-init-file t) alternate-filename-function) - (let ((alt-file (funcall alternate-filename-function))) - (unless init-file-name - (setq init-file-name alt-file)) - (and (equal (file-name-extension alt-file) "el") - (setq alt-file (file-name-sans-extension alt-file))) - (load alt-file 'noerror 'nomessage))) - - ;; If we did not find the user's init file, set - ;; user-init-file conclusively. Don't let it be - ;; set from default.el. - (when (eq user-init-file t) - (setq user-init-file init-file-name))) - - ;; If we loaded a compiled file, set `user-init-file' to - ;; the source version if that exists. - (if (equal (file-name-extension user-init-file) "elc") - (let* ((source (file-name-sans-extension user-init-file)) - (alt (concat source ".el"))) - (setq source (cond ((file-exists-p alt) alt) - ((file-exists-p source) source) - (t nil))) - (when source - (when (file-newer-than-file-p source user-init-file) - (message "Warning: %s is newer than %s" - source user-init-file) - (sit-for 1)) - (setq user-init-file source))) - ;; Else, perhaps the user init file was compiled - (when (and (equal (file-name-extension user-init-file) "eln") - ;; The next test is for builds without native - ;; compilation support or builds with unexec. - (boundp 'comp-eln-to-el-h)) - (if-let (source (gethash (file-name-nondirectory user-init-file) - comp-eln-to-el-h)) - ;; source exists or the .eln file would not load - (setq user-init-file source) - (message "Warning: unknown source file for init file %S" - user-init-file) - (sit-for 1)))) - - (when (and load-defaults - (not inhibit-default-init)) - ;; Prevent default.el from changing the value of - ;; `inhibit-startup-screen'. - (let ((inhibit-startup-screen nil)) - (load "default" 'noerror 'nomessage)))) - (error - (display-warning - 'initialization - (format-message "\ + ;; The init file might contain byte-code with embedded NULs, + ;; which can cause problems when read back, so disable nul + ;; byte detection. (Bug#52554) + (let ((inhibit-null-byte-detection t) + (body + (lambda () + (condition-case-unless-debug error + (when init-file-user + (let ((init-file-name (funcall filename-function))) + + ;; If `user-init-file' is t, then `load' will store + ;; the name of the file that it loads into + ;; `user-init-file'. + (setq user-init-file t) + (when init-file-name + (load (if (equal (file-name-extension init-file-name) + "el") + (file-name-sans-extension init-file-name) + init-file-name) + 'noerror 'nomessage)) + + (when (and (eq user-init-file t) alternate-filename-function) + (let ((alt-file (funcall alternate-filename-function))) + (unless init-file-name + (setq init-file-name alt-file)) + (and (equal (file-name-extension alt-file) "el") + (setq alt-file (file-name-sans-extension alt-file))) + (load alt-file 'noerror 'nomessage))) + + ;; If we did not find the user's init file, set + ;; user-init-file conclusively. Don't let it be + ;; set from default.el. + (when (eq user-init-file t) + (setq user-init-file init-file-name))) + + ;; If we loaded a compiled file, set `user-init-file' to + ;; the source version if that exists. + (if (equal (file-name-extension user-init-file) "elc") + (let* ((source (file-name-sans-extension user-init-file)) + (alt (concat source ".el"))) + (setq source (cond ((file-exists-p alt) alt) + ((file-exists-p source) source) + (t nil))) + (when source + (when (file-newer-than-file-p source user-init-file) + (message "Warning: %s is newer than %s" + source user-init-file) + (sit-for 1)) + (setq user-init-file source))) + ;; Else, perhaps the user init file was compiled + (when (and (equal (file-name-extension user-init-file) "eln") + ;; The next test is for builds without native + ;; compilation support or builds with unexec. + (boundp 'comp-eln-to-el-h)) + (if-let (source (gethash (file-name-nondirectory + user-init-file) + comp-eln-to-el-h)) + ;; source exists or the .eln file would not load + (setq user-init-file source) + (message "Warning: unknown source file for init file %S" + user-init-file) + (sit-for 1)))) + + (when (and load-defaults + (not inhibit-default-init)) + ;; Prevent default.el from changing the value of + ;; `inhibit-startup-screen'. + (let ((inhibit-startup-screen nil)) + (load "default" 'noerror 'nomessage)))) + (error + (display-warning + 'initialization + (format-message "\ An error occurred while loading `%s':\n\n%s%s%s\n\n\ To ensure normal operation, you should investigate and remove the cause of the error in your initialization file. Start Emacs with the `--debug-init' option to view a complete error backtrace." - user-init-file - (get (car error) 'error-message) - (if (cdr error) ": " "") - (mapconcat (lambda (s) (prin1-to-string s t)) - (cdr error) ", ")) - :warning) - (setq init-file-had-error t))) - - ;; If we can tell that the init file altered debug-on-error, - ;; arrange to preserve the value that it set up. - (unless (eq debug-ignored-errors d-i-e-initial) - (if (memq 'startup--witness debug-ignored-errors) - ;; The init file wants to add errors to the standard - ;; value, so we need to emulate that. - (setq d-i-e-from-init-file - (list (append d-i-e-standard - (remq 'startup--witness - debug-ignored-errors)))) - ;; The init file _replaces_ the standard value. - (setq d-i-e-from-init-file (list debug-ignored-errors)))) - (or (eq debug-on-error debug-on-error-initial) - (setq debug-on-error-should-be-set t - debug-on-error-from-init-file debug-on-error))) - - (when d-i-e-from-init-file - (setq debug-ignored-errors (car d-i-e-from-init-file))) - (when debug-on-error-should-be-set - (setq debug-on-error debug-on-error-from-init-file)))) + user-init-file + (get (car error) 'error-message) + (if (cdr error) ": " "") + (mapconcat (lambda (s) (prin1-to-string s t)) + (cdr error) ", ")) + :warning) + (setq init-file-had-error t)))))) + (if (eq init-file-debug t) + (handler-bind ((error #'startup--debug)) + (funcall body)) + (funcall body)))) (defvar lisp-directory nil "Directory where Emacs's own *.el and *.elc Lisp files are installed.") @@ -1445,7 +1418,7 @@ please check its value") (error (princ (if (eq (car error) 'error) - (apply 'concat (cdr error)) + (apply #'concat (cdr error)) (if (memq 'file-error (get (car error) 'error-conditions)) (format "%s: %s" (nth 1 error) @@ -1897,10 +1870,10 @@ Each element in the list should be a list of strings or pairs (let ((map (make-sparse-keymap))) (suppress-keymap map) (set-keymap-parent map button-buffer-map) - (define-key map "\C-?" 'scroll-down-command) - (define-key map [?\S-\ ] 'scroll-down-command) - (define-key map " " 'scroll-up-command) - (define-key map "q" 'exit-splash-screen) + (define-key map "\C-?" #'scroll-down-command) + (define-key map [?\S-\ ] #'scroll-down-command) + (define-key map " " #'scroll-up-command) + (define-key map "q" #'exit-splash-screen) map) "Keymap for splash screen buffer.") @@ -2338,7 +2311,7 @@ To quit a partially entered command, type Control-g.\n") ;; If C-h can't be invoked, temporarily disable its ;; binding, so where-is uses alternative bindings. (let ((map (make-sparse-keymap))) - (define-key map [?\C-h] 'undefined) + (define-key map [?\C-h] #'undefined) map)) minor-mode-overriding-map-alist))) @@ -2530,8 +2503,8 @@ A fancy display is used on graphic displays, normal otherwise." (fancy-about-screen) (normal-splash-screen nil))) -(defalias 'about-emacs 'display-about-screen) -(defalias 'display-splash-screen 'display-startup-screen) +(defalias 'about-emacs #'display-about-screen) +(defalias 'display-splash-screen #'display-startup-screen) ;; This avoids byte-compiler warning in the unexec build. (declare-function pdumper-stats "pdumper.c" ()) -- cgit v1.2.3 From 604e34338f3b5a31439020c6704f9f9d07d17d69 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 20 Dec 2023 23:31:39 -0500 Subject: Move batch backtrace code to `top_level_2` Move ad-hoc code meant to ease debugging of bootstrap (and batch mode) to `top_level_2` so it doesn't pollute `signal_or_quit`. * src/lisp.h (pop_handler, push_handler_bind): Declare. * src/keyboard.c (top_level_2): Setup an error handler to call `debug-early` when noninteractive. * src/eval.c (pop_handler): Not static any more. (signal_or_quit): Remove special case for noninteractive use. (push_handler_bind): New function, extracted from `Fhandler_bind_1`. (Fhandler_bind_1): Use it. (syms_of_eval): Declare `Qdebug_early__handler`. * lisp/emacs-lisp/debug-early.el (debug-early-backtrace): Weed out frames below `debug-early`. (debug-early--handler): New function. --- lisp/emacs-lisp/debug-early.el | 4 ++++ src/eval.c | 38 ++++++++++++++------------------------ src/keyboard.c | 12 +++++++++++- src/lisp.h | 2 ++ 4 files changed, 31 insertions(+), 25 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/debug-early.el b/lisp/emacs-lisp/debug-early.el index f2eb8792bfa..464c2e96927 100644 --- a/lisp/emacs-lisp/debug-early.el +++ b/lisp/emacs-lisp/debug-early.el @@ -94,4 +94,8 @@ available before `debug' was usable.)" (prin1 (cdr (car (cdr args)))) ; The error data. (debug-early-backtrace))) +(defalias 'debug-early--handler ;Called from C. + #'(lambda (err) + (if backtrace-on-error-noninteractive (debug-early 'error err)))) + ;;; debug-early.el ends here. diff --git a/src/eval.c b/src/eval.c index 595267f7686..7e578a1aa05 100644 --- a/src/eval.c +++ b/src/eval.c @@ -317,6 +317,7 @@ call_debugger (Lisp_Object arg) /* Interrupting redisplay and resuming it later is not safe under all circumstances. So, when the debugger returns, abort the interrupted redisplay by going back to the top-level. */ + /* FIXME: Move this to the redisplay code? */ if (debug_while_redisplaying && !EQ (Vdebugger, Qdebug_early)) Ftop_level (); @@ -1198,7 +1199,7 @@ usage: (catch TAG BODY...) */) #define clobbered_eassert(E) verify (sizeof (E) != 0) -static void +void pop_handler (void) { handlerlist = handlerlist->next; @@ -1367,6 +1368,16 @@ usage: (condition-case VAR BODYFORM &rest HANDLERS) */) return internal_lisp_condition_case (var, bodyform, handlers); } +void +push_handler_bind (Lisp_Object conditions, Lisp_Object handler, int skip) +{ + if (!CONSP (conditions)) + conditions = Fcons (conditions, Qnil); + struct handler *c = push_handler (conditions, HANDLER_BIND); + c->val = handler; + c->bytecode_dest = skip; +} + DEFUN ("handler-bind-1", Fhandler_bind_1, Shandler_bind_1, 1, MANY, 0, doc: /* Setup error handlers around execution of BODYFUN. BODYFUN be a function and it is called with no arguments. @@ -1392,11 +1403,7 @@ usage: (handler-bind BODYFUN [CONDITIONS HANDLER]...) */) Lisp_Object conditions = args[i], handler = args[i + 1]; if (NILP (conditions)) continue; - else if (!CONSP (conditions)) - conditions = Fcons (conditions, Qnil); - struct handler *c = push_handler (conditions, HANDLER_BIND); - c->val = handler; - c->bytecode_dest = count++; + push_handler_bind (conditions, handler, count++); } Lisp_Object ret = call0 (bodyfun); for (; count > 0; count--) @@ -1885,24 +1892,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) return Qnil; } - /* If we're in batch mode, print a backtrace unconditionally to help - with debugging. Make sure to use `debug-early' unconditionally - to not interfere with ERT or other packages that install custom - debuggers. */ - /* FIXME: This could be turned into a `handler-bind` at toplevel? */ - if (!debugger_called && !NILP (error_symbol) - && (NILP (clause) || EQ (clause, Qerror)) - && noninteractive && backtrace_on_error_noninteractive - && NILP (Vinhibit_debugger) - && !NILP (Ffboundp (Qdebug_early))) - { - max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); - specpdl_ref count = SPECPDL_INDEX (); - specbind (Qdebugger, Qdebug_early); - call_debugger (list2 (Qerror, Fcons (error_symbol, data))); - unbind_to (count, Qnil); - } - /* If an error is signaled during a Lisp hook in redisplay, write a backtrace into the buffer *Redisplay-trace*. */ /* FIXME: Turn this into a `handler-bind` installed during redisplay? */ @@ -4392,6 +4381,7 @@ before making `inhibit-quit' nil. */); DEFSYM (QCdocumentation, ":documentation"); DEFSYM (Qdebug, "debug"); DEFSYM (Qdebug_early, "debug-early"); + DEFSYM (Qdebug_early__handler, "debug-early--handler"); DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger, doc: /* Non-nil means never enter the debugger. diff --git a/src/keyboard.c b/src/keyboard.c index 4555b71abe7..816147c9130 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1163,7 +1163,17 @@ command_loop_2 (Lisp_Object handlers) static Lisp_Object top_level_2 (void) { - return Feval (Vtop_level, Qnil); + /* If we're in batch mode, print a backtrace unconditionally when + encountering an error, to help with debugging. */ + bool setup_handler = noninteractive; + if (setup_handler) + push_handler_bind (list1 (Qerror), Qdebug_early__handler, 0); + + Lisp_Object res = Feval (Vtop_level, Qnil); + + if (setup_handler) + pop_handler (); + return res; } static Lisp_Object diff --git a/src/lisp.h b/src/lisp.h index 2b30326abfc..0e082d14a40 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4570,6 +4570,8 @@ extern Lisp_Object internal_condition_case_n extern Lisp_Object internal_catch_all (Lisp_Object (*) (void *), void *, Lisp_Object (*) (enum nonlocal_exit, Lisp_Object)); extern struct handler *push_handler (Lisp_Object, enum handlertype) ATTRIBUTE_RETURNS_NONNULL; +extern void pop_handler (void); +extern void push_handler_bind (Lisp_Object, Lisp_Object, int); extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype); extern void specbind (Lisp_Object, Lisp_Object); extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object); -- cgit v1.2.3 From a5dcc1abea32abc906abfb66599c280b01d6ba27 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 25 Dec 2023 23:55:53 -0500 Subject: (macroexp--with-extended-form-stack): Use plain `let` `macroexp--with-extended-form-stack` used manual push/pop so that upon non-local exits the "deeper" value is kept, so the error handler gets to know what was the deeper value, so as to be able to compute more precise error locations. Replace this with a `handler-bind` which catches that "deeper" value more explicitly. * lisp/emacs-lisp/bytecomp.el (bytecomp--displaying-warnings): Use `handler-bind` to catch the value of `byte-compile-form-stack` at the time of the error. Also consolidate the duplicated code. * lisp/emacs-lisp/macroexp.el (macroexp--with-extended-form-stack): Use a plain dynbound let-rebinding. --- lisp/emacs-lisp/bytecomp.el | 41 +++++++++++++++++++++++------------------ lisp/emacs-lisp/macroexp.el | 10 ++-------- 2 files changed, 25 insertions(+), 26 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1ef3f0fba6d..e36a79aaa8e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1874,39 +1874,44 @@ It is too wide if it has any lines longer than the largest of (setq byte-to-native-plist-environment overriding-plist-environment))))) -(defmacro displaying-byte-compile-warnings (&rest body) +(defmacro displaying-byte-compile-warnings (&rest body) ;FIXME: Namespace! (declare (debug (def-body))) `(bytecomp--displaying-warnings (lambda () ,@body))) (defun bytecomp--displaying-warnings (body-fn) - (let* ((warning-series-started + (let* ((wrapped-body + (lambda () + (if byte-compile-debug + (funcall body-fn) + ;; Use a `handler-bind' to remember the `byte-compile-form-stack' + ;; active at the time the error is signaled, so as to + ;; get more precise error locations. + (let ((form-stack nil)) + (condition-case error-info + (handler-bind + ((error (lambda (_err) + (setq form-stack byte-compile-form-stack)))) + (funcall body-fn)) + (error (let ((byte-compile-form-stack form-stack)) + (byte-compile-report-error error-info)))))))) + (warning-series-started (and (markerp warning-series) (eq (marker-buffer warning-series) (get-buffer byte-compile-log-buffer)))) (byte-compile-form-stack byte-compile-form-stack)) - (if (or (eq warning-series 'byte-compile-warning-series) + (if (or (eq warning-series #'byte-compile-warning-series) warning-series-started) ;; warning-series does come from compilation, ;; so don't bind it, but maybe do set it. - (let (tem) - ;; Log the file name. Record position of that text. - (setq tem (byte-compile-log-file)) + (let ((tem (byte-compile-log-file))) ;; Log the file name. (unless warning-series-started - (setq warning-series (or tem 'byte-compile-warning-series))) - (if byte-compile-debug - (funcall body-fn) - (condition-case error-info - (funcall body-fn) - (error (byte-compile-report-error error-info))))) + (setq warning-series (or tem #'byte-compile-warning-series))) + (funcall wrapped-body)) ;; warning-series does not come from compilation, so bind it. (let ((warning-series ;; Log the file name. Record position of that text. - (or (byte-compile-log-file) 'byte-compile-warning-series))) - (if byte-compile-debug - (funcall body-fn) - (condition-case error-info - (funcall body-fn) - (error (byte-compile-report-error error-info)))))))) + (or (byte-compile-log-file) #'byte-compile-warning-series))) + (funcall wrapped-body))))) ;;;###autoload (defun byte-force-recompile (directory) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 0e4fd3ea521..b87b749dd76 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -42,14 +42,8 @@ condition-case handling a signaled error.") (defmacro macroexp--with-extended-form-stack (expr &rest body) "Evaluate BODY with EXPR pushed onto `byte-compile-form-stack'." (declare (indent 1)) - ;; FIXME: We really should just be using a simple dynamic let-binding here, - ;; but these explicit push and pop make the extended stack value visible - ;; to error handlers. Remove that need for that! - `(progn - (push ,expr byte-compile-form-stack) - (prog1 - (progn ,@body) - (pop byte-compile-form-stack)))) + `(let ((byte-compile-form-stack (cons ,expr byte-compile-form-stack))) + ,@body)) ;; Bound by the top-level `macroexpand-all', and modified to include any ;; macros defined by `defmacro'. -- cgit v1.2.3 From 391c208aecc44fd82c599696d47a18782f2f36da Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 25 Dec 2023 21:41:08 -0500 Subject: (backtrace-on-redisplay-error): Use `handler-bind` Reimplement `backtrace-on-redisplay-error` using `push_handler_bind`. This moves the code from `signal_or_quit` to `xdisp.c` and `debug-early.el`. * lisp/emacs-lisp/debug-early.el (debug-early-backtrace): Add `base` arg to strip "internal" frames. (debug--early): New function, extracted from `debug-early`. (debug-early, debug-early--handler): Use it. (debug-early--muted): New function, extracted (translated) from `signal_or_quit`; trim the buffer to a max of 10 backtraces. * src/xdisp.c (funcall_with_backtraces): New function. (dsafe_calln): Use it. (syms_of_xdisp): Defsym `Qdebug_early__muted`. * src/eval.c (redisplay_deep_handler): Delete var. (init_eval, internal_condition_case_n): Don't set it any more. (backtrace_yet): Delete var. (signal_or_quit): Remove special case for `backtrace_on_redisplay_error`. * src/keyboard.c (command_loop_1): Don't set `backtrace_yet` any more. * src/lisp.h (backtrace_yet): Don't declare. --- lisp/emacs-lisp/debug-early.el | 83 +++++++++++++++++++++++++++++------------- src/eval.c | 67 +++------------------------------- src/keyboard.c | 4 +- src/lisp.h | 1 - src/xdisp.c | 20 +++++++++- 5 files changed, 84 insertions(+), 91 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/debug-early.el b/lisp/emacs-lisp/debug-early.el index 464c2e96927..8a0dddc2679 100644 --- a/lisp/emacs-lisp/debug-early.el +++ b/lisp/emacs-lisp/debug-early.el @@ -27,14 +27,17 @@ ;; This file dumps a backtrace on stderr when an error is thrown. It ;; has no dependencies on any Lisp libraries and is thus used for ;; generating backtraces for bugs in the early parts of bootstrapping. -;; It is also always used in batch model. It was introduced in Emacs +;; It is also always used in batch mode. It was introduced in Emacs ;; 29, before which there was no backtrace available during early ;; bootstrap. ;;; Code: +;; For bootstrap reasons, we cannot use any macros here since they're +;; not defined yet. + (defalias 'debug-early-backtrace - #'(lambda () + #'(lambda (&optional base) "Print a trace of Lisp function calls currently active. The output stream used is the value of `standard-output'. @@ -51,26 +54,39 @@ of the build process." (require 'cl-print) (error nil))) #'cl-prin1 - #'prin1))) + #'prin1)) + (first t)) (mapbacktrace #'(lambda (evald func args _flags) - (let ((args args)) - (if evald + (if first + ;; The first is the debug-early entry point itself. + (setq first nil) + (let ((args args)) + (if evald + (progn + (princ " ") + (funcall prin1 func) + (princ "(")) (progn - (princ " ") - (funcall prin1 func) - (princ "(")) - (progn - (princ " (") - (setq args (cons func args)))) - (if args - (while (progn - (funcall prin1 (car args)) - (setq args (cdr args))) - (princ " "))) - (princ ")\n"))))))) - -(defalias 'debug-early + (princ " (") + (setq args (cons func args)))) + (if args + (while (progn + (funcall prin1 (car args)) + (setq args (cdr args))) + (princ " "))) + (princ ")\n")))) + base)))) + +(defalias 'debug--early + #'(lambda (error base) + (princ "\nError: ") + (prin1 (car error)) ; The error symbol. + (princ " ") + (prin1 (cdr error)) ; The error data. + (debug-early-backtrace base))) + +(defalias 'debug-early ;Called from C. #'(lambda (&rest args) "Print an error message with a backtrace of active Lisp function calls. The output stream used is the value of `standard-output'. @@ -88,14 +104,31 @@ support the latter, except in batch mode which always uses \(In versions of Emacs prior to Emacs 29, no backtrace was available before `debug' was usable.)" - (princ "\nError: ") - (prin1 (car (car (cdr args)))) ; The error symbol. - (princ " ") - (prin1 (cdr (car (cdr args)))) ; The error data. - (debug-early-backtrace))) + (debug--early (car (cdr args)) #'debug-early))) ; The error object. (defalias 'debug-early--handler ;Called from C. #'(lambda (err) - (if backtrace-on-error-noninteractive (debug-early 'error err)))) + (if backtrace-on-error-noninteractive + (debug--early err #'debug-early--handler)))) + +(defalias 'debug-early--muted ;Called from C. + #'(lambda (err) + (save-current-buffer + (set-buffer (get-buffer-create "*Redisplay-trace*")) + (goto-char (point-max)) + (if (bobp) nil + (let ((separator "\n\n\n\n")) + (save-excursion + ;; The C code tested `backtrace_yet', instead we + ;; keep a max of 10 backtraces. + (if (search-backward separator nil t 10) + (delete-region (point-min) (match-end 0)))) + (insert separator))) + (insert "-- Caught at " (current-time-string) "\n") + (let ((standard-output (current-buffer))) + (debug--early err #'debug-early--muted)) + (setq delayed-warnings-list + (cons '(error "Error in a redisplay Lisp hook. See buffer *Redisplay-trace*") + delayed-warnings-list))))) ;;; debug-early.el ends here. diff --git a/src/eval.c b/src/eval.c index 1dd797063eb..94f6d8e31f8 100644 --- a/src/eval.c +++ b/src/eval.c @@ -57,12 +57,6 @@ Lisp_Object Vrun_hooks; /* FIXME: We should probably get rid of this! */ Lisp_Object Vsignaling_function; -/* The handler structure which will catch errors in Lisp hooks called - from redisplay. We do not use it for this; we compare it with the - handler which is about to be used in signal_or_quit, and if it - matches, cause a backtrace to be generated. */ -static struct handler *redisplay_deep_handler; - /* These would ordinarily be static, but they need to be visible to GDB. */ bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE; Lisp_Object *backtrace_args (union specbinding *) EXTERNALLY_VISIBLE; @@ -244,7 +238,6 @@ init_eval (void) lisp_eval_depth = 0; /* This is less than the initial value of num_nonmacro_input_events. */ when_entered_debugger = -1; - redisplay_deep_handler = NULL; } static void @@ -1611,16 +1604,12 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *), ptrdiff_t nargs, Lisp_Object *args)) { - struct handler *old_deep = redisplay_deep_handler; struct handler *c = push_handler (handlers, CONDITION_CASE); - if (redisplaying_p) - redisplay_deep_handler = c; if (sys_setjmp (c->jmp)) { Lisp_Object val = handlerlist->val; clobbered_eassert (handlerlist == c); handlerlist = handlerlist->next; - redisplay_deep_handler = old_deep; return hfun (val, nargs, args); } else @@ -1628,7 +1617,6 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *), Lisp_Object val = bfun (nargs, args); eassert (handlerlist == c); handlerlist = c->next; - redisplay_deep_handler = old_deep; return val; } } @@ -1766,11 +1754,6 @@ quit (void) return signal_or_quit (Qquit, Qnil, true); } -/* Has an error in redisplay giving rise to a backtrace occurred as - yet in the current command? This gets reset in the command - loop. */ -bool backtrace_yet = false; - /* Signal an error, or quit. ERROR_SYMBOL and DATA are as with Fsignal. If CONTINUABLE, the caller allows this function to return (presumably after calling the debugger); @@ -1897,51 +1880,13 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable) return Qnil; } - /* If an error is signaled during a Lisp hook in redisplay, write a - backtrace into the buffer *Redisplay-trace*. */ - /* FIXME: Turn this into a `handler-bind` installed during redisplay? */ - if (!debugger_called && !oom - && backtrace_on_redisplay_error - && (NILP (clause) || h == redisplay_deep_handler) - && NILP (Vinhibit_debugger) - && !NILP (Ffboundp (Qdebug_early))) - { - specpdl_ref count = SPECPDL_INDEX (); - max_ensure_room (100); - AUTO_STRING (redisplay_trace, "*Redisplay-trace*"); - Lisp_Object redisplay_trace_buffer; - AUTO_STRING (gap, "\n\n\n\n"); /* Separates things in *Redisplay-trace* */ - Lisp_Object delayed_warning; - redisplay_trace_buffer = Fget_buffer_create (redisplay_trace, Qnil); - current_buffer = XBUFFER (redisplay_trace_buffer); - if (!backtrace_yet) /* Are we on the first backtrace of the command? */ - Ferase_buffer (); - else - Finsert (1, &gap); - backtrace_yet = true; - specbind (Qstandard_output, redisplay_trace_buffer); - specbind (Qdebugger, Qdebug_early); - call_debugger (list2 (Qerror, error)); - unbind_to (count, Qnil); - delayed_warning = make_string - ("Error in a redisplay Lisp hook. See buffer *Redisplay-trace*", 61); - - Vdelayed_warnings_list = Fcons (list2 (Qerror, delayed_warning), - Vdelayed_warnings_list); - } - if (!NILP (clause)) - { - unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, error); - } - else - { - if (handlerlist != handlerlist_sentinel) - /* FIXME: This will come right back here if there's no `top-level' - catcher. A better solution would be to abort here, and instead - add a catch-all condition handler so we never come here. */ - Fthrow (Qtop_level, Qt); - } + unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, error); + else if (handlerlist != handlerlist_sentinel) + /* FIXME: This will come right back here if there's no `top-level' + catcher. A better solution would be to abort here, and instead + add a catch-all condition handler so we never come here. */ + Fthrow (Qtop_level, Qt); string = Ferror_message_string (error); fatal ("%s", SDATA (string)); diff --git a/src/keyboard.c b/src/keyboard.c index aa7d732bcc3..e1d738dd6ef 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1167,9 +1167,10 @@ top_level_2 (void) encountering an error, to help with debugging. */ bool setup_handler = noninteractive; if (setup_handler) + /* FIXME: Should we (re)use `list_of_error` from `xdisp.c`? */ push_handler_bind (list1 (Qerror), Qdebug_early__handler, 0); - Lisp_Object res = Feval (Vtop_level, Qnil); + Lisp_Object res = Feval (Vtop_level, Qt); if (setup_handler) pop_handler (); @@ -1365,7 +1366,6 @@ command_loop_1 (void) display_malloc_warning (); Vdeactivate_mark = Qnil; - backtrace_yet = false; /* Don't ignore mouse movements for more than a single command loop. (This flag is set in xdisp.c whenever the tool bar is diff --git a/src/lisp.h b/src/lisp.h index 0e082d14a40..44f69892c6f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4529,7 +4529,6 @@ extern Lisp_Object Vrun_hooks; extern Lisp_Object Vsignaling_function; extern Lisp_Object inhibit_lisp_code; extern bool signal_quit_p (Lisp_Object); -extern bool backtrace_yet; /* To run a normal hook, use the appropriate function from the list below. The calling convention: diff --git a/src/xdisp.c b/src/xdisp.c index aeaf8b34652..f8670c6ecb5 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3072,10 +3072,24 @@ dsafe__call (bool inhibit_quit, Lisp_Object (f) (ptrdiff_t, Lisp_Object *), return val; } +static Lisp_Object +funcall_with_backtraces (ptrdiff_t nargs, Lisp_Object *args) +{ + /* If an error is signaled during a Lisp hook in redisplay, write a + backtrace into the buffer *Redisplay-trace*. */ + push_handler_bind (list_of_error, Qdebug_early__muted, 0); + Lisp_Object res = Ffuncall (nargs, args); + pop_handler (); + return res; +} + #define SAFE_CALLMANY(inhibit_quit, f, array) \ dsafe__call ((inhibit_quit), f, ARRAYELTS (array), array) -#define dsafe_calln(inhibit_quit, ...) \ - SAFE_CALLMANY ((inhibit_quit), Ffuncall, ((Lisp_Object []) {__VA_ARGS__})) +#define dsafe_calln(inhibit_quit, ...) \ + SAFE_CALLMANY ((inhibit_quit), \ + backtrace_on_redisplay_error \ + ? funcall_with_backtraces : Ffuncall, \ + ((Lisp_Object []) {__VA_ARGS__})) static Lisp_Object dsafe_call1 (Lisp_Object f, Lisp_Object arg) @@ -37753,6 +37767,8 @@ cursor shapes. */); DEFSYM (Qthin_space, "thin-space"); DEFSYM (Qzero_width, "zero-width"); + DEFSYM (Qdebug_early__muted, "debug-early--muted"); + DEFVAR_LISP ("pre-redisplay-function", Vpre_redisplay_function, doc: /* Function run just before redisplay. It is called with one argument, which is the set of windows that are to -- cgit v1.2.3 From 1870e2f48a7874b9a7cd627198a6079d6a3b70c0 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 4 Jan 2024 18:44:43 -0500 Subject: Avoid `defconst` for vars which we modify If we `setq` or let-bind a var, then presumably it's not a const. * lisp/bookmark.el (bookmark-bmenu-buffer): * lisp/char-fold.el (char-fold-table): * lisp/pcmpl-linux.el (pcmpl-linux-fs-modules-path-format) (pcmpl-linux-mtab-file): * lisp/emacs-lisp/bytecomp.el (byte-compile-log-buffer): * lisp/emacs-lisp/check-declare.el (check-declare-warning-buffer): * lisp/emacs-lisp/ert-x.el (ert-remote-temporary-file-directory): * lisp/erc/erc.el (erc-default-port): * lisp/net/tramp.el (tramp-unknown-id-string) (tramp-unknown-id-integer): * lisp/url/url-util.el (url-unreserved-chars): --- lisp/bookmark.el | 2 +- lisp/char-fold.el | 2 +- lisp/emacs-lisp/bytecomp.el | 4 ++-- lisp/emacs-lisp/check-declare.el | 2 +- lisp/emacs-lisp/ert-x.el | 2 +- lisp/erc/erc.el | 2 +- lisp/net/tramp.el | 6 +++--- lisp/pcmpl-linux.el | 4 ++-- lisp/url/url-util.el | 2 +- 9 files changed, 13 insertions(+), 13 deletions(-) (limited to 'lisp') diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 893fdffb7ce..60dd61a5ac8 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -142,7 +142,7 @@ Nil means don't prompt for confirmation." "Non-nil means show annotations when jumping to a bookmark." :type 'boolean) -(defconst bookmark-bmenu-buffer "*Bookmark List*" +(defvar bookmark-bmenu-buffer "*Bookmark List*" "Name of buffer used for Bookmark List.") (defvar bookmark-bmenu-use-header-line t diff --git a/lisp/char-fold.el b/lisp/char-fold.el index a620d4d8dc3..4d9644216d8 100644 --- a/lisp/char-fold.el +++ b/lisp/char-fold.el @@ -214,7 +214,7 @@ equiv)) equiv))) -(defconst char-fold-table +(defvar char-fold-table (eval-when-compile (char-fold--make-table)) "Used for folding characters of the same group during search. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1ef3f0fba6d..e940a135e51 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -262,7 +262,7 @@ This option is enabled by default because it reduces Emacs memory usage." :type 'boolean) ;;;###autoload(put 'byte-compile-dynamic-docstrings 'safe-local-variable 'booleanp) -(defconst byte-compile-log-buffer "*Compile-Log*" +(defvar byte-compile-log-buffer "*Compile-Log*" "Name of the byte-compiler's log buffer.") (defvar byte-compile--known-dynamic-vars nil @@ -1874,7 +1874,7 @@ It is too wide if it has any lines longer than the largest of (setq byte-to-native-plist-environment overriding-plist-environment))))) -(defmacro displaying-byte-compile-warnings (&rest body) +(defmacro displaying-byte-compile-warnings (&rest body) ;FIXME: namespace! (declare (debug (def-body))) `(bytecomp--displaying-warnings (lambda () ,@body))) diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el index 0362c7d2c24..8e40b227b65 100644 --- a/lisp/emacs-lisp/check-declare.el +++ b/lisp/emacs-lisp/check-declare.el @@ -40,7 +40,7 @@ ;;; Code: -(defconst check-declare-warning-buffer "*Check Declarations Warnings*" +(defvar check-declare-warning-buffer "*Check Declarations Warnings*" "Name of buffer used to display any `check-declare' warnings.") (defun check-declare-locate (file basefile) diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 05da0f1844e..a6d2fe4a1da 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -543,7 +543,7 @@ The same keyword arguments are supported as in ;; If this defconst is used in a test file, `tramp' shall be loaded ;; prior `ert-x'. There is no default value on w32 systems, which ;; could work out of the box. -(defconst ert-remote-temporary-file-directory +(defvar ert-remote-temporary-file-directory (when (featurep 'tramp) (cond ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY")) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 0565440f357..e639a6278fc 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1691,7 +1691,7 @@ Defaults to the server buffer." (defconst erc-default-server "irc.libera.chat" "IRC server to use if it cannot be detected otherwise.") -(defconst erc-default-port 6667 +(defvar erc-default-port 6667 "IRC port to use if it cannot be detected otherwise.") (defconst erc-default-port-tls 6697 diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 2f6b526039f..ad36dd53a32 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1085,10 +1085,10 @@ Derived from `tramp-postfix-host-format'.") (defconst tramp-localname-regexp (rx (* (not (any "\r\n"))) eos) "Regexp matching localnames.") -(defconst tramp-unknown-id-string "UNKNOWN" +(defvar tramp-unknown-id-string "UNKNOWN" "String used to denote an unknown user or group.") -(defconst tramp-unknown-id-integer -1 +(defvar tramp-unknown-id-integer -1 "Integer used to denote an unknown user or group.") ;;;###tramp-autoload @@ -2081,7 +2081,7 @@ without a visible progress reporter." (defmacro with-tramp-timeout (list &rest body) "Like `with-timeout', but allow SECONDS to be nil. -(fn (SECONDS TIMEOUT-FORMS...) BODY)" +\(fn (SECONDS TIMEOUT-FORMS...) BODY)" (declare (indent 1) (debug ((form body) body))) (let ((seconds (car list)) (timeout-forms (cdr list))) diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el index 3aee0b296f6..d0defc54174 100644 --- a/lisp/pcmpl-linux.el +++ b/lisp/pcmpl-linux.el @@ -61,7 +61,7 @@ (pcomplete-opt "hVanfFrsvwt(pcmpl-linux-fs-types)o?L?U?") (while (pcomplete-here (pcomplete-entries) nil #'identity))) -(defconst pcmpl-linux-fs-modules-path-format "/lib/modules/%s/kernel/fs/") +(defvar pcmpl-linux-fs-modules-path-format "/lib/modules/%s/kernel/fs/") (defun pcmpl-linux-fs-types () "Return a list of available fs modules on GNU/Linux systems." @@ -69,7 +69,7 @@ (directory-files (format pcmpl-linux-fs-modules-path-format kernel-ver)))) -(defconst pcmpl-linux-mtab-file "/etc/mtab") +(defvar pcmpl-linux-mtab-file "/etc/mtab") (defun pcmpl-linux-mounted-directories () "Return a list of mounted directory names." diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index 28d1885387d..5f45b98c7a5 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -335,7 +335,7 @@ appropriate coding-system; see `decode-coding-string'." str (substring str (match-end 0))))) (concat tmp str))) -(defconst url-unreserved-chars +(defvar url-unreserved-chars '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 -- cgit v1.2.3 From 1d40c601b3b77d3bf1ad1bdfbaf2f479ba9c4998 Mon Sep 17 00:00:00 2001 From: Graham Marlow Date: Tue, 2 Jan 2024 13:58:22 -0800 Subject: Improve yaml-ts-mode fill-paragraph (bug#68226) When using fill-paragraph on a block_scalar (the element within a block_node) fill the paragraph such that the contents remain within the block_node. This fixes the previous behavior that would clobber a block_node. * lisp/textmodes/yaml-ts-mode.el: Add yaml-ts-mode--fill-paragraph --- lisp/textmodes/yaml-ts-mode.el | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) (limited to 'lisp') diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el index 2b57b384300..08fe4c49733 100644 --- a/lisp/textmodes/yaml-ts-mode.el +++ b/lisp/textmodes/yaml-ts-mode.el @@ -117,6 +117,26 @@ '((ERROR) @font-lock-warning-face)) "Tree-sitter font-lock settings for `yaml-ts-mode'.") +(defun yaml-ts-mode--fill-paragraph (&optional justify) + "Fill paragraph. +Behaves like `fill-paragraph', but respects block node +boundaries. JUSTIFY is passed to `fill-paragraph'." + (interactive "*P") + (save-restriction + (widen) + (let ((node (treesit-node-at (point)))) + (when (string= "block_scalar" (treesit-node-type node)) + (let* ((start (treesit-node-start node)) + (end (treesit-node-end node)) + (start-marker (point-marker)) + (fill-paragraph-function nil)) + (save-excursion + (goto-char start) + (forward-line) + (move-marker start-marker (point)) + (narrow-to-region (point) end)) + (fill-region start-marker end justify)))))) + ;;;###autoload (define-derived-mode yaml-ts-mode text-mode "YAML" "Major mode for editing YAML, powered by tree-sitter." @@ -141,6 +161,8 @@ (constant escape-sequence number property) (bracket delimiter error misc-punctuation))) + (setq-local fill-paragraph-function #'yaml-ts-mode--fill-paragraph) + (treesit-major-mode-setup))) (if (treesit-ready-p 'yaml) -- cgit v1.2.3 From ba300c96fa21af2fe7b7f25d16eec0a6c0738a95 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 4 Jan 2024 22:12:14 -0500 Subject: * lisp/startup.el (startup--load-user-init-file): Fix last change Use `condition-case-unless-debug` only in the branch when `--debug-init` is not in use, otherwise it prevents `handler-bind` from triggering the debugger. --- lisp/startup.el | 156 ++++++++++++++++++++++++++++---------------------------- 1 file changed, 78 insertions(+), 78 deletions(-) (limited to 'lisp') diff --git a/lisp/startup.el b/lisp/startup.el index 4040d5d3774..23937055f30 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1041,88 +1041,88 @@ init-file, or to a default value if loading is not possible." (let ((inhibit-null-byte-detection t) (body (lambda () - (condition-case-unless-debug error - (when init-file-user - (let ((init-file-name (funcall filename-function))) - - ;; If `user-init-file' is t, then `load' will store - ;; the name of the file that it loads into - ;; `user-init-file'. - (setq user-init-file t) - (when init-file-name - (load (if (equal (file-name-extension init-file-name) - "el") - (file-name-sans-extension init-file-name) - init-file-name) - 'noerror 'nomessage)) - - (when (and (eq user-init-file t) alternate-filename-function) - (let ((alt-file (funcall alternate-filename-function))) - (unless init-file-name - (setq init-file-name alt-file)) - (and (equal (file-name-extension alt-file) "el") - (setq alt-file (file-name-sans-extension alt-file))) - (load alt-file 'noerror 'nomessage))) - - ;; If we did not find the user's init file, set - ;; user-init-file conclusively. Don't let it be - ;; set from default.el. - (when (eq user-init-file t) - (setq user-init-file init-file-name))) - - ;; If we loaded a compiled file, set `user-init-file' to - ;; the source version if that exists. - (if (equal (file-name-extension user-init-file) "elc") - (let* ((source (file-name-sans-extension user-init-file)) - (alt (concat source ".el"))) - (setq source (cond ((file-exists-p alt) alt) - ((file-exists-p source) source) - (t nil))) - (when source - (when (file-newer-than-file-p source user-init-file) - (message "Warning: %s is newer than %s" - source user-init-file) - (sit-for 1)) - (setq user-init-file source))) - ;; Else, perhaps the user init file was compiled - (when (and (equal (file-name-extension user-init-file) "eln") - ;; The next test is for builds without native - ;; compilation support or builds with unexec. - (boundp 'comp-eln-to-el-h)) - (if-let (source (gethash (file-name-nondirectory - user-init-file) - comp-eln-to-el-h)) - ;; source exists or the .eln file would not load - (setq user-init-file source) - (message "Warning: unknown source file for init file %S" - user-init-file) - (sit-for 1)))) - - (when (and load-defaults - (not inhibit-default-init)) - ;; Prevent default.el from changing the value of - ;; `inhibit-startup-screen'. - (let ((inhibit-startup-screen nil)) - (load "default" 'noerror 'nomessage)))) - (error - (display-warning - 'initialization - (format-message "\ + (when init-file-user + (let ((init-file-name (funcall filename-function))) + + ;; If `user-init-file' is t, then `load' will store + ;; the name of the file that it loads into + ;; `user-init-file'. + (setq user-init-file t) + (when init-file-name + (load (if (equal (file-name-extension init-file-name) + "el") + (file-name-sans-extension init-file-name) + init-file-name) + 'noerror 'nomessage)) + + (when (and (eq user-init-file t) alternate-filename-function) + (let ((alt-file (funcall alternate-filename-function))) + (unless init-file-name + (setq init-file-name alt-file)) + (and (equal (file-name-extension alt-file) "el") + (setq alt-file (file-name-sans-extension alt-file))) + (load alt-file 'noerror 'nomessage))) + + ;; If we did not find the user's init file, set + ;; user-init-file conclusively. Don't let it be + ;; set from default.el. + (when (eq user-init-file t) + (setq user-init-file init-file-name))) + + ;; If we loaded a compiled file, set `user-init-file' to + ;; the source version if that exists. + (if (equal (file-name-extension user-init-file) "elc") + (let* ((source (file-name-sans-extension user-init-file)) + (alt (concat source ".el"))) + (setq source (cond ((file-exists-p alt) alt) + ((file-exists-p source) source) + (t nil))) + (when source + (when (file-newer-than-file-p source user-init-file) + (message "Warning: %s is newer than %s" + source user-init-file) + (sit-for 1)) + (setq user-init-file source))) + ;; Else, perhaps the user init file was compiled + (when (and (equal (file-name-extension user-init-file) "eln") + ;; The next test is for builds without native + ;; compilation support or builds with unexec. + (boundp 'comp-eln-to-el-h)) + (if-let (source (gethash (file-name-nondirectory + user-init-file) + comp-eln-to-el-h)) + ;; source exists or the .eln file would not load + (setq user-init-file source) + (message "Warning: unknown source file for init file %S" + user-init-file) + (sit-for 1)))) + + (when (and load-defaults + (not inhibit-default-init)) + ;; Prevent default.el from changing the value of + ;; `inhibit-startup-screen'. + (let ((inhibit-startup-screen nil)) + (load "default" 'noerror 'nomessage))))))) + (if (eq init-file-debug t) + (handler-bind ((error #'startup--debug)) + (funcall body)) + (condition-case-unless-debug error + (funcall body) + (error + (display-warning + 'initialization + (format-message "\ An error occurred while loading `%s':\n\n%s%s%s\n\n\ To ensure normal operation, you should investigate and remove the cause of the error in your initialization file. Start Emacs with the `--debug-init' option to view a complete error backtrace." - user-init-file - (get (car error) 'error-message) - (if (cdr error) ": " "") - (mapconcat (lambda (s) (prin1-to-string s t)) - (cdr error) ", ")) - :warning) - (setq init-file-had-error t)))))) - (if (eq init-file-debug t) - (handler-bind ((error #'startup--debug)) - (funcall body)) - (funcall body)))) + user-init-file + (get (car error) 'error-message) + (if (cdr error) ": " "") + (mapconcat (lambda (s) (prin1-to-string s t)) + (cdr error) ", ")) + :warning) + (setq init-file-had-error t)))))) (defvar lisp-directory nil "Directory where Emacs's own *.el and *.elc Lisp files are installed.") -- cgit v1.2.3 From d490874b3416d702686bb9dd25f75441d135264a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 5 Jan 2024 09:38:58 +0200 Subject: Improve documentation of derived modes and their parents * doc/lispref/modes.texi (Derived Modes): Expand documentation of functions that manipulate parent modes of a derived mode. Document 'provided-mode-derived-p'. Improve indexing. * lisp/subr.el (derived-mode-all-parents) (derived-mode-add-parents, provided-mode-derived-p) (derived-mode-p): Doc fixes. --- doc/lispref/modes.texi | 38 +++++++++++++++++++++++++++++++++----- lisp/subr.el | 13 ++++++++++--- 2 files changed, 43 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 8c5fd63918a..1d961249633 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -809,6 +809,7 @@ modes, rather than those of the current buffer. @node Derived Modes @subsection Defining Derived Modes @cindex derived mode +@cindex parent mode The recommended way to define a new major mode is to derive it from an existing one using @code{define-derived-mode}. If there is no closely @@ -866,6 +867,9 @@ also a special mode (@pxref{Major Mode Conventions}). You can also specify @code{nil} for @var{parent}. This gives the new mode no parent. Then @code{define-derived-mode} behaves as described above, but, of course, omits all actions connected with @var{parent}. +Conversely, you can use @code{derived-mode-set-parent} and +@code{derived-mode-add-parents}, described below, to explicitly set +the ancestry of the new mode. The argument @var{docstring} specifies the documentation string for the new mode. @code{define-derived-mode} adds some general information @@ -932,6 +936,7 @@ Do not write an @code{interactive} spec in the definition; @code{define-derived-mode} does that automatically. @end defmac +@cindex ancestry, of major modes @defun derived-mode-p modes This function returns non-@code{nil} if the current major mode is derived from any of the major modes given by the list of symbols @@ -940,10 +945,28 @@ Instead of a list, @var{modes} can also be a single mode symbol. Furthermore, we still support a deprecated calling convention where the @var{modes} were passed as separate arguments. + +When examining the parent modes of the current major mode, this +function takes into consideration the current mode's parents set by +@code{define-derived-mode}, and also its additional parents set by +@code{derived-mode-add-parents}, described below. +@end defun + +@defun provided-mode-derived-p mode modes +This function returns non-@code{nil} if @var{mode} is derived from any +of the major modes given by the list of symbols in @var{modes}. Like +with @code{derived-mode-p}, @var{modes} can also be a single symbol, +and this function also supports a deprecated calling convention where +the @var{modes} were passed as separate symbol arguments. + +When examining the parent modes of @var{mode}, this function takes +into consideration the parents of @var{mode} set by +@code{define-derived-mode}, and also its additional parents set by +@code{derived-mode-add-parents}, described below. @end defun -The graph of major modes is accessed with the following lower-level -functions: +The graph of a major mode's ancestry can be accessed and modified with +the following lower-level functions: @defun derived-mode-set-parent mode parent This function declares that @var{mode} inherits from @code{parent}. @@ -956,14 +979,19 @@ by reusing @code{parent}. This function makes it possible to register additional parents beside the one that was used when defining @var{mode}. This can be used when the similarity between @var{mode} and the modes in @var{extra-parents} -is such that it makes sense to treat it as a child of those -modes for purposes like applying directory-local variables. +is such that it makes sense to treat @var{mode} as a child of those +modes for purposes like applying directory-local variables and other +mode-specific settings. The additional parent modes are specified as +a list of symbols in @var{extra-parents}. Those additional parent +modes will be considered as one of the @var{mode}s parents by +@code{derived-mode-p} and @code{provided-mode-derived-p}. @end defun @defun derived-mode-all-parents mode This function returns the list of all the modes in the ancestry of @var{mode}, ordered from the most specific to the least specific, and -starting with @var{mode} itself. +starting with @var{mode} itself. This includes the additional parent +modes, if any, added by calling @code{derived-mode-add-parents}. @end defun diff --git a/lisp/subr.el b/lisp/subr.el index 0519e56e057..df28989b399 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2737,6 +2737,8 @@ By default we choose the head of the first list." (defun derived-mode-all-parents (mode &optional known-children) "Return all the parents of MODE, starting with MODE. +This includes the parents set by `define-derived-mode' and additional +ones set by `derived-mode-add-parents'. The returned list is not fresh, don't modify it. \n(fn MODE)" ;`known-children' is for internal use only. ;; Can't use `with-memoization' :-( @@ -2785,7 +2787,9 @@ The returned list is not fresh, don't modify it. (defun provided-mode-derived-p (mode &optional modes &rest old-modes) "Non-nil if MODE is derived from a mode that is a member of the list MODES. MODES can also be a single mode instead of a list. -If you just want to check `major-mode', use `derived-mode-p'. +This examines the parent modes set by `define-derived-mode' and also +additional ones set by `derived-mode-add-parents'. +If you just want to check the current `major-mode', use `derived-mode-p'. We also still support the deprecated calling convention: \(provided-mode-derived-p MODE &rest MODES)." (declare (side-effect-free t) @@ -2799,8 +2803,10 @@ We also still support the deprecated calling convention: (car modes))) (defun derived-mode-p (&optional modes &rest old-modes) - "Non-nil if the current major mode is derived from one of MODES. + "Return non-nil if the current major mode is derived from one of MODES. MODES should be a list of symbols or a single mode symbol instead of a list. +This examines the parent modes set by `define-derived-mode' and also +additional ones set by `derived-mode-add-parents'. We also still support the deprecated calling convention: \(derived-mode-p &rest MODES)." (declare (side-effect-free t) @@ -2820,7 +2826,8 @@ We also still support the deprecated calling convention: (defun derived-mode-add-parents (mode extra-parents) "Add EXTRA-PARENTS to the parents of MODE. Declares the parents of MODE to be its main parent (as defined -in `define-derived-mode') plus EXTRA-PARENTS." +in `define-derived-mode') plus EXTRA-PARENTS, which should be a list +of symbols." (put mode 'derived-mode-extra-parents extra-parents) (derived-mode--flush mode)) -- cgit v1.2.3 From dc9d02f8a01d86ac8ff3fb004bb2f22cf211dcef Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 5 Jan 2024 09:39:04 +0200 Subject: * lisp/isearch.el (isearch-search-and-update): Let-bind 'isearch-cmds'. When 'isearch-wrap-pause' is 'no' or 'no-ding', let-bind 'isearch-cmds' to avoid changing it by 'isearch-push-state' in 'isearch-repeat', so that a later DEL (isearch-delete-char) doesn't stop at the intermediate failing state (bug#68158). --- lisp/isearch.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/isearch.el b/lisp/isearch.el index ee5660309df..f753a5377ca 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2844,7 +2844,8 @@ The command accepts Unicode names like \"smiling face\" or (isearch-search) (when (and (memq isearch-wrap-pause '(no no-ding)) (not isearch-success)) - (isearch-repeat (if isearch-forward 'forward 'backward))))) + (let ((isearch-cmds isearch-cmds)) + (isearch-repeat (if isearch-forward 'forward 'backward)))))) (isearch-push-state) (if isearch-op-fun (funcall isearch-op-fun)) (isearch-update)) -- cgit v1.2.3 From f9acf12f6f17b57265d19079e6973d167a328536 Mon Sep 17 00:00:00 2001 From: Jeremy Bryant Date: Thu, 4 Jan 2024 23:58:19 +0000 Subject: * lisp/mail/rmail.el (rmail-epa-decrypt): Fix typo (bug#68248). --- lisp/mail/rmail.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 74cf297c2fc..fb504055f1d 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4690,7 +4690,7 @@ Argument MIME is non-nil if this is a mime message." (while (search-forward "\r\n" nil t) (delete-region (- (point) 2) (- (point) 1)))))) ))) - ;; User wants to decrypt the message perenently. + ;; User wants to decrypt the message permanently. (when (eq major-mode 'rmail-mode) (rmail-add-label "decrypt")) (setq decrypts (nreverse decrypts)) -- cgit v1.2.3 From 790b5982175b8dcd45fe444379e8039b6cc05e97 Mon Sep 17 00:00:00 2001 From: Nicholas Vollmer Date: Fri, 5 Jan 2024 12:22:10 -0500 Subject: Use special-mode in checkdoc status buffer * lisp/emacs-lisp/checkdoc.el (checkdoc-display-status-buffer): Use `special-mode'. (Bug#68268) --- lisp/emacs-lisp/checkdoc.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 80eaf93c3b7..82c6c03a592 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -556,7 +556,8 @@ the users will view as each check is completed." "Display and update the status buffer for the current checkdoc mode. CHECK is a list of four strings stating the current status of each test; the nth string describes the status of the nth test." - (let (temp-buffer-setup-hook) + (let (temp-buffer-setup-hook + (temp-buffer-show-hook #'special-mode)) (with-output-to-temp-buffer "*Checkdoc Status*" (mapc #'princ (list "Buffer comments and tags: " (nth 0 check) -- cgit v1.2.3 From 2740a3cbfde65a899f2fcefceee9c4bc06eebc2d Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 5 Jan 2024 17:51:40 +0800 Subject: ; Update Android port splash screen message * lisp/term/android-win.el (android-after-splash-screen): Insert missing newline. --- lisp/term/android-win.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index 51163e5b9b2..876b24683bc 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -417,7 +417,7 @@ been denied. Click " :link '("here" android-display-storage-permission-popup) " to grant them.") (insert - "Permissions necessary to access external storage directories have been + "\nPermissions necessary to access external storage directories have been denied. ") (insert-button "Click here to grant them." 'action #'android-display-storage-permission-popup -- cgit v1.2.3 From d3a4fe5694f7bd1a09546d67d2cddc0f444d41ca Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Wed, 3 Jan 2024 11:35:25 +0100 Subject: Fix use of 'display-buffer-alist' for Info buffers * lisp/info.el (info-pop-to-buffer): New function. (info-other-window, info, Info-find-node, Info-revert-find-node) (Info-next, Info-prev, Info-up, info-display-manual): Call 'info-pop-to-buffer'. (Bug#68081) --- lisp/info.el | 67 +++++++++++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 57 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/info.el b/lisp/info.el index 39ca88c358c..f4384934155 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -732,8 +732,53 @@ in `Info-file-supports-index-cookies-list'." (read-file-name "Info file name: " nil nil t)) (if (numberp current-prefix-arg) (format "*info*<%s>" current-prefix-arg)))) - (info-setup file-or-node - (switch-to-buffer-other-window (or buffer "*info*")))) + (info-pop-to-buffer file-or-node buffer t)) + +(defun info-pop-to-buffer (&optional file-or-node buffer-or-name other-window) + "Put Info node FILE-OR-NODE in specified buffer and display it. +Optional argument FILE-OR-NODE is as for `info'. + +If the optional argument BUFFER-OR-NAME is a buffer, use that +buffer. If it is a string, use that string as the name of the +buffer, creating it if it does not exist. Otherwise, use a +buffer with the name `*info*', creating it if it does not exist. + +Optional argument OTHER-WINDOW nil means to prefer the selected +window. OTHER-WINDOW non-nil means to prefer another window. +Select the window used, if it has been made." + (let ((buffer (cond + ((bufferp buffer-or-name) + buffer-or-name) + ((stringp buffer-or-name) + (get-buffer-create buffer-or-name)) + (t + (get-buffer-create "*info*"))))) + (with-current-buffer buffer + (unless (derived-mode-p 'Info-mode) + (Info-mode))) + + (let* ((window + (display-buffer buffer + (if other-window + '(nil (inhibit-same-window . t)) + '(display-buffer-same-window))))) + (with-current-buffer buffer + (if file-or-node + ;; If argument already contains parentheses, don't add another set + ;; since the argument will then be parsed improperly. This also + ;; has the added benefit of allowing node names to be included + ;; following the parenthesized filename. + (Info-goto-node + (if (and (stringp file-or-node) (string-match "(.*)" file-or-node)) + file-or-node + (concat "(" file-or-node ")"))) + (if (and (zerop (buffer-size)) + (null Info-history)) + ;; If we just created the Info buffer, go to the directory. + (Info-directory)))) + + (when window + (select-window window))))) ;;;###autoload (put 'info 'info-file (purecopy "emacs")) ;;;###autoload @@ -768,8 +813,8 @@ See a list of available Info commands in `Info-mode'." ;; of names that might have been wrapped (in emails, etc.). (setq file-or-node (string-replace "\n" " " file-or-node))) - (info-setup file-or-node - (pop-to-buffer-same-window (or buffer "*info*")))) + + (info-pop-to-buffer file-or-node buffer)) (defun info-setup (file-or-node buffer) "Display Info node FILE-OR-NODE in BUFFER." @@ -789,6 +834,8 @@ See a list of available Info commands in `Info-mode'." ;; If we just created the Info buffer, go to the directory. (Info-directory)))) +(make-obsolete 'info-setup "use `info-pop-to-buffer' instead" "30.1") + ;;;###autoload (defun info-emacs-manual () "Display the Emacs manual in Info mode." @@ -927,7 +974,7 @@ If NOERROR, inhibit error messages when we can't find the node." (setq nodename (info--node-canonicalize-whitespace nodename)) (setq filename (Info-find-file filename noerror)) ;; Go into Info buffer. - (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) + (or (derived-mode-p 'Info-mode) (info-pop-to-buffer filename)) ;; Record the node we are leaving, if we were in one. (and (not no-going-back) Info-current-file @@ -957,7 +1004,7 @@ otherwise, that defaults to `Top'." "Go to an Info node FILENAME and NODENAME, re-reading disk contents. When *info* is already displaying FILENAME and NODENAME, the window position is preserved, if possible." - (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) + (or (derived-mode-p 'Info-mode) (info-pop-to-buffer filename)) (let ((old-filename Info-current-file) (old-nodename Info-current-node) (window-selected (eq (selected-window) (get-buffer-window))) @@ -2290,7 +2337,7 @@ This command doesn't descend into sub-nodes, like \\\\[Info-forwa (interactive nil Info-mode) ;; In case another window is currently selected (save-window-excursion - (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) + (or (derived-mode-p 'Info-mode) (info-pop-to-buffer)) (Info-goto-node (Info-extract-pointer "next")))) (defun Info-prev () @@ -2299,7 +2346,7 @@ This command doesn't go up to the parent node, like \\\\[Info-bac (interactive nil Info-mode) ;; In case another window is currently selected (save-window-excursion - (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) + (or (derived-mode-p 'Info-mode) (info-pop-to-buffer)) (Info-goto-node (Info-extract-pointer "prev[ious]*" "previous")))) (defun Info-up (&optional same-file) @@ -2308,7 +2355,7 @@ If SAME-FILE is non-nil, do not move to a different Info file." (interactive nil Info-mode) ;; In case another window is currently selected (save-window-excursion - (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) + (or (derived-mode-p 'Info-mode) (info-pop-to-buffer)) (let ((old-node Info-current-node) (old-file Info-current-file) (node (Info-extract-pointer "up")) p) @@ -5485,7 +5532,7 @@ completion alternatives to currently visited manuals." (raise-frame (window-frame window)) (select-frame-set-input-focus (window-frame window)) (select-window window)) - (switch-to-buffer found))) + (info-pop-to-buffer nil found))) ;; The buffer doesn't exist; create it. (info-initialize) (info (Info-find-file manual) -- cgit v1.2.3 From 471cc26002d3f6028252c77998272fccf73722ec Mon Sep 17 00:00:00 2001 From: Jurgen De Backer Date: Thu, 4 Jan 2024 11:10:56 +0000 Subject: Fix file-name resolution in *compilation* and *grep* buffers Resolving symlinks in file names could lead to non-existent files if some leading directory is a symlink to its parent. In emacs 28 'expand-file-name' was replaced by 'file-truename' to solve bug #8035. * lisp/progmodes/compile.el (safe-expand-file-name): New function. (compilation-find-file-1): Call 'safe-expand-file-name'. (Bug#67930) --- lisp/progmodes/compile.el | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 4af6a96900a..3002cd1b86c 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -3122,7 +3122,16 @@ and overlay is highlighted between MK and END-MK." (cancel-timer next-error-highlight-timer)) (remove-hook 'pre-command-hook #'compilation-goto-locus-delete-o)) - + +(defun safe-expand-file-name (directory filename) + "Expand the specified filename using expand-file-name. If this fails, +retry with file-truename (see bug #8035) +Unlike expand-file-name, file-truename follows symlinks which we try to avoid if possible." + (let* ((expandedname (expand-file-name filename directory))) + (if (file-exists-p expandedname) + expandedname + (file-truename (file-name-concat directory filename))))) + (defun compilation-find-file-1 (marker filename directory &optional formats) (or formats (setq formats '("%s"))) (let ((dirs compilation-search-path) @@ -3143,8 +3152,7 @@ and overlay is highlighted between MK and END-MK." fmts formats) ;; For each directory, try each format string. (while (and fmts (null buffer)) - (setq name (file-truename - (file-name-concat thisdir (format (car fmts) filename))) + (setq name (safe-expand-file-name thisdir (format (car fmts) filename)) buffer (and (file-exists-p name) (find-file-noselect name)) fmts (cdr fmts))) @@ -3166,8 +3174,7 @@ and overlay is highlighted between MK and END-MK." (setq thisdir (car dirs) fmts formats) (while (and fmts (null buffer)) - (setq name (file-truename - (file-name-concat thisdir (format (car fmts) filename))) + (setq name (safe-expand-file-name thisdir (format (car fmts) filename)) buffer (and (file-exists-p name) (find-file-noselect name)) fmts (cdr fmts))) @@ -3227,8 +3234,7 @@ attempts to find a file whose name is produced by (format FMT FILENAME)." (ding) (sit-for 2)) ((and (file-directory-p name) (not (file-exists-p - (setq name (file-truename - (file-name-concat name filename)))))) + (setq name (safe-expand-file-name name filename))))) (message "No `%s' in directory %s" filename origname) (ding) (sit-for 2)) (t -- cgit v1.2.3 From 409985288dc83b20b4af2ce4072177fdc06b6ad7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Jan 2024 12:33:44 +0200 Subject: Fix last change (bug#67930) * lisp/progmodes/compile.el (compilation--expand-fn): Renamed from 'safe-expand-file-name'; all callers changed. Doc fix. --- lisp/progmodes/compile.el | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 3002cd1b86c..e7d4e9966cf 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -3123,10 +3123,10 @@ and overlay is highlighted between MK and END-MK." (remove-hook 'pre-command-hook #'compilation-goto-locus-delete-o)) -(defun safe-expand-file-name (directory filename) - "Expand the specified filename using expand-file-name. If this fails, -retry with file-truename (see bug #8035) -Unlike expand-file-name, file-truename follows symlinks which we try to avoid if possible." +(defun compilation--expand-fn (directory filename) + "Expand FILENAME or resolve its true name. +Unlike `expand-file-name', `file-truename' follows symlinks, which +we try to avoid if possible." (let* ((expandedname (expand-file-name filename directory))) (if (file-exists-p expandedname) expandedname @@ -3152,7 +3152,8 @@ Unlike expand-file-name, file-truename follows symlinks which we try to avoid if fmts formats) ;; For each directory, try each format string. (while (and fmts (null buffer)) - (setq name (safe-expand-file-name thisdir (format (car fmts) filename)) + (setq name (compilation--expand-fn thisdir + (format (car fmts) filename)) buffer (and (file-exists-p name) (find-file-noselect name)) fmts (cdr fmts))) @@ -3174,7 +3175,8 @@ Unlike expand-file-name, file-truename follows symlinks which we try to avoid if (setq thisdir (car dirs) fmts formats) (while (and fmts (null buffer)) - (setq name (safe-expand-file-name thisdir (format (car fmts) filename)) + (setq name (compilation--expand-fn thisdir + (format (car fmts) filename)) buffer (and (file-exists-p name) (find-file-noselect name)) fmts (cdr fmts))) @@ -3234,7 +3236,7 @@ attempts to find a file whose name is produced by (format FMT FILENAME)." (ding) (sit-for 2)) ((and (file-directory-p name) (not (file-exists-p - (setq name (safe-expand-file-name name filename))))) + (setq name (compilation--expand-fn name filename))))) (message "No `%s' in directory %s" filename origname) (ding) (sit-for 2)) (t -- cgit v1.2.3 From 466d1c98a9ef7490332469165f63a38c2b07a05d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Jan 2024 13:26:29 +0200 Subject: Fix icons.el when icon does not exist as a file * lisp/emacs-lisp/icons.el (icons--create): Handle the case when ICON is a file that doesn't exists or is unreadable. Suggested by David Ponce . (Bug#66846) --- lisp/emacs-lisp/icons.el | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el index a35a00ec1f3..1fc0e39f9fe 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -187,11 +187,13 @@ present if the icon is represented by an image." merged) (cl-defmethod icons--create ((_type (eql 'image)) icon keywords) - (let ((file (if (file-name-absolute-p icon) - icon - (and (fboundp 'image-search-load-path) - (image-search-load-path icon))))) - (and (display-images-p) + (let* ((file (if (file-name-absolute-p icon) + icon + (and (fboundp 'image-search-load-path) + (image-search-load-path icon)))) + (file-exists (and (stringp file) (file-readable-p file)))) + (and file-exists + (display-images-p) (fboundp 'image-supported-file-p) (image-supported-file-p file) (propertize -- cgit v1.2.3 From 16162e0645d959d824d97e3f9908e46d401e8028 Mon Sep 17 00:00:00 2001 From: Steven Allen Date: Fri, 29 Dec 2023 09:53:05 -0800 Subject: Make 'advice-remove' interactive `ad-advice-remove' is already interactive, but it doesn't work with new-style advice. * lisp/emacs-lisp/nadvice.el (advice-remove): Make it interactive (Bug#67926). * doc/lispref/functions.texi (Advising Named Functions): Document that 'advice-remove' is now an interactive command. --- doc/lispref/functions.texi | 8 +++++--- etc/NEWS | 4 ++++ lisp/emacs-lisp/nadvice.el | 26 ++++++++++++++++++++++++++ 3 files changed, 35 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 2b2c9287d91..29e9f04a076 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -2077,10 +2077,12 @@ Add the advice @var{function} to the named function @var{symbol}. (@pxref{Core Advising Primitives}). @end defun -@defun advice-remove symbol function +@deffn Command advice-remove symbol function Remove the advice @var{function} from the named function @var{symbol}. -@var{function} can also be the @code{name} of a piece of advice. -@end defun +@var{function} can also be the @code{name} of a piece of advice. When +called interactively, prompt for both an advised @var{function} and +the advice to remove. +@end deffn @defun advice-member-p function symbol Return non-@code{nil} if the advice @var{function} is already in the named diff --git a/etc/NEWS b/etc/NEWS index 7bbfbf9512d..3a1168f62b3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -104,6 +104,10 @@ to your init: * Changes in Emacs 30.1 +** 'advice-remove' is now an interactive command. +When called interactively, 'advice-remove' now prompts for an advised +function to the advice to remove. + ** Emacs now supports Unicode Standard version 15.1. ** Network Security Manager diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 0d45b4b95fa..de287e43b21 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -539,6 +539,32 @@ Contrary to `remove-function', this also works when SYMBOL is a macro or an autoload and it preserves `fboundp'. Instead of the actual function to remove, FUNCTION can also be the `name' of the piece of advice." + (interactive + (let* ((pred (lambda (sym) (advice--p (advice--symbol-function sym)))) + (default (when-let* ((f (function-called-at-point)) + ((funcall pred f))) + (symbol-name f))) + (prompt (format-prompt "Remove advice from function" default)) + (symbol (intern (completing-read prompt obarray pred t nil nil default))) + advices) + (advice-mapc (lambda (f p) + (let ((k (or (alist-get 'name p) f))) + (push (cons + ;; "name" (string) and 'name (symbol) are + ;; considered different names so we use + ;; `prin1-to-string' even if the name is + ;; a string to distinguish between these + ;; two cases. + (prin1-to-string k) + ;; We use `k' here instead of `f' because + ;; the same advice can have multiple + ;; names. + k) + advices))) + symbol) + (list symbol (cdr (assoc-string + (completing-read "Advice to remove: " advices nil t) + advices))))) (let ((f (symbol-function symbol))) (remove-function (cond ;This is `advice--symbol-function' but as a "place". ((get symbol 'advice--pending) -- cgit v1.2.3 From e48a396d4ba1694e083f900dda1f41cc41d00ead Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 6 Jan 2024 18:12:47 +0100 Subject: Adapt Tramp version * doc/misc/trampver.texi: * lisp/net/trampver.el (tramp-version): Adapt Tramp versions. --- doc/misc/trampver.texi | 2 +- lisp/net/trampver.el | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index a239c091889..8cb0e3d574a 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -7,7 +7,7 @@ @c In the Tramp GIT, the version number and the bug report address @c are auto-frobbed from configure.ac. -@set trampver 2.7.0-pre +@set trampver 2.7.0 @set trampurl https://www.gnu.org/software/tramp/ @set tramp-bug-report-address tramp-devel@@gnu.org @set emacsver 27.1 diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index bfabbbeaf34..4b8868561d4 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.7.0-pre +;; Version: 2.7.0 ;; Package-Requires: ((emacs "27.1")) ;; Package-Type: multi ;; URL: https://www.gnu.org/software/tramp/ @@ -40,7 +40,7 @@ ;; ./configure" to change them. ;;;###tramp-autoload -(defconst tramp-version "2.7.0-pre" +(defconst tramp-version "2.7.0" "This version of Tramp.") ;;;###tramp-autoload @@ -78,7 +78,7 @@ ;; Check for Emacs version. (let ((x (if (not (string-version-lessp emacs-version "27.1")) "ok" - (format "Tramp 2.7.0-pre is not fit for %s" + (format "Tramp 2.7.0 is not fit for %s" (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) -- cgit v1.2.3 From 166b10e9f80dc78147601a87b6425f59860bcfe4 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 6 Jan 2024 18:15:23 +0100 Subject: Complete change of ert-remote-temporary-file-directory * lisp/emacs-lisp/ert-x.el: Adapt comment. * test/lisp/net/tramp-tests.el (ert-remote-temporary-file-directory): Make it a defvar. --- lisp/emacs-lisp/ert-x.el | 2 +- test/lisp/net/tramp-tests.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index a6d2fe4a1da..cd60f9f457f 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -540,7 +540,7 @@ The same keyword arguments are supported as in (when (and (featurep 'tramp) (getenv "EMACS_HYDRA_CI")) (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) -;; If this defconst is used in a test file, `tramp' shall be loaded +;; If this defvar is used in a test file, `tramp' shall be loaded ;; prior `ert-x'. There is no default value on w32 systems, which ;; could work out of the box. (defvar ert-remote-temporary-file-directory diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 3216a8be1b0..91b0542c759 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -134,7 +134,7 @@ A resource file is in the resource directory as per (eval-and-compile ;; There is no default value on w32 systems, which could work out ;; of the box. - (defconst ert-remote-temporary-file-directory + (defvar ert-remote-temporary-file-directory (cond ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY")) ((eq system-type 'windows-nt) null-device) -- cgit v1.2.3 From 8729a2a10d9b8d88f6ba33b5ce62f74d89e7788a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Jan 2024 19:30:16 +0200 Subject: Fix 'rmail-summary-by-thread' * lisp/mail/rmailsum.el (rmail-summary-by-thread): Call 'rmail-new-summary' from the original buffer, not from 'rmail-buffer' to avoid failing the logic in 'rmail-new-summary' that decides whether to pop up a new window. Reported by Andrea Monaco . --- lisp/mail/rmailsum.el | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 30fe75f7e5c..cccd702dae2 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -436,19 +436,19 @@ headers of the messages." (unless (and rmail-summary-message-parents-vector (= (length rmail-summary-message-parents-vector) (1+ rmail-total-messages))) - (rmail-summary-fill-message-parents-and-descs-vectors)) - (let ((enc-msgs (make-bool-vector (1+ rmail-total-messages) nil))) - (rmail-summary--walk-thread-message-recursively msgnum enc-msgs) - (rmail-new-summary (format "thread containing message %d" msgnum) - (list 'rmail-summary-by-thread msgnum) - (if (and rmail-summary-progressively-narrow - (rmail-summary--exists-1)) - (lambda (msg _msgnum) - (and (aref rmail-summary-currently-displayed-msgs msg) - (aref enc-msgs msg))) + (rmail-summary-fill-message-parents-and-descs-vectors))) + (let ((enc-msgs (make-bool-vector (1+ rmail-total-messages) nil))) + (rmail-summary--walk-thread-message-recursively msgnum enc-msgs) + (rmail-new-summary (format "thread containing message %d" msgnum) + (list 'rmail-summary-by-thread msgnum) + (if (and rmail-summary-progressively-narrow + (rmail-summary--exists-1)) (lambda (msg _msgnum) - (aref enc-msgs msg))) - msgnum)))) + (and (aref rmail-summary-currently-displayed-msgs msg) + (aref enc-msgs msg))) + (lambda (msg _msgnum) + (aref enc-msgs msg))) + msgnum))) ;;;###autoload (defun rmail-summary-by-labels (labels) -- cgit v1.2.3 From 73cb931e5bab1b956f0569cd542468cfa7f4c9a7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 6 Jan 2024 18:50:25 -0500 Subject: (describe-package-1): Fix bug#68288 Fix support for multiple maintainers in `describe-package` and in `package-report-bug`. * lisp/emacs-lisp/package.el (describe-package-1): There's no `:maintainers:`, instead `:maintainer` can hold a list of maintainers. (package-maintainers): Adapt to the possibility of having multiple maintainers. (package-report-bug): Don't burp if the package is not installed. --- lisp/emacs-lisp/package.el | 38 ++++++++++++++++++++++---------------- 1 file changed, 22 insertions(+), 16 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 8df2088ce43..b21e0f8fc51 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2804,8 +2804,7 @@ Helper function for `describe-package'." (status (if desc (package-desc-status desc) "orphan")) (incompatible-reason (package--incompatible-p desc)) (signed (if desc (package-desc-signed desc))) - (maintainers (or (cdr (assoc :maintainers extras)) - (list (cdr (assoc :maintainer extras))))) + (maintainers (cdr (assoc :maintainer extras))) (authors (cdr (assoc :authors extras))) (news (and-let* (pkg-dir ((not built-in)) @@ -4699,18 +4698,23 @@ will be signaled in that case." (let* ((name (package-desc-name pkg-desc)) (extras (package-desc-extras pkg-desc)) (maint (alist-get :maintainer extras))) + (unless (listp (cdr maint)) + (setq maint (list maint))) (cond ((and (null maint) (null no-error)) (user-error "Package `%s' has no explicit maintainer" name)) ((and (not (progn (require 'ietf-drums) - (ietf-drums-parse-address (cdr maint)))) + (ietf-drums-parse-address (cdar maint)))) (null no-error)) (user-error "Package `%s' has no maintainer address" name)) - ((not (null maint)) + (t (with-temp-buffer - (package--print-email-button maint) - (string-trim (substring-no-properties (buffer-string)))))))) + (mapc #'package--print-email-button maint) + (replace-regexp-in-string + "\n" ", " (string-trim + (buffer-substring-no-properties + (point-min) (point-max))))))))) ;;;###autoload (defun package-report-bug (desc) @@ -4720,17 +4724,19 @@ DESC must be a `package-desc' object." package-menu-mode) (let ((maint (package-maintainers desc)) (name (symbol-name (package-desc-name desc))) + (pkgdir (package-desc-dir desc)) vars) - (dolist-with-progress-reporter (group custom-current-group-alist) - "Scanning for modified user options..." - (when (and (car group) - (file-in-directory-p (car group) (package-desc-dir desc))) - (dolist (ent (get (cdr group) 'custom-group)) - (when (and (custom-variable-p (car ent)) - (boundp (car ent)) - (not (eq (custom--standard-value (car ent)) - (default-toplevel-value (car ent))))) - (push (car ent) vars))))) + (when pkgdir + (dolist-with-progress-reporter (group custom-current-group-alist) + "Scanning for modified user options..." + (when (and (car group) + (file-in-directory-p (car group) pkgdir)) + (dolist (ent (get (cdr group) 'custom-group)) + (when (and (custom-variable-p (car ent)) + (boundp (car ent)) + (not (eq (custom--standard-value (car ent)) + (default-toplevel-value (car ent))))) + (push (car ent) vars)))))) (dlet ((reporter-prompt-for-summary-p t)) (reporter-submit-bug-report maint name vars)))) -- cgit v1.2.3 From b5de9ae8010684a5ed0c6f2703077a61d325ccad Mon Sep 17 00:00:00 2001 From: João Távora Date: Sat, 6 Jan 2024 17:56:33 -0600 Subject: Eglot: careful when invoking code actions on no symbol at all Invoking code actions without a marked region or over a symbol will trip certain servers up since BEG and END in eglot-code-actions will be nil, causing 'eglot--pos-to-lsp-position' to assume point (which is OK) but the 'flymake-diagnostics' call to return all diagnostics. This causes an absolutely undecipherable JavaScript backtrace to be sent back to Eglot from typescript-language-server. Github-reference: https://github.com/joaotavora/eglot/issues/847 * lisp/progmodes/eglot.el (eglot--code-action-bounds): Avoid returning (list nil nil) --- lisp/progmodes/eglot.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index d330e6e23cb..ba2cc72a6b4 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -3605,16 +3605,17 @@ edit proposed by the server." (defun eglot--code-action-bounds () "Calculate appropriate bounds depending on region and point." - (let (diags) + (let (diags boftap) (cond ((use-region-p) `(,(region-beginning) ,(region-end))) ((setq diags (flymake-diagnostics (point))) (cl-loop for d in diags minimizing (flymake-diagnostic-beg d) into beg maximizing (flymake-diagnostic-end d) into end finally (cl-return (list beg end)))) + ((setq boftap (bounds-of-thing-at-point 'sexp)) + (list (car boftap) (cdr boftap))) (t - (let ((boftap (bounds-of-thing-at-point 'sexp))) - (list (car boftap) (cdr boftap))))))) + (list (point) (point)))))) (defun eglot-code-actions (beg &optional end action-kind interactive) "Find LSP code actions of type ACTION-KIND between BEG and END. -- cgit v1.2.3 From f866c85ac4e32df8061b285b6b44b15346994f3d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 7 Jan 2024 00:02:08 -0500 Subject: (jsonrpc--log-event): Try and fix bug#68072 * lisp/jsonrpc.el (jsonrpc--log-event): Force the use of `lisp-indent-function` in `pp-to-string`. --- lisp/jsonrpc.el | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 3f33443f321..f0f5842a0ee 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -1003,16 +1003,17 @@ of the API instead.") (or method "") (if id (format "[%s]" id) ""))))) (msg - (cond ((eq format 'full) - (format "%s%s\n" preamble (or json log-text))) - ((eq format 'short) - (format "%s%s\n" preamble (or log-text ""))) - (t - (format "%s%s" preamble - (or (and foreign-message - (concat "\n" (pp-to-string - foreign-message))) - (concat log-text "\n"))))))) + (pcase format + ('full (format "%s%s\n" preamble (or json log-text))) + ('short (format "%s%s\n" preamble (or log-text ""))) + (_ + (format "%s%s" preamble + (or (and foreign-message + (let ((lisp-indent-function ;bug#68072 + #'lisp-indent-function)) + (concat "\n" (pp-to-string + foreign-message)))) + (concat log-text "\n"))))))) (goto-char (point-max)) ;; XXX: could use `run-at-time' to delay server logs ;; slightly to play nice with verbose servers' stderr. -- cgit v1.2.3 From aadcb906095e8588ed6302920bf835df20ab320f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 7 Jan 2024 12:39:47 +0100 Subject: Handle local default directory in connection-local-value * lisp/files-x.el (connection-local-p, connection-local-value): Handle local `default-directory'. * test/lisp/files-x-tests.el (files-x-test-connection-local-value): Extend test. --- lisp/files-x.el | 27 +++++++++++++++++---------- test/lisp/files-x-tests.el | 43 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 60 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/files-x.el b/lisp/files-x.el index fccb2fa4a9f..f70be5f7ff3 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -929,19 +929,23 @@ earlier in the `setq-connection-local'. The return value of the ;;;###autoload (defmacro connection-local-p (variable &optional application) "Non-nil if VARIABLE has a connection-local binding in `default-directory'. +`default-directory' must be a remote file name. If APPLICATION is nil, the value of `connection-local-default-application' is used." (declare (debug (symbolp &optional form))) (unless (symbolp variable) (signal 'wrong-type-argument (list 'symbolp variable))) - `(let (connection-local-variables-alist file-local-variables-alist) - (hack-connection-local-variables - (connection-local-criteria-for-default-directory ,application)) - (and (assq ',variable connection-local-variables-alist) t))) + `(let ((criteria + (connection-local-criteria-for-default-directory ,application)) + connection-local-variables-alist file-local-variables-alist) + (when criteria + (hack-connection-local-variables criteria) + (and (assq ',variable connection-local-variables-alist) t)))) ;;;###autoload (defmacro connection-local-value (variable &optional application) "Return connection-local VARIABLE for APPLICATION in `default-directory'. +`default-directory' must be a remote file name. If APPLICATION is nil, the value of `connection-local-default-application' is used. If VARIABLE does not have a connection-local binding, the return @@ -949,12 +953,15 @@ value is the default binding of the variable." (declare (debug (symbolp &optional form))) (unless (symbolp variable) (signal 'wrong-type-argument (list 'symbolp variable))) - `(let (connection-local-variables-alist file-local-variables-alist) - (hack-connection-local-variables - (connection-local-criteria-for-default-directory ,application)) - (if-let ((result (assq ',variable connection-local-variables-alist))) - (cdr result) - ,variable))) + `(let ((criteria + (connection-local-criteria-for-default-directory ,application)) + connection-local-variables-alist file-local-variables-alist) + (if (not criteria) + ,variable + (hack-connection-local-variables criteria) + (if-let ((result (assq ',variable connection-local-variables-alist))) + (cdr result) + ,variable)))) ;;;###autoload (defun path-separator () diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el index a2f16d5ae35..528467a5641 100644 --- a/test/lisp/files-x-tests.el +++ b/test/lisp/files-x-tests.el @@ -553,6 +553,49 @@ If it's not initialized yet, initialize it." (should-not (boundp 'remote-shell-file-name)) (should (string-equal (symbol-value 'remote-null-device) "null")))) + ;; `connection-local-value' and `connection-local-p' care about a + ;; local default directory. + (with-temp-buffer + (let ((enable-connection-local-variables t) + (default-directory temporary-file-directory) + (remote-null-device "null")) + (should-not connection-local-variables-alist) + (should-not (local-variable-p 'remote-shell-file-name)) + (should-not (local-variable-p 'remote-null-device)) + (should-not (boundp 'remote-shell-file-name)) + (should (string-equal (symbol-value 'remote-null-device) "null")) + + ;; The recent variable values are used. + (should-not (connection-local-p remote-shell-file-name)) + ;; `remote-shell-file-name' is not defined, so we get an error. + (should-error + (connection-local-value remote-shell-file-name) :type 'void-variable) + (should-not (connection-local-p remote-null-device)) + (should + (string-equal + (connection-local-value remote-null-device) remote-null-device)) + (should-not (connection-local-p remote-lazy-var)) + + ;; Run with a different application. + (should-not + (connection-local-p + remote-shell-file-name (cadr files-x-test--application))) + ;; `remote-shell-file-name' is not defined, so we get an error. + (should-error + (connection-local-value + remote-shell-file-name (cadr files-x-test--application)) + :type 'void-variable) + (should-not + (connection-local-p + remote-null-device (cadr files-x-test--application))) + (should + (string-equal + (connection-local-value + remote-null-device (cadr files-x-test--application)) + remote-null-device)) + (should-not + (connection-local-p remote-lazy-var (cadr files-x-test--application))))) + ;; Cleanup. (custom-set-variables `(connection-local-profile-alist ',clpa now) -- cgit v1.2.3 From 1b123972636d717241a38bcd6daa3e3f424fb8b0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 7 Jan 2024 17:15:18 +0200 Subject: ; Don't record multiple versions of use-package * lisp/use-package/use-package-ensure-system-package.el: Remove Version: header, to avoid confusing loaddefs-gene. (Bug#68304) --- lisp/use-package/use-package-ensure-system-package.el | 1 - 1 file changed, 1 deletion(-) (limited to 'lisp') diff --git a/lisp/use-package/use-package-ensure-system-package.el b/lisp/use-package/use-package-ensure-system-package.el index 12bf16998a1..3e369d99624 100644 --- a/lisp/use-package/use-package-ensure-system-package.el +++ b/lisp/use-package/use-package-ensure-system-package.el @@ -5,7 +5,6 @@ ;; Author: Justin Talbott ;; Keywords: convenience, tools, extensions ;; URL: https://github.com/waymondo/use-package-ensure-system-package -;; Version: 0.2 ;; Package-Requires: ((use-package "2.1") (system-packages "1.0.4")) ;; Filename: use-package-ensure-system-package.el ;; Package: use-package -- cgit v1.2.3 From 18de131222ee24c4088ac45be1babad26284af5b Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 7 Jan 2024 20:04:06 +0200 Subject: Support more metadata properties in completion-category-overrides (bug#68214) * doc/lispref/minibuf.texi (Completion Variables): Add to the table of completion-category-overrides new items: `cycle-sort-function', `group-function', `annotation-function', `affixation-function'. * lisp/minibuffer.el (completion-metadata-get): Try also to get the property from completion-category-overrides by category. Suggested by Daniel Mendler . (completion-category-defaults): Add new properties to docstring. (completion-category-overrides): Add customization for new properties: `cycle-sort-function', `group-function', `annotation-function', `affixation-function'. (completion-metadata-override-get): Remove function. (minibuffer-completion-help): Replace 'completion-metadata-override-get' with 'completion-metadata-get' for 'display-sort-function'. --- doc/lispref/minibuf.texi | 15 +++++++++++++- etc/NEWS | 10 ++++++---- lisp/minibuffer.el | 51 +++++++++++++++++++++++++++++++++++++----------- 3 files changed, 60 insertions(+), 16 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 8aed1515764..8d25a53161e 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1879,17 +1879,30 @@ The value should be a value for @code{completion-cycle-threshold} (@pxref{Completion Options,,, emacs, The GNU Emacs Manual}) for this category. +@item cycle-sort-function +The function to sort entries when cycling. + @item display-sort-function +The function to sort entries in the @file{*Completions*} buffer. The possible values are: @code{nil}, which means to use either the sorting function from metadata or if that is @code{nil}, fall back to @code{completions-sort}; @code{identity}, which means not to sort at all, leaving the original order; or any other value out of those used in @code{completions-sort} (@pxref{Completion Options,,, emacs, The GNU Emacs Manual}). + +@item group-function +The function to group completions. + +@item annotation-function +The function to add annotations to completions. + +@item affixation-function +The function to add prefixes and suffixes to completions. @end table @noindent -Additional alist entries may be defined in the future. +See @ref{Programmed Completion}, for a complete list of metadata entries. @end defopt @defvar completion-extra-properties diff --git a/etc/NEWS b/etc/NEWS index 3a1168f62b3..c3d777b971f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -745,10 +745,12 @@ will be first sorted alphabetically, and then re-sorted by their order in the minibuffer history, with more recent candidates appearing first. +++ -*** 'completion-category-overrides' supports 'display-sort-function'. -You can now customize the sorting order for any category in -'completion-category-overrides' that will override the sorting order -defined in the metadata or in 'completions-sort'. +*** 'completion-category-overrides' supports more metadata. +The new supported completion properties are 'cycle-sort-function', +'display-sort-function', 'annotation-function', 'affixation-function', +'group-function'. You can now customize them for any category in +'completion-category-overrides' that will override the properties +defined in completion metadata. ** Pcomplete diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index b7aebae63a8..04b36f03d11 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -151,7 +151,15 @@ The metadata of a completion table should be constant between two boundaries." minibuffer-completion-predicate)) (defun completion-metadata-get (metadata prop) - (cdr (assq prop metadata))) + "Get PROP from completion METADATA. +If the metadata specifies a completion category, the variables +`completion-category-overrides' and +`completion-category-defaults' take precedence." + (if-let (((not (eq prop 'category))) + (cat (alist-get 'category metadata)) + (over (completion--category-override cat prop))) + (cdr over) + (alist-get prop metadata))) (defun complete-with-action (action collection string predicate) "Perform completion according to ACTION. @@ -1138,27 +1146,38 @@ styles for specific categories, such as files, buffers, etc." (symbol-help (styles . (basic shorthand substring))) (calendar-month (display-sort-function . identity))) "Default settings for specific completion categories. + Each entry has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: - `styles': the list of `completion-styles' to use for that category. - `cycle': the `completion-cycle-threshold' to use for that category. -- `display-sort-function': the sorting function. +- `cycle-sort-function': function to sort entries when cycling. +- `display-sort-function': function to sort entries in *Completions*. +- `group-function': function for grouping the completion candidates. +- `annotation-function': function to add annotations in *Completions*. +- `affixation-function': function to prepend/append a prefix/suffix. + Categories are symbols such as `buffer' and `file', used when completing buffer and file names, respectively. Also see `completion-category-overrides'.") (defcustom completion-category-overrides nil - "List of category-specific user overrides for completion styles. + "List of category-specific user overrides for completion metadata. Each override has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: - `styles': the list of `completion-styles' to use for that category. - `cycle': the `completion-cycle-threshold' to use for that category. +- `cycle-sort-function': function to sort entries when cycling. - `display-sort-function': nil means to use either the sorting function from metadata, or if that is nil, fall back to `completions-sort'; `identity' disables sorting and keeps the original order; and other possible values are the same as in `completions-sort'. +- `group-function': function for grouping the completion candidates. +- `annotation-function': function to add annotations in *Completions*. +- `affixation-function': function to prepend/append a prefix/suffix. +See more description of metadata in `completion-metadata'. Categories are symbols such as `buffer' and `file', used when completing buffer and file names, respectively. @@ -1180,6 +1199,10 @@ overrides the default specified in `completion-category-defaults'." (cons :tag "Completion Cycling" (const :tag "Select one value from the menu." cycle) ,completion--cycling-threshold-type) + (cons :tag "Cycle Sorting" + (const :tag "Select one value from the menu." + cycle-sort-function) + (choice (function :tag "Custom function"))) (cons :tag "Completion Sorting" (const :tag "Select one value from the menu." display-sort-function) @@ -1189,18 +1212,24 @@ overrides the default specified in `completion-category-defaults'." minibuffer-sort-alphabetically) (const :tag "Historical sorting" minibuffer-sort-by-history) - (function :tag "Custom function")))))) + (function :tag "Custom function"))) + (cons :tag "Completion Groups" + (const :tag "Select one value from the menu." + group-function) + (choice (function :tag "Custom function"))) + (cons :tag "Completion Annotation" + (const :tag "Select one value from the menu." + annotation-function) + (choice (function :tag "Custom function"))) + (cons :tag "Completion Affixation" + (const :tag "Select one value from the menu." + affixation-function) + (choice (function :tag "Custom function")))))) (defun completion--category-override (category tag) (or (assq tag (cdr (assq category completion-category-overrides))) (assq tag (cdr (assq category completion-category-defaults))))) -(defun completion-metadata-override-get (metadata prop) - (if-let ((cat (completion-metadata-get metadata 'category)) - (over (completion--category-override cat prop))) - (cdr over) - (completion-metadata-get metadata prop))) - (defun completion--styles (metadata) (let* ((cat (completion-metadata-get metadata 'category)) (over (completion--category-override cat 'styles))) @@ -2546,7 +2575,7 @@ The candidate will still be chosen by `choose-completion' unless (aff-fun (or (completion-metadata-get all-md 'affixation-function) (plist-get completion-extra-properties :affixation-function))) - (sort-fun (completion-metadata-override-get all-md 'display-sort-function)) + (sort-fun (completion-metadata-get all-md 'display-sort-function)) (group-fun (completion-metadata-get all-md 'group-function)) (mainbuf (current-buffer)) ;; If the *Completions* buffer is shown in a new -- cgit v1.2.3 From 74f022b2797567ab04405af37b877d94cc4fdca2 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 1 Jan 2024 00:34:53 -0800 Subject: ; Make erc--send-input-lines a normal function again * lisp/erc/erc.el (erc--send-input-lines): Revert portion of 174b3dd9bd78c662ce9fff78404dcfa02259d21b "Make nested input handling more robust in ERC" that converted this from a function to a method. Instead, defer change until it's needed, likely for bug#49860. Also, don't inadvertently allow overloading of `insertp' because user code can legitimately set that to a function, which we then blindly call. Instead, hard-code it to the only expected alternate display function. --- lisp/erc/erc.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index e639a6278fc..b73e80cedde 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7878,12 +7878,13 @@ queue. Expect LINES-OBJ to be an `erc--input-split' object." (user-error "Multiline command detected" )) lines-obj) -(cl-defmethod erc--send-input-lines (lines-obj) +(defun erc--send-input-lines (lines-obj) "Send lines in `erc--input-split-lines' object LINES-OBJ." (when (erc--input-split-sendp lines-obj) (dolist (line (erc--input-split-lines lines-obj)) (when (erc--input-split-insertp lines-obj) - (if (functionp (erc--input-split-insertp lines-obj)) + (if (eq (erc--input-split-insertp lines-obj) + 'erc--command-indicator-display) (funcall (erc--input-split-insertp lines-obj) line) (erc-display-msg line))) (erc-process-input-line (concat line "\n") -- cgit v1.2.3 From fad2d1e2acc12cf8b1770d821738d924105acd8a Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 1 Jan 2024 23:18:54 -0800 Subject: Use global window hook for erc-keep-place-indicator * lisp/erc/erc-goodies.el (erc--keep-place-indicator-on-window-buffer-change): Expect a frame instead of a window argument for the only parameter, which is now ignored, and exit early when entering a minibuffer. (erc--keep-place-indicator-setup): Remove function because local modules don't need a separate setup function. (erc-keep-place-indicator-mode): Add autoload cookie even though this is a local module, since this particular one is intended for more granular, interactive activation. This is mostly a formality because it only matters in the unlikely event `erc-modules' is missing all other modules defined in `erc-goodies'. (erc-keep-place-indicator-mode, erc-keep-place-indicator-enable, erc-keep-place-indicator-disable): Move functionality from `erc--keep-place-indicator-setup' into enable body. Use global instead of local members for `erc-keep-place-mode-hook' and `window-buffer-change-functions'. (erc--keep-place-indicator-on-global-module): Perform necessary action in all ERC buffers, not just the current one, where the user has ostensibly disabled `erc-keep-place-mode'. * test/lisp/erc/erc-goodies-tests.el (erc-goodies-tests--assert-kp-indicator-on, erc-goodies-tests--assert-kp-indicator-off): Change expected hook membership for dependencies from global to local. (erc-goodies-tests--keep-place-indicator): Use new helpers from the `erc-tests-common' library. (Bug#59943) --- lisp/erc/erc-goodies.el | 84 ++++++++++++++++++++------------------ test/lisp/erc/erc-goodies-tests.el | 18 ++++---- 2 files changed, 52 insertions(+), 50 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index c5ab25bea98..23589657b2d 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -331,14 +331,15 @@ buffer than the window's start." (defvar-local erc--keep-place-indicator-overlay nil "Overlay for `erc-keep-place-indicator-mode'.") -(defun erc--keep-place-indicator-on-window-buffer-change (window) +(defun erc--keep-place-indicator-on-window-buffer-change (_) "Maybe sync `erc--keep-place-indicator-overlay'. Do so only when switching to a new buffer in the same window if the replaced buffer is no longer visible in another window and its `window-start' at the time of switching is strictly greater than the indicator's position." (when-let ((erc-keep-place-indicator-follow) - ((eq window (selected-window))) + (window (selected-window)) + ((not (eq window (active-minibuffer-window)))) (old-buffer (window-old-buffer window)) ((buffer-live-p old-buffer)) ((not (eq old-buffer (current-buffer)))) @@ -352,67 +353,70 @@ than the indicator's position." (with-current-buffer old-buffer (erc-keep-place-move old-start)))) -(defun erc--keep-place-indicator-setup () - "Initialize buffer for maintaining `erc--keep-place-indicator-overlay'." - (require 'fringe) - (erc--restore-initialize-priors erc-keep-place-indicator-mode - erc--keep-place-indicator-overlay (make-overlay 0 0)) - (add-hook 'erc-keep-place-mode-hook - #'erc--keep-place-indicator-on-global-module nil t) - (add-hook 'window-buffer-change-functions - #'erc--keep-place-indicator-on-window-buffer-change 40 t) - (when-let* (((memq erc-keep-place-indicator-style '(t arrow))) - (ov-property (if (zerop (fringe-columns 'left)) - 'after-string - 'before-string)) - (display (if (zerop (fringe-columns 'left)) - `((margin left-margin) ,overlay-arrow-string) - '(left-fringe right-triangle - erc-keep-place-indicator-arrow))) - (bef (propertize " " 'display display))) - (overlay-put erc--keep-place-indicator-overlay ov-property bef)) - (when (memq erc-keep-place-indicator-style '(t face)) - (overlay-put erc--keep-place-indicator-overlay 'face - 'erc-keep-place-indicator-line))) - ;;;###autoload(put 'keep-place-indicator 'erc--feature 'erc-goodies) +;;;###autoload(autoload 'erc-keep-place-indicator-mode "erc-goodies" nil t) (define-erc-module keep-place-indicator nil "Buffer-local `keep-place' with fringe arrow and/or highlighted face. Play nice with global module `keep-place' but don't depend on it. Expect that users may want different combinations of `keep-place' -and `keep-place-indicator' in different buffers. Unlike global -`keep-place', when `switch-to-buffer-preserve-window-point' is -enabled, don't forcibly sync point in all windows where buffer -has previously been shown because that defeats the purpose of -having a placeholder." +and `keep-place-indicator' in different buffers." ((cond (erc-keep-place-mode) ((memq 'keep-place erc-modules) (erc-keep-place-mode +1)) ;; Enable a local version of `keep-place-mode'. (t (add-hook 'erc-insert-pre-hook #'erc-keep-place 65 t))) + (require 'fringe) + (add-hook 'window-buffer-change-functions + #'erc--keep-place-indicator-on-window-buffer-change 40) + (add-hook 'erc-keep-place-mode-hook + #'erc--keep-place-indicator-on-global-module 40) (if (pcase erc-keep-place-indicator-buffer-type ('target erc--target) ('server (not erc--target)) ('t t)) - (erc--keep-place-indicator-setup) + (progn + (erc--restore-initialize-priors erc-keep-place-indicator-mode + erc--keep-place-indicator-overlay (make-overlay 0 0)) + (when-let (((memq erc-keep-place-indicator-style '(t arrow))) + (ov-property (if (zerop (fringe-columns 'left)) + 'after-string + 'before-string)) + (display (if (zerop (fringe-columns 'left)) + `((margin left-margin) ,overlay-arrow-string) + '(left-fringe right-triangle + erc-keep-place-indicator-arrow))) + (bef (propertize " " 'display display))) + (overlay-put erc--keep-place-indicator-overlay ov-property bef)) + (when (memq erc-keep-place-indicator-style '(t face)) + (overlay-put erc--keep-place-indicator-overlay 'face + 'erc-keep-place-indicator-line))) (erc-keep-place-indicator-mode -1))) ((when erc--keep-place-indicator-overlay (delete-overlay erc--keep-place-indicator-overlay)) - (remove-hook 'window-buffer-change-functions - #'erc--keep-place-indicator-on-window-buffer-change t) + (let ((buffer (current-buffer))) + ;; Remove global hooks unless others exist with mode enabled. + (unless (erc-buffer-filter (lambda () + (and (not (eq buffer (current-buffer))) + erc-keep-place-indicator-mode))) + (remove-hook 'erc-keep-place-mode-hook + #'erc--keep-place-indicator-on-global-module) + (remove-hook 'window-buffer-change-functions + #'erc--keep-place-indicator-on-window-buffer-change))) + (when (local-variable-p 'erc-insert-pre-hook) + (remove-hook 'erc-insert-pre-hook #'erc-keep-place t)) (remove-hook 'erc-keep-place-mode-hook #'erc--keep-place-indicator-on-global-module t) - (remove-hook 'erc-insert-pre-hook #'erc-keep-place t) (kill-local-variable 'erc--keep-place-indicator-overlay)) 'local) (defun erc--keep-place-indicator-on-global-module () - "Ensure `keep-place-indicator' can cope with `erc-keep-place-mode'. -That is, ensure the local module can survive a user toggling the -global one." - (if erc-keep-place-mode - (remove-hook 'erc-insert-pre-hook #'erc-keep-place t) - (add-hook 'erc-insert-pre-hook #'erc-keep-place 65 t))) + "Ensure `keep-place-indicator' survives toggling `erc-keep-place-mode'. +Do this by simulating `keep-place' in all buffers where +`keep-place-indicator' is enabled." + (erc-with-all-buffers-of-server nil (lambda () erc-keep-place-indicator-mode) + (if erc-keep-place-mode + (remove-hook 'erc-insert-pre-hook #'erc-keep-place t) + (add-hook 'erc-insert-pre-hook #'erc-keep-place 65 t)))) (defun erc-keep-place-move (pos) "Move keep-place indicator to current line or POS. diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index b8e00c57ef5..170e28bda96 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -251,15 +251,16 @@ (defun erc-goodies-tests--assert-kp-indicator-on () (should erc--keep-place-indicator-overlay) - (should (local-variable-p 'window-buffer-change-functions)) - (should window-configuration-change-hook) + (should (memq 'erc--keep-place-indicator-on-window-buffer-change + window-buffer-change-functions)) (should (memq 'erc-keep-place erc-insert-pre-hook)) (should (eq erc-keep-place-mode (not (local-variable-p 'erc-insert-pre-hook))))) (defun erc-goodies-tests--assert-kp-indicator-off () (should-not (local-variable-p 'erc-insert-pre-hook)) - (should-not (local-variable-p 'window-buffer-change-functions)) + (should-not (memq 'erc--keep-place-indicator-on-window-buffer-change + window-buffer-change-functions)) (should-not erc--keep-place-indicator-overlay)) (defun erc-goodies-tests--kp-indicator-populate () @@ -272,12 +273,9 @@ (goto-char erc-input-marker)) (defun erc-goodies-tests--keep-place-indicator (test) - (with-current-buffer (get-buffer-create "*erc-keep-place-indicator-mode*") - (erc-mode) - (erc--initialize-markers (point) nil) - (setq erc-server-process - (start-process "sleep" (current-buffer) "sleep" "1")) - (set-process-query-on-exit-flag erc-server-process nil) + (erc-keep-place-mode -1) + (with-current-buffer (erc-tests-common-make-server-buf + "*erc-keep-place-indicator-mode*") (let (erc-connect-pre-hook erc-modules) @@ -294,7 +292,7 @@ (should-not (member 'erc-keep-place (default-value 'erc-insert-pre-hook))) (should-not (local-variable-p 'erc-insert-pre-hook)) - (kill-buffer)))) + (erc-tests-common-kill-buffers)))) (ert-deftest erc-keep-place-indicator-mode--no-global () (erc-goodies-tests--keep-place-indicator -- cgit v1.2.3 From d6f9379d1c708dddc0543bf7242ba1ec6aee9746 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 3 Jan 2024 02:00:45 -0800 Subject: Allow setting `erc-split-line-length' to zero * etc/ERC-NEWS: Mention that `erc-flood-protect' no longer affects line splitting. * lisp/erc/erc-backend.el (erc-split-line-length): Mention ways for modules to suppress line splitting entirely. (erc--split-line): Exit loop instead of asserting progress has been made. * lisp/erc/erc.el (erc--split-lines): Don't split input when option `erc-split-line-length' is zero. * test/lisp/erc/erc-tests.el (erc--split-line): Assert behavior when `erc-split-line-length' is 0. (Bug#62947) --- etc/ERC-NEWS | 5 +++++ lisp/erc/erc-backend.el | 9 +++++++-- lisp/erc/erc.el | 2 +- test/lisp/erc/erc-tests.el | 8 ++++++++ 4 files changed, 21 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index c51b6f05458..6cfa704d995 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -560,6 +560,11 @@ third-party code, the key takeaway is that more 'font-lock-face' properties encountered in the wild may be combinations of faces rather than lone ones. +*** 'erc-flood-protect' no longer influences input splitting. +This variable's role has been narrowed to rate limiting only. ERC +used to suppress protocol line-splitting when its value was nil, but +that's now handled by setting 'erc-split-line-length' to zero. + *** 'erc-pre-send-functions' visits prompt input post-split. ERC now adjusts input lines to fall within allowed length limits before showing hook members the result. For compatibility, diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 4162df00595..95207e56fd1 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -433,7 +433,11 @@ and optionally alter the attempts tally." (defcustom erc-split-line-length 440 "The maximum length of a single message. -If a message exceeds this size, it is broken into multiple ones. +ERC normally splits chat input submitted at its prompt into +multiple messages when the initial size exceeds this value in +bytes. Modules can tell ERC to forgo splitting entirely by +setting this to zero locally or, preferably, by binding it around +a remapped `erc-send-current-line' command. IRC allows for lines up to 512 bytes. Two of them are CR LF. And a typical message looks like this: @@ -596,7 +600,8 @@ escape hatch for inhibiting their transmission.") (if (= (car cmp) (point-min)) (goto-char (nth 1 cmp)) (goto-char (car cmp))))) - (cl-assert (/= (point-min) (point))) + (when (= (point-min) (point)) + (goto-char (point-max))) (push (buffer-substring-no-properties (point-min) (point)) out) (delete-region (point-min) (point))) (or (nreverse out) (list ""))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index b73e80cedde..d0c43134f9d 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7821,7 +7821,7 @@ When all lines are empty, remove all but the first." "Partition non-command input into lines of protocol-compliant length." ;; Prior to ERC 5.6, line splitting used to be predicated on ;; `erc-flood-protect' being non-nil. - (unless (erc--input-split-cmdp state) + (unless (or (zerop erc-split-line-length) (erc--input-split-cmdp state)) (setf (erc--input-split-lines state) (mapcan #'erc--split-line (erc--input-split-lines state))))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 2cd47ec3f89..a9aa255718d 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1298,6 +1298,14 @@ (should-not erc-debug-irc-protocol))) (ert-deftest erc--split-line () + (let ((erc-split-line-length 0)) + (should (equal (erc--split-line "") '(""))) + (should (equal (erc--split-line " ") '(" "))) + (should (equal (erc--split-line "1") '("1"))) + (should (equal (erc--split-line " 1") '(" 1"))) + (should (equal (erc--split-line "1 ") '("1 "))) + (should (equal (erc--split-line "abc") '("abc")))) + (let ((erc-default-recipients '("#chan")) (erc-split-line-length 10)) (should (equal (erc--split-line "") '(""))) -- cgit v1.2.3 From 37e87bc3eeb8e62e2900d73cf4dd9fc9e942d66d Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 3 Jan 2024 23:10:55 -0800 Subject: Make ERC's format catalogs more extensible * lisp/erc/erc-common.el (erc--define-catalog): Accept a `:parent' keyword to allow for extending an existing catalog by overriding some subset of defined entries. (erc-define-message-format-catalog): Add edebug spec. * lisp/erc/erc.el (erc-retrieve-catalog-entry): Check parent for definition before looking to `default-toplevel-value'. * test/lisp/erc/erc-tests.el (erc-retrieve-catalog-entry): Add test case for inheritance. * test/lisp/erc/resources/erc-tests-common.el (erc-tests-common-pp-propertized-parts): Fix bug in convenience command. (Bug#67677) --- lisp/erc/erc-common.el | 17 +++++++++++++++-- lisp/erc/erc.el | 6 ++++++ test/lisp/erc/erc-tests.el | 16 +++++++++++++++- test/lisp/erc/resources/erc-tests-common.el | 2 +- 4 files changed, 37 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index b8ba0673355..2581e40f850 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -554,9 +554,21 @@ See `erc-define-message-format-catalog' for the meaning of ENTRIES, an alist, and `erc-tests-common-pp-propertized-parts' in tests/lisp/erc/erc-tests.el for a convenience command to convert a literal string into a sequence of `propertize' forms, which are -much easier to review and edit." +much easier to review and edit. When ENTRIES begins with a +sequence of keyword-value pairs remove them and consider their +evaluated values before processing the alist proper. + +Currently, the only recognized keyword is `:parent', which tells +ERC to search recursively for a given template key using the +keyword's associated value, another catalog symbol, if not found +in catalog NAME." (declare (indent 1)) (let (out) + (while (keywordp (car entries)) + (push (pcase-exhaustive (pop entries) + (:parent `(put ',name 'erc--base-format-catalog + ,(pop entries)))) + out)) (dolist (e entries (cons 'progn (nreverse out))) (push `(defvar ,(intern (format "erc-message-%s-%s" name (car e))) ,(cdr e) @@ -575,7 +587,8 @@ symbol, and FORMAT evaluates to a format string compatible with `format-spec'. Expect modules that only define a handful of entries to do so manually, instead of using this macro, so that the resulting variables will end up with more useful doc strings." - (declare (indent 1)) + (declare (indent 1) + (debug (symbolp [&rest [keywordp form]] &rest (symbolp . form)))) `(erc--define-catalog ,language ,entries)) (defmacro erc--doarray (spec &rest body) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index d0c43134f9d..478683a77f5 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -9320,6 +9320,12 @@ if yet untried." (unless catalog (setq catalog erc-current-message-catalog)) (symbol-value (or (erc--make-message-variable-name catalog key 'softp) + (let ((parent catalog) + last) + (while (and (setq parent (get parent 'erc--base-format-catalog)) + (not (setq last (erc--make-message-variable-name + parent key 'softp))))) + last) (let ((default (default-toplevel-value 'erc-current-message-catalog))) (or (and (not (eq default catalog)) (erc--make-message-variable-name default key 'softp)) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index a9aa255718d..a71cc806f6a 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3533,6 +3533,20 @@ connection." (should (equal (erc-retrieve-catalog-entry 's221) "test-top 221 val")) (makunbound (intern "erc-message-test-top-s221")) - (unintern "erc-message-test-top-s221" obarray)) + (unintern "erc-message-test-top-s221" obarray) + + ;; Inheritance. + (let ((obarray (obarray-make))) + (set (intern "erc-message-test1-abc") "val test1 abc") + (set (intern "erc-message-test2-abc") "val test2 abc") + (set (intern "erc-message-test2-def") "val test2 def") + (put (intern "test0") 'erc--base-format-catalog (intern "test1")) + (put (intern "test1") 'erc--base-format-catalog (intern "test2")) + (should (equal (erc-retrieve-catalog-entry 'abc (intern "test0")) + "val test1 abc")) + (should (equal (erc-retrieve-catalog-entry 'def (intern "test0")) + "val test2 def")) + ;; Terminates. + (should-not (erc-retrieve-catalog-entry 'ghi (intern "test0"))))) ;;; erc-tests.el ends here diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index fc5649798b5..906aa891352 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -150,7 +150,7 @@ between literal strings." For simplicity, assume string evaluates to itself." (interactive "P") (let ((sexp (erc-tests-common-string-to-propertized-parts (pp-last-sexp)))) - (if arg (insert (pp-to-string sexp)) (pp-eval-expression sexp)))) + (if arg (insert (pp-to-string sexp)) (pp-macroexpand-expression sexp)))) ;; The following utilities are meant to help prepare tests for ;; `erc--get-inserted-msg-bounds' and friends. -- cgit v1.2.3 From 50f430ebcd87b77207013f97e6e5d1b8fe93f990 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 5 Jan 2024 07:20:34 -0800 Subject: Clarify purpose of module aliases in ERC * doc/misc/erc.texi: Mention that aliases should not be defined for new modules. * lisp/erc/erc-common.el (define-erc-module): Refactor slightly for readability. (erc-with-all-buffers-of-server): Redo doc string. * lisp/erc/erc-pcomplete.el: Declare `completion' module's feature and group as being `erc-pcomplete'. * test/lisp/erc/erc-tests.el (erc--find-group--real): Assert group lookup works for "normalized" module name `completion' of `erc-pcomplete-mode'. --- doc/misc/erc.texi | 8 ++++++++ lisp/erc/erc-common.el | 31 +++++++++++++++++-------------- lisp/erc/erc-pcomplete.el | 2 ++ test/lisp/erc/erc-tests.el | 1 + 4 files changed, 28 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 52c7477c9dd..f877fb681fe 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -678,6 +678,14 @@ signals an error. Users defining personal modules in an init file should @code{(provide 'erc-my-module)} somewhere to placate ERC. Dynamically generating modules on the fly is not supported. +Some older built-in modules have a second name along with a second +minor-mode toggle, which is just a function alias for its primary +counterpart. For practical reasons, ERC does not define a +corresponding variable alias because contending with indirect +variables complicates bookkeeping tasks, such as persisting module +state across IRC sessions. New modules should definitely avoid +defining aliases without a good reason. + Some packages have been known to autoload a module's definition instead of its minor-mode command, which severs the link between the library and the module. This means that enabling the mode by invoking diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 2581e40f850..28ab6aad466 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -333,6 +333,7 @@ instead of a `set' state, which precludes any actual saving." (read (current-buffer)))) (defmacro erc--find-feature (name alias) + ;; Don't use this outside of the file that defines NAME. `(pcase (erc--find-group ',name ,(and alias (list 'quote alias))) ('erc (and-let* ((file (or (macroexp-file-name) buffer-file-name))) (intern (file-name-base file)))) @@ -350,8 +351,12 @@ See Info node `(elisp) Defining Minor Modes' for more.") (defmacro define-erc-module (name alias doc enable-body disable-body &optional local-p) "Define a new minor mode using ERC conventions. -Symbol NAME is the name of the module. -Symbol ALIAS is the alias to use, or nil. +Expect NAME to be the module's name and ALIAS, when non-nil, to +be a retired name used only for compatibility purposes. In new +code, assume NAME is the same symbol users should specify when +customizing `erc-modules' (see info node `(erc) Module Loading' +for more on naming). + DOC is the documentation string to use for the minor mode. ENABLE-BODY is a list of expressions used to enable the mode. DISABLE-BODY is a list of expressions used to disable the mode. @@ -382,7 +387,10 @@ Example: (let* ((sn (symbol-name name)) (mode (intern (format "erc-%s-mode" (downcase sn)))) (enable (intern (format "erc-%s-enable" (downcase sn)))) - (disable (intern (format "erc-%s-disable" (downcase sn))))) + (disable (intern (format "erc-%s-disable" (downcase sn)))) + (nmodule (erc--normalize-module-symbol name)) + (amod (and alias (intern (format "erc-%s-mode" + (downcase (symbol-name alias))))))) `(progn (define-minor-mode ,mode @@ -399,13 +407,9 @@ if ARG is omitted or nil. (if ,mode (,enable) (,disable)))) ,(erc--assemble-toggle local-p name enable mode t enable-body) ,(erc--assemble-toggle local-p name disable mode nil disable-body) - ,@(and-let* ((alias) - ((not (eq name alias))) - (aname (intern (format "erc-%s-mode" - (downcase (symbol-name alias)))))) - `((defalias ',aname #',mode) - (put ',aname 'erc-module ',(erc--normalize-module-symbol name)))) - (put ',mode 'erc-module ',(erc--normalize-module-symbol name)) + ,@(and amod `((defalias ',amod #',mode) + (put ',amod 'erc-module ',nmodule))) + (put ',mode 'erc-module ',nmodule) ;; For find-function and find-variable. (put ',mode 'definition-name ',name) (put ',enable 'definition-name ',name) @@ -462,10 +466,9 @@ If no server buffer exists, return nil." ,@body))))) (defmacro erc-with-all-buffers-of-server (process pred &rest forms) - "Execute FORMS in all buffers which have same process as this server. -FORMS will be evaluated in all buffers having the process PROCESS and -where PRED matches or in all buffers of the server process if PRED is -nil." + "Evaluate FORMS in all buffers of PROCESS in which PRED returns non-nil. +When PROCESS is nil, do so in all ERC buffers. When PRED is nil, +run FORMS unconditionally." (declare (indent 2) (debug (form form body))) (macroexp-let2 nil pred pred `(erc-buffer-filter (lambda () diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index 52ebdc83e5e..05cbaf3872f 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el @@ -58,7 +58,9 @@ add this string to nicks completed." ;;;###autoload(put 'Completion 'erc--module 'completion) ;;;###autoload(put 'pcomplete 'erc--module 'completion) +;;;###autoload(put 'completion 'erc--feature 'erc-pcomplete) ;;;###autoload(autoload 'erc-completion-mode "erc-pcomplete" nil t) +(put 'completion 'erc-group 'erc-pcomplete) (define-erc-module pcomplete Completion "In ERC Completion mode, the TAB key does completion whenever possible." ((add-hook 'erc-mode-hook #'pcomplete-erc-setup) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index a71cc806f6a..2318fed28f2 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3186,6 +3186,7 @@ (should (eq (erc--find-group 'autojoin) 'erc-autojoin)) (should (eq (erc--find-group 'pcomplete 'Completion) 'erc-pcomplete)) (should (eq (erc--find-group 'capab-identify) 'erc-capab)) + (should (eq (erc--find-group 'completion) 'erc-pcomplete)) ;; No group specified. (should (eq (erc--find-group 'smiley nil) 'erc)) (should (eq (erc--find-group 'unmorse nil) 'erc))) -- cgit v1.2.3 From d9462e24a967e32d550ee886b5150f0cc78358f6 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 8 Jan 2024 14:52:25 +0100 Subject: Make Tramp more robust * lisp/net/tramp-sh.el (tramp-bundle-read-file-names): Check, that the command finishes successfully. --- lisp/net/tramp-sh.el | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 6489f473634..8ec9467ab45 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3652,20 +3652,20 @@ filled are described in `tramp-bundle-read-file-names'." (dolist (elt - (ignore-errors + (with-current-buffer (tramp-get-connection-buffer vec) ;; We cannot use `tramp-send-command-and-read', because ;; this does not cooperate well with heredoc documents. - (tramp-send-command - vec - (format - "tramp_bundle_read_file_names <<'%s'\n%s\n%s\n" - tramp-end-of-heredoc - (mapconcat #'tramp-shell-quote-argument files "\n") - tramp-end-of-heredoc)) - (with-current-buffer (tramp-get-connection-buffer vec) - ;; Read the expression. - (goto-char (point-min)) - (read (current-buffer))))) + (unless (tramp-send-command-and-check + vec + (format + "tramp_bundle_read_file_names <<'%s'\n%s\n%s\n" + tramp-end-of-heredoc + (mapconcat #'tramp-shell-quote-argument files "\n") + tramp-end-of-heredoc)) + (tramp-error vec 'file-error "%s" (tramp-get-buffer-string))) + ;; Read the expression. + (goto-char (point-min)) + (read (current-buffer)))) (tramp-set-file-property vec (car elt) "file-exists-p" (nth 1 elt)) (tramp-set-file-property vec (car elt) "file-readable-p" (nth 2 elt)) -- cgit v1.2.3 From 774c8ec74c98d69d56b2511a613145f2b69fb2eb Mon Sep 17 00:00:00 2001 From: Harald Jörg Date: Mon, 8 Jan 2024 16:12:19 +0100 Subject: cperl-mode.el: Make sure cperl-file-style is set buffer-local * lisp/progmodes/cperl-mode.el (cperl-file-style): Add description what the options actually do. (cperl-menu): Split the menu entry "Indent styles" into "Default indent styles" and "Indent styles for current buffer" (cperl--set-file-style): call `cperl-file-style' instead of `cperl-set-style'. This completes the fix for Bug#17948. (cperl-set-style): Explain when to use `cperl-file-style'. Use `set-default-toplevel-value' instead of `set'. (cperl-set-style-back): Use `set-default-toplevel-value' instead of `set'. (cperl-file-style): New command to set the file style for the current buffer. * etc/NEWS: Announce the new command cperl-file-style. --- etc/NEWS | 5 +++++ lisp/progmodes/cperl-mode.el | 41 +++++++++++++++++++++++++++++++++++++---- 2 files changed, 42 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index c3d777b971f..f4d008ee2d6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1116,6 +1116,11 @@ value of 'perl-code' is useful for trailing POD and for AutoSplit modules, the value 'comment' makes CPerl mode treat trailers as comment, like Perl mode does. +*** New command 'cperl-file-style'. +This command sets the indentation style for the current buffer. To +change the default style, either use the option with the same name or +use the command cperl-set-style. + *** Commands using the Perl info page are obsolete. The Perl documentation in info format is no longer distributed with Perl or on CPAN since more than 10 years. Perl documentation can be diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 9f7f29b8182..5e435f7133e 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -162,6 +162,9 @@ for constructs with multiline if/unless/while/until/for/foreach condition." (defcustom cperl-file-style nil "Indentation style to use in cperl-mode. +Setting this option will override options as given in +`cperl-style-alist' for the keyword provided here. If nil, then +the individual options as customized are used. \"PBP\" is the style recommended in the Book \"Perl Best Practices\" by Damian Conway. \"CPerl\" is the traditional style of cperl-mode, and \"PerlStyle\" follows the Perl documentation @@ -1130,7 +1133,7 @@ Unless KEEP, removes the old indentation." ["Fix whitespace on indent" cperl-toggle-construct-fix t] ["Auto-help on Perl constructs" cperl-toggle-autohelp t] ["Auto fill" auto-fill-mode t]) - ("Indent styles..." + ("Default indent styles..." ["CPerl" (cperl-set-style "CPerl") t] ["PBP" (cperl-set-style "PBP") t] ["PerlStyle" (cperl-set-style "PerlStyle") t] @@ -1141,6 +1144,15 @@ Unless KEEP, removes the old indentation." ["Whitesmith" (cperl-set-style "Whitesmith") t] ["Memorize Current" (cperl-set-style "Current") t] ["Memorized" (cperl-set-style-back) cperl-old-style]) + ("Indent styles for current buffer..." + ["CPerl" (cperl-set-style "CPerl") t] + ["PBP" (cperl-file-style "PBP") t] + ["PerlStyle" (cperl-file-style "PerlStyle") t] + ["GNU" (cperl-file-style "GNU") t] + ["C++" (cperl-file-style "C++") t] + ["K&R" (cperl-file-style "K&R") t] + ["BSD" (cperl-file-style "BSD") t] + ["Whitesmith" (cperl-file-style "Whitesmith") t]) ("Micro-docs" ["Tips" (describe-variable 'cperl-tips) t] ["Problems" (describe-variable 'cperl-problems) t] @@ -1924,7 +1936,8 @@ or as help on variables `cperl-tips', `cperl-problems', (defun cperl--set-file-style () (when cperl-file-style - (cperl-set-style cperl-file-style))) + (cperl-file-style cperl-file-style))) + ;; Fix for perldb - make default reasonable (defun cperl-db () @@ -6496,6 +6509,10 @@ See examples in `cperl-style-examples'.") (defun cperl-set-style (style) "Set CPerl mode variables to use one of several different indentation styles. +This command sets the default values for the variables. It does +not affect buffers visiting files where the style has been set as +a file or directory variable. To change the indentation style of +a buffer, use the command `cperl-file-style' instead. The arguments are a string representing the desired style. The list of styles is in `cperl-style-alist', available styles are \"CPerl\", \"PBP\", \"PerlStyle\", \"GNU\", \"K&R\", \"BSD\", \"C++\" @@ -6516,7 +6533,8 @@ side-effect of memorizing only. Examples in `cperl-style-examples'." (let ((style (cdr (assoc style cperl-style-alist))) setting) (while style (setq setting (car style) style (cdr style)) - (set (car setting) (cdr setting))))) + (set-default-toplevel-value (car setting) (cdr setting)))) + (set-default-toplevel-value 'cperl-file-style style)) (defun cperl-set-style-back () "Restore a style memorized by `cperl-set-style'." @@ -6526,7 +6544,22 @@ side-effect of memorizing only. Examples in `cperl-style-examples'." (while cperl-old-style (setq setting (car cperl-old-style) cperl-old-style (cdr cperl-old-style)) - (set (car setting) (cdr setting))))) + (set-default-toplevel-value (car setting) (cdr setting))))) + +(defun cperl-file-style (style) + "Set the indentation style for the current buffer to STYLE. +The list of styles is in `cperl-style-alist', available styles +are \"CPerl\", \"PBP\", \"PerlStyle\", \"GNU\", \"K&R\", \"BSD\", \"C++\" +and \"Whitesmith\"." + (interactive + (list (completing-read "Enter style: " cperl-style-alist nil 'insist))) + (dolist (setting (cdr (assoc style cperl-style-alist)) style) + (let ((option (car setting)) + (value (cdr setting))) + (make-variable-buffer-local option) + (set option value))) + (make-variable-buffer-local 'cperl-file-style) + (setq cperl-file-style style)) (declare-function Info-find-node "info" (filename nodename &optional no-going-back strict-case -- cgit v1.2.3 From 0a5ebd444a820308571a659005d094b2dd93fe3f Mon Sep 17 00:00:00 2001 From: Harald Jörg Date: Tue, 9 Jan 2024 11:44:43 +0100 Subject: ; cperl-mode: Fix a compiler warning caused by my previous commit * lisp/progmodes/cperl-mode.el (cperl-file-style): Replace 'make-variable-buffer-local' with 'make.local-variable' --- lisp/progmodes/cperl-mode.el | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 5e435f7133e..bfc1742610c 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6556,10 +6556,8 @@ and \"Whitesmith\"." (dolist (setting (cdr (assoc style cperl-style-alist)) style) (let ((option (car setting)) (value (cdr setting))) - (make-variable-buffer-local option) - (set option value))) - (make-variable-buffer-local 'cperl-file-style) - (setq cperl-file-style style)) + (set (make-local-variable option) value))) + (set (make-local-variable 'cperl-file-style) style)) (declare-function Info-find-node "info" (filename nodename &optional no-going-back strict-case -- cgit v1.2.3 From ee2a8fd4cff84cd5bd672fdde8ec3e0800f132be Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Jan 2024 11:34:05 -0500 Subject: (mouse-wheel-*-event): Minor cleanups * lisp/mwheel.el (mwheel-event-button): Mark as obsolete alias. Change all callers. * lisp/edmacro.el (mouse-wheel-*-event): Move declarations to ... (edmacro-fix-menu-commands): ... where we do know that they should be defined. Obey `mouse-wheel-*-alternate-event`s as well. --- lisp/edmacro.el | 20 +++++++++++++------- lisp/mwheel.el | 18 ++++++------------ 2 files changed, 19 insertions(+), 19 deletions(-) (limited to 'lisp') diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 362ec0ecbb4..5bd0c1892e5 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -720,17 +720,19 @@ This function assumes that the events can be stored in a string." (setf (aref seq i) (logand (aref seq i) 127))) seq) -;; These are needed in a --without-x build. -(defvar mouse-wheel-down-event) -(defvar mouse-wheel-up-event) -(defvar mouse-wheel-right-event) -(defvar mouse-wheel-left-event) - (defun edmacro-fix-menu-commands (macro &optional noerror) (if (vectorp macro) (let (result) ;; Not preloaded in a --without-x build. (require 'mwheel) + (defvar mouse-wheel-down-event) + (defvar mouse-wheel-up-event) + (defvar mouse-wheel-right-event) + (defvar mouse-wheel-left-event) + (defvar mouse-wheel-down-alternate-event) + (defvar mouse-wheel-up-alternate-event) + (defvar mouse-wheel-right-alternate-event) + (defvar mouse-wheel-left-alternate-event) ;; Make a list of the elements. (setq macro (append macro nil)) (dolist (ev macro) @@ -748,7 +750,11 @@ This function assumes that the events can be stored in a string." (memq (event-basic-type ev) (list mouse-wheel-down-event mouse-wheel-up-event mouse-wheel-right-event - mouse-wheel-left-event))) + mouse-wheel-left-event + mouse-wheel-down-alternate-event + mouse-wheel-up-alternate-event + mouse-wheel-right-alternate-event + mouse-wheel-left-alternate-event))) nil) (noerror nil) (t diff --git a/lisp/mwheel.el b/lisp/mwheel.el index b75b6f27d53..735adf42f68 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -216,15 +216,9 @@ Also see `mouse-wheel-tilt-scroll'." :type 'boolean :version "26.1") -(defun mwheel-event-button (event) - (let ((x (event-basic-type event))) - ;; Map mouse-wheel events to appropriate buttons - (if (eq 'mouse-wheel x) - (let ((amount (car (cdr (cdr (cdr event)))))) - (if (< amount 0) - mouse-wheel-up-event - mouse-wheel-down-event)) - x))) +;; This function used to handle the `mouse-wheel` event which was +;; removed in 2003 by commit 9eb28007fb27, thus making it obsolete. +(define-obsolete-function-alias 'mwheel-event-button #'event-basic-type "30.1") (defun mwheel-event-window (event) (posn-window (event-start event))) @@ -347,7 +341,7 @@ value of ARG, and the command uses it in subsequent scrolls." (when (numberp amt) (setq amt (* amt (event-line-count event)))) (condition-case nil (unwind-protect - (let ((button (mwheel-event-button event))) + (let ((button (event-basic-type event))) (cond ((and (eq amt 'hscroll) (memq button (list mouse-wheel-down-event mouse-wheel-down-alternate-event))) (when (and (natnump arg) (> arg 0)) @@ -434,7 +428,7 @@ See also `text-scale-adjust'." (interactive (list last-input-event)) (let ((selected-window (selected-window)) (scroll-window (mouse-wheel--get-scroll-window event)) - (button (mwheel-event-button event))) + (button (event-basic-type event))) (select-window scroll-window 'mark-for-redisplay) (unwind-protect (cond ((memq button (list mouse-wheel-down-event @@ -450,7 +444,7 @@ See also `text-scale-adjust'." "Increase or decrease the global font size according to the EVENT. This invokes `global-text-scale-adjust', which see." (interactive (list last-input-event)) - (let ((button (mwheel-event-button event))) + (let ((button (event-basic-type event))) (cond ((memq button (list mouse-wheel-down-event mouse-wheel-down-alternate-event)) (global-text-scale-adjust 1)) -- cgit v1.2.3 From 29e59b835c86e1ebac12adcb28ab7e1d0c275b2f Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 9 Jan 2024 19:22:40 +0200 Subject: * lisp/tab-bar.el: Fixes for point in window configuration (bug#68235) (tab-bar--tab): Instead of 'point-marker', use 'copy-marker' with the TYPE argument set to 'window-point-insertion-type'. This will allow point to follow the output after switching tabs when point is at the end of a comint/compilation buffer. (tab-bar-select-tab): Remove ad-hoc rule for the reverted dired buffer. --- lisp/tab-bar.el | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 219f42848ef..3e1d8278b04 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1302,7 +1302,7 @@ tab bar might wrap to the second line when it shouldn't.") (ws . ,(window-state-get (frame-root-window (or frame (selected-frame))) 'writable)) (wc . ,(current-window-configuration)) - (wc-point . ,(point-marker)) + (wc-point . ,(copy-marker (window-point) window-point-insertion-type)) (wc-bl . ,bl) (wc-bbl . ,bbl) ,@(when tab-bar-history-mode @@ -1455,13 +1455,7 @@ Negative TAB-NUMBER counts tabs from the end of the tab bar." ;; set-window-configuration does not restore the value of ;; point in the current buffer, so restore it separately. (when (and (markerp wc-point) - (marker-buffer wc-point) - ;; FIXME: After dired-revert, marker relocates to 1. - ;; window-configuration restores point to global point - ;; in this dired buffer, not to its window point, - ;; but this is slightly better than 1. - ;; Maybe better to save dired-filename in each window? - (not (eq 1 (marker-position wc-point)))) + (marker-buffer wc-point)) (goto-char wc-point)) (when wc-bl (set-frame-parameter nil 'buffer-list wc-bl)) -- cgit v1.2.3 From aff1d53cd466b64ded08d5cf12f83e5746704c07 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 9 Jan 2024 19:57:50 +0200 Subject: Support more metadata properties in completion-extra-properties (bug#68214) * doc/lispref/minibuf.texi (Completion Variables): Add to the table of completion-extra-properties new items: `group-function', `display-sort-function', `cycle-sort-function'. * lisp/icomplete.el (icomplete--augment): Remove unnecessary plist-get from completion-extra-properties since now completion-metadata-get does this. * lisp/minibuffer.el (completion-metadata-get): Use plist-get to get prop from completion-extra-properties and cache the keyword. Thanks to Daniel Mendler . (completion-extra-properties): Mention new properties in docstring. (minibuffer-completion-help): Remove unnecessary plist-get from completion-extra-properties since now completion-metadata-get does this. * lisp/net/eww.el (eww-switch-to-buffer): * test/lisp/minibuffer-tests.el (completions-affixation-navigation-test): Unquote lambda in completion-extra-properties. --- doc/lispref/minibuf.texi | 9 +++++++++ etc/NEWS | 5 +++++ lisp/icomplete.el | 6 ++---- lisp/minibuffer.el | 33 ++++++++++++++++++++++++--------- lisp/net/eww.el | 7 ++++--- test/lisp/minibuffer-tests.el | 10 +++++----- 6 files changed, 49 insertions(+), 21 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 8d25a53161e..18df44256a8 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1928,6 +1928,15 @@ element of the returned list must be a three-element list, the completion, a prefix string, and a suffix string. This function takes priority over @code{:annotation-function}. +@item :group-function +The function to group completions. + +@item :display-sort-function +The function to sort entries in the @file{*Completions*} buffer. + +@item :cycle-sort-function +The function to sort entries when cycling. + @item :exit-function The value should be a function to run after performing completion. The function should accept two arguments, @var{string} and diff --git a/etc/NEWS b/etc/NEWS index f4d008ee2d6..fcec2ca715a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -752,6 +752,11 @@ The new supported completion properties are 'cycle-sort-function', 'completion-category-overrides' that will override the properties defined in completion metadata. ++++ +*** 'completion-extra-properties' supports more metadata. +The new supported completion properties are 'group-function', +'display-sort-function', 'cycle-sort-function'. + ** Pcomplete --- diff --git a/lisp/icomplete.el b/lisp/icomplete.el index d49714f3204..aa3c5680a7e 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -789,10 +789,8 @@ and SUFFIX, if non-nil, are obtained from `affixation-function' or `group-function'. Consecutive `equal' sections are avoided. COMP is the element in PROSPECTS or a transformation also given by `group-function''s second \"transformation\" protocol." - (let* ((aff-fun (or (completion-metadata-get md 'affixation-function) - (plist-get completion-extra-properties :affixation-function))) - (ann-fun (or (completion-metadata-get md 'annotation-function) - (plist-get completion-extra-properties :annotation-function))) + (let* ((aff-fun (completion-metadata-get md 'affixation-function)) + (ann-fun (completion-metadata-get md 'annotation-function)) (grp-fun (and completions-group (completion-metadata-get md 'group-function))) (annotated diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 04b36f03d11..42d04e0ff96 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -151,15 +151,25 @@ The metadata of a completion table should be constant between two boundaries." minibuffer-completion-predicate)) (defun completion-metadata-get (metadata prop) - "Get PROP from completion METADATA. + "Get property PROP from completion METADATA. If the metadata specifies a completion category, the variables `completion-category-overrides' and -`completion-category-defaults' take precedence." +`completion-category-defaults' take precedence for +category-specific overrides. If the completion metadata does not +specify the property, the `completion-extra-properties' plist is +consulted. Note that the keys of the +`completion-extra-properties' plist are keyword symbols, not +plain symbols." (if-let (((not (eq prop 'category))) (cat (alist-get 'category metadata)) (over (completion--category-override cat prop))) (cdr over) - (alist-get prop metadata))) + (or (alist-get prop metadata) + (plist-get completion-extra-properties + ;; Cache the keyword + (or (get prop 'completion-extra-properties--keyword) + (put prop 'completion-extra-properties--keyword + (intern (concat ":" (symbol-name prop))))))))) (defun complete-with-action (action collection string predicate) "Perform completion according to ACTION. @@ -2447,6 +2457,15 @@ These include: `:annotation-function' when both are provided, so only this function is used. +`:group-function': Function for grouping the completion candidates. + +`:display-sort-function': Function to sort entries in *Completions*. + +`:cycle-sort-function': Function to sort entries when cycling. + +See more information about these functions above +in `completion-metadata'. + `:exit-function': Function to run after completion is performed. The function must accept two arguments, STRING and STATUS. @@ -2569,12 +2588,8 @@ The candidate will still be chosen by `choose-completion' unless base-size md minibuffer-completion-table minibuffer-completion-predicate)) - (ann-fun (or (completion-metadata-get all-md 'annotation-function) - (plist-get completion-extra-properties - :annotation-function))) - (aff-fun (or (completion-metadata-get all-md 'affixation-function) - (plist-get completion-extra-properties - :affixation-function))) + (ann-fun (completion-metadata-get all-md 'annotation-function)) + (aff-fun (completion-metadata-get all-md 'affixation-function)) (sort-fun (completion-metadata-get all-md 'display-sort-function)) (group-fun (completion-metadata-get all-md 'group-function)) (mainbuf (current-buffer)) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 22f07cbc5b4..6c46ef0fedb 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -2064,9 +2064,10 @@ If CHARSET is nil then use UTF-8." "Prompt for an EWW buffer to display in the selected window." (interactive nil eww-mode) (let ((completion-extra-properties - '(:annotation-function (lambda (buf) - (with-current-buffer buf - (format " %s" (eww-current-url)))))) + `(:annotation-function + ,(lambda (buf) + (with-current-buffer buf + (format " %s" (eww-current-url)))))) (curbuf (current-buffer))) (pop-to-buffer-same-window (read-buffer "Switch to EWW buffer: " diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 6dc15d0801f..c1fe3032cb5 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -505,11 +505,11 @@ (ert-deftest completions-affixation-navigation-test () (let ((completion-extra-properties - '(:affixation-function - (lambda (completions) - (mapcar (lambda (c) - (list c "prefix " " suffix")) - completions))))) + `(:affixation-function + ,(lambda (completions) + (mapcar (lambda (c) + (list c "prefix " " suffix")) + completions))))) (completing-read-with-minibuffer-setup '("aa" "ab" "ac") (insert "a") -- cgit v1.2.3 From 7755f7172748b2d337fa53434c1f678269cc5c45 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 10 Jan 2024 09:34:47 +0200 Subject: Support :category in completion-extra-properties (bug#68214) * doc/lispref/minibuf.texi (Completion Variables): Add :category to the table of completion-extra-properties. * lisp/minibuffer.el (completion--metadata-get-1): New internal function. (completion-metadata-get): Use 'completion--metadata-get-1'. Thanks to Daniel Mendler . (completion-extra-properties): Mention :category in the docstring. * lisp/calendar/calendar.el (calendar-read-date): Use more user-friendly let-binding of completion-extra-properties with :category. --- doc/lispref/minibuf.texi | 6 ++++++ etc/NEWS | 4 ++-- lisp/calendar/calendar.el | 14 ++++++-------- lisp/minibuffer.el | 20 +++++++++++++------- 4 files changed, 27 insertions(+), 17 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 18df44256a8..aa27de72ba0 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1912,6 +1912,12 @@ completion commands. Its value should be a list of property and value pairs. The following properties are supported: @table @code +@item :category +The value should be a symbol describing what kind of text the +completion function is trying to complete. If the symbol matches one +of the keys in @code{completion-category-overrides}, the usual +completion behavior is overridden. @xref{Completion Variables}. + @item :annotation-function The value should be a function to add annotations in the completions buffer. This function must accept one argument, a completion, and diff --git a/etc/NEWS b/etc/NEWS index fcec2ca715a..4559c67d4ae 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -754,8 +754,8 @@ defined in completion metadata. +++ *** 'completion-extra-properties' supports more metadata. -The new supported completion properties are 'group-function', -'display-sort-function', 'cycle-sort-function'. +The new supported completion properties are 'category', +'group-function', 'display-sort-function', 'cycle-sort-function'. ** Pcomplete diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index e01d5d792a6..2c3e7d28301 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -2337,14 +2337,12 @@ returned is (month year)." (defmon (aref month-array (1- (calendar-extract-month default-date)))) (completion-ignore-case t) (month (cdr (assoc-string - (completing-read - (format-prompt "Month name" defmon) - (lambda (string pred action) - (if (eq action 'metadata) - '(metadata (category . calendar-month)) - (complete-with-action - action (append month-array nil) string pred))) - nil t nil nil defmon) + (let ((completion-extra-properties + '(:category calendar-month))) + (completing-read + (format-prompt "Month name" defmon) + (append month-array nil) + nil t nil nil defmon)) (calendar-make-alist month-array 1) t))) (defday (calendar-extract-day default-date)) (last (calendar-last-day-of-month month year))) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 42d04e0ff96..45aab398078 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -150,6 +150,14 @@ The metadata of a completion table should be constant between two boundaries." minibuffer-completion-table minibuffer-completion-predicate)) +(defun completion--metadata-get-1 (metadata prop) + (or (alist-get prop metadata) + (plist-get completion-extra-properties + ;; Cache the keyword + (or (get prop 'completion-extra-properties--keyword) + (put prop 'completion-extra-properties--keyword + (intern (concat ":" (symbol-name prop)))))))) + (defun completion-metadata-get (metadata prop) "Get property PROP from completion METADATA. If the metadata specifies a completion category, the variables @@ -161,15 +169,10 @@ consulted. Note that the keys of the `completion-extra-properties' plist are keyword symbols, not plain symbols." (if-let (((not (eq prop 'category))) - (cat (alist-get 'category metadata)) + (cat (completion--metadata-get-1 metadata 'category)) (over (completion--category-override cat prop))) (cdr over) - (or (alist-get prop metadata) - (plist-get completion-extra-properties - ;; Cache the keyword - (or (get prop 'completion-extra-properties--keyword) - (put prop 'completion-extra-properties--keyword - (intern (concat ":" (symbol-name prop))))))))) + (completion--metadata-get-1 metadata prop))) (defun complete-with-action (action collection string predicate) "Perform completion according to ACTION. @@ -2442,6 +2445,9 @@ candidates." "Property list of extra properties of the current completion job. These include: +`:category': the kind of objects returned by `all-completions'. + Used by `completion-category-overrides'. + `:annotation-function': Function to annotate the completions buffer. The function must accept one argument, a completion string, and return either nil or a string which is to be displayed -- cgit v1.2.3 From eb913c7501489e1eae475cae843fccdf14cc24d8 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 10 Jan 2024 09:25:41 +0100 Subject: Handle package versions that are not version strings * lisp/emacs-lisp/package.el (package-menu--version-predicate): Ignore any errors raised by 'version-to-list', thus falling back to the default version list. (Bug#68317) --- lisp/emacs-lisp/package.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index b21e0f8fc51..868373f46c2 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -4069,8 +4069,8 @@ invocations." (defun package-menu--version-predicate (A B) "Predicate to sort \"*Packages*\" buffer by the version column. This is used for `tabulated-list-format' in `package-menu-mode'." - (let ((vA (or (version-to-list (aref (cadr A) 1)) '(0))) - (vB (or (version-to-list (aref (cadr B) 1)) '(0)))) + (let ((vA (or (ignore-error error (version-to-list (aref (cadr A) 1))) '(0))) + (vB (or (ignore-error error (version-to-list (aref (cadr B) 1))) '(0)))) (if (version-list-= vA vB) (package-menu--name-predicate A B) (version-list-< vA vB)))) -- cgit v1.2.3 From cf887b7eb08a7ed0859b3fa2e1c4e54d787d2f9d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 10 Jan 2024 12:49:08 +0100 Subject: Fix file name completion with Tramp on MS Windoes * doc/misc/trampver.texi: * lisp/net/trampver.el (tramp-version): Adapt Tramp versions. * lisp/net/tramp.el (tramp-build-completion-file-name-regexp): Do not use `tramp-volume-letter-regexp'. (Bug#68320) (tramp-completion-handle-expand-file-name): Simplify regexp. * test/lisp/net/tramp-tests.el (tramp-test26-file-name-completion) (tramp-test26-interactive-file-name-completion): Run also on MS Windows. --- doc/misc/trampver.texi | 2 +- lisp/net/tramp.el | 11 +---- lisp/net/trampver.el | 6 +-- test/lisp/net/tramp-tests.el | 100 +++++++++++++++++++++---------------------- 4 files changed, 54 insertions(+), 65 deletions(-) (limited to 'lisp') diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 8cb0e3d574a..bf5c90ee8a9 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -7,7 +7,7 @@ @c In the Tramp GIT, the version number and the bug report address @c are auto-frobbed from configure.ac. -@set trampver 2.7.0 +@set trampver 2.7.1-pre @set trampurl https://www.gnu.org/software/tramp/ @set tramp-bug-report-address tramp-devel@@gnu.org @set emacsver 27.1 diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ad36dd53a32..f943bd81a51 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1205,14 +1205,7 @@ The `ftp' syntax does not support methods.") ;; FIXME: This shouldn't be necessary. (rx bos "/" (? "[" (* (not "]"))) eos) (rx - bos - ;; `file-name-completion' uses absolute paths for matching. - ;; This means that on W32 systems, something like - ;; "/ssh:host:~/path" becomes "c:/ssh:host:~/path". See also - ;; `tramp-drop-volume-letter'. - (? (regexp tramp-volume-letter-regexp)) - ;; We cannot use `tramp-prefix-regexp', because it starts with `bol'. - (literal tramp-prefix-format) + (regexp tramp-prefix-regexp) ;; Optional multi-hops. (* (regexp tramp-remote-file-name-spec-regexp) @@ -2666,7 +2659,7 @@ not in completion mode." (string-match-p (rx (regexp tramp-postfix-host-regexp) eos) dir)) (concat dir filename)) ((string-match-p - (rx bos (regexp tramp-prefix-regexp) + (rx (regexp tramp-prefix-regexp) (* (regexp tramp-remote-file-name-spec-regexp) (regexp tramp-postfix-hop-regexp)) (? (regexp tramp-method-regexp) (regexp tramp-postfix-method-regexp) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 4b8868561d4..c131d39c110 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.7.0 +;; Version: 2.7.1-pre ;; Package-Requires: ((emacs "27.1")) ;; Package-Type: multi ;; URL: https://www.gnu.org/software/tramp/ @@ -40,7 +40,7 @@ ;; ./configure" to change them. ;;;###tramp-autoload -(defconst tramp-version "2.7.0" +(defconst tramp-version "2.7.1-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -78,7 +78,7 @@ ;; Check for Emacs version. (let ((x (if (not (string-version-lessp emacs-version "27.1")) "ok" - (format "Tramp 2.7.0 is not fit for %s" + (format "Tramp 2.7.1-pre is not fit for %s" (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 91b0542c759..2a3b3e16891 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4719,57 +4719,55 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check `file-name-completion' and `file-name-all-completions'." (skip-unless (tramp--test-enabled)) - ;; Method and host name in completion mode. This kind of completion - ;; does not work on MS Windows. - (unless (memq system-type '(cygwin windows-nt)) - (let ((tramp-fuse-remove-hidden-files t) - (method (file-remote-p ert-remote-temporary-file-directory 'method)) - (host (file-remote-p ert-remote-temporary-file-directory 'host)) - (orig-syntax tramp-syntax) - (minibuffer-completing-file-name t)) - (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) - (setq host (match-string 1 host))) + ;; Method and host name in completion mode. + (let ((tramp-fuse-remove-hidden-files t) + (method (file-remote-p ert-remote-temporary-file-directory 'method)) + (host (file-remote-p ert-remote-temporary-file-directory 'host)) + (orig-syntax tramp-syntax) + (minibuffer-completing-file-name t)) + (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) + (setq host (match-string 1 host))) - (unwind-protect - (dolist (syntax (if (tramp--test-expensive-test-p) - (tramp-syntax-values) `(,orig-syntax))) - (tramp-change-syntax syntax) - ;; This has cleaned up all connection data, which are used - ;; for completion. We must refill the cache. - (tramp-set-connection-property tramp-test-vec "property" nil) - - (let (;; This is needed for the `separate' syntax. - (prefix-format (substring tramp-prefix-format 1)) - ;; This is needed for the IPv6 host name syntax. - (ipv6-prefix - (and (string-match-p tramp-ipv6-regexp host) - tramp-prefix-ipv6-format)) - (ipv6-postfix - (and (string-match-p tramp-ipv6-regexp host) - tramp-postfix-ipv6-format))) - ;; Complete method name. - (unless (or (tramp-string-empty-or-nil-p method) - (string-empty-p tramp-method-regexp)) - (should - (member - (concat prefix-format method tramp-postfix-method-format) - (file-name-all-completions - (concat prefix-format (substring method 0 1)) "/")))) - ;; Complete host name. - (unless (or (tramp-string-empty-or-nil-p method) - (string-empty-p tramp-method-regexp) - (tramp-string-empty-or-nil-p host)) - (should - (member - (concat - prefix-format method tramp-postfix-method-format - ipv6-prefix host ipv6-postfix tramp-postfix-host-format) - (file-name-all-completions - (concat prefix-format method tramp-postfix-method-format) - "/")))))) + (unwind-protect + (dolist (syntax (if (tramp--test-expensive-test-p) + (tramp-syntax-values) `(,orig-syntax))) + (tramp-change-syntax syntax) + ;; This has cleaned up all connection data, which are used + ;; for completion. We must refill the cache. + (tramp-set-connection-property tramp-test-vec "property" nil) - ;; Cleanup. - (tramp-change-syntax orig-syntax)))) + (let (;; This is needed for the `separate' syntax. + (prefix-format (substring tramp-prefix-format 1)) + ;; This is needed for the IPv6 host name syntax. + (ipv6-prefix + (and (string-match-p tramp-ipv6-regexp host) + tramp-prefix-ipv6-format)) + (ipv6-postfix + (and (string-match-p tramp-ipv6-regexp host) + tramp-postfix-ipv6-format))) + ;; Complete method name. + (unless (or (tramp-string-empty-or-nil-p method) + (string-empty-p tramp-method-regexp)) + (should + (member + (concat prefix-format method tramp-postfix-method-format) + (file-name-all-completions + (concat prefix-format (substring method 0 1)) "/")))) + ;; Complete host name. + (unless (or (tramp-string-empty-or-nil-p method) + (string-empty-p tramp-method-regexp) + (tramp-string-empty-or-nil-p host)) + (should + (member + (concat + prefix-format method tramp-postfix-method-format + ipv6-prefix host ipv6-postfix tramp-postfix-host-format) + (file-name-all-completions + (concat prefix-format method tramp-postfix-method-format) + "/")))))) + + ;; Cleanup. + (tramp-change-syntax orig-syntax))) (dolist (non-essential '(nil t)) (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) @@ -4851,9 +4849,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; and Bug#60505. (ert-deftest tramp-test26-interactive-file-name-completion () "Check interactive completion with different `completion-styles'." - ;; Method, user and host name in completion mode. This kind of - ;; completion does not work on MS Windows. - (skip-unless (not (memq system-type '(cygwin windows-nt)))) + ;; Method, user and host name in completion mode. (tramp-cleanup-connection tramp-test-vec nil 'keep-password) (let ((method (file-remote-p ert-remote-temporary-file-directory 'method)) -- cgit v1.2.3 From 83ee584052f063cc802fca427c42ece2d5091ca5 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 10 Jan 2024 12:49:46 +0100 Subject: ; Adapt TODO list of tramp-compat.el --- lisp/net/tramp-compat.el | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 8065ba01734..87b20b982f9 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -330,6 +330,16 @@ Also see `ignore'." ;;; TODO: ;; ;; * Starting with Emacs 27.1, there's no need to escape open -;; parentheses with a backslash in docstrings anymore. +;; parentheses with a backslash in docstrings anymore. However, +;; `outline-minor-mode' has still problems with this. Since there +;; are developers using `outline-minor-mode' in Lisp files, we still +;; keep this quoting. +;; +;; * Starting with Emacs 29.1, use `buffer-match-p'. +;; +;; * Starting with Emacs 30.1, there is `handler-bind'. Use it +;; instead of `condition-case' when the origin of an error shall be +;; kept, for example when the HANDLER propagates the error with +;; `(signal (car err) (cdr err)'. ;;; tramp-compat.el ends here -- cgit v1.2.3 From cd0eb055fd4ebc3f7f7f5f5617549f963fe8ecff Mon Sep 17 00:00:00 2001 From: Rudolf Adamkovič Date: Tue, 3 Oct 2023 09:07:40 +0200 Subject: Make Compilation mode recognize Lua errors Emacs comes with built-in support for the Lua programming language in the form of the Lua mode and now also the Lua Tree-sitter mode. This patch further improves Lua support in Emacs by making the Compilation mode recognize Lua errors and stack traces. * lisp/progmodes/compile.el (compilation-error-regexp-alist-alist): Add regexps to aid Lua development, namely the 'lua' regexp that matches Lua errors and the 'lua-stack' regexp that matches Lua stack frames. (Bug#60830) * etc/compilation.txt (Lua): Add an example of a Lua error message with a stack trace. * test/lisp/progmodes/compile-tests.el (compile-tests--test-regexps-data): (compile-test-error-regexps): Test the new 'lua' and 'lua-stack' regexps added to the 'compilation-error-regexp-alist-alist'. --- etc/NEWS | 5 +++++ etc/compilation.txt | 13 +++++++++++++ lisp/progmodes/compile.el | 8 ++++++++ test/lisp/progmodes/compile-tests.el | 31 +++++++++++++++++++++++++++++-- 4 files changed, 55 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index 4559c67d4ae..bce33f96aee 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -452,6 +452,11 @@ This is because it partly acts by modifying other rules which may occasionally be surprising. It can be re-enabled by adding 'omake' to 'compilation-error-regexp-alist'. +*** Lua errors and stack traces are now recognized. +Compilation mode now recognizes Lua language errors and stack traces. +Every Lua error is recognized as a compilation error, and every Lua +stack frame is recognized as a compilation info. + ** Project +++ diff --git a/etc/compilation.txt b/etc/compilation.txt index c03d30afa79..05f0829864c 100644 --- a/etc/compilation.txt +++ b/etc/compilation.txt @@ -344,6 +344,19 @@ In /home/janneke/vc/guile/examples/gud-break.scm: 1033: 0 [stderr "~a:hello world\n" (# # #)] +* Lua 5.1, 5.2, 5.3, 5.4, and LuaJIT 2.1 + +/usr/bin/lua: database.lua:31: assertion failed! +stack traceback: + [C]: in function 'assert' + database.lua:31: in field 'statement' + database.lua:42: in field 'table' + database.lua:55: in field 'row' + database.lua:63: in field 'value' + io.lua: in main chunk + [C]: in ? + + * Lucid Compiler, lcc 3.x symbol: lcc diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index e7d4e9966cf..797e594c0c5 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -362,6 +362,14 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) (ruby-Test::Unit "^ [[ ]?\\([^ (].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:in " 1 2) + ;; Tested with Lua 5.1, 5.2, 5.3, 5.4, and LuaJIT 2.1. + (lua + "^[^\n\t]+?: \\([^\n\t]+?\\):\\([0-9]+?\\): .+\nstack traceback:\n\t" + 1 2 nil 2 1) + (lua-stack + "^\t\\(?:\\[C\\]:\\|\\([^\n\t]+?\\):\\(?:\\([0-9]+?\\):\\)?\\) in " + 1 2 nil 0 1) + (gmake ;; Set GNU make error messages as INFO level. ;; It starts with the name of the make program which is variable, diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index f5b5cad9c0b..20beed955d2 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -206,6 +206,33 @@ 1 0 31 "/usr/include/c++/3.3/backward/iostream.h") (gcc-include " from test_clt.cc:1:" 1 nil 1 "test_clt.cc") + ;; Lua + (lua "lua: database.lua:10: assertion failed!\nstack traceback:\n\t" + 6 nil 10 "database.lua") + (lua "lua 5.4: database 2.lua:10: assertion failed!\nstack traceback:\n\t" + 10 nil 10 "database 2.lua") + (lua "/usr/local/bin/lua: core/database.lua:20: assertion failed!\nstack traceback:\n\t" + 21 nil 20 "core/database.lua") + (lua "C:\\Lua\\Lua.exe: Core\\Database.lua:20: assertion failed!\nstack traceback:\n\t" + 17 nil 20 "Core\\Database.lua") + (lua "lua: /tmp/database.lua:20: assertion failed!\nstack traceback:\n\t" + 6 nil 20 "/tmp/database.lua") + (lua "Lua.exe: C:\\Temp\\Database.lua:20: assertion failed!\nstack traceback:\n\t" + 10 nil 20 "C:\\Temp\\Database.lua") + (lua-stack " database.lua: in field 'statement'" + 2 nil nil "database.lua" 0) + (lua-stack " database.lua:10: in field 'statement'" + 2 nil 10 "database.lua" 0) + (lua-stack " core/database.lua:20: in field 'statement'" + 2 nil 20 "core/database.lua" 0) + (lua-stack " database 2.lua: in field 'statement'" + 2 nil nil "database 2.lua" 0) + (lua-stack " Core\\Database.lua:20: in field 'statement'" + 2 nil 20 "Core\\Database.lua" 0) + (lua-stack " /tmp/database.lua: in field 'statement'" + 2 nil nil "/tmp/database.lua" 0) + (lua-stack " C:\\Core\\Database.lua: in field 'statement'" + 2 nil nil "C:\\Core\\Database.lua" 0) ;; gmake (gmake "make: *** [Makefile:20: all] Error 2" 12 nil 20 "Makefile" 0) (gmake "make[4]: *** [sub/make.mk:19: all] Error 127" 15 nil 19 @@ -507,9 +534,9 @@ The test data is in `compile-tests--test-regexps-data'." 1 15 5 "alpha.c"))) (compile--test-error-line test)) - (should (eq compilation-num-errors-found 100)) + (should (eq compilation-num-errors-found 106)) (should (eq compilation-num-warnings-found 35)) - (should (eq compilation-num-infos-found 28))))) + (should (eq compilation-num-infos-found 35))))) (ert-deftest compile-test-grep-regexps () "Test the `grep-regexp-alist' regexps. -- cgit v1.2.3 From 5567ce1a9ff8d893348ac8a3f64953426e2a7c86 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 10 Jan 2024 09:25:41 +0100 Subject: Handle package versions that are not version strings * lisp/emacs-lisp/package.el (package-menu--version-predicate): Ignore any errors raised by 'version-to-list', thus falling back to the default version list. (Bug#68317) (cherry picked from commit eb913c7501489e1eae475cae843fccdf14cc24d8) --- lisp/emacs-lisp/package.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index c7769d5430c..608306c8254 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -4003,8 +4003,8 @@ invocations." (defun package-menu--version-predicate (A B) "Predicate to sort \"*Packages*\" buffer by the version column. This is used for `tabulated-list-format' in `package-menu-mode'." - (let ((vA (or (version-to-list (aref (cadr A) 1)) '(0))) - (vB (or (version-to-list (aref (cadr B) 1)) '(0)))) + (let ((vA (or (ignore-error error (version-to-list (aref (cadr A) 1))) '(0))) + (vB (or (ignore-error error (version-to-list (aref (cadr B) 1))) '(0)))) (if (version-list-= vA vB) (package-menu--name-predicate A B) (version-list-< vA vB)))) -- cgit v1.2.3 From 29af214a75a3d77e603c377e1247a3ca85c130c5 Mon Sep 17 00:00:00 2001 From: Stephen Berman Date: Wed, 10 Jan 2024 16:24:53 +0100 Subject: Fix fontification of cgroup2 in fstab (bug#68367) * lisp/generic-x.el (etc-fstab-generic-mode): Add cgroup2. --- lisp/generic-x.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/generic-x.el b/lisp/generic-x.el index b4ae0225943..373bfad92dd 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -1491,6 +1491,7 @@ like an INI file. You can add this hook to `find-file-hook'." "cd9660" "cfs" "cgroup" + "cgroup2" "cifs" "coda" "coherent" -- cgit v1.2.3 From 492ba5721cbac0a374d785297401a1ac4b9eef37 Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Tue, 26 Dec 2023 17:49:34 +0100 Subject: Fix window setting in register preview (bug#67882) and allow configuring it if needed. * lisp/register.el (register-preview-display-buffer-alist): New user var. (register-preview,register-preview-1): Use it. --- lisp/register.el | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) (limited to 'lisp') diff --git a/lisp/register.el b/lisp/register.el index baad2c2a05d..f5b0365dec2 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -386,18 +386,21 @@ Format of each entry is controlled by the variable `register-preview-function'." (setq register-preview-function (register--preview-function register--read-with-preview-function))) (when (or show-empty (consp register-alist)) - (with-current-buffer-window - buffer - (cons 'display-buffer-below-selected - '((window-height . fit-window-to-buffer) - (preserve-size . (nil . t)))) - nil - (with-current-buffer standard-output - (setq cursor-in-non-selected-windows nil) - (mapc (lambda (elem) - (when (get-register (car elem)) - (insert (funcall register-preview-function elem)))) - register-alist))))) + (with-current-buffer-window buffer + register-preview-display-buffer-alist + nil + (with-current-buffer standard-output + (setq cursor-in-non-selected-windows nil) + (mapc (lambda (elem) + (when (get-register (car elem)) + (insert (funcall register-preview-function elem)))) + register-alist))))) + +(defcustom register-preview-display-buffer-alist '(display-buffer-at-bottom + (window-height . fit-window-to-buffer) + (preserve-size . (nil . t))) + "Window configuration for the register preview buffer." + :type display-buffer--action-custom-type) (defun register-preview-1 (buffer &optional show-empty types) "Pop up a window showing the preview of registers in BUFFER. @@ -415,9 +418,7 @@ Format of each entry is controlled by the variable `register-preview-function'." (when (or show-empty (consp registers)) (with-current-buffer-window buffer - (cons 'display-buffer-below-selected - '((window-height . fit-window-to-buffer) - (preserve-size . (nil . t)))) + register-preview-display-buffer-alist nil (with-current-buffer standard-output (setq cursor-in-non-selected-windows nil) -- cgit v1.2.3 From d7d9bf1fe35e81e4bd37c326ebe569ab38043640 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Wed, 10 Jan 2024 16:55:14 +0100 Subject: Lua compilation-mode rules adjustments (bug#60830) * lisp/progmodes/compile.el (compilation-error-regexp-alist-alist): Translate `lua' and `lua-stack' to rx, and change two unnecessary non-greedy operators to greedy. --- lisp/progmodes/compile.el | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 797e594c0c5..51c81b9d2f6 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -364,10 +364,24 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) ;; Tested with Lua 5.1, 5.2, 5.3, 5.4, and LuaJIT 2.1. (lua - "^[^\n\t]+?: \\([^\n\t]+?\\):\\([0-9]+?\\): .+\nstack traceback:\n\t" + ,(rx bol + (+? (not (in "\t\n"))) + ": " + (group (+? (not (in "\t\n")))) + ":" + (group (+ (in "0-9"))) + ": " + (+ nonl) + "\nstack traceback:\n\t") 1 2 nil 2 1) (lua-stack - "^\t\\(?:\\[C\\]:\\|\\([^\n\t]+?\\):\\(?:\\([0-9]+?\\):\\)?\\) in " + ,(rx bol "\t" + (| "[C]:" + (: (group (+? (not (in "\t\n")))) + ":" + (? (group (+ (in "0-9"))) + ":"))) + " in ") 1 2 nil 0 1) (gmake -- cgit v1.2.3 From 1bbb610821eb143e0828d2541a3f856d29d67b6f Mon Sep 17 00:00:00 2001 From: Mauro Aranda Date: Sun, 5 Nov 2023 07:23:55 -0300 Subject: Implement missing functions for custom-icon widget * lisp/cus-edit.el (custom-icon-reset-saved, custom-icon-mark-to-save) (custom-icon-state-set-and-redraw, custom-icon-reset-standard) (custom-icon-mark-to-reset-standard): New functions. (custom-icon, custom-icon-extended-menu): Register and add them to the menu. (Bug#66947) --- lisp/cus-edit.el | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 55 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 62564f6dfcb..12eea0fa0e5 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -5348,9 +5348,49 @@ The following properties have special meanings for this widget: :hidden-states '(standard) :action #'custom-icon-action :custom-set #'custom-icon-set - :custom-reset-current #'custom-redraw) - ;; Not implemented yet. - ;; :custom-reset-saved 'custom-icon-reset-saved) + :custom-mark-to-save #'custom-icon-mark-to-save + :custom-reset-current #'custom-redraw + :custom-reset-saved #'custom-icon-reset-saved + :custom-state-set-and-redraw #'custom-icon-state-set-and-redraw + :custom-reset-standard #'custom-icon-reset-standard + :custom-mark-to-reset-standard #'custom-icon-mark-to-reset-standard) + +(defun custom-icon-mark-to-save (widget) + "Mark user customization for icon edited by WIDGET to be saved later." + (let* ((icon (widget-value widget)) + (value (custom--icons-widget-value + (car (widget-get widget :children))))) + (custom-push-theme 'theme-icon icon 'user 'set value))) + +(defun custom-icon-reset-saved (widget) + "Restore icon customized by WIDGET to the icon's default attributes. + +If there's a theme value for the icon, resets to that. Otherwise, resets to +its standard value." + (let* ((icon (widget-value widget))) + (custom-push-theme 'theme-icon icon 'user 'reset) + (custom-icon-state-set widget) + (custom-redraw widget))) + +(defun custom-icon-state-set-and-redraw (widget) + "Set state of icon widget WIDGET and redraw it with up-to-date settings." + (custom-icon-state-set widget) + (custom-redraw-magic widget)) + +(defun custom-icon-reset-standard (widget) + "Reset icon edited by WIDGET to its standard value." + (let* ((icon (widget-value widget)) + (themes (get icon 'theme-icon))) + (dolist (theme themes) + (custom-push-theme 'theme-icon icon (car theme) 'reset)) + (custom-save-all)) + (widget-put widget :custom-state 'unknown) + (custom-redraw widget)) + +(defun custom-icon-mark-to-reset-standard (widget) + "Reset icon edited by WIDGET to its standard value." + ;; Don't mark for now, there aren't that many icons. + (custom-icon-reset-standard widget)) (defvar custom-icon-extended-menu (let ((map (make-sparse-keymap))) @@ -5369,6 +5409,18 @@ The following properties have special meanings for this widget: :enable (memq (widget-get custom-actioned-widget :custom-state) '(modified changed)))) + (define-key-after map [custom-icon-reset-saved] + '(menu-item "Revert This Session's Customization" + custom-icon-reset-saved + :enable (memq + (widget-get custom-actioned-widget :custom-state) + '(modified set changed rogue)))) + (when (or custom-file init-file-user) + (define-key-after map [custom-icon-reset-standard] + '(menu-item "Erase Customization" custom-icon-reset-standard + :enable (memq + (widget-get custom-actioned-widget :custom-state) + '(modified set changed saved rogue))))) map) "A menu for `custom-icon' widgets. Used in `custom-icon-action' to show a menu to the user.") -- cgit v1.2.3 From 820f0793f0b46448928905552726c1f1b999062f Mon Sep 17 00:00:00 2001 From: Xi Lu Date: Tue, 10 Oct 2023 22:20:05 +0800 Subject: Fix man.el shell injection vulnerability * lisp/man.el (Man-translate-references): Fix shell injection vulnerability. (Bug#66390) * test/lisp/man-tests.el (man-tests-Man-translate-references): New test. --- lisp/man.el | 6 +++++- test/lisp/man-tests.el | 12 ++++++++++++ 2 files changed, 17 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/man.el b/lisp/man.el index 55cb9383bec..d96396483d3 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -761,7 +761,11 @@ and the `Man-section-translations-alist' variables)." (setq name (match-string 2 ref) section (match-string 1 ref)))) (if (string= name "") - ref ; Return the reference as is + ;; see Bug#66390 + (mapconcat 'identity + (mapcar #'shell-quote-argument + (split-string ref "\\s-+")) + " ") ; Return the reference as is (if Man-downcase-section-letters-flag (setq section (downcase section))) (while slist diff --git a/test/lisp/man-tests.el b/test/lisp/man-tests.el index 140482ee622..11f5f805e43 100644 --- a/test/lisp/man-tests.el +++ b/test/lisp/man-tests.el @@ -161,6 +161,18 @@ DESCRIPTION (let ((button (button-at (match-beginning 0)))) (should (and button (eq 'Man-xref-header-file (button-type button)))))))))) +(ert-deftest man-tests-Man-translate-references () + (should (equal (Man-translate-references "basename") + "basename")) + (should (equal (Man-translate-references "basename(3)") + "3 basename")) + (should (equal (Man-translate-references "basename(3v)") + "3v basename")) + (should (equal (Man-translate-references ";id") + "\\;id")) + (should (equal (Man-translate-references "-k basename") + "-k basename"))) + (provide 'man-tests) ;;; man-tests.el ends here -- cgit v1.2.3 From c12166de380397168e374931c4e59bbb3a09bf21 Mon Sep 17 00:00:00 2001 From: Augusto Stoffel Date: Wed, 27 Sep 2023 18:35:32 +0200 Subject: Use auth-info-mode for non-hidden authinfo and netrc files * files.el (auto-mode-alist): Match non-hidden authinfo and netrc files, since it is reasonable to store passwords in ~/.emacs.d/authinfo.gpg or a similarly named file. (Bug#66241) --- lisp/files.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/files.el b/lisp/files.el index 8b4e4394e5a..9c8914bfc50 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3059,7 +3059,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" . ("\\.docbook\\'" . sgml-mode) ("\\.com\\'" . dcl-mode) ("/config\\.\\(?:bat\\|log\\)\\'" . fundamental-mode) - ("/\\.\\(authinfo\\|netrc\\)\\'" . authinfo-mode) + ("/\\.?\\(authinfo\\|netrc\\)\\'" . authinfo-mode) ;; Windows candidates may be opened case sensitively on Unix ("\\.\\(?:[iI][nN][iI]\\|[lL][sS][tT]\\|[rR][eE][gG]\\|[sS][yY][sS]\\)\\'" . conf-mode) ("\\.la\\'" . conf-unix-mode) -- cgit v1.2.3 From 9eed00c8e5ac697203dc24331c60bd2bb0b90b5d Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Tue, 14 Feb 2023 09:18:37 +0200 Subject: Handle anonymous commands in C-h K * lisp/info.el (Info-goto-emacs-key-command-node): Don't call Info-goto-emacs-command-node for anonymous commands. (Bug#61505) --- lisp/info.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/info.el b/lisp/info.el index f4384934155..02ba8b0eff9 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -4733,8 +4733,11 @@ the variable `Info-file-list-for-emacs'." (eq command 'execute-extended-command)) (Info-goto-emacs-command-node (read-command "Find documentation for command: "))) + ((symbolp command) + (Info-goto-emacs-command-node command)) (t - (Info-goto-emacs-command-node command))))) + (message "%s invokes an anonymous command" + (key-description key)))))) (defvar Info-link-keymap (let ((keymap (make-sparse-keymap))) -- cgit v1.2.3 From 6a645cd53289853bc2239657d2b0bb6384875903 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Jan 2024 23:50:16 +0100 Subject: ; Clarify message in last change * lisp/info.el (Info-goto-emacs-key-command-node): Clarify message in last change. --- lisp/info.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/info.el b/lisp/info.el index 02ba8b0eff9..e56344825b9 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -4736,8 +4736,11 @@ the variable `Info-file-list-for-emacs'." ((symbolp command) (Info-goto-emacs-command-node command)) (t - (message "%s invokes an anonymous command" - (key-description key)))))) + (message + (substitute-command-keys + (format + "\\`%s' invokes an anonymous command defined with `lambda'" + (key-description key)))))))) (defvar Info-link-keymap (let ((keymap (make-sparse-keymap))) -- cgit v1.2.3 From 1ecb53ad2fc9888ce0d0073c8fc3f36d63394dcd Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 11 Jan 2024 01:21:14 +0200 Subject: vc-log-mergebase: Fix the printing of buttons at the bottom * lisp/vc/vc.el (vc-print-log-setup-buttons): Fix when LIMIT is a string (bug#68364). (vc-print-log-internal): Update docstring. --- lisp/vc/vc.el | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index b8cc44fc3dc..94bc3f0911a 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2703,20 +2703,22 @@ Not all VC backends support short logs!") (defun vc-print-log-setup-buttons (working-revision is-start-revision limit pl-return) "Insert at the end of the current buffer buttons to show more log entries. In the new log, leave point at WORKING-REVISION (if non-nil). -LIMIT is the current maximum number of entries shown. Does -nothing if IS-START-REVISION is non-nil and LIMIT is 1, or if -LIMIT is nil, or if PL-RETURN is `limit-unsupported'." +LIMIT is the current maximum number of entries shown, or the +revision (string) before which to stop. Does nothing if +IS-START-REVISION is non-nil and LIMIT is 1, or if LIMIT is nil, +or if PL-RETURN is `limit-unsupported'." ;; LIMIT=1 is set by vc-annotate-show-log-revision-at-line ;; or by vc-print-root-log with current-prefix-arg=1. ;; In either case only one revision is wanted, no buttons. (when (and limit (not (eq 'limit-unsupported pl-return)) (not (and is-start-revision - (= limit 1)))) + (eql limit 1)))) (let ((entries 0)) (goto-char (point-min)) (while (re-search-forward log-view-message-re nil t) (cl-incf entries)) - (if (< entries limit) + (if (or (stringp limit) + (< entries limit)) ;; The log has been printed in full. Perhaps it started ;; with a copy or rename? ;; FIXME: We'd probably still want this button even when @@ -2811,7 +2813,8 @@ button for. Same for CURRENT-REVISION. LIMIT means the usual." Leave point at WORKING-REVISION, if it is non-nil. If IS-START-REVISION is non-nil, start the log from WORKING-REVISION \(not all backends support this); i.e., show only WORKING-REVISION and -earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." +earlier revisions. Show up to LIMIT entries (non-nil means unlimited). +LIMIT can also be a string, which means the revision before which to stop." ;; Don't switch to the output buffer before running the command, ;; so that any buffer-local settings in the vc-controlled ;; buffer can be accessed by the command. -- cgit v1.2.3 From c7c143b019d5cad8d44a2511953ac76bc4278aa1 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 11 Jan 2024 01:24:17 +0200 Subject: ; (vc-print-log-internal): Update docstring further --- lisp/vc/vc.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 94bc3f0911a..f612daaa569 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2813,7 +2813,7 @@ button for. Same for CURRENT-REVISION. LIMIT means the usual." Leave point at WORKING-REVISION, if it is non-nil. If IS-START-REVISION is non-nil, start the log from WORKING-REVISION \(not all backends support this); i.e., show only WORKING-REVISION and -earlier revisions. Show up to LIMIT entries (non-nil means unlimited). +earlier revisions. Show up to LIMIT entries (nil means unlimited). LIMIT can also be a string, which means the revision before which to stop." ;; Don't switch to the output buffer before running the command, ;; so that any buffer-local settings in the vc-controlled -- cgit v1.2.3 From 63411709a8dbad8b17c7f1e0cfed99f4aeb174a1 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 11 Jan 2024 00:32:15 +0100 Subject: ; Fix typos --- doc/misc/widget.texi | 2 +- etc/TODO | 2 +- lisp/progmodes/python.el | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi index 82d89449dd2..d4f2ba1e76c 100644 --- a/doc/misc/widget.texi +++ b/doc/misc/widget.texi @@ -1592,7 +1592,7 @@ Example: (widget-create 'variable-link :button-prefix "" :button-suffix "" - :tag "What setting controlls button-prefix?" + :tag "What setting controls button-prefix?" 'widget-button-prefix) @end lisp diff --git a/etc/TODO b/etc/TODO index a672b6b5b72..9b3796515d2 100644 --- a/etc/TODO +++ b/etc/TODO @@ -156,7 +156,7 @@ from. ** Make back_comment use syntax-ppss or equivalent -* Make play-sound asynchronous and non-blocking +** Make play-sound asynchronous and non-blocking ** Consider improving src/sysdep.c's search for a fqdn https://lists.gnu.org/r/emacs-devel/2007-04/msg00782.html diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 3247291b6ee..9849fde8588 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1107,7 +1107,7 @@ fontified." (defun python--treesit-fontify-union-types (node override start end &optional type-regex &rest _) "Fontify nested union types in the type hints. -For examlpe, Lvl1 | Lvl2[Lvl3[Lvl4[Lvl5 | None]], Lvl2]. This +For example, Lvl1 | Lvl2[Lvl3[Lvl4[Lvl5 | None]], Lvl2]. This structure is represented via nesting binary_operator and subscript nodes. This function iterates over all levels and highlight identifier nodes. If TYPE-REGEX is not nil fontify type @@ -1265,7 +1265,7 @@ fontified." (subscript (identifier) @font-lock-type-face) (subscript (attribute attribute: (identifier) @font-lock-type-face))])) - ;; Patern matching: case [str(), pack0.Type0()]. Take only the + ;; Pattern matching: case [str(), pack0.Type0()]. Take only the ;; last identifier. (class_pattern (dotted_name (identifier) @font-lock-type-face :anchor)) -- cgit v1.2.3 From cfa64bdc84d18dba55443939b37107e0b3524f08 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 9 Jan 2024 14:50:43 -0800 Subject: ; Fix overridden erc--input-split slot definition * lisp/erc/erc-common.el (erc--input-split): Don't set the default value to `:read-only'. * test/lisp/erc/erc-tests.el (erc--channel-modes, erc--channel-modes/graphic-p): Use `char-displayable-p' instead of `display-graphic-p' to prevent the first test from failing on Unicode terminal emulators. --- lisp/erc/erc-common.el | 2 +- test/lisp/erc/erc-tests.el | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 28ab6aad466..e7e70fffd3a 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -52,7 +52,7 @@ string insertp sendp) (cl-defstruct (erc--input-split (:include erc-input - (string :read-only) + (string "" :read-only t) (insertp erc-insert-this) (sendp (with-suppressed-warnings ((obsolete erc-send-this)) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 2318fed28f2..b3912cab33d 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -849,7 +849,7 @@ ;; truncation ellipsis when run interactively. Rather than have ;; hard-to-read "nondeterministic" comparisons against sets of ;; acceptable values, we use separate tests. - (when (display-graphic-p) (ert-pass)) + (when (char-displayable-p ?…) (ert-pass)) ;; Truncation cache populated and used. (let ((cache (erc--channel-mode-types-shortargs erc--channel-mode-types)) @@ -877,7 +877,7 @@ (ert-deftest erc--channel-modes/graphic-p () :tags `(:unstable ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) - (unless (display-graphic-p) (ert-skip "See non-/graphic-p variant")) + (unless (char-displayable-p ?…) (ert-skip "See non-/graphic-p variant")) (erc-tests-common-init-server-proc "sleep" "1") (setq erc--isupport-params (make-hash-table) -- cgit v1.2.3 From dc1f18e9d0863a03e00134b36279101f0747fcfb Mon Sep 17 00:00:00 2001 From: Gabriel do Nascimento Ribeiro Date: Sat, 23 Sep 2023 04:32:02 -0300 Subject: Consider outline-heading-end-regexp in outline-font-lock-keywords * lisp/outline.el (outline-font-lock-keywords): Add outline-heading-end-regexp to regexp (bug#66166). --- lisp/outline.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/outline.el b/lisp/outline.el index 96e0d0df205..b50708c1a7b 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -260,7 +260,7 @@ non-nil and point is located on the heading line.") '( ;; Highlight headings according to the level. (eval . (list (or outline-search-function - (concat "^\\(?:" outline-regexp "\\).*")) + (concat "^\\(?:" outline-regexp "\\).*" outline-heading-end-regexp)) 0 '(if outline-minor-mode (if outline-minor-mode-highlight (list 'face (outline-font-lock-face))) -- cgit v1.2.3 From c7aa5c6d2b838e2fd84db4cbdafdbd546dd87832 Mon Sep 17 00:00:00 2001 From: Jared Finder Date: Mon, 8 Jan 2024 13:20:25 -0800 Subject: Populate tool-bar bindings on text terminals * lisp/tool-bar.el (tool-bar-make-keymap-1): Populate on text terminals. (Bug#68334) --- lisp/tool-bar.el | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index 4ca81fb01e0..96b61c7b229 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -165,6 +165,8 @@ color capability and based on the available image libraries." base-keymap) base-keymap))) +;; This function should return binds even if images can not be +;; displayed so the tool bar can still be displayed on terminals. (defun tool-bar-make-keymap-1 (&optional map) "Generate an actual keymap from `tool-bar-map', without caching. MAP is either a keymap to use as a source for menu items, or nil, @@ -180,15 +182,14 @@ in which case the value of `tool-bar-map' is used instead." (consp image-exp) (not (eq (car image-exp) 'image)) (fboundp (car image-exp))) - (if (not (display-images-p)) - (setq bind nil) - (let ((image (eval image-exp))) - (unless (and image (image-mask-p image)) - (setq image (append image '(:mask heuristic)))) - (setq bind (copy-sequence bind) - plist (nthcdr (if (consp (nth 4 bind)) 5 4) - bind)) - (plist-put plist :image image)))) + (let ((image (and (display-images-p) + (eval image-exp)))) + (unless (and image (image-mask-p image)) + (setq image (append image '(:mask heuristic)))) + (setq bind (copy-sequence bind) + plist (nthcdr (if (consp (nth 4 bind)) 5 4) + bind)) + (plist-put plist :image image))) bind)) (or map tool-bar-map))) -- cgit v1.2.3 From ef08f94cbec1a9fb98bc1bbfcc88cd399b7ff8d0 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 11 Jan 2024 12:30:05 +0100 Subject: Support numeric port numbers in auth-source-macos-keychain * lisp/auth-source.el (auth-source-macos-keychain-search): Support numeric port numbers (bug#68376). (auth-source-macos-keychain-search-items): Make regexp more robust. * test/lisp/auth-source-tests.el (test-macos-keychain-search): Extend test. --- lisp/auth-source.el | 14 ++++++++------ test/lisp/auth-source-tests.el | 28 ++++++++++++++++++---------- 2 files changed, 26 insertions(+), 16 deletions(-) (limited to 'lisp') diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 369cf4dca2e..cf93cb05fba 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -1946,18 +1946,20 @@ entries for git.gnus.org: (returned-keys (delete-dups (append '(:host :login :port :secret) search-keys))) - ;; Extract host and port from spec + ;; Extract host, port and user from spec (hosts (plist-get spec :host)) - (hosts (if (and hosts (listp hosts)) hosts `(,hosts))) + (hosts (if (consp hosts) hosts `(,hosts))) (ports (plist-get spec :port)) - (ports (if (and ports (listp ports)) ports `(,ports))) + (ports (if (consp ports) ports `(,ports))) (users (plist-get spec :user)) - (users (if (and users (listp users)) users `(,users))) + (users (if (consp users) users `(,users))) ;; Loop through all combinations of host/port and pass each of these to - ;; auth-source-macos-keychain-search-items + ;; auth-source-macos-keychain-search-items. Convert numeric port to + ;; string (bug#68376). (items (catch 'match (dolist (host hosts) (dolist (port ports) + (when (numberp port) (setq port (number-to-string port))) (dolist (user users) (let ((items (apply #'auth-source-macos-keychain-search-items @@ -2019,7 +2021,7 @@ entries for git.gnus.org: (when port (if keychain-generic (setq args (append args (list "-s" port))) - (setq args (append args (if (string-match "[0-9]+" port) + (setq args (append args (if (string-match-p "\\`[[:digit:]]+\\'" port) (list "-P" port) (list "-r" (substring (format "%-4s" port) diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index 5452501b861..2ff76977174 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -442,18 +442,26 @@ machine c1 port c2 user c3 password c4\n" (cl-letf (((symbol-function 'call-process) (lambda (_program _infile _destination _display &rest args) - ;; Arguments must be all strings + ;; Arguments must be all strings. (should (cl-every #'stringp args)) - ;; Argument number should be even + ;; Argument number should be even. (should (cl-evenp (length args))) - (should (cond ((string= (car args) "find-internet-password") - (let ((protocol (cl-member "-r" args :test #'string=))) - (if protocol - (= 4 (length (cadr protocol))) - t))) - ((string= (car args) "find-generic-password") - t)))))) - (auth-source-search :user '("a" "b") :host '("example.org") :port '("irc" "ftp" "https"))))) + (should + (cond + ((string= (car args) "find-internet-password") + (let ((protocol-r (cl-member "-r" args :test #'string=)) + (protocol-P (cl-member "-P" args :test #'string=))) + (cond (protocol-r + (= 4 (length (cadr protocol-r)))) + (protocol-P + (string-match-p + "\\`[[:digit:]]+\\'" (cadr protocol-P))) + (t)))) + ((string= (car args) "find-generic-password") + t)))))) + (auth-source-search + :user '("a" "b") :host '("example.org") + :port '("irc" "ftp" "https" 123))))) (provide 'auth-source-tests) ;;; auth-source-tests.el ends here -- cgit v1.2.3 From 07bb8dc0afaef5ec7a7e194df42cc019ce8604d4 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Thu, 11 Jan 2024 17:54:47 +0000 Subject: Bind cross-buffer buffer-local variable correctly. This fixes bug#68200. * lisp/emacs-lisp/bytecomp.el (byte-compile-output-docform): Note that let-binding a buffer local variable leaves it buffer local, hence to transfer the binding of byte-compile-dynamic-docstrings to the output buffer, an intermediate variable is needed. Implement this. --- lisp/emacs-lisp/bytecomp.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 2bc8d54ba77..ea9298c6646 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2605,9 +2605,10 @@ list that represents a doc string reference. `defvaralias', `autoload' and `custom-declare-variable' need that." ;; We need to examine byte-compile-dynamic-docstrings ;; in the input buffer (now current), not in the output buffer. - (let ((byte-compile-dynamic-docstrings byte-compile-dynamic-docstrings)) + (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) (with-current-buffer byte-compile--outbuffer - (let ((position (point)) + (let ((byte-compile-dynamic-docstrings dynamic-docstrings) + (position (point)) (print-continuous-numbering t) print-number-table ;; FIXME: The bindings below are only needed for when we're -- cgit v1.2.3 From a66069c50c8eaf4a3ee253e7b7e47af48e721585 Mon Sep 17 00:00:00 2001 From: john muhl Date: Sat, 6 Jan 2024 09:36:33 -0600 Subject: Support indented continuation lines in lua-ts-mode * lisp/progmodes/lua-ts-mode.el (lua-ts--simple-indent-rules): Add a rule to indent multi-line assignments and if statements. (lua-ts-indent-continuation-lines): New user option. * test/lisp/progmodes/lua-ts-mode-resources/indent.erts: Add tests. (Bug#68279) --- lisp/progmodes/lua-ts-mode.el | 49 ++++++++++ .../progmodes/lua-ts-mode-resources/indent.erts | 106 +++++++++++++++++++++ 2 files changed, 155 insertions(+) (limited to 'lisp') diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 3b600f59521..05a3ff6d7c6 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -122,6 +122,28 @@ :group 'lua-ts :version "30.1") +(defcustom lua-ts-indent-continuation-lines t + "Controls how multi-line if/else statements are aligned. + +If t, then continuation lines are indented by `lua-ts-indent-offset': + + if a + and b then + print(1) + end + +If nil, then continuation lines are aligned with the beginning of +the statement: + + if a + and b then + print(1) + end" + :type 'boolean + :safe 'booleanp + :group 'lua-ts + :version "30.1") + (defvar lua-ts--builtins '("assert" "bit32" "collectgarbage" "coroutine" "debug" "dofile" "error" "getmetatable" "io" "ipairs" "load" "loadfile" @@ -329,6 +351,17 @@ values of OVERRIDE." ((or (match "end" "function_definition") (node-is "end")) standalone-parent 0) + ((n-p-gp "expression_list" "assignment_statement" "variable_declaration") + lua-ts--variable-declaration-continuation-anchor + lua-ts-indent-offset) + ((and (parent-is "binary_expression") + lua-ts--variable-declaration-continuation) + lua-ts--variable-declaration-continuation-anchor + lua-ts-indent-offset) + ((and (lambda (&rest _) lua-ts-indent-continuation-lines) + (parent-is "binary_expression")) + standalone-parent lua-ts-indent-offset) + ((parent-is "binary_expression") standalone-parent 0) ((or (parent-is "function_declaration") (parent-is "function_definition") (parent-is "do_statement") @@ -415,6 +448,22 @@ values of OVERRIDE." (treesit-induce-sparse-tree parent #'lua-ts--function-definition-p))) (= 1 (length (cadr sparse-tree))))) +(defun lua-ts--variable-declaration-continuation (node &rest _) + "Matches if NODE is part of a multi-line variable declaration." + (treesit-parent-until node + (lambda (p) + (equal "variable_declaration" + (treesit-node-type p))))) + +(defun lua-ts--variable-declaration-continuation-anchor (node &rest _) + "Return the start position of the variable declaration for NODE." + (save-excursion + (goto-char (treesit-node-start + (lua-ts--variable-declaration-continuation node))) + (when (looking-back (rx bol (* whitespace)) + (line-beginning-position)) + (point)))) + (defvar lua-ts--syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?+ "." table) diff --git a/test/lisp/progmodes/lua-ts-mode-resources/indent.erts b/test/lisp/progmodes/lua-ts-mode-resources/indent.erts index 9797467bbe5..48184160b4d 100644 --- a/test/lisp/progmodes/lua-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/lua-ts-mode-resources/indent.erts @@ -529,6 +529,58 @@ local Other = { } =-=-= +Name: Continuation Indent + +=-= +local very_long_variable_name = +"ok".. + "ok" +local n = a + +b * +c / +1 +local x = "A".. +"B" +.."C" +if a + and b + and c then + if x + and y then + local x = 1 + +2 * + 3 + end +elseif a + or b + or c then +end +=-= +local very_long_variable_name = + "ok".. + "ok" +local n = a + + b * + c / + 1 +local x = "A".. + "B" + .."C" +if a + and b + and c then + if x + and y then + local x = 1 + + 2 * + 3 + end +elseif a + or b + or c then +end +=-=-= + Code: (lambda () (setq indent-tabs-mode nil) @@ -677,3 +729,57 @@ function e (n, t) end)(i(...)) end end end =-=-= + +Code: + (lambda () + (setq indent-tabs-mode nil) + (setq lua-ts-indent-continuation-lines nil) + (setq lua-ts-indent-offset 2) + (lua-ts-mode) + (indent-region (point-min) (point-max))) + +Name: Unaligned Continuation Indent + +=-= +local n = a + + b * + c / + 1 +if a + and b +and c then + if x + and y then + local x = 1 + + 2 * + 3 + end +elseif a + or b + or c then + if x + or y + end +end +=-= +local n = a + + b * + c / + 1 +if a +and b +and c then + if x + and y then + local x = 1 + + 2 * + 3 + end +elseif a +or b +or c then + if x + or y + end +end +=-=-= -- cgit v1.2.3 From e4e89e2cb663c730fd563d89228fe3a9a34e63e5 Mon Sep 17 00:00:00 2001 From: Alyssa Ross Date: Thu, 9 Nov 2023 15:46:30 +0100 Subject: Add autoload cookie to vc-git-grep * lisp/vc/vc-git.el (vc-git-grep): Add autoload cookie. (Bug#67018) --- lisp/vc/vc-git.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index fed15ae2033..456417e566e 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1982,6 +1982,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (defvar compilation-environment) ;; Derived from `lgrep'. +;;;###autoload (defun vc-git-grep (regexp &optional files dir) "Run git grep, searching for REGEXP in FILES in directory DIR. The search is limited to file names matching shell pattern FILES. -- cgit v1.2.3 From eac3f2a80778b3904c55ae7b65ff862a79eebf2a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 11 Jan 2024 22:12:34 -0500 Subject: sh-script.el: Add support for `case FOO {...}` (bug#55764) * lisp/progmodes/sh-script.el (sh-font-lock-paren): Also recognize `FOO)` after `{`. (sh-smie-sh-rules): Make `for` rule apply to `case FOO { ...}` as well. * test/manual/indent/shell.sh: Add new test case. --- lisp/progmodes/sh-script.el | 7 ++++--- test/manual/indent/shell.sh | 7 +++++++ 2 files changed, 11 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 0562415b4e5..2a650fe0ea6 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1054,7 +1054,8 @@ subshells can nest." ;; a normal command rather than the real `in' keyword. ;; I.e. we should look back to try and find the ;; corresponding `case'. - (and (looking-at ";\\(?:;&?\\|[&|]\\)\\|\\_ Date: Fri, 12 Jan 2024 17:50:09 -0500 Subject: (mwheel--is-dir-p): New macro to reduce code duplication It also slightly reduces memory allocation. * lisp/mwheel.el (mwheel--is-dir-p): New macro. (mwheel-scroll, mouse-wheel-text-scale) (mouse-wheel-global-text-scale): Use it. --- lisp/mwheel.el | 45 +++++++++++++++++++++++---------------------- 1 file changed, 23 insertions(+), 22 deletions(-) (limited to 'lisp') diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 735adf42f68..84679f5c33f 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -305,6 +305,15 @@ active window." frame nil t))))) (mwheel-event-window event))) +(defmacro mwheel--is-dir-p (dir button) + (declare (debug (sexp form))) + (let ((custom-var (intern (format "mouse-wheel-%s-event" dir))) + (custom-var-alt (intern (format "mouse-wheel-%s-alternate-event" dir)))) + (macroexp-let2 nil butsym button + `(or (eq ,butsym ,custom-var) + ;; We presume here `button' is never nil. + (eq ,butsym ,custom-var-alt))))) + (defun mwheel-scroll (event &optional arg) "Scroll up or down according to the EVENT. This should be bound only to mouse buttons 4, 5, 6, and 7 on @@ -342,16 +351,14 @@ value of ARG, and the command uses it in subsequent scrolls." (condition-case nil (unwind-protect (let ((button (event-basic-type event))) - (cond ((and (eq amt 'hscroll) (memq button (list mouse-wheel-down-event - mouse-wheel-down-alternate-event))) + (cond ((and (eq amt 'hscroll) (mwheel--is-dir-p down button)) (when (and (natnump arg) (> arg 0)) (setq mouse-wheel-scroll-amount-horizontal arg)) (funcall (if mouse-wheel-flip-direction mwheel-scroll-left-function mwheel-scroll-right-function) mouse-wheel-scroll-amount-horizontal)) - ((memq button (list mouse-wheel-down-event - mouse-wheel-down-alternate-event)) + ((mwheel--is-dir-p down button) (condition-case nil (funcall mwheel-scroll-down-function amt) ;; Make sure we do indeed scroll to the beginning of ;; the buffer. @@ -366,31 +373,29 @@ value of ARG, and the command uses it in subsequent scrolls." ;; for a reason that escapes me. This problem seems ;; to only affect scroll-down. --Stef (set-window-start (selected-window) (point-min)))))) - ((and (eq amt 'hscroll) (memq button (list mouse-wheel-up-event - mouse-wheel-up-alternate-event))) + ((and (eq amt 'hscroll) (mwheel--is-dir-p up button)) (when (and (natnump arg) (> arg 0)) (setq mouse-wheel-scroll-amount-horizontal arg)) (funcall (if mouse-wheel-flip-direction mwheel-scroll-right-function mwheel-scroll-left-function) mouse-wheel-scroll-amount-horizontal)) - ((memq button (list mouse-wheel-up-event - mouse-wheel-up-alternate-event)) + ((mwheel--is-dir-p up button) (condition-case nil (funcall mwheel-scroll-up-function amt) ;; Make sure we do indeed scroll to the end of the buffer. (end-of-buffer (while t (funcall mwheel-scroll-up-function))))) - ((memq button (list mouse-wheel-left-event - mouse-wheel-left-alternate-event)) ; for tilt scroll + ((mwheel--is-dir-p left button) ; for tilt scroll (when mouse-wheel-tilt-scroll (funcall (if mouse-wheel-flip-direction mwheel-scroll-right-function - mwheel-scroll-left-function) amt))) - ((memq button (list mouse-wheel-right-event - mouse-wheel-right-alternate-event)) ; for tilt scroll + mwheel-scroll-left-function) + amt))) + ((mwheel--is-dir-p right button) ; for tilt scroll (when mouse-wheel-tilt-scroll (funcall (if mouse-wheel-flip-direction mwheel-scroll-left-function - mwheel-scroll-right-function) amt))) + mwheel-scroll-right-function) + amt))) (t (error "Bad binding in mwheel-scroll")))) (if (eq scroll-window selected-window) ;; If there is a temporarily active region, deactivate it if @@ -431,11 +436,9 @@ See also `text-scale-adjust'." (button (event-basic-type event))) (select-window scroll-window 'mark-for-redisplay) (unwind-protect - (cond ((memq button (list mouse-wheel-down-event - mouse-wheel-down-alternate-event)) + (cond ((mwheel--is-dir-p down button) (text-scale-increase 1)) - ((memq button (list mouse-wheel-up-event - mouse-wheel-up-alternate-event)) + ((mwheel--is-dir-p up button) (text-scale-decrease 1))) (select-window selected-window)))) @@ -445,11 +448,9 @@ See also `text-scale-adjust'." This invokes `global-text-scale-adjust', which see." (interactive (list last-input-event)) (let ((button (event-basic-type event))) - (cond ((memq button (list mouse-wheel-down-event - mouse-wheel-down-alternate-event)) + (cond ((mwheel--is-dir-p down button) (global-text-scale-adjust 1)) - ((memq button (list mouse-wheel-up-event - mouse-wheel-up-alternate-event)) + ((mwheel--is-dir-p up button) (global-text-scale-adjust -1))))) (defun mouse-wheel--add-binding (key fun) -- cgit v1.2.3 From f2cc8ee2a1a106f9045447a1a025572d7938647e Mon Sep 17 00:00:00 2001 From: kobarity Date: Sat, 6 Jan 2024 22:04:42 +0900 Subject: Fix 'python-info-docstring-p' bug in the 2nd line of a buffer * lisp/progmodes/python.el (python-info-docstring-p): Add 'looking-at-p' check when bobp. * test/lisp/progmodes/python-tests.el (python-font-lock-operator-1) (python-font-lock-operator-2): Restoration of ERTs deleted by mistake. (python-font-lock-escape-sequence-bytes-newline) (python-font-lock-escape-sequence-hex-octal) (python-font-lock-escape-sequence-unicode) (python-font-lock-raw-escape-sequence): Change 'font-lock-doc-face' to 'font-lock-string-face' and remove :expected-result :failed. (python-info-docstring-p-8): New test. (Bug#68284) --- lisp/progmodes/python.el | 4 +- test/lisp/progmodes/python-tests.el | 73 +++++++++++++++++++++++++------------ 2 files changed, 53 insertions(+), 24 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 1148da11a06..a44d4215d7c 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -6260,7 +6260,9 @@ point's current `syntax-ppss'." counter))) (python-util-forward-comment -1) (python-nav-beginning-of-statement) - (cond ((bobp)) + (cond ((and (bobp) (save-excursion + (python-util-forward-comment) + (looking-at-p re)))) ((python-info-assignment-statement-p) t) ((python-info-looking-at-beginning-of-defun)) (t nil)))))) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 1df0c42a0ce..97ffd5fe20f 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -474,6 +474,28 @@ def f(x: CustomInt) -> CustomInt: (136 . font-lock-operator-face) (137) (144 . font-lock-keyword-face) (150)))) +(ert-deftest python-font-lock-operator-1 () + (python-tests-assert-faces + "1 << 2 ** 3 == +4%-5|~6&7^8%9" + '((1) + (3 . font-lock-operator-face) (5) + (8 . font-lock-operator-face) (10) + (13 . font-lock-operator-face) (15) + (16 . font-lock-operator-face) (17) + (18 . font-lock-operator-face) (20) + (21 . font-lock-operator-face) (23) + (24 . font-lock-operator-face) (25) + (26 . font-lock-operator-face) (27) + (28 . font-lock-operator-face) (29)))) + +(ert-deftest python-font-lock-operator-2 () + "Keyword operators are font-locked as keywords." + (python-tests-assert-faces + "is_ is None" + '((1) + (5 . font-lock-keyword-face) (7) + (8 . font-lock-constant-face)))) + (ert-deftest python-font-lock-escape-sequence-string-newline () (python-tests-assert-faces "'\\n' @@ -585,62 +607,58 @@ u\"\\n\"" (845 . font-lock-string-face) (886)))) (ert-deftest python-font-lock-escape-sequence-bytes-newline () - :expected-result :failed (python-tests-assert-faces "b'\\n' b\"\\n\"" '((1) - (2 . font-lock-doc-face) + (2 . font-lock-string-face) (3 . font-lock-constant-face) - (5 . font-lock-doc-face) (6) - (8 . font-lock-doc-face) + (5 . font-lock-string-face) (6) + (8 . font-lock-string-face) (9 . font-lock-constant-face) - (11 . font-lock-doc-face)))) + (11 . font-lock-string-face)))) (ert-deftest python-font-lock-escape-sequence-hex-octal () - :expected-result :failed (python-tests-assert-faces "b'\\x12 \\777 \\1\\23' '\\x12 \\777 \\1\\23'" '((1) - (2 . font-lock-doc-face) + (2 . font-lock-string-face) (3 . font-lock-constant-face) - (7 . font-lock-doc-face) + (7 . font-lock-string-face) (8 . font-lock-constant-face) - (12 . font-lock-doc-face) + (12 . font-lock-string-face) (13 . font-lock-constant-face) - (18 . font-lock-doc-face) (19) - (20 . font-lock-doc-face) + (18 . font-lock-string-face) (19) + (20 . font-lock-string-face) (21 . font-lock-constant-face) - (25 . font-lock-doc-face) + (25 . font-lock-string-face) (26 . font-lock-constant-face) - (30 . font-lock-doc-face) + (30 . font-lock-string-face) (31 . font-lock-constant-face) - (36 . font-lock-doc-face)))) + (36 . font-lock-string-face)))) (ert-deftest python-font-lock-escape-sequence-unicode () - :expected-result :failed (python-tests-assert-faces "b'\\u1234 \\U00010348 \\N{Plus-Minus Sign}' '\\u1234 \\U00010348 \\N{Plus-Minus Sign}'" '((1) - (2 . font-lock-doc-face) (41) - (42 . font-lock-doc-face) + (2 . font-lock-string-face) (41) + (42 . font-lock-string-face) (43 . font-lock-constant-face) - (49 . font-lock-doc-face) + (49 . font-lock-string-face) (50 . font-lock-constant-face) - (60 . font-lock-doc-face) + (60 . font-lock-string-face) (61 . font-lock-constant-face) - (80 . font-lock-doc-face)))) + (80 . font-lock-string-face)))) (ert-deftest python-font-lock-raw-escape-sequence () - :expected-result :failed (python-tests-assert-faces "rb'\\x12 \123 \\n' r'\\x12 \123 \\n \\u1234 \\U00010348 \\N{Plus-Minus Sign}'" '((1) - (3 . font-lock-doc-face) (14) - (16 . font-lock-doc-face)))) + (3 . font-lock-string-face) (14) + (16 . font-lock-string-face)))) ;;; Indentation @@ -6647,6 +6665,15 @@ class Class: (python-tests-look-at "Also not a docstring") (should-not (python-info-docstring-p)))) +(ert-deftest python-info-docstring-p-8 () + "Test string in the 2nd line of a buffer." + (python-tests-with-temp-buffer + "import sys +'''Not a docstring.''' +" + (python-tests-look-at "Not a docstring") + (should-not (python-info-docstring-p)))) + (ert-deftest python-info-triple-quoted-string-p-1 () "Test triple quoted string." (python-tests-with-temp-buffer -- cgit v1.2.3 From 9b8b352ebc09de3259f655fa4d491507109044b3 Mon Sep 17 00:00:00 2001 From: Steven Allen Date: Sat, 6 Jan 2024 09:19:12 -0800 Subject: Set the 'name' prop in 'define-advice' In addition to naming the advice function `symbol@name', set the 'name' property to NAME. * lisp/emacs-lisp/nadvice.el (define-advice): set the 'name' property to NAME (requested in Bug#68114). Fixes Bug#68294. * doc/lispref/functions.texi (Advising Named Functions): Document that 'define-advice' installs the advice with the specified name. --- doc/lispref/functions.texi | 7 ++++--- etc/NEWS | 6 ++++++ lisp/emacs-lisp/nadvice.el | 8 +++++--- 3 files changed, 15 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 29e9f04a076..29061e6561c 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -2066,9 +2066,10 @@ code) obey the advice and other calls (from C code) do not. @defmac define-advice symbol (where lambda-list &optional name depth) &rest body This macro defines a piece of advice and adds it to the function named -@var{symbol}. The advice is an anonymous function if @var{name} is -@code{nil} or a function named @code{symbol@@name}. See -@code{advice-add} for explanation of other arguments. +@var{symbol}. If @var{name} is non-nil, the advice is named +@code{@var{symbol}@@@var{name}} and installed with the name @var{name}; otherwise, +the advice is anonymous. See @code{advice-add} for explanation of +other arguments. @end defmac @defun advice-add symbol where function &optional props diff --git a/etc/NEWS b/etc/NEWS index bce33f96aee..5cf3e821627 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1410,6 +1410,12 @@ values. * Lisp Changes in Emacs 30.1 ++++ +** 'define-advice' now sets the new advice's 'name' property to NAME +Named advice defined with 'define-advice' can now be removed with +'(advice-remove SYMBOL NAME)' in addition to '(advice-remove SYMBOL +SYMBOL@NAME)'. + +++ ** New function 'require-with-check' to detect new versions shadowing. This is like 'require', but it checks whether the argument 'feature' diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index de287e43b21..7524ab18e58 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -585,8 +585,8 @@ of the piece of advice." (defmacro define-advice (symbol args &rest body) "Define an advice and add it to function named SYMBOL. See `advice-add' and `add-function' for explanation on the -arguments. Note if NAME is nil the advice is anonymous; -otherwise it is named `SYMBOL@NAME'. +arguments. If NAME is non-nil, the advice is named `SYMBOL@NAME' +and installed with the name NAME; otherwise, the advice is anonymous. \(fn SYMBOL (HOW LAMBDA-LIST &optional NAME DEPTH) &rest BODY)" (declare (indent 2) (doc-string 3) (debug (sexp sexp def-body))) @@ -597,7 +597,9 @@ otherwise it is named `SYMBOL@NAME'. (lambda-list (nth 1 args)) (name (nth 2 args)) (depth (nth 3 args)) - (props (and depth `((depth . ,depth)))) + (props (append + (and depth `((depth . ,depth))) + (and name `((name . ,name))))) (advice (cond ((null name) `(lambda ,lambda-list ,@body)) ((or (stringp name) (symbolp name)) (intern (format "%s@%s" symbol name))) -- cgit v1.2.3 From 740953d1a2f4ea4a200637872b9ecb7dfddfdbe4 Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Tue, 2 Jan 2024 09:06:13 +0100 Subject: Fix 'what-page' * lisp/textmodes/page.el (page--what-page): Adjust for 1st line on page, and use 'count-lines' again. (Bug#68215) * test/lisp/textmodes/page-tests.el (page-tests-what-page): Update test. --- lisp/textmodes/page.el | 8 +++++--- test/lisp/textmodes/page-tests.el | 6 +++++- 2 files changed, 10 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el index e8621ee0383..1c7561d71c6 100644 --- a/lisp/textmodes/page.el +++ b/lisp/textmodes/page.el @@ -159,21 +159,23 @@ point, respectively." total before after))) (defun page--what-page () - "Return a list of the page and line number of point." + "Return a list of the page and line number of point. +The line number is relative to the start of the page." (save-restriction (widen) (save-excursion (let ((count 1) + (adjust (if (or (bolp) (looking-back page-delimiter)) 1 0)) (opoint (point))) (goto-char (point-min)) (while (re-search-forward page-delimiter opoint t) (when (= (match-beginning 0) (match-end 0)) (forward-char)) (setq count (1+ count))) - (list count (line-number-at-pos opoint)))))) + (list count (+ adjust (count-lines (point) opoint))))))) (defun what-page () - "Print page and line number of point." + "Display the page number, and the line number within that page." (interactive) (apply #'message (cons "Page %d, line %d" (page--what-page)))) diff --git a/test/lisp/textmodes/page-tests.el b/test/lisp/textmodes/page-tests.el index f3a2c5fbe00..617b59a54fb 100644 --- a/test/lisp/textmodes/page-tests.el +++ b/test/lisp/textmodes/page-tests.el @@ -106,10 +106,14 @@ (insert "foo\n \nbar\n \nbaz") (goto-char (point-min)) (should (equal (page--what-page) '(1 1))) + (forward-char) + (should (equal (page--what-page) '(1 1))) (forward-page) + (should (equal (page--what-page) '(2 1))) + (next-line) (should (equal (page--what-page) '(2 2))) (forward-page) - (should (equal (page--what-page) '(3 4))))) + (should (equal (page--what-page) '(3 1))))) ;;; page-tests.el ends here -- cgit v1.2.3 From 106cd9aafe8248ef91d7e89161adc5f912ea54eb Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 13 Jan 2024 12:45:10 +0200 Subject: ; * lisp/textmodes/page.el (page--what-page): Fix last change. --- lisp/textmodes/page.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el index 1c7561d71c6..a5de354fc0a 100644 --- a/lisp/textmodes/page.el +++ b/lisp/textmodes/page.el @@ -165,7 +165,7 @@ The line number is relative to the start of the page." (widen) (save-excursion (let ((count 1) - (adjust (if (or (bolp) (looking-back page-delimiter)) 1 0)) + (adjust (if (or (bolp) (looking-back page-delimiter nil)) 1 0)) (opoint (point))) (goto-char (point-min)) (while (re-search-forward page-delimiter opoint t) -- cgit v1.2.3 From 76904626b36910b511d3b0a3e56cc80af90d9361 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 13 Jan 2024 20:16:42 +0200 Subject: * lisp/window.el (window-prefix-map): Bind C-x w q to quit-window (bug#13167) --- lisp/window.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/window.el b/lisp/window.el index e100f25526b..23977691f50 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -10813,7 +10813,8 @@ Used in `repeat-mode'." "^ f" #'tear-off-window "^ t" #'tab-window-detach "-" #'fit-window-to-buffer - "0" #'delete-windows-on) + "0" #'delete-windows-on + "q" #'quit-window) (define-key ctl-x-map "w" window-prefix-map) (provide 'window) -- cgit v1.2.3 From 519c7ca7356fc7f9707b97c143c9495deea5b272 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 30 Dec 2023 15:54:32 +0100 Subject: Don't pretend that hash-table-size is useful * lisp/emacs-lisp/shortdoc.el (hash-table): Remove hash-table-size entry. * doc/lispref/hash.texi (Other Hash): * src/fns.c (Fhash_table_size): Make it clear that hash-table-size is probably not worth using. --- doc/lispref/hash.texi | 3 ++- lisp/emacs-lisp/shortdoc.el | 5 +---- src/fns.c | 12 ++++++++---- 3 files changed, 11 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi index ff9d1799a60..aeaeab27fc0 100644 --- a/doc/lispref/hash.texi +++ b/doc/lispref/hash.texi @@ -386,5 +386,6 @@ This returns the rehash threshold of @var{table}. @end defun @defun hash-table-size table -This returns the current nominal size of @var{table}. +This returns the current allocation size of @var{table}. Since hash table +allocation is managed automatically, this is rarely of interest. @end defun diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 17cbf6b2d31..a6a49c72f74 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -572,10 +572,7 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :result-string "#s(hash-table ...)") (hash-table-count :no-eval (hash-table-count table) - :eg-result 15) - (hash-table-size - :no-eval (hash-table-size table) - :eg-result 65)) + :eg-result 15)) (define-short-documentation-group list "Making Lists" diff --git a/src/fns.c b/src/fns.c index 3765fc74967..70288590e24 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5518,10 +5518,14 @@ DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, DEFUN ("hash-table-size", Fhash_table_size, Shash_table_size, 1, 1, 0, - doc: /* Return the size of TABLE. -The size can be used as an argument to `make-hash-table' to create -a hash table than can hold as many elements as TABLE holds -without need for resizing. */) + doc: /* Return the current allocation size of TABLE. + +This is probably not the function that you are looking for. To get the +number of entries in a table, use `hash-table-count' instead. + +The returned value is the number of entries that TABLE can currently +hold without growing, but since hash tables grow automatically, this +number is rarely of interest. */) (Lisp_Object table) { struct Lisp_Hash_Table *h = check_hash_table (table); -- cgit v1.2.3 From d2c3a983146b7c0fb0f8b855268effb695d0bbf5 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 30 Dec 2023 16:00:28 +0100 Subject: Hash-table documentation updates (bug#68244) * doc/lispref/hash.texi (Creating Hash, Other Hash): Manual updates for make-hash-table, hash-table-rehash-size and hash-table-rehash-threshold. * doc/lispref/objects.texi (Hash Table Type): Update example. * src/fns.c (Fhash_table_rehash_size, Fhash_table_rehash_threshold): Update doc strings. * etc/NEWS: Announce changes. --- doc/lispref/hash.texi | 47 ++++++++--------------------------------------- doc/lispref/objects.texi | 3 +-- etc/NEWS | 15 +++++++++++++++ lisp/emacs-lisp/comp.el | 2 +- src/fns.c | 16 ++++++++-------- 5 files changed, 33 insertions(+), 50 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi index aeaeab27fc0..3d3fe3e3be2 100644 --- a/doc/lispref/hash.texi +++ b/doc/lispref/hash.texi @@ -121,32 +121,10 @@ referenced in the hash table are preserved from garbage collection. @item :size @var{size} This specifies a hint for how many associations you plan to store in the hash table. If you know the approximate number, you can make things a -little more efficient by specifying it this way. If you specify too -small a size, the hash table will grow automatically when necessary, but -doing that takes some extra time. - -The default size is 65. - -@item :rehash-size @var{rehash-size} -When you add an association to a hash table and the table is full, -it grows automatically. This value specifies how to make the hash table -larger, at that time. - -If @var{rehash-size} is an integer, it should be positive, and the hash -table grows by adding approximately that much to the nominal size. If -@var{rehash-size} is floating point, it had better be greater -than 1, and the hash table grows by multiplying the old size by -approximately that number. - -The default value is 1.5. - -@item :rehash-threshold @var{threshold} -This specifies the criterion for when the hash table is full (so -it should be made larger). The value, @var{threshold}, should be a -positive floating-point number, no greater than 1. The hash table is -full whenever the actual number of entries exceeds the nominal size -multiplied by an approximation to this value. The default for -@var{threshold} is 0.8125. +little more efficient by specifying it this way but since the hash +table memory is managed automatically, the gain in speed is rarely +significant. + @end table @end defun @@ -159,7 +137,7 @@ the following specifies a hash table containing the keys (a symbol) and @code{300} (a number) respectively. @example -#s(hash-table size 30 data (key1 val1 key2 300)) +#s(hash-table data (key1 val1 key2 300)) @end example Note, however, that when using this in Emacs Lisp code, it's @@ -172,12 +150,11 @@ The printed representation for a hash table consists of @samp{#s} followed by a list beginning with @samp{hash-table}. The rest of the list should consist of zero or more property-value pairs specifying the hash table's properties and initial contents. The properties and -values are read literally. Valid property names are @code{size}, -@code{test}, @code{weakness}, @code{rehash-size}, -@code{rehash-threshold}, and @code{data}. The @code{data} property +values are read literally. Valid property names are @code{test}, +@code{weakness} and @code{data}. The @code{data} property should be a list of key-value pairs for the initial contents; the other properties have the same meanings as the matching -@code{make-hash-table} keywords (@code{:size}, @code{:test}, etc.), +@code{make-hash-table} keywords (@code{:test} and @code{:weakness}), described above. Note that you cannot specify a hash table whose initial contents @@ -377,14 +354,6 @@ This function returns the @var{weak} value that was specified for hash table @var{table}. @end defun -@defun hash-table-rehash-size table -This returns the rehash size of @var{table}. -@end defun - -@defun hash-table-rehash-threshold table -This returns the rehash threshold of @var{table}. -@end defun - @defun hash-table-size table This returns the current allocation size of @var{table}. Since hash table allocation is managed automatically, this is rarely of interest. diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 111beb5e5b0..07ceb0d7a98 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -1373,8 +1373,7 @@ and contents, like this: @example (make-hash-table) - @result{} #s(hash-table size 65 test eql rehash-size 1.5 - rehash-threshold 0.8125 data ()) + @result{} #s(hash-table) @end example @noindent diff --git a/etc/NEWS b/etc/NEWS index 5cf3e821627..da0253e97dc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1806,6 +1806,21 @@ The former macro returns non-nil if a variable has a connection-local binding. The latter macro returns the connection-local value of a variable if any, or its current value. +** Hash tables + ++++ +*** ':rehash-size' and ':rehash-threshold' args no longer have any effect. +These keyword arguments are now ignored by 'make-hash-table'. Emacs +manages the memory for all hash table objects in the same way. +The functions 'hash-table-rehash-size' and 'hash-table-rehash-threshold' +remain for compatibility but now always return the old default values. + ++++ +*** The printed representation has been shrunk and simplified. +The 'test' parameter is omitted if it is 'eql' (the default), as is +'data' if empty. 'rehash-size', 'rehash-threshold' and 'size' are +always omitted, and ignored if present when the object is read back in. + * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 260bd2f1acb..8441b228898 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1134,7 +1134,7 @@ Return value is the fall-through block name." (defun comp-jump-table-optimizable (jmp-table) "Return t if JMP-TABLE can be optimized out." ;; Identify LAP sequences like: - ;; (byte-constant #s(hash-table size 3 test eq rehash-size 1.5 rehash-threshold 0.8125 purecopy t data (created 126 deleted 126 changed 126)) . 24) + ;; (byte-constant #s(hash-table test eq purecopy t data (created 126 deleted 126 changed 126)) . 24) ;; (byte-switch) ;; (TAG 126 . 10) (let ((targets (hash-table-values jmp-table))) diff --git a/src/fns.c b/src/fns.c index 70288590e24..2905c3f1b86 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5495,25 +5495,25 @@ DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0, DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, Shash_table_rehash_size, 1, 1, 0, - doc: /* Return the current rehash size of TABLE. */) + doc: /* Return the rehash size of TABLE. +This function is for compatibility only; it returns a nominal value +without current significance. */) (Lisp_Object table) { CHECK_HASH_TABLE (table); - /* Nominal factor by which to increase the size of a hash table. - No longer used; this is for compatibility. */ - return make_float (1.5); + return make_float (1.5); /* The old default rehash-size value. */ } DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, Shash_table_rehash_threshold, 1, 1, 0, - doc: /* Return the current rehash threshold of TABLE. */) + doc: /* Return the rehash threshold of TABLE. +This function is for compatibility only; it returns a nominal value +without current significance. */) (Lisp_Object table) { CHECK_HASH_TABLE (table); - /* Nominal threshold for when to resize a hash table. - No longer used; this is for compatibility. */ - return make_float (0.8125); + return make_float (0.8125); /* The old default rehash-threshold value. */ } -- cgit v1.2.3 From 7d869a04029798410773fe6071e76b556d3a9ee2 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 14 Jan 2024 14:47:39 +0100 Subject: Doc fix in auth-source-read-char-choice * lisp/auth-source.el (auth-source-read-char-choice): Don't document 'dropdown-list', which was removed in 2011. --- lisp/auth-source.el | 1 - 1 file changed, 1 deletion(-) (limited to 'lisp') diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 5776b6acb8c..5969cdbf9f8 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -330,7 +330,6 @@ If the value is not a list, symmetric encryption will be used." (defun auth-source-read-char-choice (prompt choices) "Read one of CHOICES by `read-char-choice', or `read-char'. -`dropdown-list' support is disabled because it doesn't work reliably. Only one of CHOICES will be returned. The PROMPT is augmented with \"[a/b/c] \" if CHOICES is \(?a ?b ?c)." (when choices -- cgit v1.2.3 From 6653ee66ca5ebd42322613a09d4c0d2e35af924b Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 14 Jan 2024 14:52:17 +0100 Subject: Improve two docstrings in ox-latex * lisp/org/ox-latex.el (org-latex-src-block-backend) (org-latex-engraved-theme): Improve docstring; mention that engrave-faces is a GNU ELPA package. --- lisp/org/ox-latex.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index 9989a9bae5c..f44b50c99ea 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -978,7 +978,7 @@ The most comprehensive option can be set with, which causes source code to be run through `engrave-faces-latex-buffer', which generates colorings using Emacs' font-lock information. This requires the Emacs package -engrave-faces (available from ELPA), and the LaTeX package +engrave-faces (available from GNU ELPA), and the LaTeX package fvextra be installed. The styling of the engraved result can be customized with @@ -1262,9 +1262,10 @@ block-specific options, you may use the following syntax: (defcustom org-latex-engraved-theme nil "The theme that should be used for engraved code, when non-nil. -This can be set to any theme defined in `engrave-faces-themes' or -loadable by Emacs. When set to t, the current Emacs theme is -used. When nil, no theme is applied." +This can be set to any theme defined in `engrave-faces-themes' +(from the engrave-faces package) or loadable by Emacs. When set +to t, the current Emacs theme is used. When nil, no theme is +applied." :group 'org-export-latex :package-version '(Org . "9.6") :type 'symbol) -- cgit v1.2.3 From 725a3f32f8ba78ac5fffcd03be5b82cbc2c1b275 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 14 Jan 2024 14:56:06 +0100 Subject: ; Fix typos in symbol names --- admin/cus-test.el | 2 +- lisp/abbrev.el | 2 +- lisp/calendar/todo-mode.el | 2 +- lisp/erc/erc.el | 2 +- lisp/jsonrpc.el | 2 +- lisp/leim/quail/cyrillic.el | 4 ++-- lisp/org/org-element.el | 2 +- lisp/org/org-fold-core.el | 2 +- lisp/org/org-macs.el | 2 +- lisp/org/ox-latex.el | 2 +- lisp/progmodes/eglot.el | 2 +- lisp/term.el | 2 +- lisp/term/pc-win.el | 2 +- lisp/treesit.el | 2 +- lisp/window.el | 2 +- 15 files changed, 16 insertions(+), 16 deletions(-) (limited to 'lisp') diff --git a/admin/cus-test.el b/admin/cus-test.el index 62fec77c16f..64c742ea855 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -146,7 +146,7 @@ Names should be as they appear in loaddefs.el.") (defvar cus-test-errors nil "List of problematic variables found by `cus-test-apropos'. -Each element is (VARIABLE . PROBLEM); see `cus-test--format-problem'.") +Each element is (VARIABLE . PROBLEM); see `cus-test--format-errors'.") (defvar cus-test-tested-variables nil "List of options tested by last call of `cus-test-apropos'.") diff --git a/lisp/abbrev.el b/lisp/abbrev.el index c4eac8c5c39..9afa617908e 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -1275,7 +1275,7 @@ which see." (setq font-lock-multiline nil)) (defun abbrev--possibly-save (query &optional arg) - "Hook function for use by `save-some-buffer-functions'. + "Hook function for use by `save-some-buffers-functions'. Maybe save abbrevs, and record whether we either saved them or asked to." ;; Query mode. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 20e056c2521..9ef473b1b43 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -1516,7 +1516,7 @@ the archive of the file moved to, creating it if it does not exist." (prin1 todo-categories (current-buffer))) ;; If archive was just created, save it to avoid "File ;; no longer exists!" message on invoking - ;; `todo-view-archived-items'. + ;; `todo-find-archive'. (unless (file-exists-p (buffer-file-name)) (save-buffer)) (todo-category-number (or new cat)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 4171ba3cb1d..88e41e96a82 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2192,7 +2192,7 @@ parameters SERVER and NICK." ;; (bug#60428). (defun erc--warn-unencrypted () ;; Remove unconditionally to avoid wrong context due to races from - ;; simultaneous dialing or aborting (e.g., via `keybaord-quit'). + ;; simultaneous dialing or aborting (e.g., via `keyboard-quit'). (remove-hook 'erc--server-post-connect-hook #'erc--warn-unencrypted) (when (and (process-contact erc-server-process :nowait) (equal erc-session-server erc-default-server) diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 2ccb528fee9..f2060d3faa1 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -555,7 +555,7 @@ With optional CLEANUP, kill any associated buffers." "Called when new data STRING has arrived for PROC." (when jsonrpc--in-process-filter ;; Problematic recursive process filters may happen if - ;; `jsonrpc--connection-receive', called by us, eventually calls + ;; `jsonrpc-connection-receive', called by us, eventually calls ;; client code which calls `process-send-string' (which see) to, ;; say send a follow-up message. If that happens to writes enough ;; bytes for pending output to be received, we will lose JSONRPC diff --git a/lisp/leim/quail/cyrillic.el b/lisp/leim/quail/cyrillic.el index 577898f82bd..60c88221a65 100644 --- a/lisp/leim/quail/cyrillic.el +++ b/lisp/leim/quail/cyrillic.el @@ -1101,9 +1101,9 @@ as follows. ;; Ognyan Kulev wrote: ;; I would suggest future `cyrillic-translit' to be with the -;; modification of `cyrillic-translit-bulgarian' applied and the +;; modification of `cyrillic-translit-bulgarian' (now deleted) applied and the ;; latter to disappear. It could be used by people who write -;; bulgarian e-mails with latin letters for kick start (phonetic input +;; Bulgarian e-mails with latin letters for kick start (phonetic input ;; method is not so obvious as translit input method but each letter ;; is one keypress and a *lot* of people know it). diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index ff587bba38c..796191dd386 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -6556,7 +6556,7 @@ the expected result." (error "org-element: Parsing aborted by user. Cache has been cleared. If you observe Emacs hangs frequently, please report this to Org mode mailing list (M-x org-submit-bug-report).")) (message (substitute-command-keys - "`org-element--parse-buffer': Suppressed `\\[keyboard-quit]'. Press `\\[keyboard-quit]' %d more times to force interruption.") + "`org-element--parse-to': Suppressed `\\[keyboard-quit]'. Press `\\[keyboard-quit]' %d more times to force interruption.") (- org-element--cache-interrupt-C-g-max-count org-element--cache-interrupt-C-g-count))) (unless element diff --git a/lisp/org/org-fold-core.el b/lisp/org/org-fold-core.el index 73b3c9bbf8c..be90ca398a1 100644 --- a/lisp/org/org-fold-core.el +++ b/lisp/org/org-fold-core.el @@ -433,7 +433,7 @@ Return nil when there is no matching folding spec." (org-fold-core-get-folding-spec-from-alias spec-or-alias)) (defsubst org-fold-core--check-spec (spec-or-alias) - "Throw an error if SPEC-OR-ALIAS is not in `org-fold-core--spec-priority-list'." + "Throw an error if SPEC-OR-ALIAS is not in `org-fold-core-folding-spec-list'." (unless (org-fold-core-folding-spec-p spec-or-alias) (error "%s is not a valid folding spec" spec-or-alias))) diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 55541834784..b891284a8bb 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -1072,7 +1072,7 @@ Return width in pixels when PIXELS is non-nil." ;; FIXME: Fallback to old limited version, because ;; `window-pixel-width' is buggy in older Emacs. (org--string-width-1 string) - ;; Wrap/line prefix will make `window-text-pizel-size' return too + ;; Wrap/line prefix will make `window-text-pixel-size' return too ;; large value including the prefix. (remove-text-properties 0 (length string) '(wrap-prefix t line-prefix t) diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index f44b50c99ea..c83728a8f09 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -3667,7 +3667,7 @@ CONTENTS is the contents of the object." ;; takes care of tables with a "verbatim" mode. Otherwise, it ;; delegates the job to either `org-latex--table.el-table', ;; `org-latex--org-table', `org-latex--math-table' or -;; `org-latex--org-tabbing' functions, +;; `org-latex--org-align-string-tabbing' functions, ;; depending of the type of the table and the mode requested. ;; ;; `org-latex--align-string' is a subroutine used to build alignment diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 64fd548e824..1e90e26a537 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1592,7 +1592,7 @@ If optional MARKER, return a marker instead" (let ((vec (copy-sequence url-path-allowed-chars))) (aset vec ?: nil) ;; see github#639 vec) - "Like `url-path-allows-chars' but more restrictive.") + "Like `url-path-allowed-chars' but more restrictive.") (defun eglot--path-to-uri (path) "URIfy PATH." diff --git a/lisp/term.el b/lisp/term.el index e3dedf247d1..647938c3b86 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -1109,7 +1109,7 @@ variable `term-input-autoexpand', and addition is controlled by the variable `term-input-ignoredups'. Input to, and output from, the subprocess can cause the window to scroll to -the end of the buffer. See variables `term-scroll-to-bottom-on-input', +the end of the buffer. See variables `term-scroll-snap-to-bottom', and `term-scroll-to-bottom-on-output'. If you accidentally suspend your process, use \\[term-continue-subjob] diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el index 02ad6b85c37..92d65c75816 100644 --- a/lisp/term/pc-win.el +++ b/lisp/term/pc-win.el @@ -47,7 +47,7 @@ ;; This was copied from etc/rgb.txt, except that some values were changed ;; a bit to make them consistent with DOS console colors, and the RGB -;; values were scaled up to 16 bits, as `tty-define-color' requires. +;; values were scaled up to 16 bits, as `tty-color-define' requires. ;;; ;; The mapping between the 16 standard EGA/VGA colors and X color names ;; was done by running a Unix version of Emacs inside an X client and a diff --git a/lisp/treesit.el b/lisp/treesit.el index c63bf510a24..2676ed932dc 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1422,7 +1422,7 @@ no-node comment-end - Matches if text after point matches `treesit-comment-end'. + Matches if text after point matches `comment-end-skip'. catch-all diff --git a/lisp/window.el b/lisp/window.el index c7cd32e6200..13fe1feba10 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -8528,7 +8528,7 @@ buffer. ALIST is a buffer display action alist as compiled by canonical frame lines. If it is the constant `full-height', prefer a full-height window. -If ALIST contains a non-nil `inhibit-same--window' entry, do not +If ALIST contains a non-nil `inhibit-same-window' entry, do not return the selected window." (let ((windows (window-list-1 nil 'nomini (cdr (assq 'lru-frames alist)))) -- cgit v1.2.3 From 78ddb32fadb61b3e78047400e257d57b2cff7cd8 Mon Sep 17 00:00:00 2001 From: Daniel Martín Date: Sun, 14 Jan 2024 15:36:16 +0100 Subject: Fix documentation of icon-elements * lisp/emacs-lisp/icons.el (icon-elements): The plist key it returns is `image', not `display'. (Bug#68451) --- lisp/emacs-lisp/icons.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el index 1fc0e39f9fe..f9591661688 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -164,7 +164,7 @@ If OBJECT is an icon, return the icon properties." (defun icon-elements (name) "Return the elements of icon NAME. The elements are represented as a plist where the keys are -`string', `face' and `display'. The `image' element is only +`string', `face' and `image'. The `image' element is only present if the icon is represented by an image." (let ((string (icon-string name))) (list 'face (get-text-property 0 'face string) -- cgit v1.2.3 From 314c939d1e182b8d015fc9c63d445274e0494748 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 14 Jan 2024 22:17:13 -0500 Subject: (js-json-mode): Don't derive from `js-mode` (bug#67463) * lisp/progmodes/js.el (js--mode-setup): New function, extracted from `js-mode`. (js-mode): Use it. (js-json-mode): Use it instead of inheriting from `js-mode`. --- etc/NEWS | 5 +++++ lisp/progmodes/js.el | 7 ++++++- 2 files changed, 11 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index da0253e97dc..03b8c3b517a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1002,6 +1002,11 @@ which calls 'xref-find-definitions'. If the previous one worked better for you, use 'define-key' in your init script to bind 'js-find-symbol' to that combination again. +** Json mode +`js-json-mode` does not derive from `js-mode` any more so as not +to confuse tools like Eglot or YASnippet into thinking that those +buffers contain Javascript code. + ** Python mode --- diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 0115feb0e97..947d91c9b1a 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3702,6 +3702,9 @@ Currently there are `js-mode' and `js-ts-mode'." (define-derived-mode js-mode js-base-mode "JavaScript" "Major mode for editing JavaScript." :group 'js + (js--mode-setup)) + +(defun js--mode-setup () ;; Ensure all CC Mode "lang variables" are set to valid values. (c-init-language-vars js-mode) (setq-local indent-line-function #'js-indent-line) @@ -3924,7 +3927,9 @@ See `treesit-thing-settings' for more information.") (put-text-property (1- ne) ne 'syntax-table syntax))))) ;;;###autoload -(define-derived-mode js-json-mode js-mode "JSON" +(define-derived-mode js-json-mode prog-mode "JSON" + :syntax-table js-mode-syntax-table + (js--mode-setup) ;Reuse most of `js-mode', but not as parent (bug#67463). (setq-local js-enabled-frameworks nil) ;; Speed up `syntax-ppss': JSON files can be big but can't hold ;; regexp matchers nor #! thingies (and `js-enabled-frameworks' is nil). -- cgit v1.2.3 From 43612103c221ffb300536798e2b8a8adb753f594 Mon Sep 17 00:00:00 2001 From: João Távora Date: Mon, 15 Jan 2024 06:32:51 -0600 Subject: Jsonrpc: fix bug in jsonrpc--remove * lisp/jsonrpc.el (jsonrpc--remove): Check timer before cancelling it. (Version): Bump to 1.2.24 See https://github.com/joaotavora/eglot/issues/1342 --- lisp/jsonrpc.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index f0f5842a0ee..7ff57daeb7d 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -4,7 +4,7 @@ ;; Author: João Távora ;; Keywords: processes, languages, extensions -;; Version: 1.0.23 +;; Version: 1.0.24 ;; Package-Requires: ((emacs "25.2")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -782,7 +782,7 @@ Return the full continuation (ID SUCCESS-FN ERROR-FN TIMER)" (if deferred-spec (remhash deferred-spec defs)) (when-let ((ass (assq id conts))) (cl-destructuring-bind (_ _ _ _ timer) ass - (cancel-timer timer)) + (when timer (cancel-timer timer))) (setf conts (delete ass conts)) ass))) -- cgit v1.2.3 From 53b5b77010117e2f58565dacf96fddeb734b6021 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Wed, 16 Aug 2023 15:58:29 +0000 Subject: Simplify 'without-restriction' This simplification is symmetrical to 01fb898420. * src/editfns.c: (Finternal__labeled_widen): Add a call to 'Fwiden', and rename from 'internal--unlabel-restriction'. (unwind_labeled_narrow_to_region): Use the renamed function, and remove the call to 'Fwiden'. (syms_of_editfns): Rename the symbol. * lisp/subr.el (internal--without-restriction): Use the renamed function. (cherry picked from commit 9e9e11648d3d5514de85edfb69f0949a062f4716) --- lisp/subr.el | 5 +++-- src/editfns.c | 16 ++++++++-------- 2 files changed, 11 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/subr.el b/lisp/subr.el index e8a6bb01c1e..d9df8d1a458 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4013,8 +4013,9 @@ by `with-restriction' with the same LABEL argument are lifted. (defun internal--without-restriction (body &optional label) "Helper function for `without-restriction', which see." (save-restriction - (if label (internal--unlabel-restriction label)) - (widen) + (if label + (internal--labeled-widen label) + (widen)) (funcall body))) (defun find-tag-default-bounds () diff --git a/src/editfns.c b/src/editfns.c index 6ddee0840c2..85f7739df07 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2684,7 +2684,7 @@ DEFUN ("delete-and-extract-region", Fdelete_and_extract_region, labeled restriction was entered (which may be a narrowing that was set by the user and is visible on display). This alist is used internally by narrow-to-region, internal--labeled-narrow-to-region, - widen, internal--unlabel-restriction and save-restriction. For + widen, internal--labeled-widen and save-restriction. For efficiency reasons, an alist is used instead of a buffer-local variable: otherwise reset_outermost_restrictions, which is called during each redisplay cycle, would have to loop through all live @@ -2860,8 +2860,7 @@ labeled_restrictions_restore (Lisp_Object buf_and_restrictions) static void unwind_labeled_narrow_to_region (Lisp_Object label) { - Finternal__unlabel_restriction (label); - Fwiden (); + Finternal__labeled_widen (label); } /* Narrow current_buffer to BEGV-ZV with a restriction labeled with @@ -2984,7 +2983,7 @@ argument. To gain access to other portions of the buffer, use DEFUN ("internal--labeled-narrow-to-region", Finternal__labeled_narrow_to_region, Sinternal__labeled_narrow_to_region, 3, 3, 0, - doc: /* Restrict editing in this buffer to START-END, and label the restriction with LABEL. + doc: /* Restrict this buffer to START-END, and label the restriction with LABEL. This is an internal function used by `with-restriction'. */) (Lisp_Object start, Lisp_Object end, Lisp_Object label) @@ -3002,9 +3001,9 @@ This is an internal function used by `with-restriction'. */) return Qnil; } -DEFUN ("internal--unlabel-restriction", Finternal__unlabel_restriction, - Sinternal__unlabel_restriction, 1, 1, 0, - doc: /* If the current restriction is labeled with LABEL, remove its label. +DEFUN ("internal--labeled-widen", Finternal__labeled_widen, + Sinternal__labeled_widen, 1, 1, 0, + doc: /* Remove the current restriction if it is labeled with LABEL, and widen. This is an internal function used by `without-restriction'. */) (Lisp_Object label) @@ -3012,6 +3011,7 @@ This is an internal function used by `without-restriction'. */) Lisp_Object buf = Fcurrent_buffer (); if (EQ (labeled_restrictions_peek_label (buf), label)) labeled_restrictions_pop (buf); + Fwiden (); return Qnil; } @@ -4951,7 +4951,7 @@ it to be non-nil. */); defsubr (&Swiden); defsubr (&Snarrow_to_region); defsubr (&Sinternal__labeled_narrow_to_region); - defsubr (&Sinternal__unlabel_restriction); + defsubr (&Sinternal__labeled_widen); defsubr (&Ssave_restriction); defsubr (&Stranspose_regions); } -- cgit v1.2.3 From 2ef3111b136599ee26ec4316199677107bffedbc Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 15 Jan 2024 16:55:27 +0100 Subject: * lisp/info-xref.el (info-xref-subfile-p): Avoid false positives. (Bug#68428) --- lisp/info-xref.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/info-xref.el b/lisp/info-xref.el index 7887909037b..95e9a1e55f7 100644 --- a/lisp/info-xref.el +++ b/lisp/info-xref.el @@ -79,9 +79,11 @@ If removing the last \"-\" from the filename gives a file which exists, then consider FILENAME a subfile. This is an imperfect test, probably ought to open up the purported top file and see what subfiles it says." - (and (string-match "\\`\\(\\([^-]*-\\)*[^-]*\\)-[0-9]+\\(.*\\)\\'" filename) - (file-exists-p (concat (match-string 1 filename) - (match-string 3 filename))))) + (let ((nondir (file-name-nondirectory filename))) + (and (string-match "\\`\\(\\([^-]*-\\)*[^-]*\\)-[0-9]+\\(.*\\)\\'" nondir) + (file-exists-p (concat (file-name-directory filename) + (match-string 1 nondir) + (match-string 3 nondir)))))) (defmacro info-xref-with-file (filename &rest body) ;; checkdoc-params: (filename body) -- cgit v1.2.3 From 27ff4d9c4956fe06c59f342def8b35d32bbc3b50 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 15 Jan 2024 19:00:50 -0500 Subject: * lisp/help-fns.el (help-fns--parent-mode): Mention the extra parents As suggested by Stefan Kangas in bug#68246. --- lisp/help-fns.el | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/help-fns.el b/lisp/help-fns.el index ca21408f6c3..99642d08bbd 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -741,18 +741,28 @@ the C sources, too." (defun help-fns--parent-mode (function) ;; If this is a derived mode, link to the parent. - (let ((parent-mode (and (symbolp function) - ;; FIXME: Should we mention other parent modes? - (get function - 'derived-mode-parent)))) + (when (symbolp function) + (let ((parent-mode (get function 'derived-mode-parent)) + (extra-parents (get function 'derived-mode-extra-parents))) (when parent-mode (insert (substitute-quotes " Parent mode: `")) (let ((beg (point))) - (insert (format "%s" parent-mode)) + (insert (format "%S" parent-mode)) (make-text-button beg (point) 'type 'help-function 'help-args (list parent-mode))) - (insert (substitute-quotes "'.\n"))))) + (insert (substitute-quotes "'.\n"))) + (when extra-parents + (insert (format " Extra parent mode%s:" (if (cdr extra-parents) "s" ""))) + (dolist (parent extra-parents) + (insert (substitute-quotes " `")) + (let ((beg (point))) + (insert (format "%S" parent)) + (make-text-button beg (point) + 'type 'help-function + 'help-args (list parent))) + (insert (substitute-quotes "'"))) + (insert ".\n"))))) (defun help-fns--obsolete (function) ;; Ignore lambda constructs, keyboard macros, etc. -- cgit v1.2.3 From e6a2901b1be6b4aa01f8bf0d3c6e06344ce8d366 Mon Sep 17 00:00:00 2001 From: Mike Kupfer Date: Mon, 15 Jan 2024 11:47:43 -0800 Subject: Fix folder creation error (Bug#67361) * lisp/mh-e/mh-funcs.el (mh-kill-folder), lisp/mh-e/mh-search.el (mh-index-new-folder), lisp/mh-e/mh-utils.el (mh-prompt-for-folder): Check for existence of speedbar-buffer rather than mh-speed-folder-map. The latter can exist if mh-speed has only been loaded but not displayed. --- lisp/mh-e/mh-funcs.el | 2 +- lisp/mh-e/mh-search.el | 2 +- lisp/mh-e/mh-utils.el | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el index 2684722eb26..bb3e67467d5 100644 --- a/lisp/mh-e/mh-funcs.el +++ b/lisp/mh-e/mh-funcs.el @@ -108,7 +108,7 @@ folder. This is useful for folders that are easily regenerated." (window-config mh-previous-window-config)) (mh-set-folder-modified-p t) ; lock folder to kill it (mh-exec-cmd-daemon "rmf" 'mh-rmf-daemon folder) - (when (boundp 'mh-speed-folder-map) + (when (and (boundp 'speedbar-buffer) speedbar-buffer) (mh-speed-invalidate-map folder)) (mh-remove-from-sub-folders-cache folder) (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index f475973631c..59dad161c11 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -1569,7 +1569,7 @@ If the folder returned doesn't exist then it is created." (save-excursion (mh-exec-cmd-quiet nil "rmf" chosen-name)) (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name) (mh-remove-from-sub-folders-cache chosen-name) - (when (boundp 'mh-speed-folder-map) + (when (and (boundp 'speedbar-buffer) speedbar-buffer) (mh-speed-add-folder chosen-name)) chosen-name)) diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index 7943879d887..9d5711105ba 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -795,7 +795,7 @@ used in searching." (message "Creating %s" folder-name) (mh-exec-cmd-error nil "folder" folder-name) (mh-remove-from-sub-folders-cache folder-name) - (when (boundp 'mh-speed-folder-map) + (when (and (boundp 'speedbar-buffer) speedbar-buffer) (mh-speed-add-folder folder-name)) (message "Creating %s...done" folder-name)) (new-file-flag -- cgit v1.2.3 From 44fcab04f6a346e602f00a6d9f5b0e6f0dbeb5e0 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 16 Jan 2024 10:59:34 +0800 Subject: Enable the system's Arabic and Khmer fonts under Android * lisp/international/fontset.el (setup-default-fontset): If `android', search for Arabic or Khmer fonts with script tags, not OTF features. --- lisp/international/fontset.el | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 2c461a7f7ab..33e444507c4 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -645,8 +645,14 @@ (nil . "microsoft-cp1251") (nil . "koi8-r")) - (arabic ,(font-spec :registry "iso10646-1" - :otf '(arab nil (init medi fina liga))) + (arabic ,(if (featurep 'android) + ;; The Android font driver does not support the + ;; detection of OTF tags but all fonts installed on + ;; Android with Arabic characters provide shaping + ;; information required for displaying Arabic text. + (font-spec :registry "iso10646-1" :script 'arabic) + (font-spec :registry "iso10646-1" + :otf '(arab nil (init medi fina liga)))) (nil . "MuleArabic-0") (nil . "MuleArabic-1") (nil . "MuleArabic-2") @@ -657,7 +663,9 @@ (hebrew ,(font-spec :registry "iso10646-1" :script 'hebrew) (nil . "ISO8859-8")) - (khmer ,(font-spec :registry "iso10646-1" :otf '(khmr nil (pres)))) + (khmer ,(if (featurep 'android) + (font-spec :registry "iso10646-1" :script 'khmer) + (font-spec :registry "iso10646-1" :otf '(khmr nil (pres))))) (kana (nil . "JISX0208*") (nil . "GB2312.1980-0") -- cgit v1.2.3 From d4b9cb6b5b640e8d769c82289e4308407be12ba9 Mon Sep 17 00:00:00 2001 From: Mike Kupfer Date: Mon, 15 Jan 2024 11:47:43 -0800 Subject: Fix folder creation error (Bug#67361) * lisp/mh-e/mh-funcs.el (mh-kill-folder) * lisp/mh-e/mh-search.el (mh-index-new-folder) * lisp/mh-e/mh-utils.el (mh-prompt-for-folder): Check for existence of 'speedbar-buffer' rather than 'mh-speed-folder-map'. The latter can exist if 'mh-speed' has only been loaded but not displayed. (cherry picked from commit e6a2901b1be6b4aa01f8bf0d3c6e06344ce8d366) --- lisp/mh-e/mh-funcs.el | 2 +- lisp/mh-e/mh-search.el | 2 +- lisp/mh-e/mh-utils.el | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el index 2684722eb26..bb3e67467d5 100644 --- a/lisp/mh-e/mh-funcs.el +++ b/lisp/mh-e/mh-funcs.el @@ -108,7 +108,7 @@ folder. This is useful for folders that are easily regenerated." (window-config mh-previous-window-config)) (mh-set-folder-modified-p t) ; lock folder to kill it (mh-exec-cmd-daemon "rmf" 'mh-rmf-daemon folder) - (when (boundp 'mh-speed-folder-map) + (when (and (boundp 'speedbar-buffer) speedbar-buffer) (mh-speed-invalidate-map folder)) (mh-remove-from-sub-folders-cache folder) (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index f475973631c..59dad161c11 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -1569,7 +1569,7 @@ If the folder returned doesn't exist then it is created." (save-excursion (mh-exec-cmd-quiet nil "rmf" chosen-name)) (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name) (mh-remove-from-sub-folders-cache chosen-name) - (when (boundp 'mh-speed-folder-map) + (when (and (boundp 'speedbar-buffer) speedbar-buffer) (mh-speed-add-folder chosen-name)) chosen-name)) diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index 7943879d887..9d5711105ba 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -795,7 +795,7 @@ used in searching." (message "Creating %s" folder-name) (mh-exec-cmd-error nil "folder" folder-name) (mh-remove-from-sub-folders-cache folder-name) - (when (boundp 'mh-speed-folder-map) + (when (and (boundp 'speedbar-buffer) speedbar-buffer) (mh-speed-add-folder folder-name)) (message "Creating %s...done" folder-name)) (new-file-flag -- cgit v1.2.3 From 6f75d0f36dd44fa794ed264042bb6edb4d897bec Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 16 Jan 2024 18:54:04 +0200 Subject: New display action alist entry 'post-command-select-window' (bug#67993) * doc/lispref/windows.texi (Buffer Display Action Alists): Add 'post-command-select-window'. * lisp/window.el (display-buffer): Add 'post-command-select-window' to the docstring and handle at the end of function. --- doc/lispref/windows.texi | 10 ++++++++++ etc/NEWS | 6 ++++++ lisp/window.el | 19 +++++++++++++++++++ 3 files changed, 35 insertions(+) (limited to 'lisp') diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 93b25cbe67f..f14e74bc785 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -3344,6 +3344,16 @@ It is called @emph{after} the buffer is displayed, and @emph{before} the entries @code{window-height}, @code{window-width} and @code{preserve-size} are applied that could resize the window to fit it to the inserted contents. + +@vindex post-command-select-window@r{, a buffer display action alist entry} +@item post-command-select-window +If the value is non-@code{nil}, the buffer displayed by @code{display-buffer} +is selected after the current command is executed by running the hook +@code{post-command-hook} (@pxref{Command Overview}). +If the value is @code{nil}, the buffer selected by such functions as +@code{pop-to-buffer} is deselected, and the window that was selected +before calling this function will remain selected regardless of which +windows were selected afterwards within this command. @end table By convention, the entries @code{window-height}, @code{window-width} diff --git a/etc/NEWS b/etc/NEWS index 03b8c3b517a..939caed14f6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -262,6 +262,12 @@ Anything following the symbol 'mode-line-format-right-align' in right-aligned to is controlled by the new user option 'mode-line-right-align-edge'. +** Windows + +*** New buffer display action alist entry 'post-command-select-window'. +It specifies whether the window of the displayed buffer should be +selected or deselected at the end of executing the current command. + ** Tab Bars and Tab Lines *** New user option 'tab-bar-tab-name-format-functions'. diff --git a/lisp/window.el b/lisp/window.el index 23977691f50..65651b2931b 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -7798,6 +7798,14 @@ Action alist entries are: and `preserve-size' are applied. The function is supposed to fill the window body with some contents that might depend on dimensions of the displayed window. + `post-command-select-window' -- A non-nil value means that after the + current command is executed and the hook `post-command-hook' is called, + the window displayed by this function will be selected. A nil value + means that if functions like `pop-to-buffer' selected another window, + at the end of this command that window will be deselected, and the + window that was selected before calling this function will remain + selected regardless of which windows were selected afterwards within + this command. The entries `window-height', `window-width', `window-size' and `preserve-size' are applied only when the window used for @@ -7853,6 +7861,17 @@ specified by the ACTION argument." (while (and functions (not window)) (setq window (funcall (car functions) buffer alist) functions (cdr functions))) + (when-let ((select (assq 'post-command-select-window alist))) + (letrec ((old-selected-window (selected-window)) + (postfun + (lambda () + (if (cdr select) + (when (window-live-p window) + (select-window window)) + (when (window-live-p old-selected-window) + (select-window old-selected-window))) + (remove-hook 'post-command-hook postfun)))) + (add-hook 'post-command-hook postfun))) (and (windowp window) window)))) (defun display-buffer-other-frame (buffer) -- cgit v1.2.3 From b96aa528f642f69e2b42620807d53f8d9bbd9623 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 16 Jan 2024 19:51:18 +0200 Subject: * lisp/net/eww.el (eww-retrieve): Fix args of eww-render for sync (bug#68336). Suggested by Phil Sainty . --- lisp/net/eww.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/net/eww.el b/lisp/net/eww.el index d127d819f26..7be65dc1e82 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -427,7 +427,7 @@ For more information, see Info node `(eww) Top'." ((eq eww-retrieve-command 'sync) (let ((data-buffer (url-retrieve-synchronously url))) (with-current-buffer data-buffer - (apply #'eww-render nil url cbargs)))) + (apply #'eww-render nil cbargs)))) (t (let ((buffer (generate-new-buffer " *eww retrieve*")) (error-buffer (generate-new-buffer " *eww error*"))) -- cgit v1.2.3 From 2cb1b76696b56fe01eb70d623b602dfe00613511 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 18 Jan 2024 01:25:24 +0200 Subject: diff-mode: Support committing diff with file deletions * lisp/vc/diff-mode.el (diff-vc-deduce-fileset): Remove nil elements from the result (bug#68443). --- lisp/vc/diff-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 2b9d12a5756..4f150dc7f36 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2955,7 +2955,7 @@ hunk text is not found in the source file." (goto-char (point-min)) (while (progn (diff-file-next) (not (eobp))) (push (diff-find-file-name nil t) files))) - (list backend (nreverse files) nil nil 'patch))) + (list backend (delete nil (nreverse files)) nil nil 'patch))) (defun diff--filter-substring (str) (when diff-font-lock-prettify -- cgit v1.2.3 From 314ac2e4317650a5135b950374118bbc38e8207f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Jan 2024 08:29:34 +0200 Subject: ; * lisp/mail/rmail.el (rmail-show-message-verbose-min): Doc fix (bug#68369). --- lisp/mail/rmail.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index b6c36c2f76c..5747091c498 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -2684,7 +2684,9 @@ N defaults to the current message." (and (string-match text-regexp content-type-header) t))))) (defcustom rmail-show-message-verbose-min 200000 - "Message size at which to show progress messages for displaying it." + "Message size at which to show progress messages for displaying it. +Messages longer than this (in characters) will produce echo-area +messages when Rmail processes such a message for display." :type 'integer :group 'rmail :version "23.1") -- cgit v1.2.3 From ef01b634d219bcceda17dcd61024c7a12173b88c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Jan 2024 05:17:44 -0500 Subject: ; Regenerate lisp/ldefs-boot.el and etc/AUTHORS for 29.2. --- etc/AUTHORS | 112 +++++++++++++++++++++++++++++++++-------------------- lisp/ldefs-boot.el | 20 ++++++---- 2 files changed, 83 insertions(+), 49 deletions(-) (limited to 'lisp') diff --git a/etc/AUTHORS b/etc/AUTHORS index 5fc54f1909f..193a3db6760 100644 --- a/etc/AUTHORS +++ b/etc/AUTHORS @@ -45,7 +45,7 @@ Adam Hupp: changed emacs.py emacs2.py emacs3.py gud.el progmodes/python.el Adam Porter: changed tab-line.el cl-macs.el map.el control.texi - map-tests.el pcase-tests.el tab-bar.el + map-tests.el pcase-tests.el tab-bar.el variables.texi Adam Sjøgren: changed mml2015.el shr.el spam.el xterm.c blink.xpm braindamaged.xpm cry.xpm dead.xpm evil.xpm forced.xpm frown.xpm @@ -537,7 +537,7 @@ Aubrey Jaffer: changed info.el unexelf.c August Feng: changed bookmark.el -Augustin Chéneau: changed treesit.el +Augustin Chéneau: changed c-ts-mode.el treesit.el Augusto Stoffel: co-wrote ansi-osc.el and changed progmodes/python.el isearch.el eglot.el comint.el eldoc.el @@ -555,6 +555,8 @@ Axel Boldt: changed ehelp.el electric.el Axel Svensson: changed characters.el display.texi x-win.el +Aymeric Agon-Rambosson: changed indent.el + Bahodir Mansurov: changed quail/cyrillic.el Bake Timmons: changed gnus.texi mail-source.el @@ -984,7 +986,7 @@ Christoph Dittmann: changed ox-beamer.el Christophe de Dinechin: co-wrote ns-win.el -Christophe Deleuze: changed icalendar.el image-dired.el +Christophe Deleuze: changed ange-ftp.el icalendar.el image-dired.el Christoph Egger: changed configure.ac @@ -1016,7 +1018,8 @@ Christopher Thorne: changed dired.el progmodes/grep.el Christopher Wellons: changed emacs-lisp/cl-lib.el hashcash.el viper-cmd.el viper-ex.el viper-init.el viper.el -Christophe Troestler: changed gnus-icalendar.el epg.el newcomment.el +Christophe Troestler: changed rust-ts-mode.el gnus-icalendar.el epg.el + newcomment.el Christoph Göttschkes: changed make-mode.el @@ -1186,6 +1189,9 @@ Daniel LaLiberte: wrote edebug.el isearch.el and co-wrote hideif.el and changed cust-print.el mlconvert.el eval-region.el +Daniel Laurens Nicolai: changed doc-view.el facemenu.el files.el + misc.texi re-builder.el searching.texi + Daniel Lenski: changed speedbar.el Daniel Lopez: changed progmodes/compile.el @@ -1196,7 +1202,7 @@ Daniel Martín: changed c-ts-mode.el nsterm.m shortdoc.el ns-win.el simple.el diff-mode-tests.el erc.texi files.el files.texi indent.erts msdos-xtra.texi progmodes/python.el search.texi .lldbinit basic.texi c-ts-mode-tests.el cmacexp.el compilation.txt compile-tests.el - compile.texi configure.ac and 46 other files + compile.texi configure.ac and 47 other files Daniel McClanahan: changed lisp-mode.el @@ -1475,6 +1481,9 @@ and changed complete.el Denis Stünkel: changed ibuf-ext.el +Denis Zubarev: changed treesit-tests.el progmodes/python.el + python-tests.el treesit.c + Deniz Dogan: changed rcirc.el simple.el css-mode.el TUTORIAL.sv commands.texi erc-backend.el erc-log.el erc.el image.el iswitchb.el lisp-mode.el process.c progmodes/python.el quickurl.el rcirc.texi @@ -1564,10 +1573,10 @@ Dmitry Gorbik: changed org.el Dmitry Gutov: wrote elisp-mode-tests.el jit-lock-tests.el json-tests.el vc-hg-tests.el xref-tests.el and changed xref.el ruby-mode.el project.el vc-git.el ruby-ts-mode.el - elisp-mode.el etags.el ruby-mode-tests.el js.el vc.el package.el - vc-hg.el symref/grep.el dired-aux.el ruby-ts-mode-tests.el simple.el - progmodes/python.el treesit.el log-edit.el ruby-ts.rb rust-ts-mode.el - and 157 other files + elisp-mode.el js.el etags.el ruby-mode-tests.el vc.el package.el + vc-hg.el symref/grep.el treesit.el dired-aux.el progmodes/python.el + ruby-ts-mode-tests.el simple.el typescript-ts-mode.el log-edit.el + ruby-ts.rb and 158 other files Dmitry Kurochkin: changed isearch.el @@ -1668,7 +1677,7 @@ and co-wrote help-tests.el and changed xdisp.c display.texi w32.c msdos.c simple.el w32fns.c files.el fileio.c keyboard.c emacs.c text.texi configure.ac w32term.c dispnew.c frames.texi w32proc.c files.texi xfaces.c window.c - dispextern.h lisp.h and 1334 other files + dispextern.h lisp.h and 1341 other files Eliza Velasquez: changed server.el @@ -2087,6 +2096,8 @@ George D. Plymale Ii: changed esh-cmd.el George Kettleborough: changed org-clock.el org-timer.el +George Kuzler: changed calc.el + George McNinch: changed nnir.el Georges Brun-Cottan: wrote easy-mmode.el @@ -2172,7 +2183,7 @@ Gregor Schmid: changed intervals.c intervals.h tcl-mode.el textprop.c Gregory Chernov: changed nnslashdot.el -Gregory Heytings: changed xdisp.c editfns.c keyboard.c subr.el buffer.c +Gregory Heytings: changed xdisp.c editfns.c subr.el keyboard.c buffer.c dispextern.h lisp.h buffer.h display.texi efaq.texi files.el isearch.el minibuffer.el Makefile.in bytecode.c composite.c positions.texi bytecomp.el emake help-fns.el lread.c and 78 other files @@ -2556,11 +2567,10 @@ and changed gnus-score.el gnus-logic.el Jan Vroonhof: changed gnus-cite.el gnus-msg.el nntp.el -Jared Finder: changed menu-bar.el term.c commands.texi frame.c isearch.el - mouse.el tmm.el wid-edit.el xt-mouse.el artist.el dispnew.c - ediff-wind.el ediff.el faces.el foldout.el frames.texi keyboard.c - lread.c mouse-drag.el progmodes/compile.el ruler-mode.el - and 7 other files +Jared Finder: changed menu-bar.el term.c commands.texi xt-mouse.el + frame.c isearch.el mouse.el tmm.el wid-edit.el artist.el dired.el + dispnew.c ediff-wind.el ediff.el faces.el foldout.el frames.texi + keyboard.c lread.c mouse-drag.el progmodes/compile.el and 9 other files Jarek Czekalski: changed keyboard.c callproc.c mini.texi minibuf.c misc.texi server.el shell.el w32fns.c xgselect.c @@ -2626,7 +2636,7 @@ and changed idlw-rinfo.el idlw-toolbar.el comint.el idlwave.texi vc.el Jean Abou Samra: changed scheme.el -Jean-Christophe Helary: changed emacs-lisp-intro.texi ns-win.el +Jean-Christophe Helary: changed back.texi emacs-lisp-intro.texi ns-win.el package-tests.el package.el strings.texi subr-x.el ucs-normalize.el Jean Forget: changed cal-french.el @@ -2704,6 +2714,9 @@ Jérémie Courrèges-Anglas: changed kqueue.c org.texi ox-latex.el Jeremy Bertram Maitin-Shepard: changed erc.el erc-backend.el erc-button.el erc-track.el mml.el +Jeremy Bryant: changed abbrev.el cl-extra.el emacs-lisp/cl-lib.el + files.texi functions.texi simple.el + Jérémy Compostella: changed tramp-sh.el mml.el battery.el keyboard.c windmove.el window.el xdisp.c @@ -2767,7 +2780,7 @@ Jim Porter: changed eshell.texi esh-cmd.el esh-var-tests.el esh-util.el eshell-tests-helpers.el em-pred.el esh-arg.el esh-cmd-tests.el tramp.el em-pred-tests.el em-dirs-tests.el server.el em-basic.el em-extpipe-tests.el esh-opt-tests.el esh-opt.el - and 92 other files + and 93 other files Jim Radford: changed gnus-start.el @@ -3129,7 +3142,7 @@ Juri Linkov: wrote compose.el emoji.el files-x.el misearch.el and changed isearch.el simple.el info.el replace.el dired.el dired-aux.el progmodes/grep.el minibuffer.el window.el subr.el vc.el outline.el mouse.el diff-mode.el repeat.el image-mode.el files.el menu-bar.el - search.texi startup.el progmodes/compile.el and 473 other files + search.texi startup.el display.texi and 473 other files Jussi Lahdenniemi: changed w32fns.c ms-w32.h msdos.texi w32.c w32.h w32console.c w32heap.c w32inevt.c w32term.h @@ -3645,6 +3658,8 @@ Lute Kamstra: changed modes.texi emacs-lisp/debug.el generic-x.el Lynn Slater: wrote help-macro.el +Maciej Kalandyk: changed progmodes/python.el + Maciek Pasternacki: changed nnrss.el Madan Ramakrishnan: changed org-agenda.el @@ -3940,6 +3955,8 @@ Matthew Tromp: changed ielm.el Matthew White: changed buffer.c bookmark-tests.el bookmark.el test-list.bmk +Matthew Woodcraft: changed eglot.texi + Matthias Dahl: changed faces.el process.c process.h Matthias Förste: changed files.el @@ -3986,11 +4003,11 @@ Matt Simmons: changed message.el Matt Swift: changed dired.el editfns.c lisp-mode.el mm-decode.el outline.el progmodes/compile.el rx.el simple.el startup.el -Mauro Aranda: changed wid-edit.el cus-edit.el custom.el wid-edit-tests.el - widget.texi perl-mode.el custom-tests.el checkdoc-tests.el checkdoc.el - cperl-mode-tests.el cus-edit-tests.el cus-theme.el customize.texi - files.texi gnus.texi octave.el pong.el align.el auth-source.el - autorevert.el base.el and 56 other files +Mauro Aranda: changed wid-edit.el cus-edit.el widget.texi custom.el + wid-edit-tests.el perl-mode.el custom-tests.el checkdoc-tests.el + checkdoc.el cperl-mode-tests.el cus-edit-tests.el cus-theme.el + customize.texi files.texi gnus.texi octave.el pong.el align.el + auth-source.el autorevert.el base.el and 62 other files Maxime Edouard Robert Froumentin: changed gnus-art.el mml.el @@ -4013,7 +4030,7 @@ and co-wrote tramp-cache.el tramp-sh.el tramp.el and changed tramp.texi tramp-adb.el trampver.el trampver.texi dbusbind.c files.el ange-ftp.el files.texi file-notify-tests.el dbus.texi gitlab-ci.yml autorevert.el tramp-fish.el kqueue.c Dockerfile.emba - os.texi tramp-gw.el test/Makefile.in README shell.el files-tests.el + os.texi tramp-gw.el test/Makefile.in README files-x.el shell.el and 309 other files Michael Ben-Gershon: changed acorn.h configure.ac riscix1-1.h riscix1-2.h @@ -4197,8 +4214,8 @@ Mike Kazantsev: changed erc-dcc.el Mike Kupfer: changed mh-comp.el mh-e.el mh-mime.el mh-utils.el files.el ftcrfont.c mh-compat.el mh-utils-tests.el emacs-mime.texi files.texi - gnus-mh.el gnus.texi mh-acros.el mh-e.texi mh-identity.el mh-scan.el - xftfont.c + gnus-mh.el gnus.texi mh-acros.el mh-e.texi mh-funcs.el mh-identity.el + mh-scan.el xftfont.c Mike Lamb: changed em-unix.el esh-util.el pcmpl-unix.el @@ -4258,10 +4275,10 @@ Mohsin Kaleem: changed eglot.el Mon Key: changed animate.el imap.el syntax.el -Morgan J. Smith: changed gnus-group-tests.el +Morgan J. Smith: changed gnus-group-tests.el url-vars.el -Morgan Smith: changed image-dired.el minibuffer-tests.el minibuffer.el - vc-git.el window.el +Morgan Smith: changed image-dired.el doc-view.el minibuffer-tests.el + minibuffer.el vc-git.el window.el Morten Welinder: wrote [many MS-DOS files] arc-mode.el desktop.el dosfns.c internal.el msdos.h pc-win.el @@ -4341,6 +4358,8 @@ Nevin Kapur: changed nnmail.el gnus-sum.el nnimap.el gnus-group.el Nguyen Thai Ngoc Duy: co-wrote vnvni.el +Niall Dooley: changed eglot.el + Niall Mansfield: changed etags.c Nic Ferrier: changed ert.el tramp.el @@ -4455,7 +4474,8 @@ and changed rsz-mini.el emacs-buffer.gdb comint.el files.el Makefile Noah Lavine: changed tramp.el -Noah Peart: changed treesit.el +Noah Peart: changed typescript-ts-mode.el indent.erts js.el treesit.el + c-ts-mode.el js-tests.el js-ts-indents.erts Noah Swainland: changed calc.el goto-addr.el misc.texi @@ -4720,7 +4740,8 @@ Peter O'Gorman: changed configure.ac frame.h hpux10-20.h termhooks.h Peter Oliver: changed emacsclient.desktop emacsclient-mail.desktop Makefile.in emacs-mail.desktop server.el configure.ac emacs.desktop - emacs.metainfo.xml misc.texi perl-mode.el ruby-mode-tests.el vc-sccs.el + emacs.metainfo.xml emacsclient.1 misc.texi perl-mode.el + ruby-mode-tests.el vc-sccs.el Peter Povinec: changed term.el @@ -4760,7 +4781,7 @@ Petri Kaurinkoski: changed configure.ac iris4d.h irix6-0.h irix6-5.h Petr Salinger: changed configure.ac gnu-kfreebsd.h Petteri Hintsanen: changed sequences.texi Makefile.in emacs/Makefile.in - lispintro/Makefile.in lispref/Makefile.in misc/Makefile.in + lispintro/Makefile.in lispref/Makefile.in misc/Makefile.in tab-bar.el Phil Hagelberg: wrote ert-x-tests.el and changed package.el pcmpl-unix.el subr.el @@ -5495,6 +5516,8 @@ Simon Thum: changed ob-maxima.el Skip Collins: changed w32fns.c w32term.c w32term.h +Skykanin-: changed eglot.el + Sławomir Nowaczyk: changed emacs.py progmodes/python.el TUTORIAL.pl flyspell.el ls-lisp.el w32proc.c @@ -5527,7 +5550,7 @@ and co-wrote help-tests.el keymap-tests.el and changed image-dired.el efaq.texi package.el cperl-mode.el help.el subr.el checkdoc.el bookmark.el simple.el dired.el files.el gnus.texi dired-x.el keymap.c image-mode.el erc.el ediff-util.el speedbar.el - woman.el browse-url.el bytecomp-tests.el and 1678 other files + woman.el browse-url.el bytecomp-tests.el and 1683 other files Stefan Merten: co-wrote rst.el @@ -5581,7 +5604,7 @@ and changed wdired.el todo-mode.texi wdired-tests.el diary-lib.el dired.el dired-tests.el doc-view.el files.el info.el minibuffer.el outline.el todo-test-1.todo allout.el eww.el find-dired.el frames.texi hl-line.el menu-bar.el mouse.el otodo-mode.el simple.el - and 63 other files + and 64 other files Stephen C. Gilardi: changed configure.ac @@ -5791,10 +5814,10 @@ Theodore Jump: changed makefile.nt makefile.def w32-win.el w32faces.c Theodor Thornhill: changed typescript-ts-mode.el java-ts-mode.el c-ts-mode.el eglot.el csharp-mode.el js.el css-mode.el project.el - json-ts-mode.el treesit.el c-ts-common.el eglot-tests.el EGLOT-NEWS - README.md c-ts-mode-tests.el compile-tests.el go-ts-mode.el - indent-bsd.erts indent.erts maintaining.texi mwheel.el - and 5 other files + indent.erts json-ts-mode.el treesit.el c-ts-common.el eglot-tests.el + EGLOT-NEWS README.md c-ts-mode-tests.el compile-tests.el go-ts-mode.el + indent-bsd.erts java-ts-mode-tests.el maintaining.texi + and 8 other files Theresa O'Connor: wrote json.el and changed erc.el erc-viper.el erc-log.el erc-track.el viper.el @@ -6317,10 +6340,15 @@ W. Trevor King: changed xterm.el Xavier Maillard: changed gnus-faq.texi gnus-score.el mh-utils.el spam.el +Xiaoyue Chen: changed esh-proc.el + Xi Lu: changed etags.c htmlfontify.el ruby-mode.el CTAGS.good_crlf CTAGS.good_update Makefile TUTORIAL.cn crlf eww.el shortdoc.el tramp-sh.el +Xiyue Deng: changed emacs-lisp-intro.texi functions.texi strings.texi + symbols.texi + Xu Chunyang: changed eglot.el eww.el dom.el gud.el netrc.el Xue Fuqiao: changed display.texi emacs-lisp-intro.texi files.texi @@ -6383,11 +6411,11 @@ Yoshinari Nomura: changed ox-html.el ox.el Yoshinori Koseki: wrote iimage.el and changed fontset.el message.el nnheader.el nnmail.el -Yuan Fu: changed treesit.el treesit.c c-ts-mode.el parsing.texi +Yuan Fu: changed treesit.el c-ts-mode.el treesit.c parsing.texi progmodes/python.el modes.texi js.el treesit-tests.el indent.erts - typescript-ts-mode.el css-mode.el treesit.h configure.ac + typescript-ts-mode.el treesit.h css-mode.el configure.ac java-ts-mode.el print.c sh-script.el c-ts-common.el gdb-mi.el - rust-ts-mode.el go-ts-mode.el starter-guide and 54 other files + rust-ts-mode.el go-ts-mode.el starter-guide and 55 other files Yuanle Song: changed rng-xsd.el diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 82643a55508..16a9df2c92e 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -6613,6 +6613,13 @@ There is some minimal font-lock support (see vars (setq debugger 'debug) (autoload 'debug "debug" "\ Enter debugger. \\`\\[debugger-continue]' returns from the debugger. + +In interactive sessions, this switches to a backtrace buffer and shows +the Lisp backtrace of function calls there. In batch mode (more accurately, +when `noninteractive' is non-nil), it shows the Lisp backtrace on the +standard error stream (unless `backtrace-on-error-noninteractive' is nil), +and then kills Emacs, causing it to exit with a negative exit code. + Arguments are mainly for use when this is called from the internals of the evaluator. @@ -9201,14 +9208,14 @@ Edit a keyboard macro which has been given a name by `name-last-kbd-macro'. (fn &optional PREFIX)" t) (autoload 'read-kbd-macro "edmacro" "\ Read the region as a keyboard macro definition. -The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\". -See documentation for `edmacro-mode' for details. +The region between START and END is interpreted as spelled-out keystrokes, +e.g., \"M-x abc RET\". See documentation for `edmacro-mode' for details. Leading/trailing \"C-x (\" and \"C-x )\" in the text are allowed and ignored. The resulting macro is installed as the \"current\" keyboard macro. In Lisp, may also be called with a single STRING argument in which case the result is returned rather than being installed as the current macro. -The result will be a string if possible, otherwise an event vector. +The result is a vector of input events. Second argument NEED-VECTOR means to return an event vector always. (fn START &optional END)" t) @@ -9824,7 +9831,7 @@ This command prompts for an emoji name, with completion, and inserts it. It recognizes the Unicode Standard names of emoji, and also consults the `emoji-alternate-names' alist." t) (autoload 'emoji-list "emoji" "\ -List emojis and insert the one that's selected. +List emojis and allow selecting and inserting one of them. Select the emoji by typing \\\\[emoji-list-select] on its picture. The glyph will be inserted into the buffer that was current when the command was invoked." t) @@ -22498,7 +22505,7 @@ Coloring: ;;; Generated autoloads from org/org.el -(push (purecopy '(org 9 6 10)) package--builtin-versions) +(push (purecopy '(org 9 6 15)) package--builtin-versions) (autoload 'org-babel-do-load-languages "org" "\ Load the languages defined in `org-babel-load-languages'. @@ -32871,7 +32878,7 @@ Add archive file name handler to `file-name-handler-alist'." (when (and tramp-ar ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 6 2 -1)) package--builtin-versions) +(push (purecopy '(tramp 2 6 2 29 2)) package--builtin-versions) (register-definition-prefixes "trampver" '("tramp-")) @@ -34116,7 +34123,6 @@ Normalize arguments to delight. ;;; Generated autoloads from use-package/use-package-ensure-system-package.el -(push (purecopy '(use-package 0 2)) package--builtin-versions) (autoload 'use-package-normalize/:ensure-system-package "use-package-ensure-system-package" "\ Turn ARGS into a list of conses of the form (PACKAGE-NAME . INSTALL-COMMAND). -- cgit v1.2.3 From 2c887f497c723c2397888e2f406faa4de3a8208a Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Thu, 18 Jan 2024 07:24:39 -0800 Subject: Avoid font-lock reset in `gnus-message-citation-mode' * lisp/gnus/gnus-cite.el (gnus-message-citation-mode): Use `font-lock-add-keywords' and `font-lock-remove-keywords' instead of modifying font-lock defaults. Make no font-lock changes until `font-lock-mode' is active. Thanks to Morgan Willcock --- lisp/gnus/gnus-cite.el | 36 +++++++++++------------------------- 1 file changed, 11 insertions(+), 25 deletions(-) (limited to 'lisp') diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index 04abdfc0d1b..3fde9baa0fe 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -1122,31 +1122,17 @@ Returns nil if there is no such line before LIMIT, t otherwise." When enabled, it automatically turns on `font-lock-mode'." :lighter "" (when (derived-mode-p 'message-mode) - ;; FIXME: Use font-lock-add-keywords! - (let ((defaults (car font-lock-defaults)) - default) ;; keywords - (while defaults - (setq default (if (consp defaults) - (pop defaults) - (prog1 - defaults - (setq defaults nil)))) - (if gnus-message-citation-mode - ;; `gnus-message-citation-keywords' should be the last - ;; elements of the keywords because the others are unlikely - ;; to have the OVERRIDE flags -- XEmacs applies a keyword - ;; having no OVERRIDE flag to matched text even if it has - ;; already other faces, while Emacs doesn't. - (set (make-local-variable default) - (append (default-value default) - gnus-message-citation-keywords)) - (kill-local-variable default)))) - ;; Force `font-lock-set-defaults' to update `font-lock-keywords'. - (setq font-lock-set-defaults nil) - (font-lock-set-defaults) - (if font-lock-mode - (font-lock-flush) - (gnus-message-citation-mode (font-lock-mode 1))))) + (if (not font-lock-mode) + (gnus-message-citation-mode (font-lock-mode 1)) + (if gnus-message-citation-mode + ;; `gnus-message-citation-keywords' should be the last + ;; elements of the keywords because the others are unlikely + ;; to have the OVERRIDE flags -- XEmacs applies a keyword + ;; having no OVERRIDE flag to matched text even if it has + ;; already other faces, while Emacs doesn't. + (font-lock-add-keywords nil gnus-message-citation-keywords t) + (font-lock-remove-keywords nil gnus-message-citation-keywords)) + (font-lock-flush)))) (defun turn-on-gnus-message-citation-mode () "Turn on `gnus-message-citation-mode'." -- cgit v1.2.3 From a33f3947ea1ba429570e2ecb4c3167341dcae1a2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 18 Jan 2024 14:05:16 -0500 Subject: * lisp/progmodes/elisp-mode.el (elisp-completion-at-point): Fix bug#68514 Redo the commit 0db2126d7176 to try and avoid selecting more than a mere symbol. --- lisp/progmodes/elisp-mode.el | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 00910fb67c7..da0cb96e1cf 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -657,12 +657,13 @@ functions are annotated with \"\" via the (save-excursion (backward-sexp 1) (skip-chars-forward "`',‘#") - (point)) + (min (point) pos)) (scan-error pos))) (end - (unless (or (eq beg (point-max)) - (member (char-syntax (char-after beg)) - '(?\" ?\())) + (cond + ((and (< beg (point-max)) + (memq (char-syntax (char-after beg)) + '(?w ?\\ ?_))) (condition-case nil (save-excursion (goto-char beg) @@ -670,7 +671,11 @@ functions are annotated with \"\" via the (skip-chars-backward "'’") (when (>= (point) pos) (point))) - (scan-error pos)))) + (scan-error pos))) + ((or (>= beg (point-max)) + (memq (char-syntax (char-after beg)) + '(?\) ?\s))) + beg))) ;; t if in function position. (funpos (eq (char-before beg) ?\()) (quoted (elisp--form-quoted-p beg)) -- cgit v1.2.3 From 81a2212bd52f68045b47d8be9345736655de6607 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 18 Jan 2024 18:28:54 -0500 Subject: * lisp/international/quail.el (quail-input-method): Fix bug#68338 --- lisp/international/quail.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 56f049aedf5..48d2ccb8828 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -1324,9 +1324,11 @@ If STR has `advice' text property, append the following special event: ;; binding in `universal-argument-map' just return ;; (list KEY), otherwise act as if there was no ;; overriding map. - (or (not (eq (cadr overriding-terminal-local-map) - universal-argument-map)) - (lookup-key overriding-terminal-local-map (vector key)))) + ;; We used to do that only for `universal-argument-map', + ;; but according to bug#68338 this should also apply to + ;; other transient maps. Let's hope it's OK to apply it + ;; to all `overriding-terminal-local-map's. + (lookup-key overriding-terminal-local-map (vector key))) overriding-local-map) (list key) (quail-setup-overlays (quail-conversion-keymap)) -- cgit v1.2.3 From 13c7933a9d4b26e74e7f5e19d70bb89003239c34 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 15 Jan 2024 05:53:24 -0800 Subject: Add test for erc-extract-command-from-line * lisp/erc/erc.el (erc-extract-command-from-line): Redo doc string. * test/lisp/erc/erc-tests.el (erc--parse-isupport-value): Add case for commonly seen escaped character ?=. (erc-extract-command-from-line): New test. ; * test/lisp/erc/resources/erc-d/resources/basic.eld: Update. ; Don't send unnegotiated multi-prefixed userhost names. ; * test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld: Update. ; * test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld: Update. ; * test/lisp/erc/resources/erc-d/resources/dynamic.eld: Update. ; * test/lisp/erc/resources/erc-d/resources/eof.eld: Update. ; * test/lisp/erc/resources/erc-d/resources/fuzzy.eld: Update. ; * test/lisp/erc/resources/erc-d/resources/incremental.eld: Update. ; * test/lisp/erc/resources/erc-d/resources/linger.eld: Update. ; * test/lisp/erc/resources/erc-d/resources/no-block.eld: Update. ; * test/lisp/erc/resources/erc-d/resources/no-match.eld: Update. ; * test/lisp/erc/resources/erc-d/resources/unexpected.eld: Update. --- lisp/erc/erc.el | 15 +++++-- test/lisp/erc/erc-tests.el | 48 ++++++++++++++++++++++ test/lisp/erc/resources/erc-d/resources/basic.eld | 5 +-- .../resources/erc-d/resources/dynamic-barnet.eld | 2 +- .../resources/erc-d/resources/dynamic-foonet.eld | 2 +- .../lisp/erc/resources/erc-d/resources/dynamic.eld | 5 +-- test/lisp/erc/resources/erc-d/resources/eof.eld | 5 +-- test/lisp/erc/resources/erc-d/resources/fuzzy.eld | 4 +- .../erc/resources/erc-d/resources/incremental.eld | 5 +-- test/lisp/erc/resources/erc-d/resources/linger.eld | 5 +-- .../erc/resources/erc-d/resources/no-block.eld | 7 ++-- .../erc/resources/erc-d/resources/no-match.eld | 5 +-- .../erc/resources/erc-d/resources/unexpected.eld | 5 +-- 13 files changed, 81 insertions(+), 32 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 478683a77f5..6332a8f6763 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7973,9 +7973,18 @@ as outgoing chat messages and echoed slash commands." (when (fboundp cmd) cmd))) (defun erc-extract-command-from-line (line) - "Extract command and args from the input LINE. -If no command was given, return nil. If command matches, return a -list of the form: (command args) where both elements are strings." + "Extract a \"slash command\" and its args from a prompt-input LINE. +If LINE doesn't start with a slash command, return nil. If it +does, meaning the pattern `erc-command-regexp' matches, return a +list of the form (COMMAND ARGS), where COMMAND is either a symbol +for a known handler function or `erc-cmd-default' if unknown. +When COMMAND has the symbol property `do-not-parse-args', return +a string in place of ARGS: that is, either LINE itself, when LINE +consists of only whitespace, or LINE stripped of any trailing +whitespace, including a final newline. When COMMAND lacks the +symbol property `do-not-parse-args', return a possibly empty list +of non-whitespace tokens. Do not perform any shell-style parsing +of quoted or escaped substrings." (when (string-match erc-command-regexp line) (let* ((cmd (erc-command-symbol (match-string 1 line))) ;; note: return is nil, we apply this simply for side effects diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b3912cab33d..e3e20b7ba8f 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -969,6 +969,7 @@ (should (equal (erc--parse-isupport-value "\\x20\\x20\\x20") '(" "))) (should (equal (erc--parse-isupport-value "\\x5Co/") '("\\o/"))) (should (equal (erc--parse-isupport-value "\\x7F,\\x19") '("\\x7F" "\\x19"))) + (should (equal (erc--parse-isupport-value "a\\x3Db") '("a=b"))) (should (equal (erc--parse-isupport-value "a\\x2Cb,c") '("a,b" "c")))) (ert-deftest erc--get-isupport-entry () @@ -1663,6 +1664,53 @@ (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b"))))) (should-not erc-ask-about-multiline-input))) +(ert-deftest erc-extract-command-from-line () + ;; FIXME when next modifying `erc-command-regexp's default value, + ;; move the single quote in the first group's character alternative + ;; to the front, i.e., [A-Za-z'] -> ['A-Za-z], so we can assert + ;; equivalence with this more readable `rx' form. + (rx bol + "/" + (group (+ (in "'A-Za-z"))) + (group (| (: (+ (syntax whitespace)) (* nonl)) + (* (syntax whitespace)))) + eol) + (erc-mode) ; for `erc-mode-syntax-table' + + ;; Non-command. + (should-not (erc-extract-command-from-line "FAKE\n")) + ;; Unknown command. + (should (equal (erc-extract-command-from-line "/FAKE\n") + '(erc-cmd-default "/FAKE\n"))) + + (ert-info ("With `do-not-parse-args'") + (should (equal (erc-extract-command-from-line "/MSG\n") + '(erc-cmd-MSG "\n"))) + (should (equal (erc-extract-command-from-line "/MSG \n") + '(erc-cmd-MSG " \n"))) + (should (equal (erc-extract-command-from-line "/MSG \n\n") + '(erc-cmd-MSG " \n\n"))) + (should (equal (erc-extract-command-from-line "/MSG foo\n") + '(erc-cmd-MSG " foo"))) + (should (equal (erc-extract-command-from-line "/MSG foo\n\n") + '(erc-cmd-MSG " foo"))) + (should (equal (erc-extract-command-from-line "/MSG foo\n \n") + '(erc-cmd-MSG " foo"))) + (should (equal (erc-extract-command-from-line "/MSG foo\n") + '(erc-cmd-MSG " foo")))) + + (ert-info ("Without `do-not-parse-args'") + (should (equal (erc-extract-command-from-line "/HELP\n") + '(erc-cmd-HELP nil))) + (should (equal (erc-extract-command-from-line "/HELP \n") + '(erc-cmd-HELP nil))) + (should (equal (erc-extract-command-from-line "/HELP foo\n") + '(erc-cmd-HELP ("foo")))) + (should (equal (erc-extract-command-from-line "/HELP foo\n") + '(erc-cmd-HELP ("foo")))) + (should (equal (erc-extract-command-from-line "/HELP foo bar\n") + '(erc-cmd-HELP ("foo" "bar")))))) + ;; The point of this test is to ensure output is handled identically ;; regardless of whether a command handler is summoned. diff --git a/test/lisp/erc/resources/erc-d/resources/basic.eld b/test/lisp/erc/resources/erc-d/resources/basic.eld index a020eec3fff..80e46d9a279 100644 --- a/test/lisp/erc/resources/erc-d/resources/basic.eld +++ b/test/lisp/erc/resources/erc-d/resources/basic.eld @@ -8,8 +8,7 @@ (0 ":irc.example.org 002 tester :Your host is irc.example.org") (0 ":irc.example.org 003 tester :This server was created just now") (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv") - (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)") ;; Just to mix thing's up (force handler to schedule timer) (0.1 ":irc.example.org 252 tester 0 :IRC Operators online") @@ -24,7 +23,7 @@ (0 ":irc.example.org 221 tester +Zi") (0 ":irc.example.org 306 tester :You have been marked as being away") (0 ":tester!~tester@localhost JOIN #chan") - (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.example.org 353 alice = #chan :+alice @bob") (0 ":irc.example.org 366 alice #chan :End of NAMES list")) ;; Some comment (to prevent regression) diff --git a/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld b/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld index e8feb2e6fd8..47be0722115 100644 --- a/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld +++ b/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld @@ -22,7 +22,7 @@ (0. ":irc.barnet.org 221 tester +Zi") (0. ":irc.barnet.org 306 tester :You have been marked as being away") (0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan") - (0 ":irc.barnet.org 353 joe = #chan :+joe!~joe@example.com @%+mike!~mike@example.org") + (0 ":irc.barnet.org 353 joe = #chan :+joe @mike") (0 ":irc.barnet.org 366 joe #chan :End of NAMES list")) ((mode 3 "MODE #chan") diff --git a/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld b/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld index 2db750e49da..5d5f8ed18a8 100644 --- a/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld +++ b/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld @@ -21,7 +21,7 @@ (0. ":irc.foonet.org 221 tester +Zi") (0. ":irc.foonet.org 306 tester :You have been marked as being away") (0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan") - (0 ":irc.foonet.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.foonet.org 353 alice = #chan :+alice @bob") (0 ":irc.foonet.org 366 alice #chan :End of NAMES list")) ((mode 3 "MODE #chan") diff --git a/test/lisp/erc/resources/erc-d/resources/dynamic.eld b/test/lisp/erc/resources/erc-d/resources/dynamic.eld index 459b6e52bfe..64d8c091ad7 100644 --- a/test/lisp/erc/resources/erc-d/resources/dynamic.eld +++ b/test/lisp/erc/resources/erc-d/resources/dynamic.eld @@ -7,8 +7,7 @@ (0.0 ":" dom " 002 " nick " :Your host is " dom) (0.0 ":" dom " 003 " nick " :This server was created just now") (0.0 ":" dom " 004 " nick " " dom " BERios CEIRabehiklmnoqstv Iabehkloqv") - (0.0 ":" dom " 005 " nick " MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0.0 ":" dom " 005 " nick " MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0.0 ":" dom " 251 " nick " :There are 3 users and 0 invisible on 1 server(s)") (0.0 ":" dom " 252 " nick " 0 :IRC Operators online") (0.0 ":" dom " 253 " nick " 0 :unregistered connections") @@ -23,7 +22,7 @@ (0.0 ":" dom " 306 " nick " :You have been marked as being away") (0.0 ":" nick "!~" nick "@localhost JOIN #chan") - (0.0 ":" dom " 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0.0 ":" dom " 353 alice = #chan :+alice @bob") (0.0 ":" dom " 366 alice #chan :End of NAMES list")) ((mode 2.2 "MODE #chan") diff --git a/test/lisp/erc/resources/erc-d/resources/eof.eld b/test/lisp/erc/resources/erc-d/resources/eof.eld index 5da84b2e74f..db39b3d4af1 100644 --- a/test/lisp/erc/resources/erc-d/resources/eof.eld +++ b/test/lisp/erc/resources/erc-d/resources/eof.eld @@ -8,8 +8,7 @@ (0 ":irc.example.org 002 tester :Your host is irc.example.org") (0 ":irc.example.org 003 tester :This server was created just now") (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv") - (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)") ;; Just to mix thing's up (force handler to schedule timer) (0.1 ":irc.example.org 252 tester 0 :IRC Operators online") @@ -24,7 +23,7 @@ (0 ":irc.example.org 221 tester +Zi") (0 ":irc.example.org 306 tester :You have been marked as being away") (0 ":tester!~tester@localhost JOIN #chan") - (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.example.org 353 alice = #chan :+alice @bob") (0 ":irc.example.org 366 alice #chan :End of NAMES list")) ((mode-chan 1.2 "MODE #chan") diff --git a/test/lisp/erc/resources/erc-d/resources/fuzzy.eld b/test/lisp/erc/resources/erc-d/resources/fuzzy.eld index 0504b6a6682..cf64004da0d 100644 --- a/test/lisp/erc/resources/erc-d/resources/fuzzy.eld +++ b/test/lisp/erc/resources/erc-d/resources/fuzzy.eld @@ -23,12 +23,12 @@ ((~join-foo 3.2 "JOIN #foo") (0 "@time=" now " :tester!~tester@localhost JOIN #foo") - (0 "@time=" now " :irc.example.org 353 alice = #foo :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 "@time=" now " :irc.example.org 353 alice = #foo :+alice @bob") (0 "@time=" now " :irc.example.org 366 alice #foo :End of NAMES list")) ((~join-bar 1.2 "JOIN #bar") (0 "@time=" now " :tester!~tester@localhost JOIN #bar") - (0 "@time=" now " :irc.example.org 353 alice = #bar :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 "@time=" now " :irc.example.org 353 alice = #bar :+alice @bob") (0 "@time=" now " :irc.example.org 366 alice #bar :End of NAMES list")) ((~mode-foo 3.2 "MODE #foo") diff --git a/test/lisp/erc/resources/erc-d/resources/incremental.eld b/test/lisp/erc/resources/erc-d/resources/incremental.eld index a1b48495ec3..7d192a53066 100644 --- a/test/lisp/erc/resources/erc-d/resources/incremental.eld +++ b/test/lisp/erc/resources/erc-d/resources/incremental.eld @@ -7,8 +7,7 @@ (0.0 ":irc.foo.net 002 tester :Your host is irc.foo.net") (0.0 ":irc.foo.net 003 tester :This server was created just now") (0.0 ":irc.foo.net 004 tester irc.foo.net BERios CEIRabehiklmnoqstv Iabehkloqv") - (0.0 ":irc.foo.net 005 tester MODES NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0.0 ":irc.foo.net 005 tester MODES NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0.0 ":irc.foo.net 251 tester :There are 3 users and 0 invisible on 1 server(s)") (0.0 ":irc.foo.net 252 tester 0 :IRC Operators online") (0.0 ":irc.foo.net 253 tester 0 :unregistered connections") @@ -24,7 +23,7 @@ ((join 3 "JOIN #foo") (0 ":tester!~tester@localhost JOIN #foo") - (0 ":irc.foo.net 353 alice = #foo :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.foo.net 353 alice = #foo :+alice @bob") (0 ":irc.foo.net 366 alice #foo :End of NAMES list")) ((mode 3 "MODE #foo") diff --git a/test/lisp/erc/resources/erc-d/resources/linger.eld b/test/lisp/erc/resources/erc-d/resources/linger.eld index e456370a800..d68da730581 100644 --- a/test/lisp/erc/resources/erc-d/resources/linger.eld +++ b/test/lisp/erc/resources/erc-d/resources/linger.eld @@ -8,8 +8,7 @@ (0 ":irc.example.org 002 tester :Your host is irc.example.org") (0 ":irc.example.org 003 tester :This server was created just now") (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv") - (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)") ;; Just to mix thing's up (force handler to schedule timer) (0.1 ":irc.example.org 252 tester 0 :IRC Operators online") @@ -24,7 +23,7 @@ (0 ":irc.example.org 221 tester +Zi") (0 ":irc.example.org 306 tester :You have been marked as being away") (0 ":tester!~tester@localhost JOIN #chan") - (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.example.org 353 alice = #chan :+alice @bob") (0 ":irc.example.org 366 alice #chan :End of NAMES list")) ((mode-chan 2 "MODE #chan") diff --git a/test/lisp/erc/resources/erc-d/resources/no-block.eld b/test/lisp/erc/resources/erc-d/resources/no-block.eld index 2811923d8ac..af2f4a83ff6 100644 --- a/test/lisp/erc/resources/erc-d/resources/no-block.eld +++ b/test/lisp/erc/resources/erc-d/resources/no-block.eld @@ -7,8 +7,7 @@ (0.0 ":irc.org 002 tester :Your host is irc.org") (0.0 ":irc.org 003 tester :This server was created just now") (0.0 ":irc.org 004 tester irc.org BERios CEIRabehiklmnoqstv Iabehkloqv") - (0.0 ":irc.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0.0 ":irc.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0.0 ":irc.org 251 tester :There are 3 users and 0 invisible on 1 server(s)") (0.0 ":irc.org 252 tester 0 :IRC Operators online") (0.0 ":irc.org 253 tester 0 :unregistered connections") @@ -24,13 +23,13 @@ ((join-foo 1.2 "JOIN #foo") (0 ":tester!~tester@localhost JOIN #foo") - (0 ":irc.example.org 353 alice = #foo :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.example.org 353 alice = #foo :+alice @bob") (0 ":irc.example.org 366 alice #foo :End of NAMES list")) ;; This would time out if the mode-foo's outgoing blocked (remove minus signs to see) ((~join-bar 1.5 "JOIN #bar") (0 ":tester!~tester@localhost JOIN #bar") - (0 ":irc.example.org 353 alice = #bar :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.example.org 353 alice = #bar :+alice @bob") (0 ":irc.example.org 366 alice #bar :End of NAMES list")) ((mode-foo 1.2 "MODE #foo") diff --git a/test/lisp/erc/resources/erc-d/resources/no-match.eld b/test/lisp/erc/resources/erc-d/resources/no-match.eld index d147be1e084..d12854de551 100644 --- a/test/lisp/erc/resources/erc-d/resources/no-match.eld +++ b/test/lisp/erc/resources/erc-d/resources/no-match.eld @@ -8,8 +8,7 @@ (0 ":irc.example.org 002 tester :Your host is irc.example.org") (0 ":irc.example.org 003 tester :This server was created just now") (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv") - (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)") (0 ":irc.example.org 252 tester 0 :IRC Operators online") (0 ":irc.example.org 253 tester 0 :unregistered connections") @@ -25,7 +24,7 @@ ((join 1.2 "JOIN #chan") (0 ":tester!~tester@localhost JOIN #chan") - (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.example.org 353 alice = #chan :+alice @bob") (0 ":irc.example.org 366 alice #chan :End of NAMES list")) ((mode-chan 0.2 "MODE #chan") diff --git a/test/lisp/erc/resources/erc-d/resources/unexpected.eld b/test/lisp/erc/resources/erc-d/resources/unexpected.eld index ac0a8fecfa6..c03b1dbcfdb 100644 --- a/test/lisp/erc/resources/erc-d/resources/unexpected.eld +++ b/test/lisp/erc/resources/erc-d/resources/unexpected.eld @@ -7,8 +7,7 @@ (0.0 ":irc.example.org 002 tester :Your host is irc.example.org") (0.0 ":irc.example.org 003 tester :This server was created just now") (0.0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv") - (0.0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0.0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0.0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)") (0.0 ":irc.example.org 252 tester 0 :IRC Operators online") (0.0 ":irc.example.org 253 tester 0 :unregistered connections") @@ -23,6 +22,6 @@ (0.0 ":irc.example.org 306 tester :You have been marked as being away") (0.0 ":tester!~tester@localhost JOIN #chan") - (0.0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0.0 ":irc.example.org 353 alice = #chan :+alice @bob") (0.0 ":irc.example.org 366 alice #chan :End of NAMES list") (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey")) -- cgit v1.2.3 From dd2caf1a7634ea6fd8aebbdc45ea4caf22d786cd Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 14 Jan 2024 13:02:27 -0800 Subject: Redo doc strings for ERC's entry point commands * lisp/erc/erc.el: Bump Compat version in Package-Requires header to 29.1.4.4. (erc-select-read-args): Revise doc string, and update name of internal `--interactive-env--' entry-point parameter. (erc, erc-tls): Don't use `&interactive-env' as a variable name, in case it confuses persons or programs. Overhaul doc string in response to user complaints. For `erc' specifically, include literal `:keyword' symbols to help non-Emacs users understand the required syntax, which isn't obvious without an example, like `erc-tls' has, and with only "&key" and upcased metasynctatic variables to go by. (erc--current-buffer-joined-p): Remove assertion. * test/lisp/erc/erc-scenarios-keep-place-indicator.el (erc-scenarios-keep-place-indicator--follow): Try waiting for intermittently failing condition. * test/lisp/erc/erc-tests.el (erc-select-read-args): Update name of internal keyword variable. --- lisp/erc/erc.el | 117 +++++++++------------ .../lisp/erc/erc-scenarios-keep-place-indicator.el | 4 +- test/lisp/erc/erc-tests.el | 6 +- 3 files changed, 57 insertions(+), 70 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 6332a8f6763..767a693a52e 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -13,7 +13,7 @@ ;; Michael Olson (mwolson@gnu.org) ;; Kelvin White (kwhite@gnu.org) ;; Version: 5.6-git -;; Package-Requires: ((emacs "27.1") (compat "29.1.4.3")) +;; Package-Requires: ((emacs "27.1") (compat "29.1.4.4")) ;; Keywords: IRC, chat, client, Internet ;; URL: https://www.gnu.org/software/emacs/erc.html @@ -2637,8 +2637,11 @@ typically the same as that reported by `erc-current-nick'." ;;;###autoload (defun erc-select-read-args () - "Prompt the user for values of nick, server, port, and password. -With prefix arg, also prompt for user and full name." + "Prompt for connection parameters and return them in a plist. +By default, collect `:server', `:port', `:nickname', and +`:password'. With a non-nil prefix argument, also prompt for +`:user' and `:full-name'. Also return various environmental +properties needed by entry-point commands, like `erc-tls'." (let* ((input (let ((d (erc-compute-server))) (if erc--prompt-for-server-function (funcall erc--prompt-for-server-function) @@ -2692,7 +2695,7 @@ With prefix arg, also prompt for user and full name." (setq passwd nil)) `( :server ,server :port ,port :nick ,nick ,@(and user `(:user ,user)) ,@(and passwd `(:password ,passwd)) ,@(and full `(:full-name ,full)) - ,@(and env `(&interactive-env ,env))))) + ,@(and env `(--interactive-env-- ,env))))) (defmacro erc--with-entrypoint-environment (env &rest body) "Run BODY with bindings from ENV alist." @@ -2721,30 +2724,40 @@ With prefix arg, also prompt for user and full name." (full-name (erc-compute-full-name)) id ;; Used by interactive form - ((&interactive-env --interactive-env--))) - "ERC is a powerful, modular, and extensible IRC client. -This function is the main entry point for ERC. - -It allows selecting connection parameters, and then starts ERC. - -Non-interactively, it takes the keyword arguments - (server (erc-compute-server)) - (port (erc-compute-port)) - (nick (erc-compute-nick)) - (user (erc-compute-user)) - password - (full-name (erc-compute-full-name)) - id - -That is, if called with + ((--interactive-env-- --interactive-env--))) + "Connect to an Internet Relay Chat SERVER on a non-TLS PORT. +Use NICK and USER, when non-nil, to inform the IRC commands of +the same name, possibly factoring in a non-nil FULL-NAME as well. +When PASSWORD is non-nil, also send an opening server password +via the \"PASS\" command. Interactively, prompt for SERVER, +PORT, NICK, and PASSWORD, along with USER and FULL-NAME when +given a prefix argument. Non-interactively, expect the rarely +needed ID parameter, when non-nil, to be a symbol or a string for +naming the server buffer and identifying the connection +unequivocally. (See Info node `(erc) Connecting' for details +about all mentioned parameters.) + +Together with `erc-tls', this command serves as the main entry +point for ERC, the powerful, modular, and extensible IRC client. +Non-interactively, both commands accept the following keyword +arguments, with their defaults supplied by the indicated +\"compute\" functions: + + :server `erc-compute-server' + :port `erc-compute-port' + :nick `erc-compute-nick' + :user `erc-compute-user' + :password N/A + :full-name `erc-compute-full-name' + :id' N/A + +For example, when called in the following manner (erc :server \"irc.libera.chat\" :full-name \"J. Random Hacker\") -then the server and full-name will be set to those values, -whereas `erc-compute-port' and `erc-compute-nick' will be invoked -for the values of the other parameters. - -See `erc-tls' for the meaning of ID. +ERC assigns SERVER and FULL-NAME the associated keyword values +and defers to `erc-compute-port', `erc-compute-user', and +`erc-compute-nick' for those respective parameters. \(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME ID)" (interactive (let ((erc--display-context `((erc-interactive-display . erc) @@ -2770,51 +2783,26 @@ See `erc-tls' for the meaning of ID. client-certificate id ;; Used by interactive form - ((&interactive-env --interactive-env--))) - "ERC is a powerful, modular, and extensible IRC client. -This function is the main entry point for ERC over TLS. - -It allows selecting connection parameters, and then starts ERC -over TLS. - -Non-interactively, it takes the keyword arguments - (server (erc-compute-server)) - (port (erc-compute-port)) - (nick (erc-compute-nick)) - (user (erc-compute-user)) - password - (full-name (erc-compute-full-name)) - client-certificate - id - -That is, if called with - - (erc-tls :server \"irc.libera.chat\" :full-name \"J. Random Hacker\") - -then the server and full-name will be set to those values, -whereas `erc-compute-port' and `erc-compute-nick' will be invoked -for the values of their respective parameters. - -CLIENT-CERTIFICATE, if non-nil, should either be a list where the -first element is the certificate key file name, and the second -element is the certificate file name itself, or t, which means -that `auth-source' will be queried for the key and the -certificate. Authenticating using a TLS client certificate is -also referred to as \"CertFP\" (Certificate Fingerprint) -authentication by various IRC networks. - -Example usage: + ((--interactive-env-- --interactive-env--))) + "Connect to an IRC server over a TLS-encrypted connection. +Interactively, prompt for SERVER, PORT, NICK, and PASSWORD, along +with USER and FULL-NAME when given a prefix argument. +Non-interactively, also accept a CLIENT-CERTIFICATE, which should +be a list containing the file name of the certificate's key +followed by that of the certificate itself. Alternatively, +accept a value of t instead of a list, to tell ERC to query +`auth-source' for the certificate's details. + +Example client certificate (CertFP) usage: (erc-tls :server \"irc.libera.chat\" :port 6697 :client-certificate \\='(\"/home/bandali/my-cert.key\" \"/home/bandali/my-cert.crt\")) -When present, ID should be a symbol or a string to use for naming -the server buffer and identifying the connection unequivocally. -See Info node `(erc) Network Identifier' for details. Like -CLIENT-CERTIFICATE, this parameter cannot be specified -interactively. +See the alternative entry-point command `erc' as well as Info +node `(erc) Connecting' for a fuller description of the various +parameters, like ID. \(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME CLIENT-CERTIFICATE ID)" (interactive @@ -8055,7 +8043,6 @@ See also `erc-downcase'." (defun erc--current-buffer-joined-p () "Return non-nil if the current buffer is a channel and is joined." - (cl-assert erc--target) (and (erc--target-channel-p erc--target) (erc--target-channel-joined-p erc--target) t)) diff --git a/test/lisp/erc/erc-scenarios-keep-place-indicator.el b/test/lisp/erc/erc-scenarios-keep-place-indicator.el index b8ff59f4e02..572045cf0bc 100644 --- a/test/lisp/erc/erc-scenarios-keep-place-indicator.el +++ b/test/lisp/erc/erc-scenarios-keep-place-indicator.el @@ -85,8 +85,8 @@ (goto-char (window-point)) (should (looking-back (rx " tester, welcome!"))) (should (= (pos-bol) (window-start))) - (should (= (overlay-start erc--keep-place-indicator-overlay) - (pos-bol)))) + (erc-d-t-wait-for 20 + (= (overlay-start erc--keep-place-indicator-overlay) (pos-bol)))) ;; Lower window is still centered at start. (other-window 1) (switch-to-buffer "#chan") diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index e3e20b7ba8f..49c72836a22 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -2707,7 +2707,7 @@ (list :server "irc.libera.chat" :port 6697 :nick (user-login-name) - '&interactive-env + '--interactive-env-- '((erc-server-connect-function . erc-open-tls-stream) (erc-join-buffer . window)))))) @@ -2717,7 +2717,7 @@ (list :server "irc.gnu.org" :port 6697 :nick (user-login-name) - '&interactive-env + '--interactive-env-- '((erc-server-connect-function . erc-open-tls-stream) (erc-join-buffer . window)))))) @@ -2728,7 +2728,7 @@ (list :server "irc.gnu.org" :port 6697 :nick (user-login-name) - '&interactive-env + '--interactive-env-- '((erc-server-connect-function . erc-open-tls-stream) (erc--display-context -- cgit v1.2.3 From 1293aac0df4e2837a141818f225539ec847b6684 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 19 Jan 2024 15:02:50 -0500 Subject: trace.el: Make it usable in batch mode as well While at it, this fixes a bug where a traced function was not able to set `deactivate-mark`. * lisp/emacs-lisp/trace.el (trace--insert): New function, extracted from `trace-make-advice`. Output to stdout in batch mode. (trace--entry-message): Rename from `trace-entry-message`. Change calling convention. Do the insertion directly from here. (trace--exit-message): Rename from `trace-exit-message`. Change calling convention. Do the insertion directly from here. (trace-make-advice, trace-values): Simplify accordingly. --- lisp/emacs-lisp/trace.el | 118 +++++++++++++++++++++++------------------------ 1 file changed, 57 insertions(+), 61 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el index 2c8b913ec33..29775e77716 100644 --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el @@ -156,45 +156,44 @@ (defun trace-values (&rest values) "Helper function to get internal values. You can call this function to add internal values in the trace buffer." - (unless inhibit-trace - (with-current-buffer (get-buffer-create trace-buffer) - (goto-char (point-max)) - (insert - (trace-entry-message - 'trace-values trace-level values ""))))) + (trace--entry-message + 'trace-values trace-level values (lambda () ""))) -(defun trace-entry-message (function level args context) +(defun trace--entry-message (function level args context) "Generate a string that describes that FUNCTION has been entered. -LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION, -and CONTEXT is a string describing the dynamic context (e.g. values of -some global variables)." - (let ((print-circle t) - (print-escape-newlines t)) - (format "%s%s%d -> %s%s\n" - (mapconcat #'char-to-string (make-string (max 0 (1- level)) ?|) " ") - (if (> level 1) " " "") - level - ;; FIXME: Make it so we can click the function name to jump to its - ;; definition and/or untrace it. - (cl-prin1-to-string (cons function args)) - context))) - -(defun trace-exit-message (function level value context) +LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION." + (unless inhibit-trace + (trace--insert + (let ((ctx (funcall context)) + (print-circle t) + (print-escape-newlines t)) + (format "%s%s%d -> %s%s\n" + (mapconcat #'char-to-string + (make-string (max 0 (1- level)) ?|) " ") + (if (> level 1) " " "") + level + ;; FIXME: Make it so we can click the function name to + ;; jump to its definition and/or untrace it. + (cl-prin1-to-string (cons function args)) + ctx))))) + +(defun trace--exit-message (function level value context) "Generate a string that describes that FUNCTION has exited. -LEVEL is the trace level, VALUE value returned by FUNCTION, -and CONTEXT is a string describing the dynamic context (e.g. values of -some global variables)." - (let ((print-circle t) - (print-escape-newlines t)) - (format "%s%s%d <- %s: %s%s\n" - (mapconcat 'char-to-string (make-string (1- level) ?|) " ") - (if (> level 1) " " "") - level - function - ;; Do this so we'll see strings: - (cl-prin1-to-string value) - context))) - +LEVEL is the trace level, VALUE value returned by FUNCTION." + (unless inhibit-trace + (trace--insert + (let ((ctx (funcall context)) + (print-circle t) + (print-escape-newlines t)) + (format "%s%s%d <- %s: %s%s\n" + (mapconcat 'char-to-string (make-string (1- level) ?|) " ") + (if (> level 1) " " "") + level + function + ;; Do this so we'll see strings: + (cl-prin1-to-string value) + ctx))))) + (defvar trace--timer nil) (defun trace--display-buffer (buf) @@ -208,43 +207,40 @@ some global variables)." (setq trace--timer nil) (display-buffer buf nil 0)))))) +(defun trace--insert (msg) + (if noninteractive + (message "%s" (if (eq ?\n (aref msg (1- (length msg)))) + (substring msg 0 -1) msg)) + (with-current-buffer trace-buffer + (setq-local window-point-insertion-type t) + (goto-char (point-max)) + (let ((deactivate-mark nil)) ;Protect deactivate-mark. + (insert msg))))) (defun trace-make-advice (function buffer background context) "Build the piece of advice to be added to trace FUNCTION. FUNCTION is the name of the traced function. BUFFER is the buffer where the trace should be printed. BACKGROUND if nil means to display BUFFER. -CONTEXT if non-nil should be a function that returns extra info that should -be printed along with the arguments in the trace." +CONTEXT should be a function that returns extra text that should +be printed after the arguments in the trace." (lambda (body &rest args) (let ((trace-level (1+ trace-level)) - (trace-buffer (get-buffer-create buffer)) - (deactivate-mark nil) ;Protect deactivate-mark. - (ctx (funcall context))) + (trace-buffer (get-buffer-create buffer))) + ;; Insert a separator from previous trace output: (unless inhibit-trace - (with-current-buffer trace-buffer - (setq-local window-point-insertion-type t) - (unless background (trace--display-buffer trace-buffer)) - (goto-char (point-max)) - ;; Insert a separator from previous trace output: - (if (= trace-level 1) (insert trace-separator)) - (insert - (trace-entry-message - function trace-level args ctx)))) + (unless background (trace--display-buffer trace-buffer)) + (if (= trace-level 1) (trace--insert trace-separator))) + (trace--entry-message + function trace-level args context) (let ((result)) (unwind-protect (setq result (list (apply body args))) - (unless inhibit-trace - (let ((ctx (funcall context))) - (with-current-buffer trace-buffer - (unless background (trace--display-buffer trace-buffer)) - (goto-char (point-max)) - (insert - (trace-exit-message - function - trace-level - (if result (car result) '\!non-local\ exit\!) - ctx)))))) + (trace--exit-message + function + trace-level + (if result (car result) '\!non-local\ exit\!) + context)) (car result))))) (defun trace-function-internal (function buffer background context) -- cgit v1.2.3 From 3a5ee060571b29474f83ebaee11df6920ea68c6a Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Fri, 5 Jan 2024 16:40:44 +0100 Subject: ; Use HTML entities for reserved characters in 'dom-print' * lisp/dom.el (dom-print): Encode HTML reserved characters in strings. * test/lisp/dom-tests.el (dom-tests-print): New test. (Bug#68508) --- lisp/dom.el | 2 +- test/lisp/dom-tests.el | 10 ++++++++++ 2 files changed, 11 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/dom.el b/lisp/dom.el index f7043ba8252..b329379fdc3 100644 --- a/lisp/dom.el +++ b/lisp/dom.el @@ -288,7 +288,7 @@ If XML, generate XML instead of HTML." (insert ">") (dolist (child children) (if (stringp child) - (insert child) + (insert (url-insert-entities-in-string child)) (setq non-text t) (when pretty (insert "\n" (make-string (+ column 2) ?\s))) diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el index 8cbfb9ad9df..a4e913541bf 100644 --- a/test/lisp/dom-tests.el +++ b/test/lisp/dom-tests.el @@ -209,6 +209,16 @@ child results in an error." (dom-pp node t) (should (equal (buffer-string) "(\"foo\" nil)"))))) +(ert-deftest dom-tests-print () + "Test that `dom-print' correctly encodes HTML reserved characters." + (with-temp-buffer + (dom-print '(samp ((class . "samp")) "
")) + (should (equal + (buffer-string) + (concat "" + "<div class="default"> </div>" + ""))))) + (ert-deftest dom-test-search () (let ((dom '(a nil (b nil (c nil))))) (should (equal (dom-search dom (lambda (d) (eq (dom-tag d) 'a))) -- cgit v1.2.3 From 115908469d30f8c40689673312f72b44c1631c6b Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 20 Jan 2024 10:45:27 +0100 Subject: Sync with Tramp 2.6.3-pre (don't merge with master) * doc/misc/tramp.texi (Obtaining @value{tramp}): Mention the ELPA Tramp manual. (Remote processes): Adapt index. * doc/misc/trampver.texi: * lisp/net/trampver.el (tramp-version): Set to "2.6.3-pre". * lisp/net/tramp.el (tramp-local-host-regexp): Extend. Adapt :version. (tramp-signal-process): PROCESS can also be a string. (tramp-skeleton-directory-files): * lisp/net/tramp-cache.el (with-tramp-saved-file-property) (with-tramp-saved-file-properties) (with-tramp-saved-connection-property) (with-tramp-saved-connection-properties): Use `setf' but `setq' in macro. * lisp/net/tramp-compat.el (tramp-compat-funcall): Declare debug. * lisp/net/tramp-crypt.el (tramp-crypt-file-name-p): Exclude lock files. (tramp-crypt-file-name-handler-alist): Use `identity' for `abbreviate-file-name'. (tramp-crypt-add-directory, tramp-crypt-remove-directory): Adapt docstrings. (tramp-crypt-cleanup-connection): New defun. Add it to `tramp-cleanup-connection-hook' * lisp/net/tramp.el (tramp-skeleton-file-name-all-completions): Handle "." and "..". * lisp/net/tramp-adb.el (tramp-adb-handle-file-name-all-completions): * lisp/net/tramp-fuse.el (tramp-fuse-handle-file-name-all-completions): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-name-all-completions): Remove special handling of "." an "..". * lisp/net/tramp-sh.el (tramp-pipe-stty-settings): New defcustom. (tramp-sh-handle-make-process): Use it. (Bug#62093) * test/lisp/net/tramp-tests.el (tramp-test18-file-attributes): Adapt test. (tramp-test31-signal-process): Extend. --- doc/misc/tramp.texi | 16 ++++--- doc/misc/trampver.texi | 2 +- lisp/net/tramp-adb.el | 12 ++--- lisp/net/tramp-cache.el | 8 ++-- lisp/net/tramp-compat.el | 1 + lisp/net/tramp-crypt.el | 24 ++++++++-- lisp/net/tramp-fuse.el | 13 +----- lisp/net/tramp-gvfs.el | 2 +- lisp/net/tramp-sh.el | 30 +++++++++--- lisp/net/tramp.el | 33 +++++++++++--- lisp/net/trampver.el | 6 +-- test/lisp/net/tramp-tests.el | 106 ++++++++++++++++++++++++------------------- 12 files changed, 156 insertions(+), 97 deletions(-) (limited to 'lisp') diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 53a848ad652..3be88d1767a 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -318,7 +318,7 @@ behind the scenes when you open a file with @value{tramp}. @cindex GNU ELPA @vindex tramp-version -@value{tramp} is included as part of Emacs (since @w{Emacs 22.1}). +@value{tramp} is included as part of Emacs. @value{tramp} is also freely packaged for download on the Internet at @uref{https://ftp.gnu.org/gnu/tramp/}. The version number of @@ -340,10 +340,12 @@ versions packaged with Emacs can be retrieved by @end lisp @value{tramp} is also available as @uref{https://elpa.gnu.org, GNU -ELPA} package. Besides the standalone releases, further minor versions -of @value{tramp} will appear on GNU ELPA, until the next @value{tramp} -release appears. These minor versions have a four-number string, like -``2.4.5.1''. +ELPA} package. Besides the standalone releases, further minor +versions of @value{tramp} will appear on GNU ELPA, until the next +@value{tramp} release appears. These minor versions have a +four-number string, like ``2.4.5.1''. The manual of the latest +@value{tramp} ELPA package is located at +@uref{https://elpa.gnu.org/packages/doc/tramp.html}. @value{tramp} development versions are available on Git servers. Development versions contain new and incomplete features. The @@ -4108,7 +4110,7 @@ To open @command{powershell} as a remote shell, use this: @subsection Remote process connection type @vindex process-connection-type -@cindex tramp-process-connection-type +@vindex tramp-process-connection-type Asynchronous processes behave differently based on whether they use a pseudo tty or not. This is controlled by the variable @@ -4245,7 +4247,7 @@ called @code{tramp-connection-local-*-ps-profile} and @end group @end lisp -@cindex proced +@cindex @code{proced} @vindex proced-show-remote-processes If you want to see a listing of remote system processes when calling @code{proced}, set user option @code{proced-show-remote-processes} to diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 794c54c112e..956d055fdaf 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -7,7 +7,7 @@ @c In the Tramp GIT, the version number and the bug report address @c are auto-frobbed from configure.ac. -@set trampver 2.6.2.29.2 +@set trampver 2.6.3-pre @set trampurl https://www.gnu.org/software/tramp/ @set tramp-bug-report-address tramp-devel@@gnu.org @set emacsver 26.1 diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 144212a3aec..f2c50983a32 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -464,14 +464,10 @@ Emacs dired can't find files." (file-name-as-directory f) f)) (with-current-buffer (tramp-get-buffer v) - (append - ;; On some file systems like "sdcard", "." and ".." are - ;; not included. - '("." "..") - (mapcar - (lambda (l) - (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string (buffer-string) "\n" 'omit)))))))))) + (mapcar + (lambda (l) + (and (not (string-match-p (rx bol (* blank) eol) l)) l)) + (split-string (buffer-string) "\n" 'omit))))))))) (defun tramp-adb-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index b17469ba908..fe6aeca6eb0 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -338,7 +338,7 @@ Preserve timestamps." (declare (indent 3) (debug t)) `(progn ;; Unify localname. Remove hop from `tramp-file-name' structure. - (setq ,key (tramp-file-name-unify ,key ,file)) + (setf ,key (tramp-file-name-unify ,key ,file)) (let* ((hash (tramp-get-hash-table ,key)) (cached (and (hash-table-p hash) (gethash ,property hash)))) (unwind-protect (progn ,@body) @@ -356,7 +356,7 @@ Preserve timestamps." (declare (indent 3) (debug t)) `(progn ;; Unify localname. Remove hop from `tramp-file-name' structure. - (setq ,key (tramp-file-name-unify ,key ,file)) + (setf ,key (tramp-file-name-unify ,key ,file)) (let* ((hash (tramp-get-hash-table ,key)) (values (and (hash-table-p hash) @@ -472,7 +472,7 @@ used to cache connection properties of the local machine." "Save PROPERTY, run BODY, reset PROPERTY." (declare (indent 2) (debug t)) `(progn - (setq ,key (tramp-file-name-unify ,key)) + (setf ,key (tramp-file-name-unify ,key)) (let* ((hash (tramp-get-hash-table ,key)) (cached (and (hash-table-p hash) (gethash ,property hash tramp-cache-undefined)))) @@ -489,7 +489,7 @@ used to cache connection properties of the local machine." PROPERTIES is a list of file properties (strings)." (declare (indent 2) (debug t)) `(progn - (setq ,key (tramp-file-name-unify ,key)) + (setf ,key (tramp-file-name-unify ,key)) (let* ((hash (tramp-get-hash-table ,key)) (values (mapcar diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 66d312ad2f0..43de5509081 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -63,6 +63,7 @@ ;; avoid them in cases we know what we do. (defmacro tramp-compat-funcall (function &rest arguments) "Call FUNCTION with ARGUMENTS if it exists. Do not raise compiler warnings." + (declare (indent 1) (debug t)) `(when (functionp ,function) (with-no-warnings (funcall ,function ,@arguments)))) diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index a27ca875646..143327c123a 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -148,6 +148,8 @@ If NAME doesn't belong to an encrypted remote directory, return nil." (and tramp-crypt-enabled (stringp name) (not (tramp-compat-file-name-quoted-p name)) (not (string-suffix-p tramp-crypt-encfs-config name)) + ;; No lock file name. + (not (string-prefix-p ".#" (file-name-nondirectory name))) (dolist (dir tramp-crypt-directories) (and (string-prefix-p dir (file-name-as-directory (expand-file-name name))) @@ -157,7 +159,7 @@ If NAME doesn't belong to an encrypted remote directory, return nil." ;; New handlers should be added here. ;;;###tramp-autoload (defconst tramp-crypt-file-name-handler-alist - '(;; `abbreviate-file-name' performed by default handler. + '((abbreviate-file-name . identity) (access-file . tramp-crypt-handle-access-file) (add-name-to-file . tramp-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. @@ -487,7 +489,7 @@ See `tramp-crypt-do-encrypt-or-decrypt-file'." ;;;###tramp-autoload (defun tramp-crypt-add-directory (name) - "Mark remote directory NAME for encryption. + "Mark expanded remote directory NAME for encryption. Files in that directory and all subdirectories will be encrypted before copying to, and decrypted after copying from that directory. File names will be also encrypted." @@ -511,7 +513,7 @@ directory. File names will be also encrypted." #'tramp-crypt-command-completion-p) (defun tramp-crypt-remove-directory (name) - "Unmark remote directory NAME for encryption. + "Unmark expanded remote directory NAME for encryption. Existing files in that directory and its subdirectories will be kept in their encrypted form." ;; (declare (completion tramp-crypt-command-completion-p)) @@ -859,6 +861,22 @@ WILDCARD is not supported." (tramp-compat-funcall 'unlock-file (tramp-crypt-encrypt-file-name filename)))) +(defun tramp-crypt-cleanup-connection (vec) + "Cleanup crypt ressources determined by VEC." + (let ((tramp-cleanup-connection-hook + (remove + #'tramp-crypt-cleanup-connection tramp-cleanup-connection-hook))) + (dolist (dir tramp-crypt-directories) + (when (tramp-file-name-equal-p vec (tramp-dissect-file-name dir)) + (tramp-cleanup-connection (tramp-crypt-dissect-file-name dir)))))) + +;; Add cleanup hooks. +(add-hook 'tramp-cleanup-connection-hook #'tramp-crypt-cleanup-connection) +(add-hook 'tramp-crypt-unload-hook + (lambda () + (remove-hook 'tramp-cleanup-connection-hook + #'tramp-crypt-cleanup-connection))) + (with-eval-after-load 'bookmark (add-hook 'bookmark-inhibit-context-functions #'tramp-crypt-file-name-p) diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index 885000406ea..47870c05911 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -108,17 +108,8 @@ (tramp-fuse-remove-hidden-files (all-completions filename - (append - (file-name-all-completions - filename (tramp-fuse-local-file-name directory)) - ;; Some storage systems do not return "." and "..". - (let (result) - (dolist (item '(".." ".") result) - (when (string-prefix-p filename item) - (catch 'match - (dolist (elt completion-regexp-list) - (unless (string-match-p elt item) (throw 'match nil))) - (setq result (cons (concat item "/") result))))))))))) + (file-name-all-completions + filename (tramp-fuse-local-file-name directory)))))) ;; This function isn't used. (defun tramp-fuse-handle-insert-directory diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index ecb0f922f54..2ccba85c238 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1440,7 +1440,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." filename (with-parsed-tramp-file-name (expand-file-name directory) nil (with-tramp-file-property v localname "file-name-all-completions" - (let ((result '("./" "../"))) + (let (result) ;; Get a list of directories and files. (dolist (item (tramp-gvfs-get-directory-attributes directory) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 40e706c4a11..38925652376 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2876,7 +2876,16 @@ the result will be a local, non-Tramp, file name." (tramp-run-real-handler #'expand-file-name (list localname)))))))))) -;;; Remote commands: +;;; Remote processes: + +(defcustom tramp-pipe-stty-settings "-icanon min 1 time 0" + "How to prevent blocking read in pipeline processes. +This is used in `make-process' with `connection-type' `pipe'." + :group 'tramp + :version "29.3" + :type '(choice (const :tag "Use size limit" "-icanon min 1 time 0") + (const :tag "Use timeout" "-icanon min 0 time 1") + string)) ;; We use BUFFER also as connection buffer during setup. Because of ;; this, its original contents must be saved, and restored once @@ -3087,12 +3096,21 @@ implementation will be used." ;; otherwise strings larger than 4096 ;; bytes, sent by the process, could ;; block, see termios(3) and Bug#61341. + ;; In order to prevent blocking read + ;; from pipe processes, "stty -icanon" + ;; is used. By default, it expects at + ;; least one character to read. When a + ;; process does not read from stdin, + ;; like magit, it should set a timeout + ;; instead. See`tramp-pipe-stty-settings'. + ;; (Bug#62093) ;; FIXME: Shall we rather use "stty raw"? - (if (tramp-check-remote-uname v "Darwin") - (tramp-send-command - v "stty -icanon min 1 time 0") - (tramp-send-command - v "stty -icrnl -icanon min 1 time 0"))) + (tramp-send-command + v (format + "stty %s %s" + (if (tramp-check-remote-uname v "Darwin") + "" "-icrnl") + tramp-pipe-stty-settings))) ;; `tramp-maybe-open-connection' and ;; `tramp-send-command-and-read' could ;; have trashed the connection buffer. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 15a12000120..56b00bdeb42 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -569,11 +569,15 @@ host runs a restricted shell, it shall be added to this list, too." (tramp-compat-rx bos (| (literal tramp-system-name) - (| "localhost" "localhost4" "localhost6" "127.0.0.1" "::1")) + (| "localhost" "127.0.0.1" "::1" + ;; Fedora. + "localhost4" "localhost6" + ;; Ubuntu. + "ip6-localhost" "ip6-loopback")) eos) "Host names which are regarded as local host. If the local host runs a chrooted environment, set this to nil." - :version "29.1" + :version "29.3" :type '(choice (const :tag "Chrooted environment" nil) (regexp :tag "Host regexp"))) @@ -3071,19 +3075,27 @@ not in completion mode." (tramp-run-real-handler #'file-exists-p (list filename)))) (defmacro tramp-skeleton-file-name-all-completions - (_filename _directory &rest body) + (filename directory &rest body) "Skeleton for `tramp-*-handle-filename-all-completions'. BODY is the backend specific code." (declare (indent 2) (debug t)) `(tramp-compat-ignore-error file-missing (delete-dups (delq nil (let* ((case-fold-search read-file-name-completion-ignore-case) - (regexp (mapconcat #'identity completion-regexp-list "\\|")) - (result ,@body)) + (result (progn ,@body))) + ;; Some storage systems do not return "." and "..". + (when (tramp-tramp-file-p ,directory) + (dolist (elt '(".." ".")) + (when (string-prefix-p ,filename elt) + (setq result (cons (concat elt "/") result))))) (if (consp completion-regexp-list) ;; Discriminate over `completion-regexp-list'. (mapcar - (lambda (x) (and (stringp x) (string-match-p regexp x) x)) + (lambda (x) + (when (stringp x) + (catch 'match + (dolist (elt completion-regexp-list x) + (unless (string-match-p elt x) (throw 'match nil)))))) result) result)))))) @@ -3617,7 +3629,7 @@ BODY is the backend specific code." (with-parsed-tramp-file-name (expand-file-name ,directory) nil (tramp-barf-if-file-missing v ,directory (when (file-directory-p ,directory) - (setq ,directory + (setf ,directory (file-name-as-directory (expand-file-name ,directory))) (let ((temp (with-tramp-file-property v localname "directory-files" ,@body)) @@ -6895,7 +6907,14 @@ If PROCESS is a process object which contains the property `remote-pid', or PROCESS is a number and REMOTE is a remote file name, PROCESS is interpreted as process on the respective remote host, which will be the process to signal. +If PROCESS is a string, it is interpreted as process object with +the respective process name, or as a number. SIGCODE may be an integer, or a symbol whose name is a signal name." + (when (stringp process) + (setq process (or (get-process process) + (and (string-match-p (rx bol (+ digit) eol) process) + (string-to-number process)) + (signal 'wrong-type-argument (list #'processp process))))) (let (pid vec) (cond ((processp process) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 7817c520974..1647960ef0e 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.6.2.29.2 +;; Version: 2.6.3-pre ;; Package-Requires: ((emacs "26.1")) ;; Package-Type: multi ;; URL: https://www.gnu.org/software/tramp/ @@ -40,7 +40,7 @@ ;; ./configure" to change them. ;;;###tramp-autoload -(defconst tramp-version "2.6.2.29.2" +(defconst tramp-version "2.6.3-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -78,7 +78,7 @@ ;; Check for Emacs version. (let ((x (if (not (string-version-lessp emacs-version "26.1")) "ok" - (format "Tramp 2.6.2.29.2 is not fit for %s" + (format "Tramp 2.6.3-pre is not fit for %s" (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 5f2a41909b7..465afa87bb0 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3757,7 +3757,7 @@ This tests also `access-file', `file-readable-p', (should (eq (file-attribute-type attr) t))) ;; Cleanup. - (ignore-errors (delete-directory tmp-name1)) + (ignore-errors (delete-directory tmp-name1 'recursive)) (ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-file tmp-name2)))))) @@ -5675,55 +5675,69 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (delete-exited-processes t) kill-buffer-query-functions command proc) - (dolist (sigcode '(2 INT)) - (unwind-protect - (with-temp-buffer - (setq command "trap 'echo boom; exit 1' 2; sleep 100" - proc (start-file-process-shell-command - (format "test1%s" sigcode) (current-buffer) command)) - (should (processp proc)) - (should (process-live-p proc)) - (should (equal (process-status proc) 'run)) - (should (numberp (process-get proc 'remote-pid))) - (should (equal (process-get proc 'remote-command) - (with-connection-local-variables - `(,shell-file-name ,shell-command-switch ,command)))) - (should (zerop (signal-process proc sigcode))) - ;; Let the process accept the signal. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (accept-process-output proc 0 nil t))) - (should-not (process-live-p proc))) + ;; If PROCESS is a string, it must be a process name or a process + ;; number. Check error handling. + (should-error + (signal-process (md5 (current-time-string)) 0) + :type 'wrong-type-argument) + + ;; The PROCESS argument of `signal-process' can be a string. Test + ;; this as well. + (dolist + (func '(identity + (lambda (x) (format "%s" (if (processp x) (process-name x) x))))) + (dolist (sigcode '(2 INT)) + (unwind-protect + (with-temp-buffer + (setq command "trap 'echo boom; exit 1' 2; sleep 100" + proc (start-file-process-shell-command + (format "test1-%s" sigcode) (current-buffer) command)) + (should (processp proc)) + (should (process-live-p proc)) + (should (equal (process-status proc) 'run)) + (should (numberp (process-get proc 'remote-pid))) + (should + (equal (process-get proc 'remote-command) + (with-connection-local-variables + `(,shell-file-name ,shell-command-switch ,command)))) + (should (zerop (signal-process (funcall func proc) sigcode))) + ;; Let the process accept the signal. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (accept-process-output proc 0 nil t))) + (should-not (process-live-p proc))) - ;; Cleanup. - (ignore-errors (kill-process proc)) - (ignore-errors (delete-process proc))) + ;; Cleanup. + (ignore-errors (kill-process proc)) + (ignore-errors (delete-process proc))) - (unwind-protect - (with-temp-buffer - (setq command "trap 'echo boom; exit 1' 2; sleep 100" - proc (start-file-process-shell-command - (format "test2%s" sigcode) (current-buffer) command)) - (should (processp proc)) - (should (process-live-p proc)) - (should (equal (process-status proc) 'run)) - (should (numberp (process-get proc 'remote-pid))) - (should (equal (process-get proc 'remote-command) - (with-connection-local-variables - `(,shell-file-name ,shell-command-switch ,command)))) - ;; `signal-process' has argument REMOTE since Emacs 29. - (with-no-warnings + (unwind-protect + (with-temp-buffer + (setq command "trap 'echo boom; exit 1' 2; sleep 100" + proc (start-file-process-shell-command + (format "test2-%s" sigcode) (current-buffer) command)) + (should (processp proc)) + (should (process-live-p proc)) + (should (equal (process-status proc) 'run)) + (should (numberp (process-get proc 'remote-pid))) (should - (zerop - (signal-process - (process-get proc 'remote-pid) sigcode default-directory)))) - ;; Let the process accept the signal. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (accept-process-output proc 0 nil t))) - (should-not (process-live-p proc))) + (equal (process-get proc 'remote-command) + (with-connection-local-variables + `(,shell-file-name ,shell-command-switch ,command)))) + ;; `signal-process' has argument REMOTE since Emacs 29. + (with-no-warnings + (should + (zerop + (signal-process + (funcall func (process-get proc 'remote-pid)) + sigcode default-directory)))) + ;; Let the process accept the signal. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (accept-process-output proc 0 nil t))) + (should-not (process-live-p proc))) - ;; Cleanup. - (ignore-errors (kill-process proc)) - (ignore-errors (delete-process proc)))))) + ;; Cleanup. + (ignore-errors (kill-process proc)) + (ignore-errors (delete-process proc))))))) (ert-deftest tramp-test31-list-system-processes () "Check `list-system-processes'." -- cgit v1.2.3 From 8bb5525b62163d7c3617a8b61da94f1a12a8d8e8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 20 Jan 2024 06:37:09 -0500 Subject: ; Fix merge snafus * lisp/jsonrpc.el: * lisp/progmodes/eglot.el: Fix merge snafus. --- lisp/jsonrpc.el | 3 +++ lisp/progmodes/eglot.el | 43 ------------------------------------------- 2 files changed, 3 insertions(+), 43 deletions(-) (limited to 'lisp') diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 0ecde0a5425..1f8e1b1a876 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -689,6 +689,9 @@ With optional CLEANUP, kill any associated buffers." (when-let (p (slot-value connection '-autoport-inferior)) (delete-process p)) (funcall (jsonrpc--on-shutdown connection) connection))))) +(defvar jsonrpc--in-process-filter nil + "Non-nil if inside `jsonrpc--process-filter'.") + (cl-defun jsonrpc--process-filter (proc string) "Called when new data STRING has arrived for PROC." (when jsonrpc--in-process-filter diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 5d3f7159161..c5cfdd3cedd 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1803,49 +1803,6 @@ If optional MARKER, return a marker instead" vec) "Like `url-path-allowed-chars' but more restrictive.") -(defun eglot--path-to-uri (path) - "URIfy PATH." - (let ((truepath (file-truename path))) - (if (and (url-type (url-generic-parse-url path)) - ;; It might be MS Windows path which includes a drive - ;; letter that looks like a URL scheme (bug#59338) - (not (and (eq system-type 'windows-nt) - (file-name-absolute-p truepath)))) - ;; Path is already a URI, so forward it to the LSP server - ;; untouched. The server should be able to handle it, since - ;; it provided this URI to clients in the first place. - path - (concat "file://" - ;; Add a leading "/" for local MS Windows-style paths. - (if (and (eq system-type 'windows-nt) - (not (file-remote-p truepath))) - "/") - (url-hexify-string - ;; Again watch out for trampy paths. - (directory-file-name (file-local-name truepath)) - eglot--uri-path-allowed-chars))))) - -(declare-function w32-long-file-name "w32proc.c" (fn)) -(defun eglot--uri-to-path (uri) - "Convert URI to file path, helped by `eglot--current-server'." - (when (keywordp uri) (setq uri (substring (symbol-name uri) 1))) - (let* ((server (eglot-current-server)) - (remote-prefix (and server (eglot--trampish-p server))) - (url (url-generic-parse-url uri))) - ;; Only parse file:// URIs, leave other URI untouched as - ;; `file-name-handler-alist' should know how to handle them - ;; (bug#58790). - (if (string= "file" (url-type url)) - (let* ((retval (url-unhex-string (url-filename url))) - ;; Remove the leading "/" for local MS Windows-style paths. - (normalized (if (and (not remote-prefix) - (eq system-type 'windows-nt) - (cl-plusp (length retval))) - (w32-long-file-name (substring retval 1)) - retval))) - (concat remote-prefix normalized)) - uri))) - (defun eglot--snippet-expansion-fn () "Compute a function to expand snippets. Doubles as an indicator of snippet support." -- cgit v1.2.3 From 412cc0212d7bf2f2d0f49fdb8a4ff69480b8afed Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 20 Jan 2024 05:43:27 -0600 Subject: Eldoc: play nice with mode-line-format-right-align (bug#68547) * lisp/emacs-lisp/eldoc.el (eldoc-minibuffer-message): Avoid nesting 'mode-line-format', since that breaks 'mode-line-format-right-align'. --- lisp/emacs-lisp/eldoc.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 06970d40e8a..912a7357ca7 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -312,9 +312,11 @@ Otherwise, it displays the message like `message' would." (not (and (listp mode-line-format) (assq 'eldoc-mode-line-string mode-line-format)))) (setq mode-line-format - (list "" '(eldoc-mode-line-string - (" " eldoc-mode-line-string " ")) - mode-line-format))) + (funcall + (if (listp mode-line-format) #'append #'list) + (list "" '(eldoc-mode-line-string + (" " eldoc-mode-line-string " "))) + mode-line-format))) (setq eldoc-mode-line-string (when (stringp format-string) (apply #'format-message format-string args))) -- cgit v1.2.3 From eb779ae64677e643d2d78cfc2b016088e8d7ff98 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Jan 2024 18:05:14 -0500 Subject: * lisp/keymap.el (define-keymap): Demote "duplicate def" to a warning * test/src/keymap-tests.el (keymap-test-duplicate-definitions): Adjust accordingly. --- lisp/keymap.el | 12 +++++++++--- test/src/keymap-tests.el | 17 +++++++++++++---- 2 files changed, 22 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/keymap.el b/lisp/keymap.el index 065c59da74c..d2544e30ce0 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -577,9 +577,15 @@ should be a MENU form as accepted by `easy-menu-define'. (let ((def (pop definitions))) (if (eq key :menu) (easy-menu-define nil keymap "" def) - (if (member key seen-keys) - (error "Duplicate definition for key: %S %s" key keymap) - (push key seen-keys)) + (when (member key seen-keys) + ;; Since the keys can be computed dynamically, it can + ;; very well happen that we get duplicate definitions + ;; due to some unfortunate configuration rather than + ;; due to an actual bug. While such duplicates are + ;; not desirable, they shouldn't prevent the users + ;; from getting their job done. + (message "Duplicate definition for key: %S %s" key keymap)) + (push key seen-keys) (keymap-set keymap key def))))) keymap))) diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index bc9977f31bf..04b897045db 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -23,6 +23,7 @@ ;;; Code: (require 'ert) +(require 'cl-lib) (defun keymap-tests--make-keymap-test (fun) (should (eq (car (funcall fun)) 'keymap)) @@ -470,10 +471,18 @@ g .. h foo ert-keymap-duplicate "a" #'next-line "a" #'previous-line)) - (should-error - (define-keymap - "a" #'next-line - "a" #'previous-line))) + (let ((msg "")) + ;; FIXME: It would be nicer to use `current-message' rather than override + ;; `message', but `current-message' returns always nil in batch mode :-( + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) (setq msg (apply #'format fmt args))))) + (should + (string-match "duplicate" + (progn + (define-keymap + "a" #'next-line + "a" #'previous-line) + msg)))))) (ert-deftest keymap-unset-test-remove-and-inheritance () "Check various behaviors of keymap-unset. (Bug#62207)" -- cgit v1.2.3 From 82f71e106afd9bede95cfea3025f7c059d7c2bcf Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Jan 2024 18:08:31 -0500 Subject: * lisp/completion-preview.el: Fix use in non-GUI session Fix loading in non-GUI sessions where `mwheel` is not preloaded. Not requiring `mwheel` would be a lot more complex, since it would require delaying the construction of `completion-preview--mouse-map`. * lisp/completion-preview.el (): Require `mwheel`. Remove correspondingly redundant `defvar`s. (completion-preview--mouse-map): Use `key-description` rather than mimicking it with `format`. --- lisp/completion-preview.el | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index baadb4714b1..3bb5ef24e9d 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -52,6 +52,8 @@ ;;; Code: +(require 'mwheel) + (defgroup completion-preview nil "In-buffer completion preview." :group 'completion) @@ -128,19 +130,19 @@ If this option is nil, these commands do not display any message." ;; "M-p" #'completion-preview-prev-candidate ) -(defvar mouse-wheel-up-event) -(defvar mouse-wheel-up-alternate-event) -(defvar mouse-wheel-down-event) -(defvar mouse-wheel-down-alternate-event) (defvar-keymap completion-preview--mouse-map :doc "Keymap for mouse clicks on the completion preview." "" #'completion-preview-insert "C-" #'completion-at-point "" #'completion-at-point - (format "<%s>" mouse-wheel-up-event) #'completion-preview-prev-candidate - (format "<%s>" mouse-wheel-up-alternate-event) #'completion-preview-prev-candidate - (format "<%s>" mouse-wheel-down-event) #'completion-preview-next-candidate - (format "<%s>" mouse-wheel-down-alternate-event) #'completion-preview-next-candidate) + (key-description (vector mouse-wheel-up-event)) + #'completion-preview-prev-candidate + (key-description (vector mouse-wheel-up-alternate-event)) + #'completion-preview-prev-candidate + (key-description (vector mouse-wheel-down-event)) + #'completion-preview-next-candidate + (key-description (vector mouse-wheel-down-alternate-event)) + #'completion-preview-next-candidate) (defvar-local completion-preview--overlay nil) -- cgit v1.2.3 From db8890b3c96289ca95e4ea3ea53f0eda1a948af6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Jan 2024 18:28:12 -0500 Subject: mwheel.el: Unconditionally use the `wheel-up/down/...` events The `mouse-wheel-DIR-event` vars were introduced because under X11 we get different `mouse-N` events depending on the users' mouse and those same events can be used for other things for other rodents, so we can't unconditionally treat those events as mouse-wheel events. But this does not apply to the `wheel-up/down/...` events. So hard code them. * lisp/mwheel.el (mwheel--is-dir-p): Always consider the `wheel-DIR` events. (mouse-wheel--setup-bindings): Always bind the `wheel-DIR` events. * lisp/completion-preview.el (completion-preview--mouse-map): Unconditionally bind the `wheel-DIR` events. * lisp/edmacro.el (edmacro-fix-menu-commands): Hard code the `wheel-DIR` events as mouse events regardless of `mouse-wheel-*-event`s. * lisp/progmodes/flymake.el (flymake--mode-line-counter-map): Do nothing, because it's already been done in commit e5be6c7ae309. * doc/lispref/commands.texi (Misc Events): Document the need to use `wheel-up/down/left/right` unconditionally. --- doc/lispref/commands.texi | 29 +++++++++++++++-------------- etc/NEWS | 7 +++++++ lisp/completion-preview.el | 2 ++ lisp/edmacro.el | 15 ++++++++------- lisp/mwheel.el | 15 ++++++++++----- 5 files changed, 42 insertions(+), 26 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 10f47d736d2..5f840ac21ec 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2562,23 +2562,24 @@ non-@code{nil}. @vindex mouse-wheel-up-event @vindex mouse-wheel-down-event The @code{wheel-up} and @code{wheel-down} events are generated only on -some kinds of systems. On other systems, @code{mouse-4} and -@code{mouse-5} are used instead. For portable code, use the variables -@code{mouse-wheel-up-event}, @code{mouse-wheel-up-alternate-event}, -@code{mouse-wheel-down-event} and -@code{mouse-wheel-down-alternate-event} defined in @file{mwheel.el} to -determine what event types to expect from the mouse wheel. +some kinds of systems. On other systems, other events like @code{mouse-4} and +@code{mouse-5} are used instead. Portable code should handle both +@code{wheel-up} and @code{wheel-down} events as well as the events +specified in the variables @code{mouse-wheel-up-event} and +@code{mouse-wheel-down-event}, defined in @file{mwheel.el}. @vindex mouse-wheel-left-event @vindex mouse-wheel-right-event -Similarly, some mice can generate @code{mouse-wheel-left-event} and -@code{mouse-wheel-right-event} and can be used to scroll if -@code{mouse-wheel-tilt-scroll} is non-@code{nil}. However, some mice -also generate other events at the same time as they're generating -these scroll events which may get in the way. The way to fix this is -generally to unbind these events (for instance, @code{mouse-6} or -@code{mouse-7}, but this is very hardware and operating system -dependent). +The same holds for the horizontal wheel movements which are usually +represented by @code{wheel-left} and @code{wheel-right} events, but +for which portable code should also obey the variables +@code{mouse-wheel-left-event} and @code{mouse-wheel-right-event}, +defined in @file{mwheel.el}. +However, some mice also generate other events at the same time as +they're generating these scroll events which may get in the way. +The way to fix this is generally to unbind these events (for instance, +@code{mouse-6} or @code{mouse-7}, but this is very hardware and +operating system dependent). @cindex @code{pinch} event @item (pinch @var{position} @var{dx} @var{dy} @var{scale} @var{angle}) diff --git a/etc/NEWS b/etc/NEWS index f4d008ee2d6..fefdfb2afb3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -406,6 +406,13 @@ respectively, in addition to the existing translations 'C-x 8 / e' and * Changes in Specialized Modes and Packages in Emacs 30.1 ++++ +** Mwheel +The 'wheel-up/down/left/right' events are now bound unconditionally, +and the 'mouse-wheel-up/down/left/right-event' variables are thus +used only to specify the 'mouse-4/5/6/7' events generated by +legacy setup, such as 'xterm-mouse-mode' or X11 without XInput2. + +++ ** New command 'lldb'. Run the LLDB debugger, analogous to the 'gud-gdb' command. diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 3bb5ef24e9d..48b6a4fd822 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -135,6 +135,8 @@ If this option is nil, these commands do not display any message." "" #'completion-preview-insert "C-" #'completion-at-point "" #'completion-at-point + "" #'completion-preview-prev-candidate + "" #'completion-preview-next-candidate (key-description (vector mouse-wheel-up-event)) #'completion-preview-prev-candidate (key-description (vector mouse-wheel-up-alternate-event)) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 5bd0c1892e5..9ade554f559 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -748,13 +748,14 @@ This function assumes that the events can be stored in a string." ;; info is recorded in macros to make this possible. ((or (mouse-event-p ev) (mouse-movement-p ev) (memq (event-basic-type ev) - (list mouse-wheel-down-event mouse-wheel-up-event - mouse-wheel-right-event - mouse-wheel-left-event - mouse-wheel-down-alternate-event - mouse-wheel-up-alternate-event - mouse-wheel-right-alternate-event - mouse-wheel-left-alternate-event))) + `( ,mouse-wheel-down-event ,mouse-wheel-up-event + ,mouse-wheel-right-event + ,mouse-wheel-left-event + ,mouse-wheel-down-alternate-event + ,mouse-wheel-up-alternate-event + ,mouse-wheel-right-alternate-event + ,mouse-wheel-left-alternate-event + wheel-down wheel-up wheel-left wheel-right))) nil) (noerror nil) (t diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 84679f5c33f..f50376c72b5 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -308,9 +308,11 @@ active window." (defmacro mwheel--is-dir-p (dir button) (declare (debug (sexp form))) (let ((custom-var (intern (format "mouse-wheel-%s-event" dir))) - (custom-var-alt (intern (format "mouse-wheel-%s-alternate-event" dir)))) + (custom-var-alt (intern (format "mouse-wheel-%s-alternate-event" dir))) + (event (intern (format "wheel-%s" dir)))) (macroexp-let2 nil butsym button - `(or (eq ,butsym ,custom-var) + `(or (eq ,butsym ',event) + (eq ,butsym ,custom-var) ;; We presume here `button' is never nil. (eq ,butsym ,custom-var-alt))))) @@ -503,14 +505,16 @@ an event used for scrolling, such as `mouse-wheel-down-event'." ((and (consp binding) (eq (cdr binding) 'text-scale)) (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event mouse-wheel-down-alternate-event - mouse-wheel-up-alternate-event)) + mouse-wheel-up-alternate-event + 'wheel-down 'wheel-up)) (when event (mouse-wheel--add-binding `[,(append (car binding) (list event))] 'mouse-wheel-text-scale)))) ((and (consp binding) (eq (cdr binding) 'global-text-scale)) (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event mouse-wheel-down-alternate-event - mouse-wheel-up-alternate-event)) + mouse-wheel-up-alternate-event + 'wheel-down 'wheel-up)) (when event (mouse-wheel--add-binding `[,(append (car binding) (list event))] 'mouse-wheel-global-text-scale)))) @@ -521,7 +525,8 @@ an event used for scrolling, such as `mouse-wheel-down-event'." mouse-wheel-down-alternate-event mouse-wheel-up-alternate-event mouse-wheel-left-alternate-event - mouse-wheel-right-alternate-event)) + mouse-wheel-right-alternate-event + 'wheel-down 'wheel-up 'wheel-left 'wheel-right)) (when event (dolist (key (mouse-wheel--create-scroll-keys binding event)) (mouse-wheel--add-binding key 'mwheel-scroll)))))))) -- cgit v1.2.3 From 18294854c717a82966090e99130bcb99fc354a5b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Jan 2024 18:52:37 -0500 Subject: mwheel.el: Remove `mouse-wheel-*-alternate-event` vars Now that `wheel-DIR` events are hardcoded, we never need more than one variable (which we actually never needed anyway, we could have let `mouse-wheel-*-event` vars hold lists of events instead), so remove the `mouse-wheel-*-alternate-event` vars by merging their default value into that of the corresponding `mouse-wheel-*-event`. * lisp/mwheel.el (mouse-wheel-down-event, mouse-wheel-up-event) (mouse-wheel-left-event, mouse-wheel-right-event): Don't bother holding `wheel-DIR` events since these are already handled anyway. Hold the event that would have been held in `mouse-wheel-DIR-alternate-event` instead. (mouse-wheel-down-alternate-event, mouse-wheel-up-alternate-event) (mouse-wheel-left-alternate-event, mouse-wheel-right-alternate-event): Delete vars. (mwheel--is-dir-p, mouse-wheel--setup-bindings): * lisp/edmacro.el (edmacro-fix-menu-commands): * lisp/completion-preview.el (completion-preview--mouse-map): Don't use `mouse-wheel-up/down-alternate-event` any more. * lisp/progmodes/flymake.el (flymake--mode-line-counter-map): Do nothing, because it already ignored those vars. --- lisp/completion-preview.el | 4 --- lisp/edmacro.el | 11 +------ lisp/mwheel.el | 76 +++++++++++++--------------------------------- 3 files changed, 22 insertions(+), 69 deletions(-) (limited to 'lisp') diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 48b6a4fd822..f552db7aa8e 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -139,11 +139,7 @@ If this option is nil, these commands do not display any message." "" #'completion-preview-next-candidate (key-description (vector mouse-wheel-up-event)) #'completion-preview-prev-candidate - (key-description (vector mouse-wheel-up-alternate-event)) - #'completion-preview-prev-candidate (key-description (vector mouse-wheel-down-event)) - #'completion-preview-next-candidate - (key-description (vector mouse-wheel-down-alternate-event)) #'completion-preview-next-candidate) (defvar-local completion-preview--overlay nil) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 9ade554f559..9d185d79142 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -729,10 +729,6 @@ This function assumes that the events can be stored in a string." (defvar mouse-wheel-up-event) (defvar mouse-wheel-right-event) (defvar mouse-wheel-left-event) - (defvar mouse-wheel-down-alternate-event) - (defvar mouse-wheel-up-alternate-event) - (defvar mouse-wheel-right-alternate-event) - (defvar mouse-wheel-left-alternate-event) ;; Make a list of the elements. (setq macro (append macro nil)) (dolist (ev macro) @@ -749,12 +745,7 @@ This function assumes that the events can be stored in a string." ((or (mouse-event-p ev) (mouse-movement-p ev) (memq (event-basic-type ev) `( ,mouse-wheel-down-event ,mouse-wheel-up-event - ,mouse-wheel-right-event - ,mouse-wheel-left-event - ,mouse-wheel-down-alternate-event - ,mouse-wheel-up-alternate-event - ,mouse-wheel-right-alternate-event - ,mouse-wheel-left-alternate-event + ,mouse-wheel-right-event ,mouse-wheel-left-event wheel-down wheel-up wheel-left wheel-right))) nil) (noerror nil) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index f50376c72b5..438ca5f84d5 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -60,44 +60,28 @@ (if (or (featurep 'w32-win) (featurep 'ns-win) (featurep 'haiku-win) (featurep 'pgtk-win) (featurep 'android-win)) - 'wheel-up + (if (featurep 'xinput2) + nil + (unless (featurep 'x) + 'mouse-4)) 'mouse-4) - "Event used for scrolling down." + "Event used for scrolling down, beside `wheel-down', if any." :group 'mouse :type 'symbol :set 'mouse-wheel-change-button) -(defcustom mouse-wheel-down-alternate-event - (if (featurep 'xinput2) - 'wheel-up - (unless (featurep 'x) - 'mouse-4)) - "Alternative wheel down event to consider." - :group 'mouse - :type 'symbol - :version "29.1" - :set 'mouse-wheel-change-button) - (defcustom mouse-wheel-up-event (if (or (featurep 'w32-win) (featurep 'ns-win) (featurep 'haiku-win) (featurep 'pgtk-win) (featurep 'android-win)) - 'wheel-down + (if (featurep 'xinput2) + nil + (unless (featurep 'x) + 'mouse-5)) 'mouse-5) - "Event used for scrolling up." - :group 'mouse - :type 'symbol - :set 'mouse-wheel-change-button) - -(defcustom mouse-wheel-up-alternate-event - (if (featurep 'xinput2) - 'wheel-down - (unless (featurep 'x) - 'mouse-5)) - "Alternative wheel up event to consider." + "Event used for scrolling up, beside `wheel-up', if any." :group 'mouse :type 'symbol - :version "29.1" :set 'mouse-wheel-change-button) (defcustom mouse-wheel-click-event 'mouse-2 @@ -252,31 +236,23 @@ Also see `mouse-wheel-tilt-scroll'." (if (or (featurep 'w32-win) (featurep 'ns-win) (featurep 'haiku-win) (featurep 'pgtk-win) (featurep 'android-win)) - 'wheel-left + (if (featurep 'xinput2) + nil + (unless (featurep 'x) + 'mouse-6)) 'mouse-6) - "Event used for scrolling left.") - -(defvar mouse-wheel-left-alternate-event - (if (featurep 'xinput2) - 'wheel-left - (unless (featurep 'x) - 'mouse-6)) - "Alternative wheel left event to consider.") + "Event used for scrolling left, beside `wheel-left', if any.") (defvar mouse-wheel-right-event (if (or (featurep 'w32-win) (featurep 'ns-win) (featurep 'haiku-win) (featurep 'pgtk-win) (featurep 'android-win)) - 'wheel-right + (if (featurep 'xinput2) + nil + (unless (featurep 'x) + 'mouse-7)) 'mouse-7) - "Event used for scrolling right.") - -(defvar mouse-wheel-right-alternate-event - (if (featurep 'xinput2) - 'wheel-right - (unless (featurep 'x) - 'mouse-7)) - "Alternative wheel right event to consider.") + "Event used for scrolling right, beside `wheel-right', if any.") (defun mouse-wheel--get-scroll-window (event) "Return window for mouse wheel event EVENT. @@ -308,13 +284,11 @@ active window." (defmacro mwheel--is-dir-p (dir button) (declare (debug (sexp form))) (let ((custom-var (intern (format "mouse-wheel-%s-event" dir))) - (custom-var-alt (intern (format "mouse-wheel-%s-alternate-event" dir))) (event (intern (format "wheel-%s" dir)))) (macroexp-let2 nil butsym button `(or (eq ,butsym ',event) - (eq ,butsym ,custom-var) ;; We presume here `button' is never nil. - (eq ,butsym ,custom-var-alt))))) + (eq ,butsym ,custom-var))))) (defun mwheel-scroll (event &optional arg) "Scroll up or down according to the EVENT. @@ -504,16 +478,12 @@ an event used for scrolling, such as `mouse-wheel-down-event'." ;; Bindings for changing font size. ((and (consp binding) (eq (cdr binding) 'text-scale)) (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event - mouse-wheel-down-alternate-event - mouse-wheel-up-alternate-event 'wheel-down 'wheel-up)) (when event (mouse-wheel--add-binding `[,(append (car binding) (list event))] 'mouse-wheel-text-scale)))) ((and (consp binding) (eq (cdr binding) 'global-text-scale)) (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event - mouse-wheel-down-alternate-event - mouse-wheel-up-alternate-event 'wheel-down 'wheel-up)) (when event (mouse-wheel--add-binding `[,(append (car binding) (list event))] @@ -522,10 +492,6 @@ an event used for scrolling, such as `mouse-wheel-down-event'." (t (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event mouse-wheel-left-event mouse-wheel-right-event - mouse-wheel-down-alternate-event - mouse-wheel-up-alternate-event - mouse-wheel-left-alternate-event - mouse-wheel-right-alternate-event 'wheel-down 'wheel-up 'wheel-left 'wheel-right)) (when event (dolist (key (mouse-wheel--create-scroll-keys binding event)) -- cgit v1.2.3 From 998667f90262432facbf43cdb1f0a96704c84271 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Jan 2024 19:05:24 -0500 Subject: mwheel.el: Code clean to reduce duplication * lisp/mwheel.el (mouse-wheel-obey-old-style-wheel-buttons): New var, extracted from `mouse-wheel-*-event` definitions. (mouse-wheel-down-event, mouse-wheel-up-event) (mouse-wheel-left-event, mouse-wheel-right-event): Use it. --- lisp/mwheel.el | 54 +++++++++++++++++++++--------------------------------- 1 file changed, 21 insertions(+), 33 deletions(-) (limited to 'lisp') diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 438ca5f84d5..fc1f8e8b6d6 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -56,33 +56,33 @@ (bound-and-true-p mouse-wheel-mode)) (mouse-wheel-mode 1))) -(defcustom mouse-wheel-down-event +(defvar mouse-wheel-obey-old-style-wheel-buttons + ;; FIXME: Yuck! (if (or (featurep 'w32-win) (featurep 'ns-win) (featurep 'haiku-win) (featurep 'pgtk-win) (featurep 'android-win)) (if (featurep 'xinput2) nil (unless (featurep 'x) - 'mouse-4)) - 'mouse-4) + t)) + t) + "If non-nil, treat mouse-4/5/6/7 events as mouse wheel events. +These are the event names used historically in X11 before XInput2. +They are sometimes generated by things like `xterm-mouse-mode' as well.") + +(defcustom mouse-wheel-down-event + (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-4) "Event used for scrolling down, beside `wheel-down', if any." :group 'mouse :type 'symbol - :set 'mouse-wheel-change-button) + :set #'mouse-wheel-change-button) (defcustom mouse-wheel-up-event - (if (or (featurep 'w32-win) (featurep 'ns-win) - (featurep 'haiku-win) (featurep 'pgtk-win) - (featurep 'android-win)) - (if (featurep 'xinput2) - nil - (unless (featurep 'x) - 'mouse-5)) - 'mouse-5) + (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-5) "Event used for scrolling up, beside `wheel-up', if any." :group 'mouse :type 'symbol - :set 'mouse-wheel-change-button) + :set #'mouse-wheel-change-button) (defcustom mouse-wheel-click-event 'mouse-2 "Event that should be temporarily inhibited after mouse scrolling. @@ -92,7 +92,7 @@ scrolling with the mouse wheel. To prevent that, this variable can be set to the event sent when clicking on the mouse wheel button." :group 'mouse :type 'symbol - :set 'mouse-wheel-change-button) + :set #'mouse-wheel-change-button) (defcustom mouse-wheel-inhibit-click-time 0.35 "Time in seconds to inhibit clicking on mouse wheel button after scroll." @@ -149,7 +149,7 @@ information, see `text-scale-adjust' and `global-text-scale-adjust'." (const :tag "Scroll horizontally" :value hscroll) (const :tag "Change buffer face size" :value text-scale) (const :tag "Change global face size" :value global-text-scale))))) - :set 'mouse-wheel-change-button + :set #'mouse-wheel-change-button :version "28.1") (defcustom mouse-wheel-progressive-speed t @@ -233,25 +233,11 @@ Also see `mouse-wheel-tilt-scroll'." "Function that does the job of scrolling right.") (defvar mouse-wheel-left-event - (if (or (featurep 'w32-win) (featurep 'ns-win) - (featurep 'haiku-win) (featurep 'pgtk-win) - (featurep 'android-win)) - (if (featurep 'xinput2) - nil - (unless (featurep 'x) - 'mouse-6)) - 'mouse-6) + (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-6) "Event used for scrolling left, beside `wheel-left', if any.") (defvar mouse-wheel-right-event - (if (or (featurep 'w32-win) (featurep 'ns-win) - (featurep 'haiku-win) (featurep 'pgtk-win) - (featurep 'android-win)) - (if (featurep 'xinput2) - nil - (unless (featurep 'x) - 'mouse-7)) - 'mouse-7) + (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-7) "Event used for scrolling right, beside `wheel-right', if any.") (defun mouse-wheel--get-scroll-window (event) @@ -335,7 +321,8 @@ value of ARG, and the command uses it in subsequent scrolls." mwheel-scroll-right-function) mouse-wheel-scroll-amount-horizontal)) ((mwheel--is-dir-p down button) - (condition-case nil (funcall mwheel-scroll-down-function amt) + (condition-case nil + (funcall mwheel-scroll-down-function amt) ;; Make sure we do indeed scroll to the beginning of ;; the buffer. (beginning-of-buffer @@ -359,7 +346,8 @@ value of ARG, and the command uses it in subsequent scrolls." ((mwheel--is-dir-p up button) (condition-case nil (funcall mwheel-scroll-up-function amt) ;; Make sure we do indeed scroll to the end of the buffer. - (end-of-buffer (while t (funcall mwheel-scroll-up-function))))) + (end-of-buffer + (while t (funcall mwheel-scroll-up-function))))) ((mwheel--is-dir-p left button) ; for tilt scroll (when mouse-wheel-tilt-scroll (funcall (if mouse-wheel-flip-direction -- cgit v1.2.3 From 9841ced147f8a198da58a7925c0be55e2ed8dc75 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 20 Jan 2024 21:08:52 +0100 Subject: ; Fix typos --- admin/codespell/codespell.exclude | 1 + lisp/net/tramp-crypt.el | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/admin/codespell/codespell.exclude b/admin/codespell/codespell.exclude index 89b8a951f93..2503f4a9a16 100644 --- a/admin/codespell/codespell.exclude +++ b/admin/codespell/codespell.exclude @@ -1548,3 +1548,4 @@ VERY VERY LONG STRIN | VERY VERY LONG STRIN (ert-info ("Joined by bouncer to #foo, pal persent") (ert-info ("Joined by bouncer to #chan@foonet, pal persent") (ert-info ("Joined by bouncer to #chan@barnet, pal persent") +.UE . diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 143327c123a..9f30cdef069 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -862,7 +862,7 @@ WILDCARD is not supported." 'unlock-file (tramp-crypt-encrypt-file-name filename)))) (defun tramp-crypt-cleanup-connection (vec) - "Cleanup crypt ressources determined by VEC." + "Cleanup crypt resources determined by VEC." (let ((tramp-cleanup-connection-hook (remove #'tramp-crypt-cleanup-connection tramp-cleanup-connection-hook))) -- cgit v1.2.3 From ca8d451561c5f722f7c3bfc63595961334b7b5f9 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 20 Jan 2024 23:00:54 -0500 Subject: (define-derived-mode): Fix bug#68600 * lisp/emacs-lisp/derived.el (define-derived-mode): Use a reference to the mode symbol instead of the mode's "pretty" name in the hook variable's docstring. --- lisp/emacs-lisp/derived.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 5c224362708..726f96a25f7 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -211,10 +211,10 @@ See Info node `(elisp)Derived Modes' for more details. (defvar ,hook nil) (unless (get ',hook 'variable-documentation) (put ',hook 'variable-documentation - ,(format "Hook run after entering %s mode. + ,(format "Hook run after entering `%S'. No problems result if this variable is not bound. `add-hook' automatically binds it. (This is true for all hook variables.)" - name))) + child))) (unless (boundp ',map) (put ',map 'definition-name ',child)) (with-no-warnings (defvar ,map (make-sparse-keymap))) -- cgit v1.2.3 From eca7368039d841993ba649bc144017598592fa56 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 20 Jan 2024 23:12:36 -0500 Subject: * lisp/mwheel.el (mouse-wheel-obey-old-style-wheel-buttons): Simplify --- lisp/mwheel.el | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/mwheel.el b/lisp/mwheel.el index fc1f8e8b6d6..d3cdab87e84 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -56,16 +56,7 @@ (bound-and-true-p mouse-wheel-mode)) (mouse-wheel-mode 1))) -(defvar mouse-wheel-obey-old-style-wheel-buttons - ;; FIXME: Yuck! - (if (or (featurep 'w32-win) (featurep 'ns-win) - (featurep 'haiku-win) (featurep 'pgtk-win) - (featurep 'android-win)) - (if (featurep 'xinput2) - nil - (unless (featurep 'x) - t)) - t) +(defvar mouse-wheel-obey-old-style-wheel-buttons t "If non-nil, treat mouse-4/5/6/7 events as mouse wheel events. These are the event names used historically in X11 before XInput2. They are sometimes generated by things like `xterm-mouse-mode' as well.") -- cgit v1.2.3 From 957b4f826a440d3d6fae8e338667530713ddf0ba Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Jan 2024 12:47:24 +0800 Subject: Don't invert wheel event directions * lisp/mwheel.el (mwheel--is-dir-p): In Emacs, up means down and down means up... --- lisp/mwheel.el | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/mwheel.el b/lisp/mwheel.el index d3cdab87e84..1e08328c875 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -261,7 +261,15 @@ active window." (defmacro mwheel--is-dir-p (dir button) (declare (debug (sexp form))) (let ((custom-var (intern (format "mouse-wheel-%s-event" dir))) - (event (intern (format "wheel-%s" dir)))) + ;; N.B. that the direction `down' in a wheel event refers to + ;; the movement of the section of the buffer the window is + ;; displaying, that is to say, the direction `scroll-up' moves + ;; it in. + (event (intern (format "wheel-%s" (cond ((eq dir 'up) + 'down) + ((eq dir 'down) + 'up) + (t dir)))))) (macroexp-let2 nil butsym button `(or (eq ,butsym ',event) ;; We presume here `button' is never nil. -- cgit v1.2.3 From 0a07603ae8db41f69e83b1bfec6e28a92f737852 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sun, 21 Jan 2024 07:08:11 +0200 Subject: project-recompile: New command * lisp/progmodes/project.el (project-recompile): New command (bug#68570). --- lisp/progmodes/project.el | 13 +++++++++++++ 1 file changed, 13 insertions(+) (limited to 'lisp') diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index a6f14a0865c..ab4504fa027 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1363,6 +1363,7 @@ If you exit the `query-replace', you can later continue the (defvar compilation-read-command) (declare-function compilation-read-command "compile") +(declare-function recompile "compile") (defun project-prefixed-buffer-name (mode) (concat "*" @@ -1396,6 +1397,18 @@ If non-nil, it overrides `compilation-buffer-name-function' for compilation-buffer-name-function))) (call-interactively #'compile))) +(defun project-recompile (&optional edit-command) + "Run `recompile' with appropriate buffer." + (declare (interactive-only recompile)) + (interactive "P") + (let ((compilation-buffer-name-function + (or project-compilation-buffer-name-function + ;; Should we error instead? When there's no + ;; project-specific naming, there is no point in using + ;; this command. + compilation-buffer-name-function))) + (recompile edit-command))) + (defcustom project-ignore-buffer-conditions nil "List of conditions to filter the buffers to be switched to. If any of these conditions are satisfied for a buffer in the -- cgit v1.2.3 From 5c12e988abb24b8240814d3dd3f40face7d48287 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 21 Jan 2024 14:09:21 +0100 Subject: doc: Delete extraneous quotes around keys * lisp/allout.el (allout-outlinify-sticky): * lisp/auth-source.el (auth-sources): * lisp/buff-menu.el (Buffer-menu-delete) (Buffer-menu-delete-backwards, Buffer-menu-save) (Buffer-menu-execute, Buffer-menu-select): * lisp/calendar/todo-mode.el (todo-show) (todo-show-categories-table, todo-top-priorities-overrides): * lisp/desktop.el (desktop-save-mode): * lisp/dired-aux.el (dired-do-kill-lines, dired-do-copy): * lisp/edmacro.el (edit-kbd-macro): * lisp/emulation/viper-cmd.el (viper-ask-level): * lisp/emulation/viper-init.el (viper-expert-level): * lisp/filesets.el (filesets-add-buffer): * lisp/follow.el (follow-mode): * lisp/gnus/gnus-group.el (gnus-group-mode): * lisp/gnus/gnus-sum.el (gnus-summary-mode): * lisp/ibuffer.el (ibuffer-mode): * lisp/international/ogonek.el (ogonek-informacja) (ogonek-information): * lisp/isearch.el (search-default-mode): * lisp/macros.el (apply-macro-to-region-lines): * lisp/mail/supercite.el (sc-mail-field-query) (sc-insert-reference, sc-insert-citation): * lisp/play/decipher.el (decipher-make-checkpoint): (decipher-restore-checkpoint): * lisp/progmodes/idlw-shell.el (idlwave-shell-mode): * lisp/progmodes/idlwave.el (idlwave-store-inquired-class): * lisp/progmodes/prolog.el (prolog-mode, prolog-inferior-mode): * lisp/progmodes/sh-script.el (sh-set-shell): * lisp/progmodes/vhdl-mode.el (vhdl-compiler-alist) (vhdl-modify-date-prefix-string) (vhdl-modify-date-on-saving, vhdl-mode): * lisp/server.el (server-start): * lisp/subr.el (locate-library): * lisp/tempo.el (tempo-marks, tempo-use-tag-list): * lisp/time.el (world-clock): * lisp/vc/vc-hooks.el (vc-mode): * lisp/whitespace.el (whitespace-report-region): * lisp/windmove.el (windmove-delete-in-direction): Doc fix: Delete extraneous quotes around keys. --- lisp/allout.el | 2 +- lisp/auth-source.el | 4 +- lisp/buff-menu.el | 18 ++-- lisp/calendar/todo-mode.el | 26 ++--- lisp/desktop.el | 4 +- lisp/dired-aux.el | 4 +- lisp/edmacro.el | 6 +- lisp/emulation/viper-cmd.el | 2 +- lisp/emulation/viper-init.el | 10 +- lisp/filesets.el | 2 +- lisp/follow.el | 4 +- lisp/gnus/gnus-group.el | 6 +- lisp/gnus/gnus-sum.el | 10 +- lisp/ibuffer.el | 238 +++++++++++++++++++++---------------------- lisp/international/ogonek.el | 4 +- lisp/isearch.el | 6 +- lisp/macros.el | 4 +- lisp/mail/supercite.el | 6 +- lisp/play/decipher.el | 6 +- lisp/progmodes/idlw-shell.el | 2 +- lisp/progmodes/idlwave.el | 2 +- lisp/progmodes/prolog.el | 4 +- lisp/progmodes/sh-script.el | 2 +- lisp/progmodes/vhdl-mode.el | 18 ++-- lisp/server.el | 4 +- lisp/subr.el | 2 +- lisp/tempo.el | 4 +- lisp/time.el | 2 +- lisp/vc/vc-hooks.el | 2 +- lisp/whitespace.el | 4 +- lisp/windmove.el | 2 +- 31 files changed, 206 insertions(+), 204 deletions(-) (limited to 'lisp') diff --git a/lisp/allout.el b/lisp/allout.el index 95b73c54934..a7121efb14a 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -6195,7 +6195,7 @@ for details on preparing Emacs for automatic allout activation." (allout-open-topic 2) (insert (substitute-command-keys (concat "Dummy outline topic header -- see" - " `allout-mode' docstring: `\\[describe-mode]'."))) + " `allout-mode' docstring: \\[describe-mode]"))) (allout-adjust-file-variable "allout-layout" (or allout-layout '(-1 : 0)))))) ;;;_ > allout-file-vars-section-data () diff --git a/lisp/auth-source.el b/lisp/auth-source.el index e62a9eaa7b1..1f233f9f60f 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -233,8 +233,8 @@ EPA/EPG set up, the file will be encrypted and decrypted automatically. See Info node `(epa)Encrypting/decrypting gpg files' for details. -It's best to customize this with `\\[customize-variable]' because the choices -can get pretty complex." +It's best to customize this with \\[customize-variable] because +the choices can get pretty complex." :version "26.1" ; neither new nor changed default :type `(repeat :tag "Authentication Sources" (choice diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 82afea3d053..5796544c534 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -416,7 +416,7 @@ When called interactively prompt for MARK; RET remove all marks." (defun Buffer-menu-delete (&optional arg) "Mark the buffer on this Buffer Menu buffer line for deletion. -A subsequent \\`\\[Buffer-menu-execute]' command +A subsequent \\\\[Buffer-menu-execute] command \ will delete it. If prefix argument ARG is non-nil, it specifies the number of @@ -437,16 +437,16 @@ buffers to delete; a negative ARG means to delete backwards." (defun Buffer-menu-delete-backwards (&optional arg) "Mark the buffer on this Buffer Menu line for deletion, and move up. -A subsequent \\`\\[Buffer-menu-execute]' -command will delete the marked buffer. Prefix ARG means move -that many lines." +A subsequent \\\\[Buffer-menu-execute] command \ +will delete the marked buffer. Prefix ARG + means move that many lines." (interactive "p" Buffer-menu-mode) (Buffer-menu-delete (- (or arg 1)))) (defun Buffer-menu-save () "Mark the buffer on this Buffer Menu line for saving. -A subsequent \\`\\[Buffer-menu-execute]' command -will save it." +A subsequent \\\\[Buffer-menu-execute] \ +command will save it." (interactive nil Buffer-menu-mode) (when (Buffer-menu-buffer) (tabulated-list-set-col 2 "S" t) @@ -463,8 +463,8 @@ it as modified." (defun Buffer-menu-execute () "Save and/or delete marked buffers in the Buffer Menu. -Buffers marked with \\`\\[Buffer-menu-save]' are saved. -Buffers marked with \\`\\[Buffer-menu-delete]' are deleted." +Buffers marked with \\\\[Buffer-menu-save] are saved. +Buffers marked with \\\\[Buffer-menu-delete] are deleted." (interactive nil Buffer-menu-mode) (save-excursion (Buffer-menu-beginning) @@ -492,7 +492,7 @@ Buffers marked with \\`\\[Buffer-menu-delete]' are deleted (defun Buffer-menu-select () "Select this line's buffer; also, display buffers marked with `>'. -You can mark buffers with the \\`\\[Buffer-menu-mark]' command. +You can mark buffers with the \\\\[Buffer-menu-mark] command. This command deletes and replaces all the previously existing windows in the selected frame, and will remove any marks." diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index d0b4c05cd68..f2ee94ec8f7 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -677,7 +677,7 @@ current (i.e., last displayed) category. In Todo mode just the category's unfinished todo items are shown by default. The done items are hidden, but typing -`\\[todo-toggle-view-done-items]' displays them below the todo +\\[todo-toggle-view-done-items] displays them below the todo items. With non-nil user option `todo-show-with-done' both todo and done items are always shown on visiting a category." (interactive "P\np") @@ -3570,12 +3570,12 @@ categories display according to priority." In the initial display the lines of the table are numbered, indicating the current order of the categories when sequentially -navigating through the todo file with `\\[todo-forward-category]' -and `\\[todo-backward-category]'. You can reorder the lines, and -hence the category sequence, by typing `\\[todo-raise-category]' -or `\\[todo-lower-category]' to raise or lower the category at -point, or by typing `\\[todo-set-category-number]' and entering a -number at the prompt or by typing `\\[todo-set-category-number]' +navigating through the todo file with \\[todo-forward-category] +and \\[todo-backward-category]. You can reorder the lines, and +hence the category sequence, by typing \\[todo-raise-category] +or \\[todo-lower-category] to raise or lower the category at +point, or by typing \\[todo-set-category-number] and entering a +number at the prompt or by typing \\[todo-set-category-number] with a numeric prefix. If you save the todo file after reordering the categories, the new order persists in subsequent Emacs sessions. @@ -3584,8 +3584,8 @@ The labels above the category names and item counts are buttons, and clicking these changes the display: sorted by category name or by the respective item counts (alternately descending or ascending). In these displays the categories are not numbered -and `\\[todo-set-category-number]', `\\[todo-raise-category]' and -`\\[todo-lower-category]' are disabled. (Programmatically, the +and \\[todo-set-category-number], \\[todo-raise-category] and +\\[todo-lower-category] are disabled. (Programmatically, the sorting is triggered by passing a non-nil SORTKEY argument.) In addition, the lines with the category names and item counts @@ -4065,8 +4065,8 @@ face." (defcustom todo-top-priorities-overrides nil "List of rules specifying number of top priority items to show. These rules override `todo-top-priorities' on invocations of -`\\[todo-filter-top-priorities]' and -`\\[todo-filter-top-priorities-multifile]'. Each rule is a list +\\[todo-filter-top-priorities] and +\\[todo-filter-top-priorities-multifile]. Each rule is a list of the form (FILE NUM ALIST), where FILE is a member of `todo-files', NUM is a number specifying the default number of top priority items for each category in that file, and ALIST, @@ -4075,8 +4075,8 @@ number specifying the default number of top priority items in that category, which overrides NUM. This variable should be set interactively by -`\\[todo-set-top-priorities-in-file]' or -`\\[todo-set-top-priorities-in-category]'." +\\[todo-set-top-priorities-in-file] or +\\[todo-set-top-priorities-in-category]." :type 'sexp :group 'todo-filtered) diff --git a/lisp/desktop.el b/lisp/desktop.el index ff113c85e12..e3994ceb83c 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -168,8 +168,8 @@ one session to another. In particular, Emacs will save the desktop when it exits (this may prompt you; see the option `desktop-save'). The next time Emacs starts, if this mode is active it will restore the desktop. -To manually save the desktop at any time, use the command `\\[desktop-save]'. -To load it, use `\\[desktop-read]'. +To manually save the desktop at any time, use the command \\[desktop-save]. +To load it, use \\[desktop-read]. Once a desktop file exists, Emacs will auto-save it according to the option `desktop-auto-save-timeout'. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index f091101ea27..a2ce3083cfe 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1467,7 +1467,7 @@ With a prefix argument, kill that many lines starting with the current line. (defun dired-do-kill-lines (&optional arg fmt init-count) "Remove all marked lines, or the next ARG lines. The files or directories on those lines are _not_ deleted. Only the -Dired listing is affected. To restore the removals, use `\\[revert-buffer]'. +Dired listing is affected. To restore the removals, use \\[revert-buffer]. With a numeric prefix arg, remove that many lines going forward, starting with the current line. (A negative prefix arg removes lines @@ -2871,7 +2871,7 @@ similar to the \"-d\" option for the \"cp\" shell command. But if `dired-copy-dereference' is non-nil, the symbolic links are dereferenced and then copied, similar to the \"-L\" option for the \"cp\" shell command. If ARG is a cons with -element 4 (`\\[universal-argument]'), the inverted value of +element 4 (\\[universal-argument]), the inverted value of `dired-copy-dereference' will be used. Also see `dired-do-revert-buffer'." diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 9d185d79142..abfc380d154 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -124,9 +124,9 @@ from `kmacro-edit-lossage'." (defun edit-kbd-macro (keys &optional prefix finish-hook store-hook) "Edit a keyboard macro. At the prompt, type any key sequence which is bound to a keyboard macro. -Or, type `\\[kmacro-end-and-call-macro]' or \\`RET' to edit the last -keyboard macro, `\\[view-lossage]' to edit the last 300 -keystrokes as a keyboard macro, or `\\[execute-extended-command]' +Or, type \\[kmacro-end-and-call-macro] or \\`RET' to edit the last +keyboard macro, \\[view-lossage] to edit the last 300 +keystrokes as a keyboard macro, or \\[execute-extended-command] to edit a macro by its command name. With a prefix argument, format the macro in a more concise way." (interactive diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 9c42f38dc45..192eb99a570 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -4637,7 +4637,7 @@ sensitive for VI-style look-and-feel." (insert (substitute-command-keys " Please specify your level of familiarity with the venomous VI PERil \(and the VI Plan for Emacs Rescue). -You can change it at any time by typing `\\[viper-set-expert-level]' +You can change it at any time by typing \\[viper-set-expert-level] 1 -- BEGINNER: Almost all Emacs features are suppressed. Feels almost like straight Vi. File name completion and diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index 30750951887..9f724551239 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -257,11 +257,11 @@ that deletes a file.") (defvar viper-expert-level (if (boundp 'viper-expert-level) viper-expert-level 0) "User's expert level. -The minor mode viper-vi-diehard-minor-mode is in effect when -viper-expert-level is 1 or 2 or when viper-want-emacs-keys-in-vi is t. -The minor mode viper-insert-diehard-minor-mode is in effect when -viper-expert-level is 1 or 2 or if viper-want-emacs-keys-in-insert is t. -Use `\\[viper-set-expert-level]' to change this.") +The minor mode `viper-vi-diehard-minor-mode' is in effect when +`viper-expert-level' is 1 or 2 or when `viper-want-emacs-keys-in-vi' is t. +The minor mode `viper-insert-diehard-minor-mode' is in effect when +`viper-expert-level' is 1 or 2 or if `viper-want-emacs-keys-in-insert' is t. +Use \\[viper-set-expert-level] to change this.") ;; Max expert level supported by Viper. This is NOT a user option. ;; It is here to make it hard for the user from resetting it. diff --git a/lisp/filesets.el b/lisp/filesets.el index 7332687d46d..11576a46936 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -1767,7 +1767,7 @@ If no fileset name is provided, prompt for NAME." (add-to-list 'filesets-data (list name '(:files))) (message (substitute-command-keys - "Fileset %s created. Call `\\[filesets-save-config]' to save.") + "Fileset %s created. Call \\[filesets-save-config] to save.") name) (car filesets-data)))))) (if entry diff --git a/lisp/follow.el b/lisp/follow.el index 316c85b1629..ce40317ca59 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -413,8 +413,8 @@ being able to use 144 or 216 lines instead of the normal 72... (your mileage may vary). To split one large window into two side-by-side windows, the commands -`\\[split-window-right]' or \ -`\\[follow-delete-other-windows-and-split]' can be used. +\\[split-window-right] or \ +\\[follow-delete-other-windows-and-split] can be used. Only windows displayed in the same frame follow each other. diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 9664d603019..d562d052d82 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -1064,11 +1064,11 @@ When FORCE, rebuild the tool bar." All normal editing commands are switched off. \\ The group buffer lists (some of) the groups available. For instance, -`\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]' +\\[gnus-group-list-groups] will list all subscribed groups with unread articles, while \\[gnus-group-list-zombies] lists all zombie groups. -Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe -to a group not displayed, type `\\[gnus-group-toggle-subscription]'. +Groups that are displayed can be entered with \\[gnus-group-read-group]. To subscribe +to a group not displayed, type \\[gnus-group-toggle-subscription]. For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index fd67e46a401..dc66e1375ab 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -3062,17 +3062,17 @@ the summary mode hooks are run.") "Major mode for reading articles. \\ Each line in this buffer represents one article. To read an -article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards -and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]', +article, you can, for instance, type \\[gnus-summary-next-page]. To move forwards +and backwards while displaying articles, type \\[gnus-summary-next-unread-article] and \\[gnus-summary-prev-unread-article], respectively. You can also post articles and send mail from this buffer. To -follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author -of an article, type `\\[gnus-summary-reply]'. +follow up an article, type \\[gnus-summary-followup]. To mail a reply to the author +of an article, type \\[gnus-summary-reply]. There are approximately one gazillion commands you can execute in this buffer; read the Info manual for more -information (`\\[gnus-info-find-node]'). +information (\\[gnus-info-find-node]). The following commands are available: diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 602f06338e2..c65213f5bde 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -2376,135 +2376,135 @@ particular subset of them, and sorting by various criteria. Operations on marked buffers: \\ - `\\[ibuffer-do-save]' - Save the marked buffers. - `\\[ibuffer-do-view]' - View the marked buffers in the selected frame. - `\\[ibuffer-do-view-other-frame]' - View the marked buffers in another frame. - `\\[ibuffer-do-revert]' - Revert the marked buffers. - `\\[ibuffer-do-toggle-read-only]' - Toggle read-only state of marked buffers. - `\\[ibuffer-do-toggle-lock]' - Toggle lock state of marked buffers. - `\\[ibuffer-do-delete]' - Kill the marked buffers. - `\\[ibuffer-do-isearch]' - Do incremental search in the marked buffers. - `\\[ibuffer-do-isearch-regexp]' - Isearch for regexp in the marked buffers. - `\\[ibuffer-do-replace-regexp]' - Replace by regexp in each of the marked - buffers. - `\\[ibuffer-do-query-replace]' - Query replace in each of the marked buffers. - `\\[ibuffer-do-query-replace-regexp]' - As above, with a regular expression. - `\\[ibuffer-do-print]' - Print the marked buffers. - `\\[ibuffer-do-occur]' - List lines in all marked buffers which match - a given regexp (like the function `occur'). - `\\[ibuffer-do-shell-command-pipe]' - Pipe the contents of the marked - buffers to a shell command. - `\\[ibuffer-do-shell-command-pipe-replace]' - Replace the contents of the marked - buffers with the output of a shell command. - `\\[ibuffer-do-shell-command-file]' - Run a shell command with the - buffer's file as an argument. - `\\[ibuffer-do-eval]' - Evaluate a form in each of the marked buffers. This - is a very flexible command. For example, if you want to make all - of the marked buffers read-only, try using (read-only-mode 1) as - the input form. - `\\[ibuffer-do-view-and-eval]' - As above, but view each buffer while the form - is evaluated. - `\\[ibuffer-do-kill-lines]' - Remove the marked lines from the *Ibuffer* buffer, - but don't kill the associated buffer. - `\\[ibuffer-do-kill-on-deletion-marks]' - Kill all buffers marked for deletion. + \\[ibuffer-do-save] - Save the marked buffers. + \\[ibuffer-do-view] - View the marked buffers in the selected frame. + \\[ibuffer-do-view-other-frame] - View the marked buffers in another frame. + \\[ibuffer-do-revert] - Revert the marked buffers. + \\[ibuffer-do-toggle-read-only] - Toggle read-only state of marked buffers. + \\[ibuffer-do-toggle-lock] - Toggle lock state of marked buffers. + \\[ibuffer-do-delete] - Kill the marked buffers. + \\[ibuffer-do-isearch] - Do incremental search in the marked buffers. + \\[ibuffer-do-isearch-regexp] - Isearch for regexp in the marked buffers. + \\[ibuffer-do-replace-regexp] - Replace by regexp in each of the marked + buffers. + \\[ibuffer-do-query-replace] - Query replace in each of the marked buffers. + \\[ibuffer-do-query-replace-regexp] - As above, with a regular expression. + \\[ibuffer-do-print] - Print the marked buffers. + \\[ibuffer-do-occur] - List lines in all marked buffers which match + a given regexp (like the function `occur'). + \\[ibuffer-do-shell-command-pipe] - Pipe the contents of the marked + buffers to a shell command. + \\[ibuffer-do-shell-command-pipe-replace] - Replace the contents of the marked + buffers with the output of a shell command. + \\[ibuffer-do-shell-command-file] - Run a shell command with the + buffer's file as an argument. + \\[ibuffer-do-eval] - Evaluate a form in each of the marked buffers. This + is a very flexible command. For example, if you want to make all + of the marked buffers read-only, try using (read-only-mode 1) as + the input form. + \\[ibuffer-do-view-and-eval] - As above, but view each buffer while the form + is evaluated. + \\[ibuffer-do-kill-lines] - Remove the marked lines from the *Ibuffer* buffer, + but don't kill the associated buffer. + \\[ibuffer-do-kill-on-deletion-marks] - Kill all buffers marked for deletion. Marking commands: - `\\[ibuffer-mark-forward]' - Mark the buffer at point. - `\\[ibuffer-toggle-marks]' - Unmark all currently marked buffers, and mark - all unmarked buffers. - `\\[ibuffer-change-marks]' - Change the mark used on marked buffers. - `\\[ibuffer-unmark-forward]' - Unmark the buffer at point. - `\\[ibuffer-unmark-backward]' - Unmark the previous buffer. - `\\[ibuffer-unmark-all]' - Unmark buffers marked with MARK. - `\\[ibuffer-unmark-all-marks]' - Unmark all marked buffers. - `\\[ibuffer-mark-by-mode]' - Mark buffers by major mode. - `\\[ibuffer-mark-unsaved-buffers]' - Mark all \"unsaved\" buffers. - This means that the buffer is modified, and has an associated file. - `\\[ibuffer-mark-modified-buffers]' - Mark all modified buffers, - regardless of whether they have an associated file. - `\\[ibuffer-mark-special-buffers]' - Mark all buffers whose name begins and - ends with `*'. - `\\[ibuffer-mark-dissociated-buffers]' - Mark all buffers which have - an associated file, but that file doesn't currently exist. - `\\[ibuffer-mark-read-only-buffers]' - Mark all read-only buffers. - `\\[ibuffer-mark-dired-buffers]' - Mark buffers in `dired-mode'. - `\\[ibuffer-mark-help-buffers]' - Mark buffers in `help-mode', `apropos-mode', etc. - `\\[ibuffer-mark-old-buffers]' - Mark buffers older than `ibuffer-old-time'. - `\\[ibuffer-mark-for-delete]' - Mark the buffer at point for deletion. - `\\[ibuffer-mark-by-name-regexp]' - Mark buffers by their name, using a regexp. - `\\[ibuffer-mark-by-mode-regexp]' - Mark buffers by their major mode, using a regexp. - `\\[ibuffer-mark-by-file-name-regexp]' - Mark buffers by their filename, using a regexp. - `\\[ibuffer-mark-by-content-regexp]' - Mark buffers by their content, using a regexp. - `\\[ibuffer-mark-by-locked]' - Mark all locked buffers. + \\[ibuffer-mark-forward] - Mark the buffer at point. + \\[ibuffer-toggle-marks] - Unmark all currently marked buffers, and mark + all unmarked buffers. + \\[ibuffer-change-marks] - Change the mark used on marked buffers. + \\[ibuffer-unmark-forward] - Unmark the buffer at point. + \\[ibuffer-unmark-backward] - Unmark the previous buffer. + \\[ibuffer-unmark-all] - Unmark buffers marked with MARK. + \\[ibuffer-unmark-all-marks] - Unmark all marked buffers. + \\[ibuffer-mark-by-mode] - Mark buffers by major mode. + \\[ibuffer-mark-unsaved-buffers] - Mark all \"unsaved\" buffers. + This means that the buffer is modified, and has an associated file. + \\[ibuffer-mark-modified-buffers] - Mark all modified buffers, + regardless of whether they have an associated file. + \\[ibuffer-mark-special-buffers] - Mark all buffers whose name begins and + ends with `*'. + \\[ibuffer-mark-dissociated-buffers] - Mark all buffers which have + an associated file, but that file doesn't currently exist. + \\[ibuffer-mark-read-only-buffers] - Mark all read-only buffers. + \\[ibuffer-mark-dired-buffers] - Mark buffers in `dired-mode'. + \\[ibuffer-mark-help-buffers] - Mark buffers in `help-mode', `apropos-mode', etc. + \\[ibuffer-mark-old-buffers] - Mark buffers older than `ibuffer-old-time'. + \\[ibuffer-mark-for-delete] - Mark the buffer at point for deletion. + \\[ibuffer-mark-by-name-regexp] - Mark buffers by their name, using a regexp. + \\[ibuffer-mark-by-mode-regexp] - Mark buffers by their major mode, using a regexp. + \\[ibuffer-mark-by-file-name-regexp] - Mark buffers by their filename, using a regexp. + \\[ibuffer-mark-by-content-regexp] - Mark buffers by their content, using a regexp. + \\[ibuffer-mark-by-locked] - Mark all locked buffers. Filtering commands: - `\\[ibuffer-filter-chosen-by-completion]' - Select and apply filter chosen by completion. - `\\[ibuffer-filter-by-mode]' - Add a filter by any major mode. - `\\[ibuffer-filter-by-used-mode]' - Add a filter by a major mode now in use. - `\\[ibuffer-filter-by-derived-mode]' - Add a filter by derived mode. - `\\[ibuffer-filter-by-name]' - Add a filter by buffer name. - `\\[ibuffer-filter-by-content]' - Add a filter by buffer content. - `\\[ibuffer-filter-by-basename]' - Add a filter by basename. - `\\[ibuffer-filter-by-directory]' - Add a filter by directory name. - `\\[ibuffer-filter-by-filename]' - Add a filter by filename. - `\\[ibuffer-filter-by-file-extension]' - Add a filter by file extension. - `\\[ibuffer-filter-by-modified]' - Add a filter by modified buffers. - `\\[ibuffer-filter-by-predicate]' - Add a filter by an arbitrary Lisp predicate. - `\\[ibuffer-filter-by-size-gt]' - Add a filter by buffer size. - `\\[ibuffer-filter-by-size-lt]' - Add a filter by buffer size. - `\\[ibuffer-filter-by-starred-name]' - Add a filter by special buffers. - `\\[ibuffer-filter-by-visiting-file]' - Add a filter by buffers visiting files. - `\\[ibuffer-save-filters]' - Save the current filters with a name. - `\\[ibuffer-switch-to-saved-filters]' - Switch to previously saved filters. - `\\[ibuffer-add-saved-filters]' - Add saved filters to current filters. - `\\[ibuffer-and-filter]' - Replace the top two filters with their logical AND. - `\\[ibuffer-or-filter]' - Replace the top two filters with their logical OR. - `\\[ibuffer-pop-filter]' - Remove the top filter. - `\\[ibuffer-negate-filter]' - Invert the logical sense of the top filter. - `\\[ibuffer-decompose-filter]' - Break down the topmost filter. - `\\[ibuffer-filter-disable]' - Remove all filtering currently in effect. + \\[ibuffer-filter-chosen-by-completion] - Select and apply filter chosen by completion. + \\[ibuffer-filter-by-mode] - Add a filter by any major mode. + \\[ibuffer-filter-by-used-mode] - Add a filter by a major mode now in use. + \\[ibuffer-filter-by-derived-mode] - Add a filter by derived mode. + \\[ibuffer-filter-by-name] - Add a filter by buffer name. + \\[ibuffer-filter-by-content] - Add a filter by buffer content. + \\[ibuffer-filter-by-basename] - Add a filter by basename. + \\[ibuffer-filter-by-directory] - Add a filter by directory name. + \\[ibuffer-filter-by-filename] - Add a filter by filename. + \\[ibuffer-filter-by-file-extension] - Add a filter by file extension. + \\[ibuffer-filter-by-modified] - Add a filter by modified buffers. + \\[ibuffer-filter-by-predicate] - Add a filter by an arbitrary Lisp predicate. + \\[ibuffer-filter-by-size-gt] - Add a filter by buffer size. + \\[ibuffer-filter-by-size-lt] - Add a filter by buffer size. + \\[ibuffer-filter-by-starred-name] - Add a filter by special buffers. + \\[ibuffer-filter-by-visiting-file] - Add a filter by buffers visiting files. + \\[ibuffer-save-filters] - Save the current filters with a name. + \\[ibuffer-switch-to-saved-filters] - Switch to previously saved filters. + \\[ibuffer-add-saved-filters] - Add saved filters to current filters. + \\[ibuffer-and-filter] - Replace the top two filters with their logical AND. + \\[ibuffer-or-filter] - Replace the top two filters with their logical OR. + \\[ibuffer-pop-filter] - Remove the top filter. + \\[ibuffer-negate-filter] - Invert the logical sense of the top filter. + \\[ibuffer-decompose-filter] - Break down the topmost filter. + \\[ibuffer-filter-disable] - Remove all filtering currently in effect. Filter group commands: - `\\[ibuffer-filters-to-filter-group]' - Create filter group from filters. - `\\[ibuffer-pop-filter-group]' - Remove top filter group. - `\\[ibuffer-forward-filter-group]' - Move to the next filter group. - `\\[ibuffer-backward-filter-group]' - Move to the previous filter group. - `\\[ibuffer-clear-filter-groups]' - Remove all active filter groups. - `\\[ibuffer-save-filter-groups]' - Save the current groups with a name. - `\\[ibuffer-switch-to-saved-filter-groups]' - Restore previously saved groups. - `\\[ibuffer-delete-saved-filter-groups]' - Delete previously saved groups. + \\[ibuffer-filters-to-filter-group] - Create filter group from filters. + \\[ibuffer-pop-filter-group] - Remove top filter group. + \\[ibuffer-forward-filter-group] - Move to the next filter group. + \\[ibuffer-backward-filter-group] - Move to the previous filter group. + \\[ibuffer-clear-filter-groups] - Remove all active filter groups. + \\[ibuffer-save-filter-groups] - Save the current groups with a name. + \\[ibuffer-switch-to-saved-filter-groups] - Restore previously saved groups. + \\[ibuffer-delete-saved-filter-groups] - Delete previously saved groups. Sorting commands: - `\\[ibuffer-toggle-sorting-mode]' - Rotate between the various sorting modes. - `\\[ibuffer-invert-sorting]' - Reverse the current sorting order. - `\\[ibuffer-do-sort-by-alphabetic]' - Sort the buffers lexicographically. - `\\[ibuffer-do-sort-by-filename/process]' - Sort the buffers by the file name. - `\\[ibuffer-do-sort-by-recency]' - Sort the buffers by last viewing time. - `\\[ibuffer-do-sort-by-size]' - Sort the buffers by size. - `\\[ibuffer-do-sort-by-major-mode]' - Sort the buffers by major mode. + \\[ibuffer-toggle-sorting-mode] - Rotate between the various sorting modes. + \\[ibuffer-invert-sorting] - Reverse the current sorting order. + \\[ibuffer-do-sort-by-alphabetic] - Sort the buffers lexicographically. + \\[ibuffer-do-sort-by-filename/process] - Sort the buffers by the file name. + \\[ibuffer-do-sort-by-recency] - Sort the buffers by last viewing time. + \\[ibuffer-do-sort-by-size] - Sort the buffers by size. + \\[ibuffer-do-sort-by-major-mode] - Sort the buffers by major mode. Other commands: - `\\[ibuffer-update]' - Regenerate the list of all buffers. - Prefix arg means to toggle whether buffers that match - `ibuffer-maybe-show-predicates' should be displayed. - `\\[ibuffer-auto-mode]' - Toggle automatic updates. - - `\\[ibuffer-switch-format]' - Change the current display format. - `\\[forward-line]' - Move point to the next line. - `\\[previous-line]' - Move point to the previous line. - `\\[describe-mode]' - This help. - `\\[ibuffer-diff-with-file]' - View the differences between this buffer - and its associated file. - `\\[ibuffer-visit-buffer]' - View the buffer on this line. - `\\[ibuffer-visit-buffer-other-window]' - As above, but in another window. - `\\[ibuffer-visit-buffer-other-window-noselect]' - As both above, but don't select - the new window. - `\\[ibuffer-bury-buffer]' - Bury (not kill!) the buffer on this line. + \\[ibuffer-update] - Regenerate the list of all buffers. + Prefix arg means to toggle whether buffers that match + `ibuffer-maybe-show-predicates' should be displayed. + \\[ibuffer-auto-mode] - Toggle automatic updates. + + \\[ibuffer-switch-format] - Change the current display format. + \\[forward-line] - Move point to the next line. + \\[previous-line] - Move point to the previous line. + \\[describe-mode] - This help. + \\[ibuffer-diff-with-file] - View the differences between this buffer + and its associated file. + \\[ibuffer-visit-buffer] - View the buffer on this line. + \\[ibuffer-visit-buffer-other-window] - As above, but in another window. + \\[ibuffer-visit-buffer-other-window-noselect] - As both above, but don't select + the new window. + \\[ibuffer-bury-buffer] - Bury (not kill!) the buffer on this line. ** Information on Filtering: @@ -2525,7 +2525,7 @@ with \"gnus\". You can accomplish this via: \\[ibuffer-filter-by-name] ^gnus RET Additionally, you can OR the top two filters together with -`\\[ibuffer-or-filters]'. To see all buffers in either +\\[ibuffer-or-filters]. To see all buffers in either `emacs-lisp-mode' or `lisp-interaction-mode', type: \\[ibuffer-filter-by-mode] emacs-lisp-mode RET @@ -2535,9 +2535,9 @@ Additionally, you can OR the top two filters together with Filters can also be saved and restored using mnemonic names: see the functions `ibuffer-save-filters' and `ibuffer-switch-to-saved-filters'. -To remove the top filter on the stack, use `\\[ibuffer-pop-filter]', and +To remove the top filter on the stack, use \\[ibuffer-pop-filter], and to disable all filtering currently in effect, use -`\\[ibuffer-filter-disable]'. +\\[ibuffer-filter-disable]. ** Filter Groups: @@ -2545,7 +2545,7 @@ Once one has mastered filters, the next logical step up is \"filter groups\". A filter group is basically a named group of buffers which match a filter, which are displayed together in an Ibuffer buffer. To create a filter group, simply use the regular functions to create a -filter, and then type `\\[ibuffer-filters-to-filter-group]'. +filter, and then type \\[ibuffer-filters-to-filter-group]. A quick example will make things clearer. Suppose that one wants to group all of one's Emacs Lisp buffers together. To do this, type: @@ -2563,7 +2563,7 @@ multiple filter groups; instead, the first filter group is used. The filter groups are displayed in this order of precedence. You may rearrange filter groups by using the usual pair -`\\[ibuffer-kill-line]' and `\\[ibuffer-yank]'. Yanked groups +\\[ibuffer-kill-line] and \\[ibuffer-yank]. Yanked groups will be inserted before the group at point." ;; Include state info next to the mode name. (setq-local mode-line-process diff --git a/lisp/international/ogonek.el b/lisp/international/ogonek.el index 13feaee405a..4fddd2701d5 100644 --- a/lisp/international/ogonek.el +++ b/lisp/international/ogonek.el @@ -75,7 +75,7 @@ The codes are given in the following order: Je/sli czytasz ten tekst, to albo przegl/adasz plik /xr/od/lowy biblioteki `ogonek.el', albo wywo/la/le/s polecenie `ogonek-jak'. W drugim przypadku mo/zesz usun/a/c tekst z ekranu, stosuj/ac -polecenie `\\[kill-buffer]'. +polecenie \\[kill-buffer]. Niniejsza biblioteka dostarcza funkcji do zmiany kodowania polskich znak/ow diakrytycznych. Funkcje te mo/zna pogrupowa/c nast/epuj/aco. @@ -174,7 +174,7 @@ znak/ow diakrytycznych. Funkcje te mo/zna pogrupowa/c nast/epuj/aco. If you read this text then you are either looking at the library's source text or you have called the `ogonek-how' command. In the -latter case you may remove this text using `\\[kill-buffer]'. +latter case you may remove this text using \\[kill-buffer]. The library provides functions for changing the encoding of Polish diacritic characters, the ones with an `ogonek' below or above them. diff --git a/lisp/isearch.el b/lisp/isearch.el index 4cac79a3f4a..a139a6fb84e 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -282,13 +282,13 @@ Value is nil, t, or a function. If nil, default to literal searches (note that `case-fold-search' and `isearch-lax-whitespace' may still be applied).\\ -If t, default to regexp searches (as if typing `\\[isearch-toggle-regexp]' during +If t, default to regexp searches (as if typing \\[isearch-toggle-regexp] during isearch). If a function, use that function as an `isearch-regexp-function'. Example functions (and the keys to toggle them during isearch) -are `word-search-regexp' \(`\\[isearch-toggle-word]'), `isearch-symbol-regexp' -\(`\\[isearch-toggle-symbol]'), and `char-fold-to-regexp' \(`\\[isearch-toggle-char-fold]')." +are `word-search-regexp' \(\\[isearch-toggle-word]), `isearch-symbol-regexp' +\(\\[isearch-toggle-symbol]), and `char-fold-to-regexp' \(\\[isearch-toggle-char-fold])." ;; :type is set below by `isearch-define-mode-toggle'. :type '(choice (const :tag "Literal search" nil) (const :tag "Regexp search" t) diff --git a/lisp/macros.el b/lisp/macros.el index 0a04bad762a..7108a027ca6 100644 --- a/lisp/macros.el +++ b/lisp/macros.el @@ -197,7 +197,7 @@ For example, in Usenet articles, sections of text quoted from another author are indented, or have each line start with `>'. To quote a section of text, define a keyboard macro which inserts `>', put point and mark at opposite ends of the quoted section, and use -`\\[apply-macro-to-region-lines]' to mark the entire section. +\\[apply-macro-to-region-lines] to mark the entire section. Suppose you wanted to build a keyword table in C where each entry looked like this: @@ -219,7 +219,7 @@ and write a macro to massage a word into a table entry: \\C-x ) and then select the region of un-tablified names and use -`\\[apply-macro-to-region-lines]' to build the table from the names." +\\[apply-macro-to-region-lines] to build the table from the names." (interactive "r") (or macro (progn diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el index c3fa738150e..9104feb6219 100644 --- a/lisp/mail/supercite.el +++ b/lisp/mail/supercite.el @@ -817,7 +817,7 @@ If there was no mail header with FIELD as its key, return the value of (defun sc-mail-field-query (arg) "View the value of a mail field. -With `\\[universal-argument]', prompts for action on mail field. +With \\[universal-argument], prompts for action on mail field. Action can be one of: View, Modify, Add, or Delete." (interactive "P") (let* ((alist '(("view" . ?v) ("modify" . ?m) ("add" . ?a) ("delete" . ?d))) @@ -1710,7 +1710,7 @@ Numeric ARG indicates which header style from `sc-rewrite-header-list' to use when rewriting the header. No supplied ARG indicates use of `sc-preferred-header-style'. -With just `\\[universal-argument]', electric reference insert mode is +With just \\[universal-argument], electric reference insert mode is entered, regardless of the value of `sc-electric-references-p'. See `sc-electric-mode' for more information." (interactive "P") @@ -1930,7 +1930,7 @@ With numeric ARG, inserts that many new lines." (defun sc-insert-citation (arg) "Insert citation string at beginning of current line if not already cited. -With `\\[universal-argument]' insert citation even if line is already +With \\[universal-argument] insert citation even if line is already cited." (interactive "P") (save-excursion diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el index bfc28ec9f89..56f166c10f1 100644 --- a/lisp/play/decipher.el +++ b/lisp/play/decipher.el @@ -481,7 +481,7 @@ The most useful commands are: "Checkpoint the current cipher alphabet. This records the current alphabet so you can return to it later. You may have any number of checkpoints. -Type `\\[decipher-restore-checkpoint]' to restore a checkpoint." +Type \\[decipher-restore-checkpoint] to restore a checkpoint." (interactive "sCheckpoint description: " decipher-mode) (or (stringp desc) (setq desc "")) @@ -508,7 +508,7 @@ Type `\\[decipher-restore-checkpoint]' to restore a checkpoint." If point is not on a checkpoint line, moves to the first checkpoint line. If point is on a checkpoint, restores that checkpoint. -Type `\\[decipher-make-checkpoint]' to make a checkpoint." +Type \\[decipher-make-checkpoint] to make a checkpoint." (interactive nil decipher-mode) (beginning-of-line) (if (looking-at "%!\\([A-Z ]+\\)!") @@ -524,7 +524,7 @@ Type `\\[decipher-make-checkpoint]' to make a checkpoint." ;; Move to the first checkpoint: (goto-char (point-min)) (if (re-search-forward "^%![A-Z ]+!" nil t) - (message "Select the checkpoint to restore and type `%s'" + (message "Select the checkpoint to restore and type %s" (substitute-command-keys "\\[decipher-restore-checkpoint]")) (error "No checkpoints in this buffer")))) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index b5470b5490d..0f11103cf02 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -829,7 +829,7 @@ IDL has currently stepped.") 3. Routine Info ------------ - `\\[idlwave-routine-info]' displays information about an IDL routine near point, + \\[idlwave-routine-info] displays information about an IDL routine near point, just like in `idlwave-mode'. The module used is the one at point or the one whose argument list is being edited. To update IDLWAVE's knowledge about compiled or edited modules, use diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 4b96461d773..30442fa0d34 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -657,7 +657,7 @@ When you specify a class, this information can be stored as a text property on the `->' arrow in the source code, so that during the same editing session, IDLWAVE will not have to ask again. When this variable is non-nil, IDLWAVE will store and reuse the class information. -The class stored can be checked and removed with `\\[idlwave-routine-info]' +The class stored can be checked and removed with \\[idlwave-routine-info] on the arrow. The default of this variable is nil, since the result of commands then diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index a65943a48eb..97f08a79ccd 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -1148,7 +1148,7 @@ line and comments can also be enclosed in /* ... */. If an optional argument SYSTEM is non-nil, set up mode for the given system. To find out what version of Prolog mode you are running, enter -`\\[prolog-mode-version]'. +\\[prolog-mode-version]. Commands: \\{prolog-mode-map}" @@ -1268,7 +1268,7 @@ imitating normal Unix input editing. \\[comint-quit-subjob] sends quit signal, likewise. To find out what version of Prolog mode you are running, enter -`\\[prolog-mode-version]'." +\\[prolog-mode-version]." (require 'compile) (setq comint-input-filter 'prolog-input-filter) (setq mode-line-process '(": %s")) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 2a650fe0ea6..43fb8a723bd 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -2304,7 +2304,7 @@ Point should be before the newline." When used interactively, insert the proper starting #!-line, and make the visited file executable via `executable-set-magic', perhaps querying depending on the value of `executable-query'. -(If given a prefix (i.e., `\\[universal-argument]') don't insert any starting #! +(If given a prefix (i.e., \\[universal-argument]) don't insert any starting #! line.) When this function is called noninteractively, INSERT-FLAG (the third diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 060880d7cf2..afdf52629c4 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -457,7 +457,7 @@ If no file name at all is printed out, set both \"File Message\" entries to 0 \(a default file name message will be printed out instead, does not work in XEmacs). -A compiler is selected for syntax analysis (`\\[vhdl-compile]') by +A compiler is selected for syntax analysis (\\[vhdl-compile]) by assigning its name to option `vhdl-compiler'. Please send any missing or erroneous compiler properties to the maintainer for @@ -1106,14 +1106,14 @@ For more information on format strings, see the documentation for the (defcustom vhdl-modify-date-prefix-string "-- Last update: " "Prefix string of modification date in VHDL file header. If actualization of the modification date is called (menu, -`\\[vhdl-template-modify]'), this string is searched and the rest +\\[vhdl-template-modify]), this string is searched and the rest of the line replaced by the current date." :type 'string :group 'vhdl-header) (defcustom vhdl-modify-date-on-saving t "Non-nil means update the modification date when the buffer is saved. -Calls function `\\[vhdl-template-modify]'). +Calls function \\[vhdl-template-modify]). NOTE: Activate the new setting in a VHDL buffer by using the menu entry \"Activate Options\"." @@ -4469,7 +4469,7 @@ Usage: according to option `vhdl-argument-list-indent'. If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of - tabs. `\\[tabify]' and `\\[untabify]' allow the conversion of spaces to + tabs. \\[tabify] and \\[untabify] allow the conversion of spaces to tabs and vice versa. Syntax-based indentation can be very slow in large files. Option @@ -4780,7 +4780,7 @@ Usage: `vhdl-highlight-translate-off' is non-nil. For documentation and customization of the used colors see - customization group `vhdl-highlight-faces' (`\\[customize-group]'). For + customization group `vhdl-highlight-faces' (\\[customize-group]). For highlighting of matching parenthesis, see customization group `paren-showing'. Automatic buffer highlighting is turned on/off by option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs). @@ -4840,14 +4840,14 @@ Usage: sessions using the \"Save Options\" menu entry. Options and their detailed descriptions can also be accessed by using - the \"Customize\" menu entry or the command `\\[customize-option]' - (`\\[customize-group]' for groups). Some customizations only take effect + the \"Customize\" menu entry or the command \\[customize-option] + (\\[customize-group] for groups). Some customizations only take effect after some action (read the NOTE in the option documentation). Customization can also be done globally (i.e. site-wide, read the INSTALL file). Not all options are described in this documentation, so go and see - what other useful user options there are (`\\[vhdl-customize]' or menu)! + what other useful user options there are (\\[vhdl-customize] or menu)! FILE EXTENSIONS: @@ -4876,7 +4876,7 @@ Usage: Maintenance: ------------ -To submit a bug report, enter `\\[vhdl-submit-bug-report]' within VHDL Mode. +To submit a bug report, enter \\[vhdl-submit-bug-report] within VHDL Mode. Add a description of the problem and include a reproducible test case. Questions and enhancement requests can be sent to . diff --git a/lisp/server.el b/lisp/server.el index f75e9cb4fe5..66e6d729f8a 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -729,7 +729,9 @@ the `server-process' variable." (concat "Unable to start the Emacs server.\n" (cadr err) (substitute-command-keys - "\nTo start the server in this Emacs process, stop the existing server or call `\\[server-force-delete]' to forcibly disconnect it.")) + (concat "\nTo start the server in this Emacs process, stop " + "the existing server or call \\[server-force-delete] " + "to forcibly disconnect it."))) :warning) (setq leave-dead t))) ;; Now any previous server is properly stopped. diff --git a/lisp/subr.el b/lisp/subr.el index df28989b399..33de100870e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3102,7 +3102,7 @@ instead." LIBRARY should be a relative file name of the library, a string. It can omit the suffix (a.k.a. file-name extension) if NOSUFFIX is nil (which is the default, see below). -This command searches the directories in `load-path' like `\\[load-library]' +This command searches the directories in `load-path' like \\[load-library] to find the file that `\\[load-library] RET LIBRARY RET' would load. Optional second arg NOSUFFIX non-nil means don't add suffixes `load-suffixes' to the specified name LIBRARY. diff --git a/lisp/tempo.el b/lisp/tempo.el index 513e778e4ef..b7ad680c2a9 100644 --- a/lisp/tempo.el +++ b/lisp/tempo.el @@ -164,7 +164,7 @@ documentation for the function `tempo-complete-tag' for more info. "Indicates if the tag collection needs to be rebuilt.") (defvar-local tempo-marks nil - "A list of marks to jump to with `\\[tempo-forward-mark]' and `\\[tempo-backward-mark]'.") + "A list of marks to jump to with \\[tempo-forward-mark] and \\[tempo-backward-mark].") (defvar-local tempo-match-finder "\\b\\([[:word:]]+\\)\\=" "The regexp or function used to find the string to match against tags. @@ -582,7 +582,7 @@ TAG-LIST is a symbol whose variable value is a tag list created with `tempo-add-tag'. COMPLETION-FUNCTION is an obsolete option for specifying an optional -function or string that is used by `\\[tempo-complete-tag]' to find a +function or string that is used by \\[tempo-complete-tag] to find a string to match the tag against. It has the same definition as the variable `tempo-match-finder'. In this version, supplying a COMPLETION-FUNCTION just sets `tempo-match-finder' locally." diff --git a/lisp/time.el b/lisp/time.el index e561f36398c..9b932e945ba 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -589,7 +589,7 @@ See `world-clock'." (defun world-clock () "Display a world clock buffer with times in various time zones. The variable `world-clock-list' specifies which time zones to use. -To turn off the world time display, go to the window and type `\\[quit-window]'." +To turn off the world time display, go to the window and type \\[quit-window]." (interactive) (if-let ((buffer (get-buffer world-clock-buffer-name))) (pop-to-buffer buffer) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 1ef1388e21f..1493845e2d9 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -185,7 +185,7 @@ revision number and lock status." "Version Control minor mode. This minor mode is automatically activated whenever you visit a file under control of one of the revision control systems in `vc-handled-backends'. -VC commands are globally reachable under the prefix `\\[vc-prefix-map]': +VC commands are globally reachable under the prefix \\[vc-prefix-map]: \\{vc-prefix-map}") (defmacro vc-error-occurred (&rest body) diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 6f47e32beb5..15c1b83fcc1 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1774,10 +1774,10 @@ cleaning up these problems." (when has-bogus (goto-char (point-max)) (insert (substitute-command-keys - " Type `\\[whitespace-cleanup]'") + " Type \\[whitespace-cleanup]") " to cleanup the buffer.\n\n" (substitute-command-keys - " Type `\\[whitespace-cleanup-region]'") + " Type \\[whitespace-cleanup-region]") " to cleanup a region.\n\n")) (whitespace-display-window (current-buffer)))))) has-bogus))) diff --git a/lisp/windmove.el b/lisp/windmove.el index bc2beed5055..b4e77102abd 100644 --- a/lisp/windmove.el +++ b/lisp/windmove.el @@ -641,7 +641,7 @@ Default value of MODIFIERS is `shift-meta'." (defun windmove-delete-in-direction (dir &optional arg) "Delete the window at direction DIR. -If prefix ARG is `\\[universal-argument]', also kill the buffer in that window. +If prefix ARG is \\[universal-argument], also kill the buffer in that window. With \\`M-0' prefix, delete the selected window and select the window at direction DIR. When `windmove-wrap-around' is non-nil, takes the window -- cgit v1.2.3 From 51ca049608cd116e5ec5b8bb4fd815bed1cbf4ca Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 21 Jan 2024 14:41:27 +0100 Subject: Fix image-dired-tags-db-file void variable error * lisp/image/image-dired-tags.el (image-dired-sane-db-file): Require 'image-dired'. (Bug#68636) --- lisp/image/image-dired-tags.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/image/image-dired-tags.el b/lisp/image/image-dired-tags.el index 7b4ca35a15e..2b5248cb14b 100644 --- a/lisp/image/image-dired-tags.el +++ b/lisp/image/image-dired-tags.el @@ -51,6 +51,7 @@ Return the value of last form in BODY." "Check if `image-dired-tags-db-file' exists. If not, try to create it (including any parent directories). Signal error if there are problems creating it." + (require 'image-dired) ; for `image-dired-dir' (or (file-exists-p image-dired-tags-db-file) (let (dir buf) (unless (file-directory-p (setq dir (file-name-directory -- cgit v1.2.3 From 9364c28959a5b00e8ffd5d0d283ff0c0042f1bb0 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 21 Jan 2024 15:28:06 +0100 Subject: ; Fix typos in symbol names --- admin/cus-test.el | 2 +- lisp/emacs-lisp/comp-cstr.el | 2 +- lisp/erc/erc-button.el | 2 +- lisp/erc/erc-track.el | 2 +- lisp/filesets.el | 2 +- lisp/forms.el | 2 +- lisp/jsonrpc.el | 2 +- lisp/net/tramp-sh.el | 2 +- lisp/org/ox-latex.el | 2 +- lisp/progmodes/c-ts-common.el | 7 +++---- lisp/progmodes/cc-engine.el | 2 +- lisp/progmodes/cc-fonts.el | 2 +- lisp/progmodes/cc-langs.el | 2 +- lisp/progmodes/flymake.el | 2 +- lisp/term/android-win.el | 2 +- lisp/touch-screen.el | 2 +- 16 files changed, 18 insertions(+), 19 deletions(-) (limited to 'lisp') diff --git a/admin/cus-test.el b/admin/cus-test.el index b86643a769a..68907f4f5e5 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -146,7 +146,7 @@ Names should be as they appear in loaddefs.el.") (defvar cus-test-errors nil "List of problematic variables found by `cus-test-apropos'. -Each element is (VARIABLE . PROBLEM); see `cus-test--format-errors'.") +Each element is (VARIABLE . PROBLEM); see `cus-test--format-error'.") (defvar cus-test-tested-variables nil "List of options tested by last call of `cus-test-apropos'.") diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index c65af16b725..2984bedb1dd 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -130,7 +130,7 @@ Integer values are handled in the `range' slot.") ;; TODO we should be able to just cons hash this. (common-supertype-mem (make-hash-table :test #'equal) :type hash-table :documentation "Serve memoization for -`comp-common-supertype'.") +`comp-ctxt-common-supertype-mem'.") (subtype-p-mem (make-hash-table :test #'equal) :type hash-table :documentation "Serve memoization for `comp-cstr-ctxt-subtype-p-mem'.") diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 27406a76f59..6b78e451b54 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -443,7 +443,7 @@ of the channel. However, don't bother creating an actual Instead, just spoof an `erc-server-user' and stash it during \"PRIVMSG\" handling via `erc--cmem-from-nick-function' and retrieve it during buttonizing via -`erc-button--fallback-user-function'." +`erc-button--fallback-cmem-function'." :interactive nil (if erc-button--phantom-users-mode (progn diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 7e5ed165fb9..04ee76a9349 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -924,7 +924,7 @@ and expected types. This function should return a face or nil.") Expect RANKS to be a list of faces and both NORMALS and the car of NEW-FACES to be hash tables mapping faces to non-nil values. Assume the latter's makeup and that of RANKS to resemble -`erc-track-face-normal-list' and `erc-track-faces-priority-list'. +`erc-track-faces-normal-list' and `erc-track-faces-priority-list'. If NEW-FACES has a cdr, expect it to be its car's contents ordered from most recently seen (later in the buffer) to earliest. In general, act like `erc-track-select-mode-line-face' diff --git a/lisp/filesets.el b/lisp/filesets.el index 11576a46936..4e2de8fed1b 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -286,7 +286,7 @@ See `easy-menu-add-item' for documentation." ) (defcustom filesets-menu-in-menu nil - "Use that instead of `current-menubar' as the menu to change. + "Use that instead of `current-global-map' as the menu to change. See `easy-menu-add-item' for documentation." :set #'filesets-set-default :type 'sexp) diff --git a/lisp/forms.el b/lisp/forms.el index e38fa7ae873..009667af273 100644 --- a/lisp/forms.el +++ b/lisp/forms.el @@ -343,7 +343,7 @@ suitable for forms processing.") (defvar forms-write-file-filter nil "The name of a function that is called before writing the data file. -This can be used to undo the effects of `form-read-file-hook'.") +This can be used to undo the effects of `form-read-file-filter'.") (defvar forms-new-record-filter nil "The name of a function that is called when a new record is created.") diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 1f8e1b1a876..14fe0447008 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -438,7 +438,7 @@ ignored." `(canceled ,cancel-on-input-retval)) (t (while t (accept-process-output nil 30))))) ;; In normal operation, continuations for error/success is - ;; handled by `jsonrpc-continue'. Timeouts also remove + ;; handled by `jsonrpc--continue'. Timeouts also remove ;; the continuation... (pcase-let* ((`(,id ,_) id-and-timer)) ;; ...but we still have to guard against exist explicit diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 8ec9467ab45..de515e40345 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4112,7 +4112,7 @@ Only send the definition if it has not already been done." (unless (member name scripts) (with-tramp-progress-reporter vec 5 (format-message "Sending script `%s'" name) - ;; In bash, leading TABs like in `tramp-vc-registered-read-file-names' + ;; In bash, leading TABs like in `tramp-bundle-read-file-names' ;; could result in unwanted command expansion. Avoid this. (setq script (tramp-compat-string-replace (make-string 1 ?\t) (make-string 8 ? ) script)) diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index 834fb957329..b409f552a2b 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -3667,7 +3667,7 @@ CONTENTS is the contents of the object." ;; takes care of tables with a "verbatim" mode. Otherwise, it ;; delegates the job to either `org-latex--table.el-table', ;; `org-latex--org-table', `org-latex--math-table' or -;; `org-latex--org-align-string-tabbing' functions, +;; `org-table--org-tabbing' functions, ;; depending of the type of the table and the mode requested. ;; ;; `org-latex--align-string' is a subroutine used to build alignment diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index 07161025d5d..0095d83e302 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -37,9 +37,8 @@ ;; ;; For indenting statements: ;; -;; - Set `c-ts-common-indent-offset', -;; `c-ts-common-indent-block-type-regexp', and -;; `c-ts-common-indent-bracketless-type-regexp', then use simple-indent +;; - Set `c-ts-common-indent-offset', and +;; `c-ts-common-indent-type-regexp-alist', then use simple-indent ;; offset `c-ts-common-statement-offset' in ;; `treesit-simple-indent-rules'. @@ -331,7 +330,7 @@ If NODE is nil, return nil." Assumes the anchor is (point-min), i.e., the 0th column. This function basically counts the number of block nodes (i.e., -brackets) (defined by `c-ts-common-indent-block-type-regexp') +brackets) (see `c-ts-common-indent-type-regexp-alist') between NODE and the root node (not counting NODE itself), and multiply that by `c-ts-common-indent-offset'. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 4c591fbba36..ea4ee3d7b7c 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -11476,7 +11476,7 @@ This function might do hidden buffer changes." ;; an arglist it would be a meaningless expression because ;; the result isn't used. We therefore choose to recognize ;; it as a declaration when there's "symmetrical WS" around - ;; the "*" or the flag `c-assymetry-fontification-flag' is + ;; the "*" or the flag `c-asymmetry-fontification-flag' is ;; not set. We only allow a suffix (which makes the ;; construct look like a function call) when `at-decl-start' ;; provides additional evidence that we do have a diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 89f197b98e6..6419d6cf05a 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1112,7 +1112,7 @@ casts and declarations are fontified. Used on level 2 and higher." ;; 'c-decl-type-start (according to TYPES). Stop at LIMIT. ;; ;; If TYPES is t, fontify all identifiers as types; if it is a number, a - ;; buffer position, additionally set the `c-deftype' text property on the + ;; buffer position, additionally set the `c-typedef' text property on the ;; keyword at that position; if it is nil fontify as either variables or ;; functions, otherwise TYPES is a face to use. If NOT-TOP is non-nil, we ;; are not at the top-level ("top-level" includes being directly inside a diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index ad21bd1d5ef..ba0d1d0fc49 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -817,7 +817,7 @@ there be copies of the opener contained in the multi-line string." (c-lang-defconst c-cpp-or-ml-match-offset ;; The offset to be added onto match numbers for a multi-line string in - ;; matches for `c-cpp-or-ml-string-opener-re'. + ;; matches for `c-ml-string-cpp-or-opener-re'. t (if (c-lang-const c-anchored-cpp-prefix) (+ 2 (regexp-opt-depth (c-lang-const c-anchored-cpp-prefix))) 2)) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 3f8aec27833..225f8ecf874 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -715,7 +715,7 @@ associated `flymake-category' return DEFAULT." (delete-overlay ov))) (defun flymake--eol-overlay-summary (src-ovs) - "Helper function for `flymake--eol-overlay-update'." + "Helper function for `flymake--update-eol-overlays'." (cl-flet ((summarize (d) (propertize (flymake-diagnostic-oneliner d t) 'face (flymake--lookup-type-property (flymake--diag-type d) diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index 876b24683bc..e0d252f17e0 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -406,7 +406,7 @@ to grant such permissions. FANCY-P non-nil means the notice will be displayed with faces, in the style appropriate for its incorporation within the fancy splash -screen display; see `francy-splash-insert'." +screen display; see `fancy-splash-insert'." (unless (android-external-storage-available-p) (if fancy-p (fancy-splash-insert diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index c2f8f8068d7..a1ec4bca89f 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -1027,7 +1027,7 @@ POINT was initially placed upon, and pixel deltas describing how much point has moved relative to its previous position in the X and Y axes. -If the fourth element of `touchscreen-current-tool' is `scroll', +If the fourth element of `touch-screen-current-tool' is `scroll', then generate a `touchscreen-scroll' event with the window that POINT was initially placed upon, and pixel deltas describing how much point has moved relative to its previous position in the X -- cgit v1.2.3 From e780f98944fbb14a22a2b1e15d0e7cb435f55550 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 22 Jan 2024 09:20:46 +0100 Subject: * lisp/leim/quail/indian.el (tamil-input): Use `quail' as parent group. --- lisp/leim/quail/indian.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el index c1348081d58..9ea23ec087c 100644 --- a/lisp/leim/quail/indian.el +++ b/lisp/leim/quail/indian.el @@ -476,7 +476,7 @@ Full key sequences are listed below:" (defgroup tamil-input nil "Translation rules for the Tamil input method." :prefix "tamil-" - :group 'leim) + :group 'quail) (defcustom tamil-translation-rules ;; Vowels. -- cgit v1.2.3 From 14d68221d26af5c3e99ae0fbc7ade44494aaf4f3 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 22 Jan 2024 10:08:45 +0100 Subject: Fix nasty cut'n'waste error in Tramp * lisp/net/tramp.el (tramp-parse-passwd): Use `tramp-parse-passwd-group'. Reported by Tim Landscheidt . --- lisp/net/tramp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 56b00bdeb42..bd556753261 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3518,7 +3518,7 @@ Host is always \"localhost\"." (when (zerop (tramp-call-process nil "getent" nil t nil "passwd")) (goto-char (point-min)) (cl-loop while (not (eobp)) collect - (tramp-parse-etc-group-group)))) + (tramp-parse-passwd-group)))) (tramp-parse-file filename #'tramp-parse-passwd-group)))) (defun tramp-parse-passwd-group () -- cgit v1.2.3 From 87cf30fba37346a179c6307a29d5d39b39311cef Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Fri, 19 Jan 2024 13:50:29 +0100 Subject: Further shrink eglot--{} Up to and including Emacs 29, :size 0 was an alias for :size 1. Emacs 30 gained support for :size 0 hash tables (bug#68244). * lisp/progmodes/eglot.el (eglot--{}): Define as truly zero-sized. --- lisp/progmodes/eglot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index c5cfdd3cedd..511000927cf 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -575,7 +575,7 @@ It is nil if Eglot is not byte-complied.") (defvaralias 'eglot-{} 'eglot--{}) -(defconst eglot--{} (make-hash-table :size 1) "The empty JSON object.") +(defconst eglot--{} (make-hash-table :size 0) "The empty JSON object.") (defun eglot--executable-find (command &optional remote) "Like Emacs 27's `executable-find', ignore REMOTE on Emacs 26." -- cgit v1.2.3 From aa6c24da61fd1419ac0a7c491c5aec20e52cc964 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 20 Dec 2023 13:40:47 +0100 Subject: Fix broken links to Freedesktop notifications spec * doc/lispref/os.texi (Desktop Notifications): * lisp/notifications.el: Replace broken developer.gnome.org links with specifications.freedesktop.org (bug#67939). --- doc/lispref/os.texi | 2 +- lisp/notifications.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index e9d81038d4b..c8c64ddde89 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -2913,7 +2913,7 @@ interpreted as icon name. @item :category @var{category} The type of notification this is, a string. See the -@uref{https://developer.gnome.org/notification-spec/#categories, +@url{https://specifications.freedesktop.org/notification-spec/notification-spec-latest.html#categories, Desktop Notifications Specification} for a list of standard categories. diff --git a/lisp/notifications.el b/lisp/notifications.el index f284fb46b20..3509968a6cd 100644 --- a/lisp/notifications.el +++ b/lisp/notifications.el @@ -23,7 +23,7 @@ ;;; Commentary: ;; This package provides an implementation of the Desktop Notifications -;; . +;; . ;; In order to activate this package, you must add the following code ;; into your .emacs: -- cgit v1.2.3 From a043cccb62bfd1812cedf107db327039dfdfe89b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 24 Jan 2024 08:21:26 -0500 Subject: * lisp/emacs-lisp/pcase.el (Commentary:): Add paper reference --- lisp/emacs-lisp/pcase.el | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 5ac4b289a80..4754d4e720d 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -42,6 +42,14 @@ ;; - ideally we'd want (pcase s ((re RE1) E1) ((re RE2) E2)) to be able to ;; generate a lex-style DFA to decide whether to run E1 or E2. +;; While the first version was written before I knew about Racket's `match' +;; construct, the second version was significantly influenced by it, +;; so a good presentation of the underlying ideas can be found at: +;; +;; Extensible Pattern Matching in an Extensible Language +;; Sam Tobin-Hochstadt, 2010 +;; https://arxiv.org/abs/1106.2578 + ;;; Code: (require 'macroexp) -- cgit v1.2.3 From 1f3371b46e8a6a51f88c56785175b48af2a0bed7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 24 Jan 2024 12:57:33 -0500 Subject: Take stock of the wheel-up/down confusion While we're hopefully all aware of the usual confusion between the scroll operation moving the document or moving the viewport, Emacs has its very own instance of that confusion where the `mouse-wheel-down-event` variable is the one that (used to) hold the value `wheel-up` and vice versa. Thanks for Po Lu's commit 957b4f826a4 which not only fixed my change but brought that confusion to my attention. This patch doesn't fix the problem, but tries to fix the other places in the code where we did not take it into account. * doc/lispref/commands.texi (Misc Events): Mention the wheel-up/down confusion. * lisp/progmodes/flymake.el (flymake--mode-line-counter-map): * lisp/completion-preview.el (completion-preview--mouse-map): Fix wheel-up/down confusion. * lisp/mwheel.el (mouse-wheel-down-event, mouse-wheel-up-event): Fix docstrings. --- doc/lispref/commands.texi | 3 +++ lisp/completion-preview.el | 6 ++++-- lisp/mwheel.el | 8 ++++---- lisp/progmodes/flymake.el | 6 ++++-- 4 files changed, 15 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 5f840ac21ec..6c8d42337d0 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2567,6 +2567,9 @@ some kinds of systems. On other systems, other events like @code{mouse-4} and @code{wheel-up} and @code{wheel-down} events as well as the events specified in the variables @code{mouse-wheel-up-event} and @code{mouse-wheel-down-event}, defined in @file{mwheel.el}. +Beware that for historical reasons the @code{mouse-wheel-@emph{up}-event} +is the variable that holds an event that should be handled similarly to +@code{wheel-@emph{down}} and vice versa. @vindex mouse-wheel-left-event @vindex mouse-wheel-right-event diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index f552db7aa8e..6fd60f3c416 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -135,12 +135,14 @@ If this option is nil, these commands do not display any message." "" #'completion-preview-insert "C-" #'completion-at-point "" #'completion-at-point + ;; BEWARE: `mouse-wheel-UP-event' corresponds to `wheel-DOWN' events + ;; and vice versa!! "" #'completion-preview-prev-candidate "" #'completion-preview-next-candidate (key-description (vector mouse-wheel-up-event)) - #'completion-preview-prev-candidate + #'completion-preview-next-candidate (key-description (vector mouse-wheel-down-event)) - #'completion-preview-next-candidate) + #'completion-preview-prev-candidate) (defvar-local completion-preview--overlay nil) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 1e08328c875..53042085bf6 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -34,8 +34,8 @@ ;; Implementation note: ;; ;; I for one would prefer some way of converting the mouse-4/mouse-5 -;; events into different event types, like 'mwheel-up' or -;; 'mwheel-down', but I cannot find a way to do this very easily (or +;; events into different event types, like 'wheel-up' or +;; 'wheel-down', but I cannot find a way to do this very easily (or ;; portably), so for now I just live with it. (require 'timer) @@ -63,14 +63,14 @@ They are sometimes generated by things like `xterm-mouse-mode' as well.") (defcustom mouse-wheel-down-event (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-4) - "Event used for scrolling down, beside `wheel-down', if any." + "Event used for scrolling down, beside `wheel-up', if any." :group 'mouse :type 'symbol :set #'mouse-wheel-change-button) (defcustom mouse-wheel-up-event (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-5) - "Event used for scrolling up, beside `wheel-up', if any." + "Event used for scrolling up, beside `wheel-down', if any." :group 'mouse :type 'symbol :set #'mouse-wheel-change-button) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 225f8ecf874..5974f076556 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1637,14 +1637,16 @@ correctly.") (defvar flymake--mode-line-counter-map (let ((map (make-sparse-keymap))) + ;; BEWARE: `mouse-wheel-UP-event' corresponds to `wheel-DOWN' events + ;; and vice versa!! (define-key map (vector 'mode-line mouse-wheel-down-event) #'flymake--mode-line-counter-scroll-prev) (define-key map [mode-line wheel-down] - #'flymake--mode-line-counter-scroll-prev) + #'flymake--mode-line-counter-scroll-next) (define-key map (vector 'mode-line mouse-wheel-up-event) #'flymake--mode-line-counter-scroll-next) (define-key map [mode-line wheel-up] - #'flymake--mode-line-counter-scroll-next) + #'flymake--mode-line-counter-scroll-prev) map)) (defun flymake--mode-line-counter-1 (type) -- cgit v1.2.3 From 65ea742ed5ec505837706d64690e3cc2073825c7 Mon Sep 17 00:00:00 2001 From: João Távora Date: Thu, 25 Jan 2024 01:37:57 +0000 Subject: Eglot: try even harder to avoid other completion styles (bug#68699) Any completion style except for eglot--dumb-flex spells trouble for Eglot, for the well known reason that LSP is geared towards completion tooltips and none of Emacs' partial-completion shenanigans. This commit puts a "try-completion" function that doesn't return nil in the eglot--dumb-flex completion style so that other styles aren't tried (partial-completion, in particular, errors out). The function often doesn't do anything very useful, but at least it doesn't stop the more usual *Completions* buffer from appearing. * lisp/progmodes/eglot.el (eglot--dumb-tryc): New helper. (completion-styles-alist): Add it to the dumb-flex style. --- lisp/progmodes/eglot.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 511000927cf..c5fbf5eb9d5 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -3060,9 +3060,13 @@ for which LSP on-type-formatting should be requested." finally (cl-return comp))) (defun eglot--dumb-allc (pat table pred _point) (funcall table pat pred t)) +(defun eglot--dumb-tryc (pat table pred point) + (if-let ((probe (funcall table pat pred nil))) + (cons probe (length probe)) + (cons pat point))) (add-to-list 'completion-category-defaults '(eglot-capf (styles eglot--dumb-flex))) -(add-to-list 'completion-styles-alist '(eglot--dumb-flex ignore eglot--dumb-allc)) +(add-to-list 'completion-styles-alist '(eglot--dumb-flex eglot--dumb-tryc eglot--dumb-allc)) (defun eglot-completion-at-point () "Eglot's `completion-at-point' function." -- cgit v1.2.3 From d85f561da03cd4705341a5a73f5c643f778e0f35 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 19 Jan 2024 09:11:37 -0800 Subject: Reserve negative depth range for ERC's insert hooks * etc/ERC-NEWS: Mention additional reserved depth range of -80 to -20. Also mention possibly having to cycle module activation state after updating options. * lisp/erc/erc-goodies.el (erc-irccontrols-mode, erc-irccontrols-enable): Add `erc-controls-highlight' to `erc-insert-modify-hook' at depth -50. * lisp/erc/erc.el (erc-insert-modify-hook): Mention negative hook-depth range in doc string. --- etc/ERC-NEWS | 13 ++++++++++++- lisp/erc/erc-goodies.el | 2 +- lisp/erc/erc.el | 4 ++-- 3 files changed, 15 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 6cfa704d995..b673d36220a 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -325,6 +325,15 @@ to enable the displaying of status prefixes on the speaker nicks of incoming chat messages. Prefixes on your speaker nick for outgoing chat messages continue to always be present. +** Updating user options requires cycling associated minor modes. +During a live ERC session, you may need to disable and re-enable a +module's minor mode via 'M-x erc-foo-mode RET' or similar before an +option's updated value takes effect. This primarily impacts new +options introduced by this release and existing ones whose behavior +has changed in some way. At present, ERC does not perform this step +automatically on your behalf, even if a change was made in a +'Custom-mode' buffer or via 'setopt'. + ** Miscellaneous UX changes. Some minor quality-of-life niceties have finally made their way to ERC. For example, fool visibility has become togglable with the new @@ -387,8 +396,10 @@ when present, at depths beginning at 20 and ending below 80. Of most interest to module authors is the new relative positioning of the first three, which have been rotated leftward with respect to their previous places in recent ERC versions (fill, button, match ,stamp). +A similar designated range from -80 to -20 also exists and is home to +the function 'erc-controls-highlight'. -ERC also provisionally reserves the same depth interval for +ERC also provisionally reserves the same depth intervals for 'erc-insert-pre-hook' and possibly other, similar hooks, but will continue to modify non-ERC hooks locally whenever possible, especially in new code. diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 23589657b2d..bf361ff91fb 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -822,7 +822,7 @@ The value `erc-interpret-controls-p' must also be t for this to work." ;;;###autoload(autoload 'erc-irccontrols-mode "erc-goodies" nil t) (define-erc-module irccontrols nil "This mode enables the interpretation of IRC control chars." - ((add-hook 'erc-insert-modify-hook #'erc-controls-highlight) + ((add-hook 'erc-insert-modify-hook #'erc-controls-highlight -50) (add-hook 'erc-send-modify-hook #'erc-controls-highlight) (erc--modify-local-map t "C-c C-c" #'erc-toggle-interpret-controls)) ((remove-hook 'erc-insert-modify-hook #'erc-controls-highlight) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 767a693a52e..e9d6099317f 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1278,8 +1278,8 @@ of `erc-insert-this' is t. ERC runs this hook with the buffer narrowed to the bounds of the inserted message plus a trailing newline. Built-in modules place -their hook members at depths between 20 and 80, with those from -the stamp module always running last. Use the functions +their hook members in two depth ranges: the first between -80 and +-20 and the second between 20 and 80. Use the functions `erc-find-parsed-property' and `erc-get-parsed-vector' to locate and extract the `erc-response' object for the inserted message." :group 'erc-hooks -- cgit v1.2.3 From aedc8b55bfc4d2864d777ac17f6bcf70e4ee04ce Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 17 Jan 2024 21:42:02 -0800 Subject: Actually derive channel membership from PREFIX in ERC * lisp/erc/erc-backend.el (erc--with-isupport-data): Add comment for possibly superior alternate implementation. * lisp/erc/erc-common.el (erc--get-isupport-entry): Use helper to initialize traditional prefix slots in overridden well-known constructor. (erc--parsed-prefix): Reverse order of characters in the `letters' and `statuses' slots, in their defaults and also their definitions. (erc--strpos): New function, a utility for finding a single character in a string. * lisp/erc/erc.el (erc--define-channel-user-status-compat-getter): Modify to query advertised value for associated mode letter at runtime instead of baking it in. (erc-channel-user-voice, erc-channel-user-halfop, erc-channel-user-op, erc-channel-user-admin, erc-channel-user-owner): Supply second argument for fallback mode letter. (erc--cusr-status-p, erc--cusr-change-status): New functions for querying and modifying `erc-channel-user' statuses. (erc-send-input-line): Update speaker time in own nick's `erc-channel-member' entry. (erc-get-channel-membership-prefix): Adapt code to prefer advertised prefix for mode letter. (erc--parsed-prefix): Save "reversed" `letters' and `statuses' so that they're ordered from lowest to highest semantically. (erc--get-prefix-flag, erc--init-cusr-fallback-status, erc--compute-cusr-fallback-status): New functions for retrieving internal prefix values and massaging hard-coded traditional prefixes so they're compatible with existing `erc-channel-member' update code. (erc--partition-prefixed-names): New function, separated for testing and for conversion to a generic in the future when ERC supports extensions that list member rolls in a different format. (erc-channel-receive-names): Refactor to use new status-aware update and init workhorse functions for updating and initializing a `erc-channel-members' entry. (erc--create-current-channel-member): New "status-aware" function comprising the `addp' path of `erc-update-current-channel-member'. (erc--update-current-channel-member): New "status-aware" function comprising the "update" path of `erc-update-current-channel-member', which ran when an existing `erc-channel-members' entry for the queried nick was found. (erc-update-current-channel-member): Split code body into two constituent functions, both for readability and for usability, so callers can more explicitly request the desired operation in a "status-aware" manner. (erc--update-membership-prefix): Remove unused function, originally meant to be new in ERC 5.6. (erc--process-channel-modes): Call `erc--cusr-change-status' instead of `erc--update-membership-prefix'. (erc--shuffle-nuh-nickward): New utility function to ensure code like `erc--partition-prefixed-names' can use `erc--parse-nuh' in a practical and relatively convenient way in the near future. * test/lisp/erc/erc-scenarios-base-chan-modes.el (erc-scenarios-base-chan-modes--speaker-status): New test. * test/lisp/erc/erc-tests.el (erc--parsed-prefix): Reverse expected order of various slot values in `erc--parsed-prefix' objects. (erc--get-prefix-flag, erc--init-cusr-fallback-status, erc--compute-cusr-fallback-status, erc--cusr-status-p, erc--cusr-change-status): New tests. (erc--update-channel-modes, erc-process-input-line): Use newly available utilities imported from common library. * test/lisp/erc/resources/base/modes/speaker-status.eld: New file. (Bug#67220) --- lisp/erc/erc-backend.el | 4 +- lisp/erc/erc-common.el | 24 +- lisp/erc/erc.el | 362 +++++++++++++-------- test/lisp/erc/erc-scenarios-base-chan-modes.el | 58 ++++ test/lisp/erc/erc-tests.el | 122 +++++-- .../erc/resources/base/modes/speaker-status.eld | 69 ++++ 6 files changed, 471 insertions(+), 168 deletions(-) create mode 100644 test/lisp/erc/resources/base/modes/speaker-status.eld (limited to 'lisp') diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 95207e56fd1..e379066b08e 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -2201,7 +2201,9 @@ primitive value." ;; While it's better to depend on interfaces than specific types, ;; using `cl-struct-slot-value' or similar to extract a known slot at ;; runtime would incur a small "ducktyping" tax, which should probably -;; be avoided when running dozens of times per incoming message. +;; be avoided when running hundreds of times per incoming message. +;; Instead of separate keys per data type, we could increment a +;; counter whenever a new 005 arrives. (defmacro erc--with-isupport-data (param var &rest body) "Return structured data stored in VAR for \"ISUPPORT\" PARAM. Expect VAR's value to be an instance of `erc--isupport-data'. If diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index e7e70fffd3a..e39e414b290 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -37,6 +37,7 @@ (defvar erc-session-server) (declare-function erc--get-isupport-entry "erc-backend" (key &optional single)) +(declare-function erc--init-cusr-fallback-status "erc" (v h o a q)) (declare-function erc-get-buffer "erc" (target &optional proc)) (declare-function erc-server-buffer "erc" nil) (declare-function widget-apply-action "wid-edit" (widget &optional event)) @@ -76,11 +77,11 @@ make-erc-channel-user ( &key voice halfop op admin owner last-message-time - &aux (status (+ (if voice 1 0) - (if halfop 2 0) - (if op 4 0) - (if admin 8 0) - (if owner 16 0))))) + &aux (status + (if (or voice halfop op admin owner) + (erc--init-cusr-fallback-status + voice halfop op admin owner) + 0)))) :named) "Object containing channel-specific data for a single user." ;; voice halfop op admin owner @@ -140,9 +141,12 @@ For use with the macro `erc--with-isupport-data'." (cl-defstruct (erc--parsed-prefix (:include erc--isupport-data)) "Server-local data for recognized membership-status prefixes. Derived from the advertised \"PREFIX\" ISUPPORT parameter." - (letters "qaohv" :type string) - (statuses "~&@%+" :type string) - (alist nil :type (list-of cons))) + ( letters "vhoaq" :type string + :documentation "Status letters ranked lowest to highest.") + ( statuses "+%@&~" :type string + :documentation "Status prefixes ranked lowest to highest.") + ( alist nil :type (list-of cons) + :documentation "Alist of letters-prefix pairs.")) (cl-defstruct (erc--channel-mode-types (:include erc--isupport-data)) "Server-local \"CHANMODES\" data." @@ -594,6 +598,10 @@ the resulting variables will end up with more useful doc strings." (debug (symbolp [&rest [keywordp form]] &rest (symbolp . form)))) `(erc--define-catalog ,language ,entries)) +(define-inline erc--strpos (char string) + "Return position of CHAR in STRING or nil if not found." + (inline-quote (string-search (string ,char) ,string))) + (defmacro erc--doarray (spec &rest body) "Map over ARRAY, running BODY with VAR bound to iteration element. Behave more or less like `seq-doseq', but tailor operations for diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index e9d6099317f..fc6f51950e2 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -598,28 +598,52 @@ Removes all users in the current channel. This is called by erc-channel-users) (clrhash erc-channel-users))) -(defmacro erc--define-channel-user-status-compat-getter (name n) +(defmacro erc--define-channel-user-status-compat-getter (name c d) "Define a gv getter for historical `erc-channel-user' status slot NAME. -Expect NAME to be a string and N to be its associated power-of-2 -\"enumerated flag\" integer." +Expect NAME to be a string, C to be its traditionally associated +letter, and D to be its fallback power-of-2 integer for non-ERC +buffers." `(defun ,(intern (concat "erc-channel-user-" name)) (u) ,(format "Get equivalent of pre-5.6 `%s' slot for `erc-channel-user'." name) (declare (gv-setter (lambda (v) (macroexp-let2 nil v v - (,'\`(let ((val (erc-channel-user-status ,',u))) + (,'\`(let ((val (erc-channel-user-status ,',u)) + (n (or (erc--get-prefix-flag ,c) ,d))) (setf (erc-channel-user-status ,',u) (if ,',v - (logior val ,n) - (logand val ,(lognot n)))) + (logior val n) + (logand val (lognot n)))) ,',v)))))) - (= ,n (logand ,n (erc-channel-user-status u))))) - -(erc--define-channel-user-status-compat-getter "voice" 1) -(erc--define-channel-user-status-compat-getter "halfop" 2) -(erc--define-channel-user-status-compat-getter "op" 4) -(erc--define-channel-user-status-compat-getter "admin" 8) -(erc--define-channel-user-status-compat-getter "owner" 16) + (let ((n (or (erc--get-prefix-flag ,c) ,d))) + (= n (logand n (erc-channel-user-status u)))))) + +(erc--define-channel-user-status-compat-getter "voice" ?v 1) +(erc--define-channel-user-status-compat-getter "halfop" ?h 2) +(erc--define-channel-user-status-compat-getter "op" ?o 4) +(erc--define-channel-user-status-compat-getter "admin" ?a 8) +(erc--define-channel-user-status-compat-getter "owner" ?q 16) + +;; This is a generalized version of the compat-oriented getters above. +(defun erc--cusr-status-p (nick-or-cusr letter) + "Return non-nil if NICK-OR-CUSR has channel membership status LETTER." + (and-let* ((cusr (or (and (erc-channel-user-p nick-or-cusr) nick-or-cusr) + (cdr (erc-get-channel-member nick-or-cusr)))) + (n (erc--get-prefix-flag letter))) + (= n (logand n (erc-channel-user-status cusr))))) + +(defun erc--cusr-change-status (nick-or-cusr letter enablep &optional resetp) + "Add or remove membership status associated with LETTER for NICK-OR-CUSR. +With RESETP, clear the user's status info completely. If ENABLEP +is non-nil, add the status value associated with LETTER." + (when-let ((cusr (or (and (erc-channel-user-p nick-or-cusr) nick-or-cusr) + (cdr (erc-get-channel-member nick-or-cusr)))) + (n (erc--get-prefix-flag letter))) + (cl-callf (lambda (v) + (if resetp + (if enablep n 0) + (if enablep (logior v n) (logand v (lognot n))))) + (erc-channel-user-status cusr)))) (defun erc-channel-user-owner-p (nick) "Return non-nil if NICK is an owner of the current channel." @@ -3900,6 +3924,10 @@ for other purposes.") (defun erc-send-input-line (target line &optional force) "Send LINE to TARGET." + (when-let ((target) + (cmem (erc-get-channel-member (erc-current-nick)))) + (setf (erc-channel-user-last-message-time (cdr cmem)) + (erc-compat--current-lisp-time))) (when (and (not erc--allow-empty-outgoing-lines-p) (string= line "\n")) (setq line " \n")) (erc-message "PRIVMSG" (concat target " " line) force)) @@ -6141,17 +6169,15 @@ return a possibly empty string." (catch 'done (pcase-dolist (`(,letter . ,pfx) (erc--parsed-prefix-alist pfx-obj)) - (pcase letter - ((and ?q (guard (erc-channel-user-owner nick-or-cusr))) - (throw 'done (propertize (string pfx) 'help-echo "owner"))) - ((and ?a (guard (erc-channel-user-admin nick-or-cusr))) - (throw 'done (propertize (string pfx) 'help-echo "admin"))) - ((and ?o (guard (erc-channel-user-op nick-or-cusr))) - (throw 'done (propertize (string pfx) 'help-echo "operator"))) - ((and ?h (guard (erc-channel-user-halfop nick-or-cusr))) - (throw 'done (propertize (string pfx) 'help-echo "half-op"))) - ((and ?v (guard (erc-channel-user-voice nick-or-cusr))) - (throw 'done (propertize (string pfx) 'help-echo "voice"))))) + (when (erc--cusr-status-p nick-or-cusr letter) + (throw 'done + (pcase letter + (?q (propertize (string pfx) 'help-echo "owner")) + (?a (propertize (string pfx) 'help-echo "admin")) + (?o (propertize (string pfx) 'help-echo "operator")) + (?h (propertize (string pfx) 'help-echo "half-op")) + (?v (propertize (string pfx) 'help-echo "voice")) + (_ (string pfx)))))) ""))) (t (cond ((erc-channel-user-owner nick-or-cusr) @@ -6763,12 +6789,52 @@ parameter advertised by the current server, with the original ordering intact. If no such parameter has yet arrived, return a stand-in from the fallback value \"(qaohv)~&@%+\"." (erc--with-isupport-data PREFIX erc--parsed-prefix - (let ((alist (nreverse (erc-parse-prefix)))) + (let ((alist (erc-parse-prefix))) (make-erc--parsed-prefix :key key :letters (apply #'string (map-keys alist)) :statuses (apply #'string (map-values alist)) - :alist alist)))) + :alist (nreverse alist))))) + +(defun erc--get-prefix-flag (char &optional parsed-prefix from-prefix-p) + "Return numeric rank for CHAR or nil if unknown. +For example, given letters \"qaohv\" return 1 for ?v, 2 for ?h, +and 4 for ?o, etc. If given, expect PARSED-PREFIX to be a +`erc--parse-prefix' object. With FROM-PREFIX-P, expect CHAR to +be a prefix instead." + (and-let* ((obj (or parsed-prefix (erc--parsed-prefix))) + (pos (erc--strpos char (if from-prefix-p + (erc--parsed-prefix-statuses obj) + (erc--parsed-prefix-letters obj))))) + (ash 1 pos))) + +(defun erc--init-cusr-fallback-status (voice halfop op admin owner) + "Return channel-membership based on traditional status semantics. +Massage boolean switches VOICE, HALFOP, OP, ADMIN, and OWNER into +an internal numeric value suitable for the `status' slot of a new +`erc-channel-user' object." + (let ((pfx (erc--parsed-prefix))) + (+ (if voice (if pfx (or (erc--get-prefix-flag ?v pfx) 0) 1) 0) + (if halfop (if pfx (or (erc--get-prefix-flag ?h pfx) 0) 2) 0) + (if op (if pfx (or (erc--get-prefix-flag ?o pfx) 0) 4) 0) + (if admin (if pfx (or (erc--get-prefix-flag ?a pfx) 0) 8) 0) + (if owner (if pfx (or (erc--get-prefix-flag ?q pfx) 0) 16) 0)))) + +(defun erc--compute-cusr-fallback-status (current v h o a q) + "Return current channel membership after toggling V H O A Q as requested. +Assume `erc--parsed-prefix' is non-nil in the current buffer. +Expect status switches V, H, O, A, Q, when non-nil, to be the +symbol `on' or `off'. Return an internal numeric value suitable +for the `status' slot of an `erc-channel-user' object." + (let (on off) + (when v (push (or (erc--get-prefix-flag ?v) 0) (if (eq v 'on) on off))) + (when h (push (or (erc--get-prefix-flag ?h) 0) (if (eq h 'on) on off))) + (when o (push (or (erc--get-prefix-flag ?o) 0) (if (eq o 'on) on off))) + (when a (push (or (erc--get-prefix-flag ?a) 0) (if (eq a 'on) on off))) + (when q (push (or (erc--get-prefix-flag ?q) 0) (if (eq q 'on) on off))) + (when on (setq current (apply #'logior current on))) + (when off (setq current (apply #'logand current (mapcar #'lognot off))))) + current) (defcustom erc-channel-members-changed-hook nil "This hook is called every time the variable `channel-members' changes. @@ -6776,48 +6842,40 @@ The buffer where the change happened is current while this hook is called." :group 'erc-hooks :type 'hook) -(defun erc-channel-receive-names (names-string) - "This function is for internal use only. +(defun erc--partition-prefixed-names (name) + "From NAME, return a list of (STATUS NICK LOGIN HOST). +Expect NAME to be a prefixed name, like @bob." + (unless (string-empty-p name) + (let* ((status (erc--get-prefix-flag (aref name 0) nil 'from-prefix-p)) + (nick (if status (substring name 1) name))) + (unless (string-empty-p nick) + (list status nick nil nil))))) -Update `erc-channel-users' according to NAMES-STRING. -NAMES-STRING is a string listing some of the names on the -channel." - (let* ((prefix (erc--parsed-prefix-alist (erc--parsed-prefix))) - (voice-ch (cdr (assq ?v prefix))) - (op-ch (cdr (assq ?o prefix))) - (hop-ch (cdr (assq ?h prefix))) - (adm-ch (cdr (assq ?a prefix))) - (own-ch (cdr (assq ?q prefix))) - (names (delete "" (split-string names-string))) - name op voice halfop admin owner) - (let ((erc-channel-members-changed-hook nil)) - (dolist (item names) - (let ((updatep t) - (ch (aref item 0))) - (setq name item op 'off voice 'off halfop 'off admin 'off owner 'off) - (if (rassq ch prefix) - (if (= (length item) 1) - (setq updatep nil) - (setq name (substring item 1)) - (setf (pcase ch - ((pred (eq voice-ch)) voice) - ((pred (eq hop-ch)) halfop) - ((pred (eq op-ch)) op) - ((pred (eq adm-ch)) admin) - ((pred (eq own-ch)) owner) - (_ (message "Unknown prefix char `%S'" ch) voice)) - 'on))) - (when updatep +(defun erc-channel-receive-names (names-string) + "Update `erc-channel-members' from NAMES-STRING. +Expect NAMES-STRING to resemble the trailing argument of a 353 +RPL_NAMREPLY. Call internal handlers for parsing individual +names, whose expected composition may differ depending on enabled +extensions." + (let ((names (delete "" (split-string names-string))) + (erc-channel-members-changed-hook nil)) + (dolist (name names) + (when-let ((args (erc--partition-prefixed-names name))) + (pcase-let* ((`(,status ,nick ,login ,host) args) + (cmem (erc-get-channel-user nick))) + (progn ;; If we didn't issue the NAMES request (consider two clients ;; talking to an IRC proxy), `erc-channel-begin-receiving-names' ;; will not have been called, so we have to do it here. (unless erc-channel-new-member-names (erc-channel-begin-receiving-names)) - (puthash (erc-downcase name) t - erc-channel-new-member-names) - (erc-update-current-channel-member - name name t voice halfop op admin owner))))) - (run-hooks 'erc-channel-members-changed-hook))) + (puthash (erc-downcase nick) t erc-channel-new-member-names) + (if cmem + (erc--update-current-channel-member cmem status nil + nick host login) + (erc--create-current-channel-member nick status nil + nick host login))))))) + (run-hooks 'erc-channel-members-changed-hook)) (defun erc-update-user-nick (nick &optional new-nick host login full-name info) @@ -6869,17 +6927,85 @@ which USER is a member, and t is returned." (run-hooks 'erc-channel-members-changed-hook)))))) changed)) +(defun erc--create-current-channel-member + (nick status timep &optional new-nick host login full-name info) + "Add an `erc-channel-member' entry for NICK. +Create a new `erc-server-users' entry if necessary, and ensure +`erc-channel-members-changed-hook' runs exactly once, regardless. +Pass STATUS to the `erc-channel-user' constructor. With TIMEP, +assume NICK has just spoken, and initialize `last-message-time'. +Pass NEW-NICK, HOST, LOGIN, FULL-NAME, and INFO to +`erc-update-user' if a server user exists and otherwise to the +`erc-server-user' constructor." + (cl-assert (null (erc-get-channel-member nick))) + (let* ((user-changed-p nil) + (down (erc-downcase nick)) + (user (gethash down (erc-with-server-buffer erc-server-users)))) + (if user + (progn + (cl-pushnew (current-buffer) (erc-server-user-buffers user)) + ;; Update *after* ^ so hook has chance to run. + (setf user-changed-p (erc-update-user user new-nick host login + full-name info))) + (erc-add-server-user nick + (setq user (make-erc-server-user + :nickname (or new-nick nick) + :host host + :full-name full-name + :login login + :info nil + :buffers (list (current-buffer)))))) + (let ((cusr (erc-channel-user--make + :status (or status 0) + :last-message-time (and timep + (erc-compat--current-lisp-time))))) + (puthash down (cons user cusr) erc-channel-users)) + ;; An existing `cusr' was changed or a new one was added, and + ;; `user' was not updated, though possibly just created (since + ;; `erc-update-user' runs this same hook in all a user's buffers). + (unless user-changed-p + (run-hooks 'erc-channel-members-changed-hook)) + t)) + +(defun erc--update-current-channel-member (cmem status timep &rest user-args) + "Update existing `erc-channel-member' entry. +Set the `status' slot of the entry's `erc-channel-user' side to +STATUS and, with TIMEP, update its `last-message-time'. When +actual changes are made, run `erc-channel-members-changed-hook', +and return non-nil." + (cl-assert cmem) + (let ((cusr (cdr cmem)) + (user (car cmem)) + cusr-changed-p user-changed-p) + (when (and status (/= status (erc-channel-user-status cusr))) + (setf (erc-channel-user-status cusr) status + cusr-changed-p t)) + (when timep + (setf (erc-channel-user-last-message-time cusr) + (erc-compat--current-lisp-time))) + ;; Ensure `erc-channel-members-changed-hook' runs on change. + (cl-assert (memq (current-buffer) (erc-server-user-buffers user))) + (setq user-changed-p (apply #'erc-update-user user user-args)) + ;; An existing `cusr' was changed or a new one was added, and + ;; `user' was not updated, though possibly just created (since + ;; `erc-update-user' runs this same hook in all a user's buffers). + (when (and cusr-changed-p (null user-changed-p)) + (run-hooks 'erc-channel-members-changed-hook)) + (erc-log (format "update-member: user = %S, cusr = %S" user cusr)) + (or cusr-changed-p user-changed-p))) + (defun erc-update-current-channel-member - (nick new-nick &optional addp voice halfop op admin owner host login full-name info - update-message-time) + (nick new-nick &optional addp voice halfop op admin owner host login + full-name info update-message-time) "Update or create entry for NICK in current `erc-channel-members' table. -With ADDP, ensure an entry exists. If one already does, call -`erc-update-user' to handle updates to HOST, LOGIN, FULL-NAME, -INFO, and NEW-NICK. Expect any non-nil membership status -switches among VOICE, HALFOP, OP, ADMIN, and OWNER to be the -symbol `on' or `off' when needing to influence a new or existing -`erc-channel-user' object's `status' slot. Likewise, when -UPDATE-MESSAGE-TIME is non-nil, update or initialize the +With ADDP, ensure an entry exists. When an entry does exist or +when ADDP is non-nil and an `erc-server-users' entry already +exists, call `erc-update-user' with NEW-NICK, HOST, LOGIN, +FULL-NAME, and INFO. Expect any non-nil membership +status switches among VOICE, HALFOP, OP, ADMIN, and OWNER to be +the symbol `on' or `off' when needing to influence a new or +existing `erc-channel-user' object's `status' slot. Likewise, +when UPDATE-MESSAGE-TIME is non-nil, update or initialize the `last-message-time' slot to the current-time. If changes occur, including creation, run `erc-channel-members-changed-hook'. Return non-nil when meaningful changes, including creation, have @@ -6889,62 +7015,26 @@ Without ADDP, do nothing unless a `erc-channel-members' entry exists. When it doesn't, assume the sender is a non-joined entity, like the server itself or a historical speaker, or assume the prior buffer for the channel was killed without parting." - (let* (cusr-changed-p - user-changed-p - (cmem (erc-get-channel-member nick)) - (cusr (cdr cmem)) - (down (erc-downcase nick)) - (user (or (car cmem) - (gethash down (erc-with-server-buffer erc-server-users))))) - (if cusr - (progn - (erc-log (format "update-member: user = %S, cusr = %S" user cusr)) - (when-let (((or voice halfop op admin owner)) - (existing (erc-channel-user-status cusr))) - (when voice (setf (erc-channel-user-voice cusr) (eq voice 'on))) - (when halfop (setf (erc-channel-user-halfop cusr) (eq halfop 'on))) - (when op (setf (erc-channel-user-op cusr) (eq op 'on))) - (when admin (setf (erc-channel-user-admin cusr) (eq admin 'on))) - (when owner (setf (erc-channel-user-owner cusr) (eq owner 'on))) - (setq cusr-changed-p (= existing (erc-channel-user-status cusr)))) - (when update-message-time - (setf (erc-channel-user-last-message-time cusr) (current-time))) - ;; Assume `user' exists and its `buffers' slot contains the - ;; current buffer so that `erc-channel-members-changed-hook' - ;; will run if changes are made. - (setq user-changed-p - (erc-update-user user new-nick - host login full-name info))) - (when addp - (if (null user) - (progn - (setq user (make-erc-server-user - :nickname nick - :host host - :full-name full-name - :login login - :info info - :buffers (list (current-buffer)))) - (erc-add-server-user nick user)) - (setf (erc-server-user-buffers user) - (cons (current-buffer) - (erc-server-user-buffers user)))) - (setq cusr (make-erc-channel-user - :voice (and voice (eq voice 'on)) - :halfop (and halfop (eq halfop 'on)) - :op (and op (eq op 'on)) - :admin (and admin (eq admin 'on)) - :owner (and owner (eq owner 'on)) - :last-message-time (if update-message-time - (current-time)))) - (puthash down (cons user cusr) erc-channel-users) - (setq cusr-changed-p t))) - ;; An existing `cusr' was changed or a new one was added, and - ;; `user' was not updated, though possibly just created (since - ;; `erc-update-user' runs this same hook in all a user's buffers). - (when (and cusr-changed-p (null user-changed-p)) - (run-hooks 'erc-channel-members-changed-hook)) - (or cusr-changed-p user-changed-p))) +(let* ((cmem (erc-get-channel-member nick)) + (status (and (or voice halfop op admin owner) + (if cmem + (erc--compute-cusr-fallback-status + (erc-channel-user-status (cdr cmem)) + voice halfop op admin owner) + (erc--init-cusr-fallback-status + (and voice (eq voice 'on)) + (and halfop (eq halfop 'on)) + (and op (eq op 'on)) + (and admin (eq admin 'on)) + (and owner (eq owner 'on))))))) + (if cmem + (erc--update-current-channel-member cmem status update-message-time + new-nick host login + full-name info) + (when addp + (erc--create-current-channel-member nick status update-message-time + new-nick host login + full-name info))))) (defun erc-update-channel-member (channel nick new-nick &optional add voice halfop op admin owner host login @@ -7134,16 +7224,6 @@ person who changed the modes." ;; nick modes - ignored at this point (t nil)))) -(defun erc--update-membership-prefix (nick letter state) - "Update status prefixes for NICK in current channel buffer. -Expect LETTER to be a status char and STATE to be a boolean." - (erc-update-current-channel-member nick nil nil - (and (= letter ?v) state) - (and (= letter ?h) state) - (and (= letter ?o) state) - (and (= letter ?a) state) - (and (= letter ?q) state))) - (defvar-local erc--channel-modes nil "When non-nil, a hash table of current channel modes. Keys are characters. Values are either a string, for types A-C, @@ -7189,7 +7269,7 @@ complement relevant letters in STRING." (cond ((= ?+ c) (setq +p t)) ((= ?- c) (setq +p nil)) ((and status-letters (string-search (string c) status-letters)) - (erc--update-membership-prefix (pop args) c (if +p 'on 'off))) + (erc--cusr-change-status (pop args) c +p)) ((and-let* ((group (or (aref table c) (and fallbackp ?d)))) (erc--handle-channel-mode group c +p (and (/= group ?d) @@ -7511,6 +7591,12 @@ See associated unit test for precise behavior." (match-string 2 string) (match-string 3 string)))) +(defun erc--shuffle-nuh-nickward (nick login host) + "Interpret results of `erc--parse-nuh', promoting loners to nicks." + (cond (nick (cl-assert (null login)) (list nick login host)) + ((and (null login) host) (list host nil nil)) + ((and login (null host)) (list login nil nil)))) + (defun erc-extract-nick (string) "Return the nick corresponding to a user specification STRING. diff --git a/test/lisp/erc/erc-scenarios-base-chan-modes.el b/test/lisp/erc/erc-scenarios-base-chan-modes.el index 73fba65acf4..3183cd27370 100644 --- a/test/lisp/erc/erc-scenarios-base-chan-modes.el +++ b/test/lisp/erc/erc-scenarios-base-chan-modes.el @@ -81,4 +81,62 @@ (should-not erc-channel-user-limit) (funcall expect 10 " after")))) +;; This asserts proper recognition of nonstandard prefixes advertised +;; via the "PREFIX=" ISUPPORT parameter. Note that without the IRCv3 +;; `multi-prefix' extension, we can't easily sync a user's channel +;; membership status on receipt of a 352/353 by parsing the "flags" +;; parameter because even though servers remember multiple prefixes, +;; they only ever return the one with the highest rank. For example, +;; if on receipt of a 352, we were to "update" someone we believe to +;; be @+ by changing them to a to @, we'd be guilty of willful +;; munging. And if they later lose that @, we'd then see them as null +;; when in fact they're still +. However, we *could* use a single +;; degenerate prefix to "validate" an existing record to ensure +;; correctness of our processing logic, but it's unclear how such a +;; discrepancy ought to be handled beyond asking the user to file a +;; bug. +(ert-deftest erc-scenarios-base-chan-modes--speaker-status () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/modes") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'speaker-status)) + (erc-show-speaker-membership-status t) + (erc-autojoin-channels-alist '(("." "#chan"))) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port (process-contact dumb-server :service) + :nick "tester" + :user "tester") + (funcall expect 5 "Here on foonet, we provide services"))) + + (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan")) + + (ert-info ("Prefixes printed correctly in 353") + (funcall expect 10 "chan: +alice @fsbot -bob !foop")) + + (ert-info ("Speakers honor option `erc-show-speaker-membership-status'") + (funcall expect 10 "<-bob> alice: Of that which hath") + (funcall expect 10 "<+alice> Hie you, make haste") + (funcall expect 10 " hi")) + + (ert-info ("Status conferred and rescinded") + (funcall expect 10 "*** foop (user@netadmin.example.net) has changed ") + (funcall expect 10 "mode for #chan to +v bob") + (funcall expect 10 "<+bob> alice: Fair as a text B") + (funcall expect 10 "<+alice> bob: Even as Apemantus") + (funcall expect 10 "mode for #chan to -v bob") + (funcall expect 10 "<-bob> alice: That's the way") + (funcall expect 10 "<+alice> Give it the beasts")) + + ;; If it had instead overwritten it, our two states would be + ;; out of sync. (See comment above.) + (ert-info ("/WHO output confirms server shadowed V status") + (erc-scenarios-common-say "/who #chan") + (funcall expect 10 '(: "bob" (+ " ") "H-")) + (funcall expect 10 "<-bob> alice: Remains in danger") + (erc-cmd-QUIT ""))))) + ;;; erc-scenarios-base-chan-modes.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 49c72836a22..b51bd67ae04 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -674,7 +674,7 @@ ;; checking if null beforehand. (should-not erc--parsed-prefix) (should (equal (erc--parsed-prefix) - #s(erc--parsed-prefix nil "qaohv" "~&@%+" + #s(erc--parsed-prefix nil "vhoaq" "+%@&~" ((?q . ?~) (?a . ?&) (?o . ?@) (?h . ?%) (?v . ?+))))) (let ((cached (should erc--parsed-prefix))) @@ -696,7 +696,7 @@ (should (equal expected (erc--parsed-prefix-alist erc--parsed-prefix))) (setq cached erc--parsed-prefix) (should (equal cached - #s(erc--parsed-prefix ("(ov)@+") "ov" "@+" + #s(erc--parsed-prefix ("(ov)@+") "vo" "+@" ((?o . ?@) (?v . ?+))))) ;; Second target buffer reuses cached value. (with-temp-buffer @@ -714,6 +714,88 @@ (erc-with-server-buffer erc--parsed-prefix)) '((?q . ?~) (?h . ?%))))))) +(ert-deftest erc--get-prefix-flag () + (erc-tests-common-make-server-buf (buffer-name)) + (should-not erc--parsed-prefix) + (should (= (erc--get-prefix-flag ?v) 1)) + (should (= (erc--get-prefix-flag ?h) 2)) + (should (= (erc--get-prefix-flag ?o) 4)) + (should (= (erc--get-prefix-flag ?a) 8)) + (should (= (erc--get-prefix-flag ?q) 16)) + + (ert-info ("With optional `from-prefix-p'") + (should (= (erc--get-prefix-flag ?+ nil 'fpp) 1)) + (should (= (erc--get-prefix-flag ?% nil 'fpp) 2)) + (should (= (erc--get-prefix-flag ?@ nil 'fpp) 4)) + (should (= (erc--get-prefix-flag ?& nil 'fpp) 8)) + (should (= (erc--get-prefix-flag ?~ nil 'fpp) 16))) + (should erc--parsed-prefix)) + +(ert-deftest erc--init-cusr-fallback-status () + ;; Fallback behavior active because no `erc--parsed-prefix'. + (should-not erc--parsed-prefix) + (should (= 0 (erc--init-cusr-fallback-status nil nil nil nil nil))) + (should (= 1 (erc--init-cusr-fallback-status t nil nil nil nil))) + (should (= 4 (erc--init-cusr-fallback-status nil nil t nil nil))) + (should-not erc--parsed-prefix) ; not created in non-ERC buffer. + + ;; Uses advertised server parameter. + (erc-tests-common-make-server-buf (buffer-name)) + (setq erc-server-parameters '(("PREFIX" . "(YqaohvV)!~&@%+-"))) + (should (= 0 (erc--init-cusr-fallback-status nil nil nil nil nil))) + (should (= 2 (erc--init-cusr-fallback-status t nil nil nil nil))) + (should (= 8 (erc--init-cusr-fallback-status nil nil t nil nil))) + (should erc--parsed-prefix)) + +(ert-deftest erc--compute-cusr-fallback-status () + ;; Useless without an `erc--parsed-prefix'. + (should (= 0 (erc--compute-cusr-fallback-status 0 nil nil nil nil nil))) + (should (= 0 (erc--compute-cusr-fallback-status 0 'on 'on 'on 'on 'on))) + + (erc-tests-common-make-server-buf (buffer-name)) + (should (= 0 (erc--compute-cusr-fallback-status 0 nil nil nil nil nil))) + (should (= 1 (erc--compute-cusr-fallback-status 0 'on nil nil nil nil))) + (should (= 1 (erc--compute-cusr-fallback-status 0 'on 'off 'off 'off 'off))) + (should (= 1 (erc--compute-cusr-fallback-status 1 'on 'off 'off 'off 'off))) + (should (= 1 (erc--compute-cusr-fallback-status 1 nil nil nil nil nil))) + (should (= 1 (erc--compute-cusr-fallback-status 3 nil 'off nil nil nil))) + (should (= 1 (erc--compute-cusr-fallback-status 7 nil 'off 'off nil nil))) + (should (= 4 (erc--compute-cusr-fallback-status 1 'off nil 'on nil nil)))) + +(ert-deftest erc--cusr-status-p () + (erc-tests-common-make-server-buf (buffer-name)) + (should-not erc--parsed-prefix) + (let ((cusr (make-erc-channel-user :voice t :op t))) + (should-not (erc--cusr-status-p cusr ?q)) + (should-not (erc--cusr-status-p cusr ?a)) + (should-not (erc--cusr-status-p cusr ?h)) + (should (erc--cusr-status-p cusr ?o)) + (should (erc--cusr-status-p cusr ?v))) + (should erc--parsed-prefix)) + +(ert-deftest erc--cusr-change-status () + (erc-tests-common-make-server-buf (buffer-name)) + (let ((cusr (make-erc-channel-user))) + (should-not (erc--cusr-status-p cusr ?o)) + (should-not (erc--cusr-status-p cusr ?v)) + (erc--cusr-change-status cusr ?o t) + (erc--cusr-change-status cusr ?v t) + (should (erc--cusr-status-p cusr ?o)) + (should (erc--cusr-status-p cusr ?v)) + + (ert-info ("Reset with optional param") + (erc--cusr-change-status cusr ?q t 'reset) + (should-not (erc--cusr-status-p cusr ?o)) + (should-not (erc--cusr-status-p cusr ?v)) + (should (erc--cusr-status-p cusr ?q))) + + (ert-info ("Clear with optional param") + (erc--cusr-change-status cusr ?v t) + (should (erc--cusr-status-p cusr ?v)) + (erc--cusr-change-status cusr ?q nil 'reset) + (should-not (erc--cusr-status-p cusr ?v)) + (should-not (erc--cusr-status-p cusr ?q))))) + ;; This exists as a reference to assert legacy behavior in order to ;; preserve and incorporate it as a fallback in the 5.6+ replacement. (ert-deftest erc-parse-modes () @@ -737,12 +819,9 @@ (should (equal (erc-parse-modes "-l") '(nil nil (("l" off nil)))))))) (ert-deftest erc--update-channel-modes () - (erc-mode) + (erc-tests-common-make-server-buf) (setq erc-channel-users (make-hash-table :test #'equal) - erc-server-users (make-hash-table :test #'equal) - erc--isupport-params (make-hash-table) erc--target (erc--target-from-string "#test")) - (erc-tests-common-init-server-proc "sleep" "1") (let ((orig-handle-fn (symbol-function 'erc--handle-channel-mode)) calls) @@ -1715,13 +1794,13 @@ ;; regardless of whether a command handler is summoned. (ert-deftest erc-process-input-line () - (let (erc-server-last-sent-time - erc-server-flood-queue - (orig-erc-cmd-MSG (symbol-function 'erc-cmd-MSG)) - (erc-default-recipients '("#chan")) + (erc-tests-common-make-server-buf) + (let ((orig-erc-cmd-MSG (symbol-function 'erc-cmd-MSG)) + (pop-flood-queue (lambda () (erc-with-server-buffer + (pop erc-server-flood-queue)))) calls) - (with-temp-buffer - (erc-tests-common-init-server-proc "sleep" "1") + (setq erc-server-current-nick "tester") + (with-current-buffer (erc--open-target "#chan") (cl-letf (((symbol-function 'erc-cmd-MSG) (lambda (line) (push line calls) @@ -1735,49 +1814,50 @@ (ert-info ("Baseline") (erc-process-input-line "/msg #chan hi\n") (should (equal (pop calls) " #chan hi")) - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :hi\r\n" . utf-8)))) (ert-info ("Quote preserves line intact") (erc-process-input-line "/QUOTE FAKE foo bar\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("FAKE foo bar\r\n" . utf-8)))) (ert-info ("Unknown command respected") (erc-process-input-line "/FAKE foo bar\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("FAKE foo bar\r\n" . utf-8)))) (ert-info ("Spaces preserved") (erc-process-input-line "/msg #chan hi you\n") (should (equal (pop calls) " #chan hi you")) - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :hi you\r\n" . utf-8)))) (ert-info ("Empty line honored") (erc-process-input-line "/msg #chan\n") (should (equal (pop calls) " #chan")) - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :\r\n" . utf-8))))) (ert-info ("Implicit cmd via `erc-send-input-line-function'") (ert-info ("Baseline") (erc-process-input-line "hi\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :hi\r\n" . utf-8)))) (ert-info ("Spaces preserved") (erc-process-input-line "hi you\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :hi you\r\n" . utf-8)))) (ert-info ("Empty line transmitted with injected-space kludge") (erc-process-input-line "\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan : \r\n" . utf-8)))) - (should-not calls)))))) + (should-not calls))))) + (erc-tests-common-kill-buffers)) (ert-deftest erc--get-inserted-msg-beg/basic () (erc-tests-common-assert-get-inserted-msg/basic diff --git a/test/lisp/erc/resources/base/modes/speaker-status.eld b/test/lisp/erc/resources/base/modes/speaker-status.eld new file mode 100644 index 00000000000..4a7d508e35c --- /dev/null +++ b/test/lisp/erc/resources/base/modes/speaker-status.eld @@ -0,0 +1,69 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER tester 0 * :unknown") + (0.00 ":irc.example.net NOTICE * :*** Looking up your hostname...") + (0.00 ":irc.example.net NOTICE tester :*** Could not resolve your hostname: Domain not found; using your IP address (10.0.2.100) instead.") + (0.09 ":irc.example.net 001 tester :Welcome to the foonet IRC Network tester!tester@10.0.2.100") + (0.01 ":irc.example.net 002 tester :Your host is irc.example.net, running version InspIRCd-3") + (0.01 ":irc.example.net 003 tester :This server was created 07:50:59 Jan 22 2024") + (0.03 ":irc.example.net 004 tester irc.example.net InspIRCd-3 BIRcgikorsw ACHIKMORTVXabcefghijklmnopqrstvyz :HIVXabefghjkloqvy") + (0.00 ":irc.example.net 005 tester ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=ascii CHANLIMIT=#:20 CHANMODES=IXbeg,k,Hfjl,ACKMORTcimnprstz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server") + (0.01 ":irc.example.net 005 tester EXTBAN=,ACORTUacjrwz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=foonet :are supported by this server") + (0.01 ":irc.example.net 005 tester NICKLEN=30 PREFIX=(yqaohvV)!~&@%+- SAFELIST SILENCE=32 STATUSMSG=!~&@%+- TOPICLEN=307 UHNAMES USERIP USERLEN=10 USERMODES=,,s,BIRcgikorw WHOX :are supported by this server") + (0.01 ":irc.example.net 251 tester :There are 2 users and 2 invisible on 2 servers") + (0.00 ":irc.example.net 252 tester 1 :operator(s) online") + (0.00 ":irc.example.net 253 tester 1 :unknown connections") + (0.00 ":irc.example.net 254 tester 2 :channels formed") + (0.00 ":irc.example.net 255 tester :I have 4 clients and 1 servers") + (0.00 ":irc.example.net 265 tester :Current local users: 4 Max: 5") + (0.00 ":irc.example.net 266 tester :Current global users: 4 Max: 5") + (0.00 ":irc.example.net 375 tester :irc.example.net message of the day") + (0.00 ":irc.example.net 372 tester : https://github.com/inspircd/inspircd-docker/issues") + (0.00 ":irc.example.net 372 tester : ") + (0.00 ":irc.example.net 372 tester : Have fun with the image!") + (0.00 ":irc.example.net 376 tester :End of message of the day.") + (0.00 ":irc.example.net 501 tester x :is not a recognised user mode.") + (0.00 ":NickServ!NickServ@services.int NOTICE tester :Welcome to foonet, tester! Here on foonet, we provide services to enable the registration of nicknames and channels! For details, type \2/msg NickServ help\2 and \2/msg ChanServ help\2.")) + +((mode 10 "MODE tester +i") + (0.01 ":tester!tester@10.0.2.100 MODE tester :+i")) + +((join 10 "JOIN #chan") + (0.02 ":tester!tester@10.0.2.100 JOIN :#chan") + (0.02 ":irc.example.net 353 tester = #chan :+alice @fsbot -bob !foop tester") + (0.03 ":irc.example.net 366 tester #chan :End of /NAMES list.") + (0.00 ":bob!bob@localhost PRIVMSG #chan :tester, welcome!") + (0.01 ":alice!alice@localhost PRIVMSG #chan :tester, welcome!")) + +((mode-chan 10 "MODE #chan") + (0.00 ":irc.example.net 324 tester #chan :+nt") + (0.01 ":irc.example.net 329 tester #chan :1705909863") + (0.03 ":bob!bob@localhost PRIVMSG #chan :alice: Of that which hath so faithfully been paid.") + (0.03 ":alice!alice@localhost PRIVMSG #chan :Hie you, make haste, for it grows very late.") + (0.03 ":foop!user@netadmin.example.net PRIVMSG #chan :hi") + ;; (0.07 ":alice!alice@localhost PRIVMSG #chan :bob: And make a clear way to the gods.") + ;; (0.04 ":bob!bob@localhost PRIVMSG #chan :Why, that they have; and bid them so be gone.") + ;; (0.08 ":bob!bob@localhost PRIVMSG #chan :alice: Now stay your strife: what shall be is dispatch'd.") + (0.06 ":foop!user@netadmin.example.net MODE #chan +v :bob") + (0.05 ":bob!bob@localhost PRIVMSG #chan :alice: Fair as a text B in a copy-book.") + (0.07 ":alice!alice@localhost PRIVMSG #chan :bob: Even as Apemantus does now; hate a lord with my heart.") + (0.03 ":bob!bob@localhost PRIVMSG #chan :Then here is a supplication for you. And when you come to him, at the first approach you must kneel; then kiss his foot; then deliver up your pigeons; and then look for your reward. I'll be at hand, sir; see you do it bravely.") + (0.05 ":foop!user@netadmin.example.net MODE #chan -v :bob") + (0.04 ":bob!bob@localhost PRIVMSG #chan :alice: That's the way: for women are light at midnight.") + (0.04 ":alice!alice@localhost PRIVMSG #chan :Give it the beasts, to be rid of the men.") + ;; (0.02 ":alice!alice@localhost PRIVMSG #chan :bob: Here comes young Master Ganymede, my new mistress's brother.") + ) + +((who-chan 10 "who #chan") + (0.03 ":irc.example.net 352 tester #chan alice localhost irc.example.net alice H+ :0 Irc bot based on irc3 http://irc3.readthedocs.io") + (0.03 ":irc.example.net 352 tester #chan fsbot localhost irc.example.net fsbot H@ :0 fsbot") + (0.01 ":irc.example.net 352 tester #chan bob localhost irc.example.net bob H- :0 Irc bot based on irc3 http://irc3.readthedocs.io") + (0.01 ":irc.example.net 352 tester #chan user netadmin.example.net irc.example.net foop H*! :0 unknown") + (0.01 ":irc.example.net 352 tester #chan tester 10.0.2.100 irc.example.net tester H :0 unknown") + (0.01 ":irc.example.net 315 tester #chan :End of /WHO list.") + ;; (0.09 ":bob!bob@localhost PRIVMSG #chan :alice: Shall nothing wrong him. Thus it is, general.") + ;; (0.04 ":alice!alice@localhost PRIVMSG #chan :bob: His father and I were soldiers together; to whom I have been often bound for no less than my life. Here comes the Briton: let him be so entertained amongst you as suits, with gentlemen of your knowing, to a stranger of his quality.") + (0.04 ":bob!bob@localhost PRIVMSG #chan :alice: Remains in danger of her former tooth.")) + +((quit 10 "QUIT :\2ERC\2") + (0.03 "ERROR :Closing link: (tester@10.0.2.100) [Quit: \2ERC\2 5.x (IRC client for GNU Emacs)]")) -- cgit v1.2.3 From aae131b8dd9ab3c3ceb23079796005873e107bee Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 16 Jan 2024 10:42:21 -0800 Subject: Force erc-speedbar to update on insertion * lisp/erc/erc-speedbar.el (erc-speedbar--force-update-interval-secs, erc-speedbar--last-ran): New variables. (erc-speedbar--reset-last-ran-on-timer, erc-speedbar--run-timer-on-post-insert): New functions. (erc-nickbar-mode, erc-nickbar-enable, erc-nickbar-disable): Use `erc-insert-post-hook' and `speedbar-timer-hook' to update the speedbar periodically. (Bug#63595) --- lisp/erc/erc-speedbar.el | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) (limited to 'lisp') diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index 5fcea056e3e..e3d28aa60dd 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -545,6 +545,29 @@ The INDENT level is ignored." (speedbar-set-mode-line-format)))) (defvar erc-speedbar--shutting-down-p nil) +(defvar erc-speedbar--force-update-interval-secs 5 "Speedbar update period.") + +(defvar-local erc-speedbar--last-ran nil + "When non-nil, a lisp timestamp updated when the speedbar timer runs.") + +(defun erc-speedbar--run-timer-on-post-insert () + "Refresh speedbar if idle for `erc-speedbar--force-update-interval-secs'." + (when speedbar-buffer + (with-current-buffer speedbar-buffer + (when-let + ((dframe-timer) + ((erc--check-msg-prop 'erc--cmd 'PRIVMSG)) + (interval erc-speedbar--force-update-interval-secs) + ((or (null erc-speedbar--last-ran) + (time-less-p erc-speedbar--last-ran + (time-subtract (current-time) interval))))) + (run-at-time 0 nil #'dframe-timer-fn))))) + +(defun erc-speedbar--reset-last-ran-on-timer () + "Reset `erc-speedbar--last-ran'." + (when speedbar-buffer + (setf (buffer-local-value 'erc-speedbar--last-ran speedbar-buffer) + (current-time)))) ;;;###autoload(autoload 'erc-nickbar-mode "erc-speedbar" nil t) (define-erc-module nickbar nil @@ -559,6 +582,8 @@ raising of frames or the stealing of input focus. If you witness such a thing and can reproduce it, please file a bug report with \\[erc-bug]." ((add-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure) + (add-hook 'erc-insert-post-hook #'erc-speedbar--run-timer-on-post-insert) + (add-hook 'speedbar-timer-hook #'erc-speedbar--reset-last-ran-on-timer) (erc-speedbar--ensure) (unless (or erc--updating-modules-p (and-let* ((speedbar-buffer) @@ -569,6 +594,8 @@ such a thing and can reproduce it, please file a bug report with (with-current-buffer buf (erc-speedbar--ensure 'force))))) ((remove-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure) + (remove-hook 'erc-insert-post-hook #'erc-speedbar--run-timer-on-post-insert) + (remove-hook 'speedbar-timer-hook #'erc-speedbar--reset-last-ran-on-timer) (when erc-track-mode (setq erc-track--switch-fallback-blockers (remove '(derived-mode . speedbar-mode) -- cgit v1.2.3 From d6be068ffe8c151575ea784ce508711b41cec7c5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 1 Jan 2024 06:37:25 -0800 Subject: Add replacement-text field to erc-input struct * etc/ERC-NEWS: Promote `refoldp' slot from simulated to real. Mention new `substxt' slot of `erc-input' struct. * lisp/erc/erc-common.el (erc-input): Add `substxt' and `refoldp' slots. (erc--input-split): Move `refoldp' to "superclass". * lisp/erc/erc-goodies.el (erc--command-indicator-permit-insertion): Use `substxt' field instead of overloading `insertp'. (erc--command-indicator-display): Accept extra lines for compatibility. * lisp/erc/erc.el (erc-pre-send-functions): Revise doc. (erc--input-ensure-hook-context, erc-input-refoldp): Remove unused functions, originally meant to be new in ERC 5.6. (erc--run-send-hooks): Copy data from additional fields of `erc-input' object to `erc--input-split' workspace object. (erc--send-input-lines): Handle `substxt' field of `erc-input' object when it's non-nil. (Bug#68265) --- etc/ERC-NEWS | 14 ++++++-- lisp/erc/erc-common.el | 19 +++++++++-- lisp/erc/erc-goodies.el | 7 ++-- lisp/erc/erc.el | 89 +++++++++++++++++++++++-------------------------- 4 files changed, 74 insertions(+), 55 deletions(-) (limited to 'lisp') diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index b673d36220a..f91d3fcb351 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -581,9 +581,17 @@ ERC now adjusts input lines to fall within allowed length limits before showing hook members the result. For compatibility, third-party code can request that the final input be adjusted again prior to being sent. To facilitate this, the 'erc-input' object -shared among hook members has gained a "phony" 'refoldp' slot that's -only accessible from 'erc-pre-send-functions'. See doc string for -details. +shared among hook members has gained a 'refoldp' slot. See doc string +for details. + +*** More flexibility in sending and displaying prompt input. +The abnormal hook 'erc-pre-send-functions' previously married outgoing +message text to its inserted representation in an ERC target buffer. +Going forward, users can populate the new slot 'substxt' with +alternate text to insert in place of the 'string' slot's contents, +which ERC still sends to the server. This dichotomy lets users +completely avoid the often fiddly 'erc-send-modify-hook' and friends +for use cases like language translation and subprotocol encoding. *** ERC's prompt survives the insertion of user input and messages. Previously, ERC's prompt and its input marker disappeared while diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index e39e414b290..abcdc4c8843 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -50,7 +50,23 @@ (declare-function widget-type "wid-edit" (widget)) (cl-defstruct erc-input - string insertp sendp) + "Object shared among members of `erc-pre-send-functions'. +Any use outside of the hook is not supported." + ( string "" :type string + :documentation "String to send and, without `substxt', insert. +ERC treats separate lines as separate messages.") + ( insertp nil :type boolean + :documentation "Whether to insert outgoing message. +When nil, ERC still sends `string'.") + ( sendp nil :type boolean + :documentation "Whether to send and (for compat reasons) insert. +To insert without sending, define a (slash) command.") + ( substxt nil :type (or function string null) + :documentation "Alternate string to insert without splitting. +The function form is for internal use.") + ( refoldp nil :type boolean + :documentation "Whether to resplit a possibly overlong `string'. +ERC only refolds `string', never `substxt'.")) (cl-defstruct (erc--input-split (:include erc-input (string "" :read-only t) @@ -58,7 +74,6 @@ (sendp (with-suppressed-warnings ((obsolete erc-send-this)) erc-send-this)))) - (refoldp nil :type boolean) (lines nil :type (list-of string)) (abortp nil :type (list-of symbol)) (cmdp nil :type boolean)) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index bf361ff91fb..8293994c5d4 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -583,15 +583,18 @@ Do nothing if the variable `erc-command-indicator' is nil." "Insert `erc-input' STATE's message if it's an echoed command." (cl-assert erc-command-indicator-mode) (when (erc--input-split-cmdp state) - (setf (erc--input-split-insertp state) #'erc--command-indicator-display) + (setf (erc--input-split-insertp state) t + (erc--input-split-substxt state) #'erc--command-indicator-display) (erc-send-distinguish-noncommands state))) ;; This function used to be called `erc-display-command'. It was ;; neutered in ERC 5.3.x (Emacs 24.5), commented out in 5.4, removed ;; in 5.5, and restored in 5.6. -(defun erc--command-indicator-display (line) +(defun erc--command-indicator-display (line &rest rest) "Insert command LINE as echoed input resembling that of REPLs and shells." (when erc-insert-this + (when rest + (setq line (string-join (cons line rest) "\n"))) (save-excursion (erc--assert-input-bounds) (let ((insert-position (marker-position (goto-char erc-insert-marker))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index fc6f51950e2..0da211a5f28 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1235,30 +1235,30 @@ anyway." (make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1") (defcustom erc-pre-send-functions nil - "Special hook run to possibly alter the string that is sent. -The functions are called with one argument, an `erc-input' struct, -and should alter that struct. + "Special hook to possibly alter the string to send and insert. +ERC calls the member functions with one argument, an `erc-input' +struct instance to modify as needed. -The struct has three slots: - - `string': The current input string. - `insertp': Whether the string should be inserted into the erc buffer. - `sendp': Whether the string should be sent to the irc server. - -And one \"phony\" slot only accessible by hook members at runtime: +The struct has five slots: - `refoldp': Whether the string should be re-split per protocol limits. + `string': String to send, originally from prompt input. + `insertp': Whether a string should be inserted in the buffer. + `sendp': Whether `string' should be sent to the IRC server. + `substxt': String to display (but not send) instead of `string'. + `refoldp': Whether to re-split `string' per protocol limits. This hook runs after protocol line splitting has taken place, so -the value of `string' is originally \"pre-filled\". If you need -ERC to refill the entire payload before sending it, set the phony -`refoldp' slot to a non-nil value. Note that this refilling is -only a convenience, and modules with special needs, such as -preserving \"preformatted\" text or encoding for subprotocol -\"tunneling\", should handle splitting manually." - :group 'erc - :type 'hook - :version "27.1") +the value of `string' comes \"pre-split\" according to the option +`erc-split-line-length'. If you need ERC to refill the entire +payload before sending it, set the `refoldp' slot to a non-nil +value. Note that this refilling is only a convenience, and +modules with special needs, such as preserving \"preformatted\" +text or encoding for subprotocol \"tunneling\", should handle +splitting manually and possibly also specify replacement text to +display via the `substxt' slot." + :package-version '(ERC . "5.3") + :group 'erc-hooks + :type 'hook) (define-obsolete-variable-alias 'erc--pre-send-split-functions 'erc--input-review-functions "30.1") @@ -7899,22 +7899,6 @@ When all lines are empty, remove all but the first." (setf (erc--input-split-lines state) (mapcan #'erc--split-line (erc--input-split-lines state))))) -(defun erc--input-ensure-hook-context () - (unless (erc--input-split-p erc--current-line-input-split) - (error "Invoked outside of `erc-pre-send-functions'"))) - -(defun erc-input-refoldp (_) - "Impersonate accessor for phony `erc-input' `refoldp' slot. -This function only works inside `erc-pre-send-functions' members." - (declare (gv-setter (lambda (v) - `(progn - (erc--input-ensure-hook-context) - (setf (erc--input-split-refoldp - erc--current-line-input-split) - ,v))))) - (erc--input-ensure-hook-context) - (erc--input-split-refoldp erc--current-line-input-split)) - (defun erc--run-send-hooks (lines-obj) "Run send-related hooks that operate on the entire prompt input. Sequester some of the back and forth involved in honoring old @@ -7932,12 +7916,17 @@ queue. Expect LINES-OBJ to be an `erc--input-split' object." (state (progn ;; This may change `str' and `erc-*-this'. (run-hook-with-args 'erc-send-pre-hook str) - (make-erc-input :string str - :insertp erc-insert-this - :sendp erc-send-this)))) + (make-erc-input + :string str + :insertp erc-insert-this + :sendp erc-send-this + :substxt (erc--input-split-substxt lines-obj) + :refoldp (erc--input-split-refoldp lines-obj))))) (run-hook-with-args 'erc-pre-send-functions state) (setf (erc--input-split-sendp lines-obj) (erc-input-sendp state) (erc--input-split-insertp lines-obj) (erc-input-insertp state) + (erc--input-split-substxt lines-obj) (erc-input-substxt state) + (erc--input-split-refoldp lines-obj) (erc-input-refoldp state) ;; See note in test of same name re trailing newlines. (erc--input-split-lines lines-obj) (let ((lines (split-string (erc-input-string state) @@ -7955,15 +7944,19 @@ queue. Expect LINES-OBJ to be an `erc--input-split' object." (defun erc--send-input-lines (lines-obj) "Send lines in `erc--input-split-lines' object LINES-OBJ." (when (erc--input-split-sendp lines-obj) - (dolist (line (erc--input-split-lines lines-obj)) - (when (erc--input-split-insertp lines-obj) - (if (eq (erc--input-split-insertp lines-obj) - 'erc--command-indicator-display) - (funcall (erc--input-split-insertp lines-obj) line) - (erc-display-msg line))) - (erc-process-input-line (concat line "\n") - (null erc-flood-protect) - (not (erc--input-split-cmdp lines-obj)))))) + (let ((insertp (erc--input-split-insertp lines-obj)) + (substxt (erc--input-split-substxt lines-obj))) + (when (and insertp substxt) + (setq insertp nil) + (if (functionp substxt) + (apply substxt (erc--input-split-lines lines-obj)) + (erc-display-msg substxt))) + (dolist (line (erc--input-split-lines lines-obj)) + (when insertp + (erc-display-msg line)) + (erc-process-input-line (concat line "\n") + (null erc-flood-protect) + (not (erc--input-split-cmdp lines-obj))))))) (defun erc-send-input (input &optional skip-ws-chk) "Treat INPUT as typed in by the user. -- cgit v1.2.3 From 1ba8d1c43702cf8ddd5d7159401d7b3ebc51f4fe Mon Sep 17 00:00:00 2001 From: Corwin Brust Date: Fri, 19 Jan 2024 23:51:36 -0600 Subject: Add more erc-message-type choices * lisp/erc/erc.el (erc-message-type): Add more of the possible IRC message types to customize widget for `erc-*hide-list'. New options have tags informed by these descriptions: https://modern.ircdocs.horse/#numerics (Bug#68601) --- lisp/erc/erc.el | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'lisp') diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 0da211a5f28..edac1060c3e 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -386,6 +386,16 @@ If nil, only \"> \" will be shown." (const "PART") (const "QUIT") (const "MODE") + (const :tag "Away notices (RPL_AWAY 301)" "301") + (const :tag "Self back notice (REP_UNAWAY 305)" "305") + (const :tag "Self away notice (REP_NOWAWAY 306)" "306") + (const :tag "Channel modes on join (RPL_CHANNELMODEIS 324)" "324") + (const :tag "Channel creation time (RPL_CREATIONTIME 329)" "329") + (const :tag "Channel no-topic on join (RPL_NOTOPIC 331)" "331") + (const :tag "Channel topic on join (RPL_TOPIC 332)" "332") + (const :tag "Topic author and time on join (RPL_TOPICWHOTIME 333)" "333") + (const :tag "Invitation success notice (RPL_INVITING 341)" "341") + (const :tag "Channel member names (353 RPL_NAMEREPLY)" "353") (repeat :inline t :tag "Others" (string :tag "IRC Message Type")))) (defcustom erc-hide-list nil -- cgit v1.2.3 From 28c9c7cf464c87e90567f8b0e04f854163aa6187 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Wed, 24 Jan 2024 10:52:40 -0500 Subject: Fix next-line-completion for multi-line completions Previously it would not move out of a multi-line completion, and now it will. * lisp/simple.el (next-line-completion): Move to the completion start or end before going forward or backward lines. (bug#68688) --- lisp/simple.el | 20 +++++++++++++++++--- test/lisp/minibuffer-tests.el | 14 ++++++++++++++ 2 files changed, 31 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/simple.el b/lisp/simple.el index 692c0dacefc..4ffe159dc88 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -9940,6 +9940,20 @@ Also see the `completion-auto-wrap' variable." (interactive "p") (next-completion (- n))) +(defun completion--move-to-candidate-start () + "If in a completion candidate, move point to its start." + (when (and (get-text-property (point) 'mouse-face) + (not (bobp)) + (get-text-property (1- (point)) 'mouse-face)) + (goto-char (previous-single-property-change (point) 'mouse-face)))) + +(defun completion--move-to-candidate-end () + "If in a completion candidate, move point to its end." + (when (and (get-text-property (point) 'mouse-face) + (not (eobp)) + (get-text-property (1+ (point)) 'mouse-face)) + (goto-char (or (next-single-property-change (point) 'mouse-face) (point-max))))) + (defun next-completion (n) "Move to the next item in the completions buffer. With prefix argument N, move N items (negative N means move @@ -10029,9 +10043,7 @@ Also see the `completion-auto-wrap' variable." (if (get-text-property (point) 'mouse-face) ;; If in a completion, move to the start of it. - (when (and (not (bobp)) - (get-text-property (1- (point)) 'mouse-face)) - (goto-char (previous-single-property-change (point) 'mouse-face))) + (completion--move-to-candidate-start) ;; Try to move to the previous completion. (setq pos (previous-single-property-change (point) 'mouse-face)) (if pos @@ -10046,6 +10058,7 @@ Also see the `completion-auto-wrap' variable." (while (> n 0) (setq found nil pos nil column (current-column) line (line-number-at-pos)) + (completion--move-to-candidate-end) (while (and (not found) (eq (forward-line 1) 0) (not (eobp)) @@ -10070,6 +10083,7 @@ Also see the `completion-auto-wrap' variable." (while (< n 0) (setq found nil pos nil column (current-column) line (line-number-at-pos)) + (completion--move-to-candidate-start) (while (and (not found) (eq (forward-line -1) 0) (eq (move-to-column column) column)) diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index c1fe3032cb5..d104858b0d0 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -465,6 +465,20 @@ (previous-line-completion 4) (should (equal "ac" (get-text-property (point) 'completion--string)))))) +(ert-deftest completion-next-line-multline-test () + (let ((completion-auto-wrap t)) + (completing-read-with-minibuffer-setup + '("a\na" "a\nb" "ac") + (insert "a") + (minibuffer-completion-help) + (switch-to-completions) + (goto-char (point-min)) + (next-line-completion 5) + (should (equal "a\nb" (get-text-property (point) 'completion--string))) + (goto-char (point-min)) + (previous-line-completion 5) + (should (equal "a\nb" (get-text-property (point) 'completion--string)))))) + (ert-deftest completions-header-format-test () (let ((completion-show-help nil) (completions-header-format nil)) -- cgit v1.2.3 From b5d36efa5777e4cc6db1067d58224d676cedbdd3 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Wed, 24 Jan 2024 11:10:40 -0500 Subject: Update minibuffer-show-help based on minibuffer-visible-completions minibuffer-visible-completions makes some more convenient bindings available, but the help shown by minibuffer-show-help wasn't suggesting them. Now it is. * lisp/simple.el (completion-setup-function): Change help text when minibuffer-visible-completions is non-nil. (bug#68689) --- lisp/simple.el | 28 +++++++++++++++++++++------- 1 file changed, 21 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/simple.el b/lisp/simple.el index 4ffe159dc88..1157bd578fd 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10335,13 +10335,27 @@ Called from `temp-buffer-show-hook'." ;; Maybe insert help string. (when completion-show-help (goto-char (point-min)) - (insert (substitute-command-keys - (if (display-mouse-p) - "Click or type \\[minibuffer-choose-completion] on a completion to select it.\n" - "Type \\[minibuffer-choose-completion] on a completion to select it.\n"))) - (insert (substitute-command-keys - "Type \\[minibuffer-next-completion] or \\[minibuffer-previous-completion] \ -to move point between completions.\n\n")))))) + (if minibuffer-visible-completions + (let ((helps + (with-current-buffer (window-buffer (active-minibuffer-window)) + (list + (substitute-command-keys + (if (display-mouse-p) + "Click or type \\[minibuffer-choose-completion-or-exit] on a completion to select it.\n" + "Type \\[minibuffer-choose-completion-or-exit] on a completion to select it.\n")) + (substitute-command-keys + "Type \\[minibuffer-next-completion], \\[minibuffer-previous-completion], \ +\\[minibuffer-next-line-completion], \\[minibuffer-previous-line-completion] \ +to move point between completions.\n\n"))))) + (dolist (help helps) + (insert help))) + (insert (substitute-command-keys + (if (display-mouse-p) + "Click or type \\[minibuffer-choose-completion] on a completion to select it.\n" + "Type \\[minibuffer-choose-completion] on a completion to select it.\n"))) + (insert (substitute-command-keys + "Type \\[minibuffer-next-completion] or \\[minibuffer-previous-completion] \ +to move point between completions.\n\n"))))))) (add-hook 'completion-setup-hook #'completion-setup-function) -- cgit v1.2.3 From 5d88c98e7c101ebad68b562334020b8c082c2ca5 Mon Sep 17 00:00:00 2001 From: João Távora Date: Thu, 25 Jan 2024 12:10:40 +0000 Subject: Eglot: fix bug introduced when "fixing" middle-of-symbol completions MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Culprit: commit a6ef458e3831001b0acad57cf8fa75b77a4aff3f Author: João Távora Date: Tue Dec 26 00:31:29 2023 +0000 Eglot: partial fix for middle-of-symbol completions The decision to restore the buffer state to when the last LSP completion set was invoked is rock-solid (because that the state those completions' edits apply to). However, when caching the LSP completions across multiple eglot-completion-at-point calls, we must make sure to also restore the values of the local values, such as 'bounds-string'. This allows us to do that restoration. * lisp/progmodes/eglot.el (eglot-completion-at-point): Also restore bounds-string from capf session cache. Github-reference: https://github.com/joaotavora/eglot/issues/1349 --- lisp/progmodes/eglot.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index c5fbf5eb9d5..f8d96051606 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -3125,7 +3125,8 @@ for which LSP on-type-formatting should be requested." items))) ;; (trace-values "Requested" (length proxies) cachep bounds) (setq eglot--capf-session - (if cachep (list bounds retval resolved orig-pos) :none)) + (if cachep (list bounds retval resolved orig-pos + bounds-string) :none)) (setq local-cache retval))))) (resolve-maybe ;; Maybe completion/resolve JSON object `lsp-comp' into @@ -3145,7 +3146,8 @@ for which LSP on-type-formatting should be requested." (>= (cdr bounds) (cdr (nth 0 eglot--capf-session)))) (setq local-cache (nth 1 eglot--capf-session) resolved (nth 2 eglot--capf-session) - orig-pos (nth 3 eglot--capf-session)) + orig-pos (nth 3 eglot--capf-session) + bounds-string (nth 4 eglot--capf-session)) ;; (trace-values "Recalling cache" (length local-cache) bounds orig-pos) ) (list -- cgit v1.2.3 From b014bca833a17f5b2258e88115f03cffa983d0bd Mon Sep 17 00:00:00 2001 From: João Távora Date: Thu, 25 Jan 2024 12:18:58 +0000 Subject: Eglot: bump to 1.17 * etc/EGLOT-NEWS: Update. * lisp/progmodes/eglot.el (Version): Bump to 1.17 (Package-Requires): Bump jsonrpc depedency to 1.24 --- etc/EGLOT-NEWS | 13 +++++++++++++ lisp/progmodes/eglot.el | 4 ++-- 2 files changed, 15 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 1f913f81236..12e7d3f6b9b 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -20,6 +20,19 @@ https://github.com/joaotavora/eglot/issues/1234. * Changes in upcoming Eglot + +* Changes in Eglot 1.17 (25/1/2024) + +** Fixes to completion (github#847, github#1349) + +** Fix code-action gathering for some servers (github#847) + +** Experimental support for Eglot-only subprojects + +Until project.el's support for subprojects improves, github#1337 +describes a reasonably sane way to configure nested sub-projects +within a larger one just for Eglot purposes. + * Changes in Eglot 1.16 (27/12/2023) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index f8d96051606..40837074573 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2,12 +2,12 @@ ;; Copyright (C) 2018-2024 Free Software Foundation, Inc. -;; Version: 1.16 +;; Version: 1.17 ;; Author: João Távora ;; Maintainer: João Távora ;; URL: https://github.com/joaotavora/eglot ;; Keywords: convenience, languages -;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.23") (flymake "1.2.1") (project "0.9.8") (xref "1.6.2") (eldoc "1.14.0") (seq "2.23") (external-completion "0.1")) +;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.24") (flymake "1.2.1") (project "0.9.8") (xref "1.6.2") (eldoc "1.14.0") (seq "2.23") (external-completion "0.1")) ;; This is a GNU ELPA :core package. Avoid adding functionality ;; that is not available in the version of Emacs recorded above or any -- cgit v1.2.3 From b07265f8eed74dda792e13062baae94319484b4b Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 25 Jan 2024 19:38:03 +0200 Subject: * lisp/dired.el (dired--move-to-next-line): Improve to avoid an infinite loop. An infinite loop is possible in a directory without files and subdirectories, where even lines with . and .. are omitted, so 'dired-between-files' is true for all Dired lines. For the case of dired-movement-style=cycle a guard is triggered when the loop wraps twice while the value 'arg' is not changing. And for the case of dired-movement-style=bounded a guard is triggered when point doesn't move while trying to go back to the last non-empty line. --- lisp/dired.el | 29 +++++++++++++++++++++-------- 1 file changed, 21 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/dired.el b/lisp/dired.el index 69fa15dde73..cef93ab757c 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2817,7 +2817,9 @@ is controlled by `dired-movement-style'." (dired--trivial-next-line arg))) (defun dired--move-to-next-line (arg jumpfun) - (let ((old-position (progn + (let ((wrapped nil) + (old-arg arg) + (old-position (progn ;; It's always true that we should move ;; to the filename when possible. (dired-move-to-filename) @@ -2832,16 +2834,27 @@ is controlled by `dired-movement-style'." (when (= old-position (point)) ;; Now point is at beginning/end of movable area, ;; but it still wants to move farther. - (if (eq dired-movement-style 'cycle) - ;; `cycle': go to the other end. + (cond + ;; `cycle': go to the other end. + ((eq dired-movement-style 'cycle) + ;; Argument not changing on the second wrap + ;; means infinite loop with no files found. + (if (and wrapped (eq old-arg arg)) + (setq arg 0) (goto-char (if (cl-plusp moving-down) (point-min) - (point-max))) - ;; `bounded': go back to the last non-empty line. - (while (dired-between-files) - (funcall jumpfun (- moving-down))) + (point-max)))) + (setq wrapped t)) + ;; `bounded': go back to the last non-empty line. + ((eq dired-movement-style 'bounded) + (while (and (dired-between-files) (not (zerop arg))) + (funcall jumpfun (- moving-down)) + ;; Point not moving means infinite loop. + (if (= old-position (point)) + (setq arg 0) + (setq old-position (point)))) ;; Encountered a boundary, so let's stop movement. - (setq arg moving-down))) + (setq arg (if (dired-between-files) 0 moving-down))))) (unless (dired-between-files) ;; Has moved to a non-empty line. This movement does ;; make sense. -- cgit v1.2.3 From d22a3e5afe75c9f4a18926cce16c1a13fa912df2 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 25 Jan 2024 19:52:08 +0200 Subject: * lisp/simple.el (next-line-completion): Better handing of group lines. Simplify to not compare the result of 'move-to-column' with the value 'column'. Such comparison prevented from moving over lines without completion candidates such as group lines (bug#68688). * test/lisp/minibuffer-tests.el (completions-group-navigation-test): Add more group candidates to create more columns and to test moving over group lines and over columns without candidates. --- lisp/simple.el | 4 +-- test/lisp/minibuffer-tests.el | 64 +++++++++++++++++++++++++++++++------------ 2 files changed, 48 insertions(+), 20 deletions(-) (limited to 'lisp') diff --git a/lisp/simple.el b/lisp/simple.el index 1157bd578fd..8246b9cab81 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10062,7 +10062,7 @@ Also see the `completion-auto-wrap' variable." (while (and (not found) (eq (forward-line 1) 0) (not (eobp)) - (eq (move-to-column column) column)) + (move-to-column column)) (when (get-text-property (point) 'mouse-face) (setq found t))) (when (not found) @@ -10086,7 +10086,7 @@ Also see the `completion-auto-wrap' variable." (completion--move-to-candidate-start) (while (and (not found) (eq (forward-line -1) 0) - (eq (move-to-column column) column)) + (move-to-column column)) (when (get-text-property (point) 'mouse-face) (setq found t))) (when (not found) diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index d104858b0d0..07c4dbc3197 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -565,35 +565,63 @@ (if transform name (pcase name - (`"aa" "Group 1") - (`"ab" "Group 2") - (`"ac" "Group 3"))))) + (`"aa1" "Group 1") + (`"aa2" "Group 1") + (`"aa3" "Group 1") + (`"aa4" "Group 1") + (`"ab1" "Group 2") + (`"ac1" "Group 3") + (`"ac2" "Group 3"))))) (category . unicode-name)) - (complete-with-action action '("aa" "ab" "ac") string pred))) + (complete-with-action action '("aa1" "aa2" "aa3" "aa4" "ab1" "ac1" "ac2") + string pred))) (insert "a") (minibuffer-completion-help) (switch-to-completions) - (should (equal "aa" (get-text-property (point) 'completion--string))) + (should (equal "aa1" (get-text-property (point) 'completion--string))) (let ((completion-auto-wrap t)) - (next-completion 3)) - (should (equal "aa" (get-text-property (point) 'completion--string))) + (next-completion 7)) + (should (equal "aa1" (get-text-property (point) 'completion--string))) (let ((completion-auto-wrap nil)) - (next-completion 3)) - (should (equal "ac" (get-text-property (point) 'completion--string))) + (next-completion 7)) + (should (equal "ac2" (get-text-property (point) 'completion--string))) - (first-completion) (let ((completion-auto-wrap t)) + ;; First column + (first-completion) (next-line-completion 1) - (should (equal "ab" (get-text-property (point) 'completion--string))) - (next-line-completion 2) - (should (equal "aa" (get-text-property (point) 'completion--string))) + (should (equal "aa4" (get-text-property (point) 'completion--string))) + (next-line-completion 3) + (should (equal "aa1" (get-text-property (point) 'completion--string))) (previous-line-completion 2) - (should (equal "ab" (get-text-property (point) 'completion--string)))) + (should (equal "ab1" (get-text-property (point) 'completion--string))) + + ;; Second column + (first-completion) + (next-completion 1) + (should (equal "aa2" (get-text-property (point) 'completion--string))) + (next-line-completion 1) + (should (equal "ac2" (get-text-property (point) 'completion--string))) + (next-line-completion 1) + (should (equal "aa2" (get-text-property (point) 'completion--string))) + (previous-line-completion 1) + (should (equal "ac2" (get-text-property (point) 'completion--string))) + (previous-line-completion 1) + (should (equal "aa2" (get-text-property (point) 'completion--string))) + + ;; Third column + (first-completion) + (next-completion 2) + (should (equal "aa3" (get-text-property (point) 'completion--string))) + (next-line-completion 1) + (should (equal "aa3" (get-text-property (point) 'completion--string)))) + (let ((completion-auto-wrap nil)) - (next-line-completion 3) - (should (equal "ac" (get-text-property (point) 'completion--string))) - (previous-line-completion 3) - (should (equal "aa" (get-text-property (point) 'completion--string)))))) + (first-completion) + (next-line-completion 7) + (should (equal "ac2" (get-text-property (point) 'completion--string))) + (previous-line-completion 7) + (should (equal "aa1" (get-text-property (point) 'completion--string)))))) (provide 'minibuffer-tests) ;;; minibuffer-tests.el ends here -- cgit v1.2.3 From 4e260bfc47e5b507df1db218f49729fbae91900c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 25 Jan 2024 14:24:20 -0500 Subject: * lisp/emacs-lisp/cl-generic.el (cl--generic-compiler): Clarify the test Use `compiled-function-p`. --- lisp/emacs-lisp/cl-generic.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 48f5c06e390..bdccdcc48ce 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -672,7 +672,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined ;; compiled. Otherwise the byte-compiler and all the code on ;; which it depends needs to be usable before cl-generic is loaded, ;; which imposes a significant burden on the bootstrap. - (if (consp (lambda (x) (+ x 1))) + (if (not (compiled-function-p (lambda (x) (+ x 1)))) (lambda (exp) (eval exp t)) ;; But do byte-compile the dispatchers once bootstrap is passed: ;; the performance difference is substantial (like a 5x speedup on -- cgit v1.2.3 From 22a58fccb763da6ec52f4bea98f91647b71ee1f0 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Fri, 26 Jan 2024 02:52:35 +0200 Subject: project--read-project-list: Handle corrupted file contents * lisp/progmodes/project.el (project--read-project-list): Handle the 'end-of-file' error (bug#68546). --- lisp/progmodes/project.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index ab4504fa027..da782ad5537 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1707,7 +1707,10 @@ With some possible metadata (to be decided).") (let ((name (car elem))) (list (if (file-remote-p name) name (abbreviate-file-name name))))) - (read (current-buffer)))))) + (condition-case nil + (read (current-buffer)) + (end-of-file + (warn "Failed to read the projects list file due to unexpected EOF"))))))) (unless (seq-every-p (lambda (elt) (stringp (car-safe elt))) project--list) -- cgit v1.2.3 From 737d46e04d73dbad84bf0225cebb1c936ff89365 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Fri, 26 Jan 2024 03:00:04 +0200 Subject: python--treesit-syntax-propertize: Fix edits in the middle * lisp/progmodes/python.el (python--treesit-syntax-propertize): Process the beginning and the end of the triple-quoted string's delimiters separately. Among other things, that still works when the beginning is outside of the propertized region (bug#68445). --- lisp/progmodes/python.el | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index e2f614f52c2..41f612c8b1c 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1359,15 +1359,15 @@ For NODE, OVERRIDE, START, END, and ARGS, see (save-excursion (goto-char start) (while (re-search-forward (rx (or "\"\"\"" "'''")) end t) - (let ((node (treesit-node-at (point)))) - ;; The triple quotes surround a non-empty string. - (when (equal (treesit-node-type node) "string_content") - (let ((start (treesit-node-start node)) - (end (treesit-node-end node))) - (put-text-property (1- start) start - 'syntax-table (string-to-syntax "|")) - (put-text-property end (min (1+ end) (point-max)) - 'syntax-table (string-to-syntax "|")))))))) + (let ((node (treesit-node-at (- (point) 3)))) + ;; Handle triple-quoted strings. + (pcase (treesit-node-type node) + ("string_start" + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax "|"))) + ("string_end" + (put-text-property (- (point) 3) (- (point) 2) + 'syntax-table (string-to-syntax "|")))))))) ;;; Indentation -- cgit v1.2.3 From 4834be0949e13a728b69ab97ac9c8a0dbec65f3a Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Thu, 25 Jan 2024 17:12:28 -0800 Subject: ; For compatibility, eshell/make should print to Eshell unless backgrounded * lisp/eshell/em-unix.el (eshell/make): Pass 'plain' to eshell-compile when in the foreground (bug#68724). --- lisp/eshell/em-unix.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 75afaf1c104..b066e9eeb8e 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -741,7 +741,7 @@ Fallback to standard make when called synchronously." (eshell-compile "make" args ;; Use plain output unless we're executing in the ;; background. - (not eshell-current-subjob-p))) + (unless eshell-current-subjob-p 'plain))) (put 'eshell/make 'eshell-no-numeric-conversions t) -- cgit v1.2.3 From 65829b27ca4898ff0905a8124980243977a1382f Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Thu, 25 Jan 2024 17:54:13 -0800 Subject: Improve handling of local variable settings in Eshell This ensures that these commands work the same as normal commands, aside from making environment variable settings local to that command. Among other things, this means that "VAR=value cd dir/" now changes the directory correctly. * lisp/eshell/esh-var.el (eshell-in-local-scope-p) (eshell-local-variable-bindings): New variables. (eshell-var-initialize, eshell-set-variable): Use 'eshell-local-variable-bindings'. (eshell-handle-local-variables): Don't use 'eshell-as-subcommand'. * test/lisp/eshell/esh-var-tests.el (esh-var-test/local-variables/cd): New test. --- lisp/eshell/esh-var.el | 57 +++++++++++++++++++++------------------ test/lisp/eshell/esh-var-tests.el | 8 ++++++ 2 files changed, 39 insertions(+), 26 deletions(-) (limited to 'lisp') diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index ae0b18cd13a..1d90fbdd8ee 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -255,6 +255,20 @@ copied (a.k.a. \"exported\") to the environment of created subprocesses." (defvar-keymap eshell-var-mode-map "C-c M-v" #'eshell-insert-envvar) +;;; Internal Variables: + +(defvar eshell-in-local-scope-p nil + "Non-nil if the current command has a local variable scope. +This is set to t in `eshell-local-variable-bindings' (which see).") + +(defvar eshell-local-variable-bindings + '((eshell-in-local-scope-p t) + (process-environment (eshell-copy-environment)) + (eshell-variable-aliases-list eshell-variable-aliases-list) + (eshell-path-env-list eshell-path-env-list) + (comint-pager comint-pager)) + "A list of `let' bindings for local variable (and subcommand) environments.") + ;;; Functions: (define-minor-mode eshell-var-mode @@ -271,12 +285,8 @@ copied (a.k.a. \"exported\") to the environment of created subprocesses." (setq-local process-environment (eshell-copy-environment))) (make-local-variable 'comint-pager) (setq-local eshell-subcommand-bindings - (append - '((process-environment (eshell-copy-environment)) - (eshell-variable-aliases-list eshell-variable-aliases-list) - (eshell-path-env-list eshell-path-env-list) - (comint-pager comint-pager)) - eshell-subcommand-bindings)) + (append eshell-local-variable-bindings + eshell-subcommand-bindings)) (setq-local eshell-special-chars-inside-quoting (append eshell-special-chars-inside-quoting '(?$))) @@ -296,30 +306,25 @@ copied (a.k.a. \"exported\") to the environment of created subprocesses." (defun eshell-handle-local-variables () "Allow for the syntax `VAR=val '." - ;; Eshell handles local variable settings (e.g. 'CFLAGS=-O2 make') - ;; by making the whole command into a subcommand, and calling - ;; `eshell-set-variable' immediately before the command is invoked. - ;; This means that 'FOO=x cd bar' won't work exactly as expected, - ;; but that is by no means a typical use of local environment - ;; variables. + ;; Handle local variable settings by let-binding the entries in + ;; `eshell-local-variable-bindings' and calling `eshell-set-variable' + ;; for each variable before the command is invoked. (let ((setvar "\\`\\([A-Za-z_][A-Za-z0-9_]*\\)=\\(.*\\)\\'") (command eshell-last-command-name) (args eshell-last-arguments)) (when (and (stringp command) (string-match setvar command)) (throw 'eshell-replace-command - `(eshell-as-subcommand - (progn - ,@(let (locals) - (while (and (stringp command) - (string-match setvar command)) - (push `(eshell-set-variable - ,(match-string 1 command) - ,(match-string 2 command)) - locals) - (setq command (pop args))) - (nreverse locals)) - (eshell-named-command ,command ,(list 'quote args))) - ))))) + `(let ,eshell-local-variable-bindings + ,@(let (locals) + (while (and (stringp command) + (string-match setvar command)) + (push `(eshell-set-variable + ,(match-string 1 command) + ,(match-string 2 command)) + locals) + (setq command (pop args))) + (nreverse locals)) + (eshell-named-command ,command ,(list 'quote args))))))) (defun eshell-interpolate-variable () "Parse a variable interpolation. @@ -709,7 +714,7 @@ to a Lisp variable)." ((functionp target) (funcall target nil value)) ((null target) - (unless eshell-in-subcommand-p + (unless eshell-in-local-scope-p (error "Variable `%s' is not settable" (eshell-stringify name))) (push `(,name ,(lambda () value) t t) eshell-variable-aliases-list) diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el index 39c278a6277..bb3d18abf6d 100644 --- a/test/lisp/eshell/esh-var-tests.el +++ b/test/lisp/eshell/esh-var-tests.el @@ -653,6 +653,14 @@ nil, use FUNCTION instead." "VAR=hello\n") (should (equal (getenv "VAR") "value")))) +(ert-deftest esh-var-test/local-variables/cd () + "Test that \"VAR=value cd DIR\" properly changes the directory." + (let ((parent-directory (file-name-directory + (directory-file-name default-directory)))) + (with-temp-eshell + (eshell-insert-command "VAR=hello cd ..") + (should (equal default-directory parent-directory))))) + ;; Variable aliases -- cgit v1.2.3 From 723b0973512c0e6e9fb0f07678124347ccd44b54 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Thu, 25 Jan 2024 20:58:34 -0800 Subject: Add support for running commands via Eshell's "env" command * (eshell-handle-local-variables): Move most of the code to... (eshell-parse-local-variables): ... here. (eshell/env): Call 'eshell-parse-local-variables'. * test/lisp/eshell/esh-var-tests.el (esh-var-test/local-variables/env): New test. * doc/misc/eshell.texi (Built-ins): Describe the new behavior. * etc/NEWS: Announce this change. --- doc/misc/eshell.texi | 8 ++++--- etc/NEWS | 7 ++++++ lisp/eshell/esh-var.el | 50 ++++++++++++++++++++++++--------------- test/lisp/eshell/esh-var-tests.el | 7 ++++++ 4 files changed, 50 insertions(+), 22 deletions(-) (limited to 'lisp') diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index fb9a563b696..da5e1ef1d03 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -624,9 +624,11 @@ each argument as a string, separated by a space. @item env @cmindex env -Prints the current environment variables. Unlike in Bash, this -command does not yet support running commands with a modified -environment. +With no arguments, print the current environment variables. If you +pass arguments to this command, then @command{env} will execute the +arguments as a command. If you pass any initial arguments of the form +@samp{@var{var}=@var{value}}, @command{env} will first set @var{var} +to @var{value} before running the command. @item eshell-debug @cmindex eshell-debug diff --git a/etc/NEWS b/etc/NEWS index 0d7d7d5ab60..37264f2f1f1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -656,6 +656,13 @@ appropriate, but still allow piping the output elsewhere if desired. For more information, see the "(eshell) Built-ins" node in the Eshell manual. ++++ +*** Eshell's 'env' command now supports running commands. +Like in many other shells, Eshell's 'env' command now lets you run a +command passed as arguments to 'env'. If you pass any initial +arguments of the form 'VAR=VALUE', 'env' will first set 'VAR' to +'VALUE' before running the command. + +++ *** New special reference type '#'. This special reference type returns a marker at 'POSITION' in diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 1d90fbdd8ee..627cbb17797 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -304,27 +304,36 @@ This is set to t in `eshell-local-variable-bindings' (which see).") (add-hook 'pcomplete-try-first-hook #'eshell-complete-variable-assignment nil t))) -(defun eshell-handle-local-variables () - "Allow for the syntax `VAR=val '." +(defun eshell-parse-local-variables (args) + "Parse a list of ARGS, looking for variable assignments. +Variable assignments are of the form \"VAR=value\". If ARGS +begins with any such assignments, throw `eshell-replace-command' +with a form that will temporarily set those variables. +Otherwise, return nil." ;; Handle local variable settings by let-binding the entries in ;; `eshell-local-variable-bindings' and calling `eshell-set-variable' ;; for each variable before the command is invoked. (let ((setvar "\\`\\([A-Za-z_][A-Za-z0-9_]*\\)=\\(.*\\)\\'") - (command eshell-last-command-name) - (args eshell-last-arguments)) - (when (and (stringp command) (string-match setvar command)) + (head (car args)) + (rest (cdr args))) + (when (and (stringp head) (string-match setvar head)) (throw 'eshell-replace-command `(let ,eshell-local-variable-bindings ,@(let (locals) - (while (and (stringp command) - (string-match setvar command)) + (while (and (stringp head) + (string-match setvar head)) (push `(eshell-set-variable - ,(match-string 1 command) - ,(match-string 2 command)) + ,(match-string 1 head) + ,(match-string 2 head)) locals) - (setq command (pop args))) + (setq head (pop rest))) (nreverse locals)) - (eshell-named-command ,command ,(list 'quote args))))))) + (eshell-named-command ,head ',rest)))))) + +(defun eshell-handle-local-variables () + "Allow for the syntax `VAR=val '." + (eshell-parse-local-variables (cons eshell-last-command-name + eshell-last-arguments))) (defun eshell-interpolate-variable () "Parse a variable interpolation. @@ -414,19 +423,22 @@ the values of nil for each." obarray #'boundp)) (pcomplete-here)))) -;; FIXME the real "env" command does more than this, it runs a program -;; in a modified environment. (defun eshell/env (&rest args) "Implementation of `env' in Lisp." - (eshell-init-print-buffer) (eshell-eval-using-options "env" args - '((?h "help" nil nil "show this usage screen") + '(;; FIXME: Support more "env" options, like "--unset". + (?h "help" nil nil "show this usage screen") :external "env" - :usage "") - (dolist (setting (sort (eshell-environment-variables) 'string-lessp)) - (eshell-buffered-print setting "\n")) - (eshell-flush))) + :parse-leading-options-only + :usage "[NAME=VALUE]... [COMMAND [ARG]...]") + (if args + (or (eshell-parse-local-variables args) + (eshell-named-command (car args) (cdr args))) + (eshell-init-print-buffer) + (dolist (setting (sort (eshell-environment-variables) 'string-lessp)) + (eshell-buffered-print setting "\n")) + (eshell-flush)))) (defun eshell-insert-envvar (envvar-name) "Insert ENVVAR-NAME into the current buffer at point." diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el index bb3d18abf6d..b94e8a276d7 100644 --- a/test/lisp/eshell/esh-var-tests.el +++ b/test/lisp/eshell/esh-var-tests.el @@ -661,6 +661,13 @@ nil, use FUNCTION instead." (eshell-insert-command "VAR=hello cd ..") (should (equal default-directory parent-directory))))) +(ert-deftest esh-var-test/local-variables/env () + "Test that \"env VAR=value command\" temporarily sets variables." + (with-temp-eshell + (push "VAR=value" process-environment) + (eshell-match-command-output "env VAR=hello env" "VAR=hello\n") + (should (equal (getenv "VAR") "value")))) + ;; Variable aliases -- cgit v1.2.3 From 047607f6e611709f89f6c93ae0e2fc97b25bf18f Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Fri, 26 Jan 2024 10:17:19 -0800 Subject: Fix detection of directly-invokable commands in Eshell I think this regressed partly due to eef32d13da58, so let's add some regression tests to make sure that doesn't happen again. * lisp/eshell/em-unix.el (eshell-unix-initialize): Add "compile". * lisp/eshell/esh-cmd.el (eshell--find-subcommands): Yield the second element of the subcommand. (eshell--invoke-command-directly-p): Rename and account for 'eshell-with-copied-handles'. (eshell-invoke-directly): Rename to... (eshell-invoke-directly-p): ... this, and use 'pcase' to make the logic clearer. * lisp/eshell/esh-mode.el (eshell-send-input): Always queue input if the process is running; rename some locals to be clearer. * lisp/eshell/esh-var.el (eshell-var-initialize): Add "env" as a complex command. * test/lisp/eshell/esh-cmd-tests.el (esh-cmd-test--deftest-invoke-directly): New macro. (no-args, with-args, multiple-cmds, subcmd, complex, complex-subcmd): New test cases. --- lisp/eshell/em-unix.el | 6 ++--- lisp/eshell/esh-cmd.el | 54 +++++++++++++++++++++------------------ lisp/eshell/esh-mode.el | 17 ++++++------ lisp/eshell/esh-var.el | 2 ++ test/lisp/eshell/esh-cmd-tests.el | 20 +++++++++++++++ 5 files changed, 63 insertions(+), 36 deletions(-) (limited to 'lisp') diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index b066e9eeb8e..dad02206759 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -166,9 +166,9 @@ Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine." (add-hook 'pcomplete-try-first-hook 'eshell-complete-host-reference nil t)) (setq-local eshell-complex-commands - (append '("grep" "egrep" "fgrep" "agrep" "rgrep" - "glimpse" "locate" "cat" "time" "cp" "mv" - "make" "du" "diff") + (append '("compile" "grep" "egrep" "fgrep" "agrep" + "rgrep" "glimpse" "locate" "cat" "time" "cp" + "mv" "make" "du" "diff") eshell-complex-commands))) (defalias 'eshell/date 'current-time-string) diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 2746800ea78..30494bafb48 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -934,48 +934,52 @@ This yields the SUBCOMMANDs when found in forms like (dolist (elem haystack) (cond ((eq (car-safe elem) 'eshell-as-subcommand) - (iter-yield (cdr elem))) + (iter-yield (cadr elem))) ((listp elem) (iter-yield-from (eshell--find-subcommands elem)))))) -(defun eshell--invoke-command-directly (command) +(defun eshell--invoke-command-directly-p (command) "Determine whether the given COMMAND can be invoked directly. COMMAND should be a non-top-level Eshell command in parsed form. A command can be invoked directly if all of the following are true: * The command is of the form - \"(eshell-trap-errors (eshell-named-command NAME ARGS))\", - where ARGS is optional. + (eshell-with-copied-handles + (eshell-trap-errors (eshell-named-command NAME [ARGS])) _). * NAME is a string referring to an alias function and isn't a complex command (see `eshell-complex-commands'). * Any subcommands in ARGS can also be invoked directly." - (when (and (eq (car command) 'eshell-trap-errors) - (eq (car (cadr command)) 'eshell-named-command)) - (let ((name (cadr (cadr command))) - (args (cdr-safe (nth 2 (cadr command))))) - (and name (stringp name) - (not (member name eshell-complex-commands)) - (catch 'simple - (dolist (pred eshell-complex-commands t) - (when (and (functionp pred) - (funcall pred name)) - (throw 'simple nil)))) - (eshell-find-alias-function name) - (catch 'indirect-subcommand - (iter-do (subcommand (eshell--find-subcommands args)) - (unless (eshell--invoke-command-directly subcommand) - (throw 'indirect-subcommand nil))) - t))))) - -(defun eshell-invoke-directly (command) + (pcase command + (`(eshell-with-copied-handles + (eshell-trap-errors (eshell-named-command ,name . ,args)) + ,_) + (and name (stringp name) + (not (member name eshell-complex-commands)) + (catch 'simple + (dolist (pred eshell-complex-commands t) + (when (and (functionp pred) + (funcall pred name)) + (throw 'simple nil)))) + (eshell-find-alias-function name) + (catch 'indirect-subcommand + (iter-do (subcommand (eshell--find-subcommands (car args))) + (unless (eshell--invoke-command-directly-p subcommand) + (throw 'indirect-subcommand nil))) + t))))) + +(defun eshell-invoke-directly-p (command) "Determine whether the given COMMAND can be invoked directly. COMMAND should be a top-level Eshell command in parsed form, as produced by `eshell-parse-command'." - (let ((base (cadr (nth 2 (nth 2 (cadr command)))))) - (eshell--invoke-command-directly base))) + (pcase command + (`(eshell-commands (progn ,_ (unwind-protect (progn ,base) . ,_))) + (eshell--invoke-command-directly-p base)))) + +(define-obsolete-function-alias 'eshell-invoke-directly + 'eshell-invoke-directly-p "30.1") (defun eshell-eval-argument (argument) "Evaluate a single Eshell ARGUMENT and return the result." diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 21e3f00086f..fd279f61673 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -619,14 +619,14 @@ If NO-NEWLINE is non-nil, the input is sent without an implied final newline." (interactive "P") ;; Note that the input string does not include its terminal newline. - (let ((proc-running-p (and (eshell-head-process) - (not queue-p))) - (inhibit-modification-hooks t)) - (unless (and proc-running-p + (let* ((proc-running-p (eshell-head-process)) + (send-to-process-p (and proc-running-p (not queue-p))) + (inhibit-modification-hooks t)) + (unless (and send-to-process-p (not (eq (process-status (eshell-head-process)) 'run))) - (if (or proc-running-p + (if (or send-to-process-p (>= (point) eshell-last-output-end)) (goto-char (point-max)) (let ((copy (eshell-get-old-input use-region))) @@ -634,7 +634,7 @@ newline." (insert-and-inherit copy))) (unless (or no-newline (and eshell-send-direct-to-subprocesses - proc-running-p)) + send-to-process-p)) (insert-before-markers-and-inherit ?\n)) ;; Delete and reinsert input. This seems like a no-op, except ;; for the resulting entries in the undo list: undoing this @@ -644,7 +644,7 @@ newline." (inhibit-read-only t)) (delete-region eshell-last-output-end (point)) (insert text)) - (if proc-running-p + (if send-to-process-p (progn (eshell-update-markers eshell-last-output-end) (if (or eshell-send-direct-to-subprocesses @@ -673,7 +673,8 @@ newline." (run-hooks 'eshell-input-filter-functions) (and (catch 'eshell-terminal (ignore - (if (eshell-invoke-directly cmd) + (if (and (not proc-running-p) + (eshell-invoke-directly-p cmd)) (eval cmd) (eshell-eval-command cmd input)))) (eshell-life-is-too-much))))) diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 627cbb17797..537bc4b0641 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -287,6 +287,8 @@ This is set to t in `eshell-local-variable-bindings' (which see).") (setq-local eshell-subcommand-bindings (append eshell-local-variable-bindings eshell-subcommand-bindings)) + (setq-local eshell-complex-commands + (append '("env") eshell-complex-commands)) (setq-local eshell-special-chars-inside-quoting (append eshell-special-chars-inside-quoting '(?$))) diff --git a/test/lisp/eshell/esh-cmd-tests.el b/test/lisp/eshell/esh-cmd-tests.el index be31681267b..c37e6d14187 100644 --- a/test/lisp/eshell/esh-cmd-tests.el +++ b/test/lisp/eshell/esh-cmd-tests.el @@ -468,6 +468,26 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil." (eshell-command-result-equal "unless {[ foo = bar ]} {echo no} {echo yes}" "no")) + +;; Direct invocation + +(defmacro esh-cmd-test--deftest-invoke-directly (name command expected) + "FIXME" + (declare (indent 2)) + `(ert-deftest ,(intern (concat "esh-cmd-test/invoke-directly/" + (symbol-name name))) () + (with-temp-eshell + (should (equal (eshell-invoke-directly + (eshell-parse-command ,command nil t)) + ,expected))))) + +(esh-cmd-test--deftest-invoke-directly no-args "echo" t) +(esh-cmd-test--deftest-invoke-directly with-args "echo hi" t) +(esh-cmd-test--deftest-invoke-directly multiple-cmds "echo hi; echo bye" nil) +(esh-cmd-test--deftest-invoke-directly subcmd "echo ${echo hi}" t) +(esh-cmd-test--deftest-invoke-directly complex "ls ." nil) +(esh-cmd-test--deftest-invoke-directly complex-subcmd "echo {ls .}" nil) + ;; Error handling -- cgit v1.2.3 From 972466dce268c5697f47a7f342b13dbf01f23a39 Mon Sep 17 00:00:00 2001 From: João Távora Date: Fri, 26 Jan 2024 17:18:55 -0600 Subject: Eglot: fix eglot--dumb-tryc for "only possible completion" case * lisp/progmodes/eglot.el (eglot--dumb-tryc): Fix for "only possible completion" case. --- lisp/progmodes/eglot.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 40837074573..beba268f923 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -3061,9 +3061,10 @@ for which LSP on-type-formatting should be requested." (defun eglot--dumb-allc (pat table pred _point) (funcall table pat pred t)) (defun eglot--dumb-tryc (pat table pred point) - (if-let ((probe (funcall table pat pred nil))) - (cons probe (length probe)) - (cons pat point))) + (let ((probe (funcall table pat pred nil))) + (cond ((eq probe t) t) + (probe (cons probe (length probe))) + (t (cons pat point))))) (add-to-list 'completion-category-defaults '(eglot-capf (styles eglot--dumb-flex))) (add-to-list 'completion-styles-alist '(eglot--dumb-flex eglot--dumb-tryc eglot--dumb-allc)) -- cgit v1.2.3 From 6667d6c19c3934871ed54d89dc153efc72f947de Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 27 Jan 2024 09:30:16 +0800 Subject: Import ELPA package adaptive-wrap as visual-wrap * doc/emacs/basic.texi (Continuation Lines): Document visual-wrap and its applications. * etc/NEWS (Editing Changes in Emacs 30.1): Ditto. * lisp/visual-wrap.el (visual-wrap-extra-indent) (visual-wrap--face-extend-p, visual-wrap--prefix-face) (visual-wrap--prefix, visual-wrap-fill-context-prefix) (visual-wrap-prefix-function, visual-wrap-prefix-mode, lookup-key) (visual-wrap): New file. Update copyright years and rename to `visual-wrap'. --- doc/emacs/basic.texi | 11 +++ etc/NEWS | 12 +++ lisp/visual-wrap.el | 203 +++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 226 insertions(+) create mode 100644 lisp/visual-wrap.el (limited to 'lisp') diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index f64b3995d25..a6b71db4bea 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -630,6 +630,17 @@ before they get too long, by inserting newlines. If you prefer, you can make Emacs insert a newline automatically when a line gets too long, by using Auto Fill mode. @xref{Filling}. +@cindex continuation lines, wrapping with prefix +@findex visual-wrap-prefix-mode + Normally, the first character of each continuation line is +positioned at the beginning of the screen line where it is displayed. +The minor mode @code{visual-wrap-prefix-mode} arranges that +continuation lines be prefixed by slightly adjusted versions of the +fill prefixes (@pxref{Fill Prefix}) of their respective logical lines, +so that indentation characters or the prefixes of source code comments +are replicated across every continuation line, and the appearance of +such comments or indentation is not broken. + Sometimes, you may need to edit files containing many long logical lines, and it may not be practical to break them all up by adding newlines. In that case, you can use Visual Line mode, which enables diff --git a/etc/NEWS b/etc/NEWS index 37264f2f1f1..37a017c4db1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -317,6 +317,18 @@ name detection. * Editing Changes in Emacs 30.1 ++++ +** New minor mode 'visual-wrap-prefix-mode'. + +When enabled, continuation lines displayed for a folded long line will +receive a 'wrap-prefix' automatically computed from the line's +surrounding context by the function 'fill-context-prefix', which +generally indents continuation lines as if the line were filled with +'M-q', or similar. + +This minor mode is the 'adaptive-wrap' ELPA package renamed and +lightly edited for inclusion in Emacs. + +++ ** New user option 'gud-highlight-current-line'. When enabled, Gud will visually emphasize the line being executed upon diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el new file mode 100644 index 00000000000..9f52a1868c1 --- /dev/null +++ b/lisp/visual-wrap.el @@ -0,0 +1,203 @@ +;;; visual-wrap.el --- Smart line-wrapping with wrap-prefix + +;; Copyright (C) 2011-2021, 2024 Free Software Foundation, Inc. + +;; Author: Stephen Berman +;; Stefan Monnier +;; Maintainer: emacs-devel@gnu.org +;; Keywords: convenience +;; Package: emacs + +;; This file is part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This package provides the `visual-wrap-prefix-mode' minor mode +;; which sets the wrap-prefix property on the fly so that +;; single-long-line paragraphs get word-wrapped in a way similar to +;; what you'd get with M-q using visual-fill-mode, but without +;; actually changing the buffer's text. + +;;; Code: + +(defcustom visual-wrap-extra-indent 0 + "Number of extra spaces to indent in `visual-wrap-prefix-mode'. + +`visual-wrap-prefix-mode' indents the visual lines to the level +of the actual line plus `visual-wrap-extra-indent'. A negative +value will do a relative de-indent. + +Examples: + +actual indent = 2 +extra indent = -1 + + Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed + do eiusmod tempor incididunt ut labore et dolore magna + aliqua. Ut enim ad minim veniam, quis nostrud exercitation + ullamco laboris nisi ut aliquip ex ea commodo consequat. + +actual indent = 2 +extra indent = 2 + + Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed + do eiusmod tempor incididunt ut labore et dolore magna + aliqua. Ut enim ad minim veniam, quis nostrud exercitation + ullamco laboris nisi ut aliquip ex ea commodo consequat." + :type 'integer + :safe 'integerp + :group 'visual-line) + +(defun visual-wrap--face-extend-p (face) + ;; Before Emacs 27, faces always extended beyond EOL, so we check + ;; for a non-default background instead. + (cond + ((listp face) + (plist-get face (if (fboundp 'face-extend-p) :extend :background))) + ((symbolp face) + (if (fboundp 'face-extend-p) + (face-extend-p face nil t) + (face-background face nil t))))) + +(defun visual-wrap--prefix-face (fcp _beg end) + ;; If the fill-context-prefix already specifies a face, just use that. + (cond ((get-text-property 0 'face fcp)) + ;; Else, if the last character is a newline and has a face + ;; that extends beyond EOL, assume that this face spans the + ;; whole line and apply it to the prefix to preserve the + ;; "block" visual effect. + ;; + ;; NB: the face might not actually span the whole line: see + ;; for example removed lines in diff-mode, where the first + ;; character has the diff-indicator-removed face, while the + ;; rest of the line has the diff-removed face. + ((= (char-before end) ?\n) + (let ((eol-face (get-text-property (1- end) 'face))) + ;; `eol-face' can be a face, a "face value" + ;; (plist of face properties) or a list of one of those. + (if (or (not (consp eol-face)) (keywordp (car eol-face))) + ;; A single face. + (if (visual-wrap--face-extend-p eol-face) eol-face) + ;; A list of faces. Keep the ones that extend beyond EOL. + (delq nil (mapcar (lambda (f) + (if (visual-wrap--face-extend-p f) f)) + eol-face))))))) + +(defun visual-wrap--prefix (fcp) + (let ((fcp-len (string-width fcp))) + (cond + ((= 0 visual-wrap-extra-indent) + fcp) + ((< 0 visual-wrap-extra-indent) + (concat fcp (make-string visual-wrap-extra-indent ?\s))) + ((< 0 (+ visual-wrap-extra-indent fcp-len)) + (substring fcp + 0 + (+ visual-wrap-extra-indent fcp-len))) + (t + "")))) + +(defun visual-wrap-fill-context-prefix (beg end) + "Like `fill-context-prefix', but with length adjusted by +`visual-wrap-extra-indent'." + (let* ((fcp + ;; `fill-context-prefix' ignores prefixes that look like + ;; paragraph starts, in order to avoid inadvertently + ;; creating a new paragraph while filling, but here we're + ;; only dealing with single-line "paragraphs" and we don't + ;; actually modify the buffer, so this restriction doesn't + ;; make much sense (and is positively harmful in + ;; taskpaper-mode where paragraph-start matches everything). + (or (let ((paragraph-start "\\`\\'a")) + (fill-context-prefix beg end)) + ;; Note: fill-context-prefix may return nil; See: + ;; http://article.gmane.org/gmane.emacs.devel/156285 + "")) + (prefix (visual-wrap--prefix fcp)) + (face (visual-wrap--prefix-face fcp beg end))) + (if face + (propertize prefix 'face face) + prefix))) + +(defun visual-wrap-prefix-function (beg end) + "Indent the region between BEG and END with visual filling." + ;; Any change at the beginning of a line might change its wrap + ;; prefix, which affects the whole line. So we need to "round-up" + ;; `end' to the nearest end of line. We do the same with `beg' + ;; although it's probably not needed. + (goto-char end) + (unless (bolp) (forward-line 1)) + (setq end (point)) + (goto-char beg) + (forward-line 0) + (setq beg (point)) + (while (< (point) end) + (let ((lbp (point))) + (put-text-property + (point) (progn (search-forward "\n" end 'move) (point)) + 'wrap-prefix + (let ((pfx (visual-wrap-fill-context-prefix + lbp (point)))) + ;; Remove any `wrap-prefix' property that might have been + ;; added earlier. Otherwise, we end up with a string + ;; containing a `wrap-prefix' string containing a + ;; `wrap-prefix' string ... + (remove-text-properties + 0 (length pfx) '(wrap-prefix) pfx) + (let ((dp (get-text-property 0 'display pfx))) + (when (and dp (eq dp (get-text-property (1- lbp) 'display))) + ;; There's a `display' property which covers not just the + ;; prefix but also the previous newline. So it's not + ;; just making the prefix more pretty and could interfere + ;; or even defeat our efforts (e.g. it comes from + ;; `visual-fill-mode'). + (remove-text-properties + 0 (length pfx) '(display) pfx))) + pfx)))) + `(jit-lock-bounds ,beg . ,end)) + +;;;###autoload +(define-minor-mode visual-wrap-prefix-mode + "Wrap the buffer text with visual filling." + :lighter "" + :group 'visual-line + (if visual-wrap-prefix-mode + (progn + ;; HACK ATTACK! We want to run after font-lock (so our + ;; wrap-prefix includes the faces applied by font-lock), but + ;; jit-lock-register doesn't accept an `append' argument, so + ;; we add ourselves beforehand, to make sure we're at the end + ;; of the hook (bug#15155). + (add-hook 'jit-lock-functions + #'visual-wrap-prefix-function 'append t) + (jit-lock-register #'visual-wrap-prefix-function)) + (jit-lock-unregister #'visual-wrap-prefix-function) + (with-silent-modifications + (save-restriction + (widen) + (remove-text-properties (point-min) (point-max) '(wrap-prefix nil)))))) + +;;;###autoload +(define-key-after (lookup-key menu-bar-options-menu [line-wrapping]) + [visual-wrap] + '(menu-item "Visual Wrap" visual-wrap-prefix-mode + :visible (menu-bar-menu-frame-live-and-visible-p) + :help "Display continuation lines with prefix derived from context" + :button (:toggle . (bound-and-true-p visual-wrap-prefix-mode))) + word-wrap) + +(provide 'visual-wrap) +;;; visual-wrap.el ends here -- cgit v1.2.3 From d50300c50028a81ade1eb08405036168d5a24f00 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 27 Jan 2024 09:31:38 +0800 Subject: * lisp/visual-wrap.el (visual-wrap-prefix-mode): Improve doc string. --- lisp/visual-wrap.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index 9f52a1868c1..6e6e45a480c 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -171,7 +171,7 @@ extra indent = 2 ;;;###autoload (define-minor-mode visual-wrap-prefix-mode - "Wrap the buffer text with visual filling." + "Display continuation lines with prefixes from surrounding context." :lighter "" :group 'visual-line (if visual-wrap-prefix-mode -- cgit v1.2.3 From 55f0b3e561034a1ad4235770d1c0685439a64fe5 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 27 Jan 2024 09:38:46 +0800 Subject: Move Visual Wrap menu to menu-bar.el * lisp/menu-bar.el (menu-bar-line-wrapping-menu): Insert new menu item controlling visual-wrap-prefix-mode. * lisp/visual-wrap.el: Remove menu bar autoload. --- lisp/menu-bar.el | 7 +++++++ lisp/visual-wrap.el | 11 +---------- 2 files changed, 8 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 477e3036b47..761f0603c75 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1467,6 +1467,13 @@ mail status in mode line")) (not word-wrap))) :visible (menu-bar-menu-frame-live-and-visible-p) :enable (not (truncated-partial-width-window-p)))) + + (bindings--define-key menu [visual-wrap] + '(menu-item "Visual Wrap Prefix" visual-wrap-prefix-mode + :help "Display continuation lines with contextual prefix" + :visible (menu-bar-menu-frame-live-and-visible-p) + :button (:toggle . (bound-and-true-p visual-wrap-prefix-mode)) + :enable t)) menu)) (defvar menu-bar-search-options-menu diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index 6e6e45a480c..f8e00b9c685 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -1,4 +1,4 @@ -;;; visual-wrap.el --- Smart line-wrapping with wrap-prefix +;;; visual-wrap.el --- Smart line-wrapping with wrap-prefix -*- lexical-binding: t -*- ;; Copyright (C) 2011-2021, 2024 Free Software Foundation, Inc. @@ -190,14 +190,5 @@ extra indent = 2 (widen) (remove-text-properties (point-min) (point-max) '(wrap-prefix nil)))))) -;;;###autoload -(define-key-after (lookup-key menu-bar-options-menu [line-wrapping]) - [visual-wrap] - '(menu-item "Visual Wrap" visual-wrap-prefix-mode - :visible (menu-bar-menu-frame-live-and-visible-p) - :help "Display continuation lines with prefix derived from context" - :button (:toggle . (bound-and-true-p visual-wrap-prefix-mode))) - word-wrap) - (provide 'visual-wrap) ;;; visual-wrap.el ends here -- cgit v1.2.3 From 1ef8b90ae06d698ab2ba9b43f67fde7289db2c5d Mon Sep 17 00:00:00 2001 From: Randy Taylor Date: Wed, 24 Jan 2024 21:39:45 -0500 Subject: Simplify imenu setup for {cmake,dockerfile}-ts-modes * lisp/progmodes/cmake-ts-mode.el (treesit-induce-sparse-tree, treesit-node-child, treesit-node-start, cmake-ts-mode--imenu, cmake-ts-mode--imenu-1): Remove. (treesit-search-subtree): Declare. (cmake-ts-mode--function-name): New function. (cmake-ts-mode): Use it. * lisp/progmodes/dockerfile-ts-mode.el (treesit-induce-sparse-tree, treesit-node-start, dockerfile-ts-mode--imenu, dockerfile-ts-mode--imenu-1): Remove. (dockerfile-ts-mode--stage-name): New function. (dockerfile-ts-mode): Use it. --- lisp/progmodes/cmake-ts-mode.el | 46 +++++++++-------------------------- lisp/progmodes/dockerfile-ts-mode.el | 47 +++++++++--------------------------- 2 files changed, 22 insertions(+), 71 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el index d933e4ebb81..29c9e957d3c 100644 --- a/lisp/progmodes/cmake-ts-mode.el +++ b/lisp/progmodes/cmake-ts-mode.el @@ -32,10 +32,8 @@ (declare-function treesit-parser-create "treesit.c") (declare-function treesit-query-capture "treesit.c") -(declare-function treesit-induce-sparse-tree "treesit.c") -(declare-function treesit-node-child "treesit.c") -(declare-function treesit-node-start "treesit.c") (declare-function treesit-node-type "treesit.c") +(declare-function treesit-search-subtree "treesit.c") (defcustom cmake-ts-mode-indent-offset 2 "Number of spaces for each indentation step in `cmake-ts-mode'." @@ -195,37 +193,14 @@ Check if a node type is available, then return the right font lock rules." '((ERROR) @font-lock-warning-face)) "Tree-sitter font-lock settings for `cmake-ts-mode'.") -(defun cmake-ts-mode--imenu () - "Return Imenu alist for the current buffer." - (let* ((node (treesit-buffer-root-node)) - (func-tree (treesit-induce-sparse-tree - node "function_def" nil 1000)) - (func-index (cmake-ts-mode--imenu-1 func-tree))) - (append - (when func-index `(("Function" . ,func-index)))))) - -(defun cmake-ts-mode--imenu-1 (node) - "Helper for `cmake-ts-mode--imenu'. -Find string representation for NODE and set marker, then recurse -the subtrees." - (let* ((ts-node (car node)) - (children (cdr node)) - (subtrees (mapcan #'cmake-ts-mode--imenu-1 - children)) - (name (when ts-node - (pcase (treesit-node-type ts-node) - ("function_def" - (treesit-node-text - (treesit-node-child (treesit-node-child ts-node 0) 2) t))))) - (marker (when ts-node - (set-marker (make-marker) - (treesit-node-start ts-node))))) - (cond - ((or (null ts-node) (null name)) subtrees) - (subtrees - `((,name ,(cons name marker) ,@subtrees))) - (t - `((,name . ,marker)))))) +(defun cmake-ts-mode--function-name (node) + "Return the function name of NODE. +Return nil if there is no name or if NODE is not a function node." + (pcase (treesit-node-type node) + ("function_command" + (treesit-node-text + (treesit-search-subtree node "^argument$" nil nil 2) + t)))) ;;;###autoload (define-derived-mode cmake-ts-mode prog-mode "CMake" @@ -242,7 +217,8 @@ the subtrees." (setq-local comment-start-skip (rx "#" (* (syntax whitespace)))) ;; Imenu. - (setq-local imenu-create-index-function #'cmake-ts-mode--imenu) + (setq-local treesit-simple-imenu-settings + `(("Function" "\\`function_command\\'" nil cmake-ts-mode--function-name))) (setq-local which-func-functions nil) ;; Indent. diff --git a/lisp/progmodes/dockerfile-ts-mode.el b/lisp/progmodes/dockerfile-ts-mode.el index d5b7f953e31..878335431af 100644 --- a/lisp/progmodes/dockerfile-ts-mode.el +++ b/lisp/progmodes/dockerfile-ts-mode.el @@ -31,10 +31,8 @@ (eval-when-compile (require 'rx)) (declare-function treesit-parser-create "treesit.c") -(declare-function treesit-induce-sparse-tree "treesit.c") (declare-function treesit-node-child "treesit.c") (declare-function treesit-node-child-by-field-name "treesit.c") -(declare-function treesit-node-start "treesit.c") (declare-function treesit-node-type "treesit.c") (defvar dockerfile-ts-mode--syntax-table @@ -118,38 +116,15 @@ continuation to the previous entry." '((ERROR) @font-lock-warning-face)) "Tree-sitter font-lock settings.") -(defun dockerfile-ts-mode--imenu () - "Return Imenu alist for the current buffer." - (let* ((node (treesit-buffer-root-node)) - (stage-tree (treesit-induce-sparse-tree - node "from_instruction" - nil 1000)) - (stage-index (dockerfile-ts-mode--imenu-1 stage-tree))) - (when stage-index `(("Stage" . ,stage-index))))) - -(defun dockerfile-ts-mode--imenu-1 (node) - "Helper for `dockerfile-ts-mode--imenu'. -Find string representation for NODE and set marker, then recurse -the subtrees." - (let* ((ts-node (car node)) - (children (cdr node)) - (subtrees (mapcan #'dockerfile-ts-mode--imenu-1 - children)) - (name (when ts-node - (pcase (treesit-node-type ts-node) - ("from_instruction" - (treesit-node-text - (or (treesit-node-child-by-field-name ts-node "as") - (treesit-node-child ts-node 1)) t))))) - (marker (when ts-node - (set-marker (make-marker) - (treesit-node-start ts-node))))) - (cond - ((or (null ts-node) (null name)) subtrees) - (subtrees - `((,name ,(cons name marker) ,@subtrees))) - (t - `((,name . ,marker)))))) +(defun dockerfile-ts-mode--stage-name (node) + "Return the stage name of NODE. +Return nil if there is no name or if NODE is not a stage node." + (pcase (treesit-node-type node) + ("from_instruction" + (treesit-node-text + (or (treesit-node-child-by-field-name node "as") + (treesit-node-child node 1)) + t)))) ;;;###autoload (define-derived-mode dockerfile-ts-mode prog-mode "Dockerfile" @@ -166,8 +141,8 @@ the subtrees." (setq-local comment-start-skip (rx "#" (* (syntax whitespace)))) ;; Imenu. - (setq-local imenu-create-index-function - #'dockerfile-ts-mode--imenu) + (setq-local treesit-simple-imenu-settings + `(("Stage" "\\`from_instruction\\'" nil dockerfile-ts-mode--stage-name))) (setq-local which-func-functions nil) ;; Indent. -- cgit v1.2.3 From 43e2f3acdd2dbd040ec2fc473ca60ee3179bb796 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 10:38:14 +0200 Subject: ; Minor improvements in 'visual-wrap-prefix-mode' * lisp/visual-wrap.el (visual-wrap-extra-indent): Add :version. (visual-wrap-fill-context-prefix): Doc fix. * lisp/menu-bar.el (menu-bar-line-wrapping-menu): Move the menu to a better place, improve the help-echo text. * etc/NEWS: * doc/emacs/basic.texi (Continuation Lines): Improve documentation and indexing of 'visual-wrap-prefix-mode'. --- doc/emacs/basic.texi | 5 +++-- etc/NEWS | 18 +++++++++--------- lisp/menu-bar.el | 15 ++++++++------- lisp/visual-wrap.el | 6 ++++-- 4 files changed, 24 insertions(+), 20 deletions(-) (limited to 'lisp') diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index a6b71db4bea..cdc183c2a40 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -630,7 +630,7 @@ before they get too long, by inserting newlines. If you prefer, you can make Emacs insert a newline automatically when a line gets too long, by using Auto Fill mode. @xref{Filling}. -@cindex continuation lines, wrapping with prefix +@cindex continuation lines, visual wrap prefix @findex visual-wrap-prefix-mode Normally, the first character of each continuation line is positioned at the beginning of the screen line where it is displayed. @@ -639,7 +639,8 @@ continuation lines be prefixed by slightly adjusted versions of the fill prefixes (@pxref{Fill Prefix}) of their respective logical lines, so that indentation characters or the prefixes of source code comments are replicated across every continuation line, and the appearance of -such comments or indentation is not broken. +such comments or indentation is not broken. These prefixes are only +shown on display, and does not change the buffer text in any way. Sometimes, you may need to edit files containing many long logical lines, and it may not be practical to break them all up by adding diff --git a/etc/NEWS b/etc/NEWS index 37a017c4db1..d69d0001135 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -319,15 +319,15 @@ name detection. +++ ** New minor mode 'visual-wrap-prefix-mode'. - -When enabled, continuation lines displayed for a folded long line will -receive a 'wrap-prefix' automatically computed from the line's -surrounding context by the function 'fill-context-prefix', which -generally indents continuation lines as if the line were filled with -'M-q', or similar. - -This minor mode is the 'adaptive-wrap' ELPA package renamed and -lightly edited for inclusion in Emacs. +When enabled, continuation lines displayed for a wrapped long line +will receive a 'wrap-prefix' automatically computed from the line's +surrounding context, such that continuation lines are indented on +display as if they were filled with 'M-q' or similar. Unlike 'M-q', +the indentation only happens on display, and doesn't change the buffer +text in any way. + +(This minor mode is the 'adaptive-wrap' ELPA package renamed and +lightly edited for inclusion in Emacs.) +++ ** New user option 'gud-highlight-current-line'. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 761f0603c75..47c6a8f0613 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1438,6 +1438,14 @@ mail status in mode line")) (defvar menu-bar-line-wrapping-menu (let ((menu (make-sparse-keymap "Line Wrapping"))) + (bindings--define-key menu [visual-wrap] + '(menu-item "Visual Wrap Prefix mode" visual-wrap-prefix-mode + :help "Display continuation lines with visual context-dependent prefix" + :visible (menu-bar-menu-frame-live-and-visible-p) + :button (:toggle + . (bound-and-true-p visual-wrap-prefix-mode)) + :enable t)) + (bindings--define-key menu [word-wrap] '(menu-item "Word Wrap (Visual Line mode)" menu-bar--visual-line-mode-enable @@ -1467,13 +1475,6 @@ mail status in mode line")) (not word-wrap))) :visible (menu-bar-menu-frame-live-and-visible-p) :enable (not (truncated-partial-width-window-p)))) - - (bindings--define-key menu [visual-wrap] - '(menu-item "Visual Wrap Prefix" visual-wrap-prefix-mode - :help "Display continuation lines with contextual prefix" - :visible (menu-bar-menu-frame-live-and-visible-p) - :button (:toggle . (bound-and-true-p visual-wrap-prefix-mode)) - :enable t)) menu)) (defvar menu-bar-search-options-menu diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index f8e00b9c685..1cb49538eae 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -59,6 +59,7 @@ extra indent = 2 ullamco laboris nisi ut aliquip ex ea commodo consequat." :type 'integer :safe 'integerp + :version "30.1" :group 'visual-line) (defun visual-wrap--face-extend-p (face) @@ -111,8 +112,9 @@ extra indent = 2 "")))) (defun visual-wrap-fill-context-prefix (beg end) - "Like `fill-context-prefix', but with length adjusted by -`visual-wrap-extra-indent'." + "Compute visual wrap prefix from text between FROM and TO. +This is like `fill-context-prefix', but with prefix length adjusted +by `visual-wrap-extra-indent'." (let* ((fcp ;; `fill-context-prefix' ignores prefixes that look like ;; paragraph starts, in order to avoid inadvertently -- cgit v1.2.3 From 8163e0b20c97a8394225a7165a8ab361af09ec29 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 10:52:47 +0200 Subject: Improve 'refill-mode' in Org buffers * lisp/textmodes/refill.el (refill-fill-paragraph-at): Use 'fill-forward-paragraph' instead of 'forward/backward-paragraph', so that modes could customize the behavior. (Bug#68418) --- lisp/textmodes/refill.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el index bb6b6ebda0f..244c96b60df 100644 --- a/lisp/textmodes/refill.el +++ b/lisp/textmodes/refill.el @@ -106,10 +106,10 @@ This is used to optimize refilling.") ;; FIXME: forward-paragraph seems to disregard `use-hard-newlines', ;; leading to excessive refilling and wrong choice of fill-prefix. ;; might be a bug in my paragraphs.el. - (forward-paragraph) + (fill-forward-paragraph) (skip-syntax-backward "-") (let ((end (point)) - (beg (progn (backward-paragraph) (point))) + (beg (progn (fill-forward-paragraph -1) (point))) (obeg (overlay-start refill-ignorable-overlay)) (oend (overlay-end refill-ignorable-overlay))) (unless (> beg pos) ;Don't fill if point is outside the paragraph. -- cgit v1.2.3 From fa7543eeb72342544d324a54010b6cb96c246733 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 11:44:54 +0200 Subject: Minor fix in 'describe-language-environment' * lisp/international/mule-cmds.el (describe-language-environment): Use 'current-language-environment' as DEFAULT in the prompt. Patch by Thierry Volpiatto . (Bug#68602) --- lisp/international/mule-cmds.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 07f11a62594..6b4c83112e3 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -2159,7 +2159,9 @@ See `set-language-info-alist' for use in programs." (interactive (list (read-language-name 'documentation - (format-prompt "Describe language environment" current-language-environment)))) + (format-prompt "Describe language environment" + current-language-environment) + current-language-environment))) (let ((help-buffer-under-preparation t)) (if (null language-name) (setq language-name current-language-environment)) -- cgit v1.2.3 From f0c573d8069f7ee654a550ae3d148325c49900a3 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 20 Jan 2024 12:24:32 +0100 Subject: Optionally avoid extending 'completion-at-point-functions' It is now possible to avoid extending 'completion-at-point-functions' in Text mode and its descendants. * lisp/textmodes/text-mode.el (text-mode-meta-tab-ispell-complete-word): Rename to... (text-mode-ispell-word-completion): ...this. Extend with another option 'completion-at-point'. (text-mode): Only extend 'completion-at-point-functions' when 'text-mode-ispell-word-completion' is 'completion-at-point'. (Bug#67527) * etc/NEWS: Update the entry about 'M-TAB' in Text mode. --- etc/NEWS | 13 +++++++------ lisp/textmodes/text-mode.el | 19 ++++++++++++++----- 2 files changed, 21 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index d69d0001135..b249f7e1ecb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1346,12 +1346,13 @@ files and save the changes. +++ ** 'M-TAB' now invokes 'completion-at-point' also in Text mode. -Text mode no longer binds 'M-TAB' to 'ispell-complete-word', and -instead this mode arranges for 'completion-at-point', globally bound -to 'M-TAB', to perform word completion as well. If you want 'M-TAB' -to invoke 'ispell-complete-word', as it did in previous Emacs -versions, customize the new user option -'text-mode-meta-tab-ispell-complete-word' to non-nil. +By default, Text mode no longer binds 'M-TAB' to +'ispell-complete-word'. Instead this mode arranges for +'completion-at-point', globally bound to 'M-TAB', to perform word +completion as well. You can have Text mode bind 'M-TAB' to +'ispell-complete-word' as it did in previous Emacs versions, or +disable Ispell word completion in Text mode altogether, by customizing +the new user option 'text-mode-ispell-word-completion'. ** 'pp' and 'pp-to-string' now always include a terminating newline. In the past they included a terminating newline in most cases but not all. diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index 7d3b47a9c03..87f6668cecb 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -75,8 +75,15 @@ Many other modes, such as `mail-mode' and `outline-mode', inherit all the commands defined in this map.") -(defcustom text-mode-meta-tab-ispell-complete-word nil - "Whether M-TAB invokes `ispell-complete-word' in Text mode. +(defcustom text-mode-ispell-word-completion 'completion-at-point + "How Text mode provides Ispell word completion. + +By default, this option is set to `completion-at-point', which +means that Text mode adds an Ispell word completion function to +`completion-at-point-functions'. Any other non-nil value says to +bind M-TAB directly to `ispell-complete-word' instead. If this +is nil, Text mode neither binds M-TAB to `ispell-complete-word' +nor does it extend `completion-at-point-functions'. This user option only takes effect when you customize it in Custom or with `setopt', not with `setq'." @@ -84,8 +91,9 @@ Custom or with `setopt', not with `setq'." :type 'boolean :version "30.1" :set (lambda (sym val) - (if (set sym val) - (keymap-set text-mode-map "C-M-i" #'ispell-complete-word) + (if (and (set sym val) + (not (eq val 'completion-at-point))) + (keymap-set text-mode-map "C-M-i" #'ispell-complete-word) (keymap-unset text-mode-map "C-M-i" t)))) (easy-menu-define text-mode-menu text-mode-map @@ -144,7 +152,8 @@ Turning on Text mode runs the normal hook `text-mode-hook'." ;; Enable text conversion in this buffer. (setq-local text-conversion-style t) (add-hook 'context-menu-functions 'text-mode-context-menu 10 t) - (add-hook 'completion-at-point-functions #'ispell-completion-at-point 10 t)) + (when (eq text-mode-ispell-word-completion 'completion-at-point) + (add-hook 'completion-at-point-functions #'ispell-completion-at-point 10 t))) (define-derived-mode paragraph-indent-text-mode text-mode "Parindent" "Major mode for editing text, with leading spaces starting a paragraph. -- cgit v1.2.3 From 09cdf8a406c5b73e8924a7396c2aaabe74a1a638 Mon Sep 17 00:00:00 2001 From: Jakub Ječmínek Date: Fri, 19 Jan 2024 16:38:21 +0100 Subject: Fix syntax highlighting after string literal concat in python-mode * lisp/progmodes/python.el (python-syntax-stringify): Fix incorrect font-lock after string literal concatenation. (Bug#45897) * test/lisp/progmodes/python-tests.el (python-font-lock-string-literal-concatenation): New test. Co-authored-by: kobarity Copyright-paperwork-exempt: yes --- lisp/progmodes/python.el | 3 +++ test/lisp/progmodes/python-tests.el | 12 ++++++++++++ 2 files changed, 15 insertions(+) (limited to 'lisp') diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 41f612c8b1c..9d840efb9da 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -909,6 +909,7 @@ is used to limit the scan." "Put `syntax-table' property correctly on single/triple quotes." (let* ((ppss (save-excursion (backward-char 3) (syntax-ppss))) (string-start (and (eq t (nth 3 ppss)) (nth 8 ppss))) + (string-literal-concat (numberp (nth 3 ppss))) (quote-starting-pos (- (point) 3)) (quote-ending-pos (point))) (cond ((or (nth 4 ppss) ;Inside a comment @@ -921,6 +922,8 @@ is used to limit the scan." ((nth 5 ppss) ;; The first quote is escaped, so it's not part of a triple quote! (goto-char (1+ quote-starting-pos))) + ;; Handle string literal concatenation (bug#45897) + (string-literal-concat nil) ((null string-start) ;; This set of quotes delimit the start of a string. Put ;; string fence syntax on last quote. (bug#49518) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 97ffd5fe20f..59957ff0712 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -660,6 +660,18 @@ r'\\x12 \123 \\n \\u1234 \\U00010348 \\N{Plus-Minus Sign}'" (3 . font-lock-string-face) (14) (16 . font-lock-string-face)))) +(ert-deftest python-font-lock-string-literal-concatenation () + "Test for bug#45897." + (python-tests-assert-faces + "x = \"hello\"\"\" +y = \"confused\"" + '((1 . font-lock-variable-name-face) (2) + (3 . font-lock-operator-face) (4) + (5 . font-lock-string-face) (14) + (15 . font-lock-variable-name-face) (16) + (17 . font-lock-operator-face) (18) + (19 . font-lock-string-face)))) + ;;; Indentation -- cgit v1.2.3 From 756daa93b3ef7ce33e741ab30000fa397fcd9783 Mon Sep 17 00:00:00 2001 From: Mekeor Melire Date: Mon, 4 Dec 2023 16:37:37 +0100 Subject: Add option Info-url-alist * lisp/info.el (Info-url-alist): New option mapping manuals to URLs. (Info-url-for-node): Use it. * test/lisp/info-tests.el (test-info-urls): Add more tests. In particular, 'Info-url-for-node' should error when manual-name is not handled in 'Info-url-alist'. * etc/NEWS: Announce the change. (Bug#67615) --- etc/NEWS | 9 ++++ lisp/info.el | 108 ++++++++++++++++++++++++++++++++++++++---------- test/lisp/info-tests.el | 14 +++++-- 3 files changed, 105 insertions(+), 26 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index b249f7e1ecb..7e30cda7226 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -436,6 +436,15 @@ only to specify the 'mouse-4/5/6/7' events generated by older configurations such as X11 when the X server does not support at least version 2.1 of the X Input Extension, and 'xterm-mouse-mode'. +** Info + +--- +*** New user option 'Info-url-alist'. +This user option associates manual-names with URLs. It affects the +'Info-goto-node-web' command. By default, associations for all +Emacs-included manuals are set. Further associations can be added for +arbitrary Info manuals. + +++ ** New command 'lldb'. Run the LLDB debugger, analogous to the 'gud-gdb' command. diff --git a/lisp/info.el b/lisp/info.el index e56344825b9..e91cc7b8e54 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -213,6 +213,53 @@ a version of Emacs without installing it.") These directories are searched after those in `Info-directory-list'." :type '(repeat directory)) +(defcustom Info-url-alist + '((("auth" "autotype" "bovine" "calc" "ccmode" "cl" "dbus" "dired-x" + "ebrowse" "ede" "ediff" "edt" "efaq" "efaq-w32" "eglot" "eieio" + "eintr" "elisp" "emacs" "emacs-gnutls" "emacs-mime" "epa" "erc" + "ert" "eshell" "eudc" "eww" "flymake" "forms" "gnus" + "htmlfontify" "idlwave" "ido" "info" "mairix-el" "message" + "mh-e" "modus-themes" "newsticker" "nxml-mode" "octave-mode" + "org" "pcl-cvs" "pgg" "rcirc" "reftex" "remember" "sasl" "sc" + "semantic" "ses" "sieve" "smtpmail" "speedbar" "srecode" + "todo-mode" "tramp" "transient" "url" "use-package" "vhdl-mode" + "vip" "viper" "vtable" "widget" "wisent" "woman") . + "https://www.gnu.org/software/emacs/manual/html_node/%m/%e")) + "Alist telling `Info-mode' where manuals are accessible online. + +Each element of this list has the form (MANUALs . URL-SPEC). +MANUALs represents the name of one or more manuals. It can +either be a string or a list of strings. URL-SPEC can be a +string in which the substring \"%m\" will be expanded to the +manual-name, \"%n\" to the node-name, and \"%e\" to the +URL-encoded node-name (without a `.html' suffix). (The +URL-encoding of the node-name mimics GNU Texinfo, as documented +at Info node `(texinfo)HTML Xref Node Name Expansion'.) +Alternatively, URL-SPEC can be a function which is given +manual-name, node-name and URL-encoded node-name as arguments, +and is expected to return the corresponding URL as a string. + +This variable particularly affects the command +`Info-goto-node-web', which see. + +The default value of this variable refers to the official, +HTTPS-accessible HTML-representations of all manuals that Emacs +includes. These URLs refer to the most recently released version +of Emacs, disregarding the version of the running Emacs. In +other words, the content of your local Info node and the +associated online node may differ. The resource represented by +the generated URL may even be not found by the gnu.org server." + :version "30.1" + :type '(alist + :tag "Mapping from manual-name(s) to URL-specification" + :key-type (choice + (string :tag "A single manual-name") + (repeat :tag "List of manual-names" string)) + :value-type (choice + (string :tag "URL-specification string") + (function + :tag "URL-specification function")))) + (defcustom Info-scroll-prefer-subnodes nil "If non-nil, \\\\[Info-scroll-up] in a menu visits subnodes. @@ -1854,33 +1901,50 @@ By default, go to the current Info node." (Info-url-for-node (format "(%s)%s" filename node))))) (defun Info-url-for-node (node) - "Return a URL for NODE, a node in the GNU Emacs or Elisp manual. -NODE should be a string on the form \"(manual)Node\". Only emacs -and elisp manuals are supported." - (unless (string-match "\\`(\\(.+\\))\\(.+\\)\\'" node) - (error "Invalid node name %s" node)) - (let ((manual (match-string 1 node)) - (node (match-string 2 node))) - (unless (member manual '("emacs" "elisp")) - (error "Only emacs/elisp manuals are supported")) - ;; Encode a bunch of characters the way that makeinfo does. - (setq node - (mapconcat (lambda (ch) - (if (or (< ch 32) ; ^@^A-^Z^[^\^]^^^- + "Return the URL corresponding to NODE. + +NODE should be a string of the form \"(manual)Node\"." + ;; GNU Texinfo skips whitespaces and newlines between the closing + ;; parenthesis and the node-name, i.e. space, tab, line feed and + ;; carriage return. + (unless (string-match "\\`(\\(.+\\))[ \t\n\r]*\\(.+\\)\\'" node) + (error "Invalid node-name %s" node)) + ;; Use `if-let*' instead of `let*' so we check if an association was + ;; found. + (if-let* ((manual (match-string 1 node)) + (node (match-string 2 node)) + (association (seq-find + (lambda (pair) + (seq-contains-p (ensure-list (car pair)) + manual #'string-equal-ignore-case)) + Info-url-alist)) + (url-spec (cdr association)) + (encoded-node + ;; Reproduce GNU Texinfo's way of URL-encoding. + ;; (info "(texinfo) HTML Xref Node Name Expansion") + (if (equal node "Top") + "" + (url-hexify-string + (string-replace " " "-" + (mapconcat + (lambda (ch) + (if (or (< ch 32) ; ^@^A-^Z^[^\^]^^^- (<= 33 ch 47) ; !"#$%&'()*+,-./ (<= 58 ch 64) ; :;<=>?@ (<= 91 ch 96) ; [\]_` (<= 123 ch 127)) ; {|}~ DEL (format "_00%x" ch) - (char-to-string ch))) - node - "")) - (concat "https://www.gnu.org/software/emacs/manual/html_node/" - manual "/" - (and (not (equal node "Top")) - (concat - (url-hexify-string (string-replace " " "-" node)) - ".html"))))) + (char-to-string ch))) + node "")))))) + (cond + ((stringp url-spec) + (format-spec url-spec + `((?m . ,manual) (?n . ,node) (?e . ,encoded-node)))) + ((functionp url-spec) + (funcall url-spec manual node encoded-node)) + (t (error "URL-specification neither string nor function"))) + (error "No URL-specification associated with manual-name `%s'" + manual))) (defvar Info-read-node-completion-table) diff --git a/test/lisp/info-tests.el b/test/lisp/info-tests.el index ebe718167bf..0dfdbf417e8 100644 --- a/test/lisp/info-tests.el +++ b/test/lisp/info-tests.el @@ -29,11 +29,17 @@ (ert-deftest test-info-urls () (should (equal (Info-url-for-node "(emacs)Minibuffer") - "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer.html")) + "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer")) (should (equal (Info-url-for-node "(emacs)Minibuffer File") - "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer-File.html")) + "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer-File")) (should (equal (Info-url-for-node "(elisp)Backups and Auto-Saving") - "https://www.gnu.org/software/emacs/manual/html_node/elisp/Backups-and-Auto_002dSaving.html")) - (should-error (Info-url-for-node "(gnus)Minibuffer File"))) + "https://www.gnu.org/software/emacs/manual/html_node/elisp/Backups-and-Auto_002dSaving")) + (should (equal (Info-url-for-node "(eintr)car & cdr") + "https://www.gnu.org/software/emacs/manual/html_node/eintr/car-_0026-cdr")) + (should (equal (Info-url-for-node "(emacs-mime)\tIndex") + "https://www.gnu.org/software/emacs/manual/html_node/emacs-mime/Index")) + (should (equal (Info-url-for-node "(gnus) Don't Panic") + "https://www.gnu.org/software/emacs/manual/html_node/gnus/Don_0027t-Panic")) + (should-error (Info-url-for-node "(nonexistent)Example"))) ;;; info-tests.el ends here -- cgit v1.2.3 From fc70eced27832bde0f3702a1f9033d5b81a8d61d Mon Sep 17 00:00:00 2001 From: Brad Howes Date: Sun, 21 Jan 2024 10:07:24 +0100 Subject: Downcase host names in ansi-osc.el to match URL parsing behavior * lisp/ansi-osc.el (ansi-osc-directory-tracker): Compare with 'system-name' case-insensitively. (Bug#68632) Copyright-paperwork-exempt: yes --- lisp/ansi-osc.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/ansi-osc.el b/lisp/ansi-osc.el index 7e686193f69..8dbaeb45132 100644 --- a/lisp/ansi-osc.el +++ b/lisp/ansi-osc.el @@ -121,7 +121,8 @@ and `shell-dirtrack-mode'." (let ((url (url-generic-parse-url text))) (when (and (string= (url-type url) "file") (or (null (url-host url)) - (string= (url-host url) (system-name)))) + ;; Use `downcase' to match `url-generic-parse-url' behavior + (string= (url-host url) (downcase (system-name))))) (ignore-errors (cd-absolute (url-unhex-string (url-filename url))))))) -- cgit v1.2.3 From 6b93e16e436735003d49a5a2ab451394937ee76c Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Mon, 8 Jan 2024 15:08:01 +0100 Subject: Add new option to 'register-use-preview' When set to 'insist', exit minibuffer with same key as register name, instead of pressing RET. E.g., pressing "a" selects register "a", then pressing "a" again exits the minibuffer. * lisp/register.el (register-use-preview): New option 'insist'. (register-read-with-preview-fancy): Handle new option. * doc/emacs/regs.texi: Document it. * etc/NEWS: Mention 'insist'. (Bug#68654) --- doc/emacs/regs.texi | 5 +++++ etc/NEWS | 2 +- lisp/register.el | 18 ++++++++++++++++-- 3 files changed, 22 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi index fdcddbbc739..c30bcc37999 100644 --- a/doc/emacs/regs.texi +++ b/doc/emacs/regs.texi @@ -71,6 +71,11 @@ by @code{insert-register} will only show registers whose values can be inserted into the buffer, omitting registers which hold window configurations, positions, and other un-insertable values. +@item insist +This value is like @code{t}, but in addition of pressing @key{RET} to +exit with the choosen value, you can press the same key as the name of +register. + @item nil This value requests behavior similar to @code{traditional}, but the preview is shown without delay, and is filtered according to the diff --git a/etc/NEWS b/etc/NEWS index 7e30cda7226..e854873b8d0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -639,7 +639,7 @@ This allows to customize different switches for different remote machines. +++ *** New mode of prompting for register names and showing preview. The new user option 'register-use-preview' can be customized to the -value t to request a different user interface of prompting for +value t or insist to request a different user interface of prompting for register names and previewing the registers: Emacs will require confirmation for overwriting the value of a register, and will show the preview of registers without delay. You can also customize this diff --git a/lisp/register.el b/lisp/register.el index f5b0365dec2..73d1b24b231 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -131,7 +131,11 @@ to the value of `register--read-with-preview-function'.") (defcustom register-use-preview 'traditional "Whether to show register preview when modifying registers. -When set to `t', show a preview buffer with navigation and highlighting. +When set to `t', show a preview buffer with navigation and +highlighting. +When set to \\='insist behave as with `t' but allow exiting minibuffer +by pressing a second time the selected register, e.g pressing \"a\" +select register \"a\" and pressing again \"a\" exit minibuffer. When nil, show a preview buffer without navigation and highlighting, and exit the minibuffer immediately after inserting response in minibuffer. When set to \\='never, behave as with nil, but with no preview buffer at @@ -141,6 +145,7 @@ according to `register-preview-delay'; this preserves the traditional behavior of Emacs 29 and before." :type '(choice (const :tag "Use preview" t) + (const :tag "Use preview and exit on second hit" insist) (const :tag "Use quick preview" nil) (const :tag "Never use preview" never) (const :tag "Basic preview like Emacs-29" traditional)) @@ -541,7 +546,12 @@ or \\='never." (member new strs)) new old)) (delete-minibuffer-contents) - (insert input))) + (insert input) + ;; Exit minibuffer on second hit + ;; when *-use-preview == insist. + (when (and (string= new old) + (eq register-use-preview 'insist)) + (setq noconfirm t)))) (when (and smatch (not (string= input "")) (not (member input strs))) (setq input "") @@ -551,6 +561,10 @@ or \\='never." (setq pat input)))) (if (setq win (get-buffer-window buffer)) (with-selected-window win + (when noconfirm + ;; Happen only when + ;; *-use-preview == insist. + (exit-minibuffer)) (let ((ov (make-overlay (point-min) (point-min))) ;; Allow upper-case and lower-case letters -- cgit v1.2.3 From d36c370ce555849d3d19f25999998230361cc828 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 12:52:55 +0200 Subject: ; Minor improvements of last change * lisp/register.el (register-use-preview): Doc fix. * doc/emacs/regs.texi (Registers): Fix wording. (Bug#68654) --- doc/emacs/regs.texi | 6 +++--- lisp/register.el | 9 +++++---- 2 files changed, 8 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi index c30bcc37999..cac5b32c566 100644 --- a/doc/emacs/regs.texi +++ b/doc/emacs/regs.texi @@ -72,9 +72,9 @@ inserted into the buffer, omitting registers which hold window configurations, positions, and other un-insertable values. @item insist -This value is like @code{t}, but in addition of pressing @key{RET} to -exit with the choosen value, you can press the same key as the name of -register. +This value is like @code{t}, but in addition you can press the same +key as the name of register one more time to exit the minibuffer, +instead of pressing @key{RET}. @item nil This value requests behavior similar to @code{traditional}, but the diff --git a/lisp/register.el b/lisp/register.el index 73d1b24b231..822467a0d72 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -133,9 +133,10 @@ to the value of `register--read-with-preview-function'.") When set to `t', show a preview buffer with navigation and highlighting. -When set to \\='insist behave as with `t' but allow exiting minibuffer -by pressing a second time the selected register, e.g pressing \"a\" -select register \"a\" and pressing again \"a\" exit minibuffer. +When set to \\='insist, behave as with `t', but allow exiting the +minibuffer by pressing the register name a second time. E.g., +press \"a\" to select register \"a\", then press \"a\" again to +exit the minibuffer. When nil, show a preview buffer without navigation and highlighting, and exit the minibuffer immediately after inserting response in minibuffer. When set to \\='never, behave as with nil, but with no preview buffer at @@ -145,7 +146,7 @@ according to `register-preview-delay'; this preserves the traditional behavior of Emacs 29 and before." :type '(choice (const :tag "Use preview" t) - (const :tag "Use preview and exit on second hit" insist) + (const :tag "Use preview and exit by pressing register name" insist) (const :tag "Use quick preview" nil) (const :tag "Never use preview" never) (const :tag "Basic preview like Emacs-29" traditional)) -- cgit v1.2.3 From 9b3f43fa08b2672a5ef33b872b2c6d1b0e881b88 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 13:28:32 +0200 Subject: ; * lisp/textmodes/refill.el (refill-fill-paragraph-at): Fix typo. --- lisp/textmodes/refill.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el index 244c96b60df..63789e887e2 100644 --- a/lisp/textmodes/refill.el +++ b/lisp/textmodes/refill.el @@ -106,7 +106,7 @@ This is used to optimize refilling.") ;; FIXME: forward-paragraph seems to disregard `use-hard-newlines', ;; leading to excessive refilling and wrong choice of fill-prefix. ;; might be a bug in my paragraphs.el. - (fill-forward-paragraph) + (fill-forward-paragraph 1) (skip-syntax-backward "-") (let ((end (point)) (beg (progn (fill-forward-paragraph -1) (point))) -- cgit v1.2.3 From 85faf907618798eb09f34ba49527827b0e4026bc Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 27 Jan 2024 12:36:15 +0100 Subject: ; * lisp/visual-wrap.el: use regexp-unmatchable --- lisp/visual-wrap.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index 1cb49538eae..c23a886801d 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -123,7 +123,7 @@ by `visual-wrap-extra-indent'." ;; actually modify the buffer, so this restriction doesn't ;; make much sense (and is positively harmful in ;; taskpaper-mode where paragraph-start matches everything). - (or (let ((paragraph-start "\\`\\'a")) + (or (let ((paragraph-start regexp-unmatchable)) (fill-context-prefix beg end)) ;; Note: fill-context-prefix may return nil; See: ;; http://article.gmane.org/gmane.emacs.devel/156285 -- cgit v1.2.3 From 47ee5aacdc12516a24dbcec1d9fddae85345aa0b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 15:05:40 +0200 Subject: ; Declare tree-sitter functions in yaml-ts-mode.el * lisp/textmodes/yaml-ts-mode.el (treesit-node-start) (treesit-node-end, treesit-node-type): Declare. --- lisp/textmodes/yaml-ts-mode.el | 3 +++ 1 file changed, 3 insertions(+) (limited to 'lisp') diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el index 08fe4c49733..c0185457bc2 100644 --- a/lisp/textmodes/yaml-ts-mode.el +++ b/lisp/textmodes/yaml-ts-mode.el @@ -30,6 +30,9 @@ (require 'treesit) (declare-function treesit-parser-create "treesit.c") +(declare-function treesit-node-start "treesit.c") +(declare-function treesit-node-end "treesit.c") +(declare-function treesit-node-type "treesit.c") (defvar yaml-ts-mode--syntax-table (let ((table (make-syntax-table))) -- cgit v1.2.3 From 3c2baa1b95442c114f717aaf2d017986bc07a270 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 27 Jan 2024 14:01:47 +0100 Subject: Avoid signaling errors in emoji.el on empty input * lisp/international/emoji.el (emoji--read-emoji): Signal user-error on empty input. (Bug#68671) Do not merge to master. --- lisp/international/emoji.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el index 8134214bba5..3bb5c36e4c7 100644 --- a/lisp/international/emoji.el +++ b/lisp/international/emoji.el @@ -680,11 +680,12 @@ We prefer the earliest unique letter." strings)))) (complete-with-action action table string pred))) nil t))) - (when (cl-plusp (length name)) - (let ((glyph (if emoji-alternate-names - (cadr (split-string name "\t")) - (gethash name emoji--all-bases)))) - (cons glyph (gethash glyph emoji--derived)))))) + (if (cl-plusp (length name)) + (let ((glyph (if emoji-alternate-names + (cadr (split-string name "\t")) + (gethash name emoji--all-bases)))) + (cons glyph (gethash glyph emoji--derived))) + (user-error "You didn't specify an emoji")))) (defun emoji--choose-emoji () (pcase-let ((`(,glyph . ,derived) (emoji--read-emoji))) -- cgit v1.2.3 From 63a12ffbc37e46d2752b3903228fc8ec2c1fc611 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 27 Jan 2024 14:01:47 +0100 Subject: Avoid signaling errors in emoji.el * lisp/international/emoji.el (emoji--read-emoji): Signal user-error on empty input (bug#68671). --- lisp/international/emoji.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el index 3a191c5ecd3..4f3aab5a6be 100644 --- a/lisp/international/emoji.el +++ b/lisp/international/emoji.el @@ -683,11 +683,12 @@ We prefer the earliest unique letter." strings)))) (complete-with-action action table string pred))) nil t))) - (when (cl-plusp (length name)) - (let ((glyph (if emoji-alternate-names - (cadr (split-string name "\t")) - (gethash name emoji--all-bases)))) - (cons glyph (gethash glyph emoji--derived)))))) + (if (cl-plusp (length name)) + (let ((glyph (if emoji-alternate-names + (cadr (split-string name "\t")) + (gethash name emoji--all-bases)))) + (cons glyph (gethash glyph emoji--derived))) + (user-error "You didn't specify an emoji")))) (defvar-keymap emoji-zoom-map "+" #'emoji-zoom-increase -- cgit v1.2.3 From 77d9d05df87965409c537f49d59cb5ea632abda1 Mon Sep 17 00:00:00 2001 From: Daniel Brooks Date: Sun, 5 Nov 2023 01:03:37 -0700 Subject: Calc parses fractions written using U+2044 FRACTION SLASH MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fractions of the form 123⁄456 are handled as if written 123:456. Note in particular the difference in behavior from U+2215 DIVISION SLASH and U+002F SOLIDUS, which result in division rather than a rational fraction. * lisp/calc/calc-aent.el (math-read-replacement-list): Substitute a colon for any fraction slash. (Bug#66944) * test/lisp/calc/calc-tests.el (calc-frac-input): Test various fraction types. * etc/NEWS: * doc/misc/calc.texi (Fractions): Mention fraction slash, precomposed fractions. Copyright-paperwork-exempt: yes --- doc/misc/calc.texi | 16 ++++++++++++++++ etc/NEWS | 11 ++++++++++- lisp/calc/calc-aent.el | 1 + test/lisp/calc/calc-tests.el | 25 +++++++++++++++++++++++++ 4 files changed, 52 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index 7ae338307a5..31db77a0720 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -10571,6 +10571,22 @@ Non-decimal fractions are entered and displayed as @samp{@var{radix}#@var{num}:@var{denom}} (or in the analogous three-part form). The numerator and denominator always use the same radix. +@ifnottex +Fractions may also be entered with @kbd{@U{2044}} (U+2044 FRACTION +SLASH) in place of any @kbd{:}. Precomposed fraction characters from +@kbd{@U{00BD}} (U+00BD VULGAR FRACTION ONE HALF) through +@kbd{@U{215E}} (U+215E VULGAR FRACTION SEVEN EIGHTHS) as supported as +well. Thus @samp{2:3}, @samp{2@U{2044}3}, and @samp{@U{2154}} are all +equivalent. +@end ifnottex +@iftex +Fractions may also be entered with U+2044 FRACTION SLASH in place of +any @kbd{:}. Precomposed fraction characters from U+00BD VULGAR +FRACTION ONE HALF through U+215E VULGAR FRACTION SEVEN EIGHTHS as +supported as well. +@end iftex + + @node Floats @section Floats diff --git a/etc/NEWS b/etc/NEWS index 0af275787d1..dd4a9c2afcf 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1288,7 +1288,16 @@ chat buffers use by default. +++ *** New command 'customize-dirlocals'. This command pops up a buffer to edit the settings in ".dir-locals.el". - +** Calc ++++ +*** Calc parses fractions written using U+2044 FRACTION SLASH +Fractions of the form 123⁄456 are handled as if written 123:456. Note +in particular the difference in behavior from U+2215 DIVISION SLASH +and U+002F SOLIDUS, which result in division rather than a rational +fraction. You may also be interested to know that precomposed +fraction characters, such as ½ (U+00BD VULGAR FRACTION ONE HALF), are +also recognized as rational fractions. They have been since 2004, but +it looks like it was never mentioned in the NEWS, or even the manual. * New Modes and Packages in Emacs 30.1 diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index 08e8d9fcd6f..a21efc0238d 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -505,6 +505,7 @@ The value t means abort and give an error message.") ("⅝" "(5:8)") ; 5/8 ("⅞" "(7:8)") ; 7/8 ("⅟" "1:") ; 1/... + ("⁄" ":") ; arbitrary fractions of the form 123⁄456 ;; superscripts ("⁰" "0") ; 0 ("¹" "1") ; 1 diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el index a44a5898055..d96672c04a1 100644 --- a/test/lisp/calc/calc-tests.el +++ b/test/lisp/calc/calc-tests.el @@ -734,6 +734,31 @@ An existing calc stack is reused, otherwise a new one is created." (var c var-c)))))) (calc-set-language nil))) +(ert-deftest calc-frac-input () + ;; precomposed fraction + (should (equal (math-read-expr "½") + '(frac 1 2))) + ;; ascii solidus + (should (equal (math-read-expr "123/456") + '(/ 123 456))) + (should (equal (math-read-expr "a/b") + '(/ (var a var-a) (var b var-b)))) + ;; fraction slash + (should (equal (math-read-expr "123⁄456") + '(frac 41 152))) + (should (equal (math-read-expr "a⁄b") + '(error 1 "Syntax error"))) + ;; division slash + (should (equal (math-read-expr "123∕456") + '(/ 123 456))) + (should (equal (math-read-expr "a∕b") + '(/ (var a var-a) (var b var-b)))) + ;; division sign + (should (equal (math-read-expr "123÷456") + '(frac 41 152))) + (should (equal (math-read-expr "a÷b") ; I think this one is wrong + '(error 1 "Syntax error")))) + (defvar var-g) ;; Test `let'. -- cgit v1.2.3 From 58f0603d40d238383aaa911eb09b3e2809177bfa Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 19:11:22 +0200 Subject: Allow users to opt out of following Windows Dark mode * src/w32fns.c (globals_of_w32fns) : New variable. (w32_applytheme): Disable application of Dark mode if 'w32-follow-system-dark-mode' is nil. * etc/NEWS: * doc/emacs/msdos.texi (Windows Misc): Document 'w32-follow-system-dark-mode'. --- doc/emacs/msdos.texi | 23 +++++++++++++++++------ etc/NEWS | 10 ++++++++++ lisp/cus-start.el | 2 ++ src/w32fns.c | 10 +++++++++- 4 files changed, 38 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/doc/emacs/msdos.texi b/doc/emacs/msdos.texi index b00f116ee4e..861c0d90dc6 100644 --- a/doc/emacs/msdos.texi +++ b/doc/emacs/msdos.texi @@ -1182,12 +1182,23 @@ click-to-focus policy. @end ifnottex On Windows 10 (version 1809 and higher) and Windows 11, Emacs title -bars and scroll bars will follow the system's Light or Dark mode, -similar to other programs such as Explorer and Command Prompt. To -change the color mode, select @code{Personalization} from -@w{@code{Windows Settings}}, then -@w{@code{Colors->Choose your color}} (or @w{@code{Choose your default -app mode}}); then restart Emacs. +bars and scroll bars by default follow the system's Light or Dark +mode, similar to other programs such as Explorer and Command Prompt. +To change the color mode, select @code{Personalization} from +@w{@code{Windows Settings}}, then @w{@code{Colors->Choose your color}} +(or @w{@code{Choose your default app mode}} or @w{@code{Choose your +mode}}); then restart Emacs. On Windows 11, you can select separate +default modes for Windows and for applications. + +@vindex w32-follow-system-dark-mode + If you don't want Emacs to follow the system's Dark mode setting, +customize the variable @code{w32-follow-system-dark-mode} to a +@code{nil} value; then Emacs will use the default Light mode +regardless of system-wide settings. Changing the value of this +variable affects only the Emacs frames created after the change, so +you should set its value in your init file (@pxref{Init File}), either +directly or via @kbd{M-x customize-variable}, which lets you save the +customized value, see @ref{Saving Customizations}. @ifnottex @include msdos-xtra.texi diff --git a/etc/NEWS b/etc/NEWS index dd4a9c2afcf..ee113e5614e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1880,6 +1880,16 @@ always omitted, and ignored if present when the object is read back in. * Changes in Emacs 30.1 on Non-Free Operating Systems +** MS-Windows + ++++ +*** You can now opt out of following the system's Dark mode. +By default, Emacs on MS-Windows follows the system's Dark mode for its +title bars' and scroll bars' appearance. If the new user option +'w32-follow-system-dark-mode' is customized to the nil value, Emacs +will disregard the system's Dark mode and will always use the default +Light mode. + ---------------------------------------------------------------------- This file is part of GNU Emacs. diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 36879029282..7e0b64e9067 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -606,6 +606,8 @@ This should only be chosen under exceptional circumstances, since it could result in memory overflow and make Emacs crash." nil)) "27.1") + ;; w32fns.c + (w32-follow-system-dark-mode display boolean "30.1") ;; window.c (temp-buffer-show-function windows (choice (const nil) function)) (next-screen-context-lines windows integer) diff --git a/src/w32fns.c b/src/w32fns.c index f44460e52c0..8d4bd00b91c 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -2376,7 +2376,7 @@ w32_init_class (HINSTANCE hinst) static void w32_applytheme (HWND hwnd) { - if (w32_darkmode) + if (w32_darkmode && w32_follow_system_dark_mode) { /* Set window theme to that of a built-in Windows app (Explorer), because it has dark scroll bars and other UI elements. */ @@ -11393,6 +11393,14 @@ This variable is used for debugging, and takes precedence over any value of the `inhibit-double-buffering' frame parameter. */); w32_disable_double_buffering = false; + DEFVAR_BOOL ("w32-follow-system-dark-mode", w32_follow_system_dark_mode, + doc: /* Whether to follow the system's Dark mode on MS-Windows. +If this is nil, Emacs on MS-Windows will not follow the system's Dark +mode as far as the appearance of title bars and scroll bars is +concerned, it will always use the default Light mode instead. +Changing the value takes effect only for frames created after the change. */); + w32_follow_system_dark_mode = true; + if (os_subtype == OS_SUBTYPE_NT) w32_unicode_gui = 1; else -- cgit v1.2.3 From 37c0607241506540b033e2feebe152e249517794 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 19:15:00 +0200 Subject: ; * lisp/visual-wrap.el (visual-wrap-fill-context-prefix): Doc fix. --- lisp/visual-wrap.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index c23a886801d..809df005dcb 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -112,7 +112,7 @@ extra indent = 2 "")))) (defun visual-wrap-fill-context-prefix (beg end) - "Compute visual wrap prefix from text between FROM and TO. + "Compute visual wrap prefix from text between BEG and END. This is like `fill-context-prefix', but with prefix length adjusted by `visual-wrap-extra-indent'." (let* ((fcp -- cgit v1.2.3 From 6da9dc90481fc5678dd79ac211c9d92b5e1ee8a5 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 27 Jan 2024 19:18:16 +0200 Subject: ; * lisp/visual-wrap.el: Fix typos. --- lisp/visual-wrap.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index 809df005dcb..20e55444082 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -28,7 +28,7 @@ ;; This package provides the `visual-wrap-prefix-mode' minor mode ;; which sets the wrap-prefix property on the fly so that ;; single-long-line paragraphs get word-wrapped in a way similar to -;; what you'd get with M-q using visual-fill-mode, but without +;; what you'd get with M-q using adaptive-fill-mode, but without ;; actually changing the buffer's text. ;;; Code: @@ -165,7 +165,7 @@ by `visual-wrap-extra-indent'." ;; prefix but also the previous newline. So it's not ;; just making the prefix more pretty and could interfere ;; or even defeat our efforts (e.g. it comes from - ;; `visual-fill-mode'). + ;; `adaptive-fill-mode'). (remove-text-properties 0 (length pfx) '(display) pfx))) pfx)))) -- cgit v1.2.3 From 12afe75cf7af99eabf821e40dd2fab2f9c3efcf9 Mon Sep 17 00:00:00 2001 From: Manuel Giraud Date: Sat, 27 Jan 2024 17:23:06 +0100 Subject: Enable marking tagged with ls -F Bug#68637 * lisp/image/image-dired-dired.el (image-dired-mark-tagged-files): Enable marking tagged for executable and symlink images when 'dired-listing-switches' includes -F. --- lisp/image/image-dired-dired.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/image/image-dired-dired.el b/lisp/image/image-dired-dired.el index f4778d8e121..7219a106ca8 100644 --- a/lisp/image/image-dired-dired.el +++ b/lisp/image/image-dired-dired.el @@ -383,7 +383,7 @@ matching tag will be marked in the Dired buffer." (file-name-directory curr-file))) (setq curr-file (file-name-nondirectory curr-file)) (goto-char (point-min)) - (when (search-forward-regexp (format "\\s %s$" curr-file) nil t) + (when (search-forward-regexp (format "\\s %s[*@]?$" curr-file) nil t) (setq hits (+ hits 1)) (dired-mark 1)))) (message "%d files with matching tag marked" hits))) -- cgit v1.2.3 From 54c6588952b469df8d7983b6735461f542cd806e Mon Sep 17 00:00:00 2001 From: Konstantin Kharlamov Date: Fri, 19 Jan 2024 10:33:47 +0300 Subject: Support a local repo as URL in 'treesit-language-source-alist' Sometimes people may need to bisect to find specific revision in a grammar library's repo. In this case they'd want to point the URL to the local repo to avoid cloning it on every rebuild. So add support for a directory instead of URL in 'treesit-language-source-alist'. * lisp/treesit.el (treesit--install-language-grammar-1): Test if URL is a local directory. Then if it is, avoid cloning the repo and removing the path on success. (treesit--git-clone-repo): Factor out the code for cloning to a separate function. (treesit--git-checkout-branch): A helper to checkout the revision for cases where we didn't clone the repo but want it to point the revision. (Bug#68579) --- etc/NEWS | 8 ++++++++ lisp/treesit.el | 46 ++++++++++++++++++++++++++++++++++------------ 2 files changed, 42 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index ee113e5614e..c2bc25d6289 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1877,6 +1877,14 @@ The 'test' parameter is omitted if it is 'eql' (the default), as is 'data' if empty. 'rehash-size', 'rehash-threshold' and 'size' are always omitted, and ignored if present when the object is read back in. ++++ +** 'treesit-install-language-grammar' can handle local directory instead of URL. +It is now possible to pass a directory of a local repository as URL +inside 'treesit-language-source-alist', so that calling +'treesit-install-language-grammar' would avoid cloning the repository. +It may be useful, for example, for the purposes of bisecting a +treesitter grammar. + * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/lisp/treesit.el b/lisp/treesit.el index 89f688b61c1..d1e0beaaac9 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -3417,7 +3417,8 @@ The value should be an alist where each element has the form (LANG . (URL REVISION SOURCE-DIR CC C++)) Only LANG and URL are mandatory. LANG is the language symbol. -URL is the Git repository URL for the grammar. +URL is the URL of the grammar's Git repository or a directory +where the repository has been cloned. REVISION is the Git tag or branch of the desired version, defaulting to the latest default branch. @@ -3551,6 +3552,26 @@ content as signal data, and erase buffer afterwards." (buffer-string))) (erase-buffer))) +(defun treesit--git-checkout-branch (repo-dir revision) + "Checkout REVISION in a repo located in REPO-DIR." + (treesit--call-process-signal + "git" nil t nil "-C" repo-dir "checkout" revision)) + +(defun treesit--git-clone-repo (url revision workdir) + "Clone repo pointed by URL at commit REVISION to WORKDIR. + +REVISION may be nil, in which case the cloned repo will be at its +default branch." + (message "Cloning repository") + ;; git clone xxx --depth 1 --quiet [-b yyy] workdir + (if revision + (treesit--call-process-signal + "git" nil t nil "clone" url "--depth" "1" "--quiet" + "-b" revision workdir) + (treesit--call-process-signal + "git" nil t nil "clone" url "--depth" "1" "--quiet" + workdir))) + (defun treesit--install-language-grammar-1 (out-dir lang url &optional revision source-dir cc c++) "Install and compile a tree-sitter language grammar library. @@ -3564,8 +3585,12 @@ For LANG, URL, REVISION, SOURCE-DIR, GRAMMAR-DIR, CC, C++, see `treesit-language-source-alist'. If anything goes wrong, this function signals an error." (let* ((lang (symbol-name lang)) + (maybe-repo-dir (expand-file-name url)) + (url-is-dir (file-accessible-directory-p maybe-repo-dir)) (default-directory (make-temp-file "treesit-workdir" t)) - (workdir (expand-file-name "repo")) + (workdir (if url-is-dir + maybe-repo-dir + (expand-file-name "repo"))) (source-dir (expand-file-name (or source-dir "src") workdir)) (cc (or cc (seq-find #'executable-find '("cc" "gcc" "c99")) ;; If no C compiler found, just use cc and let @@ -3580,15 +3605,10 @@ function signals an error." (lib-name (concat "libtree-sitter-" lang soext))) (unwind-protect (with-temp-buffer - (message "Cloning repository") - ;; git clone xxx --depth 1 --quiet [-b yyy] workdir - (if revision - (treesit--call-process-signal - "git" nil t nil "clone" url "--depth" "1" "--quiet" - "-b" revision workdir) - (treesit--call-process-signal - "git" nil t nil "clone" url "--depth" "1" "--quiet" - workdir)) + (if url-is-dir + (when revision + (treesit--git-checkout-branch workdir revision)) + (treesit--git-clone-repo url revision workdir)) ;; We need to go into the source directory because some ;; header files use relative path (#include "../xxx"). ;; cd "${sourcedir}" @@ -3635,7 +3655,9 @@ function signals an error." ;; Ignore errors, in case the old version is still used. (ignore-errors (delete-file old-fname))) (message "Library installed to %s/%s" out-dir lib-name)) - (when (file-exists-p workdir) + ;; Remove workdir if it's not a repo owned by user and we + ;; managed to create it in the first place. + (when (and (not url-is-dir) (file-exists-p workdir)) (delete-directory workdir t))))) ;;; Etc -- cgit v1.2.3 From 3c680968e492acf8891fda22c28baef5078ca768 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Wed, 24 Jan 2024 18:32:00 -0800 Subject: Fix command replacement with the Eshell builtin versions of "sudo" and "doas" This is particularly important when the inner command to execute is an alias. Aliases throw 'eshell-replace-command' too, so we want to do this in two phases: first, replace the "sudo"/"doas" with a let-binding of 'default-directory', and then later, let the alias code do its own replacement (bug#68074). * lisp/eshell/em-tramp.el (eshell/sudo, eshell/doas): Use 'eshell-replace-command' to wrap the inner command. * test/lisp/eshell/em-tramp-tests.el (mock-eshell-named-command): Remove. (em-tramp-test/sudo-basic, em-tramp-test/sudo-user) (em-tramp-test/doas-basic, em-tramp-test/doas-user): Catch 'eshell-replace-command'. --- lisp/eshell/em-tramp.el | 22 +++++----- test/lisp/eshell/em-tramp-tests.el | 89 +++++++++++++++++--------------------- 2 files changed, 50 insertions(+), 61 deletions(-) (limited to 'lisp') diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el index 90f9c6cf78d..efb37225651 100644 --- a/lisp/eshell/em-tramp.el +++ b/lisp/eshell/em-tramp.el @@ -121,12 +121,11 @@ Uses the system sudo through Tramp's sudo method." :usage "[(-u | --user) USER] (-s | --shell) | COMMAND Execute a COMMAND as the superuser or another USER.") (let ((dir (eshell--method-wrap-directory default-directory "sudo" user))) - (if shell - (throw 'eshell-replace-command - (eshell-parse-command "cd" (list dir))) - (throw 'eshell-external - (let ((default-directory dir)) - (eshell-named-command (car args) (cdr args)))))))) + (throw 'eshell-replace-command + (if shell + (eshell-parse-command "cd" (list dir)) + `(let ((default-directory ,dir)) + (eshell-named-command ',(car args) ',(cdr args)))))))) (put 'eshell/sudo 'eshell-no-numeric-conversions t) @@ -144,12 +143,11 @@ Uses the system doas through Tramp's doas method." :usage "[(-u | --user) USER] (-s | --shell) | COMMAND Execute a COMMAND as the superuser or another USER.") (let ((dir (eshell--method-wrap-directory default-directory "doas" user))) - (if shell - (throw 'eshell-replace-command - (eshell-parse-command "cd" (list dir))) - (throw 'eshell-external - (let ((default-directory dir)) - (eshell-named-command (car args) (cdr args)))))))) + (throw 'eshell-replace-command + (if shell + (eshell-parse-command "cd" (list dir)) + `(let ((default-directory ,dir)) + (eshell-named-command ',(car args) ',(cdr args)))))))) (put 'eshell/doas 'eshell-no-numeric-conversions t) diff --git a/test/lisp/eshell/em-tramp-tests.el b/test/lisp/eshell/em-tramp-tests.el index d33f6a2b46a..3be5d3542ca 100644 --- a/test/lisp/eshell/em-tramp-tests.el +++ b/test/lisp/eshell/em-tramp-tests.el @@ -59,35 +59,31 @@ "cd" (list ,(format "/su:root@%s:~/" tramp-default-host)))))) -(defun mock-eshell-named-command (&rest args) - "Dummy function to test Eshell `sudo' command rewriting." - (list default-directory args)) - (ert-deftest em-tramp-test/sudo-basic () "Test Eshell `sudo' command with default user." - (cl-letf (((symbol-function 'eshell-named-command) - #'mock-eshell-named-command)) - (should (equal - (catch 'eshell-external (eshell/sudo "echo" "hi")) - `(,(format "/sudo:root@%s:%s" tramp-default-host default-directory) - ("echo" ("hi"))))) - (should (equal - (catch 'eshell-external (eshell/sudo "echo" "-u" "hi")) - `(,(format "/sudo:root@%s:%s" tramp-default-host default-directory) - ("echo" ("-u" "hi"))))))) + (let ((sudo-directory (format "/sudo:root@%s:%s" + tramp-default-host default-directory))) + (should (equal (catch 'eshell-replace-command + (eshell/sudo "echo" "hi")) + `(let ((default-directory ,sudo-directory)) + (eshell-named-command '"echo" '("hi"))))) + (should (equal (catch 'eshell-replace-command + (eshell/sudo "echo" "-u" "hi")) + `(let ((default-directory ,sudo-directory)) + (eshell-named-command '"echo" '("-u" "hi"))))))) (ert-deftest em-tramp-test/sudo-user () "Test Eshell `sudo' command with specified user." - (cl-letf (((symbol-function 'eshell-named-command) - #'mock-eshell-named-command)) - (should (equal - (catch 'eshell-external (eshell/sudo "-u" "USER" "echo" "hi")) - `(,(format "/sudo:USER@%s:%s" tramp-default-host default-directory) - ("echo" ("hi"))))) - (should (equal - (catch 'eshell-external (eshell/sudo "-u" "USER" "echo" "-u" "hi")) - `(,(format "/sudo:USER@%s:%s" tramp-default-host default-directory) - ("echo" ("-u" "hi"))))))) + (let ((sudo-directory (format "/sudo:USER@%s:%s" + tramp-default-host default-directory))) + (should (equal (catch 'eshell-replace-command + (eshell/sudo "-u" "USER" "echo" "hi")) + `(let ((default-directory ,sudo-directory)) + (eshell-named-command '"echo" '("hi"))))) + (should (equal (catch 'eshell-replace-command + (eshell/sudo "-u" "USER" "echo" "-u" "hi")) + `(let ((default-directory ,sudo-directory)) + (eshell-named-command '"echo" '("-u" "hi"))))))) (ert-deftest em-tramp-test/sudo-shell () "Test Eshell `sudo' command with -s/--shell option." @@ -109,34 +105,29 @@ (ert-deftest em-tramp-test/doas-basic () "Test Eshell `doas' command with default user." - (cl-letf (((symbol-function 'eshell-named-command) - #'mock-eshell-named-command)) - (should (equal - (catch 'eshell-external (eshell/doas "echo" "hi")) - `(,(format "/doas:root@%s:%s" - tramp-default-host default-directory) - ("echo" ("hi"))))) - (should (equal - (catch 'eshell-external (eshell/doas "echo" "-u" "hi")) - `(,(format "/doas:root@%s:%s" - tramp-default-host default-directory) - ("echo" ("-u" "hi"))))))) + (let ((doas-directory (format "/doas:root@%s:%s" + tramp-default-host default-directory))) + (should (equal (catch 'eshell-replace-command + (eshell/doas "echo" "hi")) + `(let ((default-directory ,doas-directory)) + (eshell-named-command '"echo" '("hi"))))) + (should (equal (catch 'eshell-replace-command + (eshell/doas "echo" "-u" "hi")) + `(let ((default-directory ,doas-directory)) + (eshell-named-command '"echo" '("-u" "hi"))))))) (ert-deftest em-tramp-test/doas-user () "Test Eshell `doas' command with specified user." - (cl-letf (((symbol-function 'eshell-named-command) - #'mock-eshell-named-command)) - (should (equal - (catch 'eshell-external (eshell/doas "-u" "USER" "echo" "hi")) - `(,(format "/doas:USER@%s:%s" - tramp-default-host default-directory) - ("echo" ("hi"))))) - (should (equal - (catch 'eshell-external - (eshell/doas "-u" "USER" "echo" "-u" "hi")) - `(,(format "/doas:USER@%s:%s" - tramp-default-host default-directory) - ("echo" ("-u" "hi"))))))) + (let ((doas-directory (format "/doas:USER@%s:%s" + tramp-default-host default-directory))) + (should (equal (catch 'eshell-replace-command + (eshell/doas "-u" "USER" "echo" "hi")) + `(let ((default-directory ,doas-directory)) + (eshell-named-command '"echo" '("hi"))))) + (should (equal (catch 'eshell-replace-command + (eshell/doas "-u" "USER" "echo" "-u" "hi")) + `(let ((default-directory ,doas-directory)) + (eshell-named-command '"echo" '("-u" "hi"))))))) (ert-deftest em-tramp-test/doas-shell () "Test Eshell `doas' command with -s/--shell option." -- cgit v1.2.3 From 236317e5d2284399d6ca0413ea2a29b84270d545 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sat, 27 Jan 2024 22:03:28 -0800 Subject: Fix treesit-range-rules * lisp/treesit.el (treesit-range-rules): Reset :local like other keywords. The other chunk is indentation fix. --- lisp/treesit.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index d1e0beaaac9..96222ed81cb 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -595,8 +595,8 @@ that encompasses the region between START and END." (unless (and (consp range-offset) (numberp (car range-offset)) (numberp (cdr range-offset))) - (signal 'treesit-error (list "Value of :offset option should be a pair of numbers" range-offset))) - (setq offset range-offset))) + (signal 'treesit-error (list "Value of :offset option should be a pair of numbers" range-offset))) + (setq offset range-offset))) (query (if (functionp query) (push (list query nil nil) result) (when (null embed) @@ -606,7 +606,7 @@ that encompasses the region between START and END." (push (list (treesit-query-compile host query) embed local offset) result)) - (setq host nil embed nil offset nil)))) + (setq host nil embed nil offset nil local nil)))) (nreverse result))) (defun treesit--merge-ranges (old-ranges new-ranges start end) -- cgit v1.2.3 From a3cd284b90edcc7e06b21110cdbf55d11fb6fd0d Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Sat, 4 Mar 2023 22:11:23 -0800 Subject: Support setting umask symbolically in Eshell * lisp/eshell/em-basic.el (eshell/umask): Handle setting umask symbolically, and make setting umask take precedence over "-S". * test/lisp/eshell/em-basic-tests.el (em-basic-test/umask-print-numeric, em-basic-test/umask-read-symbolic, em-basic-test/umask-set): Rename to... (em-basic-test/umask/print-numeric) (em-basic-test/umask/print-symbolic, em-basic-test/umask/set-numeric): ... these. (em-basic-test/umask/set-symbolic, em-basic-test/umask/set-with-S): New tests. * etc/NEWS: Announce this change. --- etc/NEWS | 8 ++++++++ lisp/eshell/em-basic.el | 24 ++++++++++++++---------- test/lisp/eshell/em-basic-tests.el | 34 ++++++++++++++++++++++++++++++---- 3 files changed, 52 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index c2bc25d6289..061ac9a7d10 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -678,6 +678,14 @@ command passed as arguments to 'env'. If you pass any initial arguments of the form 'VAR=VALUE', 'env' will first set 'VAR' to 'VALUE' before running the command. +--- +*** Eshell's 'umask' command now supports setting the mask symbolically. +Now, you can pass an argument like "u+w,o-r" to Eshell's 'umask' +command, which will give write permission for owners of newly-created +files and deny read permission for users who are not members of the +file's group. See the Info node '(coreutils)File permissions' for +more information on this notation. + +++ *** New special reference type '#'. This special reference type returns a marker at 'POSITION' in diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el index 8f68a750bd7..6ec53ef9412 100644 --- a/lisp/eshell/em-basic.el +++ b/lisp/eshell/em-basic.el @@ -160,6 +160,18 @@ or `eshell-printn' for display." :preserve-args :usage "[-S] [mode]") (cond + (args + (let* ((mask (car args)) + (modes + (if (stringp mask) + (if (string-match (rx bos (+ (any "0-7")) eos) mask) + (- #o777 (string-to-number mask 8)) + (file-modes-symbolic-to-number + mask (default-file-modes))) + (- #o777 mask)))) + (set-default-file-modes modes) + (eshell-print + "Warning: umask changed for all new files created by Emacs.\n"))) (symbolic-p (let ((mode (default-file-modes))) (eshell-printn @@ -173,17 +185,9 @@ or `eshell-printn' for display." (concat (and (= (logand mode 1) 1) "r") (and (= (logand mode 2) 2) "w") (and (= (logand mode 4) 4) "x")))))) - ((not args) - (eshell-printn (format "%03o" (logand (lognot (default-file-modes)) - #o777)))) (t - (when (stringp (car args)) - (if (string-match "^[0-7]+$" (car args)) - (setcar args (string-to-number (car args) 8)) - (error "Setting umask symbolically is not yet implemented"))) - (set-default-file-modes (- #o777 (car args))) - (eshell-print - "Warning: umask changed for all new files created by Emacs.\n"))) + (eshell-printn (format "%03o" (logand (lognot (default-file-modes)) + #o777))))) nil)) (put 'eshell/umask 'eshell-no-numeric-conversions t) diff --git a/test/lisp/eshell/em-basic-tests.el b/test/lisp/eshell/em-basic-tests.el index 960e04690a5..ebb91cdeea0 100644 --- a/test/lisp/eshell/em-basic-tests.el +++ b/test/lisp/eshell/em-basic-tests.el @@ -33,7 +33,7 @@ ;;; Tests: -(ert-deftest em-basic-test/umask-print-numeric () +(ert-deftest em-basic-test/umask/print-numeric () "Test printing umask numerically." (cl-letf (((symbol-function 'default-file-modes) (lambda () #o775))) (eshell-command-result-equal "umask" "002\n")) @@ -43,7 +43,7 @@ (cl-letf (((symbol-function 'default-file-modes) (lambda () #o1775))) (eshell-command-result-equal "umask" "002\n"))) -(ert-deftest em-basic-test/umask-read-symbolic () +(ert-deftest em-basic-test/umask/print-symbolic () "Test printing umask symbolically." (cl-letf (((symbol-function 'default-file-modes) (lambda () #o775))) (eshell-command-result-equal "umask -S" @@ -56,8 +56,8 @@ (eshell-command-result-equal "umask -S" "u=rwx,g=rwx,o=rx\n"))) -(ert-deftest em-basic-test/umask-set () - "Test setting umask." +(ert-deftest em-basic-test/umask/set-numeric () + "Test setting umask numerically." (let ((file-modes 0)) (cl-letf (((symbol-function 'set-default-file-modes) (lambda (mode) (setq file-modes mode)))) @@ -68,4 +68,30 @@ (eshell-test-command-result "umask $(identity #o222)") (should (= file-modes #o555))))) +(ert-deftest em-basic-test/umask/set-symbolic () + "Test setting umask symbolically." + (let ((file-modes 0)) + (cl-letf (((symbol-function 'default-file-modes) + (lambda() file-modes)) + ((symbol-function 'set-default-file-modes) + (lambda (mode) (setq file-modes mode)))) + (eshell-test-command-result "umask u=rwx,g=rwx,o=rx") + (should (= file-modes #o775)) + (eshell-test-command-result "umask u=rw,g=rx,o=x") + (should (= file-modes #o651)) + (eshell-test-command-result "umask u+x,o-x") + (should (= file-modes #o750)) + (eshell-test-command-result "umask a+rx") + (should (= file-modes #o755))))) + +(ert-deftest em-basic-test/umask/set-with-S () + "Test that passing \"-S\" and a umask still sets the umask." + (let ((file-modes 0)) + (cl-letf (((symbol-function 'set-default-file-modes) + (lambda (mode) (setq file-modes mode)))) + (eshell-test-command-result "umask -S 002") + (should (= file-modes #o775)) + (eshell-test-command-result "umask -S 123") + (should (= file-modes #o654))))) + ;; em-basic-tests.el ends here -- cgit v1.2.3 From c4d16909fa4c30fd5f11bd66de7936790349cb7d Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Tue, 15 Aug 2023 18:52:11 -0700 Subject: ; Be more strict with command arguments for a few Eshell commands * lisp/eshell/em-dirs.el (eshell/pwd): * lisp/eshell/em-unix.el (eshell/whoami): * lisp/eshell/esh-proc.el (eshell/jobs): Don't accept arguments. --- lisp/eshell/em-dirs.el | 2 +- lisp/eshell/em-unix.el | 2 +- lisp/eshell/esh-proc.el | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index cf90a8bb230..85036620c57 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -316,7 +316,7 @@ Thus, this does not include the current directory.") (`(boundaries . ,suffix) `(boundaries 0 . ,(string-search "/" suffix)))))))))) -(defun eshell/pwd (&rest _args) +(defun eshell/pwd () "Change output from `pwd' to be cleaner." (let* ((path default-directory) (len (length path))) diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index dad02206759..c3c3fea691a 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -1018,7 +1018,7 @@ Show wall-clock time elapsed during execution of COMMAND.") (eshell-stringify-list (flatten-tree (cdr time-args)))))))) -(defun eshell/whoami (&rest _args) +(defun eshell/whoami () "Make \"whoami\" Tramp aware." (eshell-user-login-name)) diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 2bb0043bddb..35c81f6a4b2 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -193,7 +193,7 @@ This is like `process-live-p', but additionally checks whether (defalias 'eshell/wait #'eshell-wait-for-process) -(defun eshell/jobs (&rest _args) +(defun eshell/jobs () "List processes, if there are any." (and (fboundp 'process-list) (process-list) -- cgit v1.2.3 From 78fc49407b8ef8ec649fe70fcce09101801dbc05 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 28 Jan 2024 16:31:33 +0800 Subject: Improve filling of ChangeLog entries * lisp/vc/log-edit.el (log-edit--insert-filled-defuns): Rewrite completely. (log-edit-fill-entry): Abandon pcase and cl-lib. --- lisp/vc/log-edit.el | 133 +++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 101 insertions(+), 32 deletions(-) (limited to 'lisp') diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 72867f14d2f..5f370511b14 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -575,19 +575,79 @@ the \\[vc-prefix-map] prefix for VC commands, for example). "Insert FUNC-NAMES, following ChangeLog formatting." (if (not func-names) (insert ":") + ;; Insert a space unless this list of file names is being inserted + ;; at the start of a line or after a space character. (unless (or (memq (char-before) '(?\n ?\s)) (> (current-column) fill-column)) (insert " ")) - (cl-loop for first-fun = t then nil - for def in func-names do - (when (> (+ (current-column) (string-width def)) fill-column) - (unless first-fun - (insert ")")) - (insert "\n")) - (insert (if (memq (char-before) '(?\n ?\s)) - "(" ", ") - def)) - (insert "):"))) + (let ((inside-paren-pair nil) + (first-line t) + name) + ;; Now insert the functions names one by one, inserting newlines + ;; as appropriate. + (while func-names + (setq name (car func-names)) + (setq func-names (cdr func-names)) + ;; If inserting `name' in at the current column would overflow + ;; the fill column, place it on its own line. + (if (and first-line + (> (+ (current-column) + (string-width name) + ;; If this be the last name, the column must be + ;; followed by an extra colon character. + (if func-names 1 2)) + fill-column)) + (progn + (insert "\n") + ;; Iterate over this function name again. + (setq func-names (cons name func-names))) + (if inside-paren-pair + ;; If `name' is not the first item in a list of defuns + ;; and inserting it would overflow the fill column, + ;; start a new list of defuns on the next line. + (if (> (+ (current-column) + (string-width name) + ;; If this be the last name, the column must + ;; be followed by an extra colon character; + ;; however, there are two separator characters + ;; that will be deleted, so the number of + ;; columns to add to this in the case of + ;; `name' being final and in other cases are + ;; -1 and -2 respectively. + (if func-names -1 -2)) + fill-column) + (progn + (delete-char -2) + (insert ")\n") + (setq inside-paren-pair nil + ;; Iterate over this function name again. + func-names (cons name func-names))) + ;; Insert this file name with a separator attached. + (insert name ", ")) + ;; Otherwise, decide whether to start a list of defuns or + ;; to insert `name' on its own line. + (if (> (+ (current-column) + (string-width name) + (if func-names 1 2)) ; The column number of + ; line after inserting + ; `name'... + fill-column) + ;; ...would leave insufficient space for any subsequent + ;; file names, so insert it on its own line. + (insert (if func-names + (format "(%s)\n" name) + (format "(%s):" name))) + ;; Insert a new defun list, unless `name' is the last + ;; function name. + (insert (if (not func-names) + (format "(%s):" name) + (setq inside-paren-pair t) + (format "(%s, " name)))))) + (setq first-line nil)) + ;; Close any open list of defuns. + (when inside-paren-pair + (delete-char -2) + (insert "):"))))) (defun log-edit-fill-entry (&optional justify) "Like \\[fill-paragraph], but for filling ChangeLog-formatted entries. @@ -595,32 +655,41 @@ Consecutive function entries without prose (i.e., lines of the form \"(FUNCTION):\") will be combined into \"(FUNC1, FUNC2):\" according to `fill-column'." (save-excursion - (pcase-let ((`(,beg ,end) (log-edit-changelog-paragraph))) + (let* ((range (log-edit-changelog-paragraph)) + (beg (car range)) + (end (cadr range))) (if (= beg end) ;; Not a ChangeLog entry, fill as normal. nil - (cl-callf copy-marker end) + (setq end (copy-marker end)) (goto-char beg) - (cl-loop - for defuns-beg = - (and (< beg end) - (re-search-forward - (concat "\\(?1:" change-log-unindented-file-names-re - "\\)\\|^\\(?1:\\)[[:blank:]]*(") - end t) - (copy-marker (match-end 1))) - ;; Fill prose between log entries. - do (let ((fill-indent-according-to-mode t) - (end (if defuns-beg (match-beginning 0) end)) - (beg (progn (goto-char beg) (line-beginning-position)))) - (when (<= (line-end-position) end) - (fill-region beg end justify))) - while defuns-beg - for defuns = (progn (goto-char defuns-beg) - (change-log-read-defuns end)) - do (progn (delete-region defuns-beg (point)) - (log-edit--insert-filled-defuns defuns) - (setq beg (point)))) + (let* ((defuns-beg nil) + (defuns nil)) + (while + (progn + (setq defuns-beg + (and (< beg end) + (re-search-forward + (concat "\\(?1:" + change-log-unindented-file-names-re + "\\)\\|^\\(?1:\\)[[:blank:]]*(") + end t) + (copy-marker (match-end 1)))) + (let ((fill-indent-according-to-mode t) + (end (if defuns-beg + (match-beginning 0) end)) + (beg (progn (goto-char beg) + (line-beginning-position)))) + (when (<= (line-end-position) end) + (fill-region beg end justify))) + defuns-beg) + (goto-char defuns-beg) + (setq defuns (change-log-read-defuns end)) + (progn + (delete-region defuns-beg (point)) + (log-edit--insert-filled-defuns defuns) + (setq beg (point)))) + nil) t)))) (defun log-edit-hide-buf (&optional buf where) -- cgit v1.2.3 From adf32eb69ea34b9c057c9a4321e5f05b00a7c940 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 28 Jan 2024 16:55:56 +0800 Subject: ; Correct typo * lisp/vc/log-edit.el (log-edit--insert-filled-defuns): Correct typo in alignment constants. --- lisp/vc/log-edit.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 5f370511b14..b5f12f0b4fc 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -612,9 +612,9 @@ the \\[vc-prefix-map] prefix for VC commands, for example). ;; however, there are two separator characters ;; that will be deleted, so the number of ;; columns to add to this in the case of - ;; `name' being final and in other cases are - ;; -1 and -2 respectively. - (if func-names -1 -2)) + ;; `name' being final and in other cases are 0 + ;; and 1 respectively. + (if func-names 0 1)) fill-column) (progn (delete-char -2) -- cgit v1.2.3 From 833d2636ff8a65c9f9f982618f1974d424baa3fe Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 28 Jan 2024 17:08:50 +0800 Subject: ; * lisp/vc/log-edit.el (log-edit--insert-filled-defuns): Fix typos. --- lisp/vc/log-edit.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index b5f12f0b4fc..b847fb953f2 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -575,8 +575,8 @@ the \\[vc-prefix-map] prefix for VC commands, for example). "Insert FUNC-NAMES, following ChangeLog formatting." (if (not func-names) (insert ":") - ;; Insert a space unless this list of file names is being inserted - ;; at the start of a line or after a space character. + ;; Insert a space unless this list of defun names is being + ;; inserted at the start of a line or after a space character. (unless (or (memq (char-before) '(?\n ?\s)) (> (current-column) fill-column)) (insert " ")) @@ -622,7 +622,7 @@ the \\[vc-prefix-map] prefix for VC commands, for example). (setq inside-paren-pair nil ;; Iterate over this function name again. func-names (cons name func-names))) - ;; Insert this file name with a separator attached. + ;; Insert this defun name with a separator attached. (insert name ", ")) ;; Otherwise, decide whether to start a list of defuns or ;; to insert `name' on its own line. @@ -632,8 +632,9 @@ the \\[vc-prefix-map] prefix for VC commands, for example). ; line after inserting ; `name'... fill-column) - ;; ...would leave insufficient space for any subsequent - ;; file names, so insert it on its own line. + ;; ...would leave insufficient space for any + ;; subsequent defun names so insert it on its own + ;; line. (insert (if func-names (format "(%s)\n" name) (format "(%s):" name))) -- cgit v1.2.3 From e11c9f9c6e843779c4b69097490dd78de522a79d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 28 Jan 2024 10:31:45 +0100 Subject: Handle wrong login program in Tramp * lisp/net/tramp-sh.el (tramp-maybe-open-connection): Exit remote shell when login fails. --- lisp/net/tramp-sh.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 38925652376..1301cd633da 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -5340,7 +5340,7 @@ connection if a previous connection has died for some reason." "2>" (tramp-get-remote-null-device previous-hop)) ?l (concat remote-shell " " extra-args " -i")) ;; A restricted shell does not allow "exec". - (when r-shell '("&&" "exit" "||" "exit"))) + (when r-shell '("&&" "exit")) '("||" "exit")) " ")) ;; Send the command. -- cgit v1.2.3 From 71b5d5a9799a37948b2e8cca125a59e2bfb71e96 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 28 Jan 2024 16:59:50 +0100 Subject: ; Fix typos --- admin/codespell/codespell.exclude | 70 ++++++++++++++++------ doc/emacs/buffers.texi | 2 +- doc/misc/ses.texi | 2 +- lisp/progmodes/hideif.el | 2 +- src/eval.c | 4 +- src/xdisp.c | 2 +- .../lisp/erc/erc-scenarios-keep-place-indicator.el | 2 +- test/lisp/erc/resources/erc-tests-common.el | 2 +- .../progmodes/elixir-ts-mode-resources/indent.erts | 2 +- test/src/comp-tests.el | 2 +- 10 files changed, 62 insertions(+), 28 deletions(-) (limited to 'lisp') diff --git a/admin/codespell/codespell.exclude b/admin/codespell/codespell.exclude index 2503f4a9a16..416d79cf131 100644 --- a/admin/codespell/codespell.exclude +++ b/admin/codespell/codespell.exclude @@ -1,3 +1,54 @@ + say "And this happens inbetween"; + @ture) + ($sig,$na,@ture) +($sig,$na,@ture) +@ture) +((squery 10 "SQUERY alis :help list") + (0.01 ":Alis@hub.uk NOTICE tester :See also: HELP EXAMPLES")) + (0.04 ":Alis@hub.uk NOTICE tester :[...]") + (0.01 ":Alis@hub.uk NOTICE tester :/SQUERY Alis LIST mask [-options]") + (0.08 ":Alis@hub.uk NOTICE tester :Searches for a channel") + (erc-scenarios-common-say "/SQUERY alis help list") + (should (equal '((regexp . "(string-match-p \"^[fo]+\" \"foobar\")\n => 0")) + (or "comm" "comma" "comman" "command" "commands" + (when (and (not (or skipp erc-timestamp-format)) + (unless skipp + (skipp (or (and erc-stamp--skip-when-invisible invisible) +;; if you type "foo", but typing just "fo" doesn't show the preview. + (Emacs main thre), pid 32619 (org.gnu.emacs) +F DEBUG : pid: 32619, tid: 32644, name: Emacs main thre >>> org.gnu.emacs <<< + bnez $t2, .filld # start filling longs + j .filld # fill either doubleword or byte +.filld: + + (0.01 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:08:40] alice: My sons would never so dishonour me.") + interger intger lits bool boolen constant filename + with typess = (sort (mapcar #'comp-supertypes + for types in typess +;; FIXME: normalise `seq', both the construct and implicit sequences, +;; `intersection', we may end up normalising subtrees multiple times +;; One way to avoid this is to aggressively normalise the entire tree +;; Such normalisation could normalise synonyms, eliminate `minimal-match' + ;; Normalise the constructor to `or' and the args recursively. + "Intersection of the normalised FORMS, as an interval set." +FORM must be normalised (from `rx--normalise-char-pattern')." + "Optimise `or' arguments. Return a new rx form. +Each element of ARGS should have been normalised using + (search-forward "retur") ; leaves point before the "n" +with typess = (sort (mapcar #'comp-supertypes + (font-spec :registry "iso10646-1" :otf '(khmr nil (pres))))) +(0.01 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:08:40] alice: My sons would never so dishonour me.") + (0.05 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :alice: Pawn me to this your honour, she is his.")) + (funcall expect 1 "Entirely honour")) + (0 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :You have paid the heavens your function, and the prisoner the very debt of your calling. I have laboured for the poor gentleman to the extremest shore of my modesty; but my brother justice have I found so severe, that he hath forced me to tell him he is indeed Justice.") + (0.00 ":irc.example.net 501 tester x :is not a recognised user mode.") + (0.00 ":irc.example.net 501 dummy` x :is not a recognised user mode.") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #utf-8 :alice: Entirely honour; I would not be delay'd.")) + integer integer list bool boolean constant filename + "def" "defi" "defin" "define" + "doc" "docu" "docum" "docume" "documen" "document" + case Aadd : overflow = ckd_add (&a, accum, next); break; + And this the second, again with the same distinction therefrom. Bonus: Return a cons cell: (COMPILED . UPTODATE). Bonus: Return a cons cell: (COMPILED . UPTODATE)." (defun semantic-grammar-create-package (&optional force uptodate) @@ -57,7 +108,6 @@ order but are now listed consecutively en bloc. 2003-06-11 Daniel Néri 2001-07-26 10:00:00 Steven E. Harris 2001-01-15 Jack Twilley - matching LAMDA as a word. Noted by Stefan Monnier. completion variant for every "LAMDA" name (bug#30513). "foto" @@ -195,7 +245,7 @@ mode setting. With the Inverse flag [@code{alog}], this command is @r{ a b@: I B @: @: 2 @:alog@:(a,b) b^a} @r{ a b@: I f I @: @: 2 @:alog@:(a,b) b^a} Change comment about the iif hook to reflect the actual reason. - "I + E (ln), L (exp), B (alog: B^X); f E (lnp1), f L (expm1)" + "\\`I' + \\`E' (ln), \\`L' (exp), \\`B' (alog: B^X); \\`f E' (lnp1), \\`f L' (expm1)" (let (numer denom) (setq numer (car (math-read-expr-list))) (if (and (Math-num-integerp numer) @@ -1177,9 +1227,6 @@ In CLOS, the argument list is (CLASS OBJECT SLOT-NAME), but const char *cm_right; /* right (nd) */ (should (equal (ert-test-result-messages result) "a\nb\nc\nd\n"))))) (insert "a\nb\nc\nd\n") - (insert "a\nb\nc\nd\n") - (insert "a\nb\nc\nd\n") - (insert "a\nb\nc\nd\n") (insert "a\nb\nc\nd\n") (should (string= (buffer-string) "Abc\nd efg\n(h ijk).")))) (nd (read-directory-name "Create directory: " @@ -1192,7 +1239,6 @@ DESCRIPTION:In this meeting\\, we will cover topics from product and enginee ;; RFC5546 refers to uninvited attendees as "party crashers". That includes both spelling (e.g., "behavior", not "behaviour") and * doc/lispref/control.texi (Signalling Errors) - * doc/lispref/control.texi (Signalling Errors) Re "behavior" vs "behaviour", etc. + [[https://protesilaos.com/codelog/2020-07-08-modus-themes-nuanced-colours/][Modus themes: major review of "nuanced" colours]] (2020-07-08) + [[https://protesilaos.com/codelog/2020-09-14-modus-themes-review-blues/][Modus themes: review of blue colours]] (2020-09-14) @@ -1256,7 +1302,6 @@ Put dialogue in buffer." "Given start brace BRA, and end brace KET, expand one line into many lines." (regexp-quote ket) (int-to-string (car vec)) ket sig-tail "\n")) - "Given start brace BRA, and end brace KET, expand one line into many lines." m | mo | mot | moti | motif ) val=motif ;; i | in | ino | inot | inoti | inotif | inotify ) val=inotify ;; 2001-04-23 Kahlil Hodgson @@ -1270,14 +1315,11 @@ Put dialogue in buffer." Rename from whitespace-skipping-for-quotes-not-ouside. (whitespace-skipping-for-quotes-not-ouside) Thread-Modell: posix -Thread-Modell: posix (ert-deftest indent-sexp-cant-go () (ert-deftest thunk-let-bound-vars-cant-be-set-test () (mml-secure-cust-fpr-lookup context 'encrypt "sub@example.org"))) (let ((p-e-fprs (mml-secure-cust-fpr-lookup (p-s-fprs (mml-secure-cust-fpr-lookup - (let ((p-e-fprs (mml-secure-cust-fpr-lookup - (p-s-fprs (mml-secure-cust-fpr-lookup (let ((s-e-fprs (mml-secure-cust-fpr-lookup (s-s-fprs (mml-secure-cust-fpr-lookup (ert-deftest doesnt-time-out () @@ -1308,7 +1350,6 @@ doc/emacs/docstyle.texi:14: fied ==> field * follow.el (follow-inactive-menu): Rename from follow-deactive-menu. * emacs-lisp/cconv.el (cconv-analyse-form): Warn use of ((λ ...) ...). (feedmail-sendmail-f-doesnt-sell-me-out) - (feedmail-sendmail-f-doesnt-sell-me-out) Respect feedmail-sendmail-f-doesnt-sell-me-out. * terminal.el (te-get-char, te-tic-sentinel): from server-external-socket-initialised, since it should be @@ -1401,7 +1442,6 @@ Paul Raines (raines at slac.stanford.edu), (car secnd))) ; fetch_date secnd (cdr secnd)) (car secnd))) ; Keep_flag - secnd (cdr secnd)) (car secnd))) ; NOV_entry_position @c LocalWords: DesBrisay Dcc devel dir dired docstring filll forw Older versions of the themes provided options ~grayscale~ (or ~greyscale~) @@ -1450,14 +1490,12 @@ DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0, 2006-10-12 Magnus Henoch 2006-10-11 Magnus Henoch 2006-10-09 Magnus Henoch -2008-10-16 Magnus Henoch 2007-12-31 Magnus Henoch 2007-12-05 Magnus Henoch (ENUMABLE): Remove; no longer needed. * lisp.h (ENUMABLE) [!_AIX]: Don't define to 0 merely because we're * lisp.h (ENUMABLE, DEFINE_GDB_SYMBOL_ENUM): New macros. * lisp.h (ENUMABLE, DEFINE_GDB_SYMBOL_ENUM): Delete macros. - * lisp.h (ENUMABLE, DEFINE_GDB_SYMBOL_ENUM): New macros. 2023-06-29 Andrew G Cohen 2023-05-07 Andrew G Cohen C-x b fo @@ -1467,10 +1505,8 @@ DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0, 2022-03-22 Andrew G Cohen 2022-03-20 Andrew G Cohen 2022-03-17 Andrew G Cohen -2022-03-17 Andrew G Cohen 2022-03-04 Andrew G Cohen 2022-02-18 Andrew G Cohen -2022-02-18 Andrew G Cohen 2022-02-11 Andrew G Cohen 2022-02-08 Andrew G Cohen 2022-02-03 Andrew G Cohen @@ -1490,7 +1526,6 @@ extern struct servent *hes_getservbyname (/* char *, char * */); servent = hes_getservbyname (service, "tcp"); if (servent) servent = getservbyname (service, "tcp"); - if (servent) struct servent *srv = getservbyname (service, protocol); 2003-04-10 Sebastian Tennant (tiny change) Reported by Sebastian Tennant . @@ -1515,7 +1550,6 @@ extern struct servent *hes_getservbyname (/* char *, char * */); (substring strin pos end-pos)))))) (defun dun-listify-string2 (strin) (while (setq end-pos (string-search " " (substring strin pos))) - (substring strin pos end-pos)))))) "any" "append" "as" "asc" "ascic" "async" "at_begin" "at_end" "audit" "attribute" "(d)eclaration or (s)pecification?" t) ?s) "quantity" "(f)ree, (b)ranch, or (s)ource quantity?" t))) diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi index 80e552fa46a..d9113a6811a 100644 --- a/doc/emacs/buffers.texi +++ b/doc/emacs/buffers.texi @@ -764,7 +764,7 @@ you first type @kbd{C-M-i}. By default, when you press @kbd{C-M-i}, both Icomplete mode's in-buffer display of possible completions and the @file{*Completions*} buffer appear. If you are using @code{icomplete-in-buffer}, then you -may wish to suppress this apperance of the @file{*Completions*} +may wish to suppress this appearance of the @file{*Completions*} buffer. To do that, add the following to your initialization file (@pxref{Init File}): diff --git a/doc/misc/ses.texi b/doc/misc/ses.texi index b48ed0c1949..8500a0f08c4 100644 --- a/doc/misc/ses.texi +++ b/doc/misc/ses.texi @@ -507,7 +507,7 @@ To list the local printers in a help buffer. Except for @code{ses-prin1}, the other standard printers are suitable only for cells, not columns or default, because they format the value using the column-printer (or default-printer if @code{nil}) and then -post-proces the result, eg.@: center it: +post-process the result, eg.@: center it: @ftable @code @item ses-center diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 3b7eb393561..71f55379d96 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -1750,7 +1750,7 @@ and `+='...)." ;; Split REM-BODY @ __VA_ARGS__ into LEFT and right (setq part nil) (if (zerop va) - (setq left nil ; __VA_ARGS__ trimed + (setq left nil ; __VA_ARGS__ trimmed rem-body (cdr rem-body)) (setq left rem-body rem-body (cdr (nthcdr va rem-body))) ; _V_ removed diff --git a/src/eval.c b/src/eval.c index c995183ceb8..6f1c39ffb0e 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1377,7 +1377,7 @@ DEFUN ("handler-bind-1", Fhandler_bind_1, Shandler_bind_1, 1, MANY, 0, doc: /* Setup error handlers around execution of BODYFUN. BODYFUN be a function and it is called with no arguments. CONDITIONS should be a list of condition names (symbols). -When an error is signaled during executon of BODYFUN, if that +When an error is signaled during execution of BODYFUN, if that error matches one of CONDITIONS, then the associated HANDLER is called with the error as argument. HANDLER should either transfer the control via a non-local exit, @@ -1392,7 +1392,7 @@ usage: (handler-bind BODYFUN [CONDITIONS HANDLER]...) */) Lisp_Object bodyfun = args[0]; int count = 0; if (nargs % 2 == 0) - error ("Trailing CONDITIONS withount HANDLER in `handler-bind`"); + error ("Trailing CONDITIONS without HANDLER in `handler-bind`"); for (ptrdiff_t i = nargs - 2; i > 0; i -= 2) { Lisp_Object conditions = args[i], handler = args[i + 1]; diff --git a/src/xdisp.c b/src/xdisp.c index e69336d5abe..19f176459c7 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -30956,7 +30956,7 @@ draw_glyphs (struct window *w, int x, struct glyph_row *row, #ifdef HAVE_RSVG /* Update SVG image glyphs with mouse face features. FIXME: it - should be possible to have this behaviour with transparent + should be possible to have this behavior with transparent background PNG. */ if (hl == DRAW_MOUSE_FACE) { diff --git a/test/lisp/erc/erc-scenarios-keep-place-indicator.el b/test/lisp/erc/erc-scenarios-keep-place-indicator.el index 572045cf0bc..ccd6f81b7d2 100644 --- a/test/lisp/erc/erc-scenarios-keep-place-indicator.el +++ b/test/lisp/erc/erc-scenarios-keep-place-indicator.el @@ -101,7 +101,7 @@ (recenter 0) (redisplay) ; force ^ to appear on first line - (other-window 1) ; upper still at indicator, swtiches first + (other-window 1) ; upper still at indicator, switches first (switch-to-buffer "#spam") (other-window 1) (switch-to-buffer "#spam") ; lower follows, speaks to sync diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index 906aa891352..05dbe1d50d6 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -206,7 +206,7 @@ For simplicity, assume string evaluates to itself." (defun erc-tests-common-snapshot-compare (name dir trans-fn buf-init-fn) "Compare `buffer-string' to snapshot NAME.eld in DIR, if present. -When non-nil, run TRANS-FN to fiter the current buffer string, +When non-nil, run TRANS-FN to filter the current buffer string, and expect a similar string in return. Call BUF-INIT-FN, when non-nil, in the preview buffer after inserting the filtered string." diff --git a/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts b/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts index fe09a37a32b..f2d0eacee5b 100644 --- a/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts @@ -134,7 +134,7 @@ Name: Pipe statements with fn end) =-=-= -Name: Pipe statements stab clases +Name: Pipe statements stab clauses =-= [1, 2] diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 4e7ca88d197..54a9a6c11cc 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -906,7 +906,7 @@ Return a list of results." (defun comp-tests--types-equal (t1 t2) "Whether the types T1 and T2 are equal." - (or (equal t1 t2) ; optimisation for the common case + (or (equal t1 t2) ; optimization for the common case (and (consp t1) (consp t2) (eq (car t1) (car t2)) (if (memq (car t1) '(and or member)) -- cgit v1.2.3 From 77f5d4d523a406650036b7cd0d872d39a114a9ac Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Sun, 12 Nov 2023 13:21:50 -0800 Subject: Fix completing-read functional REQUIRE-MATCH behavior * lisp/minibuffer.el (completion--complete-and-exit): If minibuffer-completion-confirm is a function which returns nil, immediately fail to complete. See bug#66187. --- lisp/minibuffer.el | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 3c4315b87fc..faa7f543ece 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1847,10 +1847,13 @@ appear to be a match." ;; Allow user to specify null string ((= beg end) (funcall exit-function)) ;; The CONFIRM argument is a predicate. - ((and (functionp minibuffer-completion-confirm) - (funcall minibuffer-completion-confirm - (buffer-substring beg end))) - (funcall exit-function)) + ((functionp minibuffer-completion-confirm) + (if (funcall minibuffer-completion-confirm + (buffer-substring beg end)) + (funcall exit-function) + (unless completion-fail-discreetly + (ding) + (completion--message "No match")))) ;; See if we have a completion from the table. ((test-completion (buffer-substring beg end) minibuffer-completion-table -- cgit v1.2.3 From e734f8e502e315441214936e89ecd1e11e981fca Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 28 Jan 2024 18:51:11 -0500 Subject: xt-mouse.el: Obey `mouse-wheel-*-event` variables (bug#68698) * lisp/xt-mouse.el (xterm-mouse--same-button-p): New function. (xterm-mouse--read-event-sequence): Use it to obey `mouse-wheel-*-event` variables. * lisp/mwheel.el (mouse-wheel-obey-old-style-wheel-buttons): Update docstring. --- etc/NEWS | 6 ++++++ lisp/mwheel.el | 2 +- lisp/xt-mouse.el | 31 ++++++++++++++++++++++++------- 3 files changed, 31 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index 061ac9a7d10..ecb24724ab3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -430,6 +430,12 @@ only to specify the 'mouse-4/5/6/7' events generated by older configurations such as X11 when the X server does not support at least version 2.1 of the X Input Extension, and 'xterm-mouse-mode'. +** 'xterm-mouse-mode' +This mode now emits `wheel-up/down/right/left' events instead of +'mouse-4/5/6/7' events for the mouse wheel. +It uses the 'mouse-wheel-up/down/left/right-event' +variables to decide which button maps to which wheel event (if any). + ** Info --- diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 53042085bf6..66a1fa1a706 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -59,7 +59,7 @@ (defvar mouse-wheel-obey-old-style-wheel-buttons t "If non-nil, treat mouse-4/5/6/7 events as mouse wheel events. These are the event names used historically in X11 before XInput2. -They are sometimes generated by things like `xterm-mouse-mode' as well.") +They are sometimes generated by things like text-terminals as well.") (defcustom mouse-wheel-down-event (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-4) diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index cd00467f14f..081b8f32456 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -40,6 +40,8 @@ ;;; Code: +(require 'mwheel) + (defvar xterm-mouse-debug-buffer nil) (defun xterm-mouse-translate (_event) @@ -193,6 +195,12 @@ single byte." (cons n c)) (cons (- (setq c (xterm-mouse--read-coordinate)) 32) c)))) +(defun xterm-mouse--button-p (event btn) + (and (symbolp event) + (string-prefix-p "mouse-" (symbol-name event)) + (eq btn (car (read-from-string (symbol-name event) + (length "mouse-")))))) + ;; XTerm reports mouse events as ;; in default mode, and ;; ";" ";" <"M" or "m"> in extended mode. @@ -230,13 +238,22 @@ single byte." ;; Spurious release event without previous button-down ;; event: assume, that the last button was button 1. (t 1))) - (sym (if move 'mouse-movement - (intern (concat (if ctrl "C-" "") - (if meta "M-" "") - (if shift "S-" "") - (if down "down-" "") - "mouse-" - (number-to-string btn)))))) + (sym + (if move 'mouse-movement + (intern + (concat + (if ctrl "C-" "") + (if meta "M-" "") + (if shift "S-" "") + (if down "down-" "") + (cond + ;; BEWARE: `mouse-wheel-UP-event' corresponds to + ;; `wheel-DOWN' events and vice versa!! + ((xterm-mouse--button-p mouse-wheel-down-event btn) "wheel-up") + ((xterm-mouse--button-p mouse-wheel-up-event btn) "wheel-down") + ((xterm-mouse--button-p mouse-wheel-left-event btn) "wheel-left") + ((xterm-mouse--button-p mouse-wheel-right-event btn) "wheel-right") + (t (format "mouse-%d" btn)))))))) (list sym (1- x) (1- y)))) (defun xterm-mouse--set-click-count (event click-count) -- cgit v1.2.3 From 1f5a13d5843306af2e6a74fbdfd6d00af8804a23 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Sun, 28 Jan 2024 15:49:03 -0800 Subject: In Eshell, allow an escaped newline at the end of a command Normally, "echo" runs the command "echo". Likewise, "echo\" should too: we escape the first newline, and then the second one is unescaped and should send the command input to Eshell. Previously, you had to press RET a third time, but now it works as expected. * lisp/eshell/esh-arg.el (eshell-looking-at-backslash-return): Make obsolete. (eshell-parse-backslash): A backslash sequence is only incomplete if there's nothing at all after it. * test/lisp/eshell/esh-arg-tests.el (esh-arg-test/escape/newline) (esh-arg-test/escape-quoted/newline): Remove inaccurate comment; escaped newlines are always special. (esh-arg-test/escape/trailing-newline): New test. --- lisp/eshell/esh-arg.el | 5 +++-- test/lisp/eshell/esh-arg-tests.el | 14 ++++++++------ 2 files changed, 11 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 1880cc03885..97ddac58629 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -440,6 +440,7 @@ Point is left at the end of the arguments." (defsubst eshell-looking-at-backslash-return (pos) "Test whether a backslash-return sequence occurs at POS." + (declare (obsolete nil "30.1")) (and (eq (char-after pos) ?\\) (or (= (1+ pos) (point-max)) (and (eq (char-after (1+ pos)) ?\n) @@ -464,8 +465,8 @@ backslash is ignored and the character after is returned. If the backslash is in a quoted string, the backslash and the character after are both returned." (when (eq (char-after) ?\\) - (when (eshell-looking-at-backslash-return (point)) - (throw 'eshell-incomplete "\\")) + (when (= (1+ (point)) (point-max)) + (throw 'eshell-incomplete "\\")) (forward-char 2) ; Move one char past the backslash. (let ((special-chars (if eshell-current-quoted eshell-special-chars-inside-quoting diff --git a/test/lisp/eshell/esh-arg-tests.el b/test/lisp/eshell/esh-arg-tests.el index b626cf10bf1..b748c5ab4c0 100644 --- a/test/lisp/eshell/esh-arg-tests.el +++ b/test/lisp/eshell/esh-arg-tests.el @@ -60,13 +60,17 @@ chars." "he\\\\llo\n"))) (ert-deftest esh-arg-test/escape/newline () - "Test that an escaped newline is equivalent to the empty string. -When newlines are *nonspecial*, an escaped newline should be -treated as just a newline." + "Test that an escaped newline is equivalent to the empty string." (with-temp-eshell (eshell-match-command-output "echo hi\\\nthere" "hithere\n"))) +(ert-deftest esh-arg-test/escape/trailing-newline () + "Test that an escaped newline is equivalent to the empty string." + (with-temp-eshell + (eshell-match-command-output "echo hi\\\n" + "hi\n"))) + (ert-deftest esh-arg-test/escape/newline-conditional () "Test invocation of an if/else statement using line continuations." (let ((eshell-test-value t)) @@ -95,9 +99,7 @@ chars." "\\\"hi\\\\\n"))) (ert-deftest esh-arg-test/escape-quoted/newline () - "Test that an escaped newline is equivalent to the empty string. -When newlines are *nonspecial*, an escaped newline should be -treated literally, as a backslash and a newline." + "Test that an escaped newline is equivalent to the empty string." (with-temp-eshell (eshell-match-command-output "echo \"hi\\\nthere\"" "hithere\n"))) -- cgit v1.2.3 From d2abe91d4bf68f20e4b1cd39f88ed98fd5731524 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Sat, 2 Sep 2023 22:29:22 -0700 Subject: In Eshell, don't expand quoted tildes into a user's home directory * lisp/eshell/em-dirs.el (eshell-parse-user-reference): Don't expand quoted tildes. * test/lisp/eshell/em-dirs-tests.el (em-dirs-test/expand-user-reference/local) (em-dirs-test/expand-user-reference/quoted): New tests. --- lisp/eshell/em-dirs.el | 1 + test/lisp/eshell/em-dirs-tests.el | 22 ++++++++++++++++++++++ 2 files changed, 23 insertions(+) (limited to 'lisp') diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 85036620c57..07063afc286 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -262,6 +262,7 @@ Thus, this does not include the current directory.") (defun eshell-parse-user-reference () "An argument beginning with ~ is a filename to be expanded." (when (and (not eshell-current-argument) + (not eshell-current-quoted) (eq (char-after) ?~)) ;; Apply this modifier fairly early so it happens before things ;; like glob expansion. diff --git a/test/lisp/eshell/em-dirs-tests.el b/test/lisp/eshell/em-dirs-tests.el index 2f170fb0c63..9789e519f4c 100644 --- a/test/lisp/eshell/em-dirs-tests.el +++ b/test/lisp/eshell/em-dirs-tests.el @@ -34,6 +34,9 @@ default-directory)))) ;;; Tests: + +;; Variables + (ert-deftest em-dirs-test/pwd-var () "Test using the $PWD variable." (let ((default-directory "/some/path")) @@ -99,6 +102,25 @@ (eshell-match-command-output "echo $-[1][/ 1 3]" "(\"some\" \"here\")\n")))) + +;; Argument expansion + +(ert-deftest em-dirs-test/expand-user-reference/local () + "Test expansion of \"~USER\" references." + (eshell-command-result-equal "echo ~" (expand-file-name "~")) + (eshell-command-result-equal + (format "echo ~%s" user-login-name) + (expand-file-name (format "~%s" user-login-name)))) + +(ert-deftest em-dirs-test/expand-user-reference/quoted () + "Test that a quoted \"~\" isn't expanded." + (eshell-command-result-equal "echo \\~" "~") + (eshell-command-result-equal "echo \"~\"" "~") + (eshell-command-result-equal "echo '~'" "~")) + + +;; `cd' + (ert-deftest em-dirs-test/cd () "Test that changing directories with `cd' works." (ert-with-temp-directory tmpdir -- cgit v1.2.3 From e9cf215d7067d5375425e605461b155216ed23b5 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 29 Jan 2024 10:54:49 +0800 Subject: Prevent filling from mangling ChangeLog defun lists * lisp/vc/log-edit.el (log-edit-fill-entry): Replace space characters within defun lists with NBSPs for the duration of `fill-region''s execution, so that they are never considered break points. * test/lisp/vc/log-edit-tests.el (log-edit-fill-entry-space-substitution): New test. --- lisp/vc/log-edit.el | 37 +++++++++- test/lisp/vc/log-edit-tests.el | 149 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 184 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index b847fb953f2..644ea691a76 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -668,6 +668,9 @@ according to `fill-column'." (defuns nil)) (while (progn + ;; Match a regexp against the next ChangeLog entry. + ;; `defuns-beg' will be the end of the file name, + ;; which marks the beginning of the list of defuns. (setq defuns-beg (and (< beg end) (re-search-forward @@ -676,13 +679,39 @@ according to `fill-column'." "\\)\\|^\\(?1:\\)[[:blank:]]*(") end t) (copy-marker (match-end 1)))) + ;; Fill the intervening prose between the end of the + ;; last match and the beginning of the current match. (let ((fill-indent-according-to-mode t) (end (if defuns-beg (match-beginning 0) end)) (beg (progn (goto-char beg) - (line-beginning-position)))) + (line-beginning-position))) + space-beg space-end) (when (<= (line-end-position) end) - (fill-region beg end justify))) + ;; Replace space characters within parentheses + ;; that resemble ChangeLog defun names between BEG + ;; and END with non-breaking spaces to prevent + ;; them from being considered break points by + ;; `fill-region'. + (save-excursion + (goto-char beg) + (when (re-search-forward + "^[[:blank:]]*(.*\\([[:space:]]\\).*):" + end t) + (replace-regexp-in-region "[[:space:]]" " " + (setq space-beg + (copy-marker + (match-beginning 0))) + (setq space-end + (copy-marker + (match-end 0)))))) + (fill-region beg end justify)) + ;; Restore the spaces replaced by NBSPs. + (when space-beg + (replace-string-in-region " " " " + space-beg space-end) + (set-marker space-beg nil) + (set-marker space-end nil))) defuns-beg) (goto-char defuns-beg) (setq defuns (change-log-read-defuns end)) @@ -1358,3 +1387,7 @@ line of MSG." (provide 'log-edit) ;;; log-edit.el ends here + +;; Local Variables: +;; coding: utf-8-unix +;; End: diff --git a/test/lisp/vc/log-edit-tests.el b/test/lisp/vc/log-edit-tests.el index 5b555809f4c..57407d47ca8 100644 --- a/test/lisp/vc/log-edit-tests.el +++ b/test/lisp/vc/log-edit-tests.el @@ -185,4 +185,153 @@ lines.")))) "* file2.txt (abcdefghijklmnopqrstuvwxyz):"))))) +(ert-deftest log-edit-fill-entry-space-substitution () + ;; This test verifies that filling the paragraph surrounding the + ;; last line of defuns does not break between defun lists with + ;; spaces in identifiers. + (setq string " +* src/sfnt.c (xmalloc, xrealloc): Improve behavior upon allocation +failures during test. +(sfnt_table_names): Add prep. +(sfnt_transform_coordinates): Allow applying offsets during +coordinate transform. +(sfnt_decompose_compound_glyph): Defer offset computation until +any component compound glyph is loaded, then apply it during the +transform process. +(sfnt_multiply_divide): Make available everywhere. Implement on +64 bit systems. +(sfnt_multiply_divide_signed): New function. +(sfnt_mul_fixed): Fix division overflow. +(sfnt_curve_to_and_build_1, sfnt_build_glyph_outline): Remove +outdated comment. +(sfnt_build_outline_edges): Fix coding style. +(sfnt_lookup_glyph_metrics): Allow looking up metrics without +scaling. +(struct sfnt_cvt_table): Fix type of cvt values. +(struct sfnt_prep_table): New structure. +(sfnt_read_cvt_table): Read cvt values in terms of fwords, not +longs (as Apple's doc seems to say). +(sfnt_read_fpgm_table): Fix memory allocation for font program +table. +(sfnt_read_prep_table): New function. +(struct sfnt_interpreter_zone): New structure. +(struct sfnt_interpreter_graphics_state): New fields `project', +`move', `vector_dot_product'. Rename to `sfnt_graphics_state'. +(struct sfnt_interpreter, sfnt_mul_f26dot6): Stop doing rounding +division. +(sfnt_init_graphics_state, sfnt_make_interpreter, MOVE, SSW, RAW) +(SDS, ADD, SUB, ABS, NEG, WCVTF, _MIN, S45ROUND, SVTCAx) +(sfnt_set_srounding_state, sfnt_skip_code) +(sfnt_interpret_unimplemented, sfnt_interpret_fdef) +(sfnt_interpret_idef, sfnt_interpret_if, sfnt_interpret_else) +(sfnt_round_none, sfnt_round_to_grid, sfnt_round_to_double_grid) +" + wanted " +* src/sfnt.c +(xmalloc, xrealloc): +Improve behavior +upon allocation +failures during +test. +(sfnt_table_names): +Add prep. + +(sfnt_transform_coordinates): +Allow applying +offsets during +coordinate +transform. + +(sfnt_decompose_compound_glyph): +Defer offset +computation until +any component +compound glyph is +loaded, then apply +it during the +transform process. + +(sfnt_multiply_divide): +Make available +everywhere. +Implement on 64 bit +systems. + +(sfnt_multiply_divide_signed): +New function. +(sfnt_mul_fixed): +Fix division +overflow. + +(sfnt_curve_to_and_build_1) +(sfnt_build_glyph_outline): +Remove outdated +comment. + +(sfnt_build_outline_edges): +Fix coding style. + +(sfnt_lookup_glyph_metrics): +Allow looking up +metrics without +scaling. + +(struct sfnt_cvt_table): +Fix type of cvt +values. + +(struct sfnt_prep_table): +New structure. + +(sfnt_read_cvt_table): +Read cvt values in +terms of fwords, not +longs (as Apple's +doc seems to say). + +(sfnt_read_fpgm_table): +Fix memory +allocation for font +program table. + +(sfnt_read_prep_table): +New function. + +(struct sfnt_interpreter_zone): +New structure. + +(struct sfnt_interpreter_graphics_state): +New fields +`project', `move', +`vector_dot_product'. +Rename to +`sfnt_graphics_state'. + +(struct sfnt_interpreter) +(sfnt_mul_f26dot6): +Stop doing rounding +division. + +(sfnt_init_graphics_state) +(sfnt_make_interpreter) +(MOVE, SSW, RAW, SDS) +(ADD, SUB, ABS, NEG) +(WCVTF, _MIN) +(S45ROUND, SVTCAx) +(sfnt_set_srounding_state) +(sfnt_skip_code) +(sfnt_interpret_unimplemented) +(sfnt_interpret_fdef) +(sfnt_interpret_idef) +(sfnt_interpret_if) +(sfnt_interpret_else) +(sfnt_round_none) +(sfnt_round_to_grid) +(sfnt_round_to_double_grid): +") + (with-temp-buffer + (insert string) + (let ((fill-column 20)) (log-edit-fill-entry)) + (should (equal (buffer-string) wanted)))) + ;;; log-edit-tests.el ends here -- cgit v1.2.3 From 0aec3117b5f9632d85401b6a4c7e6d99dcd21db0 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 29 Jan 2024 15:45:47 +0800 Subject: Don't open a new line for long defuns being inserted at column 0 * lisp/vc/log-edit.el (log-edit--insert-filled-defuns): Don't open a new line for long defuns at column 0. * test/lisp/vc/log-edit-tests.el (log-edit-fill-entry-space-substitution): Adjust expected results to match change. (log-edit-fill-entry-initial-wrapping): New test. --- lisp/vc/log-edit.el | 6 ++++-- test/lisp/vc/log-edit-tests.el | 41 +++++++++++++++++++++++++---------------- 2 files changed, 29 insertions(+), 18 deletions(-) (limited to 'lisp') diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 644ea691a76..1f766eea455 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -588,9 +588,11 @@ the \\[vc-prefix-map] prefix for VC commands, for example). (while func-names (setq name (car func-names)) (setq func-names (cdr func-names)) - ;; If inserting `name' in at the current column would overflow - ;; the fill column, place it on its own line. + ;; If inserting `name' after preexisting text in the first + ;; line would overflow the fill column, place it on its own + ;; line. (if (and first-line + (> (current-column) 0) (> (+ (current-column) (string-width name) ;; If this be the last name, the column must be diff --git a/test/lisp/vc/log-edit-tests.el b/test/lisp/vc/log-edit-tests.el index fe0248d05f7..8373156587d 100644 --- a/test/lisp/vc/log-edit-tests.el +++ b/test/lisp/vc/log-edit-tests.el @@ -236,13 +236,11 @@ failures during test. (sfnt_table_names): Add prep. - (sfnt_transform_coordinates): Allow applying offsets during coordinate transform. - (sfnt_decompose_compound_glyph): Defer offset computation until @@ -251,68 +249,54 @@ compound glyph is loaded, then apply it during the transform process. - (sfnt_multiply_divide): Make available everywhere. Implement on 64 bit systems. - (sfnt_multiply_divide_signed): New function. (sfnt_mul_fixed): Fix division overflow. - (sfnt_curve_to_and_build_1) (sfnt_build_glyph_outline): Remove outdated comment. - (sfnt_build_outline_edges): Fix coding style. - (sfnt_lookup_glyph_metrics): Allow looking up metrics without scaling. - (struct sfnt_cvt_table): Fix type of cvt values. - (struct sfnt_prep_table): New structure. - (sfnt_read_cvt_table): Read cvt values in terms of fwords, not longs (as Apple's doc seems to say). - (sfnt_read_fpgm_table): Fix memory allocation for font program table. - (sfnt_read_prep_table): New function. - (struct sfnt_interpreter_zone): New structure. - (struct sfnt_interpreter_graphics_state): New fields `project', `move', `vector_dot_product'. Rename to `sfnt_graphics_state'. - (struct sfnt_interpreter) (sfnt_mul_f26dot6): Stop doing rounding division. - (sfnt_init_graphics_state) (sfnt_make_interpreter) (MOVE, SSW, RAW, SDS) @@ -335,4 +319,29 @@ division. (let ((fill-column 20)) (log-edit-fill-entry)) (should (equal (buffer-string) wanted))))) +(ert-deftest log-edit-fill-entry-initial-wrapping () + ;; This test verifies that a newline is inserted before a defun + ;; itself longer than the fill column when such a defun is being + ;; inserted after a file name, and not otherwise. + (let (string wanted) + (setq string " +* src/sfnt.c (long_entry_1): This entry should be placed on a +new line. +(but_this_entry_should_not): With the prose displaced to the +next line instead." + wanted " +* src/sfnt.c +(long_entry_1): This +entry should be +placed on a new +line. +(but_this_entry_should_not): +With the prose +displaced to the +next line instead.") + (with-temp-buffer + (insert string) + (let ((fill-column 20)) (log-edit-fill-entry)) + (should (equal (buffer-string) wanted))))) + ;;; log-edit-tests.el ends here -- cgit v1.2.3 From 116c47874eb25f03483b094f64e31c78613da220 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 29 Jan 2024 00:20:09 -0800 Subject: ; Spelling fixes --- etc/NEWS | 2 +- lisp/leim/quail/persian.el | 2 +- lisp/net/tramp.el | 2 +- test/lisp/emacs-lisp/hierarchy-tests.el | 2 +- test/lisp/progmodes/c-ts-mode-resources/indent.erts | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index ecb24724ab3..a21f45481fd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -408,7 +408,7 @@ functions in CJK locales. --- *** New input methods for the Urdu, Pashto, and Sindhi languages. -These languages are spoken in Pakistan and Afganistan. +These languages are spoken in Pakistan and Afghanistan. *** Additional 'C-x 8' key translations for "æ" and "Æ". These characters can now be input with 'C-x 8 a e' and 'C-x 8 A E', diff --git a/lisp/leim/quail/persian.el b/lisp/leim/quail/persian.el index de61481d7f1..676b3ab5c2e 100644 --- a/lisp/leim/quail/persian.el +++ b/lisp/leim/quail/persian.el @@ -500,7 +500,7 @@ ;; RIGHT-TO-LEFT EMBEDDING (sets base dir to RTL but allows embedded text) ("&rle;" ?\u202B) ;; (ucs-insert #x202B) named: زیرمتنِ راست‌به‌چپ ;; POP DIRECTIONAL FORMATTING (used for RLE or LRE and RLO or LRO) - ;; EMACS ANOMOLY --- Why does &pdf not show up in (describe-input-method 'farsi-transliterate-banan) + ;; EMACS ANOMALY --- Why does &pdf not show up in (describe-input-method 'farsi-transliterate-banan) ("&pdf;" ?\u202C) ;; (ucs-insert #x202C) named: پایانِ زیرمتن ("P" ?\u202C) ;; LEFT-TO-RIGHT OVERRIDE (overrides the bidirectional algorithm, display LTR) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index a369e28f021..74d95757e46 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -219,7 +219,7 @@ pair of the form (KEY VALUE). The following KEYs are defined: set this to any value other than \"/bin/sh\": Tramp wants to use a shell which groks tilde expansion, but it can search for it. Also note that \"/bin/sh\" exists on all Unixen - except Andtoid, this might not be true for the value that you + except Android, this might not be true for the value that you decide to use. You Have Been Warned. * `tramp-remote-shell-login' diff --git a/test/lisp/emacs-lisp/hierarchy-tests.el b/test/lisp/emacs-lisp/hierarchy-tests.el index 97a0f7ba52c..49c812edb05 100644 --- a/test/lisp/emacs-lisp/hierarchy-tests.el +++ b/test/lisp/emacs-lisp/hierarchy-tests.el @@ -570,7 +570,7 @@ should fail as this function will crash." (defun hierarchy-examples-delayed--childrenfn (hier-elem) "Return the children of HIER-ELEM. -Basially, feed the number, minus 1, to `hierarchy-examples-delayed--find-number' +Basically, feed the number, minus 1, to `hierarchy-examples-delayed--find-number' and then create a list of the number plus 0.0–0.9." (when (> hier-elem 1) diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent.erts b/test/lisp/progmodes/c-ts-mode-resources/indent.erts index 2fd26d75844..24b244c1611 100644 --- a/test/lisp/progmodes/c-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts @@ -84,7 +84,7 @@ int main() } =-=-= -Name: Concecutive blocks (GNU Style) (bug#60873) +Name: Consecutive blocks (GNU Style) (bug#60873) =-= int -- cgit v1.2.3 From 2f98b13ed0522ef37c7bb2ca37f24b1be2f9fde5 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 29 Jan 2024 14:56:40 +0200 Subject: ; Fix doc strings of splash-screen data structures * lisp/startup.el (fancy-startup-text, fancy-about-text): Doc fixes. (Bug#68788) --- lisp/startup.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/startup.el b/lisp/startup.el index dcc99fd3dea..eb1e027d2cb 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1749,7 +1749,7 @@ If this is nil, no message will be displayed." "\n")) "A list of texts to show in the middle part of splash screens. Each element in the list should be a list of strings or pairs -`:face FACE', like `fancy-splash-insert' accepts them.") +`:KEYWORD VALUE', like what `fancy-splash-insert' accepts.") (defconst fancy-about-text `((:face (variable-pitch font-lock-comment-face) @@ -1842,7 +1842,7 @@ Each element in the list should be a list of strings or pairs "\tDisplay the Emacs manual in Info mode")) "A list of texts to show in the middle part of the About screen. Each element in the list should be a list of strings or pairs -`:face FACE', like `fancy-splash-insert' accepts them.") +`:KEYWORD VALUE', like what `fancy-splash-insert' accepts.") (defgroup fancy-splash-screen () -- cgit v1.2.3 From 98c906e5be2a3f5a14ff0172fdab38507b7746e3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 29 Jan 2024 21:21:50 +0200 Subject: ; * lisp/minibuffer.el (minibuffer-visible-completions): Doc fix. --- lisp/minibuffer.el | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 45aab398078..642ffad171a 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3149,15 +3149,14 @@ the mode hook of this mode." (setq-local minibuffer-completion-auto-choose nil))) (defcustom minibuffer-visible-completions nil - "When non-nil, visible completions can be navigated from the minibuffer. -This means that when the *Completions* buffer is visible in a window, -then you can use the arrow keys in the minibuffer to move the cursor -in the *Completions* buffer. Then you can type `RET', -and the candidate highlighted in the *Completions* buffer -will be accepted. -But when the *Completions* buffer is not displayed on the screen, -then the arrow keys move point in the minibuffer as usual, and -`RET' accepts the input typed in the minibuffer." + "Whether candidates shown in *Completions* can be navigated from minibuffer. +When non-nil, if the *Completions* buffer is displayed in a window, +you can use the arrow keys in the minibuffer to move the cursor in +the window showing the *Completions* buffer. Typing `RET' selects +the highlighted completion candidate. +If the *Completions* buffer is not displayed on the screen, or this +variable is nil, the arrow keys move point in the minibuffer as usual, +and `RET' accepts the input typed into the minibuffer." :type 'boolean :version "30.1") -- cgit v1.2.3 From e625f2044a37f638e8c76b18e0b2d030031d6eda Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 29 Jan 2024 18:56:19 -0500 Subject: (byte-compile): Try and make it a bit more readable * lisp/emacs-lisp/bytecomp.el (byte-compile--reify-function): Use `macroexp-parse-body` and only handle closures. (byte-compile): Clarify the control and data flow a bit. --- lisp/emacs-lisp/bytecomp.el | 82 ++++++++++++++++++++------------------------- 1 file changed, 36 insertions(+), 46 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index ea9298c6646..e87595b3e77 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3018,18 +3018,10 @@ otherwise, print without quoting." (defun byte-compile--reify-function (fun) "Return an expression which will evaluate to a function value FUN. -FUN should be either a `lambda' value or a `closure' value." - (pcase-let* (((or (and `(lambda ,args . ,body) (let env nil)) - `(closure ,env ,args . ,body)) - fun) - (preamble nil) +FUN should be an interpreted closure." + (pcase-let* ((`(closure ,env ,args . ,body) fun) + (`(,preamble . ,body) (macroexp-parse-body body)) (renv ())) - ;; Split docstring and `interactive' form from body. - (when (stringp (car body)) - (push (pop body) preamble)) - (when (eq (car-safe (car body)) 'interactive) - (push (pop body) preamble)) - (setq preamble (nreverse preamble)) ;; Turn the function's closed vars (if any) into local let bindings. (dolist (binding env) (cond @@ -3051,41 +3043,39 @@ If FORM is a lambda or a macro, byte-compile it as a function." (fun (if (symbolp form) (symbol-function form) form)) - (macro (eq (car-safe fun) 'macro))) - (if macro - (setq fun (cdr fun))) - (prog1 - (cond - ;; Up until Emacs-24.1, byte-compile silently did nothing - ;; when asked to compile something invalid. So let's tone - ;; down the complaint from an error to a simple message for - ;; the known case where signaling an error causes problems. - ((compiled-function-p fun) - (message "Function %s is already compiled" - (if (symbolp form) form "provided")) - fun) - (t - (let (final-eval) - (when (or (symbolp form) (eq (car-safe fun) 'closure)) - ;; `fun' is a function *value*, so try to recover its corresponding - ;; source code. - (setq lexical-binding (eq (car fun) 'closure)) - (setq fun (byte-compile--reify-function fun)) - (setq final-eval t)) - ;; Expand macros. - (setq fun (byte-compile-preprocess fun)) - (setq fun (byte-compile-top-level fun nil 'eval)) - (if (symbolp form) - ;; byte-compile-top-level returns an *expression* equivalent to the - ;; `fun' expression, so we need to evaluate it, tho normally - ;; this is not needed because the expression is just a constant - ;; byte-code object, which is self-evaluating. - (setq fun (eval fun t))) - (if final-eval - (setq fun (eval fun t))) - (if macro (push 'macro fun)) - (if (symbolp form) (fset form fun)) - fun)))))))) + (macro (eq (car-safe fun) 'macro)) + (need-a-value nil)) + (when macro + (setq need-a-value t) + (setq fun (cdr fun))) + (cond + ;; Up until Emacs-24.1, byte-compile silently did nothing + ;; when asked to compile something invalid. So let's tone + ;; down the complaint from an error to a simple message for + ;; the known case where signaling an error causes problems. + ((compiled-function-p fun) + (message "Function %s is already compiled" + (if (symbolp form) form "provided")) + fun) + (t + (when (or (symbolp form) (eq (car-safe fun) 'closure)) + ;; `fun' is a function *value*, so try to recover its + ;; corresponding source code. + (when (setq lexical-binding (eq (car-safe fun) 'closure)) + (setq fun (byte-compile--reify-function fun))) + (setq need-a-value t)) + ;; Expand macros. + (setq fun (byte-compile-preprocess fun)) + (setq fun (byte-compile-top-level fun nil 'eval)) + (when need-a-value + ;; `byte-compile-top-level' returns an *expression* equivalent to + ;; the `fun' expression, so we need to evaluate it, tho normally + ;; this is not needed because the expression is just a constant + ;; byte-code object, which is self-evaluating. + (setq fun (eval fun lexical-binding))) + (if macro (push 'macro fun)) + (if (symbolp form) (fset form fun)) + fun)))))) (defun byte-compile-sexp (sexp) "Compile and return SEXP." -- cgit v1.2.3 From c385e966e18bebd52b1a692f13e2a7495891966d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 29 Jan 2024 19:04:59 -0500 Subject: derived.el: Delete old code (bug#68625) * lisp/emacs-lisp/derived.el (derived-mode-setup-function-name) (derived-mode-init-mode-variables, derived-mode-set-keymap) (derived-mode-set-syntax-table, derived-mode-set-abbrev-table) (derived-mode-run-hooks, derived-mode-merge-keymaps) (derived-mode-merge-syntax-tables, derived-mode-merge-abbrev-tables): Delete functions. --- etc/NEWS | 10 ++++ lisp/emacs-lisp/derived.el | 131 --------------------------------------------- 2 files changed, 10 insertions(+), 131 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index a21f45481fd..a9d6eb6789d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1370,6 +1370,16 @@ files and save the changes. * Incompatible Lisp Changes in Emacs 30.1 +--- +** Old 'derived.el' functions removed. +The following functions have been deleted because they were only used +by code compiled with Emacs<21: +'derived-mode-setup-function-name', 'derived-mode-init-mode-variables', +'derived-mode-set-keymap', 'derived-mode-set-syntax-table', +'derived-mode-set-abbrev-table', 'derived-mode-run-hooks', +'derived-mode-merge-keymaps', 'derived-mode-merge-syntax-tables', +'derived-mode-merge-abbrev-tables'. + +++ ** 'M-TAB' now invokes 'completion-at-point' also in Text mode. By default, Text mode no longer binds 'M-TAB' to diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 726f96a25f7..2423426dca0 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -365,137 +365,6 @@ which more-or-less shadow%s %s's corresponding table%s." docstring)) -;;; OBSOLETE -;; The functions below are only provided for backward compatibility with -;; code byte-compiled with versions of derived.el prior to Emacs-21. - -(defsubst derived-mode-setup-function-name (mode) - "Construct a setup-function name based on a MODE name." - (declare (obsolete nil "28.1")) - (intern (concat (symbol-name mode) "-setup"))) - - -;; Utility functions for defining a derived mode. - -;;;###autoload -(defun derived-mode-init-mode-variables (mode) - "Initialize variables for a new MODE. -Right now, if they don't already exist, set up a blank keymap, an -empty syntax table, and an empty abbrev table -- these will be merged -the first time the mode is used." - - (if (boundp (derived-mode-map-name mode)) - t - (eval `(defvar ,(derived-mode-map-name mode) - (make-sparse-keymap) - ,(format "Keymap for %s." mode))) - (put (derived-mode-map-name mode) 'derived-mode-unmerged t)) - - (if (boundp (derived-mode-syntax-table-name mode)) - t - (eval `(defvar ,(derived-mode-syntax-table-name mode) - ;; Make a syntax table which doesn't specify anything - ;; for any char. Valid data will be merged in by - ;; derived-mode-merge-syntax-tables. - (make-char-table 'syntax-table nil) - ,(format "Syntax table for %s." mode))) - (put (derived-mode-syntax-table-name mode) 'derived-mode-unmerged t)) - - (if (boundp (derived-mode-abbrev-table-name mode)) - t - (eval `(defvar ,(derived-mode-abbrev-table-name mode) - (progn - (define-abbrev-table (derived-mode-abbrev-table-name ',mode) nil) - (make-abbrev-table)) - ,(format "Abbrev table for %s." mode))))) - -;; Utility functions for running a derived mode. - -(defun derived-mode-set-keymap (mode) - "Set the keymap of the new MODE, maybe merging with the parent." - (let* ((map-name (derived-mode-map-name mode)) - (new-map (eval map-name)) - (old-map (current-local-map))) - (and old-map - (get map-name 'derived-mode-unmerged) - (derived-mode-merge-keymaps old-map new-map)) - (put map-name 'derived-mode-unmerged nil) - (use-local-map new-map))) - -(defun derived-mode-set-syntax-table (mode) - "Set the syntax table of the new MODE, maybe merging with the parent." - (let* ((table-name (derived-mode-syntax-table-name mode)) - (old-table (syntax-table)) - (new-table (eval table-name))) - (if (get table-name 'derived-mode-unmerged) - (derived-mode-merge-syntax-tables old-table new-table)) - (put table-name 'derived-mode-unmerged nil) - (set-syntax-table new-table))) - -(defun derived-mode-set-abbrev-table (mode) - "Set the abbrev table for MODE if it exists. -Always merge its parent into it, since the merge is non-destructive." - (let* ((table-name (derived-mode-abbrev-table-name mode)) - (old-table local-abbrev-table) - (new-table (eval table-name))) - (derived-mode-merge-abbrev-tables old-table new-table) - (setq local-abbrev-table new-table))) - -(defun derived-mode-run-hooks (mode) - "Run the mode hook for MODE." - (let ((hooks-name (derived-mode-hook-name mode))) - (if (boundp hooks-name) - (run-hooks hooks-name)))) - -;; Functions to merge maps and tables. - -(defun derived-mode-merge-keymaps (old new) - "Merge an OLD keymap into a NEW one. -The old keymap is set to be the last cdr of the new one, so that there will -be automatic inheritance." - ;; ?? Can this just use `set-keymap-parent'? - (let ((tail new)) - ;; Scan the NEW map for prefix keys. - (while (consp tail) - (and (consp (car tail)) - (let* ((key (vector (car (car tail)))) - (subnew (lookup-key new key)) - (subold (lookup-key old key))) - ;; If KEY is a prefix key in both OLD and NEW, merge them. - (and (keymapp subnew) (keymapp subold) - (derived-mode-merge-keymaps subold subnew)))) - (and (vectorp (car tail)) - ;; Search a vector of ASCII char bindings for prefix keys. - (let ((i (1- (length (car tail))))) - (while (>= i 0) - (let* ((key (vector i)) - (subnew (lookup-key new key)) - (subold (lookup-key old key))) - ;; If KEY is a prefix key in both OLD and NEW, merge them. - (and (keymapp subnew) (keymapp subold) - (derived-mode-merge-keymaps subold subnew))) - (setq i (1- i))))) - (setq tail (cdr tail)))) - (setcdr (nthcdr (1- (length new)) new) old)) - -(defun derived-mode-merge-syntax-tables (old new) - "Merge an OLD syntax table into a NEW one. -Where the new table already has an entry, nothing is copied from the old one." - (set-char-table-parent new old)) - -;; Merge an old abbrev table into a new one. -;; This function requires internal knowledge of how abbrev tables work, -;; presuming that they are obarrays with the abbrev as the symbol, the expansion -;; as the value of the symbol, and the hook as the function definition. -(defun derived-mode-merge-abbrev-tables (old new) - (if old - (mapatoms - (lambda (symbol) - (or (intern-soft (symbol-name symbol) new) - (define-abbrev new (symbol-name symbol) - (symbol-value symbol) (symbol-function symbol)))) - old))) - (provide 'derived) ;;; derived.el ends here -- cgit v1.2.3 From a470dfb7f8a0f6d561b1f7c9665408d73b578e18 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Mon, 29 Jan 2024 17:33:35 -0800 Subject: Fix typo in Eshell's "du" command This option is supposed to be "--si", for "International System of Units", not "--is". * lisp/eshell/em-unix.el (eshell/du): Change "is" to "si". --- lisp/eshell/em-unix.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index c3c3fea691a..a88c7e09946 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -940,7 +940,7 @@ external command." "display data only this many levels of data") (?h "human-readable" 1024 human-readable "print sizes in human readable format") - (?H "is" 1000 human-readable + (?H "si" 1000 human-readable "likewise, but use powers of 1000 not 1024") (?k "kilobytes" 1024 block-size "like --block-size 1024") -- cgit v1.2.3 From c8b9ec923f2838321aafd6c0912c7e6371145ce0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 30 Jan 2024 16:15:59 +0200 Subject: ; Rename a lexical variable in vhdl-mode.el * lisp/progmodes/vhdl-mode.el (vhdl-speedbar-insert-hierarchy): Rename a variable to avoid shadowing a global. (Bug#68810) --- lisp/progmodes/vhdl-mode.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index afdf52629c4..f52baf049aa 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -14978,9 +14978,9 @@ otherwise use cached data." (vhdl-aput 'vhdl-directory-alist directory (list (list directory)))) (defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg - package-alist ent-inst-list depth) - "Insert hierarchy of ENT-ALIST-ARG, CONF-ALIST-ARG, and PACKAGE-ALIST." - (if (not (or ent-alist-arg conf-alist-arg package-alist)) + pkg-alist ent-inst-list depth) + "Insert hierarchy of ENT-ALIST-ARG, CONF-ALIST-ARG, and PKG-ALIST." + (if (not (or ent-alist-arg conf-alist-arg pkg-alist)) (vhdl-speedbar-make-title-line "No VHDL design units!" depth) (let ((ent-alist ent-alist-arg) (conf-alist conf-alist-arg) @@ -15010,15 +15010,15 @@ otherwise use cached data." 'vhdl-speedbar-configuration-face depth) (setq conf-alist (cdr conf-alist))) ;; insert packages - (when package-alist (vhdl-speedbar-make-title-line "Packages:" depth)) - (while package-alist - (setq pack-entry (car package-alist)) + (when pkg-alist (vhdl-speedbar-make-title-line "Packages:" depth)) + (while pkg-alist + (setq pack-entry (car pkg-alist)) (vhdl-speedbar-make-pack-line (nth 0 pack-entry) (nth 1 pack-entry) (cons (nth 2 pack-entry) (nth 3 pack-entry)) (cons (nth 7 pack-entry) (nth 8 pack-entry)) depth) - (setq package-alist (cdr package-alist)))))) + (setq pkg-alist (cdr pkg-alist)))))) (declare-function speedbar-line-directory "speedbar" (&optional depth)) -- cgit v1.2.3 From 3afbab2f1d6ce7d75cadf12af096314123b6d56f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 30 Jan 2024 13:14:32 -0500 Subject: * lisp/emacs-lisp/inline.el (inline-const-val): Improve docstring --- lisp/emacs-lisp/inline.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el index c774296084e..ddbd6fdc017 100644 --- a/lisp/emacs-lisp/inline.el +++ b/lisp/emacs-lisp/inline.el @@ -80,7 +80,9 @@ (error "inline-const-p can only be used within define-inline")) (defmacro inline-const-val (_exp) - "Return the value of EXP." + "Return the value of EXP. +During inlining, if the value of EXP is not yet known, this aborts the +inlining and makes us revert to a non-inlined function call." (declare (debug t)) (error "inline-const-val can only be used within define-inline")) -- cgit v1.2.3 From 17771b2a425e776c81e7454d942ec238264ce12b Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 30 Jan 2024 17:09:37 -0800 Subject: ; Spelling fixes --- lisp/emacs-lisp/comp.el | 7 +++---- lisp/progmodes/gud.el | 2 +- src/sfnt.h | 2 +- test/lisp/net/tramp-tests.el | 4 ++-- 4 files changed, 7 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 8441b228898..2a516246ed4 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -569,10 +569,9 @@ In use by the back-end." finally return t) t)) -(defsubst comp--symbol-func-to-fun (symbol-funcion) - "Given a function called SYMBOL-FUNCION return its `comp-func'." - (gethash (gethash symbol-funcion (comp-ctxt-sym-to-c-name-h - comp-ctxt)) +(defsubst comp--symbol-func-to-fun (symbol-func) + "Given a function called SYMBOL-FUNC return its `comp-func'." + (gethash (gethash symbol-func (comp-ctxt-sym-to-c-name-h comp-ctxt)) (comp-ctxt-funcs-h comp-ctxt))) (defun comp--function-pure-p (f) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index be6357f4139..b7c85fe7f43 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -243,7 +243,7 @@ Check it when `gud-running' is t") :visible (eq gud-minor-mode 'gdbmi)] ["Print Expression" gud-print :enable (not gud-running)] - ["Dump object-Derefenrece" gud-pstar + ["Dump object-Dereference" gud-pstar :label (if (eq gud-minor-mode 'jdb) "Dump object" "Print Dereference") diff --git a/src/sfnt.h b/src/sfnt.h index 5b01270e8ce..444b1dfe427 100644 --- a/src/sfnt.h +++ b/src/sfnt.h @@ -248,7 +248,7 @@ enum sfnt_macintosh_platform_specific_id SFNT_MACINTOSH_GREEK = 6, SFNT_MACINTOSH_RUSSIAN = 7, SFNT_MACINTOSH_RSYMBOL = 8, - SFNT_MACINTOSH_DEVANGARI = 9, + SFNT_MACINTOSH_DEVANAGARI = 9, SFNT_MACINTOSH_GURMUKHI = 10, SFNT_MACINTOSH_GUJARATI = 11, SFNT_MACINTOSH_ORIYA = 12, diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 2a3b3e16891..489b682d0c3 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5155,8 +5155,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should-not (get-buffer-window (current-buffer) t)) (delete-file tmp-name))) - ;; Check remote and local DESTNATION file. This isn't - ;; implemented yet ina all file name handler backends. + ;; Check remote and local DESTINATION file. This isn't + ;; implemented yet in all file name handler backends. ;; (dolist (local '(nil t)) ;; (setq tmp-name (tramp--test-make-temp-name local quoted)) ;; (should -- cgit v1.2.3 From f63bcf2dfeb26de511f468adc237e6ea8a3cb6cc Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Tue, 30 Jan 2024 22:18:33 -0800 Subject: Fix treesit--indent-1 regarding local parsers Take this code as an example: 1 class Foo 2 { 3 /** 4 * Block comment 5 */ 6 function foo($c) { 7 } 8 } Suppose the block comment is covered by a local parser. When we indent line 3, treesit--indent-1 will try to get the local parser at the BOL, and it'll get the local parser. But it shouldn't use the local parser to indent this line, it should use the host parser of that local parser instead. So now, if treesit--indent-1 gets a local parser, but the local parser's root node's start coincides with BOL, treesit--indent-1 will use the host parser to indent this line. We also need to make treesit--update-ranges-local to save the host parser along with the local parser, and make treesit-local-parsers-at/on extract and return the host parser. I also switch the two cases in the cond form in treesit--indent-1: (null (treesit-parser-list)) and (car local-parsers), (car local-parsers) now takes precedence. * lisp/treesit.el (treesit-local-parsers-at): (treesit-local-parsers-on): Add WITH-HOST parameter. (treesit--update-ranges-local): Save the host parser to the local overlay. (treesit--indent-1): If the root node of the local parser is at BOL, use the host parser instead. --- lisp/treesit.el | 44 +++++++++++++++++++++++++++++++------------- 1 file changed, 31 insertions(+), 13 deletions(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index 96222ed81cb..fab2ddd88e6 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -655,37 +655,47 @@ those inside are kept." if (<= start (car range) (cdr range) end) collect range)) -(defun treesit-local-parsers-at (&optional pos language) +(defun treesit-local-parsers-at (&optional pos language with-host) "Return all the local parsers at POS. POS defaults to point. Local parsers are those which only parse a limited region marked by an overlay with non-nil `treesit-parser' property. -If LANGUAGE is non-nil, only return parsers for LANGUAGE." +If LANGUAGE is non-nil, only return parsers for LANGUAGE. + +If WITH-HOST is non-nil, return a list of (PARSER . HOST-PARSER) +instead. HOST-PARSER is the host parser which created the local +PARSER." (let ((res nil)) (dolist (ov (overlays-at (or pos (point)))) - (when-let ((parser (overlay-get ov 'treesit-parser))) + (when-let ((parser (overlay-get ov 'treesit-parser)) + (host-parser (overlay-get ov 'treesit-host-parser))) (when (or (null language) (eq (treesit-parser-language parser) language)) - (push parser res)))) + (push (if with-host (cons parser host-parser) parser) res)))) (nreverse res))) -(defun treesit-local-parsers-on (&optional beg end language) +(defun treesit-local-parsers-on (&optional beg end language with-host) "Return all the local parsers between BEG END. BEG and END default to the beginning and end of the buffer's accessible portion. Local parsers are those which have an `embedded' tag, and only parse a limited region marked by an overlay with a non-nil `treesit-parser' -property. If LANGUAGE is non-nil, only return parsers for LANGUAGE." +property. If LANGUAGE is non-nil, only return parsers for LANGUAGE. + +If WITH-HOST is non-nil, return a list of (PARSER . HOST-PARSER) +instead. HOST-PARSER is the host parser which created the local +PARSER." (let ((res nil)) (dolist (ov (overlays-in (or beg (point-min)) (or end (point-max)))) - (when-let ((parser (overlay-get ov 'treesit-parser))) + (when-let ((parser (overlay-get ov 'treesit-parser)) + (host-parser (overlay-get ov 'treesit-host-parser))) (when (or (null language) (eq (treesit-parser-language parser) language)) - (push parser res)))) + (push (if with-host (cons parser host-parser) parser) res)))) (nreverse res))) (defun treesit--update-ranges-local @@ -701,7 +711,8 @@ parser for EMBEDDED-LANG." (treesit-parser-delete parser)))) ;; Update range. (let* ((host-lang (treesit-query-language query)) - (ranges (treesit-query-range host-lang query beg end))) + (host-parser (treesit-parser-create host-lang)) + (ranges (treesit-query-range host-parser query beg end))) (pcase-dolist (`(,beg . ,end) ranges) (let ((has-parser nil)) (dolist (ov (overlays-in beg end)) @@ -719,6 +730,7 @@ parser for EMBEDDED-LANG." embedded-lang nil t 'embedded)) (ov (make-overlay beg end nil nil t))) (overlay-put ov 'treesit-parser embedded-parser) + (overlay-put ov 'treesit-host-parser host-parser) (treesit-parser-set-included-ranges embedded-parser `((,beg . ,end))))))))) @@ -1800,11 +1812,17 @@ Return (ANCHOR . OFFSET). This function is used by (forward-line 0) (skip-chars-forward " \t") (point))) - (local-parsers (treesit-local-parsers-at bol)) + (local-parsers (treesit-local-parsers-at bol nil t)) (smallest-node - (cond ((null (treesit-parser-list)) nil) - (local-parsers (treesit-node-at - bol (car local-parsers))) + (cond ((car local-parsers) + (let ((local-parser (caar local-parsers)) + (host-parser (cdar local-parsers))) + (if (eq (treesit-node-start + (treesit-parser-root-node local-parser)) + bol) + (treesit-node-at bol host-parser) + (treesit-node-at bol local-parser)))) + ((null (treesit-parser-list)) nil) ((eq 1 (length (treesit-parser-list nil nil t))) (treesit-node-at bol)) ((treesit-language-at bol) -- cgit v1.2.3 From 9bcc9690a8076a22398c27a7ccf836ee95eb16a2 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Tue, 30 Jan 2024 17:55:19 +0100 Subject: Eliminate lazy bytecode loading The obsolete lazy-loaded bytecode feature, enabled by `byte-compile-dynamic`, slows down Lisp execution even when not in use because every call to a bytecode function has to check that function for laziness. This change forces up-front loading of all lazy bytecode so that we can remove all those checks. (Dynamically loaded doc strings are not affected.) There is no point in generating lazy bytecode any more so we stop doing that; this simplifies the compiler. `byte-compile-dynamic` now has no effect. This is a fully compatible change; the few remaining users of `byte-compile-dynamic` should not notice any difference. * src/lread.c (bytecode_from_rev_list): Force eager loading of lazy bytecode. * src/bytecode.c (exec_byte_code): Remove lazy bytecode checks. * src/eval.c (fetch_and_exec_byte_code, Ffetch_bytecode): Remove. (funcall_lambda): Call exec_byte_code directly, avoiding checks. * lisp/subr.el (fetch-bytecode): New definition, obsolete no-op. * lisp/emacs-lisp/disass.el (disassemble-1): * lisp/emacs-lisp/bytecomp.el (byte-compile-unfold-bcf): Remove calls to fetch-bytecode. (byte-compile-dynamic): Update doc string. (byte-compile-close-variables, byte-compile-from-buffer) (byte-compile-insert-header, byte-compile-output-file-form) (byte-compile--output-docform-recurse, byte-compile-output-docform) (byte-compile-file-form-defmumble): Remove effects of byte-compile-dynamic. * doc/lispref/compile.texi (Dynamic Loading): Remove node now that the entire `byte-compile-dynamic` facility has been rendered inert. * etc/NEWS: Announce changes. --- doc/lispref/compile.texi | 66 --------------------------------------------- doc/lispref/elisp.texi | 1 - etc/NEWS | 7 +++++ lisp/emacs-lisp/bytecomp.el | 66 +++++++-------------------------------------- lisp/emacs-lisp/disass.el | 2 -- lisp/subr.el | 2 ++ src/bytecode.c | 27 +++++++++---------- src/eval.c | 59 ++-------------------------------------- src/lread.c | 49 ++++++++++++++++----------------- 9 files changed, 58 insertions(+), 221 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi index 98a01fb67f9..00602198da5 100644 --- a/doc/lispref/compile.texi +++ b/doc/lispref/compile.texi @@ -35,7 +35,6 @@ variable binding for @code{no-byte-compile} into it, like this: * Speed of Byte-Code:: An example of speedup from byte compilation. * Compilation Functions:: Byte compilation functions. * Docs and Compilation:: Dynamic loading of documentation strings. -* Dynamic Loading:: Dynamic loading of individual functions. * Eval During Compile:: Code to be evaluated when you compile. * Compiler Errors:: Handling compiler error messages. * Byte-Code Objects:: The data type used for byte-compiled functions. @@ -289,71 +288,6 @@ stands for the name of this file, as a string. Do not use these constructs in Lisp source files; they are not designed to be clear to humans reading the file. -@node Dynamic Loading -@section Dynamic Loading of Individual Functions - -@cindex dynamic loading of functions -@cindex lazy loading - When you compile a file, you can optionally enable the @dfn{dynamic -function loading} feature (also known as @dfn{lazy loading}). With -dynamic function loading, loading the file doesn't fully read the -function definitions in the file. Instead, each function definition -contains a place-holder which refers to the file. The first time each -function is called, it reads the full definition from the file, to -replace the place-holder. - - The advantage of dynamic function loading is that loading the file -should become faster. This is a good thing for a file which contains -many separate user-callable functions, if using one of them does not -imply you will probably also use the rest. A specialized mode which -provides many keyboard commands often has that usage pattern: a user may -invoke the mode, but use only a few of the commands it provides. - - The dynamic loading feature has certain disadvantages: - -@itemize @bullet -@item -If you delete or move the compiled file after loading it, Emacs can no -longer load the remaining function definitions not already loaded. - -@item -If you alter the compiled file (such as by compiling a new version), -then trying to load any function not already loaded will usually yield -nonsense results. -@end itemize - - These problems will never happen in normal circumstances with -installed Emacs files. But they are quite likely to happen with Lisp -files that you are changing. The easiest way to prevent these problems -is to reload the new compiled file immediately after each recompilation. - - @emph{Experience shows that using dynamic function loading provides -benefits that are hardly measurable, so this feature is deprecated -since Emacs 27.1.} - - The byte compiler uses the dynamic function loading feature if the -variable @code{byte-compile-dynamic} is non-@code{nil} at compilation -time. Do not set this variable globally, since dynamic loading is -desirable only for certain files. Instead, enable the feature for -specific source files with file-local variable bindings. For example, -you could do it by writing this text in the source file's first line: - -@example --*-byte-compile-dynamic: t;-*- -@end example - -@defvar byte-compile-dynamic -If this is non-@code{nil}, the byte compiler generates compiled files -that are set up for dynamic function loading. -@end defvar - -@defun fetch-bytecode function -If @var{function} is a byte-code function object, this immediately -finishes loading the byte code of @var{function} from its -byte-compiled file, if it is not fully loaded already. Otherwise, -it does nothing. It always returns @var{function}. -@end defun - @node Eval During Compile @section Evaluation During Compilation @cindex eval during compilation diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index a3ef8313f8e..cab1622337e 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -653,7 +653,6 @@ Byte Compilation * Speed of Byte-Code:: An example of speedup from byte compilation. * Compilation Functions:: Byte compilation functions. * Docs and Compilation:: Dynamic loading of documentation strings. -* Dynamic Loading:: Dynamic loading of individual functions. * Eval During Compile:: Code to be evaluated when you compile. * Compiler Errors:: Handling compiler error messages. * Byte-Code Objects:: The data type used for byte-compiled functions. diff --git a/etc/NEWS b/etc/NEWS index a9d6eb6789d..8fccc299c6b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1846,6 +1846,13 @@ The declaration '(important-return-value t)' sets the 'important-return-value' property which indicates that the function return value should probably not be thrown away implicitly. +** Bytecode is now always loaded eagerly. +Bytecode compiled with older Emacs versions for lazy loading using +'byte-compile-dynamic' is now loaded all at once. +As a consequence, 'fetch-bytecode' has no use, does nothing, and is +now obsolete. The variable 'byte-compile-dynamic' has no effect any +more; compilation will always yield bytecode for eager loading. + +++ ** New functions 'file-user-uid' and 'file-group-gid'. These functions are like 'user-uid' and 'group-gid', respectively, but diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e87595b3e77..becc77f504a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -231,17 +231,8 @@ This includes variable references and calls to functions such as `car'." :type 'boolean) (defvar byte-compile-dynamic nil - "If non-nil, compile function bodies so they load lazily. -They are hidden in comments in the compiled file, -and each one is brought into core when the -function is called. - -To enable this option, make it a file-local variable -in the source file you want it to apply to. -For example, add -*-byte-compile-dynamic: t;-*- on the first line. - -When this option is true, if you load the compiled file and then move it, -the functions you loaded will not be able to run.") + "Formerly used to compile function bodies so they load lazily. +This variable no longer has any effect.") (make-obsolete-variable 'byte-compile-dynamic "not worthwhile any more." "27.1") ;;;###autoload(put 'byte-compile-dynamic 'safe-local-variable 'booleanp) @@ -1858,7 +1849,6 @@ It is too wide if it has any lines longer than the largest of ;; (byte-compile-verbose byte-compile-verbose) (byte-optimize byte-optimize) - (byte-compile-dynamic byte-compile-dynamic) (byte-compile-dynamic-docstrings byte-compile-dynamic-docstrings) (byte-compile-warnings byte-compile-warnings) @@ -2428,8 +2418,7 @@ With argument ARG, insert value in current buffer after the form." (defun byte-compile-insert-header (_filename outbuffer) "Insert a header at the start of OUTBUFFER. Call from the source buffer." - (let ((dynamic byte-compile-dynamic) - (optimize byte-optimize)) + (let ((optimize byte-optimize)) (with-current-buffer outbuffer (goto-char (point-min)) ;; The magic number of .elc files is ";ELC", or 0x3B454C43. After @@ -2463,10 +2452,7 @@ Call from the source buffer." ((eq optimize 'byte) " byte-level optimization only") (optimize " all optimizations") (t "out optimization")) - ".\n" - (if dynamic ";;; Function definitions are lazy-loaded.\n" - "") - "\n\n")))) + ".\n\n\n")))) (defun byte-compile-output-file-form (form) ;; Write the given form to the output buffer, being careful of docstrings @@ -2487,7 +2473,7 @@ Call from the source buffer." (print-circle t)) ; Handle circular data structures. (if (memq (car-safe form) '(defvar defvaralias defconst autoload custom-declare-variable)) - (byte-compile-output-docform nil nil nil '("\n(" ")") form nil 3 nil + (byte-compile-output-docform nil nil nil '("\n(" ")") form nil 3 (memq (car form) '(defvaralias autoload custom-declare-variable))) @@ -2498,15 +2484,11 @@ Call from the source buffer." (defvar byte-compile--for-effect) (defun byte-compile--output-docform-recurse - (info position form cvecindex docindex specindex quoted) + (info position form cvecindex docindex quoted) "Print a form with a doc string. INFO is (prefix postfix). POSITION is where the next doc string is to be inserted. CVECINDEX is the index in the FORM of the constant vector, or nil. DOCINDEX is the index of the doc string (or nil) in the FORM. -If SPECINDEX is non-nil, it is the index in FORM -of the function bytecode string. In that case, -we output that argument and the following argument -\(the constants vector) together, for lazy loading. QUOTED says that we have to put a quote before the list that represents a doc string reference. `defvaralias', `autoload' and `custom-declare-variable' need that. @@ -2529,29 +2511,7 @@ Return the position after any inserted docstrings as comments." (while (setq form (cdr form)) (setq index (1+ index)) (insert " ") - (cond ((and (numberp specindex) (= index specindex) - ;; Don't handle the definition dynamically - ;; if it refers (or might refer) - ;; to objects already output - ;; (for instance, gensyms in the arg list). - (let (non-nil) - (when (hash-table-p print-number-table) - (maphash (lambda (_k v) (if v (setq non-nil t))) - print-number-table)) - (not non-nil))) - ;; Output the byte code and constants specially - ;; for lazy dynamic loading. - (goto-char position) - (let ((lazy-position (byte-compile-output-as-comment - (cons (car form) (nth 1 form)) - t))) - (setq position (point)) - (goto-char (point-max)) - (princ (format "(#$ . %d) nil" lazy-position) - byte-compile--outbuffer) - (setq form (cdr form)) - (setq index (1+ index)))) - ((eq index cvecindex) + (cond ((eq index cvecindex) (let* ((cvec (car form)) (len (length cvec)) (index2 0) @@ -2564,7 +2524,7 @@ Return the position after any inserted docstrings as comments." (byte-compile--output-docform-recurse '("#[" "]") position (append elt nil) ; Convert the vector to a list. - 2 4 specindex nil)) + 2 4 nil)) (prin1 elt byte-compile--outbuffer)) (setq index2 (1+ index2)) (unless (eq index2 len) @@ -2590,16 +2550,12 @@ Return the position after any inserted docstrings as comments." (defun byte-compile-output-docform (preface tailpiece name info form cvecindex docindex - specindex quoted) + quoted) "Print a form with a doc string. INFO is (prefix postfix). If PREFACE, NAME, and TAILPIECE are non-nil, print them too, before/after INFO and the FORM but after the doc string itself. CVECINDEX is the index in the FORM of the constant vector, or nil. DOCINDEX is the index of the doc string (or nil) in the FORM. -If SPECINDEX is non-nil, it is the index in FORM -of the function bytecode string. In that case, -we output that argument and the following argument -\(the constants vector) together, for lazy loading. QUOTED says that we have to put a quote before the list that represents a doc string reference. `defvaralias', `autoload' and `custom-declare-variable' need that." @@ -2627,7 +2583,7 @@ list that represents a doc string reference. (insert preface) (prin1 name byte-compile--outbuffer)) (byte-compile--output-docform-recurse - info position form cvecindex docindex specindex quoted) + info position form cvecindex docindex quoted) (when tailpiece (insert tailpiece)))))) @@ -2971,7 +2927,6 @@ not to take responsibility for the actual compilation of the code." (if macro '(" '(macro . #[" "])") '(" #[" "]")) (append code nil) ; Turn byte-code-function-p into list. 2 4 - (and (atom code) byte-compile-dynamic 1) nil) t))))) @@ -3810,7 +3765,6 @@ lambda-expression." (alen (length (cdr form))) (dynbinds ()) lap) - (fetch-bytecode fun) (setq lap (byte-decompile-bytecode-1 (aref fun 1) (aref fun 2) t)) ;; optimized switch bytecode makes it impossible to guess the correct ;; `byte-compile-depth', which can result in incorrect inlined code. diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index a876e6b5744..b7db2adde59 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -191,8 +191,6 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler." (if (consp obj) (setq bytes (car (cdr obj)) ;the byte code constvec (car (cdr (cdr obj)))) ;constant vector - ;; If it is lazy-loaded, load it now - (fetch-bytecode obj) (setq bytes (aref obj 1) constvec (aref obj 2))) (cl-assert (not (multibyte-string-p bytes))) diff --git a/lisp/subr.el b/lisp/subr.el index 33de100870e..a97824965b5 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2023,6 +2023,8 @@ instead; it will indirectly limit the specpdl stack size as well.") (defvaralias 'native-comp-deferred-compilation 'native-comp-jit-compilation) +(define-obsolete-function-alias 'fetch-bytecode #'ignore "30.1") + ;;;; Alternate names for functions - these are not being phased out. diff --git a/src/bytecode.c b/src/bytecode.c index ed6e2b34e77..def20b232c6 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -792,22 +792,19 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, Lisp_Object original_fun = call_fun; if (SYMBOLP (call_fun)) call_fun = XSYMBOL (call_fun)->u.s.function; - Lisp_Object template; - Lisp_Object bytecode; - if (COMPILEDP (call_fun) - /* Lexical binding only. */ - && (template = AREF (call_fun, COMPILED_ARGLIST), - FIXNUMP (template)) - /* No autoloads. */ - && (bytecode = AREF (call_fun, COMPILED_BYTECODE), - !CONSP (bytecode))) + if (COMPILEDP (call_fun)) { - fun = call_fun; - bytestr = bytecode; - args_template = XFIXNUM (template); - nargs = call_nargs; - args = call_args; - goto setup_frame; + Lisp_Object template = AREF (call_fun, COMPILED_ARGLIST); + if (FIXNUMP (template)) + { + /* Fast path for lexbound functions. */ + fun = call_fun; + bytestr = AREF (call_fun, COMPILED_BYTECODE), + args_template = XFIXNUM (template); + nargs = call_nargs; + args = call_args; + goto setup_frame; + } } Lisp_Object val; diff --git a/src/eval.c b/src/eval.c index 6f1c39ffb0e..95eb21909d2 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3122,19 +3122,6 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args) xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (numargs)); } -/* Call the compiled Lisp function FUN. If we have not yet read FUN's - bytecode string and constants vector, fetch them from the file first. */ - -static Lisp_Object -fetch_and_exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, - ptrdiff_t nargs, Lisp_Object *args) -{ - if (CONSP (AREF (fun, COMPILED_BYTECODE))) - Ffetch_bytecode (fun); - - return exec_byte_code (fun, args_template, nargs, args); -} - static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args, specpdl_ref count) { @@ -3204,8 +3191,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, ARGLIST slot value: pass the arguments to the byte-code engine directly. */ if (FIXNUMP (syms_left)) - return fetch_and_exec_byte_code (fun, XFIXNUM (syms_left), - nargs, arg_vector); + return exec_byte_code (fun, XFIXNUM (syms_left), nargs, arg_vector); /* Otherwise the bytecode object uses dynamic binding and the ARGLIST slot contains a standard formal argument list whose variables are bound dynamically below. */ @@ -3293,7 +3279,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, val = XSUBR (fun)->function.a0 (); } else - val = fetch_and_exec_byte_code (fun, 0, 0, NULL); + val = exec_byte_code (fun, 0, 0, NULL); return unbind_to (count, val); } @@ -3411,46 +3397,6 @@ lambda_arity (Lisp_Object fun) return Fcons (make_fixnum (minargs), make_fixnum (maxargs)); } -DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, - 1, 1, 0, - doc: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */) - (Lisp_Object object) -{ - Lisp_Object tem; - - if (COMPILEDP (object)) - { - if (CONSP (AREF (object, COMPILED_BYTECODE))) - { - tem = read_doc_string (AREF (object, COMPILED_BYTECODE)); - if (! (CONSP (tem) && STRINGP (XCAR (tem)) - && VECTORP (XCDR (tem)))) - { - tem = AREF (object, COMPILED_BYTECODE); - if (CONSP (tem) && STRINGP (XCAR (tem))) - error ("Invalid byte code in %s", SDATA (XCAR (tem))); - else - error ("Invalid byte code"); - } - - Lisp_Object bytecode = XCAR (tem); - if (STRING_MULTIBYTE (bytecode)) - { - /* BYTECODE must have been produced by Emacs 20.2 or earlier - because it produced a raw 8-bit string for byte-code and now - such a byte-code string is loaded as multibyte with raw 8-bit - characters converted to multibyte form. Convert them back to - the original unibyte form. */ - bytecode = Fstring_as_unibyte (bytecode); - } - - pin_string (bytecode); - ASET (object, COMPILED_BYTECODE, bytecode); - ASET (object, COMPILED_CONSTANTS, XCDR (tem)); - } - } - return object; -} /* Return true if SYMBOL's default currently has a let-binding which was made in the buffer that is now current. */ @@ -4512,7 +4458,6 @@ alist of active lexical bindings. */); defsubr (&Srun_hook_with_args_until_success); defsubr (&Srun_hook_with_args_until_failure); defsubr (&Srun_hook_wrapped); - defsubr (&Sfetch_bytecode); defsubr (&Sbacktrace_debug); DEFSYM (QCdebug_on_exit, ":debug-on-exit"); defsubr (&Smapbacktrace); diff --git a/src/lread.c b/src/lread.c index 929f86ef283..e77bfb8021d 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3481,6 +3481,8 @@ vector_from_rev_list (Lisp_Object elems) return obj; } +static Lisp_Object get_lazy_string (Lisp_Object val); + static Lisp_Object bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) { @@ -3495,14 +3497,18 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) && FIXNATP (vec[COMPILED_STACK_DEPTH]))) invalid_syntax ("Invalid byte-code object", readcharfun); - if (load_force_doc_strings - && NILP (vec[COMPILED_CONSTANTS]) - && STRINGP (vec[COMPILED_BYTECODE])) + /* Always read 'lazily-loaded' bytecode (generated by the + `byte-compile-dynamic' feature prior to Emacs 30) eagerly, to + avoid code in the fast path during execution. */ + if (CONSP (vec[COMPILED_BYTECODE])) + vec[COMPILED_BYTECODE] = get_lazy_string (vec[COMPILED_BYTECODE]); + + /* Lazily-loaded bytecode is represented by the constant slot being nil + and the bytecode slot a (lazily loaded) string containing the + print representation of (BYTECODE . CONSTANTS). Unpack the + pieces by coerceing the string to unibyte and reading the result. */ + if (NILP (vec[COMPILED_CONSTANTS])) { - /* Lazily-loaded bytecode is represented by the constant slot being nil - and the bytecode slot a (lazily loaded) string containing the - print representation of (BYTECODE . CONSTANTS). Unpack the - pieces by coerceing the string to unibyte and reading the result. */ Lisp_Object enc = vec[COMPILED_BYTECODE]; Lisp_Object pair = Fread (Fcons (enc, readcharfun)); if (!CONSP (pair)) @@ -3512,25 +3518,20 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) vec[COMPILED_CONSTANTS] = XCDR (pair); } - if (!((STRINGP (vec[COMPILED_BYTECODE]) - && VECTORP (vec[COMPILED_CONSTANTS])) - || CONSP (vec[COMPILED_BYTECODE]))) + if (!(STRINGP (vec[COMPILED_BYTECODE]) + && VECTORP (vec[COMPILED_CONSTANTS]))) invalid_syntax ("Invalid byte-code object", readcharfun); - if (STRINGP (vec[COMPILED_BYTECODE])) - { - if (STRING_MULTIBYTE (vec[COMPILED_BYTECODE])) - { - /* BYTESTR must have been produced by Emacs 20.2 or earlier - because it produced a raw 8-bit string for byte-code and - now such a byte-code string is loaded as multibyte with - raw 8-bit characters converted to multibyte form. - Convert them back to the original unibyte form. */ - vec[COMPILED_BYTECODE] = Fstring_as_unibyte (vec[COMPILED_BYTECODE]); - } - /* Bytecode must be immovable. */ - pin_string (vec[COMPILED_BYTECODE]); - } + if (STRING_MULTIBYTE (vec[COMPILED_BYTECODE])) + /* BYTESTR must have been produced by Emacs 20.2 or earlier + because it produced a raw 8-bit string for byte-code and + now such a byte-code string is loaded as multibyte with + raw 8-bit characters converted to multibyte form. + Convert them back to the original unibyte form. */ + vec[COMPILED_BYTECODE] = Fstring_as_unibyte (vec[COMPILED_BYTECODE]); + + /* Bytecode must be immovable. */ + pin_string (vec[COMPILED_BYTECODE]); XSETPVECTYPE (XVECTOR (obj), PVEC_COMPILED); return obj; -- cgit v1.2.3 From b86bc02096c65517b9a29c20635ece100864fc62 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 1 Feb 2024 16:08:47 +0800 Subject: Introduce a global variant of visual-wrap-prefix-mode * doc/emacs/basic.texi (Continuation Lines): * etc/NEWS: * lisp/visual-wrap.el (visual-wrap-prefix-mode): Document this new global minor mode. (global-visual-wrap-prefix-mode): New global minor mode. --- doc/emacs/basic.texi | 17 ++++++++++------- etc/NEWS | 4 +++- lisp/visual-wrap.el | 10 +++++++++- 3 files changed, 22 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index cdc183c2a40..c00cd6e20cf 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -632,15 +632,18 @@ long, by using Auto Fill mode. @xref{Filling}. @cindex continuation lines, visual wrap prefix @findex visual-wrap-prefix-mode +@findex global-visual-wrap-prefix-mode Normally, the first character of each continuation line is positioned at the beginning of the screen line where it is displayed. -The minor mode @code{visual-wrap-prefix-mode} arranges that -continuation lines be prefixed by slightly adjusted versions of the -fill prefixes (@pxref{Fill Prefix}) of their respective logical lines, -so that indentation characters or the prefixes of source code comments -are replicated across every continuation line, and the appearance of -such comments or indentation is not broken. These prefixes are only -shown on display, and does not change the buffer text in any way. +The minor mode @code{visual-wrap-prefix-mode} and its global +counterpart @code{global-visual-wrap-prefix-mode} (@pxref{Minor +Modes}) arranges that continuation lines be prefixed by slightly +adjusted versions of the fill prefixes (@pxref{Fill Prefix}) of their +respective logical lines, so that indentation characters or the +prefixes of source code comments are replicated across every +continuation line, and the appearance of such comments or indentation +is not broken. These prefixes are only shown on display, and does not +change the buffer text in any way. Sometimes, you may need to edit files containing many long logical lines, and it may not be practical to break them all up by adding diff --git a/etc/NEWS b/etc/NEWS index 8fccc299c6b..9bd4d0f631b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -318,7 +318,9 @@ will receive a 'wrap-prefix' automatically computed from the line's surrounding context, such that continuation lines are indented on display as if they were filled with 'M-q' or similar. Unlike 'M-q', the indentation only happens on display, and doesn't change the buffer -text in any way. +text in any way. The global minor mode +'global-visual-wrap-prefix-mode' enables this minor mode in all +buffers. (This minor mode is the 'adaptive-wrap' ELPA package renamed and lightly edited for inclusion in Emacs.) diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index 20e55444082..d95cf4bb569 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -173,7 +173,9 @@ by `visual-wrap-extra-indent'." ;;;###autoload (define-minor-mode visual-wrap-prefix-mode - "Display continuation lines with prefixes from surrounding context." + "Display continuation lines with prefixes from surrounding context. +To enable this minor mode across all buffers, enable +`global-visual-wrap-prefix-mode'." :lighter "" :group 'visual-line (if visual-wrap-prefix-mode @@ -192,5 +194,11 @@ by `visual-wrap-extra-indent'." (widen) (remove-text-properties (point-min) (point-max) '(wrap-prefix nil)))))) +;;;###autoload +(define-globalized-minor-mode global-visual-wrap-prefix-mode + visual-wrap-prefix-mode visual-wrap-prefix-mode + :init-value nil + :group 'visual-line) + (provide 'visual-wrap) ;;; visual-wrap.el ends here -- cgit v1.2.3 From 5ce02c91bc128f390bcf0beb82e37a3fa7f251ba Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 1 Feb 2024 09:08:19 +0100 Subject: Improve `desktop-save-mode` docstring * lisp/desktop.el (desktop-save-mode): Improve docstring. --- lisp/desktop.el | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/desktop.el b/lisp/desktop.el index 56841b49595..9100d825547 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -163,13 +163,22 @@ Used at desktop read to provide backward compatibility.") (define-minor-mode desktop-save-mode "Toggle desktop saving (Desktop Save mode). -When Desktop Save mode is enabled, the state of Emacs is saved from -one session to another. In particular, Emacs will save the desktop when -it exits (this may prompt you; see the option `desktop-save'). The next -time Emacs starts, if this mode is active it will restore the desktop. +When Desktop Save mode is enabled, the state of Emacs is saved from one +session to another. The saved Emacs \"desktop configuration\" includes the +buffers, their file names, major modes, buffer positions, window and frame +configuration, and some important global variables. -To manually save the desktop at any time, use the command `\\[desktop-save]'. -To load it, use `\\[desktop-read]'. +To enable this feature for future sessions, customize `desktop-save-mode' +to t, or add this line in your init file: + + (desktop-save-mode 1) + +When this mode is enabled, Emacs will save the desktop when it exits +(this may prompt you, see the option `desktop-save'). The next time +Emacs starts, if this mode is active it will restore the desktop. + +To manually save the desktop at any time, use the command \\[desktop-save]. +To load it, use \\[desktop-read]. Once a desktop file exists, Emacs will auto-save it according to the option `desktop-auto-save-timeout'. -- cgit v1.2.3 From 169c704d74747d411a545eff9c497ddafb9c886c Mon Sep 17 00:00:00 2001 From: Sacha Chua Date: Fri, 26 Jan 2024 08:54:03 -0500 Subject: shr: Correct SVG attribute case * lisp/net/shr.el (shr-correct-attribute-case): New constant. (shr-correct-dom-case): New function to correct SVG attribute case. (shr-tag-svg): Correct SVG attribute cases before using them. --- lisp/net/shr.el | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 74 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 17fdffd619d..e23fc6104d2 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1437,13 +1437,85 @@ ones, in case fg and bg are nil." (shr-dom-print elem))))) (insert (format "" (dom-tag dom)))) +(defconst shr-correct-attribute-case + '((attributename . attributeName) + (attributetype . attributeType) + (basefrequency . baseFrequency) + (baseprofile . baseProfile) + (calcmode . calcMode) + (clippathunits . clipPathUnits) + (diffuseconstant . diffuseConstant) + (edgemode . edgeMode) + (filterunits . filterUnits) + (glyphref . glyphRef) + (gradienttransform . gradientTransform) + (gradientunits . gradientUnits) + (kernelmatrix . kernelMatrix) + (kernelunitlength . kernelUnitLength) + (keypoints . keyPoints) + (keysplines . keySplines) + (keytimes . keyTimes) + (lengthadjust . lengthAdjust) + (limitingconeangle . limitingConeAngle) + (markerheight . markerHeight) + (markerunits . markerUnits) + (markerwidth . markerWidth) + (maskcontentunits . maskContentUnits) + (maskunits . maskUnits) + (numoctaves . numOctaves) + (pathlength . pathLength) + (patterncontentunits . patternContentUnits) + (patterntransform . patternTransform) + (patternunits . patternUnits) + (pointsatx . pointsAtX) + (pointsaty . pointsAtY) + (pointsatz . pointsAtZ) + (preservealpha . preserveAlpha) + (preserveaspectratio . preserveAspectRatio) + (primitiveunits . primitiveUnits) + (refx . refX) + (refy . refY) + (repeatcount . repeatCount) + (repeatdur . repeatDur) + (requiredextensions . requiredExtensions) + (requiredfeatures . requiredFeatures) + (specularconstant . specularConstant) + (specularexponent . specularExponent) + (spreadmethod . spreadMethod) + (startoffset . startOffset) + (stddeviation . stdDeviation) + (stitchtiles . stitchTiles) + (surfacescale . surfaceScale) + (systemlanguage . systemLanguage) + (tablevalues . tableValues) + (targetx . targetX) + (targety . targetY) + (textlength . textLength) + (viewbox . viewBox) + (viewtarget . viewTarget) + (xchannelselector . xChannelSelector) + (ychannelselector . yChannelSelector) + (zoomandpan . zoomAndPan)) + "Attributes for correcting the case in SVG and MathML. +Based on https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-inforeign .") + +(defun shr-correct-dom-case (dom) + "Correct the case for SVG segments." + (dolist (attr (dom-attributes dom)) + (when-let ((rep (assoc-default (car attr) shr-correct-attribute-case))) + (setcar attr rep))) + (dolist (child (dom-children dom)) + (shr-correct-dom-case child)) + dom) + (defun shr-tag-svg (dom) (when (and (image-type-available-p 'svg) (not shr-inhibit-images) (dom-attr dom 'width) (dom-attr dom 'height)) - (funcall shr-put-image-function (list (shr-dom-to-xml dom 'utf-8) - 'image/svg+xml) + (funcall shr-put-image-function + (list (shr-dom-to-xml (shr-correct-dom-case dom) 'utf-8) + 'image/svg+xml) "SVG Image"))) (defun shr-tag-sup (dom) -- cgit v1.2.3 From 4adb4b2ac507636a82373ed1323dabcb7ee9258d Mon Sep 17 00:00:00 2001 From: Graham Marlow Date: Mon, 29 Jan 2024 17:16:04 -0800 Subject: Fix 'fill-paragraph' in 'yaml-ts-mode' * lisp/textmodes/yaml-ts-mode.el (yaml-ts-mode--fill-paragraph): Avoid 'fill-paragraph' when outside of block_scalar or comment nodes. (Bug#68781) --- lisp/textmodes/yaml-ts-mode.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el index c0185457bc2..a8cb504ef03 100644 --- a/lisp/textmodes/yaml-ts-mode.el +++ b/lisp/textmodes/yaml-ts-mode.el @@ -128,7 +128,7 @@ boundaries. JUSTIFY is passed to `fill-paragraph'." (save-restriction (widen) (let ((node (treesit-node-at (point)))) - (when (string= "block_scalar" (treesit-node-type node)) + (if (member (treesit-node-type node) '("block_scalar" "comment")) (let* ((start (treesit-node-start node)) (end (treesit-node-end node)) (start-marker (point-marker)) @@ -138,7 +138,8 @@ boundaries. JUSTIFY is passed to `fill-paragraph'." (forward-line) (move-marker start-marker (point)) (narrow-to-region (point) end)) - (fill-region start-marker end justify)))))) + (fill-region start-marker end justify)) + t)))) ;;;###autoload (define-derived-mode yaml-ts-mode text-mode "YAML" -- cgit v1.2.3 From d0766c0999e1e78b2f63e1d97881e926e5e6f905 Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Wed, 31 Jan 2024 13:54:16 +0000 Subject: Fix search error in woman.el * lisp/woman.el (woman-if-body): Avoid signaling an error if "el }" is not found. (Bug#68852) --- lisp/woman.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/woman.el b/lisp/woman.el index a9af46fa387..2357ba6b132 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -2566,7 +2566,8 @@ If DELETE is non-nil then delete from point." ;; "\\(\\\\{\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*" ;; Interpret bogus `el \}' as `el \{', ;; especially for Tcl/Tk man pages: - "\\(\\\\{\\|el[ \t]*\\\\}\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*") + "\\(\\\\{\\|el[ \t]*\\\\}\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*" + nil t) (match-beginning 1)) (re-search-forward "\\\\}")) (delete-region (if delete from (match-beginning 0)) (point)) -- cgit v1.2.3 From caecbf3e8db57d93715b8d20587b2ed54064cadb Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 1 Feb 2024 17:17:36 +0100 Subject: Fix stale cache in Tramp (do not merge with master) * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Flush file properties when needed. (Bug#68805) --- lisp/net/tramp-sh.el | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'lisp') diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 1301cd633da..44c0bdc7aea 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2521,6 +2521,12 @@ The method used must be an out-of-band method." ;; cached password). (tramp-cleanup-connection v 'keep-debug 'keep-password)))) + ;; The cached file properties might be wrong if NEWNAME didn't + ;; exist. Flush them. + (when v2 + (with-parsed-tramp-file-name newname v2 + (tramp-flush-file-properties v2 v2-localname))) + ;; Handle KEEP-DATE argument. (when (and keep-date (not copy-keep-date)) (tramp-compat-set-file-times -- cgit v1.2.3 From d89e427852a63dbeed3d5e03d9deb2ae9a8e3e1b Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 1 Feb 2024 19:16:37 +0200 Subject: * lisp/simple.el (read-from-kill-ring): Ignore `read-only' text property. Add `read-only' to the list of text properties removed from history items (bug#68847). --- lisp/simple.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/simple.el b/lisp/simple.el index 8246b9cab81..9a33049f4ca 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6419,7 +6419,7 @@ PROMPT is a string to prompt with." 0 (length s) '( keymap local-map action mouse-action - button category help-args) + read-only button category help-args) s) s) kill-ring)) -- cgit v1.2.3 From c14c978e3b1be9802a5c1fdf1b29e0ee48e16364 Mon Sep 17 00:00:00 2001 From: dalu Date: Thu, 1 Feb 2024 11:45:13 +0800 Subject: Support kotlin-ts-mode in Eglot * lisp/progmodes/eglot.el (eglot-server-programs): Support kotlin-ts-mode. (Bug#68865) Copyright-paperwork-exempt: yes --- lisp/progmodes/eglot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 1e90e26a537..cbc77b331f0 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -216,7 +216,7 @@ chosen (interactively or automatically)." . ("haskell-language-server-wrapper" "--lsp")) (elm-mode . ("elm-language-server")) (mint-mode . ("mint" "ls")) - (kotlin-mode . ("kotlin-language-server")) + ((kotlin-mode kotlin-ts-mode) . ("kotlin-language-server")) ((go-mode go-dot-mod-mode go-dot-work-mode go-ts-mode go-mod-ts-mode) . ("gopls")) ((R-mode ess-r-mode) . ("R" "--slave" "-e" -- cgit v1.2.3 From 5f56bc1cdfcd474dd9cfad07240df6c252abd35c Mon Sep 17 00:00:00 2001 From: Piotr Kwiecinski Date: Thu, 1 Feb 2024 14:02:20 +0100 Subject: eglot: Add php-ts-mode to eglot-server-programs * lisp/progmodes/eglot.el (eglot-server-programs): Add php-ts-mode. (Bug#68870) Copyright-paperwork-exempt: yes --- lisp/progmodes/eglot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index cbc77b331f0..55b54ed6dc6 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -200,7 +200,7 @@ chosen (interactively or automatically)." (typescript-mode :language-id "typescript")) . ("typescript-language-server" "--stdio")) ((bash-ts-mode sh-mode) . ("bash-language-server" "start")) - ((php-mode phps-mode) + ((php-mode phps-mode php-ts-mode) . ,(eglot-alternatives '(("phpactor" "language-server") ("php" "vendor/felixfbecker/language-server/bin/php-language-server.php")))) -- cgit v1.2.3 From a3987127618b9fe49b88807f0268ec9abcc7396f Mon Sep 17 00:00:00 2001 From: nibon7 Date: Thu, 18 Jan 2024 00:01:48 +0800 Subject: eglot: Add nushell language server * lisp/progmodes/eglot.el (eglot-server-programs): Add nushell language server. (Bug#68823) --- lisp/progmodes/eglot.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 55b54ed6dc6..9eaa92da03e 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -235,6 +235,7 @@ chosen (interactively or automatically)." (erlang-mode . ("erlang_ls" "--transport" "stdio")) ((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio")) (nix-mode . ,(eglot-alternatives '("nil" "rnix-lsp" "nixd"))) + ((nushell-mode nushell-ts-mode) . ("nu" "--lsp")) (gdscript-mode . ("localhost" 6008)) ((fortran-mode f90-mode) . ("fortls")) (futhark-mode . ("futhark" "lsp")) -- cgit v1.2.3 From 72b1379f0795a5e2e9c57615c0b1d78c0b97cd1f Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 2 Feb 2024 12:28:54 +0100 Subject: Increase `emacs-lisp-docstring-fill-column` to 72 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Monitors are wider now than when these defaults were first set, and it is useful to take better advantage of that, to fit text on fewer lines. Yet, it has repeatedly been shown that overly long lines reduce readability: "A reasonable guideline would be 55 to 75 characters per line."[1] We also don't want to disfavor narrow displays, like mobile phones; a more promising direction here might be to automatically word wrap docstrings and make their maximum width customizable. That might require a new docstring format, however. Bumping it by 7 characters, from 65 to 72, seems a reasonable compromise for now. Consideration was given to increasing it to 70 or 75, but 72 happens to be a commonly recommended maximum line width elsewhere (see Fortran 66, Python docstrings, commit message recommendations, etc.), and we might as well do the same. This change was discussed in: https://lists.gnu.org/r/emacs-devel/2022-07/msg00217.html [1] "Optimal Line Length in Reading — A Literature Review", Nanavati and Bias, Visible Language, Vol. 39 No. 2 (2005). https://journals.uc.edu/index.php/vl/article/view/5765 * lisp/emacs-lisp/lisp-mode.el (emacs-lisp-docstring-fill-column): * .dir-locals.el (fill-column, emacs-lisp-docstring-fill-column): Bump default to 72. --- .dir-locals.el | 4 ++-- etc/NEWS | 5 +++++ lisp/emacs-lisp/lisp-mode.el | 5 +++-- 3 files changed, 10 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/.dir-locals.el b/.dir-locals.el index ce7febca851..1f08c882e0b 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -3,8 +3,8 @@ ((nil . ((tab-width . 8) (sentence-end-double-space . t) - (fill-column . 70) - (emacs-lisp-docstring-fill-column . 65) + (fill-column . 72) + (emacs-lisp-docstring-fill-column . 72) (vc-git-annotate-switches . "-w") (bug-reference-url-format . "https://debbugs.gnu.org/%s") (diff-add-log-use-relative-names . t) diff --git a/etc/NEWS b/etc/NEWS index 9bd4d0f631b..5b3d7dec8a6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1170,6 +1170,11 @@ Previously, the '@' character, which normally has 'symbol' syntax, would combine with a following Lisp symbol and interfere with symbol searching. +--- +*** 'emacs-lisp-docstring-fill-column' now defaults to 72. +It was previously 65. The new default formats documentation strings to +fit on fewer lines without negatively impacting readability. + ** CPerl mode --- diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index ca207ff548d..ad0525e24be 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1420,14 +1420,15 @@ A prefix argument specifies pretty-printing." ;;;; Lisp paragraph filling commands. -(defcustom emacs-lisp-docstring-fill-column 65 +(defcustom emacs-lisp-docstring-fill-column 72 "Value of `fill-column' to use when filling a docstring. Any non-integer value means do not use a different value of `fill-column' when filling docstrings." :type '(choice (integer) (const :tag "Use the current `fill-column'" t)) :safe (lambda (x) (or (eq x t) (integerp x))) - :group 'lisp) + :group 'lisp + :version "30.1") (defun lisp-fill-paragraph (&optional justify) "Like \\[fill-paragraph], but handle Emacs Lisp comments and docstrings. -- cgit v1.2.3 From 4b79c80c999fe95654b7db196b12e0844473f6da Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 2 Feb 2024 15:24:55 +0200 Subject: New function 'sort-on' * lisp/sort.el (sort-on): New function. Patch by John Wiegley . * etc/NEWS: * doc/lispref/sequences.texi (Sequence Functions): Document 'sort-on'. --- doc/lispref/sequences.texi | 37 +++++++++++++++++++++++++++++++++---- etc/NEWS | 5 +++++ lisp/sort.el | 20 ++++++++++++++++++++ 3 files changed, 58 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index f1f23f007a4..654019dfc31 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -434,12 +434,41 @@ but their relative order is also preserved: (9 . "aaa") (9 . "zzz") (9 . "ppp") (9 . "fff")] @end group @end example - -@xref{Sorting}, for more functions that perform sorting. -See @code{documentation} in @ref{Accessing Documentation}, for a -useful example of @code{sort}. @end defun +Sometimes, computation of sort keys of list elements is expensive, and +therefore it is important to perform it the minimum number of times. +By contrast, computing the sort keys of elements inside the +@var{predicate} function passed to @code{sort} will generally perform +this computation each time @var{predicate} is called with some +element. If you can separate the computation of the sort key of an +element into a function of its own, you can use the following sorting +function, which guarantees that the key will be computed for each list +element exactly once. + +@defun sort-on sequence predicate accessor +This function stably sorts the list @var{sequence}, comparing the sort +keys of the elements using @var{predicate}. The comparison function +@var{predicate} accepts two arguments, the sort keys to compare, and +should return non-@code{nil} if the element corresponding to the first +key should sort before the element corresponding to the second key. +The function computes a sort key of each element by calling the +@var{accessor} function on that element; it does so exactly once for +each element of @var{sequence}. The @var{accessor} function is called +with a single argument, an element of @var{sequence}. + +This function implements what is known as +@dfn{decorate-sort-undecorate} paradigm, of the Schwartzian transform. +It basically trades CPU for memory, creating a temporary list with the +computed sport keys, then mapping @code{car} over the result of +sorting that temporary list. Unlike with @code{sort}, the return list +is a copy; the original list is left intact. +@end defun + +@xref{Sorting}, for more functions that perform sorting. See +@code{documentation} in @ref{Accessing Documentation}, for a useful +example of @code{sort}. + @cindex sequence functions in seq @cindex seq library @cindex sequences, generalized diff --git a/etc/NEWS b/etc/NEWS index 5b3d7dec8a6..816613de4ec 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1530,6 +1530,11 @@ precedence over the variable when present. Mostly used internally to do a kind of topological sort of inheritance hierarchies. +** New function 'sort-on'. +This function implements the Schwartzian transform, and is appropriate +for sorting lists when the computation of the sort key of a list +element can be expensive. + ** New API for 'derived-mode-p' and control of the graph of major modes. *** 'derived-mode-p' now takes the list of modes as a single argument. diff --git a/lisp/sort.el b/lisp/sort.el index 2ee76b6e1e3..97b40a2aef4 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -478,6 +478,26 @@ sRegexp specifying key within record: \nr") ;; if there was no such register (error (throw 'key nil)))))))))) +;;;###autoload +(defun sort-on (sequence predicate accessor) + "Sort SEQUENCE by calling PREDICATE on sort keys produced by ACCESSOR. +SEQUENCE should be the input list to sort. +Elements of SEQUENCE are sorted by keys which are obtained by +calling ACCESSOR on each element. ACCESSOR should be a function of +one argument, an element of SEQUENCE, and should return the key +value to be compared by PREDICATE for sorting the element. +PREDICATE is the function for comparing keys; it is called with two +arguments, the keys to compare, and should return non-nil if the +first key should sort before the second key. +This function has the performance advantage of evaluating +ACCESSOR only once for each element in the input SEQUENCE, and is +therefore appropriate when computing the key by ACCESSOR is an +expensive operation. This is known as the \"decorate-sort-undecorate\" +paradigm, or the Schwartzian transform." + (mapcar #'car + (sort (mapcar #'(lambda (x) (cons x (funcall accessor x))) sequence) + #'(lambda (x y) (funcall predicate (cdr x) (cdr y)))))) + (defvar sort-columns-subprocess t) -- cgit v1.2.3 From f9a15b8a1559999b8dd9895a5f5bb922c4e6730f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 2 Feb 2024 17:39:23 +0200 Subject: ; Fix last change * lisp/sort.el (sort-on): Doc fix. * doc/lispref/sequences.texi (Sequence Functions): Fix description of 'sort-on'. --- doc/lispref/sequences.texi | 38 +++++++++++++++++++------------------- lisp/sort.el | 3 ++- 2 files changed, 21 insertions(+), 20 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 896dac35c8e..9407b5f6342 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -436,35 +436,35 @@ but their relative order is also preserved: @end example @end defun -Sometimes, computation of sort keys of list elements is expensive, and -therefore it is important to perform it the minimum number of times. -By contrast, computing the sort keys of elements inside the -@var{predicate} function passed to @code{sort} will generally perform -this computation each time @var{predicate} is called with some +Sometimes, computation of sort keys of list or vector elements is +expensive, and therefore it is important to perform it the minimum +number of times. By contrast, computing the sort keys of elements +inside the @var{predicate} function passed to @code{sort} will generally +perform this computation each time @var{predicate} is called with some element. If you can separate the computation of the sort key of an element into a function of its own, you can use the following sorting function, which guarantees that the key will be computed for each list -element exactly once. +or vector element exactly once. @cindex decorate-sort-undecorate @cindex Schwartzian transform @defun sort-on sequence predicate accessor -This function stably sorts the list @var{sequence}, comparing the sort -keys of the elements using @var{predicate}. The comparison function -@var{predicate} accepts two arguments, the sort keys to compare, and -should return non-@code{nil} if the element corresponding to the first -key should sort before the element corresponding to the second key. -The function computes a sort key of each element by calling the -@var{accessor} function on that element; it does so exactly once for +This function stably sorts the list or vector @var{sequence}, comparing +the sort keys of the elements using @var{predicate}. The comparison +function @var{predicate} accepts two arguments, the sort keys to +compare, and should return non-@code{nil} if the element corresponding +to the first key should sort before the element corresponding to the +second key. The function computes a sort key of each element by calling +the @var{accessor} function on that element; it does so exactly once for each element of @var{sequence}. The @var{accessor} function is called with a single argument, an element of @var{sequence}. -This function implements what is known as -@dfn{decorate-sort-undecorate} paradigm, of the Schwartzian transform. -It basically trades CPU for memory, creating a temporary list with the -computed sport keys, then mapping @code{car} over the result of -sorting that temporary list. Unlike with @code{sort}, the return list -is a copy; the original list is left intact. +This function implements what is known as @dfn{decorate-sort-undecorate} +paradigm, of the Schwartzian transform. It basically trades CPU for +memory, creating a temporary list with the computed sort keys, then +mapping @code{car} over the result of sorting that temporary list. +Unlike with @code{sort}, the return value is always a new list; the +original @var{sequence} is left intact. @end defun @xref{Sorting}, for more functions that perform sorting. See diff --git a/lisp/sort.el b/lisp/sort.el index 97b40a2aef4..7047a714661 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -481,7 +481,7 @@ sRegexp specifying key within record: \nr") ;;;###autoload (defun sort-on (sequence predicate accessor) "Sort SEQUENCE by calling PREDICATE on sort keys produced by ACCESSOR. -SEQUENCE should be the input list to sort. +SEQUENCE should be the input list or vector to sort. Elements of SEQUENCE are sorted by keys which are obtained by calling ACCESSOR on each element. ACCESSOR should be a function of one argument, an element of SEQUENCE, and should return the key @@ -489,6 +489,7 @@ value to be compared by PREDICATE for sorting the element. PREDICATE is the function for comparing keys; it is called with two arguments, the keys to compare, and should return non-nil if the first key should sort before the second key. +The return value is always a new list. This function has the performance advantage of evaluating ACCESSOR only once for each element in the input SEQUENCE, and is therefore appropriate when computing the key by ACCESSOR is an -- cgit v1.2.3 From eb9bdb8948683e9870a3e52d085bf0c57d049130 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 2 Feb 2024 17:48:28 +0200 Subject: ; And another fix... --- lisp/sort.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/sort.el b/lisp/sort.el index 7047a714661..4f0d759ef8a 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -481,7 +481,7 @@ sRegexp specifying key within record: \nr") ;;;###autoload (defun sort-on (sequence predicate accessor) "Sort SEQUENCE by calling PREDICATE on sort keys produced by ACCESSOR. -SEQUENCE should be the input list or vector to sort. +SEQUENCE should be the input sequence to sort. Elements of SEQUENCE are sorted by keys which are obtained by calling ACCESSOR on each element. ACCESSOR should be a function of one argument, an element of SEQUENCE, and should return the key -- cgit v1.2.3 From e9a668274e441645aed28e8c353187dfed35fcae Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 31 Jan 2024 18:56:43 -0500 Subject: bytecomp.el: Rewrite the way we print dynamic docstrings We used to print dynamic docstrings "manually" for two reasons: - References should look like `(#$ . POS)` but `prin1` was unable to print just `#$` for an sexp. - `make-docfile` needed to find those docstrings and the object to which they belonged. The second point is moot now that we don't use `make-docfile` on `.elc` files. So this patch lifts the first restriction, using `print-number-table`. The rest of the patch then simplifies and regularises the bytecompiler's generation of dynamic docstrings, which can now also easily be done for "inner" defvars and other places. * src/print.c (print_preprocess, print_object): Handle strings in `print-number-table`. (Vprint_number_table): Improve docstring. * lisp/emacs-lisp/bytecomp.el: (byte-compile--list-with-n): New function. (byte-compile--docstring-style-warn): Rename from `byte-compile-docstring-style-warn` and change calling convention. (byte-compile--\#$, byte-compile--docstrings): New vars. (byte-compile-close-variables): Bind them. (byte-compile--docstring): New function. (byte-compile-from-buffer): Set `byte-compile--\#$`. (byte-compile-output-file-form): Use `byte-compile--\#$` instead of special casing specific forms. (byte-compile--output-docform-recurse, byte-compile-output-docform): Delete functions. (byte-compile-file-form-autoload, byte-compile-file-form-defalias) (byte-compile-file-form-defvar-function, byte-compile-lambda): Use `byte-compile--docstring` and `byte-compile--list-with-n`. (byte-compile--declare-var): Add optional `not-toplevel` arg. (byte-compile-defvar): Add `toplevel` arg. Use `byte-compile--docstring`. (byte-compile-file-form-defvar): Delegate to `byte-compile-defvar`. (byte-compile--custom-declare-face): New function. Use it for `custom-declare-face`. (byte-compile-file-form-defmumble): Use `byte-compile-output-file-form` * src/doc.c (Fdocumentation_stringp): New function. (syms_of_doc): Defsubr it. (store_function_docstring): Remove left-over code from when we used DOC for the docstring of some Lisp files. * lisp/cus-face.el (custom-declare-face): Accept dynamic docstrings. * lisp/faces.el (face-documentation): Handle dynamic docstrings. * lisp/help-fns.el (describe-face): Simplify accordingly. --- lisp/cus-face.el | 2 +- lisp/emacs-lisp/bytecomp.el | 466 +++++++++++++++++--------------------------- lisp/faces.el | 4 +- lisp/help-fns.el | 5 +- src/doc.c | 58 ++---- src/print.c | 19 +- 6 files changed, 218 insertions(+), 336 deletions(-) (limited to 'lisp') diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 0c8b6b0b97c..47afa841f5e 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -32,7 +32,7 @@ (defun custom-declare-face (face spec doc &rest args) "Like `defface', but with FACE evaluated as a normal argument." (when (and doc - (not (stringp doc))) + (not (documentation-stringp doc))) (error "Invalid (or missing) doc string %S" doc)) (unless (get face 'face-defface-spec) (face-spec-set face (purecopy spec) 'face-defface-spec) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index becc77f504a..6e66771658e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -345,7 +345,7 @@ A value of `all' really means all." '(docstrings-non-ascii-quotes) "List of warning types that are only enabled during Emacs builds. This is typically either warning types that are being phased in -(but shouldn't be enabled for packages yet), or that are only relevant +\(but shouldn't be enabled for packages yet), or that are only relevant for the Emacs build itself.") (defvar byte-compile--suppressed-warnings nil @@ -1740,68 +1740,82 @@ Also ignore URLs." The byte-compiler will emit a warning for documentation strings containing lines wider than this. If `fill-column' has a larger value, it will override this variable." - :group 'bytecomp :type 'natnum :safe #'natnump :version "28.1") -(define-obsolete-function-alias 'byte-compile-docstring-length-warn - 'byte-compile-docstring-style-warn "29.1") - -(defun byte-compile-docstring-style-warn (form) - "Warn if there are stylistic problems with the docstring in FORM. -Warn if documentation string of FORM is too wide. +(defun byte-compile--list-with-n (list n elem) + "Return LIST with its Nth element replaced by ELEM." + (if (eq elem (nth n list)) + list + (nconc (take n list) + (list elem) + (nthcdr (1+ n) list)))) + +(defun byte-compile--docstring-style-warn (docs kind name) + "Warn if there are stylistic problems in the docstring DOCS. +Warn if documentation string is too wide. It is too wide if it has any lines longer than the largest of `fill-column' and `byte-compile-docstring-max-column'." (when (byte-compile-warning-enabled-p 'docstrings) - (let* ((kind nil) (name nil) (docs nil) + (let* ((name (if (eq (car-safe name) 'quote) (cadr name) name)) (prefix (lambda () (format "%s%s" kind - (if name (format-message " `%s' " name) ""))))) - (pcase (car form) - ((or 'autoload 'custom-declare-variable 'defalias - 'defconst 'define-abbrev-table - 'defvar 'defvaralias - 'custom-declare-face) - (setq kind (nth 0 form)) - (setq name (nth 1 form)) - (when (and (consp name) (eq (car name) 'quote)) - (setq name (cadr name))) - (setq docs (nth 3 form))) - ('lambda - (setq kind "") ; can't be "function", unfortunately - (setq docs (nth 2 form)))) - (when (and kind docs (stringp docs)) - (let ((col (max byte-compile-docstring-max-column fill-column))) - (when (and (byte-compile-warning-enabled-p 'docstrings-wide) - (byte-compile--wide-docstring-p docs col)) - (byte-compile-warn-x - name - "%sdocstring wider than %s characters" (funcall prefix) col))) - ;; There's a "naked" ' character before a symbol/list, so it - ;; should probably be quoted with \=. - (when (string-match-p (rx (| (in " \t") bol) - (? (in "\"#")) - "'" - (in "A-Za-z" "(")) + (if name (format-message " `%S' " name) ""))))) + (let ((col (max byte-compile-docstring-max-column fill-column))) + (when (and (byte-compile-warning-enabled-p 'docstrings-wide) + (byte-compile--wide-docstring-p docs col)) + (byte-compile-warn-x + name + "%sdocstring wider than %s characters" (funcall prefix) col))) + ;; There's a "naked" ' character before a symbol/list, so it + ;; should probably be quoted with \=. + (when (string-match-p (rx (| (in " \t") bol) + (? (in "\"#")) + "'" + (in "A-Za-z" "(")) + docs) + (byte-compile-warn-x + name + (concat "%sdocstring has wrong usage of unescaped single quotes" + " (use \\=%c or different quoting such as %c...%c)") + (funcall prefix) ?' ?` ?')) + ;; There's a "Unicode quote" in the string -- it should probably + ;; be an ASCII one instead. + (when (byte-compile-warning-enabled-p 'docstrings-non-ascii-quotes) + (when (string-match-p (rx (| " \"" (in " \t") bol) + (in "‘’")) docs) (byte-compile-warn-x name - (concat "%sdocstring has wrong usage of unescaped single quotes" - " (use \\=%c or different quoting such as %c...%c)") - (funcall prefix) ?' ?` ?')) - ;; There's a "Unicode quote" in the string -- it should probably - ;; be an ASCII one instead. - (when (byte-compile-warning-enabled-p 'docstrings-non-ascii-quotes) - (when (string-match-p (rx (| " \"" (in " \t") bol) - (in "‘’")) - docs) - (byte-compile-warn-x - name - "%sdocstring uses curved single quotes; use %s instead of ‘...’" - (funcall prefix) "`...'")))))) - form) + "%sdocstring uses curved single quotes; use %s instead of ‘...’" + (funcall prefix) "`...'")))))) + +(defvar byte-compile--\#$) ; Special value that will print as `#$'. +(defvar byte-compile--docstrings nil "Table of already compiled docstrings.") + +(defun byte-compile--docstring (doc kind name &optional is-a-value) + (byte-compile--docstring-style-warn doc kind name) + ;; Make docstrings dynamic, when applicable. + (cond + ((and byte-compile-dynamic-docstrings + ;; The native compiler doesn't use those dynamic docstrings. + (not byte-native-compiling) + ;; Docstrings can only be dynamic when compiling a file. + byte-compile--\#$) + (let* ((byte-pos (with-memoization + ;; Reuse a previously written identical docstring. + ;; This is not done out of thriftiness but to try and + ;; make sure that "equal" functions remain `equal'. + ;; (Often those identical docstrings come from + ;; `help-add-fundoc-usage'). + ;; Needed e.g. for `advice-tests-nadvice'. + (gethash doc byte-compile--docstrings) + (byte-compile-output-as-comment doc nil))) + (newdoc (cons byte-compile--\#$ byte-pos))) + (if is-a-value newdoc (macroexp-quote newdoc)))) + (t doc))) ;; If we have compiled any calls to functions which are not known to be ;; defined, issue a warning enumerating them. @@ -1836,6 +1850,8 @@ It is too wide if it has any lines longer than the largest of ;; macroenvironment. (copy-alist byte-compile-initial-macro-environment)) (byte-compile--outbuffer nil) + (byte-compile--\#$ nil) + (byte-compile--docstrings (make-hash-table :test 'equal)) (overriding-plist-environment nil) (byte-compile-function-environment nil) (byte-compile-bound-variables nil) @@ -2363,7 +2379,12 @@ With argument ARG, insert value in current buffer after the form." (setq case-fold-search nil)) (displaying-byte-compile-warnings (with-current-buffer inbuffer - (when byte-compile-current-file + (when byte-compile-dest-file + (setq byte-compile--\#$ + (copy-sequence ;It needs to be a fresh new object. + ;; Also it stands for the `load-file-name' when the `.elc' will + ;; be loaded, so make it look like it. + byte-compile-dest-file)) (byte-compile-insert-header byte-compile-current-file byte-compile--outbuffer) ;; Instruct native-comp to ignore this file. @@ -2456,11 +2477,7 @@ Call from the source buffer." (defun byte-compile-output-file-form (form) ;; Write the given form to the output buffer, being careful of docstrings - ;; (for `byte-compile-dynamic-docstrings') in defvar, defvaralias, - ;; defconst, autoload, and custom-declare-variable. - ;; defalias calls are output directly by byte-compile-file-form-defmumble; - ;; it does not pay to first build the defalias in defmumble and then parse - ;; it here. + ;; (for `byte-compile-dynamic-docstrings'). (when byte-native-compiling ;; Spill output for the native compiler here (push (make-byte-to-native-top-level :form form :lexical lexical-binding) @@ -2470,123 +2487,17 @@ Call from the source buffer." (print-level nil) (print-quoted t) (print-gensym t) - (print-circle t)) ; Handle circular data structures. - (if (memq (car-safe form) '(defvar defvaralias defconst - autoload custom-declare-variable)) - (byte-compile-output-docform nil nil nil '("\n(" ")") form nil 3 - (memq (car form) - '(defvaralias autoload - custom-declare-variable))) - (princ "\n" byte-compile--outbuffer) - (prin1 form byte-compile--outbuffer) - nil))) + (print-circle t) + (print-continuous-numbering t) + (print-number-table (make-hash-table :test #'eq))) + (when byte-compile--\#$ + (puthash byte-compile--\#$ "#$" print-number-table)) + (princ "\n" byte-compile--outbuffer) + (prin1 form byte-compile--outbuffer) + nil)) (defvar byte-compile--for-effect) -(defun byte-compile--output-docform-recurse - (info position form cvecindex docindex quoted) - "Print a form with a doc string. INFO is (prefix postfix). -POSITION is where the next doc string is to be inserted. -CVECINDEX is the index in the FORM of the constant vector, or nil. -DOCINDEX is the index of the doc string (or nil) in the FORM. -QUOTED says that we have to put a quote before the -list that represents a doc string reference. -`defvaralias', `autoload' and `custom-declare-variable' need that. - -Return the position after any inserted docstrings as comments." - (let ((index 0) - doc-string-position) - ;; Insert the doc string, and make it a comment with #@LENGTH. - (when (and byte-compile-dynamic-docstrings - (stringp (nth docindex form))) - (goto-char position) - (setq doc-string-position - (byte-compile-output-as-comment - (nth docindex form) nil) - position (point)) - (goto-char (point-max))) - - (insert (car info)) - (prin1 (car form) byte-compile--outbuffer) - (while (setq form (cdr form)) - (setq index (1+ index)) - (insert " ") - (cond ((eq index cvecindex) - (let* ((cvec (car form)) - (len (length cvec)) - (index2 0) - elt) - (insert "[") - (while (< index2 len) - (setq elt (aref cvec index2)) - (if (byte-code-function-p elt) - (setq position - (byte-compile--output-docform-recurse - '("#[" "]") position - (append elt nil) ; Convert the vector to a list. - 2 4 nil)) - (prin1 elt byte-compile--outbuffer)) - (setq index2 (1+ index2)) - (unless (eq index2 len) - (insert " "))) - (insert "]"))) - ((= index docindex) - (cond - (doc-string-position - (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)") - doc-string-position) - byte-compile--outbuffer)) - ((stringp (car form)) - (let ((print-escape-newlines nil)) - (goto-char (prog1 (1+ (point)) - (prin1 (car form) - byte-compile--outbuffer))) - (insert "\\\n") - (goto-char (point-max)))) - (t (prin1 (car form) byte-compile--outbuffer)))) - (t (prin1 (car form) byte-compile--outbuffer)))) - (insert (cadr info)) - position)) - -(defun byte-compile-output-docform (preface tailpiece name info form - cvecindex docindex - quoted) - "Print a form with a doc string. INFO is (prefix postfix). -If PREFACE, NAME, and TAILPIECE are non-nil, print them too, -before/after INFO and the FORM but after the doc string itself. -CVECINDEX is the index in the FORM of the constant vector, or nil. -DOCINDEX is the index of the doc string (or nil) in the FORM. -QUOTED says that we have to put a quote before the -list that represents a doc string reference. -`defvaralias', `autoload' and `custom-declare-variable' need that." - ;; We need to examine byte-compile-dynamic-docstrings - ;; in the input buffer (now current), not in the output buffer. - (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) - (with-current-buffer byte-compile--outbuffer - (let ((byte-compile-dynamic-docstrings dynamic-docstrings) - (position (point)) - (print-continuous-numbering t) - print-number-table - ;; FIXME: The bindings below are only needed for when we're - ;; called from ...-defmumble. - (print-escape-newlines t) - (print-length nil) - (print-level nil) - (print-quoted t) - (print-gensym t) - (print-circle t)) ; Handle circular data structures. - (when preface - ;; FIXME: We don't handle uninterned names correctly. - ;; E.g. if cl-define-compiler-macro uses uninterned name we get: - ;; (defalias '#1=#:foo--cmacro #[514 ...]) - ;; (put 'foo 'compiler-macro '#:foo--cmacro) - (insert preface) - (prin1 name byte-compile--outbuffer)) - (byte-compile--output-docform-recurse - info position form cvecindex docindex quoted) - (when tailpiece - (insert tailpiece)))))) - (defun byte-compile-keep-pending (form &optional handler) (if (memq byte-optimize '(t source)) (setq form (byte-optimize-one-form form t))) @@ -2606,7 +2517,7 @@ list that represents a doc string reference. (if byte-compile-output (let ((form (byte-compile-out-toplevel t 'file))) (cond ((eq (car-safe form) 'progn) - (mapc 'byte-compile-output-file-form (cdr form))) + (mapc #'byte-compile-output-file-form (cdr form))) (form (byte-compile-output-file-form form))) (setq byte-compile-constants nil @@ -2681,12 +2592,12 @@ list that represents a doc string reference. (setq byte-compile-unresolved-functions (delq (assq funsym byte-compile-unresolved-functions) byte-compile-unresolved-functions))))) - (if (stringp (nth 3 form)) - (prog1 - form - (byte-compile-docstring-style-warn form)) - ;; No doc string, so we can compile this as a normal form. - (byte-compile-keep-pending form 'byte-compile-normal-call))) + (let* ((doc (nth 3 form)) + (newdoc (if (not (stringp doc)) doc + (byte-compile--docstring + doc 'autoload (nth 1 form))))) + (byte-compile-keep-pending (byte-compile--list-with-n form 3 newdoc) + #'byte-compile-normal-call))) (put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar) (put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar) @@ -2698,9 +2609,10 @@ list that represents a doc string reference. (byte-compile-warn-x sym "global/dynamic var `%s' lacks a prefix" sym))) -(defun byte-compile--declare-var (sym) +(defun byte-compile--declare-var (sym &optional not-toplevel) (byte-compile--check-prefixed-var sym) - (when (memq sym byte-compile-lexical-variables) + (when (and (not not-toplevel) + (memq sym byte-compile-lexical-variables)) (setq byte-compile-lexical-variables (delq sym byte-compile-lexical-variables)) (when (byte-compile-warning-enabled-p 'lexical sym) @@ -2709,19 +2621,7 @@ list that represents a doc string reference. (push sym byte-compile--seen-defvars)) (defun byte-compile-file-form-defvar (form) - (let ((sym (nth 1 form))) - (byte-compile--declare-var sym) - (if (eq (car form) 'defconst) - (push sym byte-compile-const-variables))) - (if (and (null (cddr form)) ;No `value' provided. - (eq (car form) 'defvar)) ;Just a declaration. - nil - (byte-compile-docstring-style-warn form) - (setq form (copy-sequence form)) - (when (consp (nth 2 form)) - (setcar (cdr (cdr form)) - (byte-compile-top-level (nth 2 form) nil 'file))) - form)) + (byte-compile-defvar form 'toplevel)) (put 'define-abbrev-table 'byte-hunk-handler 'byte-compile-file-form-defvar-function) @@ -2729,26 +2629,37 @@ list that represents a doc string reference. (defun byte-compile-file-form-defvar-function (form) (pcase-let (((or `',name (let name nil)) (nth 1 form))) - (if name (byte-compile--declare-var name))) - ;; Variable aliases are better declared before the corresponding variable, - ;; since it makes it more likely that only one of the two vars has a value - ;; before the `defvaralias' gets executed, which avoids the need to - ;; merge values. - (pcase form - (`(defvaralias ,_ ',newname . ,_) - (when (memq newname byte-compile-bound-variables) - (if (byte-compile-warning-enabled-p 'suspicious) - (byte-compile-warn-x - newname - "Alias for `%S' should be declared before its referent" newname))))) - (byte-compile-docstring-style-warn form) - (byte-compile-keep-pending form)) + (if name (byte-compile--declare-var name)) + ;; Variable aliases are better declared before the corresponding variable, + ;; since it makes it more likely that only one of the two vars has a value + ;; before the `defvaralias' gets executed, which avoids the need to + ;; merge values. + (pcase form + (`(defvaralias ,_ ',newname . ,_) + (when (memq newname byte-compile-bound-variables) + (if (byte-compile-warning-enabled-p 'suspicious) + (byte-compile-warn-x + newname + "Alias for `%S' should be declared before its referent" + newname))))) + (let ((doc (nth 3 form))) + (when (stringp doc) + (setcar (nthcdr 3 form) + (byte-compile--docstring doc (nth 0 form) name)))) + (byte-compile-keep-pending form))) (put 'custom-declare-variable 'byte-hunk-handler 'byte-compile-file-form-defvar-function) (put 'custom-declare-face 'byte-hunk-handler - 'byte-compile-docstring-style-warn) + #'byte-compile--custom-declare-face) +(defun byte-compile--custom-declare-face (form) + (let ((kind (nth 0 form)) (name (nth 1 form)) (docs (nth 3 form))) + (when (stringp docs) + (let ((newdocs (byte-compile--docstring docs kind name))) + (unless (eq docs newdocs) + (setq form (byte-compile--list-with-n form 3 newdocs))))) + form)) (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) (defun byte-compile-file-form-require (form) @@ -2902,33 +2813,24 @@ not to take responsibility for the actual compilation of the code." (cons (cons bare-name code) (symbol-value this-kind)))) - (if rest - ;; There are additional args to `defalias' (like maybe a docstring) - ;; that the code below can't handle: punt! - nil - ;; Otherwise, we have a bona-fide defun/defmacro definition, and use - ;; special code to allow dynamic docstrings and byte-code. - (byte-compile-flush-pending) + (byte-compile-flush-pending) + (let ((newform `(defalias ',bare-name + ,(if macro `'(macro . ,code) code) ,@rest))) (when byte-native-compiling - ;; Spill output for the native compiler here. + ;; Don't let `byte-compile-output-file-form' push the form to + ;; `byte-to-native-top-level-forms' because we want to use + ;; `make-byte-to-native-func-def' when possible. (push - (if macro + (if (or macro rest) (make-byte-to-native-top-level - :form `(defalias ',name '(macro . ,code) nil) + :form newform :lexical lexical-binding) (make-byte-to-native-func-def :name name :byte-func code)) byte-to-native-top-level-forms)) - ;; Output the form by hand, that's much simpler than having - ;; b-c-output-file-form analyze the defalias. - (byte-compile-output-docform - "\n(defalias '" ")" - bare-name - (if macro '(" '(macro . #[" "])") '(" #[" "]")) - (append code nil) ; Turn byte-code-function-p into list. - 2 4 - nil) - t))))) + (let ((byte-native-compiling nil)) + (byte-compile-output-file-form newform))) + t)))) (defun byte-compile-output-as-comment (exp quoted) "Print Lisp object EXP in the output file at point, inside a comment. @@ -3129,9 +3031,9 @@ lambda-expression." (setq fun (cons 'lambda fun)) (unless (eq 'lambda (car-safe fun)) (error "Not a lambda list: %S" fun))) - (byte-compile-docstring-style-warn fun) (byte-compile-check-lambda-list (nth 1 fun)) (let* ((arglist (nth 1 fun)) + (bare-arglist (byte-run-strip-symbol-positions arglist)) ; for compile-defun. (arglistvars (byte-run-strip-symbol-positions (byte-compile-arglist-vars arglist))) (byte-compile-bound-variables @@ -3140,16 +3042,22 @@ lambda-expression." (body (cdr (cdr fun))) (doc (if (stringp (car body)) (prog1 (car body) - ;; Discard the doc string + ;; Discard the doc string from the body ;; unless it is the last element of the body. (if (cdr body) (setq body (cdr body)))))) (int (assq 'interactive body)) command-modes) (when lexical-binding + (when arglist + ;; byte-compile-make-args-desc lost the args's names, + ;; so preserve them in the docstring. + (setq doc (help-add-fundoc-usage doc bare-arglist))) (dolist (var arglistvars) (when (assq var byte-compile--known-dynamic-vars) (byte-compile--warn-lexical-dynamic var 'lambda)))) + (when (stringp doc) + (setq doc (byte-compile--docstring doc "" nil 'is-a-value))) ;; Process the interactive spec. (when int ;; Skip (interactive) if it is in front (the most usual location). @@ -3193,8 +3101,7 @@ lambda-expression." (and lexical-binding (byte-compile-make-lambda-lexenv arglistvars)) - reserved-csts)) - (bare-arglist (byte-run-strip-symbol-positions arglist))) ; for compile-defun. + reserved-csts))) ;; Build the actual byte-coded function. (cl-assert (eq 'byte-code (car-safe compiled))) (let ((out @@ -3206,12 +3113,7 @@ lambda-expression." ;; byte-string, constants-vector, stack depth (cdr compiled) ;; optionally, the doc string. - (cond ((and lexical-binding arglist) - ;; byte-compile-make-args-desc lost the args's names, - ;; so preserve them in the docstring. - (list (help-add-fundoc-usage doc bare-arglist))) - ((or doc int) - (list doc))) + (when (or doc int) (list doc)) ;; optionally, the interactive spec (and the modes the ;; command applies to). (cond @@ -5091,49 +4993,49 @@ binding slots have been popped." (push (nth 1 (nth 1 form)) byte-compile-global-not-obsolete-vars)) (byte-compile-normal-call form)) -(defun byte-compile-defvar (form) - ;; This is not used for file-level defvar/consts. - (when (and (symbolp (nth 1 form)) - (not (string-match "[-*/:$]" (symbol-name (nth 1 form)))) - (byte-compile-warning-enabled-p 'lexical (nth 1 form))) - (byte-compile-warn-x - (nth 1 form) - "global/dynamic var `%s' lacks a prefix" - (nth 1 form))) - (byte-compile-docstring-style-warn form) - (let ((fun (nth 0 form)) - (var (nth 1 form)) - (value (nth 2 form)) - (string (nth 3 form))) - (when (or (> (length form) 4) - (and (eq fun 'defconst) (null (cddr form)))) - (let ((ncall (length (cdr form)))) - (byte-compile-warn-x - fun - "`%s' called with %d argument%s, but %s %s" - fun ncall - (if (= 1 ncall) "" "s") - (if (< ncall 2) "requires" "accepts only") - "2-3"))) - (push var byte-compile-bound-variables) +(defun byte-compile-defvar (form &optional toplevel) + (let* ((fun (nth 0 form)) + (var (nth 1 form)) + (value (nth 2 form)) + (string (nth 3 form))) + (byte-compile--declare-var var (not toplevel)) (if (eq fun 'defconst) (push var byte-compile-const-variables)) - (when (and string (not (stringp string))) + (cond + ((stringp string) + (setq string (byte-compile--docstring string fun var 'is-a-value))) + (string (byte-compile-warn-x string "third arg to `%s %s' is not a string: %s" - fun var string)) - ;; Delegate the actual work to the function version of the - ;; special form, named with a "-1" suffix. - (byte-compile-form-do-effect - (cond - ((eq fun 'defconst) `(defconst-1 ',var ,@(nthcdr 2 form))) - ((not (cddr form)) `',var) ; A simple (defvar foo) just returns foo. - (t `(defvar-1 ',var - ;; Don't eval `value' if `defvar' wouldn't eval it either. - ,(if (macroexp-const-p value) value - `(if (boundp ',var) nil ,value)) - ,@(nthcdr 3 form))))))) + fun var string))) + (if toplevel + ;; At top-level we emit calls to defvar/defconst. + (if (and (null (cddr form)) ;No `value' provided. + (eq (car form) 'defvar)) ;Just a declaration. + nil + (let ((tail (nthcdr 4 form))) + (when (or tail string) (push string tail)) + (when (cddr form) + (push (if (not (consp value)) value + (byte-compile-top-level value nil 'file)) + tail)) + `(,fun ,var ,@tail))) + ;; At non-top-level, since there is no byte code for + ;; defvar/defconst, we delegate the actual work to the function + ;; version of the special form, named with a "-1" suffix. + (byte-compile-form-do-effect + (cond + ((eq fun 'defconst) + `(defconst-1 ',var ,@(byte-compile--list-with-n + (nthcdr 2 form) 1 (macroexp-quote string)))) + ((not (cddr form)) `',var) ; A simple (defvar foo) just returns foo. + (t `(defvar-1 ',var + ;; Don't eval `value' if `defvar' wouldn't eval it either. + ,(if (macroexp-const-p value) value + `(if (boundp ',var) nil ,value)) + ,@(byte-compile--list-with-n + (nthcdr 3 form) 0 (macroexp-quote string))))))))) (defun byte-compile-autoload (form) (and (macroexp-const-p (nth 1 form)) @@ -5159,14 +5061,6 @@ binding slots have been popped." ;; For the compilation itself, we could largely get rid of this hunk-handler, ;; if it weren't for the fact that we need to figure out when a defalias ;; defines a macro, so as to add it to byte-compile-macro-environment. - ;; - ;; FIXME: we also use this hunk-handler to implement the function's - ;; dynamic docstring feature (via byte-compile-file-form-defmumble). - ;; We should probably actually implement it (more elegantly) in - ;; byte-compile-lambda so it applies to all lambdas. We did it here - ;; so the resulting .elc format was recognizable by make-docfile, - ;; but since then we stopped using DOC for the docstrings of - ;; preloaded elc files so that obstacle is gone. (let ((byte-compile-free-references nil) (byte-compile-free-assignments nil)) (pcase form @@ -5175,7 +5069,11 @@ binding slots have been popped." ;; - `arg' is the expression to which it is defined. ;; - `rest' is the rest of the arguments. (`(,_ ',name ,arg . ,rest) - (byte-compile-docstring-style-warn form) + (let ((doc (car rest))) + (when (stringp doc) + (setq rest (byte-compile--list-with-n + rest 0 + (byte-compile--docstring doc (nth 0 form) name))))) (pcase-let* ;; `macro' is non-nil if it defines a macro. ;; `fun' is the function part of `arg' (defaults to `arg'). diff --git a/lisp/faces.el b/lisp/faces.el index d5120f42b92..c3a54a08a3d 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -651,11 +651,11 @@ Optional argument INHERIT is passed to `face-attribute'." If FACE is a face-alias, get the documentation for the target face." (let ((alias (get face 'face-alias))) (if alias - (let ((doc (get alias 'face-documentation))) + (let ((doc (documentation-property alias 'face-documentation))) (format "%s is an alias for the face `%s'.%s" face alias (if doc (format "\n%s" doc) ""))) - (get face 'face-documentation)))) + (documentation-property face 'face-documentation)))) (defun set-face-documentation (face string) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 99642d08bbd..1ba848c107d 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1799,9 +1799,8 @@ If FRAME is omitted or nil, use the selected frame." alias) "")))) (insert "\nDocumentation:\n" - (substitute-command-keys - (or (face-documentation face) - "Not documented as a face.")) + (or (face-documentation face) + "Not documented as a face.") "\n\n")) (with-current-buffer standard-output (save-excursion diff --git a/src/doc.c b/src/doc.c index a451b468ef2..b5a9ed498af 100644 --- a/src/doc.c +++ b/src/doc.c @@ -357,6 +357,20 @@ reread_doc_file (Lisp_Object file) return 1; } +DEFUN ("documentation-stringp", Fdocumentation_stringp, Sdocumentation_stringp, + 1, 1, 0, + doc: /* Return non-nil if OBJECT is a well-formed docstring object. +OBJECT can be either a string or a reference if it's kept externally. */) + (Lisp_Object object) +{ + return (STRINGP (object) + || FIXNUMP (object) /* Reference to DOC. */ + || (CONSP (object) /* Reference to .elc. */ + && STRINGP (XCAR (object)) + && FIXNUMP (XCDR (object))) + ? Qt : Qnil); +} + DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0, doc: /* Return the documentation string of FUNCTION. Unless a non-nil second argument RAW is given, the @@ -502,46 +516,13 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset) /* If it's a lisp form, stick it in the form. */ if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) fun = XCDR (fun); - if (CONSP (fun)) - { - Lisp_Object tem = XCAR (fun); - if (EQ (tem, Qlambda) || EQ (tem, Qautoload) - || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1))) - { - tem = Fcdr (Fcdr (fun)); - if (CONSP (tem) && FIXNUMP (XCAR (tem))) - /* FIXME: This modifies typically pure hash-cons'd data, so its - correctness is quite delicate. */ - XSETCAR (tem, make_fixnum (offset)); - } - } /* Lisp_Subrs have a slot for it. */ - else if (SUBRP (fun) && !SUBR_NATIVE_COMPILEDP (fun)) - { - XSUBR (fun)->doc = offset; - } - - /* Bytecode objects sometimes have slots for it. */ - else if (COMPILEDP (fun)) + if (SUBRP (fun) && !SUBR_NATIVE_COMPILEDP (fun)) + XSUBR (fun)->doc = offset; + else { - /* This bytecode object must have a slot for the - docstring, since we've found a docstring for it. */ - if (PVSIZE (fun) > COMPILED_DOC_STRING - /* Don't overwrite a non-docstring value placed there, - * such as the symbols used for Oclosures. */ - && VALID_DOCSTRING_P (AREF (fun, COMPILED_DOC_STRING))) - ASET (fun, COMPILED_DOC_STRING, make_fixnum (offset)); - else - { - AUTO_STRING (format, - (PVSIZE (fun) > COMPILED_DOC_STRING - ? "Docstring slot busy for %s" - : "No docstring slot for %s")); - CALLN (Fmessage, format, - (SYMBOLP (obj) - ? SYMBOL_NAME (obj) - : build_string (""))); - } + AUTO_STRING (format, "Ignoring DOC string on non-subr: %S"); + CALLN (Fmessage, format, obj); } } @@ -776,6 +757,7 @@ compute the correct value for the current terminal in the nil case. */); doc: /* If nil, a nil `text-quoting-style' is treated as `grave'. */); /* Initialized by ‘main’. */ + defsubr (&Sdocumentation_stringp); defsubr (&Sdocumentation); defsubr (&Ssubr_documentation); defsubr (&Sdocumentation_property); diff --git a/src/print.c b/src/print.c index c6a3dba3163..c2beff0ed55 100644 --- a/src/print.c +++ b/src/print.c @@ -1412,7 +1412,7 @@ print_preprocess (Lisp_Object obj) && SYMBOLP (obj) && !SYMBOL_INTERNED_P (obj))) { /* OBJ appears more than once. Let's remember that. */ - if (!FIXNUMP (num)) + if (SYMBOLP (num)) /* In practice, nil or t. */ { print_number_index++; /* Negative number indicates it hasn't been printed yet. */ @@ -2265,6 +2265,11 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) goto next_obj; } } + else if (STRINGP (num)) + { + strout (SDATA (num), SCHARS (num), SBYTES (num), printcharfun); + goto next_obj; + } } print_depth++; @@ -2554,11 +2559,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) goto next_obj; case PVEC_SUB_CHAR_TABLE: { - /* Make each lowest sub_char_table start a new line. - Otherwise we'll make a line extremely long, which - results in slow redisplay. */ - if (XSUB_CHAR_TABLE (obj)->depth == 3) - printchar ('\n', printcharfun); print_c_string ("#^^[", printcharfun); int n = sprintf (buf, "%d %d", XSUB_CHAR_TABLE (obj)->depth, @@ -2664,7 +2664,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) /* With the print-circle feature. */ Lisp_Object num = Fgethash (next, Vprint_number_table, Qnil); - if (FIXNUMP (num)) + if (!(NILP (num) || EQ (num, Qt))) { print_c_string (" . ", printcharfun); obj = next; @@ -2928,7 +2928,10 @@ This variable should not be set with `setq'; bind it with a `let' instead. */); DEFVAR_LISP ("print-number-table", Vprint_number_table, doc: /* A vector used internally to produce `#N=' labels and `#N#' references. The Lisp printer uses this vector to detect Lisp objects referenced more -than once. +than once. If an entry contains a number, then the corresponding key is +referenced more than once: a positive sign indicates that it's already been +printed, and the absolute value indicates the number to use when printing. +If an entry contains a string, that string is printed instead. When you bind `print-continuous-numbering' to t, you should probably also bind `print-number-table' to nil. This ensures that the value of -- cgit v1.2.3 From 82e50a23fea8bc435bfae8390008702aa7d74bda Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 2 Feb 2024 18:59:21 -0500 Subject: cperl-mode.el: Don't use obsolete `special-display-popup-frame` * lisp/progmodes/cperl-mode.el (cperl-info-on-command): Simplify, to let `pop-to-buffer` decide whether to create a new frame or not, so it can be controlled by `display-buffer-alist`. --- lisp/progmodes/cperl-mode.el | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index bfc1742610c..758a6e17f72 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6612,14 +6612,13 @@ and \"Whitesmith\"." read)))) (let ((cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///" - pos isvar height iniheight frheight buf win fr1 fr2 iniwin not-loner + pos isvar height iniheight frheight buf win iniwin not-loner max-height char-height buf-list) (if (string-match "^-[a-zA-Z]$" command) (setq cmd-desc "^-X[ \t\n]")) (setq isvar (string-match "^[$@%]" command) buf (cperl-info-buffer isvar) - iniwin (selected-window) - fr1 (window-frame iniwin)) + iniwin (selected-window)) (set-buffer buf) (goto-char (point-min)) (or isvar @@ -6640,11 +6639,7 @@ and \"Whitesmith\"." (or (not win) (eq (window-buffer win) buf) (set-window-buffer win buf)) - (and win (setq fr2 (window-frame win))) - (if (or (not fr2) (eq fr1 fr2)) - (pop-to-buffer buf) - (special-display-popup-frame buf) ; Make it visible - (select-window win)) + (pop-to-buffer buf) (goto-char pos) ; Needed (?!). ;; Resize (setq iniheight (window-height) -- cgit v1.2.3 From bb894845ed6a06e8b301251d62f8b4a73a09d5ea Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 29 Jan 2024 19:04:58 -0800 Subject: Teach customize-option about erc-modules * lisp/erc/erc-goodies.el (erc-scrolltobottom-mode) (erc-scrolltobottom-enable): Use `setq' instead of `setopt' because the latter isn't defined in Emacs 27 and 28. This fix is unrelated to the main thrust of this commit. * lisp/erc/erc.el (erc-modules): Make good on decades old language in info node "(erc) Modules" by ensuring `customize-option' can find this option before its containing library is loaded. Like `gnus-select-method', this option serves as an entry point for configuring the application and is presented that way in tutorials and library front matter. Moreover, it can't be reasonably autoloaded in the traditional way because of its many dependencies and large textual footprint. (erc-display-message): Revise doc string. --- lisp/erc/erc-goodies.el | 2 +- lisp/erc/erc.el | 37 ++++++++++++++++++++----------------- 2 files changed, 21 insertions(+), 18 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 8293994c5d4..7e30b1060fd 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -83,7 +83,7 @@ be experimental. It currently only works with Emacs 28+." (when (and erc-scrolltobottom-all (< emacs-major-version 28)) (erc-button--display-error-notice-with-keys "Option `erc-scrolltobottom-all' requires Emacs 28+. Disabling.") - (setopt erc-scrolltobottom-all nil)) + (setq erc-scrolltobottom-all nil)) (unless erc--updating-modules-p (erc-buffer-do #'erc--scrolltobottom-setup)) (if erc-scrolltobottom-all (progn diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index edac1060c3e..67c31d961e3 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2183,13 +2183,17 @@ buffer rather than a server buffer.") (cl-pushnew mod (if (get mod 'erc--module) built-in third-party))) `(,@(sort built-in #'string-lessp) ,@(nreverse third-party)))) +;;;###autoload(custom-autoload 'erc-modules "erc") + (defcustom erc-modules '( autojoin button completion fill imenu irccontrols list match menu move-to-prompt netsplit networks readonly ring stamp track) - "A list of modules which ERC should enable. -If you set the value of this without using `customize' remember to call -\(erc-update-modules) after you change it. When using `customize', modules -removed from the list will be disabled." + "Modules to enable while connecting. +When modifying this option in lisp code, use a Custom-friendly +facilitator, like `setopt', or call `erc-update-modules' +afterward. This ensures a consistent ordering and disables +removed modules. It also gives packages access to the hook +`erc-before-connect'." :get (lambda (sym) ;; replace outdated names with their newer equivalents (erc-migrate-modules (symbol-value sym))) @@ -3828,14 +3832,14 @@ TYPE, when non-nil, to be a symbol handled by string MSG). Expect BUFFER to be among the sort accepted by the function `erc-display-line'. -Expect BUFFER to be a live `erc-mode' buffer, a list of such -buffers, or the symbols `all' or `active'. If `all', insert -STRING in all buffers for the current session. If `active', -defer to the function `erc-active-buffer', which may return the -session's server buffer if the previously active buffer has been -killed. If BUFFER is nil or a network process, pretend it's set -to the appropriate server buffer. Otherwise, use the current -buffer. +When non-nil, expect BUFFER to be a live `erc-mode' buffer, a +list of such buffers, or the symbols `all' or `active'. If +`all', insert STRING in all buffers for the current session. If +`active', defer to the function `erc-active-buffer', which may +return the session's server buffer if the previously active +buffer has been killed. If BUFFER is nil or a network process, +pretend it's set to the appropriate server buffer. Otherwise, +use the current buffer. When TYPE is a list of symbols, call handlers from left to right without influencing how they behave when encountering existing @@ -3848,11 +3852,10 @@ being (erc-error-face erc-notice-face) throughout MSG when `erc-notice-highlight-type' is left at its default, `all'. As of ERC 5.6, assume third-party code will use this function -instead of lower-level ones, like `erc-insert-line', when needing -ERC to process arbitrary informative messages as if they'd been -sent from a server. That is, guarantee \"local\" messages, for -which PARSED is typically nil, will be subject to buttonizing, -filling, and other effects." +instead of lower-level ones, like `erc-insert-line', to insert +arbitrary informative messages as if sent by the server. That +is, tell modules to treat a \"local\" message for which PARSED is +nil like any other server-sent message." (let* ((erc--msg-props (or erc--msg-props (let ((table (make-hash-table)) -- cgit v1.2.3 From b7cdce097003a645ae396470cfab221bf789189e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 30 Jan 2024 18:17:41 -0800 Subject: Fix local variable persistence in erc-stamp * etc/ERC-NEWS: Mention renaming of `erc-munge-invisible-property'. * lisp/erc/erc-stamp.el (erc-stamp-mode, erc-stamp-disable): Remove correct function from `erc-mode-hook'. (erc-stamp--recover-on-reconnect): Revise doc string. (erc-munge-invisibility-spec, erc-stamp--manage-local-options-state): Mark former name as obsolete and rename to latter. Don't use helper macro meant only for local modules. This bug originated from c68dc778 "Manage some text props for ERC insertion-hook members", which stemmed from bug#60936. (erc-stamp--setup, erc-hide-timestamps, erc-show-timestamps) (erc-toggle-timestamps): Use new name for `erc-munge-invisibility-spec'. * lisp/erc/erc.el (erc--restore-initialize-priors): Raise error at runtime if mode var doesn't belong to a local module. * test/lisp/erc/erc-stamp-tests.el (erc-stamp-tests--insert-right) (erc-timestamp-intangible--left): Use new name for `erc-munge-invisibility-spec'. * test/lisp/erc/erc-tests.el (erc--refresh-prompt): Shadow `erc-last-input-time'. (erc--restore-initialize-priors): Add error form to expected expansion, and skip test on Emacs 27. * test/lisp/erc/resources/erc-scenarios-common.el (erc-scenarios-common--make-bindings): Shadow `erc-last-input-time'. --- etc/ERC-NEWS | 9 ++++-- lisp/erc/erc-stamp.el | 39 ++++++++++++++++--------- lisp/erc/erc.el | 4 ++- test/lisp/erc/erc-stamp-tests.el | 4 +-- test/lisp/erc/erc-tests.el | 5 ++++ test/lisp/erc/resources/erc-scenarios-common.el | 1 + 6 files changed, 42 insertions(+), 20 deletions(-) (limited to 'lisp') diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index f91d3fcb351..1e88500d169 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -435,9 +435,12 @@ contains unique closures and thus no longer proves effective for traversing inserted messages. For now, ERC only provides an internal means of visiting messages, but a public interface is forthcoming. Also affecting the 'stamp' module is the deprecation of the function -'erc-insert-aligned' and its removal from client code. Additionally, -the module now merges its 'invisible' property with existing ones and -includes all white space around stamps when doing so. +'erc-insert-aligned' and its removal from the default client's code. +In the same library, the function 'erc-munge-invisibility-spec' has +been renamed to 'erc-stamp--manage-local-options-state' to better +reflect its purpose. Additionally, the module now merges its +'invisible' property with existing ones and includes all white space +around stamps when doing so. This "propertizing" of surrounding white space extends to all 'stamp'-applied properties, like 'field', in all intervening space diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 558afd19427..a11739a4195 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -184,7 +184,7 @@ from entering them and instead jump over them." (add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) (add-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear 40) (unless erc--updating-modules-p (erc-buffer-do #'erc-stamp--setup))) - ((remove-hook 'erc-mode-hook #'erc-munge-invisibility-spec) + ((remove-hook 'erc-mode-hook #'erc-stamp--setup) (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) (remove-hook 'erc-send-modify-hook #'erc-add-timestamp) (remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) @@ -198,6 +198,7 @@ from entering them and instead jump over them." "Escape hatch for omitting stamps when first char is invisible.") (defun erc-stamp--recover-on-reconnect () + "Attempt to restore \"last-inserted\" snapshots from prior session." (when-let ((priors (or erc--server-reconnecting erc--target-priors))) (dolist (var '(erc-timestamp-last-inserted erc-timestamp-last-inserted-left @@ -854,12 +855,20 @@ Return the empty string if FORMAT is nil." (defvar-local erc-stamp--csf-props-updated-p nil) -;; This function is used to munge `buffer-invisibility-spec' to an -;; appropriate value. Currently, it only handles timestamps, thus its -;; location. If you add other features which affect invisibility, -;; please modify this function and move it to a more appropriate -;; location. -(defun erc-munge-invisibility-spec () +(define-obsolete-function-alias 'erc-munge-invisibility-spec + #'erc-stamp--manage-local-options-state "30.1" + "Perform setup and teardown of `stamp'-owned options. + +Note that this function's role in practice has long defied its +stated mandate as claimed in a now deleted comment, which +envisioned it as evolving into a central toggle for modifying +`buffer-invisibility-spec' on behalf of options and features +ERC-wide.") +(defun erc-stamp--manage-local-options-state () + "Perform local setup and teardown for `stamp'-owned options. +For `erc-timestamp-intangible', toggle `cursor-intangible-mode'. +For `erc-echo-timestamps', integrate with `cursor-sensor-mode'. +For `erc-hide-timestamps, modify `buffer-invisibility-spec'." (if erc-timestamp-intangible (cursor-intangible-mode +1) ; idempotent (when (bound-and-true-p cursor-intangible-mode) @@ -869,10 +878,12 @@ Return the empty string if FORMAT is nil." (unless erc-stamp--permanent-cursor-sensor-functions (dolist (hook '(erc-insert-post-hook erc-send-post-hook)) (add-hook hook #'erc-stamp--add-csf-on-post-modify nil t)) - (erc--restore-initialize-priors erc-stamp-mode - erc-stamp--csf-props-updated-p nil) + (setq erc-stamp--csf-props-updated-p + (alist-get 'erc-stamp--csf-props-updated-p + (or erc--server-reconnecting erc--target-priors))) (unless erc-stamp--csf-props-updated-p (setq erc-stamp--csf-props-updated-p t) + ;; Spoof `erc--ts' as being non-nil. (let ((erc--msg-props (map-into '((erc--ts . t)) 'hash-table))) (with-silent-modifications (erc--traverse-inserted @@ -902,9 +913,9 @@ Return the empty string if FORMAT is nil." (defun erc-stamp--setup () "Enable or disable buffer-local `erc-stamp-mode' modifications." (if erc-stamp-mode - (erc-munge-invisibility-spec) + (erc-stamp--manage-local-options-state) (let (erc-echo-timestamps erc-hide-timestamps erc-timestamp-intangible) - (erc-munge-invisibility-spec)) + (erc-stamp--manage-local-options-state)) ;; Undo local mods from `erc-insert-timestamp-left-and-right'. (erc-stamp--date-mode -1) ; kills `erc-timestamp-last-inserted-left' (kill-local-variable 'erc-stamp--last-stamp) @@ -916,7 +927,7 @@ Return the empty string if FORMAT is nil." "Hide timestamp information from display." (interactive) (setq erc-hide-timestamps t) - (erc-munge-invisibility-spec)) + (erc-stamp--manage-local-options-state)) (defun erc-show-timestamps () "Show timestamp information on display. @@ -924,7 +935,7 @@ This function only works if `erc-timestamp-format' was previously set, and timestamping is already active." (interactive) (setq erc-hide-timestamps nil) - (erc-munge-invisibility-spec)) + (erc-stamp--manage-local-options-state)) (defun erc-toggle-timestamps () "Hide or show timestamps in ERC buffers. @@ -938,7 +949,7 @@ enabled when the message was inserted." (setq erc-hide-timestamps t)) (mapc (lambda (buffer) (with-current-buffer buffer - (erc-munge-invisibility-spec))) + (erc-stamp--manage-local-options-state))) (erc-buffer-list))) (defvar-local erc-stamp--last-stamp nil) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 67c31d961e3..ef047201251 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1531,7 +1531,7 @@ Bound to local variables from an existing (logical) session's buffer during local-module setup and `erc-mode-hook' activation.") (defmacro erc--restore-initialize-priors (mode &rest vars) - "Restore local VARS for MODE from a previous session." + "Restore local VARS for local minor MODE from a previous session." (declare (indent 1)) (let ((priors (make-symbol "priors")) (initp (make-symbol "initp")) @@ -1541,6 +1541,8 @@ buffer during local-module setup and `erc-mode-hook' activation.") (push `(,k (if ,initp (alist-get ',k ,priors) ,(pop vars))) forms)) `(let* ((,priors (or erc--server-reconnecting erc--target-priors)) (,initp (and ,priors (alist-get ',mode ,priors)))) + (unless (local-variable-if-set-p ',mode) + (error "Not a local minor mode var: %s" ',mode)) (setq ,@(mapcan #'identity (nreverse forms)))))) (defun erc--target-from-string (string) diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index ef292ccb618..70ca224ac74 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -46,7 +46,7 @@ (with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*") (erc-mode) - (erc-munge-invisibility-spec) + (erc-stamp--manage-local-options-state) (erc--initialize-markers (point) nil) (erc-tests-common-init-server-proc "sleep" "1") @@ -235,7 +235,7 @@ (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*") (erc-mode) (erc--initialize-markers (point) nil) - (erc-munge-invisibility-spec) + (erc-stamp--manage-local-options-state) (erc-display-message nil 'notice (current-buffer) "Welcome") ;; ;; Pretend `fill' is active and that these lines are diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b51bd67ae04..7890049a325 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -302,6 +302,7 @@ (cl-incf counter)))) erc-accidental-paste-threshold-seconds erc-insert-modify-hook + (erc-last-input-time 0) (erc-modules (remq 'stamp erc-modules)) (erc-send-input-line-function #'ignore) (erc--input-review-functions erc--input-review-functions) @@ -1189,12 +1190,16 @@ (should (erc--valid-local-channel-p "&local"))))) (ert-deftest erc--restore-initialize-priors () + (unless (>= emacs-major-version 28) + (ert-skip "Lisp nesting exceeds `max-lisp-eval-depth'")) (should (pcase (macroexpand-1 '(erc--restore-initialize-priors erc-my-mode foo (ignore 1 2 3) bar #'spam baz nil)) (`(let* ((,p (or erc--server-reconnecting erc--target-priors)) (,q (and ,p (alist-get 'erc-my-mode ,p)))) + (unless (local-variable-if-set-p 'erc-my-mode) + (error "Not a local minor mode var: %s" 'erc-my-mode)) (setq foo (if ,q (alist-get 'foo ,p) (ignore 1 2 3)) bar (if ,q (alist-get 'bar ,p) #'spam) baz (if ,q (alist-get 'baz ,p) nil))) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 0ec48d766ef..042b3a8c05b 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -151,6 +151,7 @@ (erc-autojoin-channels-alist nil) (erc-server-auto-reconnect nil) (erc-after-connect nil) + (erc-last-input-time 0) (erc-d-linger-secs 10) ,@bindings))) -- cgit v1.2.3 From aa6315ee685185dd1b9b63ee94636e662d68106b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 31 Jan 2024 06:01:54 -0800 Subject: Reassociate erc-networks--id for orphaned queries * lisp/erc/erc-networks.el (erc-networks--examine-targets): Adopt the server's network ID in query buffers created before MOTD's end. Do this to avoid a type error in the process filter when renaming buffers. * lisp/erc/erc-networks.el (erc-networks--examine-targets): New test. * test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el (erc-scenarios-upstream-recon--znc/severed): New test. * test/lisp/erc/erc-scenarios-misc.el (erc-scenarios-base-mask-target-routing): Adjust timeout. * test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld: New file. * test/lisp/erc/resources/erc-tests-common.el (erc-tests-common-make-server-buf): Use NAME parameter for creating ID. --- lisp/erc/erc-networks.el | 25 ++++++- test/lisp/erc/erc-networks-tests.el | 46 ++++++++++++ .../erc/erc-scenarios-base-upstream-recon-znc.el | 46 ++++++++++++ test/lisp/erc/erc-scenarios-misc.el | 2 +- .../base/upstream-reconnect/znc-severed.eld | 87 ++++++++++++++++++++++ test/lisp/erc/resources/erc-tests-common.el | 2 +- 6 files changed, 202 insertions(+), 6 deletions(-) create mode 100644 test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld (limited to 'lisp') diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 99c3c0563d0..1b26afa1164 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -1123,10 +1123,27 @@ TARGET to be an `erc--target' object." (lambda () (when (and erc--target (eq (erc--target-symbol erc--target) (erc--target-symbol target))) - (let ((oursp (if (erc--target-channel-local-p target) - (equal announced erc-server-announced-name) - (erc-networks--id-equal-p identity erc-networks--id)))) - (funcall (if oursp on-dupe on-collision)))))))) + ;; When a server sends administrative queries immediately + ;; after connection registration and before the session has a + ;; net-id, the buffer remains orphaned until reassociated + ;; here retroactively. + (unless erc-networks--id + (let ((id (erc-with-server-buffer erc-networks--id)) + (server-buffer (process-buffer erc-server-process))) + (apply #'erc-button--display-error-notice-with-keys + server-buffer + (concat "Missing network session (ID) for %S. " + (if id "Using `%S' from %S." "Ignoring.")) + (current-buffer) + (and id (list (erc-networks--id-symbol + (setq erc-networks--id id)) + server-buffer))))) + (when erc-networks--id + (let ((oursp (if (erc--target-channel-local-p target) + (equal announced erc-server-announced-name) + (erc-networks--id-equal-p identity + erc-networks--id)))) + (funcall (if oursp on-dupe on-collision))))))))) (defconst erc-networks--qualified-sep "@" "Separator used for naming a target buffer.") diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index d8d8c6fa9cd..53cff8f489c 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el @@ -1761,4 +1761,50 @@ (should (equal (erc-ports-list (nth 4 srv)) '(6697 9999)))))) +(ert-deftest erc-networks--examine-targets () + (with-current-buffer (erc-tests-common-make-server-buf "foonet") + (erc--open-target "#chan") + (erc--open-target "#spam")) + + (with-current-buffer (erc-tests-common-make-server-buf "barnet") + (with-current-buffer (erc--open-target "*query") + (setq erc-networks--id nil)) + (with-current-buffer (erc--open-target "#chan") + (let ((calls ()) + (snap (lambda (parameter) + (list parameter + (erc-target) + (erc-networks--id-symbol erc-networks--id))))) + + ;; Search for "#chan" dupes among targets of all servers. + (should (equal + (erc-networks--examine-targets erc-networks--id erc--target + (lambda () (push (funcall snap 'ON-DUPE) calls)) + (lambda () (push (funcall snap 'ON-COLL) calls))) + (list (get-buffer "#chan@foonet") + (get-buffer "#chan@barnet")))) + + (should (equal (pop calls) '(ON-DUPE "#chan" barnet))) + (should (equal (pop calls) '(ON-COLL "#chan" foonet))) + (should-not calls) + (should-not (get-buffer "#chan")) + (should (get-buffer "#chan@barnet")) + (should (get-buffer "#chan@foonet")) + + ;; Search for "*query" dupes among targets of all servers. + (should (equal (erc-networks--examine-targets erc-networks--id + (buffer-local-value 'erc--target + (get-buffer "*query")) + (lambda () (push (funcall snap 'ON-DUPE) calls)) + (lambda () (push (funcall snap 'ON-COLL) calls))) + (list (get-buffer "*query")))) + + (should (equal (pop calls) '(ON-DUPE "*query" barnet))) + (should-not calls))) + + (goto-char (point-min)) + (should (search-forward "Missing network session" nil t))) + + (erc-tests-common-kill-buffers)) + ;;; erc-networks-tests.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el b/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el index bbd9c79f593..f3905974a11 100644 --- a/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el +++ b/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el @@ -42,4 +42,50 @@ 'znc-foonet 'znc-barnet)) +;; Here, the upstream connection is already severed when first +;; connecting. The bouncer therefore sends query messages from an +;; administrative bot before the first numerics burst, which results +;; in a target buffer not being associated with an `erc-networks--id'. +;; The problem only manifests later, when the buffer-association +;; machinery checks the names of all target buffers and assumes a +;; non-nil `erc-networks--id'. +(ert-deftest erc-scenarios-upstream-recon--znc/severed () + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/upstream-reconnect") + (erc-d-t-cleanup-sleep-secs 1) + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'znc-severed)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester@vanilla/foonet" + :password "changeme" + :full-name "tester") + (erc-scenarios-common-assert-initial-buf-name nil port) + (erc-d-t-wait-for 6 (eq (erc-network) 'foonet)))) + + (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "*status")) + (funcall expect 10 "Connection Refused. Reconnecting...") + (funcall expect 10 "Connected!")) + + (ert-info ("Join #chan") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 " tester, welcome!") + (funcall expect 10 " alice: And see a fearful sight") + (funcall expect 10 " hola") + (funcall expect 10 " hell o") + ;; + (funcall expect 10 " bob: Or to drown my clothes"))) + + (ert-info ("Buffer not renamed with net id") + (should (get-buffer "*status"))) + + (ert-info ("No error") + (with-current-buffer (messages-buffer) + (funcall expect -0.1 "error in process filter"))))) + ;;; erc-scenarios-base-upstream-recon-znc.el ends here diff --git a/test/lisp/erc/erc-scenarios-misc.el b/test/lisp/erc/erc-scenarios-misc.el index 8f6042de5c2..2afa1ce67a4 100644 --- a/test/lisp/erc/erc-scenarios-misc.el +++ b/test/lisp/erc/erc-scenarios-misc.el @@ -126,7 +126,7 @@ (erc-d-t-wait-for 10 (get-buffer "foonet")) (ert-info ("Channel buffer #foo playback received") - (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#foo")) + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#foo")) (funcall expect 10 "Excellent workman"))) (ert-info ("Global notices routed to server buffer") diff --git a/test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld b/test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld new file mode 100644 index 00000000000..32d05cc8a3a --- /dev/null +++ b/test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld @@ -0,0 +1,87 @@ +;; -*- mode: lisp-data; -*- +((pass 10 "PASS :changeme")) +((nick 10 "NICK tester")) +((user 10 "USER tester@vanilla/foonet 0 * :tester") + (0.00 ":irc.znc.in 001 tester :Welcome to ZNC") + (0.03 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") + (0.01 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") + (0.00 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") + (0.01 ":*status!znc@znc.in PRIVMSG tester :Connected!") + (0.02 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Wed, 31 Jan 2024 10:58:16 UTC") + (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0.00 ":irc.foonet.org 422 tester :MOTD File is missing") + (0.00 ":irc.foonet.org 221 tester +Zi") + (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((mode 10 "MODE tester +i") + (0.01 ":irc.foonet.org 352 tester * ~u pfa3tpa5ig5ty.irc irc.foonet.org tester H :0 ZNC - https://znc.in") + (0.01 ":irc.foonet.org 315 tester tester :End of WHO list") + + (0.02 ":tester!~u@pfa3tpa5ig5ty.irc JOIN #chan") + (0.03 ":irc.foonet.org 353 tester = #chan :bob tester @alice eve")) + +((mode 10 "MODE #chan") + (0.00 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.00 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") + (0.01 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") + (0.01 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: And see how he will take it at your hands.") + (0.02 ":irc.foonet.org 221 tester +Zi") + (0.01 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Fear not, my lord, your servant shall do so.") + (0.02 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: If I thrive well, I'll visit thee again.") + (0.01 ":irc.foonet.org 324 tester #chan +Cnt") + (0.03 ":irc.foonet.org 329 tester #chan 1706698713") + (0.05 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Let it be forbid, sir; so should I be a great deal of his act.") + (0.04 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: And see a fearful sight of blood and death.") + (0.00 ":eve!~u@euegh6mj3y8r2.irc PRIVMSG #chan :hola") + (0.01 ":eve!~u@euegh6mj3y8r2.irc NICK :Evel") + (0.01 ":Evel!~u@euegh6mj3y8r2.irc PRIVMSG #chan :hell o") + (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: His highness comes post from Marseilles, of as able body as when he numbered thirty: he will be here to-morrow, or I am deceived by him that in such intelligence hath seldom failed.") + (0.03 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: See, by good hap, yonder's my lord; I have sweat to see his honour.") + (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: With the rich worth of your virginity.") + + (0.02 ":*status!znc@znc.in PRIVMSG tester :Disconnected from IRC. Reconnecting...") + (0.05 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") + (0.03 ":*status!znc@znc.in PRIVMSG tester :Connected!") + (0.01 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.04 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Wed, 31 Jan 2024 10:58:16 UTC") + (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.03 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0.00 ":irc.foonet.org 422 tester :MOTD File is missing") + (0.02 ":irc.foonet.org 221 tester +i") + (0.01 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.") + (0.02 ":irc.foonet.org 352 tester * ~u hrn2ea3rpeyck.irc irc.foonet.org tester H :0 ZNC - https://znc.in") + (0.01 ":irc.foonet.org 315 tester tester :End of WHO list") + (0.02 ":tester!~u@hrn2ea3rpeyck.irc JOIN #chan")) + +((mode 10 "MODE #chan") + (0.00 ":irc.foonet.org 353 tester = #chan :tester @alice bob") + (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.00 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") + (0.01 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") + (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Nay, I assure you, a peace concluded.") + (0.03 ":irc.foonet.org 324 tester #chan +Cnt") + (0.01 ":irc.foonet.org 329 tester #chan 1706698713") + (0.05 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: But, in defence, by mercy, 'tis most just.") + (0.04 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Or to drown my clothes, and say I was stripped.")) diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index 05dbe1d50d6..99f15b89b03 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -122,7 +122,7 @@ Use NAME for the network and the session server as well." erc--isupport-params (make-hash-table) erc-session-port 6667 erc-network (intern name) - erc-networks--id (erc-networks--id-create nil)) + erc-networks--id (erc-networks--id-create name)) (current-buffer))) (defun erc-tests-common-string-to-propertized-parts (string) -- cgit v1.2.3 From d49124fc14b0bb37617b34b5839f873cea3817c8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Feb 2024 11:09:36 +0200 Subject: Avoid signaling errors from 'pixel-fill-region' * lisp/textmodes/pixel-fill.el (pixel-fill-region): Make sure the selected window displays the current buffer. This is important when this function is called inside 'with-current-buffer' or similar forms which temporarily change the buffer displayed in the selected window. (Bug#67791) --- lisp/textmodes/pixel-fill.el | 68 +++++++++++++++++++++++--------------------- 1 file changed, 35 insertions(+), 33 deletions(-) (limited to 'lisp') diff --git a/lisp/textmodes/pixel-fill.el b/lisp/textmodes/pixel-fill.el index 25c0b46cee9..d26eaec2111 100644 --- a/lisp/textmodes/pixel-fill.el +++ b/lisp/textmodes/pixel-fill.el @@ -73,39 +73,41 @@ lines that are visually wider than PIXEL-WIDTH. If START isn't at the start of a line, the horizontal position of START, converted to pixel units, will be used as the indentation prefix on subsequent lines." - (save-excursion - (goto-char start) - (let ((indentation - (car (window-text-pixel-size nil (line-beginning-position) - (point)))) - (newline-end nil)) - (when (> indentation pixel-width) - (error "The indentation (%s) is wider than the fill width (%s)" - indentation pixel-width)) - (save-restriction - (narrow-to-region start end) - (goto-char (point-max)) - (when (looking-back "\n[ \t]*" (point-min)) - (setq newline-end t)) - (goto-char (point-min)) - ;; First replace all whitespace with space. - (while (re-search-forward "[ \t\n]+" nil t) - (cond - ((or (= (match-beginning 0) start) - (= (match-end 0) end)) - (delete-region (match-beginning 0) (match-end 0))) - ;; If there's just a single space here, don't replace. - ((not (and (= (- (match-end 0) (match-beginning 0)) 1) - (= (char-after (match-beginning 0)) ?\s))) - (replace-match - ;; We need to use a space that has an appropriate width. - (propertize " " 'face - (get-text-property (match-beginning 0) 'face)))))) - (goto-char start) - (pixel-fill--fill-line pixel-width indentation) - (goto-char (point-max)) - (when newline-end - (insert "\n")))))) + (save-window-excursion + (set-window-buffer nil (current-buffer)) + (save-excursion + (goto-char start) + (let ((indentation + (car (window-text-pixel-size nil (line-beginning-position) + (point)))) + (newline-end nil)) + (when (> indentation pixel-width) + (error "The indentation (%s) is wider than the fill width (%s)" + indentation pixel-width)) + (save-restriction + (narrow-to-region start end) + (goto-char (point-max)) + (when (looking-back "\n[ \t]*" (point-min)) + (setq newline-end t)) + (goto-char (point-min)) + ;; First replace all whitespace with space. + (while (re-search-forward "[ \t\n]+" nil t) + (cond + ((or (= (match-beginning 0) start) + (= (match-end 0) end)) + (delete-region (match-beginning 0) (match-end 0))) + ;; If there's just a single space here, don't replace. + ((not (and (= (- (match-end 0) (match-beginning 0)) 1) + (= (char-after (match-beginning 0)) ?\s))) + (replace-match + ;; We need to use a space that has an appropriate width. + (propertize " " 'face + (get-text-property (match-beginning 0) 'face)))))) + (goto-char start) + (pixel-fill--fill-line pixel-width indentation) + (goto-char (point-max)) + (when newline-end + (insert "\n"))))))) (defun pixel-fill--goto-pixel (width) (vertical-motion (cons (/ width (frame-char-width)) 0))) -- cgit v1.2.3 From 2f69353e4a756cf53459c14c5618bd262331b568 Mon Sep 17 00:00:00 2001 From: Vincenzo Pupillo Date: Thu, 1 Feb 2024 16:57:39 +0100 Subject: Fix incompatibility with tree-sitter-javascript >= 0.20.2 Starting from version 0.20.2 the grammar's primary expression "function" has been renamed to "function_expression". A new function checks if the new primary expression is available, and if so, it returns the correct rules. * lisp/progmodes/js.el (js--treesit-font-lock-compatibility-definition-feature): New function. (js--treesit-font-lock-settings): Use it. (Bug#68879) --- lisp/progmodes/js.el | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index e4ccfd73cc7..12c4d0aedb8 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3427,6 +3427,26 @@ This function is intended for use in `after-change-functions'." ;;; Tree sitter integration +(defun js--treesit-font-lock-compatibility-definition-feature () + "Font lock helper, to handle different releases of tree-sitter-javascript. +Check if a node type is available, then return the right font lock rules +for \"definition\" feature." + (condition-case nil + (progn (treesit-query-capture 'javascript '((function_expression) @cap)) + ;; starting from 0.20.2 + '((function_expression + name: (identifier) @font-lock-function-name-face) + (variable_declarator + name: (identifier) @font-lock-function-name-face + value: [(function_expression) (arrow_function)]))) + (error + ;; older version + '((function + name: (identifier) @font-lock-function-name-face) + (variable_declarator + name: (identifier) @font-lock-function-name-face + value: [(function) (arrow_function)]))))) + (defun js-jsx--treesit-indent-compatibility-bb1f97b () "Indent rules helper, to handle different releases of tree-sitter-javascript. Check if a node type is available, then return the right indent rules." @@ -3538,8 +3558,7 @@ Check if a node type is available, then return the right indent rules." :language 'javascript :feature 'definition - '((function - name: (identifier) @font-lock-function-name-face) + `(,@(js--treesit-font-lock-compatibility-definition-feature) (class_declaration name: (identifier) @font-lock-type-face) @@ -3558,10 +3577,6 @@ Check if a node type is available, then return the right indent rules." (variable_declarator name: (identifier) @font-lock-variable-name-face) - (variable_declarator - name: (identifier) @font-lock-function-name-face - value: [(function) (arrow_function)]) - (variable_declarator name: [(array_pattern (identifier) @font-lock-variable-name-face) (object_pattern -- cgit v1.2.3 From b91f0ee2fcc52b6ef2d747c5fc7f37573adc7ca5 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Feb 2024 11:20:11 +0200 Subject: ; Fix last change * lisp/progmodes/js.el (js--treesit-font-lock-compatibility-definition-feature): Fix comments. --- lisp/progmodes/js.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 12c4d0aedb8..20350c0ccb6 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3433,14 +3433,14 @@ Check if a node type is available, then return the right font lock rules for \"definition\" feature." (condition-case nil (progn (treesit-query-capture 'javascript '((function_expression) @cap)) - ;; starting from 0.20.2 + ;; Starting from version 0.20.2 of the grammar. '((function_expression name: (identifier) @font-lock-function-name-face) (variable_declarator name: (identifier) @font-lock-function-name-face value: [(function_expression) (arrow_function)]))) (error - ;; older version + ;; An older version of the grammar. '((function name: (identifier) @font-lock-function-name-face) (variable_declarator -- cgit v1.2.3 From 37efb63a3df969fb2eeed70dfe7fcf6c187e05be Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Feb 2024 11:52:30 +0200 Subject: ; * lisp/eshell/em-unix.el (eshell/cp, eshell/ln): Delete extra space. Bug#68862. --- lisp/eshell/em-unix.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index a88c7e09946..78dfd0654e2 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -590,7 +590,7 @@ Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY. :external "cp" :show-usage :usage "[OPTION]... SOURCE DEST - or: cp [OPTION]... SOURCE... DIRECTORY + or: cp [OPTION]... SOURCE... DIRECTORY Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.") (if archive (setq preserve t no-dereference t em-recursive t)) @@ -619,7 +619,7 @@ Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.") :external "ln" :show-usage :usage "[OPTION]... TARGET [LINK_NAME] - or: ln [OPTION]... TARGET... DIRECTORY + or: ln [OPTION]... TARGET... DIRECTORY Create a link to the specified TARGET with optional LINK_NAME. If there is more than one TARGET, the last argument must be a directory; create links in DIRECTORY to each TARGET. Create hard links by default, symbolic links -- cgit v1.2.3 From 492e16f2ff33e7ff65ff965e9cd2ba658c9f9a45 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Feb 2024 13:00:15 +0200 Subject: Fix downcasing of mode-name in compile.el * lisp/progmodes/compile.el (compilation--downcase-mode-name): New function. (compilation-start, kill-compilation): Use it instead of calling 'downcase' on 'mode-name'. (Bug#68795) --- lisp/progmodes/compile.el | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 51c81b9d2f6..11d400e145a 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1890,6 +1890,12 @@ process from additional information inserted by Emacs." (defvar-local compilation--start-time nil "The time when the compilation started as returned by `float-time'.") +(defun compilation--downcase-mode-name (mode) + "Downcase the name of major MODE, even if MODE is not a string. +The function `downcase' will barf if passed the name of a `major-mode' +which is not a string, but instead a symbol or a list." + (downcase (format-mode-line mode))) + ;;;###autoload (defun compilation-start (command &optional mode name-function highlight-regexp continue) @@ -2081,11 +2087,12 @@ Returns the compilation buffer created." (get-buffer-process (with-no-warnings (comint-exec - outbuf (downcase mode-name) + outbuf (compilation--downcase-mode-name mode-name) shell-file-name nil `(,shell-command-switch ,command))))) - (start-file-process-shell-command (downcase mode-name) - outbuf command)))) + (start-file-process-shell-command + (compilation--downcase-mode-name mode-name) + outbuf command)))) ;; Make the buffer's mode line show process state. (setq mode-line-process '((:propertize ":%s" face compilation-mode-line-run) @@ -2790,7 +2797,8 @@ Prefix arg N says how many files to move backwards (or forwards, if negative)." (let ((buffer (compilation-find-buffer))) (if (get-buffer-process buffer) (interrupt-process (get-buffer-process buffer)) - (error "The %s process is not running" (downcase mode-name))))) + (error "The %s process is not running" + (compilation--downcase-mode-name mode-name))))) (defalias 'compile-mouse-goto-error 'compile-goto-error) -- cgit v1.2.3 From 5e4a0a29fa3562ce9b2b8e497c6e71e6bc169082 Mon Sep 17 00:00:00 2001 From: João Távora Date: Thu, 30 Nov 2023 06:00:44 -0600 Subject: Make sure read-symbol-shorthands is permanently local bug#63480, bug#67390 * lisp/files.el (permanently-enabled-local-variables): Add read-symbol-shorthands. --- lisp/files.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/files.el b/lisp/files.el index 9c8914bfc50..fd9088206d7 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3754,7 +3754,8 @@ function is allowed to change the contents of this alist. This hook is called only if there is at least one file-local variable to set.") -(defvar permanently-enabled-local-variables '(lexical-binding) +(defvar permanently-enabled-local-variables + '(lexical-binding read-symbol-shorthands) "A list of file-local variables that are always enabled. This overrides any `enable-local-variables' setting.") -- cgit v1.2.3 From c2aaa8f15aa8fb3415a6c9f421f539ee34b7f52c Mon Sep 17 00:00:00 2001 From: João Távora Date: Thu, 30 Nov 2023 06:00:38 -0600 Subject: Process read-symbol-shorthands from longest to shortest (bug#67390) This ensures that overlapping shorthands are handled correctly and consistently even if specified out-of-order by the user. * doc/lispref/symbols.texi (Shorthands): Describe shorthand sort order. * lisp/files.el (hack-local-variables--find-variables): Specially handle read-symbol-shorthands. --- doc/lispref/symbols.texi | 17 +++++++++++++++++ lisp/files.el | 7 +++++++ 2 files changed, 24 insertions(+) (limited to 'lisp') diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 367bd195f16..e95e53d972d 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -761,6 +761,23 @@ instead of @code{snu-}. ;; End: @end example +Note that if you have two shorthands in the same file where one is the +prefix of the other, the longer shorthand will be attempted first. +This happens regardless of the order you specify shorthands in the +local variables section of your file. + +@example +'( + t//foo ; reads to 'my-tricks--foo', not 'my-tricks-/foo' + t/foo ; reads to 'my-tricks-foo' + ) + +;; Local Variables: +;; read-symbol-shorthands: (("t/" . "my-tricks-") +;; ("t//" . "my-tricks--") +;; End: +@end example + @subsection Exceptions There are two exceptions to rules governing Shorthand transformations: diff --git a/lisp/files.el b/lisp/files.el index fd9088206d7..172237ceb82 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4191,6 +4191,13 @@ major-mode." ;; to use 'thisbuf's name in the ;; warning message. (or (buffer-file-name thisbuf) "")))))) + ((eq var 'read-symbol-shorthands) + ;; Sort automatically by shorthand length + ;; descending + (setq val (sort val + (lambda (sh1 sh2) (> (length (car sh1)) + (length (car sh2)))))) + (push (cons 'read-symbol-shorthands val) result)) ((and (eq var 'mode) handle-mode)) (t (ignore-errors -- cgit v1.2.3 From 17c3610c56155dd5b1efd5b7e8d6a58112f43a59 Mon Sep 17 00:00:00 2001 From: João Távora Date: Wed, 29 Nov 2023 06:21:29 -0600 Subject: Consider read-symbol-shorthands in check-declare.el (bug#67523) * lisp/emacs-lisp/check-declare.el (check-declare-verify): Consider read-symbol-shorthands. --- lisp/emacs-lisp/check-declare.el | 101 ++++++++++++++++++++------------------- 1 file changed, 53 insertions(+), 48 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el index 8e40b227b65..b4a7b4b33e6 100644 --- a/lisp/emacs-lisp/check-declare.el +++ b/lisp/emacs-lisp/check-declare.el @@ -145,64 +145,69 @@ is a string giving details of the error." (if (file-regular-p fnfile) (with-temp-buffer (insert-file-contents fnfile) + (unless cflag + ;; If in Elisp, ensure syntax and shorthands available + (set-syntax-table emacs-lisp-mode-syntax-table) + (let (enable-local-variables) (hack-local-variables))) ;; defsubst's don't _have_ to be known at compile time. - (setq re (format (if cflag - "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\"" - "^[ \t]*(\\(fset[ \t]+'\\|\ + (setq re (if cflag + (format "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\"" + (regexp-opt (mapcar 'cadr fnlist) t)) + "^[ \t]*(\\(fset[ \t]+'\\|\ cl-def\\(?:generic\\|method\\|un\\)\\|\ def\\(?:un\\|subst\\|foo\\|method\\|class\\|\ ine-\\(?:derived\\|generic\\|\\(?:global\\(?:ized\\)?-\\)?minor\\)-mode\\|\ \\(?:ine-obsolete-function-\\)?alias[ \t]+'\\|\ ine-overloadable-function\\)\\)\ -[ \t]*%s\\([ \t;]+\\|$\\)") - (regexp-opt (mapcar 'cadr fnlist) t))) +[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)\\([ \t;]+\\|$\\)")) (while (re-search-forward re nil t) (skip-chars-forward " \t\n") - (setq fn (match-string 2) - type (match-string 1) - ;; (min . max) for a fixed number of arguments, or - ;; arglists with optional elements. - ;; (min) for arglists with &rest. - ;; sig = 'err means we could not find an arglist. - sig (cond (cflag - (or - (when (search-forward "," nil t 3) - (skip-chars-forward " \t\n") - ;; Assuming minargs and maxargs on same line. - (when (looking-at "\\([0-9]+\\)[ \t]*,[ \t]*\ + (setq fn (symbol-name (car (read-from-string (match-string 2))))) + (when (member fn (mapcar 'cadr fnlist)) + (setq type (match-string 1) + ;; (min . max) for a fixed number of arguments, or + ;; arglists with optional elements. + ;; (min) for arglists with &rest. + ;; sig = 'err means we could not find an arglist. + sig (cond (cflag + (or + (when (search-forward "," nil t 3) + (skip-chars-forward " \t\n") + ;; Assuming minargs and maxargs on same line. + (when (looking-at "\\([0-9]+\\)[ \t]*,[ \t]*\ \\([0-9]+\\|MANY\\|UNEVALLED\\)") - (setq minargs (string-to-number - (match-string 1)) - maxargs (match-string 2)) - (cons minargs (unless (string-match "[^0-9]" - maxargs) - (string-to-number - maxargs))))) - 'err)) - ((string-match - "\\`define-\\(derived\\|generic\\)-mode\\'" - type) - '(0 . 0)) - ((string-match - "\\`define\\(-global\\(ized\\)?\\)?-minor-mode\\'" - type) - '(0 . 1)) - ;; Prompt to update. - ((string-match - "\\`define-obsolete-function-alias\\>" - type) - 'obsolete) - ;; Can't easily check arguments in these cases. - ((string-match "\\`\\(def\\(alias\\|class\\)\\|\ + (setq minargs (string-to-number + (match-string 1)) + maxargs (match-string 2)) + (cons minargs (unless (string-match "[^0-9]" + maxargs) + (string-to-number + maxargs))))) + 'err)) + ((string-match + "\\`define-\\(derived\\|generic\\)-mode\\'" + type) + '(0 . 0)) + ((string-match + "\\`define\\(-global\\(ized\\)?\\)?-minor-mode\\'" + type) + '(0 . 1)) + ;; Prompt to update. + ((string-match + "\\`define-obsolete-function-alias\\>" + type) + 'obsolete) + ;; Can't easily check arguments in these cases. + ((string-match "\\`\\(def\\(alias\\|class\\)\\|\ fset\\|\\(?:cl-\\)?defmethod\\)\\>" type) - t) - ((looking-at "\\((\\|nil\\)") - (byte-compile-arglist-signature - (read (current-buffer)))) - (t - 'err)) - ;; alist of functions and arglist signatures. - siglist (cons (cons fn sig) siglist))))) + t) + ((looking-at "\\((\\|nil\\)") + (byte-compile-arglist-signature + (read (current-buffer)))) + (t + 'err)) + ;; alist of functions and arglist signatures. + siglist (cons (cons fn sig) siglist)))))) (dolist (e fnlist) (setq arglist (nth 2 e) type -- cgit v1.2.3 From 0f715f9c154a47de57a2f24f19b4a402604e6dc0 Mon Sep 17 00:00:00 2001 From: João Távora Date: Wed, 29 Nov 2023 16:48:34 -0600 Subject: Improve shorthands-font-lock-shorthands (bug#67390) Add font locking to the shorthand prefix of a given printed symbol name by checking if any of the shorthand prefixes in read-symbol-shorthands are a prefix for that print name. Although this does more string comparisons, it didn't prove to be any slower than the existing approach, and is more correct. This version is more accurate when highlighting files with many overlapping shorthands. Given: ;; Local Variables: ;; read-symbol-shorthands: (("bc-" . "breadcrumb-") ;; ("aw-" . "ace-window-") ;; ("zorglub/" . "ace-window-") ;; ("he//" . "hyperdrive-entry--") ;; ("h//" . "hyperdrive--") ;; ("he/" . "hyperdrive-entry-") ;; ("h/" . "hyperdrive-")) ;; End: The following are correct highlights on print names '(zorglub/blerh ; hilits "zorglub/" reads to 'ace-window-blerh' he/foo ; hilits "he/" reads to 'hyperdrive-entry-foo' he//bar ; hilits "he//" reads to 'hyperdrive-entry--bar' h/coiso ; hilits "h/" reads to 'hyperdrive-coiso' h//thingy ; hilits "h//" reads to 'hyperdrive--thingy' bc-yo ; hilits "bc-" reads to 'breadcrumb-yo' aw-thingy ; hilits "aw-" reads to 'ace-window-thingy' ) Co-authored-by: Jonas Bernoulli Co-authored-by: Joseph Turner * lisp/emacs-lisp/shorthands.el (shorthands-font-lock-shorthands): --- lisp/emacs-lisp/shorthands.el | 34 +++++++++++----------------------- 1 file changed, 11 insertions(+), 23 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/shorthands.el b/lisp/emacs-lisp/shorthands.el index 6348aaccf93..379fb0baec9 100644 --- a/lisp/emacs-lisp/shorthands.el +++ b/lisp/emacs-lisp/shorthands.el @@ -52,38 +52,26 @@ :version "28.1" :group 'font-lock-faces) -(defun shorthands--mismatch-from-end (str1 str2) - "Tell index of first mismatch in STR1 and STR2, from end. -The index is a valid 0-based index on STR1. Returns nil if STR1 -equals STR2. Return 0 if STR1 is a suffix of STR2." - (cl-loop with l1 = (length str1) with l2 = (length str2) - for i from 1 - for i1 = (- l1 i) for i2 = (- l2 i) - while (eq (aref str1 i1) (aref str2 i2)) - if (zerop i2) return (if (zerop i1) nil i1) - if (zerop i1) return 0 - finally (return i1))) - (defun shorthands-font-lock-shorthands (limit) + "Font lock until LIMIT considering `read-symbol-shorthands'." (when read-symbol-shorthands (while (re-search-forward (concat "\\_<\\(" (rx lisp-mode-symbol) "\\)\\_>") limit t) (let* ((existing (get-text-property (match-beginning 1) 'face)) + (print-name (match-string 1)) (probe (and (not (memq existing '(font-lock-comment-face font-lock-string-face))) - (intern-soft (match-string 1)))) - (sname (and probe (symbol-name probe))) - (mismatch (and sname (shorthands--mismatch-from-end - (match-string 1) sname))) - (guess (and mismatch (1+ mismatch)))) - (when guess - (when (and (< guess (1- (length (match-string 1)))) - ;; In bug#67390 we allow other separators - (eq (char-syntax (aref (match-string 1) guess)) ?_)) - (setq guess (1+ guess))) + (intern-soft print-name))) + (symbol-name (and probe (symbol-name probe))) + (prefix (and symbol-name + (not (string-equal print-name symbol-name)) + (car (assoc print-name + read-symbol-shorthands + #'string-prefix-p))))) + (when prefix (add-face-text-property (match-beginning 1) - (+ (match-beginning 1) guess) + (+ (match-beginning 1) (length prefix)) 'elisp-shorthand-font-lock-face)))))) (font-lock-add-keywords 'emacs-lisp-mode '((shorthands-font-lock-shorthands)) t) -- cgit v1.2.3 From c52d17d91ade6c789d8672dbd1301ba86ba4d7d1 Mon Sep 17 00:00:00 2001 From: João Távora Date: Wed, 29 Nov 2023 20:09:57 -0600 Subject: Also teach loaddefs-gen.el about shorthands (bug#63480) * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--parse-file): Make aware of read-symbol-shorthands. --- lisp/emacs-lisp/loaddefs-gen.el | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 5f152d3b509..bf5cd24f161 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -378,6 +378,7 @@ don't include." (let ((defs nil) (load-name (loaddefs-generate--file-load-name file main-outfile)) (compute-prefixes t) + read-symbol-shorthands local-outfile inhibit-autoloads) (with-temp-buffer (insert-file-contents file) @@ -399,7 +400,19 @@ don't include." (setq inhibit-autoloads (read (current-buffer))))) (save-excursion (when (re-search-forward "autoload-compute-prefixes: *" nil t) - (setq compute-prefixes (read (current-buffer)))))) + (setq compute-prefixes (read (current-buffer))))) + (save-excursion + ;; since we're "open-coding" we have to repeat more + ;; complicated logic in `hack-local-variables'. + (when (re-search-forward "read-symbol-shorthands: *" nil t) + (let* ((commentless (replace-regexp-in-string + "\n\\s-*;+" "" + (buffer-substring (point) (point-max)))) + (unsorted-shorthands (car (read-from-string commentless)))) + (setq read-symbol-shorthands + (sort unsorted-shorthands + (lambda (sh1 sh2) + (> (length (car sh1)) (length (car sh2)))))))))) ;; We always return the package version (even for pre-dumped ;; files). -- cgit v1.2.3 From 817140a852e79c5ef3cf7dc5e4c50aa710e8c4a2 Mon Sep 17 00:00:00 2001 From: João Távora Date: Thu, 30 Nov 2023 07:32:50 -0600 Subject: Fix prefix discovery for files with read-symbol-shorthands (bug#67325) In a previous commit, the local-variable read-symbol-shorthands is already read into the temporary buffer used for the autoload parsing aerobatics, so all we needed to do in 'l-g--compute-prefixes' is use 'read' to give 'read-symbol-shorthands' a chance to kick in. * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--compute-prefixes): --- lisp/emacs-lisp/loaddefs-gen.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index bf5cd24f161..8aacbf406b6 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -499,7 +499,11 @@ don't include." (while (re-search-forward "^(\\(def[^ \t\n]+\\)[ \t\n]+['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t) (unless (member (match-string 1) autoload-ignored-definitions) - (let ((name (match-string-no-properties 2))) + (let* ((name (match-string-no-properties 2)) + ;; Consider `read-symbol-shorthands'. + (probe (let ((obarray (obarray-make))) + (car (read-from-string name))))) + (setq name (symbol-name probe)) (when (save-excursion (goto-char (match-beginning 0)) (or (bobp) -- cgit v1.2.3 From 9a51fbb69fc9dc4aa415308889ae667ee65660d7 Mon Sep 17 00:00:00 2001 From: João Távora Date: Sat, 3 Feb 2024 08:27:27 -0600 Subject: ; Also consider shorthands in check-declare-scan (bug#67523) * lisp/emacs-lisp/check-declare.el (check-declare-scan): Also consider shorthands here. --- lisp/emacs-lisp/check-declare.el | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el index b4a7b4b33e6..a6d1a330d90 100644 --- a/lisp/emacs-lisp/check-declare.el +++ b/lisp/emacs-lisp/check-declare.el @@ -85,6 +85,9 @@ don't know how to recognize (e.g. some macros)." (let (alist) (with-temp-buffer (insert-file-contents file) + ;; Ensure shorthands available, as we will be `read'ing Elisp + ;; (bug#67523) + (let (enable-local-variables) (hack-local-variables)) ;; FIXME we could theoretically be inside a string. (while (re-search-forward "^[ \t]*\\((declare-function\\)[ \t\n]" nil t) (let ((pos (match-beginning 1))) @@ -147,6 +150,7 @@ is a string giving details of the error." (insert-file-contents fnfile) (unless cflag ;; If in Elisp, ensure syntax and shorthands available + ;; (bug#67523) (set-syntax-table emacs-lisp-mode-syntax-table) (let (enable-local-variables) (hack-local-variables))) ;; defsubst's don't _have_ to be known at compile time. -- cgit v1.2.3 From f266622cdb34044f364976796a4e7ac003d7a1b3 Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Sat, 3 Feb 2024 08:32:37 -0600 Subject: ; Optimize shorthand insertion in loaddefs-generate--parse-file * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--parse-file): Optimize. --- lisp/emacs-lisp/loaddefs-gen.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 8aacbf406b6..fe29469d08c 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -404,10 +404,13 @@ don't include." (save-excursion ;; since we're "open-coding" we have to repeat more ;; complicated logic in `hack-local-variables'. - (when (re-search-forward "read-symbol-shorthands: *" nil t) - (let* ((commentless (replace-regexp-in-string + (when-let ((beg + (re-search-forward "read-symbol-shorthands: *" nil t))) + ;; `read-symbol-shorthands' alist ends with two parens. + (let* ((end (re-search-forward ")[;\n\s]*)")) + (commentless (replace-regexp-in-string "\n\\s-*;+" "" - (buffer-substring (point) (point-max)))) + (buffer-substring beg end))) (unsorted-shorthands (car (read-from-string commentless)))) (setq read-symbol-shorthands (sort unsorted-shorthands -- cgit v1.2.3 From ecb69c8bd8c3dba205187c6296c8cac9b6a65121 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Feb 2024 18:05:55 +0200 Subject: ; Fix a comment in loaddefs-gen.el --- lisp/emacs-lisp/loaddefs-gen.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index fe29469d08c..7eced43e735 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -402,7 +402,7 @@ don't include." (when (re-search-forward "autoload-compute-prefixes: *" nil t) (setq compute-prefixes (read (current-buffer))))) (save-excursion - ;; since we're "open-coding" we have to repeat more + ;; Since we're "open-coding", we have to repeat more ;; complicated logic in `hack-local-variables'. (when-let ((beg (re-search-forward "read-symbol-shorthands: *" nil t))) -- cgit v1.2.3 From 8fc7e8c2b0cb33b0e8e9822f116e6dbb530ab1b6 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Feb 2024 18:09:35 +0200 Subject: ; * lisp/files.el (hack-local-variables--find-variables): Fix comment. --- lisp/files.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/files.el b/lisp/files.el index 172237ceb82..229771810fb 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4193,7 +4193,7 @@ major-mode." (or (buffer-file-name thisbuf) "")))))) ((eq var 'read-symbol-shorthands) ;; Sort automatically by shorthand length - ;; descending + ;; in descending order. (setq val (sort val (lambda (sh1 sh2) (> (length (car sh1)) (length (car sh2)))))) -- cgit v1.2.3 From b0049c942b8fa4093a02a9bb4ffc9c5da2261765 Mon Sep 17 00:00:00 2001 From: Richard M Stallman Date: Sat, 3 Feb 2024 17:47:02 -0500 Subject: bytecomp.el: Warn for `,' not within backquote construct (bytecomp--report-comma): New function with `compiler-macro' property. --- lisp/emacs-lisp/bytecomp.el | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 6e66771658e..5d2aa3355be 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5742,6 +5742,16 @@ and corresponding effects." (eval form) form))) +;; Report comma operator used outside of backquote. +;; Inside backquote, backquote will transform it before it gets here. + +(put '\, 'compiler-macro #'bytecomp--report-comma) +(defun bytecomp--report-comma (form &rest _ignore) + (macroexp-warn-and-return + (format-message "`%s' called -- perhaps used not within backquote" + (car form)) + form (list 'suspicious (car form)) t)) + ;; Check for (in)comparable constant values in calls to `eq', `memq' etc. (defun bytecomp--dodgy-eq-arg-p (x number-ok) -- cgit v1.2.3 From 4ebded3f5ee8617ac6b1debaa01706cd78206f39 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 3 Feb 2024 18:22:41 -0500 Subject: * lisp/emacs-lisp/easy-mmode.el (easy-mmode--mode-docstring): Add comment --- lisp/emacs-lisp/easy-mmode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 05b23a86fc0..4fa05008dd8 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -132,7 +132,7 @@ it is disabled.") (string-replace "'" "\\='" (format "%S" getter))))) (let ((start (point))) (insert argdoc) - (when (fboundp 'fill-region) + (when (fboundp 'fill-region) ;Don't break bootstrap! (fill-region start (point) 'left t)))) ;; Finally, insert the keymap. (when (and (boundp keymap-sym) -- cgit v1.2.3 From 45125e019c3698ff74ccb2183b789c25f9d3f574 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 3 Feb 2024 23:05:03 -0500 Subject: tramp: Tweak the ls-lisp declarations * lisp/net/tramp-sh.el (ls-lisp-use-insert-directory-program): Don't declare its existence... (tramp-sh-handle-insert-directory): ...test it instead. * lisp/net/tramp.el (ls-lisp-dirs-first, ls-lisp-emulation) (ls-lisp-ignore-case, ls-lisp-use-insert-directory-program) (ls-lisp-verbosity): Move declaration... (tramp-handle-insert-directory): ...to the point where we have a good reason to think these variables exist. --- lisp/net/tramp-sh.el | 3 +-- lisp/net/tramp.el | 10 +++++----- 2 files changed, 6 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 6bb1d976ec5..7656da81dcc 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -38,7 +38,6 @@ (declare-function dired-compress-file "dired-aux") (declare-function dired-remove-file "dired-aux") (defvar dired-compress-file-suffixes) -(defvar ls-lisp-use-insert-directory-program) ;; Added in Emacs 28.1. (defvar process-file-return-signal-string) (defvar vc-handled-backends) @@ -2636,7 +2635,7 @@ The method used must be an out-of-band method." (defun tramp-sh-handle-insert-directory (filename switches &optional wildcard full-directory-p) "Like `insert-directory' for Tramp files." - (if (and (featurep 'ls-lisp) + (if (and (boundp 'ls-lisp-use-insert-directory-program) (not ls-lisp-use-insert-directory-program)) (tramp-handle-insert-directory filename switches wildcard full-directory-p) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 74d95757e46..7800efc2a5e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -67,11 +67,6 @@ (declare-function file-notify-rm-watch "filenotify") (declare-function netrc-parse "netrc") (defvar auto-save-file-name-transforms) -(defvar ls-lisp-dirs-first) -(defvar ls-lisp-emulation) -(defvar ls-lisp-ignore-case) -(defvar ls-lisp-use-insert-directory-program) -(defvar ls-lisp-verbosity) (defvar tramp-prefix-format) (defvar tramp-prefix-regexp) (defvar tramp-method-regexp) @@ -4189,6 +4184,11 @@ Let-bind it when necessary.") (filename switches &optional wildcard full-directory-p) "Like `insert-directory' for Tramp files." (require 'ls-lisp) + (defvar ls-lisp-dirs-first) + (defvar ls-lisp-emulation) + (defvar ls-lisp-ignore-case) + (defvar ls-lisp-use-insert-directory-program) + (defvar ls-lisp-verbosity) (unless switches (setq switches "")) ;; Mark trailing "/". (when (and (directory-name-p filename) -- cgit v1.2.3 From fc8b09484a2fbe182a0351c47afc3bf71f3b2a1b Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 4 Feb 2024 09:48:04 +0100 Subject: ; Fix typos --- ChangeLog.3 | 4 ++-- admin/codespell/codespell.exclude | 2 ++ lisp/erc/erc-common.el | 2 +- lisp/erc/erc.el | 2 +- lisp/eshell/esh-arg.el | 2 +- lisp/forms.el | 2 +- lisp/progmodes/eglot.el | 2 +- src/fns.c | 2 +- 8 files changed, 10 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/ChangeLog.3 b/ChangeLog.3 index dc712df43ad..7db4986410d 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -137530,7 +137530,7 @@ Bind `enable-local-variables' in `hack-connection-local-variables' * lisp/files-x.el (hack-connection-local-variables): - Bind `enable-local-variables', instead of re-declaring + Bind `enable-local-variables', instead of redeclaring `safe-local-variable-p'. 2019-03-23 Eli Zaretskii @@ -163179,7 +163179,7 @@ Quieten compilation of octave.el - * lisp/progmodes/octave.el (compilation-forget-errors): Re-declare. + * lisp/progmodes/octave.el (compilation-forget-errors): Redeclare. 2018-02-28 Glenn Morris diff --git a/admin/codespell/codespell.exclude b/admin/codespell/codespell.exclude index 416d79cf131..6413a73701b 100644 --- a/admin/codespell/codespell.exclude +++ b/admin/codespell/codespell.exclude @@ -1583,3 +1583,5 @@ VERY VERY LONG STRIN | VERY VERY LONG STRIN (ert-info ("Joined by bouncer to #chan@foonet, pal persent") (ert-info ("Joined by bouncer to #chan@barnet, pal persent") .UE . + (0.03 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: See, by good hap, yonder's my lord; I have sweat to see his honour.") + (0.05 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: But, in defence, by mercy, 'tis most just.") diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index abcdc4c8843..8388efe062c 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -171,7 +171,7 @@ Derived from the advertised \"PREFIX\" ISUPPORT parameter." ;; After dropping 28, we can use prefixed "erc-autoload" cookies. (defun erc--normalize-module-symbol (symbol) - "Return preferred SYMBOL for `erc--modules'." + "Return preferred SYMBOL for `erc--module'." (while-let ((canonical (get symbol 'erc--module)) ((not (eq canonical symbol)))) (setq symbol canonical)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index ef047201251..08dfa4b8f1b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6815,7 +6815,7 @@ stand-in from the fallback value \"(qaohv)~&@%+\"." "Return numeric rank for CHAR or nil if unknown. For example, given letters \"qaohv\" return 1 for ?v, 2 for ?h, and 4 for ?o, etc. If given, expect PARSED-PREFIX to be a -`erc--parse-prefix' object. With FROM-PREFIX-P, expect CHAR to +`erc--parsed-prefix' object. With FROM-PREFIX-P, expect CHAR to be a prefix instead." (and-let* ((obj (or parsed-prefix (erc--parsed-prefix))) (pos (erc--strpos char (if from-prefix-p diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 97ddac58629..78cf28d785a 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -285,7 +285,7 @@ QUOTED is passed to `eshell-concat' (which see) and, if non-nil, allows values to be converted to numbers where appropriate. ARGS should be a list of lists of arguments, such as that -produced by `eshell-prepare-slice'. \"Adjacent\" values of +produced by `eshell-prepare-splice'. \"Adjacent\" values of consecutive arguments will be passed to `eshell-concat'. For example, if ARGS is diff --git a/lisp/forms.el b/lisp/forms.el index 009667af273..3a3160a0c8b 100644 --- a/lisp/forms.el +++ b/lisp/forms.el @@ -343,7 +343,7 @@ suitable for forms processing.") (defvar forms-write-file-filter nil "The name of a function that is called before writing the data file. -This can be used to undo the effects of `form-read-file-filter'.") +This can be used to undo the effects of `forms-read-file-filter'.") (defvar forms-new-record-filter nil "The name of a function that is called when a new record is created.") diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index df8a287b4f2..2f32a8e6eda 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -591,7 +591,7 @@ It is nil if Eglot is not byte-complied.") (let ((vec (copy-sequence url-path-allowed-chars))) (aset vec ?: nil) ;; see github#639 vec) - "Like `url-path-allows-chars' but more restrictive.") + "Like `url-path-allowed-chars' but more restrictive.") ;;; Message verification helpers diff --git a/src/fns.c b/src/fns.c index 1262e3e749e..08908d481a3 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5374,7 +5374,7 @@ mark_fns (void) } } -/* Find the hash_table_test object correponding to the (bare) symbol TEST, +/* Find the hash_table_test object corresponding to the (bare) symbol TEST, creating one if none existed. */ static struct hash_table_test * get_hash_table_user_test (Lisp_Object test) -- cgit v1.2.3 From 56d0fbd99a87858717e08488df57db7fc08a2891 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 4 Feb 2024 10:28:18 +0100 Subject: Add alias progress-reporter-make * lisp/subr.el (progress-reporter-make): New alias for 'make-progress-reporter'. --- lisp/subr.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/subr.el b/lisp/subr.el index a97824965b5..582415a9761 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1,7 +1,6 @@ ;;; subr.el --- basic lisp subroutines for Emacs -*- lexical-binding:t -*- -;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2024 Free Software -;; Foundation, Inc. +;; Copyright (C) 1985-2024 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal @@ -6736,6 +6735,8 @@ effectively rounded up." (progress-reporter-update reporter (or current-value min-value)) reporter)) +(defalias 'progress-reporter-make #'make-progress-reporter) + (defun progress-reporter-force-update (reporter &optional value new-message suffix) "Report progress of an operation in the echo area unconditionally. -- cgit v1.2.3 From 9bbf8232dba746db90b90285e9e4ed6d299d251a Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 4 Feb 2024 10:28:40 +0100 Subject: Delete compat code in `url` library * lisp/url/url-cid.el (url-cid): Delete compat code for ancient Gnus. * lisp/url/url-ldap.el (url-ldap-certificate-formatter): Delete compat code; ssl.el has never been in Emacs. * lisp/url/url-mailto.el (url-mail): Make into alias for 'message-mail', since it is always fboundp. --- lisp/url/url-cid.el | 11 +++-------- lisp/url/url-ldap.el | 10 +++------- lisp/url/url-mailto.el | 17 ++++------------- 3 files changed, 10 insertions(+), 28 deletions(-) (limited to 'lisp') diff --git a/lisp/url/url-cid.el b/lisp/url/url-cid.el index 17a0318e652..d80037f8fe9 100644 --- a/lisp/url/url-cid.el +++ b/lisp/url/url-cid.el @@ -1,6 +1,6 @@ ;;; url-cid.el --- Content-ID URL loader -*- lexical-binding: t; -*- -;; Copyright (C) 1998-1999, 2004-2024 Free Software Foundation, Inc. +;; Copyright (C) 1998-2024 Free Software Foundation, Inc. ;; Keywords: comm, data, processes @@ -52,12 +52,7 @@ ;;;###autoload (defun url-cid (url) - (cond - ((fboundp 'mm-get-content-id) - ;; Using Pterodactyl Gnus or later - (with-current-buffer (generate-new-buffer " *url-cid*") - (url-cid-gnus (url-filename url)))) - (t - (message "Unable to handle CID URL: %s" url)))) + (with-current-buffer (generate-new-buffer " *url-cid*") + (url-cid-gnus (url-filename url)))) ;;; url-cid.el ends here diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el index 1bdd5099637..6aaea606c27 100644 --- a/lisp/url/url-ldap.el +++ b/lisp/url/url-ldap.el @@ -1,6 +1,6 @@ ;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code -*- lexical-binding: t; -*- -;; Copyright (C) 1998-1999, 2004-2024 Free Software Foundation, Inc. +;; Copyright (C) 1998-2024 Free Software Foundation, Inc. ;; Keywords: comm, data, processes @@ -92,12 +92,8 @@ "'>" dn "")) (defun url-ldap-certificate-formatter (data) - (condition-case () - (require 'ssl) - (error nil)) - (let ((vals (if (fboundp 'ssl-certificate-information) - (ssl-certificate-information data) - (tls-certificate-information data)))) + ;; FIXME: tls.el is obsolete. + (let ((vals (tls-certificate-information data))) (if (not vals) "Unable to parse certificate" (concat "\n" diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el index c2d347a1646..50293ab3f05 100644 --- a/lisp/url/url-mailto.el +++ b/lisp/url/url-mailto.el @@ -1,6 +1,6 @@ ;;; url-mailto.el --- Mail Uniform Resource Locator retrieval code -*- lexical-binding: t; -*- -;; Copyright (C) 1996-1999, 2004-2024 Free Software Foundation, Inc. +;; Copyright (C) 1996-2024 Free Software Foundation, Inc. ;; Keywords: comm, data, processes @@ -28,12 +28,7 @@ (require 'url-util) ;;;###autoload -(defun url-mail (&rest args) - (interactive "P") - (if (fboundp 'message-mail) - (apply 'message-mail args) - (or (apply 'mail args) - (error "Mail aborted")))) +(defalias 'url-mail #'message-mail) (defun url-mail-goto-field (field) (if (not field) @@ -57,8 +52,6 @@ (save-excursion (insert "\n")))))) -(declare-function mail-send-and-exit "sendmail") - ;;;###autoload (defun url-mailto (url) "Handle the mailto: URL syntax." @@ -111,8 +104,6 @@ ;; (setq func (intern-soft (concat "mail-" (caar args)))) (insert (mapconcat 'identity (cdar args) ", "))) (setq args (cdr args))) - ;; (url-mail-goto-field "User-Agent") -;; (insert url-package-name "/" url-package-version " URL/" url-version) (if (not url-request-data) (progn (set-buffer-modified-p nil) @@ -128,8 +119,8 @@ (goto-char (point-max)) (insert url-request-data) ;; It seems Microsoft-ish to send without warning. - ;; Fixme: presumably this should depend on a privacy setting. - (if (y-or-n-p "Send this auto-generated mail? ") + ;; FIXME: presumably this should depend on a privacy setting. + (if (y-or-n-p "Send this auto-generated mail?") (let ((buffer (current-buffer))) (cond ((eq url-mail-command 'compose-mail) (funcall (get mail-user-agent 'sendfunc) nil)) -- cgit v1.2.3 From e44b9f35793d642d5155fde035e3bc92102d13a1 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 4 Feb 2024 11:26:43 +0100 Subject: * lisp/speedbar.el (imenu): Require unconditionally. --- lisp/speedbar.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 1cb72dc23e6..2ed97986fe7 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -3488,7 +3488,7 @@ functions to do caching and flushing if appropriate." nil -(eval-when-compile (condition-case nil (require 'imenu) (error nil))) +(eval-when-compile (require 'imenu)) (declare-function imenu--make-index-alist "imenu" (&optional no-error)) (defun speedbar-fetch-dynamic-imenu (file) -- cgit v1.2.3 From 4d57187a248d3243dcc8b5da5d8365cb1b54a347 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 3 Feb 2024 16:46:59 +0100 Subject: Prevent cache of diff-mode buffers to grow without bounds Previously, these " *diff-syntax:..." buffers were never removed. Now we discard the least recently used half of them every hour. * lisp/vc/diff-mode.el (diff--cached-revision-buffers) (diff--cache-clean-interval, diff--cache-clean-timer, diff--cache-clean) (diff--cache-schedule-clean, diff--get-revision-properties): New. (diff-syntax-fontify-hunk): Use diff--get-revision-properties. --- lisp/vc/diff-mode.el | 69 ++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 53 insertions(+), 16 deletions(-) (limited to 'lisp') diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 83d580d98dd..34a4b70691d 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2817,6 +2817,57 @@ and the position in MAX." (defvar-local diff--syntax-file-attributes nil) (put 'diff--syntax-file-attributes 'permanent-local t) +(defvar diff--cached-revision-buffers nil + "List of ((FILE . REVISION) . BUFFER) in MRU order.") + +(defvar diff--cache-clean-timer nil) +(defconst diff--cache-clean-interval 3600) ; seconds + +(defun diff--cache-clean () + "Discard the least recently used half of the cache." + (let ((n (/ (length diff--cached-revision-buffers) 2))) + (mapc #'kill-buffer (mapcar #'cdr (nthcdr n diff--cached-revision-buffers))) + (setq diff--cached-revision-buffers + (ntake n diff--cached-revision-buffers))) + (diff--cache-schedule-clean)) + +(defun diff--cache-schedule-clean () + (setq diff--cache-clean-timer + (and diff--cached-revision-buffers + (run-with-timer diff--cache-clean-interval nil + #'diff--cache-clean)))) + +(defun diff--get-revision-properties (file revision text line-nb) + "Get font-lock properties from FILE at REVISION for TEXT at LINE-NB." + (let* ((file-rev (cons file revision)) + (entry (assoc file-rev diff--cached-revision-buffers)) + (buffer (cdr entry))) + (if (buffer-live-p buffer) + (progn + ;; Don't re-initialize the buffer (which would throw + ;; away the previous fontification work). + (setq file nil) + (setq diff--cached-revision-buffers + (cons entry + (delq entry diff--cached-revision-buffers)))) + ;; Cache miss: create a new entry. + (setq buffer (get-buffer-create (format " *diff-syntax:%s.~%s~*" + file revision))) + (condition-case nil + (vc-find-revision-no-save file revision diff-vc-backend buffer) + (error + (kill-buffer buffer) + (setq buffer nil)) + (:success + (push (cons file-rev buffer) + diff--cached-revision-buffers)))) + (when diff--cache-clean-timer + (cancel-timer diff--cache-clean-timer)) + (diff--cache-schedule-clean) + (and buffer + (with-current-buffer buffer + (diff-syntax-fontify-props file text line-nb))))) + (defun diff-syntax-fontify-hunk (beg end old) "Highlight source language syntax in diff hunk between BEG and END. When OLD is non-nil, highlight the hunk from the old source." @@ -2867,22 +2918,8 @@ When OLD is non-nil, highlight the hunk from the old source." (insert-file-contents file) (setq diff--syntax-file-attributes attrs))) (diff-syntax-fontify-props file text line-nb))))) - ;; Get properties from a cached revision - (let* ((buffer-name (format " *diff-syntax:%s.~%s~*" - file revision)) - (buffer (get-buffer buffer-name))) - (if buffer - ;; Don't re-initialize the buffer (which would throw - ;; away the previous fontification work). - (setq file nil) - (setq buffer (ignore-errors - (vc-find-revision-no-save - file revision - diff-vc-backend - (get-buffer-create buffer-name))))) - (when buffer - (with-current-buffer buffer - (diff-syntax-fontify-props file text line-nb)))))))) + (diff--get-revision-properties file revision + text line-nb))))) (let ((file (car (diff-hunk-file-names old)))) (cond ((and file diff-default-directory -- cgit v1.2.3 From 70c10204f0025eac844a88b0ef85cfca44cff61c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 4 Feb 2024 13:16:59 +0100 Subject: Prefer setq-local in more places * lisp/erc/erc-compat.el (erc-set-write-file-functions): * lisp/obsolete/iswitchb.el (iswitchb-minibuffer-setup-hook) (iswitchb-minibuffer-setup): * lisp/obsolete/longlines.el (longlines-mode): * lisp/obsolete/rcompile.el (remote-compile): * lisp/progmodes/cperl-mode.el (cperl-file-style): * test/lisp/erc/erc-tests.el (erc-ring-previous-command): Prefer setq-local. --- lisp/erc/erc-compat.el | 2 +- lisp/obsolete/iswitchb.el | 4 ++-- lisp/obsolete/longlines.el | 14 +++++--------- lisp/obsolete/rcompile.el | 14 +++++++------- lisp/progmodes/cperl-mode.el | 2 +- test/lisp/erc/erc-tests.el | 2 +- 6 files changed, 17 insertions(+), 21 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index dede833a93d..37fcdebbe7b 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -102,7 +102,7 @@ See `erc-encoding-coding-alist'." (defun erc-set-write-file-functions (new-val) (declare (obsolete nil "28.1")) - (set (make-local-variable 'write-file-functions) new-val)) + (setq-local 'write-file-functions new-val)) (defvar erc-emacs-build-time (if (or (stringp emacs-build-time) (not emacs-build-time)) diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el index 3f05b7fe7ac..d541dc085c6 100644 --- a/lisp/obsolete/iswitchb.el +++ b/lisp/obsolete/iswitchb.el @@ -370,7 +370,7 @@ See documentation of `walk-windows' for useful values." This hook is run during minibuffer setup if `iswitchb' is active. For instance: \(add-hook \\='iswitchb-minibuffer-setup-hook - \\='\(lambda () (set (make-local-variable \\='max-mini-window-height) 3))) + \\='\(lambda () (setq-local \\='max-mini-window-height 3))) will constrain the minibuffer to a maximum height of 3 lines when iswitchb is running." :type 'hook) @@ -1262,7 +1262,7 @@ Modified from `icomplete-completions'." "Set up minibuffer for `iswitchb-buffer'. Copied from `icomplete-minibuffer-setup-hook'." (when (iswitchb-entryfn-p) - (set (make-local-variable 'iswitchb-use-mycompletion) t) + (setq-local 'iswitchb-use-mycompletion t) (add-hook 'pre-command-hook #'iswitchb-pre-command nil t) (add-hook 'post-command-hook #'iswitchb-post-command nil t) (run-hooks 'iswitchb-minibuffer-setup-hook))) diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el index 6aa388805f2..e73e9e0c85b 100644 --- a/lisp/obsolete/longlines.el +++ b/lisp/obsolete/longlines.el @@ -116,17 +116,14 @@ newlines are indicated with a symbol." ;; Turn on longlines mode (progn (use-hard-newlines 1 'never) - (set (make-local-variable 'require-final-newline) nil) + (setq-local 'require-final-newline nil) (add-to-list 'buffer-file-format 'longlines) (add-hook 'change-major-mode-hook #'longlines-mode-off nil t) (add-hook 'before-revert-hook #'longlines-before-revert-hook nil t) (make-local-variable 'longlines-auto-wrap) - (set (make-local-variable 'isearch-search-fun-function) - #'longlines-search-function) - (set (make-local-variable 'replace-search-function) - #'longlines-search-forward) - (set (make-local-variable 'replace-re-search-function) - #'longlines-re-search-forward) + (setq-local 'isearch-search-fun-function #'longlines-search-function) + (setq-local 'replace-search-function #'longlines-search-forward) + (setq-local 'replace-re-search-function #'longlines-re-search-forward) (add-function :filter-return (local 'filter-buffer-substring-function) #'longlines-encode-string) (when longlines-wrap-follows-window-size @@ -136,8 +133,7 @@ newlines are indicated with a symbol." (window-width))) longlines-wrap-follows-window-size 2))) - (set (make-local-variable 'fill-column) - (- (window-width) dw))) + (setq-local 'fill-column (- (window-width) dw))) (add-hook 'window-configuration-change-hook #'longlines-window-change-function nil t)) (let ((buffer-undo-list t) diff --git a/lisp/obsolete/rcompile.el b/lisp/obsolete/rcompile.el index e0826475e32..877a143f6ad 100644 --- a/lisp/obsolete/rcompile.el +++ b/lisp/obsolete/rcompile.el @@ -169,12 +169,12 @@ See \\[compile]." ;; compilation-parse-errors will find referenced files by Tramp. (with-current-buffer next-error-last-buffer (when (fboundp 'tramp-make-tramp-file-name) - (set (make-local-variable 'comint-file-name-prefix) - (funcall - #'tramp-make-tramp-file-name - nil ;; method. - remote-compile-user - remote-compile-host - "")))))) + (setq-local 'comint-file-name-prefix + (funcall + #'tramp-make-tramp-file-name + nil ;; method. + remote-compile-user + remote-compile-host + "")))))) ;;; rcompile.el ends here diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 758a6e17f72..dc3b31c79ac 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6557,7 +6557,7 @@ and \"Whitesmith\"." (let ((option (car setting)) (value (cdr setting))) (set (make-local-variable option) value))) - (set (make-local-variable 'cperl-file-style) style)) + (setq-local 'cperl-file-style style)) (declare-function Info-find-node "info" (filename nodename &optional no-going-back strict-case diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 7890049a325..440b52fe106 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1278,7 +1278,7 @@ (setq erc-server-current-nick "tester") (setq-local erc-last-input-time 0) (should-not (local-variable-if-set-p 'erc-send-completed-hook)) - (set (make-local-variable 'erc-send-completed-hook) nil) ; skip t (globals) + (setq-local 'erc-send-completed-hook nil) ; skip t (globals) ;; Just in case erc-ring-mode is already on (setq-local erc--input-review-functions erc--input-review-functions) (add-hook 'erc--input-review-functions #'erc-add-to-input-ring) -- cgit v1.2.3 From a4587646fabf2b7f0cb19a7e0bee090f9106a73a Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 4 Feb 2024 13:20:15 +0100 Subject: ; Fix my last commit --- lisp/erc/erc-compat.el | 2 +- lisp/obsolete/iswitchb.el | 4 ++-- lisp/obsolete/longlines.el | 10 +++++----- lisp/obsolete/rcompile.el | 2 +- lisp/progmodes/cperl-mode.el | 2 +- test/lisp/erc/erc-tests.el | 2 +- 6 files changed, 11 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 37fcdebbe7b..9b8699f6949 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -102,7 +102,7 @@ See `erc-encoding-coding-alist'." (defun erc-set-write-file-functions (new-val) (declare (obsolete nil "28.1")) - (setq-local 'write-file-functions new-val)) + (setq-local write-file-functions new-val)) (defvar erc-emacs-build-time (if (or (stringp emacs-build-time) (not emacs-build-time)) diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el index d541dc085c6..e1ea9141f0d 100644 --- a/lisp/obsolete/iswitchb.el +++ b/lisp/obsolete/iswitchb.el @@ -370,7 +370,7 @@ See documentation of `walk-windows' for useful values." This hook is run during minibuffer setup if `iswitchb' is active. For instance: \(add-hook \\='iswitchb-minibuffer-setup-hook - \\='\(lambda () (setq-local \\='max-mini-window-height 3))) + \\='\(lambda () (setq-local max-mini-window-height 3))) will constrain the minibuffer to a maximum height of 3 lines when iswitchb is running." :type 'hook) @@ -1262,7 +1262,7 @@ Modified from `icomplete-completions'." "Set up minibuffer for `iswitchb-buffer'. Copied from `icomplete-minibuffer-setup-hook'." (when (iswitchb-entryfn-p) - (setq-local 'iswitchb-use-mycompletion t) + (setq-local iswitchb-use-mycompletion t) (add-hook 'pre-command-hook #'iswitchb-pre-command nil t) (add-hook 'post-command-hook #'iswitchb-post-command nil t) (run-hooks 'iswitchb-minibuffer-setup-hook))) diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el index e73e9e0c85b..f065bcaff26 100644 --- a/lisp/obsolete/longlines.el +++ b/lisp/obsolete/longlines.el @@ -116,14 +116,14 @@ newlines are indicated with a symbol." ;; Turn on longlines mode (progn (use-hard-newlines 1 'never) - (setq-local 'require-final-newline nil) + (setq-local require-final-newline nil) (add-to-list 'buffer-file-format 'longlines) (add-hook 'change-major-mode-hook #'longlines-mode-off nil t) (add-hook 'before-revert-hook #'longlines-before-revert-hook nil t) (make-local-variable 'longlines-auto-wrap) - (setq-local 'isearch-search-fun-function #'longlines-search-function) - (setq-local 'replace-search-function #'longlines-search-forward) - (setq-local 'replace-re-search-function #'longlines-re-search-forward) + (setq-local isearch-search-fun-function #'longlines-search-function) + (setq-local replace-search-function #'longlines-search-forward) + (setq-local replace-re-search-function #'longlines-re-search-forward) (add-function :filter-return (local 'filter-buffer-substring-function) #'longlines-encode-string) (when longlines-wrap-follows-window-size @@ -133,7 +133,7 @@ newlines are indicated with a symbol." (window-width))) longlines-wrap-follows-window-size 2))) - (setq-local 'fill-column (- (window-width) dw))) + (setq-local fill-column (- (window-width) dw))) (add-hook 'window-configuration-change-hook #'longlines-window-change-function nil t)) (let ((buffer-undo-list t) diff --git a/lisp/obsolete/rcompile.el b/lisp/obsolete/rcompile.el index 877a143f6ad..258b2b519d9 100644 --- a/lisp/obsolete/rcompile.el +++ b/lisp/obsolete/rcompile.el @@ -169,7 +169,7 @@ See \\[compile]." ;; compilation-parse-errors will find referenced files by Tramp. (with-current-buffer next-error-last-buffer (when (fboundp 'tramp-make-tramp-file-name) - (setq-local 'comint-file-name-prefix + (setq-local comint-file-name-prefix (funcall #'tramp-make-tramp-file-name nil ;; method. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index dc3b31c79ac..113eed64917 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6557,7 +6557,7 @@ and \"Whitesmith\"." (let ((option (car setting)) (value (cdr setting))) (set (make-local-variable option) value))) - (setq-local 'cperl-file-style style)) + (setq-local cperl-file-style style)) (declare-function Info-find-node "info" (filename nodename &optional no-going-back strict-case diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 440b52fe106..7d189d37929 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1278,7 +1278,7 @@ (setq erc-server-current-nick "tester") (setq-local erc-last-input-time 0) (should-not (local-variable-if-set-p 'erc-send-completed-hook)) - (setq-local 'erc-send-completed-hook nil) ; skip t (globals) + (setq-local erc-send-completed-hook nil) ; skip t (globals) ;; Just in case erc-ring-mode is already on (setq-local erc--input-review-functions erc--input-review-functions) (add-hook 'erc--input-review-functions #'erc-add-to-input-ring) -- cgit v1.2.3 From b2d350cfc0bf8f0e3198bffcebe60a43341fb340 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 4 Feb 2024 14:39:02 -0500 Subject: * lisp/emacs-lisp/comp.el (comp--native-compile): Use `error-message-string` --- lisp/emacs-lisp/comp.el | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 2a516246ed4..dcdc973e6c5 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3398,16 +3398,18 @@ the deferred compilation mechanism." (if (and comp-async-compilation (not (eq (car err) 'native-compiler-error))) (progn - (message (if err-val - "%s: Error: %s %s" - "%s: Error %s") + (message "%s: Error %s" function-or-file - (get (car err) 'error-message) - (car-safe err-val)) + (error-message-string err)) (kill-emacs -1)) ;; Otherwise re-signal it adding the compilation input. + ;; FIXME: We can't just insert arbitrary info in the + ;; error-data part of an error: the handler may expect + ;; specific data at specific positions! (signal (car err) (if (consp err-val) (cons function-or-file err-val) + ;; FIXME: `err-val' is supposed to be + ;; a list, so it can only be nil here! (list function-or-file err-val))))))) (if (stringp function-or-file) data -- cgit v1.2.3 From 9dbbf93a4a08f71cf5f2278ec2a22a722fe0e0f7 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sat, 3 Feb 2024 21:24:29 -0800 Subject: Improve treesit-forward-sexp behavior for leaf nodes (bug#68899) treesit-forward-sexp uses treesit--navigate-thing with 'restricted' tactic. In this tactic we don't move over the parent thing. However, this makes forward-sexp useless for symbols when point is in the symbol rather than at the beginning of it: in that case, the symbol is considered parent and treesit-forward-sexp won't move to the end of it. To solve that, we allow to move across the parent even in 'restricted' mode if the parent is a leaf thing. Here, "leaf thing" is defined as "doesn't have any child 'thing' inside it". * lisp/treesit.el (treesit--navigate-thing): Move over parent in 'restricted' tactic if the parent is a leaf thing. --- lisp/treesit.el | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index fab2ddd88e6..93b6b56534d 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2662,9 +2662,17 @@ function is called recursively." (setq parent (treesit-node-top-level parent thing t) prev nil next nil)) - ;; If TACTIC is `restricted', the implementation is very simple. + ;; If TACTIC is `restricted', the implementation is simple. + ;; In principle we don't go to parent's beg/end for + ;; `restricted' tactic, but if the parent is a "leaf thing" + ;; (doesn't have any child "thing" inside it), then we can + ;; move to the beg/end of it (bug#68899). (if (eq tactic 'restricted) - (setq pos (funcall advance (if (> arg 0) next prev))) + (setq pos (funcall + advance + (cond ((and (null next) (null prev)) parent) + ((> arg 0) next) + (t prev)))) ;; For `nested', it's a bit more work: ;; Move... (if (> arg 0) -- cgit v1.2.3 From be6de56906f0d1c09a0fad4f5165d864dddbc3ee Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sun, 4 Feb 2024 19:26:42 -0800 Subject: Use treesit-node-match-p in treesit-parent-until/while * lisp/treesit.el (treesit-parent-until): Use treesit-node-match-p. (treesit-parent-while): Update docstring. * doc/lispref/parsing.texi (Retrieving Nodes): Update docstring. --- doc/lispref/parsing.texi | 17 ++++++++++------- lisp/treesit.el | 12 +++++------- 2 files changed, 15 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 5d79c4b27f4..ac11f88ae4d 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -916,8 +916,10 @@ nodes. @defun treesit-parent-until node predicate &optional include-node This function repeatedly finds the parents of @var{node}, and returns -the parent that satisfies @var{pred}, a function that takes a node as -argument and returns a boolean that indicates a match. If no parent +the parent that satisfies @var{pred}. @var{pred} can be either a +function that takes a node as argument and returns @code{t} or +@code{nil}, or a regexp matching node type names, or other valid +predicates described in @var{treesit-thing-settings}. If no parent satisfies @var{pred}, this function returns @code{nil}. Normally this function only looks at the parents of @var{node} but not @@ -927,11 +929,12 @@ function returns @var{node} if @var{node} satisfies @var{pred}. @defun treesit-parent-while node pred This function goes up the tree starting from @var{node}, and keeps -doing so as long as the nodes satisfy @var{pred}, a function that -takes a node as argument. That is, this function returns the highest -parent of @var{node} that still satisfies @var{pred}. Note that if -@var{node} satisfies @var{pred} but its immediate parent doesn't, -@var{node} itself is returned. +doing so as long as the nodes satisfy @var{pred}. That is, this +function returns the highest parent of @var{node} that still satisfies +@var{pred}. Note that if @var{node} satisfies @var{pred} but its +immediate parent doesn't, @var{node} itself is returned. + +@var{pred} is the same as in @code{treesit-parent-until} above. @end defun @defun treesit-node-top-level node &optional type diff --git a/lisp/treesit.el b/lisp/treesit.el index 93b6b56534d..f179204d89c 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -344,14 +344,13 @@ ancestor node which satisfies the predicate PRED; then it returns that ancestor node. It returns nil if no ancestor node was found that satisfies PRED. -PRED should be a function that takes one argument, the node to -examine, and returns a boolean value indicating whether that -node is a match. +PRED can be a predicate function, a regexp matching node type, +and more; see docstring of `treesit-thing-settings'. If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED." (let ((node (if include-node node (treesit-node-parent node)))) - (while (and node (not (funcall pred node))) + (while (and node (not (treesit-node-match-p node pred))) (setq node (treesit-node-parent node))) node)) @@ -364,9 +363,8 @@ no longer satisfies the predicate PRED; it returns the last examined node that satisfies PRED. If no node satisfies PRED, it returns nil. -PRED should be a function that takes one argument, the node to -examine, and returns a boolean value indicating whether that -node is a match." +PRED can be a predicate function, a regexp matching node type, +and more; see docstring of `treesit-thing-settings'." (let ((last nil)) (while (and node (funcall pred node)) (setq last node -- cgit v1.2.3 From 5c43ef86bf169a79b87bd082d2f884757f7c2efc Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Tue, 15 Aug 2023 18:51:20 -0700 Subject: Document arguments to Eshell's built-in commands * lisp/eshell/em-unix.el (eshell/ln): LINK_NAME is required. * lisp/eshell/esh-ext.el (eshell/addpath): * lisp/eshell/esh-var.el (eshell/env): Improve help strings slightly. * doc/misc/eshell.texi (Scripts): Explain $0, $1, etc. (Dollars Expansion): Use "@dots{}" instead of "...". (Built-ins, Tramp extensions, Extra built-in commands): Document command-line arguments. --- doc/misc/eshell.texi | 654 ++++++++++++++++++++++++++++++++++++------------- lisp/eshell/em-unix.el | 8 +- lisp/eshell/esh-ext.el | 6 +- lisp/eshell/esh-var.el | 2 +- 4 files changed, 497 insertions(+), 173 deletions(-) (limited to 'lisp') diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index da5e1ef1d03..5d3e5c7dbd6 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -481,72 +481,88 @@ loaded as part of the eshell-xtra module. @xref{Extension modules}. @table @code -@item . +@item . @var{file} [@var{argument}]@dots{} @cmindex . -Source an Eshell file in the current environment. This is not to be -confused with the command @command{source}, which sources a file in a -subshell environment. +Source an Eshell script named @var{file} in the current environment, +passing any @var{arguments} to the script (@pxref{Scripts}). This is +not to be confused with the command @command{source}, which sources a +file in a subshell environment. @item addpath +@itemx addpath [-b] @var{directory}@dots{} @cmindex addpath -Adds a given path or set of paths to the PATH environment variable, or, -with no arguments, prints the current paths in this variable. +Adds each specified @var{directory} to the @code{$PATH} environment +variable. By default, this adds the directories to the end of +@code{$PATH}, in the order they were passed on the command line; by +passing @code{-b} or @code{--begin}, Eshell will instead add the +directories to the beginning. + +With no directories, print the list of directories currently stored in +@code{$PATH}. @item alias +@itemx alias @var{name} [@var{command}] @cmindex alias -Define an alias (@pxref{Aliases}). This adds it to the aliases file. +Define an alias named @var{name} and expanding to @var{command}, +adding it to the aliases file (@pxref{Aliases}). If @var{command} is +omitted, delete the alias named @var{name}. With no arguments at all, +list all the currently-defined aliases. -@item basename +@item basename @var{filename} @cmindex basename -Return a file name without its directory. +Return @var{filename} without its directory. -@item cat +@item cat @var{file}@dots{} @cmindex cat -Concatenate file contents into standard output. If in a pipeline, or -if the file is not a regular file, directory, or symlink, then this -command reverts to the system's definition of @command{cat}. +Concatenate the contents of @var{file}s to standard output. If in a +pipeline, or if any of the files is not a regular file, directory, or +symlink, then this command reverts to the system's definition of +@command{cat}. @item cd +@itemx cd @var{directory} +@itemx cd -[@var{n}] +@itemx cd =[@var{regexp}] @cmindex cd -This command changes the current working directory. Usually, it is -invoked as @kbd{cd @var{dir}} where @file{@var{dir}} is the new -working directory. But @command{cd} knows about a few special -arguments: +Change the current working directory. This command can take several +forms: -@itemize @minus{} -@item -When it receives no argument at all, it changes to the home directory. +@table @code -@item -Giving the command @kbd{cd -} changes back to the previous working -directory (this is the same as @kbd{cd $-}). +@item cd +Change to the user's home directory. -@item -The command @kbd{cd =} shows the directory ring. Each line is -numbered. +@item cd @var{directory} +Change to the specified @var{directory}. -@item -With @kbd{cd =foo}, Eshell searches the directory ring for a directory -matching the regular expression @samp{foo}, and changes to that -directory. +@item cd - +Change back to the previous working directory (this is the same as +@kbd{cd $-}). -@item -With @kbd{cd -42}, you can access the directory stack slots by number. +@item cd -@var{n} +Change to the directory in the @var{nth} slot of the directory stack. + +@item cd = +Show the directory ring. Each line is numbered. + +@item cd =@var{regexp} +Search the directory ring for a directory matching the regular +expression @var{regexp} and change to that directory. + +@end table -@item @vindex eshell-cd-shows-directory @vindex eshell-list-files-after-cd If @code{eshell-cd-shows-directory} is non-@code{nil}, @command{cd} will report the directory it changes to. If @code{eshell-list-files-after-cd} is non-@code{nil}, then @command{ls} is called with any remaining arguments after changing directories. -@end itemize -@item clear +@item clear [@var{scrollback}] @cmindex clear Scrolls the contents of the Eshell window out of sight, leaving a -blank window. If provided with an optional non-@code{nil} argument, -the scrollback contents are cleared instead. +blank window. If @var{scrollback} is non-@code{nil}, the scrollback +contents are cleared instead, as with @command{clear-scrollback}. @item clear-scrollback @cmindex clear-scrollback @@ -554,21 +570,30 @@ Clear the scrollback contents of the Eshell window. Unlike the command @command{clear}, this command deletes content in the Eshell buffer. -@item compile +@item compile [-p | -i] [-m @var{mode-name}] @var{command}@dots{} @cmindex compile Run an external command, sending its output to a compilation buffer if the command would output to the screen and is not part of a pipeline -or subcommand. This is particularly useful when defining aliases, so +or subcommand. + +With the @code{-p} or @code{--plain} options, always send the output +to the Eshell buffer; similarly, with @code{-i} or +@code{--interactive}, always send the output to a compilation buffer. +You can also set the mode of the compilation buffer with @code{-m +@var{mode-name}} or @code{--mode @var{mode-name}}. + +@command{compile} is particularly useful when defining aliases, so that interactively, the output shows up in a compilation buffer, but you can still pipe the output elsewhere if desired. For example, if you have a grep-like command on your system, you might define an alias for it like so: @samp{alias mygrep 'compile --mode=grep-mode -- mygrep $*'}. -@item cp +@item cp [@var{option}@dots{}] @var{source} @var{dest} +@item cp [@var{option}@dots{}] @var{source}@dots{} @var{directory} @cmindex cp -Copy a file to a new location or copy multiple files to the same -directory. +Copy the file @var{source} to @var{dest} or @var{source} into +@var{directory}. @vindex eshell-cp-overwrite-files @vindex eshell-cp-interactive-query @@ -577,26 +602,59 @@ If @code{eshell-cp-overwrite-files} is non-@code{nil}, then @code{eshell-cp-interactive-query} is non-@code{nil}, then @command{cp} will ask before overwriting anything. -@item date +@command{cp} accepts the following options: + +@table @asis + +@item @code{-a}, @code{--archive} +Equivalent to @code{--no-dereference --preserve --recursive}. + +@item @code{-d}, @code{--no-dereference} +Don't dereference symbolic links when copying; instead, copy the link +itself. + +@item @code{-f}, @code{--force} +Never prompt for confirmation before copying a file. + +@item @code{-i}, @code{--interactive} +Prompt for confirmation before copying a file if the target already +exists. + +@item @code{-n}, @code{--preview} +Run the command, but don't copy anything. This is useful if you +want to preview what would be removed when calling @command{cp}. + +@item @code{-p}, @code{--preserve} +Attempt to preserve file attributes when copying. + +@item @code{-r}, @code{-R}, @code{--recursive} +Copy any specified directories and their contents recursively. + +@item @code{-v}, @code{--verbose} +Print the name of each file before copying it. + +@end table + +@item date [@var{specified-time} [@var{zone}]] @cmindex date Print the current local time as a human-readable string. This command -is similar to, but slightly different from, the GNU Coreutils -@command{date} command. +is an alias to the Emacs Lisp function @code{current-time-string} +(@pxref{Time of Day,,, elisp, GNU Emacs Lisp Reference Manual}). -@item diff +@item diff [@var{option}]@dots{} @var{old} @var{new} @cmindex diff -Compare files using Emacs's internal @code{diff} (not to be confused -with @code{ediff}). @xref{Comparing Files, , , emacs, The GNU Emacs -Manual}. +Compare the files @var{old} and @var{new} using Emacs's internal +@code{diff} (not to be confused with @code{ediff}). @xref{Comparing +Files, , , emacs, The GNU Emacs Manual}. @vindex eshell-plain-diff-behavior If @code{eshell-plain-diff-behavior} is non-@code{nil}, then this command does not use Emacs's internal @code{diff}. This is the same as using @samp{alias diff '*diff $@@*'}. -@item dirname +@item dirname @var{filename} @cmindex dirname -Return the directory component of a file name. +Return the directory component of @var{filename}. @item dirs @cmindex dirs @@ -604,25 +662,75 @@ Prints the directory stack. Directories can be added or removed from the stack using the commands @command{pushd} and @command{popd}, respectively. -@item du +@item du [@var{option}]@dots{} @var{file}@dots{} @cmindex du -Summarize disk usage for each file. +Summarize disk usage for each file, recursing into directories. + +@command{du} accepts the following options: + +@table @asis + +@item @code{-a}, @code{--all} +Print sizes for files, not just directories. -@item echo +@item @code{--block-size=@var{size}} +Print sizes as number of blocks of size @var{size}. + +@item @code{-b}, @code{--bytes} +Print file sizes in bytes. + +@item @code{-c}, @code{--total} +Print a grand total of the sizes at the end. + +@item @code{-d}, @code{--max-depth=@var{depth}} +Only print sizes for directories (or files with @code{--all}) that are +@var{depth} or fewer levels below the command line arguments. + +@item @code{-h}, @code{--human-readable} +Print sizes in human-readable format, with binary prefixes (so 1 KB is +1024 bytes). + +@item @code{-H}, @code{--si} +Print sizes in human-readable format, with decimal prefixes (so 1 KB +is 1000 bytes). + +@item @code{-k}, @code{--kilobytes} +Print file sizes in kilobytes (like @code{--block-size=1024}). + +@item @code{-L}, @code{--dereference} +Follow symbolic links when traversing files. + +@item @code{-m}, @code{--megabytes} +Print file sizes in megabytes (like @code{--block-size=1048576}). + +@item @code{-s}, @code{--summarize} +Don't recurse into subdirectories (like @code{--max-depth=0}). + +@item @code{-x}, @code{--one-file-system} +Skip any directories that reside on different filesystems. + +@end table + +@item echo [-n | -N] [@var{arg}]@dots{} @cmindex echo -Echoes its input. By default, this prints in a Lisp-friendly fashion -(so that the value is useful to a Lisp command using the result of -@command{echo} as an argument). If a single argument is passed, -@command{echo} prints that; if multiple arguments are passed, it -prints a list of all the arguments; otherwise, it prints the empty -string. +Prints the value of each @var{arg}. By default, this prints in a +Lisp-friendly fashion (so that the value is useful to a Lisp command +using the result of @command{echo} as an argument). If a single +argument is passed, @command{echo} prints that; if multiple arguments +are passed, it prints a list of all the arguments; otherwise, it +prints the empty string. @vindex eshell-plain-echo-behavior If @code{eshell-plain-echo-behavior} is non-@code{nil}, @command{echo} will try to behave more like a plain shell's @command{echo}, printing each argument as a string, separated by a space. -@item env +You can control whether @command{echo} outputs a trailing newline +using @code{-n} to disable the trailing newline (the default behavior) +or @code{-N} to enable it (the default when +@code{eshell-plain-echo-behavior} is non-@code{nil}). + +@item env [@var{var}=@var{value}]@dots{} [@var{command}]@dots{} @cmindex env With no arguments, print the current environment variables. If you pass arguments to this command, then @command{env} will execute the @@ -630,7 +738,7 @@ arguments as a command. If you pass any initial arguments of the form @samp{@var{var}=@var{value}}, @command{env} will first set @var{var} to @var{value} before running the command. -@item eshell-debug +@item eshell-debug [error | form | process]@dots{} @cmindex eshell-debug Toggle debugging information for Eshell itself. You can pass this command one or more of the following arguments: @@ -658,65 +766,86 @@ Exit Eshell and save the history. By default, this command kills the Eshell buffer, but if @code{eshell-kill-on-exit} is @code{nil}, then the buffer is merely buried instead. -@item export +@item export [@var{name}=@var{value}]@dots{} @cmindex export Set environment variables using input like Bash's @command{export}, as in @samp{export @var{var1}=@var{val1} @var{var2}=@var{val2} @dots{}}. -@item grep +@item grep [@var{arg}]@dots{} @cmindex grep -@itemx agrep +@itemx agrep [@var{arg}]@dots{} @cmindex agrep -@itemx egrep +@itemx egrep [@var{arg}]@dots{} @cmindex egrep -@itemx fgrep +@itemx fgrep [@var{arg}]@dots{} @cmindex fgrep -@itemx rgrep +@itemx rgrep [@var{arg}]@dots{} @cmindex rgrep -@itemx glimpse +@itemx glimpse [@var{arg}]@dots{} @cmindex glimpse The @command{grep} commands are compatible with GNU @command{grep}, -but use Emacs's internal @code{grep} instead. +but open a compilation buffer in @code{grep-mode} instead. @xref{Grep Searching, , , emacs, The GNU Emacs Manual}. @vindex eshell-plain-grep-behavior If @code{eshell-plain-grep-behavior} is non-@code{nil}, then these -commands do not use Emacs's internal @code{grep}. This is the same as -using @samp{alias grep '*grep $@@*'}, though this setting applies to -all of the built-in commands for which you would need to create a -separate alias. +commands do not use open a compilation buffer, instead printing output +to Eshell's buffer. This is the same as using @samp{alias grep '*grep +$@@*'}, though this setting applies to all of the built-in commands +for which you would need to create a separate alias. -@item history +@item history [@var{n}] +@itemx history [-arw] [@var{filename}] @cmindex history -Prints Eshell's input history. With a numeric argument @var{N}, this -command prints the @var{N} most recent items in the history. +Prints Eshell's input history. With a numeric argument @var{n}, this +command prints the @var{n} most recent items in the history. +Alternately, you can specify the following options: + +@table @asis + +@item @code{-a}, @code{--append} +Append new history items to the history file. -@item info +@item @code{-r}, @code{--read} +Read history items from the history file and append them to the +current shell's history. + +@item @code{-w}, @code{--write} +Write the current history list to the history file. + +@end table + +@item info [@var{manual} [@var{item}]@dots{}] @cmindex info -Browse the available Info documentation. This command is the same as -the external @command{info} command, but uses Emacs's internal Info -reader. -@xref{Misc Help, , , emacs, The GNU Emacs Manual}. +Browse the available Info documentation. With no arguments, browse +the top-level menu. Otherwise, show the manual for @var{manual}, +selecting the menu entry for @var{item}. + +This command is the same as the external @command{info} command, but +uses Emacs's internal Info reader. @xref{Misc Help, , , emacs, The +GNU Emacs Manual}. @item jobs @cmindex jobs List subprocesses of the Emacs process, if any, using the function @code{list-processes}. -@item kill +@item kill [-@var{signal}] [@var{pid} | @var{process}] @cmindex kill Kill processes. Takes a PID or a process object and an optional -signal specifier which can either be a number or a signal name. +@var{signal} specifier which can either be a number or a signal name. -@item listify +@item listify [@var{arg}]@dots{} @cmindex listify -Eshell version of @code{list}. Allows you to create a list using Eshell -syntax, rather than Elisp syntax. For example, @samp{listify foo bar} -and @code{("foo" "bar")} both evaluate to @code{("foo" "bar")}. +Return the arguments as a single list. With a single argument, return +it as-is if it's already a list, or otherwise wrap it in a list. With +multiple arguments, return a list of all of them. -@item ln +@item ln [@var{option}]@dots{} @var{target} [@var{link-name}] +@itemx ln [@var{option}]@dots{} @var{target}@dots{} @var{directory} @cmindex ln -Create links to files. +Create a link to the specified @var{target} named @var{link-name} or +create links to multiple @var{targets} in @var{directory}. @vindex eshell-ln-overwrite-files @vindex eshell-ln-interactive-query @@ -725,7 +854,30 @@ will overwrite files without warning. If @code{eshell-ln-interactive-query} is non-@code{nil}, then @command{ln} will ask before overwriting files. -@item locate +@command{ln} accepts the following options: + +@table @asis + +@item @code{-f}, @code{--force} +Never prompt for confirmation before linking a target. + +@item @code{-i}, @code{--interactive} +Prompt for confirmation before linking to an item if the source +already exists. + +@item @code{-n}, @code{--preview} +Run the command, but don't move anything. This is useful if you +want to preview what would be linked when calling @command{ln}. + +@item @code{-s}, @code{--symbolic} +Make symbolic links instead of hard links. + +@item @code{-v}, @code{--verbose} +Print the name of each file before linking it. + +@end table + +@item locate @var{arg}@dots{} @cmindex locate Alias to Emacs's @code{locate} function, which simply runs the external @command{locate} command and parses the results. @@ -736,51 +888,129 @@ If @code{eshell-plain-locate-behavior} is non-@code{nil}, then Emacs's internal @code{locate} is not used. This is the same as using @samp{alias locate '*locate $@@*'}. -@item ls +@item ls [@var{option}]@dots{} [@var{file}]@dots{} @cmindex ls -Lists the contents of directories. +List information about each @var{file}, including the contents of any +specified directories. If @var{file} is unspecified, list the +contents of the current directory. + +@vindex eshell-ls-initial-args +The user option @code{eshell-ls-initial-args} contains a list of +arguments to include with any call to @command{ls}. For example, you +can include the option @option{-h} to always use a more human-readable +format. @vindex eshell-ls-use-colors If @code{eshell-ls-use-colors} is non-@code{nil}, the contents of a directory is color-coded according to file type and status. These colors and the regexps used to identify their corresponding files can -be customized via @w{@kbd{M-x customize-group @key{RET} eshell-ls @key{RET}}}. +be customized via @w{@kbd{M-x customize-group @key{RET} eshell-ls +@key{RET}}}. + +@command{ls} supports the following options: + +@table @asis + +@item @code{-a}, @code{--all} +List all files, including ones starting with @samp{.}. + +@item @code{-A}, @code{--almost-all} +Like @code{--all}, but don't list the current directory (@file{.}) or +the parent directory (@file{..}). + +@item @code{-c}, @code{--by-ctime} +Sort files by last status change time, with newest files first. + +@item @code{-C} +List entries by columns. + +@item @code{-d}, @code{--directory} +List directory entries instead of their contents. + +@item @code{-h}, @code{--human-readable} +Print sizes in human-readable format, with binary prefixes (so 1 KB is +1024 bytes). + +@item @code{-H}, @code{--si} +Print sizes in human-readable format, with decimal prefixes (so 1 KB +is 1000 bytes). + +@item @code{-I@var{pattern}}, @code{--ignore=@var{pattern}} +Don't list directory entries matching @var{pattern}. + +@item @code{-k}, @code{--kilobytes} +Print sizes as 1024-byte kilobytes. @vindex eshell-ls-date-format -The user option @code{eshell-ls-date-format} determines how the date -is displayed when using the @option{-l} option. The date is produced -using the function @code{format-time-string} (@pxref{Time Parsing,,, -elisp, GNU Emacs Lisp Reference Manual}). +@item @code{-l} +Use a long listing format showing details for each file. The user +option @code{eshell-ls-date-format} determines how the date is +displayed when using this option. The date is produced using the +function @code{format-time-string} (@pxref{Time Parsing,,, elisp, GNU +Emacs Lisp Reference Manual}). -@vindex eshell-ls-initial-args -The user option @code{eshell-ls-initial-args} contains a list of -arguments to include with any call to @command{ls}. For example, you -can include the option @option{-h} to always use a more human-readable -format. +@item @code{-L}, @code{--dereference} +Follow symbolic links when listing entries. + +@item @code{-n}, @code{--numeric-uid-gid} +Show UIDs and GIDs numerically, instead of using their names. + +@item @code{-r}, @code{--reverse} +Reverse order when sorting. + +@item @code{-R}, @code{--recursive} +List subdirectories recursively. + +@item @code{-s}, @code{--size} +Show the size of each file in blocks. @vindex eshell-ls-default-blocksize -The user option @code{eshell-ls-default-blocksize} determines the -default blocksize used when displaying file sizes with the option -@option{-s}. +@item @code{-S} +Sort by file size, with largest files first. The user option +@code{eshell-ls-default-blocksize} determines the default blocksize +used when displaying file sizes with this option. + +@item @code{-t} +Sort by modification time, with newest files first. -@item make +@item @code{-u} +Sort by last access time, with newest files first. + +@item @code{-U} +Do not sort results. Instead, list entries in their directory order. + +@item @code{-x} +List entries by lines instead of by columns. + +@item @code{-X} +Sort alphabetically by file extension. + +@item @code{-1} +List one file per line. + +@end table + +@item make [@var{arg}]@dots{} @cmindex make Run @command{make} through @code{compile} when run asynchronously (e.g., @samp{make &}). @xref{Compilation, , , emacs, The GNU Emacs Manual}. Otherwise call the external @command{make} command. -@item man +@item man [@var{arg}]@dots{} @cmindex man Display Man pages using the Emacs @code{man} command. @xref{Man Page, , , emacs, The GNU Emacs Manual}. -@item mkdir +@item mkdir [-p] @var{directory}@dots{} @cmindex mkdir -Make new directories. +Make new directories. With @code{-p} or @code{--parents}, +automatically make any necessary parent directories as well. -@item mv +@item mv [@var{option}]@dots{} @var{source} @var{dest} +@itemx mv [@var{option}]@dots{} @var{source}@dots{} @var{directory} @cmindex mv -Move or rename files. +Rename the file @var{source} to @var{dest} or move @var{source} into +@var{directory}. @vindex eshell-mv-overwrite-files @vindex eshell-mv-interactive-query @@ -789,40 +1019,93 @@ will overwrite files without warning. If @code{eshell-mv-interactive-query} is non-@code{nil}, @command{mv} will prompt before overwriting anything. -@item occur +@command{mv} accepts the following options: + +@table @asis + +@item @code{-f}, @code{--force} +Never prompt for confirmation before moving an item. + +@item @code{-i}, @code{--interactive} +Prompt for confirmation before moving an item if the target already +exists. + +@item @code{-n}, @code{--preview} +Run the command, but don't move anything. This is useful if you +want to preview what would be moved when calling @command{mv}. + +@item @code{-v}, @code{--verbose} +Print the name of each item before moving it. + +@end table + +@item occur @var{regexp} [@var{nlines}] @cmindex occur Alias to Emacs's @code{occur}. @xref{Other Repeating Search, , , emacs, The GNU Emacs Manual}. @item popd +@item popd +@var{n} @cmindex popd Pop a directory from the directory stack and switch to a another place -in the stack. +in the stack. This command can take the following forms: -@item printnl +@table @code + +@item popd +Remove the current directory from the directory stack and change to +the directory beneath it. + +@item popd +@var{n} +Remove the current directory from the directory stack and change to +the @var{nth} directory in the stack (counting from zero). + +@end table + +@item printnl [@var{arg}]@dots{} @cmindex printnl -Print the arguments separated by newlines. +Print all the @var{arg}s separated by newlines. @item pushd +@itemx pushd @var{directory} +@itemx pushd +@var{n} @cmindex pushd Push the current directory onto the directory stack, then change to -another directory. +another directory. This command can take the following forms: + +@table @code + +@vindex eshell-pushd-tohome +@item pushd +Swap the current directory with the directory on the top of the stack. +If @code{eshell-pushd-tohome} is non-@code{nil}, push the current +directory onto the stack and change to the user's home directory (like +@samp{pushd ~}). @vindex eshell-pushd-dunique +@item pushd @var{directory} +Push the current directory onto the stack and change to +@var{directory}. If @code{eshell-pushd-dunique} is non-@code{nil}, +then only unique directories will be added to the stack. + @vindex eshell-pushd-dextract -If @code{eshell-pushd-dunique} is non-@code{nil}, then only unique -directories will be added to the stack. If -@code{eshell-pushd-dextract} is non-@code{nil}, then @samp{pushd -+@var{n}} will pop the @var{n}th directory to the top of the stack. +@item pushd +@var{n} +Change to the @var{nth} directory in the directory stack (counting +from zero), and ``rotate'' the stack by moving any elements before the +@var{nth} to the bottom. If @code{eshell-pushd-dextract} is +non-@code{nil}, then @samp{pushd +@var{n}} will instead pop the +@var{n}th directory to the top of the stack. + +@end table @item pwd @cmindex pwd Prints the current working directory. -@item rm +@item rm [@var{option}]@dots{} @var{item}@dots{} @cmindex rm Removes files, buffers, processes, or Emacs Lisp symbols, depending on -the argument. +the type of each @var{item}. @vindex eshell-rm-interactive-query @vindex eshell-rm-removes-directories @@ -832,56 +1115,84 @@ will prompt before removing anything. If @command{rm} can also remove directories. Otherwise, @command{rmdir} is required. -@item rmdir +@command{rm} accepts the following options: + +@table @asis + +@item @code{-f}, @code{--force} +Never prompt for confirmation before removing an item. + +@item @code{-i}, @code{--interactive} +Prompt for confirmation before removing each item. + +@item @code{-n}, @code{--preview} +Run the command, but don't remove anything. This is useful if you +want to preview what would be removed when calling @command{rm}. + +@item @code{-r}, @code{-R}, @code{--recursive} +Remove any specified directories and their contents recursively. + +@item @code{-v}, @code{--verbose} +Print the name of each item before removing it. + +@end table + +@item rmdir @var{directory}@dots{} @cmindex rmdir Removes directories if they are empty. -@item set +@item set [@var{var} @var{value}]@dots{} @cmindex set Set variable values, using the function @code{set} like a command (@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}). -A variable name can be a symbol, in which case it refers to a Lisp -variable, or a string, referring to an environment variable +The value of @var{var} can be a symbol, in which case it refers to a +Lisp variable, or a string, referring to an environment variable (@pxref{Arguments}). -@item setq +@item setq [@var{symbol} @var{value}]@dots{} @cmindex setq Set variable values, using the function @code{setq} like a command (@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}). -@item source +@item source @var{file} [@var{argument}]@dots{} @cmindex source -Source an Eshell file in a subshell environment. This is not to be -confused with the command @command{.}, which sources a file in the -current environment. +Source an Eshell script named @var{file} in a subshell environment, +passing any @var{argument}s to the script (@pxref{Scripts}). This is +not to be confused with the command @command{.}, which sources a file +in the current environment. -@item time +@item time @var{command}@dots{} @cmindex time -Show the time elapsed during a command's execution. +Show the time elapsed during the execution of @var{command}. -@item umask +@item umask [-S] +@itemx umask @var{mode} @cmindex umask -Set or view the default file permissions for newly created files and -directories. +View the default file permissions for newly created files and +directories. If you pass @code{-S} or @code{--symbolic}, view the +mode symbolically. With @var{mode}, set the default permissions to +this value. -@item unset +@item unset [@var{var}]@dots{} @cmindex unset -Unset one or more variables. As with @command{set}, a variable name -can be a symbol, in which case it refers to a Lisp variable, or a -string, referring to an environment variable. +Unset one or more variables. As with @command{set}, the value of +@var{var} can be a symbol, in which case it refers to a Lisp variable, +or a string, referring to an environment variable. -@item wait +@item wait [@var{process}]@dots{} @cmindex wait -Wait until a process has successfully completed. +Wait until each specified @var{process} has exited. -@item which +@item which @var{command}@dots{} @cmindex which -Identify a command and its location. +For each @var{command}, identify what kind of command it is and its +location. @item whoami @cmindex whoami -Print the current user. This Eshell version of @command{whoami} -supports Tramp. +Print the current user. This Eshell version of @command{whoami} is +connection-aware, so for remote directories, it will print the user +associated with that connection. @end table @subsection Defining new built-in commands @@ -1353,6 +1664,11 @@ sequence of commands, as with almost any other shell script. Scripts are invoked from Eshell with @command{source}, or from anywhere in Emacs with @code{eshell-source-file}. +Like with aliases (@pxref{Aliases}), Eshell scripts can accept any +number of arguments. Within the script, you can refer to these with +the special variables @code{$0}, @code{$1}, @dots{}, @code{$9}, and +@code{$*}. + @cmindex . If you wish to load a script into your @emph{current} environment, rather than in a subshell, use the @code{.} command. @@ -1452,7 +1768,7 @@ As with @samp{$@{@var{command}@}}, evaluates the Eshell command invocation @command{@var{command}}, but writes the output to a temporary file and returns the file name. -@item $@var{expr}[@var{i...}] +@item $@var{expr}[@var{i@dots{}}] Expands to the @var{i}th element of the result of @var{expr}, an expression in one of the above forms listed here. If multiple indices are supplied, this will return a list containing the elements for each @@ -1501,7 +1817,7 @@ Multiple sets of indices can also be specified. For example, if expand to @code{2}, i.e.@: the second element of the first list member (all indices are zero-based). -@item $@var{expr}[@var{regexp} @var{i...}] +@item $@var{expr}[@var{regexp} @var{i@dots{}}] As above (when @var{expr} expands to a string), but use @var{regexp} to split the string. @var{regexp} can be any form other than a number. For example, @samp{$@var{var}[: 0]} will return the first @@ -2275,15 +2591,23 @@ external commands. To enable it, add @code{eshell-tramp} to @table @code -@item su +@item su [- | -l] [@var{user}] @cmindex su -@itemx sudo +Uses TRAMP's @command{su} method (@pxref{Inline methods, , , tramp, +The Tramp Manual}) to change the current user to @var{user} (or root +if unspecified). With @code{-}, @code{-l}, or @code{--login}, provide +a login environment. + +@item sudo [-u @var{user}] [-s | @var{command}@dots{}] @cmindex sudo -@itemx doas +@itemx doas [-u @var{user}] [-s | @var{command}@dots{}] @cmindex doas -Uses TRAMP's @command{su}, @command{sudo}, or @command{doas} method -(@pxref{Inline methods, , , tramp, The Tramp Manual}) to run a command -via @command{su}, @command{sudo}, or @command{doas}. +Uses TRAMP's @command{sudo} or @command{doas} method (@pxref{Inline +methods, , , tramp, The Tramp Manual}) to run @var{command} as root +via @command{sudo} or @command{doas}. When specifying @code{-u +@var{user}} or @code{--user @var{user}}, run the command as @var{user} +instead. With @code{-s} or @code{--shell}, start a shell instead of +running @var{command}. @end table @@ -2296,58 +2620,58 @@ add @code{eshell-xtra} to @code{eshell-modules-list}. @table @code -@item count +@item count @var{item} @var{seq} [@var{option}]@dots{} @cmindex count A wrapper around the function @code{cl-count} (@pxref{Searching Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item expr +@item expr @var{str} [@var{separator}] [@var{arg}]@dots{} @cmindex expr An implementation of @command{expr} using the Calc package. @xref{Top,,, calc, The GNU Emacs Calculator}. -@item ff +@item ff @var{directory} @var{pattern} @cmindex ff Shorthand for the the function @code{find-name-dired} (@pxref{Dired and Find, , , emacs, The Emacs Editor}). -@item gf +@item gf @var{directory} @var{regexp} @cmindex gf Shorthand for the the function @code{find-grep-dired} (@pxref{Dired and Find, , , emacs, The Emacs Editor}). -@item intersection +@item intersection @var{list1} @var{list2} [@var{option}]@dots{} @cmindex intersection A wrapper around the function @code{cl-intersection} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item mismatch +@item mismatch @var{seq1} @var{seq2} [@var{option}]@dots{} @cmindex mismatch A wrapper around the function @code{cl-mismatch} (@pxref{Searching Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item set-difference +@item set-difference @var{list1} @var{list2} [@var{option}]@dots{} @cmindex set-difference A wrapper around the function @code{cl-set-difference} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item set-exclusive-or +@item set-exclusive-or @var{list1} @var{list2} [@var{option}]@dots{} @cmindex set-exclusive-or A wrapper around the function @code{cl-set-exclusive-or} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item substitute +@item substitute @var{new} @var{old} @var{seq} [@var{option}]@dots{} @cmindex substitute A wrapper around the function @code{cl-substitute} (@pxref{Sequence Functions,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item union +@item union @var{list1} @var{list2} [@var{option}]@dots{} @cmindex union A wrapper around the function @code{cl-union} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 78dfd0654e2..23028576f45 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -618,11 +618,11 @@ Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.") :preserve-args :external "ln" :show-usage - :usage "[OPTION]... TARGET [LINK_NAME] + :usage "[OPTION]... TARGET LINK_NAME or: ln [OPTION]... TARGET... DIRECTORY -Create a link to the specified TARGET with optional LINK_NAME. If there is -more than one TARGET, the last argument must be a directory; create links -in DIRECTORY to each TARGET. Create hard links by default, symbolic links +Create a link to the specified TARGET with LINK_NAME. If there is more +than one TARGET, the last argument must be a directory; create links in +DIRECTORY to each TARGET. Create hard links by default, symbolic links with `--symbolic'. When creating hard links, each TARGET must exist.") (let ((no-dereference t)) (eshell-mvcpln-template "ln" "linking" diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index dc2b93e574b..44861c222b8 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -253,10 +253,10 @@ An external command simply means external to Emacs." "Add a set of paths to PATH." (eshell-eval-using-options "addpath" args - '((?b "begin" nil prepend "add path element at beginning") + '((?b "begin" nil prepend "add to beginning of $PATH") (?h "help" nil nil "display this usage message") - :usage "[-b] PATH -Adds the given PATH to $PATH.") + :usage "[-b] DIR... +Adds the given DIR to $PATH.") (let ((path (eshell-get-path t))) (if args (progn diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 537bc4b0641..02b5c785625 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -433,7 +433,7 @@ the values of nil for each." (?h "help" nil nil "show this usage screen") :external "env" :parse-leading-options-only - :usage "[NAME=VALUE]... [COMMAND [ARG]...]") + :usage "[NAME=VALUE]... [COMMAND]...") (if args (or (eshell-parse-local-variables args) (eshell-named-command (car args) (cdr args))) -- cgit v1.2.3 From 7756e9c73611c25002a90194b4a32c23051cb234 Mon Sep 17 00:00:00 2001 From: Xi Lu Date: Thu, 23 Feb 2023 20:58:00 +0800 Subject: filesets: Safely invoke `shell-command*' functions * lisp/filesets.el: (filesets-select-command, filesets-quote): Remove unused functions. (filesets-external-viewers): Remove old comments. (filesets-which-command, filesets-get-quoted-selection) (filesets-spawn-external-viewer): Use `shell-quote-argument'. (Bug#61709) --- lisp/filesets.el | 40 +++++++++------------------------------- 1 file changed, 9 insertions(+), 31 deletions(-) (limited to 'lisp') diff --git a/lisp/filesets.el b/lisp/filesets.el index 4e2de8fed1b..bc113b80e07 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -161,18 +161,9 @@ COND-FN takes one argument: the current element." (define-obsolete-function-alias 'filesets-member #'cl-member "28.1") (define-obsolete-function-alias 'filesets-sublist #'seq-subseq "28.1") -(defun filesets-select-command (cmd-list) - "Select one command from CMD-LIST -- a string with space separated names." - (let ((this (shell-command-to-string - (format "which --skip-alias %s 2> %s | head -n 1" - cmd-list null-device)))) - (if (equal this "") - nil - (file-name-nondirectory (substring this 0 (- (length this) 1)))))) - (defun filesets-which-command (cmd) "Call \"which CMD\"." - (shell-command-to-string (format "which %s" cmd))) + (shell-command-to-string (format "which %s" (shell-quote-argument cmd)))) (defun filesets-which-command-p (cmd) "Call \"which CMD\" and return non-nil if the command was found." @@ -547,16 +538,6 @@ the filename." (defcustom filesets-external-viewers (let - ;; ((ps-cmd (or (and (boundp 'my-ps-viewer) my-ps-viewer) - ;; (filesets-select-command "ggv gv"))) - ;; (pdf-cmd (or (and (boundp 'my-ps-viewer) my-pdf-viewer) - ;; (filesets-select-command "xpdf acroread"))) - ;; (dvi-cmd (or (and (boundp 'my-ps-viewer) my-dvi-viewer) - ;; (filesets-select-command "xdvi tkdvi"))) - ;; (doc-cmd (or (and (boundp 'my-ps-viewer) my-doc-viewer) - ;; (filesets-select-command "antiword"))) - ;; (pic-cmd (or (and (boundp 'my-ps-viewer) my-pic-viewer) - ;; (filesets-select-command "gqview ee display")))) ((ps-cmd "ggv") (pdf-cmd "xpdf") (dvi-cmd "xdvi") @@ -1084,10 +1065,6 @@ Return full path if FULL-FLAG is non-nil." (t (error "Filesets: %s does not exist" dir)))) -(defun filesets-quote (txt) - "Return TXT in quotes." - (concat "\"" txt "\"")) - (defun filesets-get-selection () "Get the text between mark and point -- i.e. the selection or region." (let ((m (mark)) @@ -1098,7 +1075,7 @@ Return full path if FULL-FLAG is non-nil." (defun filesets-get-quoted-selection () "Return the currently selected text in quotes." - (filesets-quote (filesets-get-selection))) + (shell-quote-argument (filesets-get-selection))) (defun filesets-get-shortcut (n) "Create menu shortcuts based on number N." @@ -1245,12 +1222,13 @@ Use the viewer defined in EV-ENTRY (a valid element of (if fmt (mapconcat (lambda (this) - (if (stringp this) (format this file) - (format "%S" (if (functionp this) - (funcall this) - this)))) + (if (stringp this) + (format this (shell-quote-argument file)) + (shell-quote-argument (if (functionp this) + (funcall this) + this)))) fmt "") - (format "%S" file)))) + (shell-quote-argument file)))) (output (cond ((and (functionp vwr) co-flag) @@ -1259,7 +1237,7 @@ Use the viewer defined in EV-ENTRY (a valid element of (funcall vwr file) nil) (co-flag - (shell-command-to-string (format "%s %s" vwr args))) + (shell-command-to-string (format "%s %s" vwr args))) (t (shell-command (format "%s %s&" vwr args)) nil)))) -- cgit v1.2.3 From ea53a26d03da8d03652696939431b3a7e63053d7 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 5 Feb 2024 08:30:31 +0100 Subject: ; Fix last change * lisp/filesets.el (filesets-quote): Resurrect as obsolete alias for 'shell-quote-argument'. --- lisp/filesets.el | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lisp') diff --git a/lisp/filesets.el b/lisp/filesets.el index bc113b80e07..68133ba2255 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -2461,11 +2461,15 @@ Set up hooks, load the cache file -- if existing -- and build the menu." (setq filesets-menu-use-cached-flag t))) (filesets-build-menu))) +;;; obsolete + (defun filesets-error (_class &rest args) "`error' wrapper." (declare (obsolete error "28.1")) (error "%s" (mapconcat #'identity args " "))) +(define-obsolete-function-alias 'filesets-quote #'shell-quote-argument "30.1") + (provide 'filesets) ;;; filesets.el ends here -- cgit v1.2.3 From c7539a363b8b109d24457aaeb60fb51bd0a03e4f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 5 Feb 2024 12:54:03 +0100 Subject: Fix stale cache in Tramp * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Flush file properties in time. (Bug#68805) --- lisp/net/tramp-sh.el | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 7656da81dcc..68ee541bee6 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2009,7 +2009,7 @@ ID-FORMAT valid values are `string' and `integer'." #'copy-directory (list dirname newname keep-date parents copy-contents)))) - ;; When newname did exist, we have wrong cached values. + ;; NEWNAME has wrong cached values. (when t2 (with-parsed-tramp-file-name (expand-file-name newname) nil (tramp-flush-file-properties v localname))))))) @@ -2148,24 +2148,24 @@ file names." ;; One of them must be a Tramp file. (error "Tramp implementation says this cannot happen"))) - ;; Handle `preserve-extended-attributes'. We ignore - ;; possible errors, because ACL strings could be - ;; incompatible. - (when-let ((attributes (and preserve-extended-attributes - (file-extended-attributes filename)))) - (ignore-errors - (set-file-extended-attributes newname attributes))) - ;; In case of `rename', we must flush the cache of the source file. (when (and t1 (eq op 'rename)) (with-parsed-tramp-file-name filename v1 (tramp-flush-file-properties v1 v1-localname))) - ;; When newname did exist, we have wrong cached values. + ;; NEWNAME has wrong cached values. (when t2 (with-parsed-tramp-file-name newname v2 (tramp-flush-file-properties v2 v2-localname))) + ;; Handle `preserve-extended-attributes'. We ignore + ;; possible errors, because ACL strings could be + ;; incompatible. + (when-let ((attributes (and preserve-extended-attributes + (file-extended-attributes filename)))) + (ignore-errors + (set-file-extended-attributes newname attributes))) + ;; KEEP-DATE handling. (when (and keep-date (not copy-keep-date)) (tramp-compat-set-file-times @@ -2437,7 +2437,7 @@ The method used must be an out-of-band method." copy-program (tramp-get-method-parameter v 'tramp-copy-program) copy-args ;; " " has either been a replacement of "%k" (when - ;; keep-date argument is non-nil), or a replacement for + ;; KEEP-DATE argument is non-nil), or a replacement for ;; the whole keep-date sublist. (delete " " (apply #'tramp-expand-args v 'tramp-copy-args spec)) ;; `tramp-ssh-controlmaster-options' is a string instead @@ -5353,7 +5353,7 @@ connection if a previous connection has died for some reason." "2>" (tramp-get-remote-null-device previous-hop)) ?l (concat remote-shell " " extra-args " -i")) ;; A restricted shell does not allow "exec". - (when r-shell '("&&" "exit")) '("||" "exit")) + (when r-shell '("&&" "exit")) '("||" "exit")) " ")) ;; Send the command. -- cgit v1.2.3 From edf61edfd6f04ab97785dca92fc68e8e5783586e Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 5 Feb 2024 12:54:56 +0100 Subject: Adapt cache handling in Tramp * lisp/net/tramp-cache.el (with-tramp-saved-file-property) (with-tramp-saved-file-properties) (with-tramp-saved-connection-property) (with-tramp-saved-connection-properties): Do not change KEY destructively. --- lisp/net/tramp-cache.el | 105 ++++++++++++++++++++++-------------------------- 1 file changed, 47 insertions(+), 58 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 25123a6e282..225a26ad1cd 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -144,7 +144,6 @@ If KEY is `tramp-cache-undefined', don't create anything, and return nil." (defun tramp-get-file-property (key file property &optional default) "Get the PROPERTY of FILE from the cache context of KEY. Return DEFAULT if not set." - ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) (if (eq key tramp-cache-undefined) default (let* ((hash (tramp-get-hash-table key)) @@ -191,7 +190,6 @@ Return DEFAULT if not set." (defun tramp-set-file-property (key file property value) "Set the PROPERTY of FILE to VALUE, in the cache context of KEY. Return VALUE." - ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) (if (eq key tramp-cache-undefined) value (let ((hash (tramp-get-hash-table key))) @@ -224,7 +222,6 @@ Return VALUE." ;;;###tramp-autoload (defun tramp-flush-file-property (key file property) "Remove PROPERTY of FILE in the cache context of KEY." - ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) (unless (eq key tramp-cache-undefined) (remhash property (tramp-get-hash-table key)) @@ -239,7 +236,6 @@ Return VALUE." ;; `file-name-directory' can return nil, for example for "~". (when-let ((file (file-name-directory file)) (file (directory-file-name file))) - ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) (unless (eq key tramp-cache-undefined) (dolist (property (hash-table-keys (tramp-get-hash-table key))) @@ -254,7 +250,6 @@ Return VALUE." (defun tramp-flush-file-properties (key file) "Remove all properties of FILE in the cache context of KEY." (let ((truename (tramp-get-file-property key file "file-truename"))) - ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) (unless (eq key tramp-cache-undefined) (tramp-message key 8 "%s" (tramp-file-name-localname key)) @@ -338,17 +333,15 @@ FILE must be a local file name on a connection identified via KEY." "Save PROPERTY, run BODY, reset PROPERTY. Preserve timestamps." (declare (indent 3) (debug t)) - `(progn - ;; Unify localname. Remove hop from `tramp-file-name' structure. - (setf ,key (tramp-file-name-unify ,key ,file)) - (let* ((hash (tramp-get-hash-table ,key)) - (cached (and (hash-table-p hash) (gethash ,property hash)))) - (unwind-protect (progn ,@body) - ;; Reset PROPERTY. Recompute hash, it could have been flushed. - (setq hash (tramp-get-hash-table ,key)) - (if (consp cached) - (puthash ,property cached hash) - (remhash ,property hash)))))) + `(let* ((key (tramp-file-name-unify ,key ,file)) + (hash (tramp-get-hash-table key)) + (cached (and (hash-table-p hash) (gethash ,property hash)))) + (unwind-protect (progn ,@body) + ;; Reset PROPERTY. Recompute hash, it could have been flushed. + (setq hash (tramp-get-hash-table key)) + (if (consp cached) + (puthash ,property cached hash) + (remhash ,property hash))))) ;;;###tramp-autoload (defmacro with-tramp-saved-file-properties (key file properties &rest body) @@ -356,22 +349,20 @@ Preserve timestamps." PROPERTIES is a list of file properties (strings). Preserve timestamps." (declare (indent 3) (debug t)) - `(progn - ;; Unify localname. Remove hop from `tramp-file-name' structure. - (setf ,key (tramp-file-name-unify ,key ,file)) - (let* ((hash (tramp-get-hash-table ,key)) - (values - (and (hash-table-p hash) - (mapcar - (lambda (property) (cons property (gethash property hash))) - ,properties)))) - (unwind-protect (progn ,@body) - ;; Reset PROPERTIES. Recompute hash, it could have been flushed. - (setq hash (tramp-get-hash-table ,key)) - (dolist (value values) - (if (consp (cdr value)) - (puthash (car value) (cdr value) hash) - (remhash (car value) hash))))))) + `(let* ((key (tramp-file-name-unify ,key ,file)) + (hash (tramp-get-hash-table key)) + (values + (and (hash-table-p hash) + (mapcar + (lambda (property) (cons property (gethash property hash))) + ,properties)))) + (unwind-protect (progn ,@body) + ;; Reset PROPERTIES. Recompute hash, it could have been flushed. + (setq hash (tramp-get-hash-table key)) + (dolist (value values) + (if (consp (cdr value)) + (puthash (car value) (cdr value) hash) + (remhash (car value) hash)))))) ;;; -- Properties -- @@ -473,38 +464,36 @@ used to cache connection properties of the local machine." (defmacro with-tramp-saved-connection-property (key property &rest body) "Save PROPERTY, run BODY, reset PROPERTY." (declare (indent 2) (debug t)) - `(progn - (setf ,key (tramp-file-name-unify ,key)) - (let* ((hash (tramp-get-hash-table ,key)) - (cached (and (hash-table-p hash) - (gethash ,property hash tramp-cache-undefined)))) - (unwind-protect (progn ,@body) - ;; Reset PROPERTY. Recompute hash, it could have been flushed. - (setq hash (tramp-get-hash-table ,key)) - (if (not (eq cached tramp-cache-undefined)) - (puthash ,property cached hash) - (remhash ,property hash)))))) + `(let* ((key (tramp-file-name-unify ,key)) + (hash (tramp-get-hash-table key)) + (cached (and (hash-table-p hash) + (gethash ,property hash tramp-cache-undefined)))) + (unwind-protect (progn ,@body) + ;; Reset PROPERTY. Recompute hash, it could have been flushed. + (setq hash (tramp-get-hash-table key)) + (if (not (eq cached tramp-cache-undefined)) + (puthash ,property cached hash) + (remhash ,property hash))))) ;;;###tramp-autoload (defmacro with-tramp-saved-connection-properties (key properties &rest body) "Save PROPERTIES, run BODY, reset PROPERTIES. PROPERTIES is a list of file properties (strings)." (declare (indent 2) (debug t)) - `(progn - (setf ,key (tramp-file-name-unify ,key)) - (let* ((hash (tramp-get-hash-table ,key)) - (values - (mapcar - (lambda (property) - (cons property (gethash property hash tramp-cache-undefined))) - ,properties))) - (unwind-protect (progn ,@body) - ;; Reset PROPERTIES. Recompute hash, it could have been flushed. - (setq hash (tramp-get-hash-table ,key)) - (dolist (value values) - (if (not (eq (cdr value) tramp-cache-undefined)) - (puthash (car value) (cdr value) hash) - (remhash (car value) hash))))))) + `(let* ((key (tramp-file-name-unify ,key)) + (hash (tramp-get-hash-table key)) + (values + (mapcar + (lambda (property) + (cons property (gethash property hash tramp-cache-undefined))) + ,properties))) + (unwind-protect (progn ,@body) + ;; Reset PROPERTIES. Recompute hash, it could have been flushed. + (setq hash (tramp-get-hash-table key)) + (dolist (value values) + (if (not (eq (cdr value) tramp-cache-undefined)) + (puthash (car value) (cdr value) hash) + (remhash (car value) hash)))))) ;;;###tramp-autoload (defun tramp-cache-print (table) -- cgit v1.2.3 From dbc5fafa311823f3a78d4ad5a395e4d87d31d9bd Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 5 Feb 2024 12:55:27 +0100 Subject: * lisp/net/tramp.el (tramp-local-host-regexp): Adapt :version. --- lisp/net/tramp-archive.el | 4 ++-- lisp/net/tramp-compat.el | 2 +- lisp/net/tramp.el | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 298cacdb0e0..752462d8fa3 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -389,7 +389,7 @@ arguments to pass to the OPERATION." "Add archive file name handler to `file-name-handler-alist'." (when (and tramp-archive-enabled (not - (rassq 'tramp-archive-file-name-handler file-name-handler-alist))) + (rassq #'tramp-archive-file-name-handler file-name-handler-alist))) (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) #'tramp-archive-autoload-file-name-handler)) @@ -443,7 +443,7 @@ arguments to pass to the OPERATION." (and (tramp-archive-file-name-p name) (match-string 2 name))) -(defvar tramp-archive-hash (make-hash-table :test 'equal) +(defvar tramp-archive-hash (make-hash-table :test #'equal) "Hash table for archive local copies. The hash key is the archive name. The value is a cons of the used `tramp-file-name' structure for tramp-gvfs, and the file diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 87b20b982f9..061766090a0 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -309,7 +309,7 @@ Also see `ignore'." ;; Macro `connection-local-p' is new in Emacs 30.1. (if (macrop 'connection-local-p) - (defalias 'tramp-compat-connection-local-p #'connection-local-p) + (defalias 'tramp-compat-connection-local-p 'connection-local-p) (defmacro tramp-compat-connection-local-p (variable) "Non-nil if VARIABLE has a connection-local binding in `default-directory'." `(let (connection-local-variables-alist file-local-variables-alist) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 7800efc2a5e..8e114912527 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -557,7 +557,7 @@ host runs a restricted shell, it shall be added to this list, too." eos) "Host names which are regarded as local host. If the local host runs a chrooted environment, set this to nil." - :version "30.1" + :version "29.3" :type '(choice (const :tag "Chrooted environment" nil) (regexp :tag "Host regexp"))) -- cgit v1.2.3 From 95c8bfb11ec82e67652e5903495c1fcb5c61ace2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 5 Feb 2024 10:13:56 -0500 Subject: (edebug-signal): Simplify Also, prefer #' to quote function names. * lisp/emacs-lisp/edebug.el (edebug-signal): Instead of re-signaling the error, let `signal_or_quit` continue processing it. --- lisp/emacs-lisp/edebug.el | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index a8a51502503..4c7dbb4ef8c 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -481,7 +481,7 @@ just FUNCTION is printed." (edebug--eval-defun #'eval-defun edebug-it))) ;;;###autoload -(defalias 'edebug-defun 'edebug-eval-top-level-form) +(defalias 'edebug-defun #'edebug-eval-top-level-form) ;;;###autoload (defun edebug-eval-top-level-form () @@ -1729,7 +1729,7 @@ contains a circular object." (defun edebug-match-form (cursor) (list (edebug-form cursor))) -(defalias 'edebug-match-place 'edebug-match-form) +(defalias 'edebug-match-place #'edebug-match-form) ;; Currently identical to edebug-match-form. ;; This is for common lisp setf-style place arguments. @@ -2277,12 +2277,7 @@ only be active while Edebug is. It checks `debug-on-error' to see whether it should call the debugger. When execution is resumed, the error is signaled again." (if (and (listp debug-on-error) (memq signal-name debug-on-error)) - (edebug 'error (cons signal-name signal-data))) - ;; If we reach here without another non-local exit, then send signal again. - ;; i.e. the signal is not continuable, yet. - ;; Avoid infinite recursion. - (let ((signal-hook-function nil)) - (signal signal-name signal-data))) + (edebug 'error (cons signal-name signal-data)))) ;;; Entering Edebug @@ -2326,6 +2321,12 @@ and run its entry function, and set up `edebug-before' and (debug-on-error (or debug-on-error edebug-on-error)) (debug-on-quit edebug-on-quit)) (unwind-protect + ;; FIXME: We could replace this `signal-hook-function' with + ;; a cleaner `handler-bind' but then we wouldn't be able to + ;; install it here (i.e. once and for all when entering + ;; an Edebugged function), but instead it would have to + ;; be installed into a modified `edebug-after' which wraps + ;; the `handler-bind' around its argument(s). :-( (let ((signal-hook-function #'edebug-signal)) (setq edebug-execution-mode (or edebug-next-execution-mode edebug-initial-mode @@ -3348,7 +3349,7 @@ With prefix argument, make it a temporary breakpoint." (message "%s" msg))) -(defalias 'edebug-step-through-mode 'edebug-step-mode) +(defalias 'edebug-step-through-mode #'edebug-step-mode) (defun edebug-step-mode () "Proceed to next stop point." @@ -3836,12 +3837,12 @@ be installed in `emacs-lisp-mode-map'.") ;; Global GUD bindings for all emacs-lisp-mode buffers. (unless edebug-inhibit-emacs-lisp-mode-bindings - (define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode) - (define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode) - (define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode) - (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where) + (define-key emacs-lisp-mode-map "\C-x\C-a\C-s" #'edebug-step-mode) + (define-key emacs-lisp-mode-map "\C-x\C-a\C-n" #'edebug-next-mode) + (define-key emacs-lisp-mode-map "\C-x\C-a\C-c" #'edebug-go-mode) + (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" #'edebug-where) ;; The following isn't a GUD binding. - (define-key emacs-lisp-mode-map "\C-x\C-a\C-m" 'edebug-set-initial-mode)) + (define-key emacs-lisp-mode-map "\C-x\C-a\C-m" #'edebug-set-initial-mode)) (defvar-keymap edebug-mode-map :parent emacs-lisp-mode-map -- cgit v1.2.3 From 5e69376292994ffe69b7f8f52ae1ad85c60c2d29 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 5 Feb 2024 17:56:11 +0100 Subject: Grudgingly accept function values in the function position * lisp/emacs-lisp/cconv.el (cconv-convert): Warn about (F ...) where F is a non-symbol function value (bytecode object etc), but let it pass for compatibility's sake (bug#68931). * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp--fun-value-as-head): New test. --- lisp/emacs-lisp/cconv.el | 12 ++++++++---- test/lisp/emacs-lisp/bytecomp-tests.el | 16 ++++++++++++++++ 2 files changed, 24 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index e210cfdf5ce..4ff47971351 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -621,12 +621,16 @@ places where they originally did not directly appear." (cconv-convert exp env extend)) (`(,func . ,forms) - (if (symbolp func) + (if (or (symbolp func) (functionp func)) ;; First element is function or whatever function-like forms are: ;; or, and, if, catch, progn, prog1, while, until - `(,func . ,(mapcar (lambda (form) - (cconv-convert form env extend)) - forms)) + (let ((args (mapcar (lambda (form) (cconv-convert form env extend)) + forms))) + (unless (symbolp func) + (byte-compile-warn-x + form + "Use `funcall' instead of `%s' in the function position" func)) + `(,func . ,args)) (byte-compile-warn-x form "Malformed function `%S'" func) nil)) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index dcb72e4105a..8ccac492141 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -848,6 +848,22 @@ byte-compiled. Run with dynamic binding." (should (equal (bytecomp-tests--eval-interpreted form) (bytecomp-tests--eval-compiled form))))))) +(ert-deftest bytecomp--fun-value-as-head () + ;; Check that (FUN-VALUE ...) is a valid call, for compatibility (bug#68931). + ;; (There is also a warning but this test does not check that.) + (dolist (lb '(nil t)) + (ert-info ((prin1-to-string lb) :prefix "lexical-binding: ") + (let* ((lexical-binding lb) + (s-int '(lambda (x) (1+ x))) + (s-comp (byte-compile s-int)) + (v-int (lambda (x) (1+ x))) + (v-comp (byte-compile v-int)) + (comp (lambda (f) (funcall (byte-compile `(lambda () (,f 3))))))) + (should (equal (funcall comp s-int) 4)) + (should (equal (funcall comp s-comp) 4)) + (should (equal (funcall comp v-int) 4)) + (should (equal (funcall comp v-comp) 4)))))) + (defmacro bytecomp-tests--with-fresh-warnings (&rest body) `(let ((macroexp--warned ; oh dear (make-hash-table :test #'equal :weakness 'key))) -- cgit v1.2.3 From cebd26b2e16d75a939e2a9f91becc6ec702122a7 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Mon, 5 Feb 2024 23:12:36 -0800 Subject: Use treesit-node-match-p in treesit-parent-while The previous commit should've done this, but I missed it. * lisp/treesit.el (treesit-parent-while): Use treesit-node-match-p. --- lisp/treesit.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index f179204d89c..6a485ae591a 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -366,7 +366,7 @@ returns nil. PRED can be a predicate function, a regexp matching node type, and more; see docstring of `treesit-thing-settings'." (let ((last nil)) - (while (and node (funcall pred node)) + (while (and node (treesit-node-match-p node pred)) (setq last node node (treesit-node-parent node))) last)) -- cgit v1.2.3 From 0d2b7120783255fbb0f8e98717573c35425f4df6 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 6 Feb 2024 13:10:57 +0800 Subject: Don't forcibly display dialogs on Android if a keyboard is present * java/org/gnu/emacs/EmacsService.java (detectKeyboard): New function. * lisp/subr.el (use-dialog-box-p): Don't always return t if a keyboard is present on Android. * src/android.c (android_init_emacs_service): Link to new function. (android_detect_keyboard): New function. * src/android.h: Update prototypes. * src/androidfns.c (Fandroid_detect_keyboard) (syms_of_androidfns): New function. --- java/org/gnu/emacs/EmacsService.java | 10 ++++++++++ lisp/subr.el | 6 +++++- src/android.c | 16 ++++++++++++++++ src/android.h | 2 ++ src/androidfns.c | 20 ++++++++++++++++++++ 5 files changed, 53 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 5cb1ceca0aa..93e34e6e694 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -60,6 +60,7 @@ import android.content.UriPermission; import android.content.pm.PackageManager; import android.content.res.AssetManager; +import android.content.res.Configuration; import android.hardware.input.InputManager; @@ -581,6 +582,15 @@ public final class EmacsService extends Service return false; } + public boolean + detectKeyboard () + { + Configuration configuration; + + configuration = getResources ().getConfiguration (); + return configuration.keyboard != Configuration.KEYBOARD_NOKEYS; + } + public String nameKeysym (int keysym) { diff --git a/lisp/subr.el b/lisp/subr.el index 582415a9761..e53ef505522 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3829,13 +3829,17 @@ confusing to some users.") (defvar from--tty-menu-p nil "Non-nil means the current command was invoked from a TTY menu.") + +(declare-function android-detect-keyboard "androidfns.c") + (defun use-dialog-box-p () "Return non-nil if the current command should prompt the user via a dialog box." (and last-input-event ; not during startup (or (consp last-nonmenu-event) ; invoked by a mouse event (and (null last-nonmenu-event) (consp last-input-event)) - (featurep 'android) ; Prefer dialog boxes on Android. + (and (featurep 'android) ; Prefer dialog boxes on Android. + (not (android-detect-keyboard))) ; If no keyboard is connected. from--tty-menu-p) ; invoked via TTY menu use-dialog-box)) diff --git a/src/android.c b/src/android.c index 4a74f5b2af4..2c0e4f845f4 100644 --- a/src/android.c +++ b/src/android.c @@ -1593,6 +1593,7 @@ android_init_emacs_service (void) FIND_METHOD (get_screen_width, "getScreenWidth", "(Z)I"); FIND_METHOD (get_screen_height, "getScreenHeight", "(Z)I"); FIND_METHOD (detect_mouse, "detectMouse", "()Z"); + FIND_METHOD (detect_keyboard, "detectKeyboard", "()Z"); FIND_METHOD (name_keysym, "nameKeysym", "(I)Ljava/lang/String;"); FIND_METHOD (browse_url, "browseUrl", "(Ljava/lang/String;Z)" "Ljava/lang/String;"); @@ -5626,6 +5627,21 @@ android_detect_mouse (void) return rc; } +bool +android_detect_keyboard (void) +{ + bool rc; + jmethodID method; + + method = service_class.detect_keyboard; + rc = (*android_java_env)->CallNonvirtualBooleanMethod (android_java_env, + emacs_service, + service_class.class, + method); + android_exception_check (); + return rc; +} + void android_set_dont_focus_on_map (android_window handle, bool no_focus_on_map) diff --git a/src/android.h b/src/android.h index 2f5f32037c5..bd19c4d9ac8 100644 --- a/src/android.h +++ b/src/android.h @@ -103,6 +103,7 @@ extern int android_get_screen_height (void); extern int android_get_mm_width (void); extern int android_get_mm_height (void); extern bool android_detect_mouse (void); +extern bool android_detect_keyboard (void); extern void android_set_dont_focus_on_map (android_window, bool); extern void android_set_dont_accept_focus (android_window, bool); @@ -265,6 +266,7 @@ struct android_emacs_service jmethodID get_screen_width; jmethodID get_screen_height; jmethodID detect_mouse; + jmethodID detect_keyboard; jmethodID name_keysym; jmethodID browse_url; jmethodID restart_emacs; diff --git a/src/androidfns.c b/src/androidfns.c index eaecb78338b..48c3f3046d6 100644 --- a/src/androidfns.c +++ b/src/androidfns.c @@ -2476,6 +2476,25 @@ there is no mouse. */) #endif } +DEFUN ("android-detect-keyboard", Fandroid_detect_keyboard, + Sandroid_detect_keyboard, 0, 0, 0, + doc: /* Return whether a keyboard is connected. +Return non-nil if a key is connected to this computer, or nil +if there is no keyboard. */) + (void) +{ +#ifndef ANDROID_STUBIFY + /* If no display connection is present, just return nil. */ + + if (!android_init_gui) + return Qnil; + + return android_detect_keyboard () ? Qt : Qnil; +#else /* ANDROID_STUBIFY */ + return Qt; +#endif /* ANDROID_STUBIFY */ +} + DEFUN ("android-toggle-on-screen-keyboard", Fandroid_toggle_on_screen_keyboard, Sandroid_toggle_on_screen_keyboard, 2, 2, 0, @@ -3560,6 +3579,7 @@ language to be US English if LANGUAGE is empty. */); defsubr (&Sx_show_tip); defsubr (&Sx_hide_tip); defsubr (&Sandroid_detect_mouse); + defsubr (&Sandroid_detect_keyboard); defsubr (&Sandroid_toggle_on_screen_keyboard); defsubr (&Sx_server_vendor); defsubr (&Sx_server_version); -- cgit v1.2.3 From f6225d125c07bbde8c828b40eb6e81333e051c2a Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Tue, 6 Feb 2024 12:39:11 +0100 Subject: Optionally show internal buffers in Buffer Menu mode Internal buffers were never shown before but they can be of interest to Elisp developers, especially since there is no general mechanism to remove unused buffers. * lisp/buff-menu.el (Buffer-menu-show-internal) (Buffer-menu--selection-message, Buffer-menu-toggle-internal): New. (Buffer-menu-mode-map): Bind to `I`. (Buffer-menu-mode-menu): Add menu entry. (list-buffers--refresh): Extend filtering logic. * etc/NEWS: Announce. --- etc/NEWS | 6 ++++++ lisp/buff-menu.el | 33 +++++++++++++++++++++++++++++---- 2 files changed, 35 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index 5180c26aa92..f980d612a57 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1303,6 +1303,12 @@ will return the URL for that bug. This allows for rcirc logs to use a custom timestamp format, than the chat buffers use by default. +--- +*** New command 'Buffer-menu-toggle-internal', locally bound to 'I'. +This command toggles the display of internal buffers in Buffer Menu mode; +that is, buffers not visiting a file and whose names start with a space. +Previously, such buffers were never shown. + ** Customize +++ diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 5796544c534..9561141f0c3 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -100,6 +100,10 @@ as it is by default." This is set by the prefix argument to `buffer-menu' and related commands.") +(defvar-local Buffer-menu-show-internal nil + "Non-nil if the current Buffer Menu lists internal buffers. +Internal buffers are those whose names start with a space.") + (defvar-local Buffer-menu-filter-predicate nil "Function to filter out buffers in the buffer list. Buffers that don't satisfy the predicate will be skipped. @@ -140,6 +144,7 @@ then the buffer will be displayed in the buffer list.") "V" #'Buffer-menu-view "O" #'Buffer-menu-view-other-window "T" #'Buffer-menu-toggle-files-only + "I" #'Buffer-menu-toggle-internal "M-s a C-s" #'Buffer-menu-isearch-buffers "M-s a C-M-s" #'Buffer-menu-isearch-buffers-regexp "M-s a C-o" #'Buffer-menu-multi-occur @@ -197,6 +202,10 @@ then the buffer will be displayed in the buffer list.") :help "Toggle whether the current buffer-menu displays only file buffers" :style toggle :selected Buffer-menu-files-only] + ["Show Internal Buffers" Buffer-menu-toggle-internal + :help "Toggle whether the current buffer-menu displays internal buffers" + :style toggle + :selected Buffer-menu-show-internal] "---" ["Refresh" revert-buffer :help "Refresh the *Buffer List* buffer contents"] @@ -317,6 +326,11 @@ ARG, show only buffers that are visiting files." (interactive "P") (display-buffer (list-buffers-noselect arg))) +(defun Buffer-menu--selection-message () + (message (cond (Buffer-menu-files-only "Showing only file-visiting buffers.") + (Buffer-menu-show-internal "Showing all buffers.") + (t "Showing all non-internal buffers.")))) + (defun Buffer-menu-toggle-files-only (arg) "Toggle whether the current `buffer-menu' displays only file buffers. With a positive ARG, display only file buffers. With zero or @@ -325,9 +339,18 @@ negative ARG, display other buffers as well." (setq Buffer-menu-files-only (cond ((not arg) (not Buffer-menu-files-only)) ((> (prefix-numeric-value arg) 0) t))) - (message (if Buffer-menu-files-only - "Showing only file-visiting buffers." - "Showing all non-internal buffers.")) + (Buffer-menu--selection-message) + (revert-buffer)) + +(defun Buffer-menu-toggle-internal (arg) + "Toggle whether the current `buffer-menu' displays internal buffers. +With a positive ARG, display non-internal buffers only. With zero or +negative ARG, display internal buffers as well." + (interactive "P" Buffer-menu-mode) + (setq Buffer-menu-show-internal + (cond ((not arg) (not Buffer-menu-show-internal)) + ((> (prefix-numeric-value arg) 0) t))) + (Buffer-menu--selection-message) (revert-buffer)) (define-obsolete-function-alias 'Buffer-menu-sort 'tabulated-list-sort @@ -667,6 +690,7 @@ See more at `Buffer-menu-filter-predicate'." (marked-buffers (Buffer-menu-marked-buffers)) (buffer-menu-buffer (current-buffer)) (show-non-file (not Buffer-menu-files-only)) + (show-internal Buffer-menu-show-internal) (filter-predicate (and (functionp Buffer-menu-filter-predicate) Buffer-menu-filter-predicate)) entries name-width) @@ -686,7 +710,8 @@ See more at `Buffer-menu-filter-predicate'." (file buffer-file-name)) (when (and (buffer-live-p buffer) (or buffer-list - (and (or (not (string= (substring name 0 1) " ")) + (and (or show-internal + (not (string= (substring name 0 1) " ")) file) (not (eq buffer buffer-menu-buffer)) (or file show-non-file) -- cgit v1.2.3 From ce7365b591852dd5556e0a4bf6a0ba63a8733802 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 6 Feb 2024 19:55:41 +0200 Subject: Use new variable Buffer-menu-show-internal in project-list-buffers. * lisp/progmodes/project.el (project-list-buffers): Add the new variable `Buffer-menu-show-internal' used to toggle internal buffers (bug#68949). --- lisp/progmodes/project.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index da782ad5537..983c0ed2ac2 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1515,7 +1515,8 @@ ARG, show only buffers that are visiting files." (lambda (buffer) (let ((name (buffer-name buffer)) (file (buffer-file-name buffer))) - (and (or (not (string= (substring name 0 1) " ")) + (and (or Buffer-menu-show-internal + (not (string= (substring name 0 1) " ")) file) (not (eq buffer (current-buffer))) (or file (not Buffer-menu-files-only))))) @@ -1525,6 +1526,7 @@ ARG, show only buffers that are visiting files." (let ((buf (list-buffers-noselect arg (with-current-buffer (get-buffer-create "*Buffer List*") + (setq-local Buffer-menu-show-internal nil) (let ((Buffer-menu-files-only arg)) (funcall buffer-list-function)))))) (with-current-buffer buf -- cgit v1.2.3 From a2201a2034a86b4cc90132ab2d920456866c11e3 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 6 Feb 2024 13:21:22 -0500 Subject: (loaddefs-generate--parse-file): Be a bit more defensive * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--parse-file): Don't fail in case of an error while generating the prefixes. (loaddefs-generate--compute-prefixes): Don't burp when `read-from-string` returns something else than a symbol. --- lisp/emacs-lisp/loaddefs-gen.el | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 7eced43e735..7cfb14ace5f 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -489,10 +489,12 @@ don't include." (when (and autoload-compute-prefixes compute-prefixes) - (when-let ((form (loaddefs-generate--compute-prefixes load-name))) - ;; This output needs to always go in the main loaddefs.el, - ;; regardless of `generated-autoload-file'. - (push (list main-outfile file form) defs))))) + (with-demoted-errors "%S" + (when-let + ((form (loaddefs-generate--compute-prefixes load-name))) + ;; This output needs to always go in the main loaddefs.el, + ;; regardless of `generated-autoload-file'. + (push (list main-outfile file form) defs)))))) defs)) (defun loaddefs-generate--compute-prefixes (load-name) @@ -506,14 +508,15 @@ don't include." ;; Consider `read-symbol-shorthands'. (probe (let ((obarray (obarray-make))) (car (read-from-string name))))) - (setq name (symbol-name probe)) - (when (save-excursion - (goto-char (match-beginning 0)) - (or (bobp) - (progn - (forward-line -1) - (not (looking-at ";;;###autoload"))))) - (push name prefs))))) + (when (symbolp name) + (setq name (symbol-name probe)) + (when (save-excursion + (goto-char (match-beginning 0)) + (or (bobp) + (progn + (forward-line -1) + (not (looking-at ";;;###autoload"))))) + (push name prefs)))))) (loaddefs-generate--make-prefixes prefs load-name))) (defun loaddefs-generate--rubric (file &optional type feature compile) -- cgit v1.2.3 From ab318cce1e97f4b9c78adc3290784105b78f0728 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 6 Feb 2024 21:55:57 +0200 Subject: ; Fix last change in buffer-menu.el * etc/NEWS: Elaborate about the binding of the new command. * lisp/buff-menu.el (Buffer-menu--selection-message): Fix wording of new message. (Buffer-menu-toggle-internal): Doc fix. (Bug#68949) --- etc/NEWS | 3 ++- lisp/buff-menu.el | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index f980d612a57..ee7462cb2aa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1307,7 +1307,8 @@ chat buffers use by default. *** New command 'Buffer-menu-toggle-internal', locally bound to 'I'. This command toggles the display of internal buffers in Buffer Menu mode; that is, buffers not visiting a file and whose names start with a space. -Previously, such buffers were never shown. +Previously, such buffers were never shown. This command is bound to 'I' +in Buffer menu mode. ** Customize diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 9561141f0c3..29ca3b41f0c 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -329,7 +329,7 @@ ARG, show only buffers that are visiting files." (defun Buffer-menu--selection-message () (message (cond (Buffer-menu-files-only "Showing only file-visiting buffers.") (Buffer-menu-show-internal "Showing all buffers.") - (t "Showing all non-internal buffers.")))) + (t "Hiding internal buffers.")))) (defun Buffer-menu-toggle-files-only (arg) "Toggle whether the current `buffer-menu' displays only file buffers. @@ -344,7 +344,7 @@ negative ARG, display other buffers as well." (defun Buffer-menu-toggle-internal (arg) "Toggle whether the current `buffer-menu' displays internal buffers. -With a positive ARG, display non-internal buffers only. With zero or +With a positive ARG, don't show internal buffers. With zero or negative ARG, display internal buffers as well." (interactive "P" Buffer-menu-mode) (setq Buffer-menu-show-internal -- cgit v1.2.3 From 77f240012f1e9a7cfee60adedebc8e6a230ce49b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 6 Feb 2024 15:36:18 -0500 Subject: (loaddefs-generate--compute-prefixes): Fix thinko in last change * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--compute-prefixes): Fix thinko in last change. Also, reduce memory allocation. --- lisp/emacs-lisp/loaddefs-gen.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 7cfb14ace5f..1e91e84157d 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -499,16 +499,17 @@ don't include." (defun loaddefs-generate--compute-prefixes (load-name) (goto-char (point-min)) - (let ((prefs nil)) + (let ((prefs nil) + (temp-obarray (obarray-make))) ;; Avoid (defvar ) by requiring a trailing space. (while (re-search-forward "^(\\(def[^ \t\n]+\\)[ \t\n]+['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t) (unless (member (match-string 1) autoload-ignored-definitions) (let* ((name (match-string-no-properties 2)) ;; Consider `read-symbol-shorthands'. - (probe (let ((obarray (obarray-make))) + (probe (let ((obarray temp-obarray)) (car (read-from-string name))))) - (when (symbolp name) + (when (symbolp probe) (setq name (symbol-name probe)) (when (save-excursion (goto-char (match-beginning 0)) -- cgit v1.2.3 From e25d11314d84cc3e606515d6551e878cec4cfee4 Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Tue, 30 Jan 2024 22:08:50 -0800 Subject: Pass unquoted filename to user-supplied MUSTMATCH predicate * lisp/minibuffer.el (read-file-name-default): Pass REQUIRE-MATCH argument through substitute-in-file-name. * lisp/minibuffer.el (read-file-name): Update docstring. Resolves bug#68815. --- lisp/minibuffer.el | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index faa7f543ece..a9e3ec937f9 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3262,9 +3262,10 @@ Fourth arg MUSTMATCH can take the following values: input, but she needs to confirm her choice if she called `minibuffer-complete' right before `minibuffer-complete-and-exit' and the input is not an existing file. -- a function, which will be called with the input as the - argument. If the function returns a non-nil value, the - minibuffer is exited with that argument as the value. +- a function, which will be called with a single argument, the + input unquoted by `substitute-in-file-name', which see. If the + function returns a non-nil value, the minibuffer is exited with + that argument as the value. - anything else behaves like t except that typing RET does not exit if it does non-null completion. @@ -3353,7 +3354,13 @@ See `read-file-name' for the meaning of the arguments." (let ((ignore-case read-file-name-completion-ignore-case) (minibuffer-completing-file-name t) (pred (or predicate 'file-exists-p)) - (add-to-history nil)) + (add-to-history nil) + (require-match (if (functionp mustmatch) + (lambda (input) + (funcall mustmatch + ;; User-supplied MUSTMATCH expects an unquoted filename + (substitute-in-file-name input))) + mustmatch))) (let* ((val (if (or (not (next-read-file-uses-dialog-p)) @@ -3389,7 +3396,7 @@ See `read-file-name' for the meaning of the arguments." (read-file-name--defaults dir initial)))) (set-syntax-table minibuffer-local-filename-syntax)) (completing-read prompt 'read-file-name-internal - pred mustmatch insdef + pred require-match insdef 'file-name-history default-filename))) ;; If DEFAULT-FILENAME not supplied and DIR contains ;; a file name, split it. -- cgit v1.2.3 From c1cdbb987299f6878072fec539bd363e2c3ca015 Mon Sep 17 00:00:00 2001 From: Wilhelm Kirschbaum Date: Fri, 29 Dec 2023 17:09:00 +0200 Subject: Add access_call fontification to elixir-ts-mode * lisp/progmodes/elixir-ts-mode.el (elixir-ts--font-lock-settings): Add access_call queries to the elixir-variable feature (bug#67246). --- lisp/progmodes/elixir-ts-mode.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el index b493195eedd..2c7323c318d 100644 --- a/lisp/progmodes/elixir-ts-mode.el +++ b/lisp/progmodes/elixir-ts-mode.el @@ -546,7 +546,9 @@ (body (identifier) @font-lock-variable-name-face) (unary_operator operand: (identifier) @font-lock-variable-name-face) (interpolation (identifier) @font-lock-variable-name-face) - (do_block (identifier) @font-lock-variable-name-face)) + (do_block (identifier) @font-lock-variable-name-face) + (access_call target: (identifier) @font-lock-variable-name-face) + (access_call "[" key: (identifier) @font-lock-variable-name-face "]")) :language 'elixir :feature 'elixir-builtin -- cgit v1.2.3 From eb90fb52b08a16ae2bdc8bad6929492b9e693f72 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Wed, 7 Feb 2024 03:54:29 +0200 Subject: elixir-ts-mode: Bring the faces' use closer to other ts modes * lisp/progmodes/elixir-ts-mode.el (elixir-ts--font-lock-settings): Rename feature 'elixir-function-name' to 'elixir-definition' and update all deferences. Add parameters' highlighting with font-lock-variable-name-face. Change variable references' highlighting to use font-lock-variable-use-face. Move the feature 'elixir-variable' from feature level 3 to level 4, to match other ts modes (bug#67246). --- lisp/progmodes/elixir-ts-mode.el | 53 ++++++++++++++++++++-------------------- 1 file changed, 27 insertions(+), 26 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el index 2c7323c318d..57db211e881 100644 --- a/lisp/progmodes/elixir-ts-mode.el +++ b/lisp/progmodes/elixir-ts-mode.el @@ -360,13 +360,14 @@ (defvar elixir-ts--font-lock-settings (treesit-font-lock-rules :language 'elixir - :feature 'elixir-function-name + :feature 'elixir-definition `((call target: (identifier) @target-identifier (arguments (identifier) @font-lock-function-name-face) (:match ,elixir-ts--definition-keywords-re @target-identifier)) (call target: (identifier) @target-identifier (arguments - (call target: (identifier) @font-lock-function-name-face)) + (call target: (identifier) @font-lock-function-name-face + (arguments ((identifier)) @font-lock-variable-name-face))) (:match ,elixir-ts--definition-keywords-re @target-identifier)) (call target: (identifier) @target-identifier (arguments @@ -379,13 +380,15 @@ (:match ,elixir-ts--definition-keywords-re @target-identifier)) (call target: (identifier) @target-identifier (arguments - (call target: (identifier) @font-lock-function-name-face)) + (call target: (identifier) @font-lock-function-name-face + (arguments ((identifier)) @font-lock-variable-name-face))) (do_block) (:match ,elixir-ts--definition-keywords-re @target-identifier)) (call target: (identifier) @target-identifier (arguments (binary_operator - left: (call target: (identifier) @font-lock-function-name-face))) + left: (call target: (identifier) @font-lock-function-name-face + (arguments ((identifier)) @font-lock-variable-name-face)))) (do_block) (:match ,elixir-ts--definition-keywords-re @target-identifier)) (unary_operator @@ -521,8 +524,8 @@ operator: "/" right: (integer))) (call target: (dot right: (identifier) @font-lock-function-call-face)) - (unary_operator operator: "&" @font-lock-variable-name-face - operand: (integer) @font-lock-variable-name-face) + (unary_operator operator: "&" @font-lock-variable-use-face + operand: (integer) @font-lock-variable-use-face) (unary_operator operator: "&" @font-lock-operator-face operand: (list))) @@ -537,18 +540,18 @@ :language 'elixir :feature 'elixir-variable - '((binary_operator left: (identifier) @font-lock-variable-name-face) - (binary_operator right: (identifier) @font-lock-variable-name-face) - (arguments ( (identifier) @font-lock-variable-name-face)) - (tuple (identifier) @font-lock-variable-name-face) - (list (identifier) @font-lock-variable-name-face) - (pair value: (identifier) @font-lock-variable-name-face) - (body (identifier) @font-lock-variable-name-face) - (unary_operator operand: (identifier) @font-lock-variable-name-face) - (interpolation (identifier) @font-lock-variable-name-face) - (do_block (identifier) @font-lock-variable-name-face) - (access_call target: (identifier) @font-lock-variable-name-face) - (access_call "[" key: (identifier) @font-lock-variable-name-face "]")) + '((binary_operator left: (identifier) @font-lock-variable-use-face) + (binary_operator right: (identifier) @font-lock-variable-use-face) + (arguments ( (identifier) @font-lock-variable-use-face)) + (tuple (identifier) @font-lock-variable-use-face) + (list (identifier) @font-lock-variable-use-face) + (pair value: (identifier) @font-lock-variable-use-face) + (body (identifier) @font-lock-variable-use-face) + (unary_operator operand: (identifier) @font-lock-variable-use-face) + (interpolation (identifier) @font-lock-variable-use-face) + (do_block (identifier) @font-lock-variable-use-face) + (access_call target: (identifier) @font-lock-variable-use-face) + (access_call "[" key: (identifier) @font-lock-variable-use-face "]")) :language 'elixir :feature 'elixir-builtin @@ -699,11 +702,10 @@ Return nil if NODE is not a defun node or doesn't have a name." ;; Font-lock. (setq-local treesit-font-lock-settings elixir-ts--font-lock-settings) (setq-local treesit-font-lock-feature-list - '(( elixir-comment elixir-doc elixir-function-name) + '(( elixir-comment elixir-doc elixir-definition) ( elixir-string elixir-keyword elixir-data-type) - ( elixir-sigil elixir-variable elixir-builtin - elixir-string-escape) - ( elixir-function-call elixir-operator elixir-number ))) + ( elixir-sigil elixir-builtin elixir-string-escape) + ( elixir-function-call elixir-variable elixir-operator elixir-number ))) ;; Imenu. @@ -736,13 +738,12 @@ Return nil if NODE is not a defun node or doesn't have a name." heex-ts--indent-rules)) (setq-local treesit-font-lock-feature-list - '(( elixir-comment elixir-doc elixir-function-name + '(( elixir-comment elixir-doc elixir-definition heex-comment heex-keyword heex-doctype ) ( elixir-string elixir-keyword elixir-data-type heex-component heex-tag heex-attribute heex-string ) - ( elixir-sigil elixir-variable elixir-builtin - elixir-string-escape) - ( elixir-function-call elixir-operator elixir-number )))) + ( elixir-sigil elixir-builtin elixir-string-escape) + ( elixir-function-call elixir-variable elixir-operator elixir-number )))) (treesit-major-mode-setup) (setq-local syntax-propertize-function #'elixir-ts--syntax-propertize))) -- cgit v1.2.3 From 8a39216ce920d82b86a40471429e30d75c6ee42d Mon Sep 17 00:00:00 2001 From: Wilhelm Kirschbaum Date: Wed, 7 Feb 2024 04:18:30 +0200 Subject: elixir-ts-mode: Highlight more method definitions * lisp/progmodes/elixir-ts-mode.el (elixir-ts--font-lock-settings): Also highlight method definitions where the arguments are literal values, not identifiers (bug#67246). --- lisp/progmodes/elixir-ts-mode.el | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'lisp') diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el index 57db211e881..f26c3a49203 100644 --- a/lisp/progmodes/elixir-ts-mode.el +++ b/lisp/progmodes/elixir-ts-mode.el @@ -362,6 +362,11 @@ :language 'elixir :feature 'elixir-definition `((call target: (identifier) @target-identifier + (arguments + (call target: (identifier) @font-lock-function-name-face + (arguments))) + (:match ,elixir-ts--definition-keywords-re @target-identifier)) + (call target: (identifier) @target-identifier (arguments (identifier) @font-lock-function-name-face) (:match ,elixir-ts--definition-keywords-re @target-identifier)) (call target: (identifier) @target-identifier -- cgit v1.2.3 From ccae58a425674c36cb6f17bcebc4416d34f23a37 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 7 Feb 2024 13:19:27 +0100 Subject: Declare function properties in Tramp * lisp/net/tramp-message.el (tramp-backtrace, tramp-error) (tramp-error-with-buffer, tramp-user-error): Declare `tramp-suppress-trace' property. --- lisp/net/tramp-message.el | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lisp') diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el index 96071e626a5..97e94a51e7a 100644 --- a/lisp/net/tramp-message.el +++ b/lisp/net/tramp-message.el @@ -353,6 +353,7 @@ applicable)." If VEC-OR-PROC is nil, the buffer *debug tramp* is used. FORCE forces the backtrace even if `tramp-verbose' is less than 10. This function is meant for debugging purposes." + (declare (tramp-suppress-trace t)) (let ((tramp-verbose (if force 10 tramp-verbose))) (when (>= tramp-verbose 10) (tramp-message @@ -364,6 +365,7 @@ VEC-OR-PROC identifies the connection to use, SIGNAL is the signal identifier to be raised, remaining arguments passed to `tramp-message'. Finally, signal SIGNAL is raised with FMT-STRING and ARGUMENTS." + (declare (tramp-suppress-trace t)) (let (signal-hook-function) (tramp-backtrace vec-or-proc) (unless arguments @@ -391,6 +393,7 @@ tramp-tests.el.") "Emit an error, and show BUF. If BUF is nil, show the connection buf. Wait for 30\", or until an input event arrives. The other arguments are passed to `tramp-error'." + (declare (tramp-suppress-trace t)) (save-window-excursion (let* ((buf (or (and (bufferp buf) buf) (and (processp vec-or-proc) (process-buffer vec-or-proc)) @@ -424,6 +427,7 @@ an input event arrives. The other arguments are passed to `tramp-error'." (defsubst tramp-user-error (vec-or-proc fmt-string &rest arguments) "Signal a user error (or \"pilot error\")." + (declare (tramp-suppress-trace t)) (unwind-protect (apply #'tramp-error vec-or-proc 'user-error fmt-string arguments) ;; Save exit. -- cgit v1.2.3 From ef3fed1a4898c3e3d6012ba01006d827a4aba0ef Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Wed, 7 Feb 2024 14:35:44 +0100 Subject: ; Fix last changes in buffer-menu.el and NEWS * etc/NEWS: Remove superfluous mention of key binding. * lisp/buff-menu.el (Buffer-menu--selection-message): Go back to previous wording. It's not about what is hidden but what is shown; the message is displayed in response to different actions. --- etc/NEWS | 2 +- lisp/buff-menu.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index ee7462cb2aa..960ad2b95ac 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1304,7 +1304,7 @@ This allows for rcirc logs to use a custom timestamp format, than the chat buffers use by default. --- -*** New command 'Buffer-menu-toggle-internal', locally bound to 'I'. +*** New command 'Buffer-menu-toggle-internal'. This command toggles the display of internal buffers in Buffer Menu mode; that is, buffers not visiting a file and whose names start with a space. Previously, such buffers were never shown. This command is bound to 'I' diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 29ca3b41f0c..be62fc51e4c 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -329,7 +329,7 @@ ARG, show only buffers that are visiting files." (defun Buffer-menu--selection-message () (message (cond (Buffer-menu-files-only "Showing only file-visiting buffers.") (Buffer-menu-show-internal "Showing all buffers.") - (t "Hiding internal buffers.")))) + (t "Showing all non-internal buffers.")))) (defun Buffer-menu-toggle-files-only (arg) "Toggle whether the current `buffer-menu' displays only file buffers. -- cgit v1.2.3 From 2ecaa60f0521446c9d2c054a3493faaf46275223 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 7 Feb 2024 19:14:20 +0200 Subject: Improve wording of message in buff-menu.el * lisp/buff-menu.el (Buffer-menu--selection-message): Improve wording of selection messages. --- lisp/buff-menu.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index be62fc51e4c..10ea99eae9a 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -329,7 +329,7 @@ ARG, show only buffers that are visiting files." (defun Buffer-menu--selection-message () (message (cond (Buffer-menu-files-only "Showing only file-visiting buffers.") (Buffer-menu-show-internal "Showing all buffers.") - (t "Showing all non-internal buffers.")))) + (t "Showing all buffers except internal ones.")))) (defun Buffer-menu-toggle-files-only (arg) "Toggle whether the current `buffer-menu' displays only file buffers. -- cgit v1.2.3 From f444786e58737a4ae6071957dfc60075bbd96edc Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Wed, 7 Feb 2024 21:50:37 +0200 Subject: Mention 'C-h' in echo for unfinished commands * etc/NEWS: Mention it here. * lisp/cus-start.el (standard): Add type and version for it. * src/keyboard.c (echo-keystrokes-help): New user option (https://lists.gnu.org/archive/html/emacs-devel/2024-02/msg00174.html). * src/keyboard.c (echo_dash): Use it. --- etc/NEWS | 3 +++ lisp/cus-start.el | 1 + src/keyboard.c | 13 +++++++++++++ 3 files changed, 17 insertions(+) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index 960ad2b95ac..f454b6d851c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -307,6 +307,9 @@ between the auto save file and the current file. ** 'ffap-lax-url' now defaults to nil. Previously, it was set to t but this broke remote file name detection. +** Unfinished commands' echo now ends with a suggestion to use Help. +Customize 'echo-keystrokes-help' to nil to prevent that. + * Editing Changes in Emacs 30.1 diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 7e0b64e9067..3fe62c8d0da 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -371,6 +371,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (auto-save-timeout auto-save (choice (const :tag "off" nil) (integer :format "%v"))) (echo-keystrokes minibuffer number) + (echo-keystrokes-help minibuffer boolean "30.1") (polling-period keyboard float) (double-click-time mouse (restricted-sexp :match-alternatives (integerp 'nil 't))) diff --git a/src/keyboard.c b/src/keyboard.c index 1f7253a7da1..6d3db5ab615 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -589,6 +589,15 @@ echo_dash (void) AUTO_STRING (dash, "-"); kset_echo_string (current_kboard, concat2 (KVAR (current_kboard, echo_string), dash)); + + if (echo_keystrokes_help) + { + AUTO_STRING (help, " (\\`C-h' for help)"); + kset_echo_string (current_kboard, + concat2 (KVAR (current_kboard, echo_string), + calln (Qsubstitute_command_keys, help))); + } + echo_now (); } @@ -13228,6 +13237,10 @@ The value may be integer or floating point. If the value is zero, don't echo at all. */); Vecho_keystrokes = make_fixnum (1); + DEFVAR_BOOL ("echo-keystrokes-help", echo_keystrokes_help, + doc: /* Non-nil means append small help text to the unfinished commands' echo. */); + echo_keystrokes_help = true; + DEFVAR_LISP ("polling-period", Vpolling_period, doc: /* Interval between polling for input during Lisp execution. The reason for polling is to make C-g work to stop a running program. -- cgit v1.2.3 From 1db2255c7c7fc232e371d379cb60827a9931e24d Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 8 Feb 2024 13:20:28 +0800 Subject: * lisp/touch-screen.el (touch-screen): Fix defgroup version. --- lisp/touch-screen.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index a1ec4bca89f..c8de1d8ee31 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -87,7 +87,7 @@ is being called from `read-sequence' or some similar function.") (defgroup touch-screen nil "Interact with Emacs from touch screen devices." :group 'mouse - :version "30.0") + :version "30.1") (defcustom touch-screen-display-keyboard nil "If non-nil, always display the on screen keyboard. -- cgit v1.2.3 From 08c81db7c8e522278fb2c8de8fbe556d109c135f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 8 Feb 2024 11:17:22 +0100 Subject: `file-remote-p' must not return an error * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler): `file-remote-p' must not return an error. (Bug#68976) --- lisp/net/tramp-gvfs.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 72589e7ce4a..4e949e7e60b 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -888,7 +888,8 @@ Operations not mentioned here will be handled by the default Emacs primitives.") "Invoke the GVFS related OPERATION and ARGS. First arg specifies the OPERATION, second arg is a list of arguments to pass to the OPERATION." - (unless tramp-gvfs-enabled + ;; `file-remote-p' must not return an error. (Bug#68976) + (unless (or tramp-gvfs-enabled (eq operation 'file-remote-p)) (tramp-user-error nil "Package `tramp-gvfs' not supported")) (if-let ((filename (apply #'tramp-file-name-for-operation operation args)) (tramp-gvfs-dbus-event-vector -- cgit v1.2.3 From bc099295dd24d059d3358acf5653ced9c9292e41 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Wed, 31 Jan 2024 21:37:18 +0100 Subject: ; Ensure 'thing-at-point-looking-at' finds full match * lisp/thingatpt.el (thing-at-point-looking-at): Regexp-search from the beginning forward, instead of the other way around. * test/lisp/thingatpt-tests.el (thing-at-point-test-data): Add tests. (Bug#68762) --- lisp/thingatpt.el | 43 +++++++++++++------------------------------ test/lisp/thingatpt-tests.el | 2 ++ 2 files changed, 15 insertions(+), 30 deletions(-) (limited to 'lisp') diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 323d3d1cf6c..b532bafff82 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -619,36 +619,19 @@ point. Optional argument DISTANCE limits search for REGEXP forward and back from point." - (save-excursion - (let ((old-point (point)) - (forward-bound (and distance (+ (point) distance))) - (backward-bound (and distance (- (point) distance))) - match prev-pos new-pos) - (and (looking-at regexp) - (>= (match-end 0) old-point) - (setq match (point))) - ;; Search back repeatedly from end of next match. - ;; This may fail if next match ends before this match does. - (re-search-forward regexp forward-bound 'limit) - (setq prev-pos (point)) - (while (and (setq new-pos (re-search-backward regexp backward-bound t)) - ;; Avoid inflooping with some regexps, such as "^", - ;; matching which never moves point. - (< new-pos prev-pos) - (or (> (match-beginning 0) old-point) - (and (looking-at regexp) ; Extend match-end past search start - (>= (match-end 0) old-point) - (setq match (point)))))) - (if (not match) nil - (goto-char match) - ;; Back up a char at a time in case search skipped - ;; intermediate match straddling search start pos. - (while (and (not (bobp)) - (progn (backward-char 1) (looking-at regexp)) - (>= (match-end 0) old-point) - (setq match (point)))) - (goto-char match) - (looking-at regexp))))) + (let* ((old (point)) + (beg (if distance (max (point-min) (- old distance)) (point-min))) + (end (and distance (min (point-max) (+ old distance)))) + prev match) + (save-excursion + (goto-char beg) + (while (and (setq prev (point) + match (re-search-forward regexp end t)) + (< (match-end 0) old)) + ;; Avoid inflooping when `regexp' matches the empty string. + (unless (< prev (point)) (forward-char)))) + (and match (<= (match-beginning 0) old (match-end 0))))) + ;; Email addresses (defvar thing-at-point-email-regexp diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index ba51f375cc6..56bc4fdc9dc 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -92,6 +92,8 @@ ("1@example.com" 1 email "1@example.com") ;; email addresses user portion containing dots ("foo.bar@example.com" 1 email "foo.bar@example.com") + ("foo.bar@example.com" 5 email "foo.bar@example.com") + (" fo.ba@example.com" 6 email "fo.ba@example.com") (".foobar@example.com" 1 email nil) (".foobar@example.com" 2 email "foobar@example.com") ;; email addresses domain portion containing dots and dashes -- cgit v1.2.3 From e2682316867ecb22ee1db5e3028a8150d95d1a80 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 8 Feb 2024 13:51:55 +0200 Subject: Don't skip links to "." and ".." in Dired when marking files * lisp/dired.el (dired-mark): Skip "." and "..", but not symlinks to those two. (Bug#38729) (Bug#68814) --- lisp/dired.el | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'lisp') diff --git a/lisp/dired.el b/lisp/dired.el index c33569d79a2..d9fbafb98c3 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -4110,6 +4110,11 @@ this subdir." (prefix-numeric-value arg) (lambda () (when (or (not (looking-at-p dired-re-dot)) + ;; Don't skip symlinks to ".", "..", etc. + (save-excursion + (re-search-forward + dired-permission-flags-regexp nil t) + (eq (char-after (match-beginning 1)) ?l)) (not (equal dired-marker-char dired-del-marker))) (delete-char 1) (insert dired-marker-char)))))))) -- cgit v1.2.3 From ebf4ef2022a5f0a69cdd881eb41104e7b59d698e Mon Sep 17 00:00:00 2001 From: USAMI Kenta Date: Sun, 4 Feb 2024 03:20:24 +0900 Subject: Fix 'browse-url-url-at-point' so that scheme does not duplicate * lisp/net/browse-url.el (browse-url-url-at-point): Prepend the default scheme only if no scheme present. (Bug#68913) --- lisp/net/browse-url.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 359453ca433..bc2a7db9a8b 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -688,8 +688,10 @@ websites are increasingly rare, but they do still exist." (defun browse-url-url-at-point () (or (thing-at-point 'url t) ;; assume that the user is pointing at something like gnu.org/gnu - (let ((f (thing-at-point 'filename t))) - (and f (concat browse-url-default-scheme "://" f))))) + (when-let ((f (thing-at-point 'filename t))) + (if (string-match-p browse-url-button-regexp f) + f + (concat browse-url-default-scheme "://" f))))) ;; Having this as a separate function called by the browser-specific ;; functions allows them to be stand-alone commands, making it easier -- cgit v1.2.3 From 0b9c7148fd681c8ad63fd0eb3895db44403e9f8c Mon Sep 17 00:00:00 2001 From: Liu Hui Date: Thu, 18 Jan 2024 12:00:00 +0800 Subject: Respect the delimiter of completer in Python shell completion * lisp/progmodes/python.el: (python-shell-completion-setup-code): Fix the completion code of IPython. Change the return value to JSON string and ... (python-shell-completion-get-completions): ... simplify parsing. (inferior-python-mode): Update docstring. (python-shell-readline-completer-delims): New variable indicating the word delimiters of readline completer. (python-shell-completion-native-setup): Set the completer delimiter. (python-shell-completion-native-get-completions): Convert output string to completions properly. (python-shell--get-multiline-input) (python-shell--extra-completion-context) (python-shell-completion-extra-context): New functions. (python-shell-completion-at-point): Send text beginning from the line start if the completion backend does not need word splitting. Remove the detection of import statement because it is not needed anymore. Create proper completion table based on completions returned from different backends. * test/lisp/progmodes/python-tests.el (python-tests--completion-module) (python-tests--completion-parameters) (python-tests--completion-extra-context): New helper functions. (python-shell-completion-at-point-jedi-completer) (python-shell-completion-at-point-ipython): New tests. (bug#68559) --- lisp/progmodes/python.el | 220 ++++++++++++++++++++++++++++-------- test/lisp/progmodes/python-tests.el | 92 +++++++++++++++ 2 files changed, 264 insertions(+), 48 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 9d840efb9da..b1654b6a5aa 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -5,7 +5,7 @@ ;; Author: Fabián E. Gallina ;; URL: https://github.com/fgallina/python.el ;; Version: 0.28 -;; Package-Requires: ((emacs "24.4") (compat "28.1.2.1") (seq "2.23")) +;; Package-Requires: ((emacs "24.4") (compat "29.1.1.0") (seq "2.23")) ;; Maintainer: emacs-devel@gnu.org ;; Created: Jul 2010 ;; Keywords: languages @@ -128,9 +128,9 @@ ;; receiving escape sequences (with some limitations, i.e. completion ;; in blocks does not work). The code executed for the "fallback" ;; completion can be found in `python-shell-completion-setup-code' and -;; `python-shell-completion-string-code' variables. Their default -;; values enable completion for both CPython and IPython, and probably -;; any readline based shell (it's known to work with PyPy). If your +;; `python-shell-completion-get-completions'. Their default values +;; enable completion for both CPython and IPython, and probably any +;; readline based shell (it's known to work with PyPy). If your ;; Python installation lacks readline (like CPython for Windows), ;; installing pyreadline (URL `https://ipython.org/pyreadline.html') ;; should suffice. To troubleshoot why you are not getting any @@ -141,6 +141,12 @@ ;; If you see an error, then you need to either install pyreadline or ;; setup custom code that avoids that dependency. +;; By default, the "native" completion uses the built-in rlcompleter. +;; To use other readline completer (e.g. Jedi) or a custom one, you just +;; need to set it in the PYTHONSTARTUP file. You can set an +;; Emacs-specific completer by testing the environment variable +;; INSIDE_EMACS. + ;; Shell virtualenv support: The shell also contains support for ;; virtualenvs and other special environment modifications thanks to ;; `python-shell-process-environment' and `python-shell-exec-path'. @@ -3604,7 +3610,6 @@ interpreter is run. Variables `python-shell-prompt-block-regexp', `python-shell-font-lock-enable', `python-shell-completion-setup-code', -`python-shell-completion-string-code', `python-eldoc-setup-code', `python-ffap-setup-code' can customize this mode for different Python interpreters. @@ -4244,8 +4249,9 @@ def __PYTHON_EL_get_completions(text): completions = [] completer = None + import json try: - import readline + import readline, re try: import __builtin__ @@ -4256,16 +4262,29 @@ def __PYTHON_EL_get_completions(text): is_ipython = ('__IPYTHON__' in builtins or '__IPYTHON__active' in builtins) - splits = text.split() - is_module = splits and splits[0] in ('from', 'import') - - if is_ipython and is_module: - from IPython.core.completerlib import module_completion - completions = module_completion(text.strip()) - elif is_ipython and '__IP' in builtins: - completions = __IP.complete(text) - elif is_ipython and 'get_ipython' in builtins: - completions = get_ipython().Completer.all_completions(text) + + if is_ipython and 'get_ipython' in builtins: + def filter_c(prefix, c): + if re.match('_+(i?[0-9]+)?$', c): + return False + elif c[0] == '%' and not re.match('[%a-zA-Z]+$', prefix): + return False + return True + + import IPython + try: + if IPython.version_info[0] >= 6: + from IPython.core.completer import provisionalcompleter + with provisionalcompleter(): + completions = [ + [c.text, c.start, c.end, c.type or '?', c.signature or ''] + for c in get_ipython().Completer.completions(text, len(text)) + if filter_c(text, c.text)] + else: + part, matches = get_ipython().Completer.complete(line_buffer=text) + completions = [text + m[len(part):] for m in matches if filter_c(text, m)] + except: + pass else: # Try to reuse current completer. completer = readline.get_completer() @@ -4288,7 +4307,7 @@ def __PYTHON_EL_get_completions(text): finally: if getattr(completer, 'PYTHON_EL_WRAPPED', False): completer.print_mode = True - return completions" + return json.dumps(completions)" "Code used to setup completion in inferior Python processes." :type 'string) @@ -4329,6 +4348,10 @@ When a match is found, native completion is disabled." :version "25.1" :type 'float) +(defvar python-shell-readline-completer-delims nil + "Word delimiters used by the readline completer. +It is automatically set by Python shell.") + (defvar python-shell-completion-native-redirect-buffer " *Python completions redirect*" "Buffer to be used to redirect output of readline commands.") @@ -4467,6 +4490,10 @@ def __PYTHON_EL_native_completion_setup(): __PYTHON_EL_native_completion_setup()" process))) (when (string-match-p "python\\.el: native completion setup loaded" output) + (setq-local python-shell-readline-completer-delims + (string-trim-right + (python-shell-send-string-no-output + "import readline; print(readline.get_completer_delims())"))) (python-shell-completion-native-try)))) (defun python-shell-completion-native-turn-off (&optional msg) @@ -4534,6 +4561,8 @@ With argument MSG show activation/deactivation message." (let* ((original-filter-fn (process-filter process)) (redirect-buffer (get-buffer-create python-shell-completion-native-redirect-buffer)) + (sep (if (string= python-shell-readline-completer-delims "") + "[\n\r]+" "[ \f\t\n\r\v()]+")) (trigger "\t") (new-input (concat input trigger)) (input-length @@ -4576,28 +4605,80 @@ With argument MSG show activation/deactivation message." process python-shell-completion-native-output-timeout comint-redirect-finished-regexp) (re-search-backward "0__dummy_completion__" nil t) - (cl-remove-duplicates - (split-string - (buffer-substring-no-properties - (line-beginning-position) (point-min)) - "[ \f\t\n\r\v()]+" t) - :test #'string=)))) + (let ((str (buffer-substring-no-properties + (line-beginning-position) (point-min)))) + ;; The readline completer is allowed to return a list + ;; of (text start end type signature) as a JSON + ;; string. See the return value for IPython in + ;; `python-shell-completion-setup-code'. + (if (string= "[" (substring str 0 1)) + (condition-case nil + (python--parse-json-array str) + (t (cl-remove-duplicates (split-string str sep t) + :test #'string=))) + (cl-remove-duplicates (split-string str sep t) + :test #'string=)))))) (set-process-filter process original-filter-fn))))) (defun python-shell-completion-get-completions (process input) "Get completions of INPUT using PROCESS." (with-current-buffer (process-buffer process) - (let ((completions - (python-util-strip-string - (python-shell-send-string-no-output - (format - "%s\nprint(';'.join(__PYTHON_EL_get_completions(%s)))" + (python--parse-json-array + (python-shell-send-string-no-output + (format "%s\nprint(__PYTHON_EL_get_completions(%s))" python-shell-completion-setup-code (python-shell--encode-string input)) - process)))) - (when (> (length completions) 2) - (split-string completions - "^'\\|^\"\\|;\\|'$\\|\"$" t))))) + process)))) + +(defun python-shell--get-multiline-input () + "Return lines at a multi-line input in Python shell." + (save-excursion + (let ((p (point)) lines) + (when (progn + (beginning-of-line) + (looking-back python-shell-prompt-block-regexp (pos-bol))) + (push (buffer-substring-no-properties (point) p) lines) + (while (progn (comint-previous-prompt 1) + (looking-back python-shell-prompt-block-regexp (pos-bol))) + (push (buffer-substring-no-properties (point) (pos-eol)) lines)) + (push (buffer-substring-no-properties (point) (pos-eol)) lines)) + lines))) + +(defun python-shell--extra-completion-context () + "Get extra completion context of current input in Python shell." + (let ((lines (python-shell--get-multiline-input)) + (python-indent-guess-indent-offset nil)) + (when (not (zerop (length lines))) + (with-temp-buffer + (delay-mode-hooks + (insert (string-join lines "\n")) + (python-mode) + (python-shell-completion-extra-context)))))) + +(defun python-shell-completion-extra-context (&optional pos) + "Get extra completion context at position POS in Python buffer. +If optional argument POS is nil, use current position. + +Readline completers could use current line as the completion +context, which may be insufficient. In this function, extra +context (e.g. multi-line function call) is found and reformatted +as one line, which is required by native completion." + (let (bound p) + (save-excursion + (and pos (goto-char pos)) + (setq bound (pos-bol)) + (python-nav-up-list -1) + (when (and (< (point) bound) + (or + (looking-back + (python-rx (group (+ (or "." symbol-name)))) (pos-bol) t) + (progn + (forward-line 0) + (looking-at "^[ \t]*\\(from \\)")))) + (setq p (match-beginning 1)))) + (when p + (replace-regexp-in-string + "\n[ \t]*" "" (buffer-substring-no-properties p (1- bound)))))) (defvar-local python-shell--capf-cache nil "Variable to store cached completions and invalidation keys.") @@ -4612,21 +4693,26 @@ using that one instead of current buffer's process." ;; Working on a shell buffer: use prompt end. (cdr (python-util-comint-last-prompt)) (line-beginning-position))) - (import-statement - (when (string-match-p - (rx (* space) word-start (or "from" "import") word-end space) - (buffer-substring-no-properties line-start (point))) - (buffer-substring-no-properties line-start (point)))) + (no-delims + (and (not (if is-shell-buffer + (eq 'font-lock-comment-face + (get-text-property (1- (point)) 'face)) + (python-syntax-context 'comment))) + (with-current-buffer (process-buffer process) + (if python-shell-completion-native-enable + (string= python-shell-readline-completer-delims "") + (string-match-p "ipython[23]?\\'" python-shell-interpreter))))) (start (if (< (point) line-start) (point) (save-excursion - (if (not (re-search-backward - (python-rx - (or whitespace open-paren close-paren - string-delimiter simple-operator)) - line-start - t 1)) + (if (or no-delims + (not (re-search-backward + (python-rx + (or whitespace open-paren close-paren + string-delimiter simple-operator)) + line-start + t 1))) line-start (forward-char (length (match-string-no-properties 0))) (point))))) @@ -4666,18 +4752,56 @@ using that one instead of current buffer's process." (t #'python-shell-completion-native-get-completions)))) (prev-prompt (car python-shell--capf-cache)) (re (or (cadr python-shell--capf-cache) regexp-unmatchable)) - (prefix (buffer-substring-no-properties start end))) + (prefix (buffer-substring-no-properties start end)) + (prefix-offset 0) + (extra-context (when no-delims + (if is-shell-buffer + (python-shell--extra-completion-context) + (python-shell-completion-extra-context)))) + (extra-offset (length extra-context))) + (unless (zerop extra-offset) + (setq prefix (concat extra-context prefix))) ;; To invalidate the cache, we check if the prompt position or the ;; completion prefix changed. (unless (and (equal prev-prompt (car prompt-boundaries)) - (string-match re prefix)) + (string-match re prefix) + (setq prefix-offset (- (length prefix) (match-end 1)))) (setq python-shell--capf-cache `(,(car prompt-boundaries) ,(if (string-empty-p prefix) regexp-unmatchable - (concat "\\`" (regexp-quote prefix) "\\(?:\\sw\\|\\s_\\)*\\'")) - ,@(funcall completion-fn process (or import-statement prefix))))) - (list start end (cddr python-shell--capf-cache)))) + (concat "\\`\\(" (regexp-quote prefix) "\\)\\(?:\\sw\\|\\s_\\)*\\'")) + ,@(funcall completion-fn process prefix)))) + (let ((cands (cddr python-shell--capf-cache))) + (cond + ((stringp (car cands)) + (if no-delims + ;; Reduce completion candidates due to long prefix. + (if-let ((Lp (length prefix)) + ((string-match "\\(\\sw\\|\\s_\\)+\\'" prefix)) + (L (match-beginning 0))) + ;; If extra-offset is not zero: + ;; start end + ;; o------------------o---------o-------o + ;; |<- extra-offset ->| + ;; |<----------- L ------------>| + ;; new-start + (list (+ start L (- extra-offset)) end + (mapcar (lambda (s) (substring s L)) cands)) + (list end end (mapcar (lambda (s) (substring s Lp)) cands))) + (list start end cands))) + ;; python-shell-completion(-native)-get-completions may produce a + ;; list of (text start end type signature) for completion. + ((consp (car cands)) + (list (+ start (nth 1 (car cands)) (- extra-offset)) + ;; Candidates may be cached, so the end position should + ;; be adjusted according to current completion prefix. + (+ start (nth 2 (car cands)) (- extra-offset) prefix-offset) + cands + :annotation-function + (lambda (c) (concat " " (nth 3 (assoc c cands)))) + :company-docsig + (lambda (c) (nth 4 (assoc c cands))))))))) (define-obsolete-function-alias 'python-shell-completion-complete-at-point diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 59957ff0712..af6c199b5bd 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -4799,6 +4799,98 @@ def foo(): (end-of-line 0) (should-not (nth 2 (python-shell-completion-at-point)))))) +(defun python-tests--completion-module () + "Check if modules can be completed in Python shell." + (insert "import datet") + (completion-at-point) + (beginning-of-line) + (should (looking-at-p "import datetime")) + (kill-line) + (insert "from datet") + (completion-at-point) + (beginning-of-line) + (should (looking-at-p "from datetime")) + (end-of-line) + (insert " import timed") + (completion-at-point) + (beginning-of-line) + (should (looking-at-p "from datetime import timedelta")) + (kill-line)) + +(defun python-tests--completion-parameters () + "Check if parameters can be completed in Python shell." + (insert "import re") + (comint-send-input) + (python-tests-shell-wait-for-prompt) + (insert "re.split('b', 'abc', maxs") + (completion-at-point) + (should (string= "re.split('b', 'abc', maxsplit=" + (buffer-substring (line-beginning-position) (point)))) + (insert "0, ") + (should (python-shell-completion-at-point)) + ;; Test if cache is used. + (cl-letf (((symbol-function 'python-shell-completion-get-completions) + 'ignore) + ((symbol-function 'python-shell-completion-native-get-completions) + 'ignore)) + (insert "fla") + (completion-at-point) + (should (string= "re.split('b', 'abc', maxsplit=0, flags=" + (buffer-substring (line-beginning-position) (point))))) + (beginning-of-line) + (kill-line)) + +(defun python-tests--completion-extra-context () + "Check if extra context is used for completion." + (insert "re.split('b', 'abc',") + (comint-send-input) + (python-tests-shell-wait-for-prompt) + (insert "maxs") + (completion-at-point) + (should (string= "maxsplit=" + (buffer-substring (line-beginning-position) (point)))) + (insert "0)") + (comint-send-input) + (python-tests-shell-wait-for-prompt) + (insert "from re import (") + (comint-send-input) + (python-tests-shell-wait-for-prompt) + (insert "IGN") + (completion-at-point) + (should (string= "IGNORECASE" + (buffer-substring (line-beginning-position) (point))))) + +(ert-deftest python-shell-completion-at-point-jedi-completer () + "Check if Python shell completion works when Jedi completer is used." + (skip-unless (executable-find python-tests-shell-interpreter)) + (python-tests-with-temp-buffer-with-shell + "" + (python-shell-with-shell-buffer + (python-shell-completion-native-turn-on) + (skip-unless (string= python-shell-readline-completer-delims "")) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-tests--completion-extra-context)))) + +(ert-deftest python-shell-completion-at-point-ipython () + "Check if Python shell completion works for IPython." + (let ((python-shell-interpreter "ipython") + (python-shell-interpreter-args "-i --simple-prompt")) + (skip-unless + (and + (executable-find python-shell-interpreter) + (eql (call-process python-shell-interpreter nil nil nil "--version") 0))) + (python-tests-with-temp-buffer-with-shell + "" + (python-shell-with-shell-buffer + (python-shell-completion-native-turn-off) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-shell-completion-native-turn-on) + (skip-unless (string= python-shell-readline-completer-delims "")) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-tests--completion-extra-context))))) ;;; PDB Track integration -- cgit v1.2.3 From f1e7b5230ad93aab20af1fd7b09931a746a89d5d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 9 Feb 2024 11:05:14 +0100 Subject: Tramp: Handle PIN requests from security keys (don't merge) * doc/misc/tramp.texi (Frequently Asked Questions): Clarify FIDO entry. * lisp/net/tramp-sh.el (tramp-actions-before-shell) (tramp-actions-copy-out-of-band): Use `tramp-security-key-pin-regexp'. * lisp/net/tramp.el (tramp-security-key-pin-regexp): New defcustom. (tramp-action-otp-password, tramp-read-passwd): Trim password prompt. (tramp-action-show-and-confirm-message): Expand for PIN requests. --- doc/misc/tramp.texi | 11 ++++++++--- lisp/net/tramp-sh.el | 2 ++ lisp/net/tramp.el | 33 ++++++++++++++++++++++----------- 3 files changed, 32 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 3be88d1767a..d6031d96d6b 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5070,9 +5070,14 @@ Does @value{tramp} support @acronym{SSH} security keys? Yes. @command{OpenSSH} has added support for @acronym{FIDO} hardware devices via special key types @option{*-sk}. @value{tramp} supports the additional handshaking messages for them. This requires at least -@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} compatible -security key, like yubikey, solokey, nitrokey, or titankey. - +@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} or +@acronym{FIDO2} compatible security key, like yubikey, solokey, +nitrokey, or titankey. +@c @uref{https://docs.fedoraproject.org/en-US/quick-docs/using-yubikeys/} + +@strong{Note} that there are reports on problems of handling yubikey +residential keys by @command{ssh-agent}. As workaround, you might +disable @command{ssh-agent} for such keys. @item @value{tramp} does not connect to Samba or MS Windows hosts running diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 44c0bdc7aea..3e6fb384a8f 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -544,6 +544,7 @@ shell from reading its init file." (tramp-terminal-prompt-regexp tramp-action-terminal) (tramp-antispoof-regexp tramp-action-confirm-message) (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message) + (tramp-security-key-pin-regexp tramp-action-otp-password) (tramp-process-alive-regexp tramp-action-process-alive)) "List of pattern/action pairs. Whenever a pattern matches, the corresponding action is performed. @@ -563,6 +564,7 @@ corresponding PATTERN matches, the ACTION function is called.") (tramp-wrong-passwd-regexp tramp-action-permission-denied) (tramp-copy-failed-regexp tramp-action-permission-denied) (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message) + (tramp-security-key-pin-regexp tramp-action-otp-password) (tramp-process-alive-regexp tramp-action-out-of-band)) "List of pattern/action pairs. This list is used for copying/renaming with out-of-band methods. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index bd556753261..f3da56e7a4f 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -224,7 +224,7 @@ pair of the form (KEY VALUE). The following KEYs are defined: set this to any value other than \"/bin/sh\": Tramp wants to use a shell which groks tilde expansion, but it can search for it. Also note that \"/bin/sh\" exists on all Unixen - except Andtoid, this might not be true for the value that you + except Android, this might not be true for the value that you decide to use. You Have Been Warned. * `tramp-remote-shell-login' @@ -788,6 +788,13 @@ The regexp should match at end of buffer." :version "28.1" :type 'regexp) +(defcustom tramp-security-key-pin-regexp + (rx bol (* "\r") (group "Enter PIN for " (* nonl)) (* (any "\r\n"))) + "Regular expression matching security key PIN prompt. +The regexp should match at end of buffer." + :version "29.3" + :type 'regexp) + (defcustom tramp-operation-not-permitted-regexp (rx (| (: "preserving times" (* nonl)) "set mode") ":" (* blank) "Operation not permitted") @@ -5589,7 +5596,7 @@ of." prompt) (goto-char (point-min)) (tramp-check-for-regexp proc tramp-process-action-regexp) - (setq prompt (concat (match-string 1) " ")) + (setq prompt (concat (string-trim (match-string 1)) " ")) (tramp-message vec 3 "Sending %s" (match-string 1)) ;; We don't call `tramp-send-string' in order to hide the ;; password from the debug buffer and the traces. @@ -5665,14 +5672,17 @@ Wait, until the connection buffer changes." (ignore set-message-function clear-message-function) (tramp-message vec 6 "\n%s" (buffer-string)) (tramp-check-for-regexp proc tramp-process-action-regexp) - (with-temp-message - (replace-regexp-in-string (rx (any "\r\n")) "" (match-string 0)) + (with-temp-message (concat (string-trim (match-string 0)) " ") ;; Hide message in buffer. (narrow-to-region (point-max) (point-max)) ;; Wait for new output. (while (not (tramp-compat-ignore-error file-error (tramp-wait-for-regexp - proc 0.1 tramp-security-key-confirmed-regexp))) + proc 0.1 + (tramp-compat-rx + (| (regexp tramp-security-key-confirmed-regexp) + (regexp tramp-security-key-pin-regexp) + (regexp tramp-security-key-timeout-regexp)))))) (when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp) (throw 'tramp-action 'timeout)) (redisplay 'force))) @@ -6726,12 +6736,13 @@ Consults the auth-source package." (tramp-get-connection-property key "login-as"))) (host (tramp-file-name-host-port vec)) (pw-prompt - (or prompt - (with-current-buffer (process-buffer proc) - (tramp-check-for-regexp proc tramp-password-prompt-regexp) - (if (string-match-p "passphrase" (match-string 1)) - (match-string 0) - (format "%s for %s " (capitalize (match-string 1)) key))))) + (string-trim-left + (or prompt + (with-current-buffer (process-buffer proc) + (tramp-check-for-regexp proc tramp-password-prompt-regexp) + (if (string-match-p "passphrase" (match-string 1)) + (match-string 0) + (format "%s for %s " (capitalize (match-string 1)) key)))))) (auth-source-creation-prompts `((secret . ,pw-prompt))) ;; Use connection-local value. (auth-sources (buffer-local-value 'auth-sources (process-buffer proc))) -- cgit v1.2.3 From 8d6a8e573f9a1e4eb9ebbc0ec244907263e61bb8 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 9 Feb 2024 11:21:05 +0100 Subject: Tramp: Handle PIN requests from security keys * doc/misc/tramp.texi (Frequently Asked Questions): Clarify FIDO entry. * lisp/net/tramp-sh.el (tramp-actions-before-shell) (tramp-actions-copy-out-of-band): Use `tramp-security-key-pin-regexp'. * lisp/net/tramp.el (tramp-security-key-pin-regexp): New defcustom. (tramp-action-otp-password, tramp-read-passwd): Trim password prompt. (tramp-action-show-and-confirm-message): Expand for PIN requests. --- doc/misc/tramp.texi | 11 ++++++++--- lisp/net/tramp-sh.el | 2 ++ lisp/net/tramp.el | 30 ++++++++++++++++++++---------- 3 files changed, 30 insertions(+), 13 deletions(-) (limited to 'lisp') diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 56945d3071c..90824024c03 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5238,9 +5238,14 @@ Does @value{tramp} support @acronym{SSH} security keys? Yes. @command{OpenSSH} has added support for @acronym{FIDO} hardware devices via special key types @option{*-sk}. @value{tramp} supports the additional handshaking messages for them. This requires at least -@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} compatible -security key, like yubikey, solokey, nitrokey, or titankey. - +@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} or +@acronym{FIDO2} compatible security key, like yubikey, solokey, +nitrokey, or titankey. +@c @uref{https://docs.fedoraproject.org/en-US/quick-docs/using-yubikeys/} + +@strong{Note} that there are reports on problems of handling yubikey +residential keys by @command{ssh-agent}. As workaround, you might +disable @command{ssh-agent} for such keys. @item @value{tramp} does not connect to Samba or MS Windows hosts running diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 68ee541bee6..3557b3a1b64 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -547,6 +547,7 @@ shell from reading its init file." (tramp-terminal-prompt-regexp tramp-action-terminal) (tramp-antispoof-regexp tramp-action-confirm-message) (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message) + (tramp-security-key-pin-regexp tramp-action-otp-password) (tramp-process-alive-regexp tramp-action-process-alive)) "List of pattern/action pairs. Whenever a pattern matches, the corresponding action is performed. @@ -566,6 +567,7 @@ corresponding PATTERN matches, the ACTION function is called.") (tramp-wrong-passwd-regexp tramp-action-permission-denied) (tramp-copy-failed-regexp tramp-action-permission-denied) (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message) + (tramp-security-key-pin-regexp tramp-action-otp-password) (tramp-process-alive-regexp tramp-action-out-of-band)) "List of pattern/action pairs. This list is used for copying/renaming with out-of-band methods. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 8e114912527..ae59915b1e8 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -770,6 +770,13 @@ The regexp should match at end of buffer." :version "28.1" :type 'regexp) +(defcustom tramp-security-key-pin-regexp + (rx bol (* "\r") (group "Enter PIN for " (* nonl)) (* (any "\r\n"))) + "Regular expression matching security key PIN prompt. +The regexp should match at end of buffer." + :version "29.3" + :type 'regexp) + (defcustom tramp-operation-not-permitted-regexp (rx (| (: "preserving times" (* nonl)) "set mode") ":" (* blank) "Operation not permitted") @@ -5435,7 +5442,7 @@ of." prompt) (goto-char (point-min)) (tramp-check-for-regexp proc tramp-process-action-regexp) - (setq prompt (concat (match-string 1) " ")) + (setq prompt (concat (string-trim (match-string 1)) " ")) (tramp-message vec 3 "Sending %s" (match-string 1)) ;; We don't call `tramp-send-string' in order to hide the ;; password from the debug buffer and the traces. @@ -5511,14 +5518,16 @@ Wait, until the connection buffer changes." (ignore set-message-function clear-message-function) (tramp-message vec 6 "\n%s" (buffer-string)) (tramp-check-for-regexp proc tramp-process-action-regexp) - (with-temp-message - (replace-regexp-in-string (rx (any "\r\n")) "" (match-string 0)) + (with-temp-message (concat (string-trim (match-string 0)) " ") ;; Hide message in buffer. (narrow-to-region (point-max) (point-max)) ;; Wait for new output. (while (not (ignore-error file-error (tramp-wait-for-regexp - proc 0.1 tramp-security-key-confirmed-regexp))) + proc 0.1 + (rx (| (regexp tramp-security-key-confirmed-regexp) + (regexp tramp-security-key-pin-regexp) + (regexp tramp-security-key-timeout-regexp)))))) (when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp) (throw 'tramp-action 'timeout)) (redisplay 'force)))))) @@ -6564,12 +6573,13 @@ Consults the auth-source package." (tramp-get-connection-property key "login-as"))) (host (tramp-file-name-host-port vec)) (pw-prompt - (or prompt - (with-current-buffer (process-buffer proc) - (tramp-check-for-regexp proc tramp-password-prompt-regexp) - (if (string-match-p "passphrase" (match-string 1)) - (match-string 0) - (format "%s for %s " (capitalize (match-string 1)) key))))) + (string-trim-left + (or prompt + (with-current-buffer (process-buffer proc) + (tramp-check-for-regexp proc tramp-password-prompt-regexp) + (if (string-match-p "passphrase" (match-string 1)) + (match-string 0) + (format "%s for %s " (capitalize (match-string 1)) key)))))) (auth-source-creation-prompts `((secret . ,pw-prompt))) ;; Use connection-local value. (auth-sources (buffer-local-value 'auth-sources (process-buffer proc))) -- cgit v1.2.3 From c4ec6d0472beac2a0cb4f5c8baec79e39dfc410b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 9 Feb 2024 14:08:51 -0500 Subject: * lisp/subr.el (read-char-from-minibuffer): Fix bug#68995 --- lisp/subr.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/subr.el b/lisp/subr.el index e53ef505522..f41bb34045e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3726,10 +3726,10 @@ There is no need to explicitly add `help-char' to CHARS; (this-command this-command) (result (minibuffer-with-setup-hook (lambda () + (setq-local post-self-insert-hook nil) (add-hook 'post-command-hook (lambda () - ;; FIXME: Should we use `<='? - (if (= (1+ (minibuffer-prompt-end)) + (if (<= (1+ (minibuffer-prompt-end)) (point-max)) (exit-minibuffer))) nil 'local)) -- cgit v1.2.3 From 3c3702b9bbc79f63026606dc0f391da3d795226d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 9 Feb 2024 14:13:29 -0500 Subject: * lisp/subr.el (with-output-to-temp-buffer): Add `indent` rule --- lisp/emacs-lisp/lisp-mode.el | 1 - lisp/subr.el | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index ad0525e24be..3475d944337 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1347,7 +1347,6 @@ Lisp function does not specify a special indentation." (put 'condition-case 'lisp-indent-function 2) (put 'handler-case 'lisp-indent-function 1) ;CL (put 'unwind-protect 'lisp-indent-function 1) -(put 'with-output-to-temp-buffer 'lisp-indent-function 1) (put 'closure 'lisp-indent-function 2) (defun indent-sexp (&optional endpos) diff --git a/lisp/subr.el b/lisp/subr.el index f41bb34045e..c317d558e24 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5019,7 +5019,7 @@ read-only, and scans it for function and variable names to make them into clickable cross-references. See the related form `with-temp-buffer-window'." - (declare (debug t)) + (declare (debug t) (indent 1)) (let ((old-dir (make-symbol "old-dir")) (buf (make-symbol "buf"))) `(let* ((,old-dir default-directory) -- cgit v1.2.3 From efedb8f479f1f2cf4d7ce703c6411dd756d2843d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 9 Feb 2024 14:22:14 -0500 Subject: modula2.el: Avoid font-lock-*-face variables * lisp/progmodes/modula2.el (m3-font-lock-keywords-1) (m3-font-lock-keywords-2): Refer to the font-lock faces directly --- lisp/progmodes/modula2.el | 47 +++++++++++++++++++++++++---------------------- 1 file changed, 25 insertions(+), 22 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el index 09cb848fd52..2bb31988290 100644 --- a/lisp/progmodes/modula2.el +++ b/lisp/progmodes/modula2.el @@ -325,20 +325,20 @@ followed by the first character of the construct. ;; ;; Module definitions. ("\\<\\(INTERFACE\\|MODULE\\|PROCEDURE\\)\\>[ \t]*\\(\\sw+\\)?" - (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) + (1 'font-lock-keyword-face) (2 'font-lock-function-name-face nil t)) ;; ;; Import directives. ("\\<\\(EXPORTS\\|FROM\\|IMPORT\\)\\>" - (1 font-lock-keyword-face) + (1 'font-lock-keyword-face) (font-lock-match-c-style-declaration-item-and-skip-to-next nil (goto-char (match-end 0)) - (1 font-lock-constant-face))) + (1 'font-lock-constant-face))) ;; ;; Pragmas as warnings. ;; Spencer Allain says do them as comments... ;; ("<\\*.*\\*>" . font-lock-warning-face) ;; ... but instead we fontify the first word. - ("<\\*[ \t]*\\(\\sw+\\)" 1 font-lock-warning-face prepend) + ("<\\*[ \t]*\\(\\sw+\\)" 1 'font-lock-warning-face prepend) ) "Subdued level highlighting for Modula-3 modes.") @@ -366,26 +366,29 @@ followed by the first character of the construct. "LOOPHOLE" "MAX" "MIN" "NARROW" "NEW" "NUMBER" "ORD" "ROUND" "SUBARRAY" "TRUNC" "TYPECODE" "VAL"))) ) - (list - ;; - ;; Keywords except those fontified elsewhere. - (concat "\\<\\(" m3-keywords "\\)\\>") - ;; - ;; Builtins. - (cons (concat "\\<\\(" m3-builtins "\\)\\>") 'font-lock-builtin-face) - ;; - ;; Type names. - (cons (concat "\\<\\(" m3-types "\\)\\>") 'font-lock-type-face) - ;; - ;; Fontify tokens as function names. - '("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*" - (1 font-lock-keyword-face) + `( + ;; + ;; Keywords except those fontified elsewhere. + ,(concat "\\<\\(" m3-keywords "\\)\\>") + ;; + ;; Builtins. + (,(concat "\\<\\(" m3-builtins "\\)\\>") + (0 'font-lock-builtin-face)) + ;; + ;; Type names. + (,(concat "\\<\\(" m3-types "\\)\\>") + (0 'font-lock-type-face)) + ;; + ;; Fontify tokens as function names. + ("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*" + (1 'font-lock-keyword-face) (font-lock-match-c-style-declaration-item-and-skip-to-next nil (goto-char (match-end 0)) - (1 font-lock-function-name-face))) - ;; - ;; Fontify constants as references. - '("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" . font-lock-constant-face) + (1 'font-lock-function-name-face))) + ;; + ;; Fontify constants as references. + ("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" + (0 'font-lock-constant-face)) )))) "Gaudy level highlighting for Modula-3 modes.") -- cgit v1.2.3 From 6568a9a0099e7745bfd142a0fd16b4d7215c0250 Mon Sep 17 00:00:00 2001 From: Mekeor Melire Date: Wed, 7 Feb 2024 23:00:08 +0100 Subject: Add option gnus-mode-line-logo * lisp/gnus/gnus.el (gnus-mode-line-logo): New option specifying whether and which logo will be displayed in the mode-line. * etc/NEWS: Announce the change. --- etc/NEWS | 5 +++++ lisp/gnus/gnus.el | 29 ++++++++++++++++++++--------- 2 files changed, 25 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index 4d3c652aebc..76862bf500d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1102,6 +1102,11 @@ The gmane.org website is, sadly, down since a number of years with no prospect of it coming back. Therefore, it is no longer valid to set the user option 'nnweb-type' to 'gmane'. +*** New user option 'gnus-mode-line-logo'. +This allows the user to either disable the display of any logo or +specify which logo will be displayed as part of the +buffer-identification in the mode-line of Gnus-buffers. + ** Rmail --- diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 99833e4eeca..cf4c3f7841c 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -309,12 +309,30 @@ be set in `.emacs' instead." :group 'gnus-start :type 'boolean) +(defcustom gnus-mode-line-logo + '((:type svg :file "gnus-pointer.svg" :ascent center) + (:type xpm :file "gnus-pointer.xpm" :ascent center) + (:type xbm :file "gnus-pointer.xbm" :ascent center)) + "Gnus logo displayed in mode-line. + +If non-nil, it should be a list of image specifications that will be +given as first argument to `find-image', which see. Then, in case of a +graphical display, the specified Gnus logo will be displayed as part of +the buffer-identification in the mode-line of Gnus-buffers. + +If nil, no logo will be displayed." + :group 'gnus-visual + :type '(choice + (repeat :tag "List of image specifications" (plist)) + (const :tag "No logo" nil))) + (defun gnus-mode-line-buffer-identification (line) (let* ((str (car-safe line)) (str (if (stringp str) (car (propertized-buffer-identification str)) str))) - (if (or (not (fboundp 'find-image)) + (if (or (not gnus-mode-line-logo) + (not (fboundp 'find-image)) (not (display-graphic-p)) (not (stringp str)) (not (string-match "^Gnus:" str))) @@ -325,14 +343,7 @@ be set in `.emacs' instead." (add-text-properties 0 5 (list 'display - (find-image - '((:type svg :file "gnus-pointer.svg" - :ascent center) - (:type xpm :file "gnus-pointer.xpm" - :ascent center) - (:type xbm :file "gnus-pointer.xbm" - :ascent center)) - t) + (find-image gnus-mode-line-logo t) 'help-echo (if gnus-emacs-version (format "This is %s, %s." -- cgit v1.2.3 From 6195a57b8e8ebff4eaaf4ff8d62719cbd55f579f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 09:28:11 +0200 Subject: ; Improve documentation of a recent change in Gnus * lisp/image.el (find-image): Doc fix. * lisp/gnus/gnus.el (gnus-mode-line-logo): Fix doc string and :type texts. Add :version. (Bug#68985) --- etc/NEWS | 1 + lisp/gnus/gnus.el | 15 ++++++++------- lisp/image.el | 26 +++++++++++++++----------- 3 files changed, 24 insertions(+), 18 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index 76862bf500d..ca0a5ed8fc8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1102,6 +1102,7 @@ The gmane.org website is, sadly, down since a number of years with no prospect of it coming back. Therefore, it is no longer valid to set the user option 'nnweb-type' to 'gmane'. +--- *** New user option 'gnus-mode-line-logo'. This allows the user to either disable the display of any logo or specify which logo will be displayed as part of the diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index cf4c3f7841c..dab66b60205 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -313,18 +313,19 @@ be set in `.emacs' instead." '((:type svg :file "gnus-pointer.svg" :ascent center) (:type xpm :file "gnus-pointer.xpm" :ascent center) (:type xbm :file "gnus-pointer.xbm" :ascent center)) - "Gnus logo displayed in mode-line. + "Image spec for the Gnus logo to be displayed in mode-line. -If non-nil, it should be a list of image specifications that will be -given as first argument to `find-image', which see. Then, in case of a -graphical display, the specified Gnus logo will be displayed as part of +If non-nil, it should be a list of image specifications to be passed +as the first argument to `find-image', which see. Then, if the display +is capable of showing images, the Gnus logo will be displayed as part of the buffer-identification in the mode-line of Gnus-buffers. -If nil, no logo will be displayed." +If nil, there will be no Gnus logo in the mode-line." :group 'gnus-visual :type '(choice - (repeat :tag "List of image specifications" (plist)) - (const :tag "No logo" nil))) + (repeat :tag "List of Gnus logo image specifications" (plist)) + (const :tag "Don't display Gnus logo" nil)) + :version "30.1") (defun gnus-mode-line-buffer-identification (line) (let* ((str (car-safe line)) diff --git a/lisp/image.el b/lisp/image.el index 73801f88d1e..2ebce59a98c 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -759,21 +759,25 @@ BUFFER nil or omitted means use the current buffer." ;;;###autoload (defun find-image (specs &optional cache) - "Find an image, choosing one of a list of image specifications. + "Find an image that satisfies one of a list of image specifications. SPECS is a list of image specifications. -Each image specification in SPECS is a property list. The contents of -a specification are image type dependent. All specifications must at -least contain either the property `:file FILE' or `:data DATA', -where FILE is the file to load the image from, and DATA is a string -containing the actual image data. If the property `:type TYPE' is -omitted or nil, try to determine the image type from its first few +Each image specification in SPECS is a property list. The +contents of a specification are image type dependent; see the +info node `(elisp)Image Descriptors' for details. All specifications +must at least contain either the property `:file FILE' or `:data DATA', +where FILE is the file from which to load the image, and DATA is a +string containing the actual image data. If the property `:type TYPE' +is omitted or nil, try to determine the image type from its first few bytes of image data. If that doesn't work, and the property `:file -FILE' provide a file name, use its file extension as image type. -If `:type TYPE' is provided, it must match the actual type -determined for FILE or DATA by `create-image'. Return nil if no -specification is satisfied. +FILE' provide a file name, use its file extension as idication of the +image type. If `:type TYPE' is provided, it must match the actual type +determined for FILE or DATA by `create-image'. + +The function returns the image specification for the first specification +in the list whose TYPE is supported and FILE, if specified, exists. It +returns nil if no specification in the list can be satisfied. If CACHE is non-nil, results are cached and returned on subsequent calls. -- cgit v1.2.3 From 4330eb2864181e49ace5736665c45d8683a5ce1d Mon Sep 17 00:00:00 2001 From: john muhl Date: Thu, 25 Jan 2024 21:23:45 -0600 Subject: Fix volume refresh bug in mpc * lisp/mpc.el (mpc-volume-refresh): Only refresh volume when mpd is playing. When stopped or paused, volume is nil. (Bug#68785) --- lisp/mpc.el | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/mpc.el b/lisp/mpc.el index 9577e0f2f42..768c70c2e3a 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -1867,11 +1867,14 @@ A value of t means the main playlist.") (defvar mpc-volume nil) (put 'mpc-volume 'risky-local-variable t) (defun mpc-volume-refresh () - ;; Maintain the volume. - (setq mpc-volume - (mpc-volume-widget - (string-to-number (cdr (assq 'volume mpc-status))))) - (let ((status-buf (mpc-proc-buffer (mpc-proc) 'status))) + "Maintain the volume." + (let ((status-buf (mpc-proc-buffer (mpc-proc) 'status)) + (status-vol (cdr (assq 'volume mpc-status)))) + ;; If MPD is paused or stopped the volume is nil. + (when status-vol + (setq mpc-volume + (mpc-volume-widget + (string-to-number status-vol)))) (when (buffer-live-p status-buf) (with-current-buffer status-buf (force-mode-line-update))))) -- cgit v1.2.3 From 59b849d1eaffb8babb208f6a39c5e0dbc73e3127 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 10:35:18 +0200 Subject: Run 'read-only-mode-hook' when visiting a file that is not writable * lisp/files.el (after-find-file): Run 'read-only-mode-hook' when the visited file is not writable. (Bug#68648) --- lisp/files.el | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lisp') diff --git a/lisp/files.el b/lisp/files.el index 229771810fb..f67b650cb92 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2747,6 +2747,10 @@ Fifth arg NOMODES non-nil means don't alter the file's modes. Finishes by calling the functions in `find-file-hook' unless NOMODES is non-nil." (setq buffer-read-only (not (file-writable-p buffer-file-name))) + ;; The above is sufficiently like turning on read-only-mode, so run + ;; the mode hook here by hand. + (if buffer-read-only + (run-hooks 'read-only-mode-hook)) (if noninteractive nil (let* (not-serious -- cgit v1.2.3 From 55aea7967604112343ff67597cbe9fc20acd9196 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 10 Feb 2024 09:50:12 +0100 Subject: Fix warning in tramp-register-archive-autoload-file-name-handler * lisp/net/tramp-archive.el (tramp-register-archive-autoload-file-name-handler): Do not use read syntax #' for `tramp-archive-file-name-handler', it isn't autoloaded. --- lisp/net/tramp-archive.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 752462d8fa3..59c4223794c 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -387,9 +387,11 @@ arguments to pass to the OPERATION." ;;;###autoload (progn (defun tramp-register-archive-autoload-file-name-handler () "Add archive file name handler to `file-name-handler-alist'." + ;; Do not use read syntax #' for `tramp-archive-file-name-handler', it + ;; isn't autoloaded. (when (and tramp-archive-enabled (not - (rassq #'tramp-archive-file-name-handler file-name-handler-alist))) + (rassq 'tramp-archive-file-name-handler file-name-handler-alist))) (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) #'tramp-archive-autoload-file-name-handler)) -- cgit v1.2.3 From 20f7a022f817eaed5f6889d9a892c22fc46f0d2f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 11:04:22 +0200 Subject: Avoid errors in winner.el's 'post-command-hook' * lisp/winner.el (winner-save-old-configurations): Don't save configuration of dead frames. (Bug#68977) --- lisp/winner.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/winner.el b/lisp/winner.el index 2aa59a86b25..19641a05bfc 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -178,7 +178,8 @@ You may want to include buffer names such as *Help*, *Apropos*, (setq winner-last-frames nil) (setq winner-last-command this-command)) (dolist (frame winner-modified-list) - (winner-insert-if-new frame)) + (if (frame-live-p frame) + (winner-insert-if-new frame))) (setq winner-modified-list nil) (winner-remember))) -- cgit v1.2.3 From 86c5b7c49c0b61413e41f8a95a2f0c7f09cd1db7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 11:10:08 +0200 Subject: * lisp/bind-key.el (personal-keybindings): Autoload it (bug#68999). --- lisp/bind-key.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/bind-key.el b/lisp/bind-key.el index 94a39f795cd..378ad69b2bc 100644 --- a/lisp/bind-key.el +++ b/lisp/bind-key.el @@ -155,6 +155,7 @@ add keys to that keymap." (add-to-list 'emulation-mode-map-alists `((override-global-mode . ,override-global-map))) +;;;###autoload (defvar personal-keybindings nil "List of bindings performed by `bind-key'. -- cgit v1.2.3 From 13ee21eb48bedc1779985c3f60010aadbbd99630 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 11:20:22 +0200 Subject: Support Info files compressed by 'lzip' * lisp/info.el (Info-suffix-list): Support lzip compression of Info files. (Bug#69004) --- lisp/info.el | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lisp') diff --git a/lisp/info.el b/lisp/info.el index e91cc7b8e54..d4d9085a787 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -499,6 +499,7 @@ or `Info-virtual-nodes'." (".info.bz2" . ("bzip2" "-dc")) (".info.xz" . "unxz") (".info.zst" . ("zstd" "-dc")) + (".info.lz" . ("lzip" "-dc")) (".info" . nil) ("-info.Z" . "uncompress") ("-info.Y" . "unyabba") @@ -507,6 +508,7 @@ or `Info-virtual-nodes'." ("-info.z" . "gunzip") ("-info.xz" . "unxz") ("-info.zst" . ("zstd" "-dc")) + ("-info.lz" . ("lzip" "-dc")) ("-info" . nil) ("/index.Z" . "uncompress") ("/index.Y" . "unyabba") @@ -515,6 +517,7 @@ or `Info-virtual-nodes'." ("/index.bz2" . ("bzip2" "-dc")) ("/index.xz" . "unxz") ("/index.zst" . ("zstd" "-dc")) + ("/index.lz" . ("lzip" "-dc")) ("/index" . nil) (".Z" . "uncompress") (".Y" . "unyabba") @@ -523,6 +526,7 @@ or `Info-virtual-nodes'." (".bz2" . ("bzip2" "-dc")) (".xz" . "unxz") (".zst" . ("zstd" "-dc")) + (".lz" . ("lzip" "-dc")) ("" . nil))) "List of file name suffixes and associated decoding commands. Each entry should be (SUFFIX . STRING); the file is given to -- cgit v1.2.3 From 717d8c4285fa6eecc0bbec9b5910f028f02aab59 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 13:00:51 +0200 Subject: Don't quote 't' in doc strings * lisp/outline.el (outline-minor-mode-use-buttons): Doc fix. Patch by Arash Esbati . (Bug#69012) --- lisp/outline.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/outline.el b/lisp/outline.el index 96e0d0df205..724263ef3d2 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -318,8 +318,8 @@ Using the value `insert' is not recommended in editable buffers because it modifies them. When the value is `in-margins', then clickable buttons are displayed in the margins before the headings. -When the value is `t', clickable buttons are displayed -in the buffer before the headings. The values `t' and +When the value is t, clickable buttons are displayed +in the buffer before the headings. The values t and `in-margins' can be used in editing buffers because they don't modify the buffer." ;; The value `insert' is not intended to be customizable. -- cgit v1.2.3 From 7e8b1863af8c820c2969c1a4666ae4451cbcea92 Mon Sep 17 00:00:00 2001 From: Damien Cassou Date: Wed, 7 Feb 2024 20:41:44 +0100 Subject: Add support for deriving major modes in which-func * lisp/progmodes/which-func.el (which-func-try-to-enable) (which-func-ff-hook): Use `derived-mode-p' to check if the current major mode is within `which-func-modes' or `which-func-non-auto-modes'. (Bug#68981) --- lisp/progmodes/which-func.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index bd68672f905..631cb3b0aef 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -211,7 +211,7 @@ non-nil.") (when which-function-mode (unless (local-variable-p 'which-func-mode) (setq which-func-mode (or (eq which-func-modes t) - (member major-mode which-func-modes))) + (apply #'derived-mode-p which-func-modes))) (setq which-func--use-mode-line (member which-func-display '(mode mode-and-header))) (setq which-func--use-header-line @@ -239,7 +239,7 @@ It creates the Imenu index for the buffer, if necessary." (condition-case err (if (and which-func-mode - (not (member major-mode which-func-non-auto-modes)) + (not (apply #'derived-mode-p which-func-non-auto-modes)) (or (null which-func-maxout) (< buffer-saved-size which-func-maxout) (= which-func-maxout 0))) -- cgit v1.2.3 From 55b4a743b6f3d452d98f135763b00965caba5240 Mon Sep 17 00:00:00 2001 From: Steven Allen Date: Sat, 27 Jan 2024 08:17:08 -0800 Subject: Record dependencies in packages installed via package-vc * lisp/emacs-lisp/package-vc.el (package-vc--unpack-1): Record a package's declared dependencies in the package's metadata file. (Bug#68761) --- lisp/emacs-lisp/package-vc.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index db0cc515e46..fc402716dab 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -532,6 +532,7 @@ documentation and marking the package as installed." (setq deps)))))) (dolist (dep deps) (cl-callf version-to-list (cadr dep))) + (setf (package-desc-reqs pkg-desc) deps) (setf missing (package-vc-install-dependencies (delete-dups deps))) (setf missing (delq (assq (package-desc-name pkg-desc) missing) -- cgit v1.2.3 From 939187fd7a07249a1a76d98e8d91051fa76b8727 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 10 Feb 2024 17:30:27 +0100 Subject: ; Fix 'thing-at-point' edge case involving overlapping matches * lisp/thingatpt.el (thing-at-point-looking-at): When finding a match that ends before point, continue searching from the beginning of that match, not its end, in case the match we're looking is overlapping with this one. * test/lisp/thingatpt-tests.el (thing-at-point-looking-at-overlapping-matches): New test. --- lisp/thingatpt.el | 3 ++- test/lisp/thingatpt-tests.el | 7 +++++++ 2 files changed, 9 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index b532bafff82..83ddc640d35 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -621,13 +621,14 @@ Optional argument DISTANCE limits search for REGEXP forward and back from point." (let* ((old (point)) (beg (if distance (max (point-min) (- old distance)) (point-min))) - (end (and distance (min (point-max) (+ old distance)))) + (end (if distance (min (point-max) (+ old distance)))) prev match) (save-excursion (goto-char beg) (while (and (setq prev (point) match (re-search-forward regexp end t)) (< (match-end 0) old)) + (goto-char (match-beginning 0)) ;; Avoid inflooping when `regexp' matches the empty string. (unless (< prev (point)) (forward-char)))) (and match (<= (match-beginning 0) old (match-end 0))))) diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index 56bc4fdc9dc..e50738f1122 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -182,6 +182,13 @@ position to retrieve THING.") (should (thing-at-point-looking-at "2abcd")) (should (equal (match-data) m2))))) +(ert-deftest thing-at-point-looking-at-overlapping-matches () + (with-temp-buffer + (insert "foo.bar.baz") + (goto-char (point-max)) + (should (thing-at-point-looking-at "[a-z]+\\.[a-z]+")) + (should (string= "bar.baz" (match-string 0))))) + (ert-deftest test-symbol-thing-1 () (with-temp-buffer (insert "foo bar zot") -- cgit v1.2.3 From 0a01b998d13027e5672592f9e60919aa683bad9e Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 10 Feb 2024 19:34:23 +0200 Subject: * lisp/menu-bar.el (menu-bar-showhide-menu): Add "Outlines" (bug#68979). The menu item "Outlines" toggles 'outline-minor-mode' when one of outline-search-function/outline-regexp/outline-level is defined in the current buffer. --- lisp/menu-bar.el | 9 +++++++++ 1 file changed, 9 insertions(+) (limited to 'lisp') diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 47c6a8f0613..5b290899ff5 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1353,6 +1353,15 @@ mail status in mode line")) (frame-visible-p (symbol-value 'speedbar-frame)))))) + (bindings--define-key menu [showhide-outline-minor-mode] + '(menu-item "Outlines" outline-minor-mode + :help "Turn outline-minor-mode on/off" + :visible (seq-some #'local-variable-p + '(outline-search-function + outline-regexp outline-level)) + :button (:toggle . (and (boundp 'outline-minor-mode) + outline-minor-mode)))) + (bindings--define-key menu [showhide-tab-line-mode] '(menu-item "Window Tab Line" global-tab-line-mode :help "Turn window-local tab-lines on/off" -- cgit v1.2.3 From 3e5aba883770312536ca7a8f289bf679e55802f5 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 10 Feb 2024 19:56:39 +0200 Subject: * lisp/buff-menu.el: Force other-window commands to use other window. (Buffer-menu-other-window, Buffer-menu-switch-other-window): Let-bind 'display-buffer-overriding-action' to '(nil (inhibit-same-window . t))' that will force the buffer to be displayed in another window in any case (bug#68978). --- lisp/buff-menu.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 10ea99eae9a..e13c3b56b4e 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -592,13 +592,17 @@ If UNMARK is non-nil, unmark them." (defun Buffer-menu-other-window () "Select this line's buffer in other window, leaving buffer menu visible." (interactive nil Buffer-menu-mode) - (switch-to-buffer-other-window (Buffer-menu-buffer t))) + (let ((display-buffer-overriding-action + '(nil (inhibit-same-window . t)))) + (switch-to-buffer-other-window (Buffer-menu-buffer t)))) (defun Buffer-menu-switch-other-window () "Make the other window select this line's buffer. The current window remains selected." (interactive nil Buffer-menu-mode) - (display-buffer (Buffer-menu-buffer t) t)) + (let ((display-buffer-overriding-action + '(nil (inhibit-same-window . t)))) + (display-buffer (Buffer-menu-buffer t) t))) (defun Buffer-menu-2-window () "Select this line's buffer, with previous buffer in second window." -- cgit v1.2.3 From 7a0ee5d65f214102734dd22edb641b164a1b73af Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sat, 10 Feb 2024 10:33:51 -0800 Subject: Fix behavior of gnus-summary-very-wide-reply with prefix arg * lisp/gnus/gnus-msg.el (gnus-summary-very-wide-reply): If a prefix argument has been given, the value of YANK will be a list containing the current article number. This should not be used to retrieve a number of work articles; that should be derived from the value of the current-prefix-arg (or marked articles). * doc/misc/gnus.texi: The interplay of prefix arg and marked articles is complex; attempt to clarify. --- doc/misc/gnus.texi | 9 +++++---- lisp/gnus/gnus-msg.el | 4 ++-- 2 files changed, 7 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 08554d0d9b9..2f8f97e5845 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -5832,10 +5832,11 @@ message to the mailing list, and include the original message @kindex S v @r{(Summary)} @findex gnus-summary-very-wide-reply Mail a very wide reply to the author of the current article -(@code{gnus-summary-very-wide-reply}). A @dfn{very wide reply} is a reply -that goes out to all people listed in the @code{To}, @code{From} (or -@code{Reply-To}) and @code{Cc} headers in all the process/prefixed -articles. This command uses the process/prefix convention. +(@code{gnus-summary-very-wide-reply}). A @dfn{very wide reply} is a +reply that goes out to all people listed in the @code{To}, @code{From} +(or @code{Reply-To}) and @code{Cc} headers in all the process/prefixed +articles. This command uses the process/prefix convention. If given a +prefix argument, the body of the current article will also be yanked. @item S V @kindex S V @r{(Summary)} diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index fdf97e1aabd..b18ede58fbf 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1189,12 +1189,12 @@ Uses the process/prefix convention. The reply will include all From/Cc headers from the original messages as the To/Cc headers. -If prefix argument YANK is non-nil, the original article(s) will +If prefix argument YANK is non-nil, the original article will be yanked automatically." (interactive (list (and current-prefix-arg (gnus-summary-work-articles 1))) gnus-summary-mode) - (gnus-summary-reply yank t (gnus-summary-work-articles yank))) + (gnus-summary-reply yank t (gnus-summary-work-articles current-prefix-arg))) (defun gnus-summary-very-wide-reply-with-original (n) "Start composing a very wide reply mail a set of messages. -- cgit v1.2.3 From 9f9da26e0dcb242327af7cd8414fad7afedbbaa9 Mon Sep 17 00:00:00 2001 From: Loïc Lemaître Date: Sun, 11 Feb 2024 05:00:38 +0200 Subject: Handle typescript ts grammar breaking change for function_expression Starting from version 0.20.4 of the typescript/tsx grammar, "function" becomes "function_expression". The right expression is used depending on the grammar version. * lisp/progmodes/typescript-ts-mode.el (tsx-ts-mode--font-lock-compatibility-function-expression): New function (bug#69024). (typescript-ts-mode--font-lock-settings): Use it. Copyright-paperwork-exempt: yes --- lisp/progmodes/typescript-ts-mode.el | 362 ++++++++++++++++++----------------- 1 file changed, 188 insertions(+), 174 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 89ca47571eb..7021f012dcd 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -199,183 +199,197 @@ Argument LANGUAGE is either `typescript' or `tsx'." [(nested_identifier (identifier)) (identifier)] @typescript-ts-jsx-tag-face))))) +(defun tsx-ts-mode--font-lock-compatibility-function-expression (language) + "Handle tree-sitter grammar breaking change for `function' expression. + +LANGUAGE can be `typescript' or `tsx'. Starting from version 0.20.4 of the +typescript/tsx grammar, `function' becomes `function_expression'." + (condition-case nil + (progn (treesit-query-capture language '((function_expression) @cap)) + ;; New version of the grammar + 'function_expression) + (treesit-query-error + ;; Old version of the grammar + 'function))) + (defun typescript-ts-mode--font-lock-settings (language) "Tree-sitter font-lock settings. Argument LANGUAGE is either `typescript' or `tsx'." - (treesit-font-lock-rules - :language language - :feature 'comment - `([(comment) (hash_bang_line)] @font-lock-comment-face) - - :language language - :feature 'constant - `(((identifier) @font-lock-constant-face - (:match "\\`[A-Z_][0-9A-Z_]*\\'" @font-lock-constant-face)) - [(true) (false) (null)] @font-lock-constant-face) - - :language language - :feature 'keyword - `([,@typescript-ts-mode--keywords] @font-lock-keyword-face - [(this) (super)] @font-lock-keyword-face) - - :language language - :feature 'string - `((regex pattern: (regex_pattern)) @font-lock-regexp-face - (string) @font-lock-string-face - (template_string) @js--fontify-template-string - (template_substitution ["${" "}"] @font-lock-misc-punctuation-face)) - - :language language - :override t ;; for functions assigned to variables - :feature 'declaration - `((function - name: (identifier) @font-lock-function-name-face) - (function_declaration - name: (identifier) @font-lock-function-name-face) - (function_signature - name: (identifier) @font-lock-function-name-face) - - (method_definition - name: (property_identifier) @font-lock-function-name-face) - (method_signature - name: (property_identifier) @font-lock-function-name-face) - (required_parameter (identifier) @font-lock-variable-name-face) - (optional_parameter (identifier) @font-lock-variable-name-face) - - (variable_declarator - name: (identifier) @font-lock-function-name-face - value: [(function) (arrow_function)]) - - (variable_declarator - name: (identifier) @font-lock-variable-name-face) - - (enum_declaration (identifier) @font-lock-type-face) - - (extends_clause value: (identifier) @font-lock-type-face) - ;; extends React.Component - (extends_clause value: (member_expression - object: (identifier) @font-lock-type-face - property: (property_identifier) @font-lock-type-face)) - - (arrow_function - parameter: (identifier) @font-lock-variable-name-face) - - (variable_declarator - name: (array_pattern - (identifier) - (identifier) @font-lock-function-name-face) - value: (array (number) (function))) - - (catch_clause - parameter: (identifier) @font-lock-variable-name-face) - - ;; full module imports - (import_clause (identifier) @font-lock-variable-name-face) - ;; named imports with aliasing - (import_clause (named_imports (import_specifier - alias: (identifier) @font-lock-variable-name-face))) - ;; named imports without aliasing - (import_clause (named_imports (import_specifier - !alias - name: (identifier) @font-lock-variable-name-face))) - - ;; full namespace import (* as alias) - (import_clause (namespace_import (identifier) @font-lock-variable-name-face))) - - :language language - :feature 'identifier - `((nested_type_identifier - module: (identifier) @font-lock-type-face) - - (type_identifier) @font-lock-type-face - - (predefined_type) @font-lock-type-face - - (new_expression - constructor: (identifier) @font-lock-type-face) - - (enum_body (property_identifier) @font-lock-type-face) - - (enum_assignment name: (property_identifier) @font-lock-type-face) - - (variable_declarator - name: (identifier) @font-lock-variable-name-face) - - (for_in_statement - left: (identifier) @font-lock-variable-name-face) - - (arrow_function - parameters: - [(_ (identifier) @font-lock-variable-name-face) - (_ (_ (identifier) @font-lock-variable-name-face)) - (_ (_ (_ (identifier) @font-lock-variable-name-face)))])) - - :language language - :feature 'property - `((property_signature - name: (property_identifier) @font-lock-property-name-face) - (public_field_definition - name: (property_identifier) @font-lock-property-name-face) - - (pair key: (property_identifier) @font-lock-property-use-face) - - ((shorthand_property_identifier) @font-lock-property-use-face)) - - :language language - :feature 'expression - '((assignment_expression - left: [(identifier) @font-lock-function-name-face - (member_expression - property: (property_identifier) @font-lock-function-name-face)] - right: [(function) (arrow_function)])) - - :language language - :feature 'function - '((call_expression - function: - [(identifier) @font-lock-function-call-face - (member_expression - property: (property_identifier) @font-lock-function-call-face)])) - - :language language - :feature 'pattern - `((pair_pattern - key: (property_identifier) @font-lock-property-use-face - value: [(identifier) @font-lock-variable-name-face - (assignment_pattern left: (identifier) @font-lock-variable-name-face)]) - - (array_pattern (identifier) @font-lock-variable-name-face) - - ((shorthand_property_identifier_pattern) @font-lock-variable-name-face)) - - :language language - :feature 'jsx - (append (tsx-ts-mode--font-lock-compatibility-bb1f97b language) - `((jsx_attribute (property_identifier) @typescript-ts-jsx-attribute-face))) - - :language language - :feature 'number - `((number) @font-lock-number-face - ((identifier) @font-lock-number-face - (:match "\\`\\(?:NaN\\|Infinity\\)\\'" @font-lock-number-face))) - - :language language - :feature 'operator - `([,@typescript-ts-mode--operators] @font-lock-operator-face - (ternary_expression ["?" ":"] @font-lock-operator-face)) - - :language language - :feature 'bracket - '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) - - :language language - :feature 'delimiter - '((["," "." ";" ":"]) @font-lock-delimiter-face) - - :language language - :feature 'escape-sequence - :override t - '((escape_sequence) @font-lock-escape-face))) + (let ((func-exp (tsx-ts-mode--font-lock-compatibility-function-expression language))) + (treesit-font-lock-rules + :language language + :feature 'comment + `([(comment) (hash_bang_line)] @font-lock-comment-face) + + :language language + :feature 'constant + `(((identifier) @font-lock-constant-face + (:match "\\`[A-Z_][0-9A-Z_]*\\'" @font-lock-constant-face)) + [(true) (false) (null)] @font-lock-constant-face) + + :language language + :feature 'keyword + `([,@typescript-ts-mode--keywords] @font-lock-keyword-face + [(this) (super)] @font-lock-keyword-face) + + :language language + :feature 'string + `((regex pattern: (regex_pattern)) @font-lock-regexp-face + (string) @font-lock-string-face + (template_string) @js--fontify-template-string + (template_substitution ["${" "}"] @font-lock-misc-punctuation-face)) + + :language language + :override t ;; for functions assigned to variables + :feature 'declaration + `((,func-exp + name: (identifier) @font-lock-function-name-face) + (function_declaration + name: (identifier) @font-lock-function-name-face) + (function_signature + name: (identifier) @font-lock-function-name-face) + + (method_definition + name: (property_identifier) @font-lock-function-name-face) + (method_signature + name: (property_identifier) @font-lock-function-name-face) + (required_parameter (identifier) @font-lock-variable-name-face) + (optional_parameter (identifier) @font-lock-variable-name-face) + + (variable_declarator + name: (identifier) @font-lock-function-name-face + value: [(,func-exp) (arrow_function)]) + + (variable_declarator + name: (identifier) @font-lock-variable-name-face) + + (enum_declaration (identifier) @font-lock-type-face) + + (extends_clause value: (identifier) @font-lock-type-face) + ;; extends React.Component + (extends_clause value: (member_expression + object: (identifier) @font-lock-type-face + property: (property_identifier) @font-lock-type-face)) + + (arrow_function + parameter: (identifier) @font-lock-variable-name-face) + + (variable_declarator + name: (array_pattern + (identifier) + (identifier) @font-lock-function-name-face) + value: (array (number) (,func-exp))) + + (catch_clause + parameter: (identifier) @font-lock-variable-name-face) + + ;; full module imports + (import_clause (identifier) @font-lock-variable-name-face) + ;; named imports with aliasing + (import_clause (named_imports (import_specifier + alias: (identifier) @font-lock-variable-name-face))) + ;; named imports without aliasing + (import_clause (named_imports (import_specifier + !alias + name: (identifier) @font-lock-variable-name-face))) + + ;; full namespace import (* as alias) + (import_clause (namespace_import (identifier) @font-lock-variable-name-face))) + + :language language + :feature 'identifier + `((nested_type_identifier + module: (identifier) @font-lock-type-face) + + (type_identifier) @font-lock-type-face + + (predefined_type) @font-lock-type-face + + (new_expression + constructor: (identifier) @font-lock-type-face) + + (enum_body (property_identifier) @font-lock-type-face) + + (enum_assignment name: (property_identifier) @font-lock-type-face) + + (variable_declarator + name: (identifier) @font-lock-variable-name-face) + + (for_in_statement + left: (identifier) @font-lock-variable-name-face) + + (arrow_function + parameters: + [(_ (identifier) @font-lock-variable-name-face) + (_ (_ (identifier) @font-lock-variable-name-face)) + (_ (_ (_ (identifier) @font-lock-variable-name-face)))])) + + :language language + :feature 'property + `((property_signature + name: (property_identifier) @font-lock-property-name-face) + (public_field_definition + name: (property_identifier) @font-lock-property-name-face) + + (pair key: (property_identifier) @font-lock-property-use-face) + + ((shorthand_property_identifier) @font-lock-property-use-face)) + + :language language + :feature 'expression + `((assignment_expression + left: [(identifier) @font-lock-function-name-face + (member_expression + property: (property_identifier) @font-lock-function-name-face)] + right: [(,func-exp) (arrow_function)])) + + :language language + :feature 'function + '((call_expression + function: + [(identifier) @font-lock-function-call-face + (member_expression + property: (property_identifier) @font-lock-function-call-face)])) + + :language language + :feature 'pattern + `((pair_pattern + key: (property_identifier) @font-lock-property-use-face + value: [(identifier) @font-lock-variable-name-face + (assignment_pattern left: (identifier) @font-lock-variable-name-face)]) + + (array_pattern (identifier) @font-lock-variable-name-face) + + ((shorthand_property_identifier_pattern) @font-lock-variable-name-face)) + + :language language + :feature 'jsx + (append (tsx-ts-mode--font-lock-compatibility-bb1f97b language) + `((jsx_attribute (property_identifier) @typescript-ts-jsx-attribute-face))) + + :language language + :feature 'number + `((number) @font-lock-number-face + ((identifier) @font-lock-number-face + (:match "\\`\\(?:NaN\\|Infinity\\)\\'" @font-lock-number-face))) + + :language language + :feature 'operator + `([,@typescript-ts-mode--operators] @font-lock-operator-face + (ternary_expression ["?" ":"] @font-lock-operator-face)) + + :language language + :feature 'bracket + '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) + + :language language + :feature 'delimiter + '((["," "." ";" ":"]) @font-lock-delimiter-face) + + :language language + :feature 'escape-sequence + :override t + '((escape_sequence) @font-lock-escape-face)))) ;;;###autoload (define-derived-mode typescript-ts-base-mode prog-mode "TypeScript" -- cgit v1.2.3 From 30b4d902326546ca2b383d56caadbe0adaf0fe89 Mon Sep 17 00:00:00 2001 From: Mekeor Melire Date: Fri, 9 Feb 2024 23:30:52 +0100 Subject: In Info-url-alist, add .html extension to %e format-sequence * lisp/info.el (Info-url-for-node): Implement the change. (Bug#68970) (Info-url-alist): Document the change. * test/lisp/info-tests.el (test-info-urls): Adjust tests to account for the change and add a test for the "Top" node. --- lisp/info.el | 31 +++++++++++++++++-------------- test/lisp/info-tests.el | 16 +++++++++------- 2 files changed, 26 insertions(+), 21 deletions(-) (limited to 'lisp') diff --git a/lisp/info.el b/lisp/info.el index d4d9085a787..176bc9c0033 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -231,8 +231,9 @@ Each element of this list has the form (MANUALs . URL-SPEC). MANUALs represents the name of one or more manuals. It can either be a string or a list of strings. URL-SPEC can be a string in which the substring \"%m\" will be expanded to the -manual-name, \"%n\" to the node-name, and \"%e\" to the -URL-encoded node-name (without a `.html' suffix). (The +manual-name and \"%n\" to the node-name. \"%e\" will expand to +the URL-encoded node-name, including the `.html' extension; in +case of the Top node, it will expand to the empty string. (The URL-encoding of the node-name mimics GNU Texinfo, as documented at Info node `(texinfo)HTML Xref Node Name Expansion'.) Alternatively, URL-SPEC can be a function which is given @@ -1928,18 +1929,20 @@ NODE should be a string of the form \"(manual)Node\"." ;; (info "(texinfo) HTML Xref Node Name Expansion") (if (equal node "Top") "" - (url-hexify-string - (string-replace " " "-" - (mapconcat - (lambda (ch) - (if (or (< ch 32) ; ^@^A-^Z^[^\^]^^^- - (<= 33 ch 47) ; !"#$%&'()*+,-./ - (<= 58 ch 64) ; :;<=>?@ - (<= 91 ch 96) ; [\]_` - (<= 123 ch 127)) ; {|}~ DEL - (format "_00%x" ch) - (char-to-string ch))) - node "")))))) + (concat + (url-hexify-string + (string-replace " " "-" + (mapconcat + (lambda (ch) + (if (or (< ch 32) ; ^@^A-^Z^[^\^]^^^- + (<= 33 ch 47) ; !"#$%&'()*+,-./ + (<= 58 ch 64) ; :;<=>?@ + (<= 91 ch 96) ; [\]_` + (<= 123 ch 127)) ; {|}~ DEL + (format "_00%x" ch) + (char-to-string ch))) + node ""))) + ".html")))) (cond ((stringp url-spec) (format-spec url-spec diff --git a/test/lisp/info-tests.el b/test/lisp/info-tests.el index 0dfdbf417e8..8020a7419cf 100644 --- a/test/lisp/info-tests.el +++ b/test/lisp/info-tests.el @@ -28,18 +28,20 @@ (require 'ert-x) (ert-deftest test-info-urls () + (should (equal (Info-url-for-node "(tramp)Top") + "https://www.gnu.org/software/emacs/manual/html_node/tramp/")) (should (equal (Info-url-for-node "(emacs)Minibuffer") - "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer")) + "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer.html")) (should (equal (Info-url-for-node "(emacs)Minibuffer File") - "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer-File")) + "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer-File.html")) (should (equal (Info-url-for-node "(elisp)Backups and Auto-Saving") - "https://www.gnu.org/software/emacs/manual/html_node/elisp/Backups-and-Auto_002dSaving")) + "https://www.gnu.org/software/emacs/manual/html_node/elisp/Backups-and-Auto_002dSaving.html")) (should (equal (Info-url-for-node "(eintr)car & cdr") - "https://www.gnu.org/software/emacs/manual/html_node/eintr/car-_0026-cdr")) + "https://www.gnu.org/software/emacs/manual/html_node/eintr/car-_0026-cdr.html")) (should (equal (Info-url-for-node "(emacs-mime)\tIndex") - "https://www.gnu.org/software/emacs/manual/html_node/emacs-mime/Index")) - (should (equal (Info-url-for-node "(gnus) Don't Panic") - "https://www.gnu.org/software/emacs/manual/html_node/gnus/Don_0027t-Panic")) + "https://www.gnu.org/software/emacs/manual/html_node/emacs-mime/Index.html")) + (should (equal (Info-url-for-node "(gnus) Don't Panic") + "https://www.gnu.org/software/emacs/manual/html_node/gnus/Don_0027t-Panic.html")) (should-error (Info-url-for-node "(nonexistent)Example"))) ;;; info-tests.el ends here -- cgit v1.2.3 From 614b244a7fa03fcb27d76757e14ef0fa895d6f23 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 11 Feb 2024 10:43:57 +0100 Subject: * Improve reproducibility of inferred values by native comp * lisp/emacs-lisp/comp-cstr.el (comp-normalize-valset): Do not try to reorder conses using 'sxhash-equal' as its behavior is not reproducible over different sessions. --- lisp/emacs-lisp/comp-cstr.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 812a79f070d..ecbe6e38a1d 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -203,6 +203,8 @@ Return them as multiple value." t) ((and (not (symbolp x)) (symbolp y)) nil) + ((or (consp x) (consp y) + nil)) (t (< (sxhash-equal x) (sxhash-equal y))))))) -- cgit v1.2.3 From faa46eb8667c11a0725500a50e957eb78021c99f Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 11 Feb 2024 12:31:13 +0100 Subject: Rename a number of native compiler functions * lisp/emacs-lisp/comp.el (comp-passes): Update. (comp-mvar): Update constructor name. (comp--loop-insn-in-block, comp--lex-byte-func-p) (comp--spill-decl-spec, comp--spill-speed) (comp--decrypt-arg-list, comp--byte-frame-size) (comp--add-func-to-ctxt, comp--spill-lap-function) (comp--intern-func-in-ctxt, comp--spill-lap-function) (comp--spill-lap, comp--lap-eob-p, comp--lap-fall-through-p) (comp--sp, comp--with-sp, comp--slot-n, comp--slot, comp-slot+1) (comp--label-to-addr, comp--mark-curr-bb-closed) (comp--bb-maybe-add, comp--call, comp--callref, make-comp-mvar) (comp--new-frame, comp--emit, comp--emit-set-call) (comp--copy-slot, comp--emit-annotation, comp--emit-setimm) (comp--make-curr-block, comp--latch-make-fill) (comp--emit-uncond-jump, comp--emit-cond-jump) (comp--emit-handler, comp--limplify-listn, comp--new-block-sym) (comp--fill-label-h, comp--jump-table-optimizable) (comp--emit-switch, comp--emit-set-call-subr, comp--op-to-fun) (comp--body-eff, comp--op-case, comp--limplify-lap-inst) (comp--emit-narg-prologue, comp--limplify-finalize-function) (comp--prepare-args-for-top-level, comp--emit-for-top-level) (comp--emit-lambda-for-top-level, comp--limplify-top-level) (comp--addr-to-bb-name, comp--limplify-block) (comp--limplify-function, comp--limplify, comp--mvar-used-p) (comp--collect-mvars, comp--collect-rhs) (comp--negate-arithm-cmp-fun, comp--reverse-arithm-fun) (comp--emit-assume, comp--maybe-add-vmvar) (comp--add-new-block-between, comp--cond-cstrs-target-mvar) (comp--add-cond-cstrs-target-block, comp--add-cond-cstrs-simple) (comp--add-cond-cstrs, comp--insert-insn, comp--emit-call-cstr) (comp--lambda-list-gen, comp--add-call-cstr, comp--add-cstrs) (comp--collect-calls, comp--pure-infer-func, comp--ipa-pure) (make--comp--ssa-mvar, comp--clean-ssa, comp--compute-edges) (comp--collect-rev-post-order, comp--compute-dominator-tree) (comp--compute-dominator-frontiers, comp--log-block-info) (comp--place-phis, comp--dom-tree-walker, comp--ssa) (comp--ssa-rename-insn, comp--ssa-rename, comp--finalize-phis) (comp--remove-unreachable-blocks, comp--ssa) (comp--fwprop-max-insns-scan, comp--copy-insn) (comp--apply-in-env, comp--fwprop-prologue) (comp--function-foldable-p, comp--function-call-maybe-fold) (comp--fwprop-call, comp--fwprop-insn, comp--fwprop*) (comp--rewrite-non-locals, comp--fwprop, comp--func-in-unit) (comp--call-optim-form-call, comp--call-optim-func) (comp--call-optim, comp--collect-mvar-ids) (comp--dead-assignments-func, comp--dead-code) (comp--form-tco-call-seq, comp--tco-func, comp--tco) (comp--remove-type-hints-func, comp--remove-type-hints) (comp--args-to-lambda-list, comp--compute-function-type) (comp--finalize-container, comp--finalize-relocs) (comp--compile-ctxt-to-file, comp--final1, comp--final) (comp--make-lambda-list-from-subr, comp-trampoline-compile) (comp--write-bytecode-file): Rename and/or update due to renaming. * test/src/comp-resources/comp-test-funcs.el (comp-test-copy-insn-f): Update. * src/comp.c (Fcomp__compile_ctxt_to_file0): Rename. (syms_of_comp): Update. --- lisp/emacs-lisp/comp.el | 974 +++++++++++++++-------------- src/comp.c | 6 +- test/src/comp-resources/comp-test-funcs.el | 4 +- 3 files changed, 493 insertions(+), 491 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index dcdc973e6c5..6879e6aeeb9 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -43,7 +43,7 @@ (defvar native-comp-eln-load-path) (defvar native-comp-enable-subr-trampolines) -(declare-function comp--compile-ctxt-to-file "comp.c") +(declare-function comp--compile-ctxt-to-file0 "comp.c") (declare-function comp--init-ctxt "comp.c") (declare-function comp--release-ctxt "comp.c") (declare-function comp-el-to-eln-filename "comp.c") @@ -155,17 +155,17 @@ native compilation runs.") "Current allocation class. Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.") -(defconst comp-passes '(comp-spill-lap - comp-limplify - comp-fwprop - comp-call-optim - comp-ipa-pure - comp-add-cstrs - comp-fwprop - comp-tco - comp-fwprop - comp-remove-type-hints - comp-final) +(defconst comp-passes '(comp--spill-lap + comp--limplify + comp--fwprop + comp--call-optim + comp--ipa-pure + comp--add-cstrs + comp--fwprop + comp--tco + comp--fwprop + comp--remove-type-hints + comp--final) "Passes to be executed in order.") (defvar comp-disabled-passes '() @@ -388,7 +388,7 @@ This is typically for top-level forms other than defun.") (closed nil :type boolean :documentation "t if closed.") ;; All the following are for SSA and CGF analysis. - ;; Keep in sync with `comp-clean-ssa'!! + ;; Keep in sync with `comp--clean-ssa'!! (in-edges () :type list :documentation "List of incoming edges.") (out-edges () :type list @@ -416,7 +416,7 @@ into it.") :documentation "Start block LAP address.") (non-ret-insn nil :type list :documentation "Insn known to perform a non local exit. -`comp-fwprop' may identify and store here basic blocks performing +`comp--fwprop' may identify and store here basic blocks performing non local exits and mark it rewrite it later.") (no-ret nil :type boolean :documentation "t when the block is known to perform a @@ -507,7 +507,7 @@ CFG is mutated by a pass.") (lambda-list nil :type list :documentation "Original lambda-list.")) -(cl-defstruct (comp-mvar (:constructor make--comp-mvar) +(cl-defstruct (comp-mvar (:constructor make--comp-mvar0) (:include comp-cstr)) "A meta-variable being a slot in the meta-stack." (id nil :type (or null number) @@ -516,6 +516,7 @@ CFG is mutated by a pass.") :documentation "Slot number in the array if a number or `scratch' for scratch slot.")) +;; In use by comp.c. (defun comp-mvar-type-hint-match-p (mvar type-hint) "Match MVAR against TYPE-HINT. In use by the back-end." @@ -636,7 +637,7 @@ VERBOSITY is a number between 0 and 3." -(defmacro comp-loop-insn-in-block (basic-block &rest body) +(defmacro comp--loop-insn-in-block (basic-block &rest body) "Loop over all insns in BASIC-BLOCK executing BODY. Inside BODY, `insn' and `insn-cell'can be used to read or set the current instruction or its cell." @@ -650,19 +651,19 @@ current instruction or its cell." ;;; spill-lap pass specific code. -(defun comp-lex-byte-func-p (f) +(defun comp--lex-byte-func-p (f) "Return t if F is a lexically-scoped byte compiled function." (and (byte-code-function-p f) (fixnump (aref f 0)))) -(defun comp-spill-decl-spec (function-name spec) +(defun comp--spill-decl-spec (function-name spec) "Return the declared specifier SPEC for FUNCTION-NAME." (plist-get (cdr (assq function-name byte-to-native-plist-environment)) spec)) -(defun comp-spill-speed (function-name) +(defun comp--spill-speed (function-name) "Return the speed for FUNCTION-NAME." - (or (comp-spill-decl-spec function-name 'speed) + (or (comp--spill-decl-spec function-name 'speed) (comp-ctxt-speed comp-ctxt))) ;; Autoloaded as might be used by `disassemble-internal'. @@ -701,7 +702,7 @@ clashes." ;; pick the first one. (concat prefix crypted "_" human-readable "_0")))) -(defun comp-decrypt-arg-list (x function-name) +(defun comp--decrypt-arg-list (x function-name) "Decrypt argument list X for FUNCTION-NAME." (unless (fixnump x) (signal 'native-compiler-error-dyn-func (list function-name))) @@ -716,21 +717,21 @@ clashes." :nonrest nonrest :rest rest)))) -(defsubst comp-byte-frame-size (byte-compiled-func) +(defsubst comp--byte-frame-size (byte-compiled-func) "Return the frame size to be allocated for BYTE-COMPILED-FUNC." (aref byte-compiled-func 3)) -(defun comp-add-func-to-ctxt (func) +(defun comp--add-func-to-ctxt (func) "Add FUNC to the current compiler context." (let ((name (comp-func-name func)) (c-name (comp-func-c-name func))) (puthash name c-name (comp-ctxt-sym-to-c-name-h comp-ctxt)) (puthash c-name func (comp-ctxt-funcs-h comp-ctxt)))) -(cl-defgeneric comp-spill-lap-function (input) +(cl-defgeneric comp--spill-lap-function (input) "Byte-compile INPUT and spill lap for further stages.") -(cl-defmethod comp-spill-lap-function ((function-name symbol)) +(cl-defmethod comp--spill-lap-function ((function-name symbol)) "Byte-compile FUNCTION-NAME, spilling data from the byte compiler." (unless (comp-ctxt-output comp-ctxt) (setf (comp-ctxt-output comp-ctxt) @@ -746,9 +747,9 @@ clashes." (list (make-byte-to-native-func-def :name function-name :c-name c-name :byte-func byte-code))) - (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h))) + (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h))) -(cl-defmethod comp-spill-lap-function ((form list)) +(cl-defmethod comp--spill-lap-function ((form list)) "Byte-compile FORM, spilling data from the byte compiler." (unless (memq (car-safe form) '(lambda closure)) (signal 'native-compiler-error @@ -762,9 +763,9 @@ clashes." (list (make-byte-to-native-func-def :name '--anonymous-lambda :c-name c-name :byte-func byte-code))) - (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h))) + (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h))) -(defun comp-intern-func-in-ctxt (_ obj) +(defun comp--intern-func-in-ctxt (_ obj) "Given OBJ of type `byte-to-native-lambda', create a function in `comp-ctxt'." (when-let ((byte-func (byte-to-native-lambda-byte-func obj))) (let* ((lap (byte-to-native-lambda-lap obj)) @@ -777,9 +778,9 @@ clashes." (name (when top-l-form (byte-to-native-func-def-name top-l-form))) (c-name (comp-c-func-name (or name "anonymous-lambda") "F")) - (func (if (comp-lex-byte-func-p byte-func) + (func (if (comp--lex-byte-func-p byte-func) (make-comp-func-l - :args (comp-decrypt-arg-list (aref byte-func 0) + :args (comp--decrypt-arg-list (aref byte-func 0) name)) (make-comp-func-d :lambda-list (aref byte-func 0))))) (setf (comp-func-name func) name @@ -789,9 +790,9 @@ clashes." (comp-func-command-modes func) (command-modes byte-func) (comp-func-c-name func) c-name (comp-func-lap func) lap - (comp-func-frame-size func) (comp-byte-frame-size byte-func) - (comp-func-speed func) (comp-spill-speed name) - (comp-func-pure func) (comp-spill-decl-spec name 'pure)) + (comp-func-frame-size func) (comp--byte-frame-size byte-func) + (comp-func-speed func) (comp--spill-speed name) + (comp-func-pure func) (comp--spill-decl-spec name 'pure)) ;; Store the c-name to have it retrievable from ;; `comp-ctxt-top-level-forms'. @@ -799,11 +800,11 @@ clashes." (setf (byte-to-native-func-def-c-name top-l-form) c-name)) (unless name (puthash byte-func func (comp-ctxt-byte-func-to-func-h comp-ctxt))) - (comp-add-func-to-ctxt func) + (comp--add-func-to-ctxt func) (comp-log (format "Function %s:\n" name) 1) (comp-log lap 1 t)))) -(cl-defmethod comp-spill-lap-function ((filename string)) +(cl-defmethod comp--spill-lap-function ((filename string)) "Byte-compile FILENAME, spilling data from the byte compiler." (byte-compile-file filename) (when (or (null byte-native-qualities) @@ -828,7 +829,7 @@ clashes." collect (if (and (byte-to-native-func-def-p form) (eq -1 - (comp-spill-speed (byte-to-native-func-def-name form)))) + (comp--spill-speed (byte-to-native-func-def-name form)))) (let ((byte-code (byte-to-native-func-def-byte-func form))) (remhash byte-code byte-to-native-lambdas-h) (make-byte-to-native-top-level @@ -836,11 +837,11 @@ clashes." ',(byte-to-native-func-def-name form) ,byte-code nil) - :lexical (comp-lex-byte-func-p byte-code))) + :lexical (comp--lex-byte-func-p byte-code))) form))) - (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h)) + (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h)) -(defun comp-spill-lap (input) +(defun comp--spill-lap (input) "Byte-compile and spill the LAP representation for INPUT. If INPUT is a symbol, it is the function-name to be compiled. If INPUT is a string, it is the filename to be compiled." @@ -848,7 +849,7 @@ If INPUT is a string, it is the filename to be compiled." (byte-to-native-lambdas-h (make-hash-table :test #'eq)) (byte-to-native-top-level-forms ()) (byte-to-native-plist-environment ()) - (res (comp-spill-lap-function input))) + (res (comp--spill-lap-function input))) (comp-cstr-ctxt-update-type-slots comp-ctxt) res)) @@ -877,55 +878,55 @@ Points to the next slot to be filled.") byte-switch byte-pushconditioncase) "LAP end of basic blocks op codes.") -(defun comp-lap-eob-p (inst) +(defun comp--lap-eob-p (inst) "Return t if INST closes the current basic blocks, nil otherwise." (when (memq (car inst) comp-lap-eob-ops) t)) -(defun comp-lap-fall-through-p (inst) +(defun comp--lap-fall-through-p (inst) "Return t if INST falls through, nil otherwise." (when (not (memq (car inst) '(byte-goto byte-return))) t)) -(defsubst comp-sp () +(defsubst comp--sp () "Current stack pointer." (declare (gv-setter (lambda (val) `(setf (comp-limplify-sp comp-pass) ,val)))) (comp-limplify-sp comp-pass)) -(defmacro comp-with-sp (sp &rest body) +(defmacro comp--with-sp (sp &rest body) "Execute BODY setting the stack pointer to SP. Restore the original value afterwards." (declare (debug (form body)) (indent defun)) (let ((sym (gensym))) - `(let ((,sym (comp-sp))) - (setf (comp-sp) ,sp) + `(let ((,sym (comp--sp))) + (setf (comp--sp) ,sp) (progn ,@body) - (setf (comp-sp) ,sym)))) + (setf (comp--sp) ,sym)))) -(defsubst comp-slot-n (n) +(defsubst comp--slot-n (n) "Slot N into the meta-stack." (comp-vec-aref (comp-limplify-frame comp-pass) n)) -(defsubst comp-slot () +(defsubst comp--slot () "Current slot into the meta-stack pointed by sp." - (comp-slot-n (comp-sp))) + (comp--slot-n (comp--sp))) -(defsubst comp-slot+1 () +(defsubst comp--slot+1 () "Slot into the meta-stack pointed by sp + 1." - (comp-slot-n (1+ (comp-sp)))) + (comp--slot-n (1+ (comp--sp)))) -(defsubst comp-label-to-addr (label) +(defsubst comp--label-to-addr (label) "Find the address of LABEL." (or (gethash label (comp-limplify-label-to-addr comp-pass)) (signal 'native-ice (list "label not found" label)))) -(defsubst comp-mark-curr-bb-closed () +(defsubst comp--mark-curr-bb-closed () "Mark the current basic block as closed." (setf (comp-block-closed (comp-limplify-curr-block comp-pass)) t)) -(defun comp-bb-maybe-add (lap-addr &optional sp) +(defun comp--bb-maybe-add (lap-addr &optional sp) "If necessary create a pending basic block for LAP-ADDR with stack depth SP. The basic block is returned regardless it was already declared or not." (let ((bb (or (cl-loop ; See if the block was already limplified. @@ -943,24 +944,24 @@ The basic block is returned regardless it was already declared or not." (signal 'native-ice (list "incoherent stack pointers" sp (comp-block-lap-sp bb)))) bb) - (car (push (make--comp-block-lap lap-addr sp (comp-new-block-sym)) + (car (push (make--comp-block-lap lap-addr sp (comp--new-block-sym)) (comp-limplify-pending-blocks comp-pass)))))) -(defsubst comp-call (func &rest args) +(defsubst comp--call (func &rest args) "Emit a call for function FUNC with ARGS." `(call ,func ,@args)) -(defun comp-callref (func nargs stack-off) +(defun comp--callref (func nargs stack-off) "Emit a call using narg abi for FUNC. NARGS is the number of arguments. STACK-OFF is the index of the first slot frame involved." `(callref ,func ,@(cl-loop repeat nargs for sp from stack-off - collect (comp-slot-n sp)))) + collect (comp--slot-n sp)))) -(cl-defun make-comp-mvar (&key slot (constant nil const-vld) type neg) +(cl-defun make--comp-mvar (&key slot (constant nil const-vld) type neg) "`comp-mvar' initializer." - (let ((mvar (make--comp-mvar :slot slot))) + (let ((mvar (make--comp-mvar0 :slot slot))) (when const-vld (comp--add-const-to-relocs constant) (setf (comp-cstr-imm mvar) constant)) @@ -970,49 +971,49 @@ STACK-OFF is the index of the first slot frame involved." (setf (comp-mvar-neg mvar) t)) mvar)) -(defun comp-new-frame (size vsize &optional ssa) +(defun comp--new-frame (size vsize &optional ssa) "Return a clean frame of meta variables of size SIZE and VSIZE. If SSA is non-nil, populate it with m-var in ssa form." (cl-loop with v = (make-comp-vec :beg (- vsize) :end size) for i from (- vsize) below size for mvar = (if ssa - (make-comp-ssa-mvar :slot i) - (make-comp-mvar :slot i)) + (make--comp--ssa-mvar :slot i) + (make--comp-mvar :slot i)) do (setf (comp-vec-aref v i) mvar) finally return v)) -(defun comp-emit (insn) +(defun comp--emit (insn) "Emit INSN into basic block BB." (let ((bb (comp-limplify-curr-block comp-pass))) (cl-assert (not (comp-block-closed bb))) (push insn (comp-block-insns bb)))) -(defun comp-emit-set-call (call) +(defun comp--emit-set-call (call) "Emit CALL assigning the result to the current slot frame. If the callee function is known to have a return type, propagate it." (cl-assert call) - (comp-emit (list 'set (comp-slot) call))) + (comp--emit (list 'set (comp--slot) call))) -(defun comp-copy-slot (src-n &optional dst-n) +(defun comp--copy-slot (src-n &optional dst-n) "Set slot number DST-N to slot number SRC-N as source. If DST-N is specified, use it; otherwise assume it to be the current slot." - (comp-with-sp (or dst-n (comp-sp)) - (let ((src-slot (comp-slot-n src-n))) + (comp--with-sp (or dst-n (comp--sp)) + (let ((src-slot (comp--slot-n src-n))) (cl-assert src-slot) - (comp-emit `(set ,(comp-slot) ,src-slot))))) + (comp--emit `(set ,(comp--slot) ,src-slot))))) -(defsubst comp-emit-annotation (str) +(defsubst comp--emit-annotation (str) "Emit annotation STR." - (comp-emit `(comment ,str))) + (comp--emit `(comment ,str))) -(defsubst comp-emit-setimm (val) +(defsubst comp--emit-setimm (val) "Set constant VAL to current slot." (comp--add-const-to-relocs val) ;; Leave relocation index nil on purpose, will be fixed-up in final ;; by `comp-finalize-relocs'. - (comp-emit `(setimm ,(comp-slot) ,val))) + (comp--emit `(setimm ,(comp--slot) ,val))) -(defun comp-make-curr-block (block-name entry-sp &optional addr) +(defun comp--make-curr-block (block-name entry-sp &optional addr) "Create a basic block with BLOCK-NAME and set it as current block. ENTRY-SP is the sp value when entering. Add block to the current function and return it." @@ -1024,104 +1025,104 @@ Add block to the current function and return it." (puthash (comp-block-name bb) bb (comp-func-blocks comp-func)) bb)) -(defun comp-latch-make-fill (target) +(defun comp--latch-make-fill (target) "Create a latch pointing to TARGET and fill it. Return the created latch." - (let ((latch (make-comp-latch :name (comp-new-block-sym "latch"))) + (let ((latch (make-comp-latch :name (comp--new-block-sym "latch"))) (curr-bb (comp-limplify-curr-block comp-pass))) - ;; See `comp-make-curr-block'. + ;; See `comp--make-curr-block'. (setf (comp-limplify-curr-block comp-pass) latch) (when (< (comp-func-speed comp-func) 3) ;; At speed 3 the programmer is responsible to manually ;; place `comp-maybe-gc-or-quit'. - (comp-emit '(call comp-maybe-gc-or-quit))) - ;; See `comp-emit-uncond-jump'. - (comp-emit `(jump ,(comp-block-name target))) - (comp-mark-curr-bb-closed) + (comp--emit '(call comp-maybe-gc-or-quit))) + ;; See `comp--emit-uncond-jump'. + (comp--emit `(jump ,(comp-block-name target))) + (comp--mark-curr-bb-closed) (puthash (comp-block-name latch) latch (comp-func-blocks comp-func)) (setf (comp-limplify-curr-block comp-pass) curr-bb) latch)) -(defun comp-emit-uncond-jump (lap-label) +(defun comp--emit-uncond-jump (lap-label) "Emit an unconditional branch to LAP-LABEL." (cl-destructuring-bind (label-num . stack-depth) lap-label (when stack-depth - (cl-assert (= (1- stack-depth) (comp-sp)))) - (let* ((target-addr (comp-label-to-addr label-num)) - (target (comp-bb-maybe-add target-addr - (comp-sp))) + (cl-assert (= (1- stack-depth) (comp--sp)))) + (let* ((target-addr (comp--label-to-addr label-num)) + (target (comp--bb-maybe-add target-addr + (comp--sp))) (latch (when (< target-addr (comp-limplify-pc comp-pass)) - (comp-latch-make-fill target))) + (comp--latch-make-fill target))) (eff-target-name (comp-block-name (or latch target)))) - (comp-emit `(jump ,eff-target-name)) - (comp-mark-curr-bb-closed)))) + (comp--emit `(jump ,eff-target-name)) + (comp--mark-curr-bb-closed)))) -(defun comp-emit-cond-jump (a b target-offset lap-label negated) +(defun comp--emit-cond-jump (a b target-offset lap-label negated) "Emit a conditional jump to LAP-LABEL when A and B satisfy EQ. TARGET-OFFSET is the positive offset on the SP when branching to the target block. If NEGATED is non null, negate the tested condition. Return value is the fall-through block name." (cl-destructuring-bind (label-num . label-sp) lap-label - (let* ((bb (comp-block-name (comp-bb-maybe-add + (let* ((bb (comp-block-name (comp--bb-maybe-add (1+ (comp-limplify-pc comp-pass)) - (comp-sp)))) ; Fall through block. - (target-sp (+ target-offset (comp-sp))) - (target-addr (comp-label-to-addr label-num)) - (target (comp-bb-maybe-add target-addr target-sp)) + (comp--sp)))) ; Fall through block. + (target-sp (+ target-offset (comp--sp))) + (target-addr (comp--label-to-addr label-num)) + (target (comp--bb-maybe-add target-addr target-sp)) (latch (when (< target-addr (comp-limplify-pc comp-pass)) - (comp-latch-make-fill target))) + (comp--latch-make-fill target))) (eff-target-name (comp-block-name (or latch target)))) (when label-sp - (cl-assert (= (1- label-sp) (+ target-offset (comp-sp))))) - (comp-emit (if negated + (cl-assert (= (1- label-sp) (+ target-offset (comp--sp))))) + (comp--emit (if negated (list 'cond-jump a b bb eff-target-name) (list 'cond-jump a b eff-target-name bb))) - (comp-mark-curr-bb-closed) + (comp--mark-curr-bb-closed) bb))) -(defun comp-emit-handler (lap-label handler-type) +(defun comp--emit-handler (lap-label handler-type) "Emit a nonlocal-exit handler to LAP-LABEL of type HANDLER-TYPE." (cl-destructuring-bind (label-num . label-sp) lap-label - (cl-assert (= (- label-sp 2) (comp-sp))) + (cl-assert (= (- label-sp 2) (comp--sp))) (setf (comp-func-has-non-local comp-func) t) - (let* ((guarded-bb (comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass)) - (comp-sp))) - (handler-bb (comp-bb-maybe-add (comp-label-to-addr label-num) - (1+ (comp-sp)))) - (pop-bb (make--comp-block-lap nil (comp-sp) (comp-new-block-sym)))) - (comp-emit (list 'push-handler + (let* ((guarded-bb (comp--bb-maybe-add (1+ (comp-limplify-pc comp-pass)) + (comp--sp))) + (handler-bb (comp--bb-maybe-add (comp--label-to-addr label-num) + (1+ (comp--sp)))) + (pop-bb (make--comp-block-lap nil (comp--sp) (comp--new-block-sym)))) + (comp--emit (list 'push-handler handler-type - (comp-slot+1) + (comp--slot+1) (comp-block-name pop-bb) (comp-block-name guarded-bb))) - (comp-mark-curr-bb-closed) + (comp--mark-curr-bb-closed) ;; Emit the basic block to pop the handler if we got the non local. (puthash (comp-block-name pop-bb) pop-bb (comp-func-blocks comp-func)) (setf (comp-limplify-curr-block comp-pass) pop-bb) - (comp-emit `(fetch-handler ,(comp-slot+1))) - (comp-emit `(jump ,(comp-block-name handler-bb))) - (comp-mark-curr-bb-closed)))) + (comp--emit `(fetch-handler ,(comp--slot+1))) + (comp--emit `(jump ,(comp-block-name handler-bb))) + (comp--mark-curr-bb-closed)))) -(defun comp-limplify-listn (n) +(defun comp--limplify-listn (n) "Limplify list N." - (comp-with-sp (+ (comp-sp) n -1) - (comp-emit-set-call (comp-call 'cons - (comp-slot) - (make-comp-mvar :constant nil)))) - (cl-loop for sp from (+ (comp-sp) n -2) downto (comp-sp) - do (comp-with-sp sp - (comp-emit-set-call (comp-call 'cons - (comp-slot) - (comp-slot+1)))))) - -(defun comp-new-block-sym (&optional postfix) + (comp--with-sp (+ (comp--sp) n -1) + (comp--emit-set-call (comp--call 'cons + (comp--slot) + (make--comp-mvar :constant nil)))) + (cl-loop for sp from (+ (comp--sp) n -2) downto (comp--sp) + do (comp--with-sp sp + (comp--emit-set-call (comp--call 'cons + (comp--slot) + (comp--slot+1)))))) + +(defun comp--new-block-sym (&optional postfix) "Return a unique symbol postfixing POSTFIX naming the next new basic block." (intern (format (if postfix "bb_%s_%s" "bb_%s") (funcall (comp-func-block-cnt-gen comp-func)) postfix))) -(defun comp-fill-label-h () +(defun comp--fill-label-h () "Fill label-to-addr hash table for the current function." (setf (comp-limplify-label-to-addr comp-pass) (make-hash-table :test 'eql)) (cl-loop for insn in (comp-func-lap comp-func) @@ -1130,7 +1131,7 @@ Return value is the fall-through block name." (`(TAG ,label . ,_) (puthash label addr (comp-limplify-label-to-addr comp-pass)))))) -(defun comp-jump-table-optimizable (jmp-table) +(defun comp--jump-table-optimizable (jmp-table) "Return t if JMP-TABLE can be optimized out." ;; Identify LAP sequences like: ;; (byte-constant #s(hash-table test eq purecopy t data (created 126 deleted 126 changed 126)) . 24) @@ -1142,13 +1143,13 @@ Return value is the fall-through block name." (`(TAG ,target . ,_label-sp) (= target (car targets))))))) -(defun comp-emit-switch (var last-insn) +(defun comp--emit-switch (var last-insn) "Emit a Limple for a lap jump table given VAR and LAST-INSN." ;; FIXME this not efficient for big jump tables. We should have a second ;; strategy for this case. (pcase last-insn (`(setimm ,_ ,jmp-table) - (unless (comp-jump-table-optimizable jmp-table) + (unless (comp--jump-table-optimizable jmp-table) (cl-loop for test being each hash-keys of jmp-table using (hash-value target-label) @@ -1156,27 +1157,27 @@ Return value is the fall-through block name." with test-func = (hash-table-test jmp-table) for n from 1 for last = (= n len) - for m-test = (make-comp-mvar :constant test) - for target-name = (comp-block-name (comp-bb-maybe-add - (comp-label-to-addr target-label) - (comp-sp))) + for m-test = (make--comp-mvar :constant test) + for target-name = (comp-block-name (comp--bb-maybe-add + (comp--label-to-addr target-label) + (comp--sp))) for ff-bb = (if last - (comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass)) - (comp-sp)) + (comp--bb-maybe-add (1+ (comp-limplify-pc comp-pass)) + (comp--sp)) (make--comp-block-lap nil - (comp-sp) - (comp-new-block-sym))) + (comp--sp) + (comp--new-block-sym))) for ff-bb-name = (comp-block-name ff-bb) if (eq test-func 'eq) - do (comp-emit (list 'cond-jump var m-test target-name ff-bb-name)) + do (comp--emit (list 'cond-jump var m-test target-name ff-bb-name)) else ;; Store the result of the comparison into the scratch slot before ;; emitting the conditional jump. - do (comp-emit (list 'set (make-comp-mvar :slot 'scratch) - (comp-call test-func var m-test))) - (comp-emit (list 'cond-jump - (make-comp-mvar :slot 'scratch) - (make-comp-mvar :constant nil) + do (comp--emit (list 'set (make--comp-mvar :slot 'scratch) + (comp--call test-func var m-test))) + (comp--emit (list 'cond-jump + (make--comp-mvar :slot 'scratch) + (make--comp-mvar :constant nil) ff-bb-name target-name)) unless last ;; All fall through are artificially created here except the last one. @@ -1191,7 +1192,7 @@ SUBR-NAME is the name of function." (or (gethash subr-name comp-subr-arities-h) (func-arity subr-name))) -(defun comp-emit-set-call-subr (subr-name sp-delta) +(defun comp--emit-set-call-subr (subr-name sp-delta) "Emit a call for SUBR-NAME. SP-DELTA is the stack adjustment." (let* ((nargs (1+ (- sp-delta))) @@ -1202,39 +1203,39 @@ SP-DELTA is the stack adjustment." (signal 'native-ice (list "subr contains unevalled args" subr-name))) (if (eq maxarg 'many) ;; callref case. - (comp-emit-set-call (comp-callref subr-name nargs (comp-sp))) + (comp--emit-set-call (comp--callref subr-name nargs (comp--sp))) ;; Normal call. (unless (and (>= maxarg nargs) (<= minarg nargs)) (signal 'native-ice (list "incoherent stack adjustment" nargs maxarg minarg))) (let* ((subr-name subr-name) (slots (cl-loop for i from 0 below maxarg - collect (comp-slot-n (+ i (comp-sp)))))) - (comp-emit-set-call (apply #'comp-call (cons subr-name slots))))))) + collect (comp--slot-n (+ i (comp--sp)))))) + (comp--emit-set-call (apply #'comp--call (cons subr-name slots))))))) (eval-when-compile - (defun comp-op-to-fun (x) + (defun comp--op-to-fun (x) "Given the LAP op strip \"byte-\" to have the subr name." (intern (string-replace "byte-" "" x))) - (defun comp-body-eff (body op-name sp-delta) + (defun comp--body-eff (body op-name sp-delta) "Given the original BODY, compute the effective one. When BODY is `auto', guess function name from the LAP byte-code name. Otherwise expect lname fnname." (pcase (car body) ('auto - `((comp-emit-set-call-subr ',(comp-op-to-fun op-name) ,sp-delta))) + `((comp--emit-set-call-subr ',(comp--op-to-fun op-name) ,sp-delta))) ((pred symbolp) - `((comp-emit-set-call-subr ',(car body) ,sp-delta))) + `((comp--emit-set-call-subr ',(car body) ,sp-delta))) (_ body)))) -(defmacro comp-op-case (&rest cases) +(defmacro comp--op-case (&rest cases) "Expand CASES into the corresponding `pcase' expansion. This is responsible for generating the proper stack adjustment, when known, and the annotation emission." (declare (debug (body)) (indent defun)) - (declare-function comp-body-eff nil (body op-name sp-delta)) + (declare-function comp--body-eff nil (body op-name sp-delta)) `(pcase op ,@(cl-loop for (op . body) in cases for sp-delta = (gethash op comp-op-stack-info) @@ -1243,55 +1244,55 @@ and the annotation emission." collect `(',op ;; Log all LAP ops except the TAG one. ;; ,(unless (eq op 'TAG) - ;; `(comp-emit-annotation + ;; `(comp--emit-annotation ;; ,(concat "LAP op " op-name))) ;; Emit the stack adjustment if present. ,(when (and sp-delta (not (eq 0 sp-delta))) - `(cl-incf (comp-sp) ,sp-delta)) - ,@(comp-body-eff body op-name sp-delta)) + `(cl-incf (comp--sp) ,sp-delta)) + ,@(comp--body-eff body op-name sp-delta)) else collect `(',op (signal 'native-ice (list "unsupported LAP op" ',op-name)))) (_ (signal 'native-ice (list "unexpected LAP op" (symbol-name op)))))) -(defun comp-limplify-lap-inst (insn) +(defun comp--limplify-lap-inst (insn) "Limplify LAP instruction INSN pushing it in the proper basic block." (let ((op (car insn)) (arg (if (consp (cdr insn)) (cadr insn) (cdr insn)))) - (comp-op-case + (comp--op-case (TAG (cl-destructuring-bind (_TAG label-num . label-sp) insn ;; Paranoid? (when label-sp (cl-assert (= (1- label-sp) (comp-limplify-sp comp-pass)))) - (comp-emit-annotation (format "LAP TAG %d" label-num)))) + (comp--emit-annotation (format "LAP TAG %d" label-num)))) (byte-stack-ref - (comp-copy-slot (- (comp-sp) arg 1))) + (comp--copy-slot (- (comp--sp) arg 1))) (byte-varref - (comp-emit-set-call (comp-call 'symbol-value (make-comp-mvar + (comp--emit-set-call (comp--call 'symbol-value (make--comp-mvar :constant arg)))) (byte-varset - (comp-emit (comp-call 'set_internal - (make-comp-mvar :constant arg) - (comp-slot+1)))) + (comp--emit (comp--call 'set_internal + (make--comp-mvar :constant arg) + (comp--slot+1)))) (byte-varbind ;; Verify - (comp-emit (comp-call 'specbind - (make-comp-mvar :constant arg) - (comp-slot+1)))) + (comp--emit (comp--call 'specbind + (make--comp-mvar :constant arg) + (comp--slot+1)))) (byte-call - (cl-incf (comp-sp) (- arg)) - (comp-emit-set-call (comp-callref 'funcall (1+ arg) (comp-sp)))) + (cl-incf (comp--sp) (- arg)) + (comp--emit-set-call (comp--callref 'funcall (1+ arg) (comp--sp)))) (byte-unbind - (comp-emit (comp-call 'helper_unbind_n - (make-comp-mvar :constant arg)))) + (comp--emit (comp--call 'helper_unbind_n + (make--comp-mvar :constant arg)))) (byte-pophandler - (comp-emit '(pop-handler))) + (comp--emit '(pop-handler))) (byte-pushconditioncase - (comp-emit-handler (cddr insn) 'condition-case)) + (comp--emit-handler (cddr insn) 'condition-case)) (byte-pushcatch - (comp-emit-handler (cddr insn) 'catcher)) + (comp--emit-handler (cddr insn) 'catcher)) (byte-nth auto) (byte-symbolp auto) (byte-consp auto) @@ -1300,19 +1301,19 @@ and the annotation emission." (byte-eq auto) (byte-memq auto) (byte-not - (comp-emit-set-call (comp-call 'eq (comp-slot-n (comp-sp)) - (make-comp-mvar :constant nil)))) + (comp--emit-set-call (comp--call 'eq (comp--slot-n (comp--sp)) + (make--comp-mvar :constant nil)))) (byte-car auto) (byte-cdr auto) (byte-cons auto) (byte-list1 - (comp-limplify-listn 1)) + (comp--limplify-listn 1)) (byte-list2 - (comp-limplify-listn 2)) + (comp--limplify-listn 2)) (byte-list3 - (comp-limplify-listn 3)) + (comp--limplify-listn 3)) (byte-list4 - (comp-limplify-listn 4)) + (comp--limplify-listn 4)) (byte-length auto) (byte-aref auto) (byte-aset auto) @@ -1323,11 +1324,11 @@ and the annotation emission." (byte-get auto) (byte-substring auto) (byte-concat2 - (comp-emit-set-call (comp-callref 'concat 2 (comp-sp)))) + (comp--emit-set-call (comp--callref 'concat 2 (comp--sp)))) (byte-concat3 - (comp-emit-set-call (comp-callref 'concat 3 (comp-sp)))) + (comp--emit-set-call (comp--callref 'concat 3 (comp--sp)))) (byte-concat4 - (comp-emit-set-call (comp-callref 'concat 4 (comp-sp)))) + (comp--emit-set-call (comp--callref 'concat 4 (comp--sp)))) (byte-sub1 1-) (byte-add1 1+) (byte-eqlsign =) @@ -1337,7 +1338,7 @@ and the annotation emission." (byte-geq >=) (byte-diff -) (byte-negate - (comp-emit-set-call (comp-call 'negate (comp-slot)))) + (comp--emit-set-call (comp--call 'negate (comp--slot)))) (byte-plus +) (byte-max auto) (byte-min auto) @@ -1352,9 +1353,9 @@ and the annotation emission." (byte-preceding-char preceding-char) (byte-current-column auto) (byte-indent-to - (comp-emit-set-call (comp-call 'indent-to - (comp-slot) - (make-comp-mvar :constant nil)))) + (comp--emit-set-call (comp--call 'indent-to + (comp--slot) + (make--comp-mvar :constant nil)))) (byte-scan-buffer-OBSOLETE) (byte-eolp auto) (byte-eobp auto) @@ -1363,7 +1364,7 @@ and the annotation emission." (byte-current-buffer auto) (byte-set-buffer auto) (byte-save-current-buffer - (comp-emit (comp-call 'record_unwind_current_buffer))) + (comp--emit (comp--call 'record_unwind_current_buffer))) (byte-set-mark-OBSOLETE) (byte-interactive-p-OBSOLETE) (byte-forward-char auto) @@ -1375,41 +1376,41 @@ and the annotation emission." (byte-buffer-substring auto) (byte-delete-region auto) (byte-narrow-to-region - (comp-emit-set-call (comp-call 'narrow-to-region - (comp-slot) - (comp-slot+1)))) + (comp--emit-set-call (comp--call 'narrow-to-region + (comp--slot) + (comp--slot+1)))) (byte-widen - (comp-emit-set-call (comp-call 'widen))) + (comp--emit-set-call (comp--call 'widen))) (byte-end-of-line auto) (byte-constant2) ; TODO ;; Branches. (byte-goto - (comp-emit-uncond-jump (cddr insn))) + (comp--emit-uncond-jump (cddr insn))) (byte-goto-if-nil - (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 0 + (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 0 (cddr insn) nil)) (byte-goto-if-not-nil - (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 0 + (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 0 (cddr insn) t)) (byte-goto-if-nil-else-pop - (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 1 + (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 1 (cddr insn) nil)) (byte-goto-if-not-nil-else-pop - (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 1 + (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 1 (cddr insn) t)) (byte-return - (comp-emit `(return ,(comp-slot+1)))) + (comp--emit `(return ,(comp--slot+1)))) (byte-discard 'pass) (byte-dup - (comp-copy-slot (1- (comp-sp)))) + (comp--copy-slot (1- (comp--sp)))) (byte-save-excursion - (comp-emit (comp-call 'record_unwind_protect_excursion))) + (comp--emit (comp--call 'record_unwind_protect_excursion))) (byte-save-window-excursion-OBSOLETE) (byte-save-restriction - (comp-emit (comp-call 'helper_save_restriction))) + (comp--emit (comp--call 'helper_save_restriction))) (byte-catch) ;; Obsolete (byte-unwind-protect - (comp-emit (comp-call 'helper_unwind_protect (comp-slot+1)))) + (comp--emit (comp--call 'helper_unwind_protect (comp--slot+1)))) (byte-condition-case) ;; Obsolete (byte-temp-output-buffer-setup-OBSOLETE) (byte-temp-output-buffer-show-OBSOLETE) @@ -1436,61 +1437,61 @@ and the annotation emission." (byte-numberp auto) (byte-integerp auto) (byte-listN - (cl-incf (comp-sp) (- 1 arg)) - (comp-emit-set-call (comp-callref 'list arg (comp-sp)))) + (cl-incf (comp--sp) (- 1 arg)) + (comp--emit-set-call (comp--callref 'list arg (comp--sp)))) (byte-concatN - (cl-incf (comp-sp) (- 1 arg)) - (comp-emit-set-call (comp-callref 'concat arg (comp-sp)))) + (cl-incf (comp--sp) (- 1 arg)) + (comp--emit-set-call (comp--callref 'concat arg (comp--sp)))) (byte-insertN - (cl-incf (comp-sp) (- 1 arg)) - (comp-emit-set-call (comp-callref 'insert arg (comp-sp)))) + (cl-incf (comp--sp) (- 1 arg)) + (comp--emit-set-call (comp--callref 'insert arg (comp--sp)))) (byte-stack-set - (comp-copy-slot (1+ (comp-sp)) (- (comp-sp) arg -1))) + (comp--copy-slot (1+ (comp--sp)) (- (comp--sp) arg -1))) (byte-stack-set2 (cl-assert nil)) ;; TODO (byte-discardN - (cl-incf (comp-sp) (- arg))) + (cl-incf (comp--sp) (- arg))) (byte-switch ;; Assume to follow the emission of a setimm. - ;; This is checked into comp-emit-switch. - (comp-emit-switch (comp-slot+1) + ;; This is checked into comp--emit-switch. + (comp--emit-switch (comp--slot+1) (cl-first (comp-block-insns (comp-limplify-curr-block comp-pass))))) (byte-constant - (comp-emit-setimm arg)) + (comp--emit-setimm arg)) (byte-discardN-preserve-tos - (cl-incf (comp-sp) (- arg)) - (comp-copy-slot (+ arg (comp-sp))))))) + (cl-incf (comp--sp) (- arg)) + (comp--copy-slot (+ arg (comp--sp))))))) -(defun comp-emit-narg-prologue (minarg nonrest rest) +(defun comp--emit-narg-prologue (minarg nonrest rest) "Emit the prologue for a narg function." (cl-loop for i below minarg - do (comp-emit `(set-args-to-local ,(comp-slot-n i))) - (comp-emit '(inc-args))) + do (comp--emit `(set-args-to-local ,(comp--slot-n i))) + (comp--emit '(inc-args))) (cl-loop for i from minarg below nonrest for bb = (intern (format "entry_%s" i)) for fallback = (intern (format "entry_fallback_%s" i)) - do (comp-emit `(cond-jump-narg-leq ,i ,fallback ,bb)) - (comp-make-curr-block bb (comp-sp)) - (comp-emit `(set-args-to-local ,(comp-slot-n i))) - (comp-emit '(inc-args)) - finally (comp-emit '(jump entry_rest_args))) + do (comp--emit `(cond-jump-narg-leq ,i ,fallback ,bb)) + (comp--make-curr-block bb (comp--sp)) + (comp--emit `(set-args-to-local ,(comp--slot-n i))) + (comp--emit '(inc-args)) + finally (comp--emit '(jump entry_rest_args))) (when (/= minarg nonrest) (cl-loop for i from minarg below nonrest for bb = (intern (format "entry_fallback_%s" i)) for next-bb = (if (= (1+ i) nonrest) 'entry_rest_args (intern (format "entry_fallback_%s" (1+ i)))) - do (comp-with-sp i - (comp-make-curr-block bb (comp-sp)) - (comp-emit-setimm nil) - (comp-emit `(jump ,next-bb))))) - (comp-make-curr-block 'entry_rest_args (comp-sp)) - (comp-emit `(set-rest-args-to-local ,(comp-slot-n nonrest))) - (setf (comp-sp) nonrest) + do (comp--with-sp i + (comp--make-curr-block bb (comp--sp)) + (comp--emit-setimm nil) + (comp--emit `(jump ,next-bb))))) + (comp--make-curr-block 'entry_rest_args (comp--sp)) + (comp--emit `(set-rest-args-to-local ,(comp--slot-n nonrest))) + (setf (comp--sp) nonrest) (when (and (> nonrest 8) (null rest)) - (cl-decf (comp-sp)))) + (cl-decf (comp--sp)))) -(defun comp-limplify-finalize-function (func) +(defun comp--limplify-finalize-function (func) "Reverse insns into all basic blocks of FUNC." (cl-loop for bb being the hash-value in (comp-func-blocks func) do (setf (comp-block-insns bb) @@ -1498,49 +1499,49 @@ and the annotation emission." (comp--log-func func 2) func) -(cl-defgeneric comp-prepare-args-for-top-level (function) +(cl-defgeneric comp--prepare-args-for-top-level (function) "Given FUNCTION, return the two arguments for comp--register-...") -(cl-defmethod comp-prepare-args-for-top-level ((function comp-func-l)) +(cl-defmethod comp--prepare-args-for-top-level ((function comp-func-l)) "Lexically-scoped FUNCTION." (let ((args (comp-func-l-args function))) - (cons (make-comp-mvar :constant (comp-args-base-min args)) - (make-comp-mvar :constant (cond + (cons (make--comp-mvar :constant (comp-args-base-min args)) + (make--comp-mvar :constant (cond ((comp-args-p args) (comp-args-max args)) ((comp-nargs-rest args) 'many) (t (comp-nargs-nonrest args))))))) -(cl-defmethod comp-prepare-args-for-top-level ((function comp-func-d)) +(cl-defmethod comp--prepare-args-for-top-level ((function comp-func-d)) "Dynamically scoped FUNCTION." - (cons (make-comp-mvar :constant (func-arity (comp-func-byte-func function))) + (cons (make--comp-mvar :constant (func-arity (comp-func-byte-func function))) (let ((comp-curr-allocation-class 'd-default)) ;; Lambda-lists must stay in the same relocation class of ;; the object referenced by code to respect uninterned ;; symbols. - (make-comp-mvar :constant (comp-func-d-lambda-list function))))) + (make--comp-mvar :constant (comp-func-d-lambda-list function))))) -(cl-defgeneric comp-emit-for-top-level (form for-late-load) +(cl-defgeneric comp--emit-for-top-level (form for-late-load) "Emit the Limple code for top level FORM.") -(cl-defmethod comp-emit-for-top-level ((form byte-to-native-func-def) +(cl-defmethod comp--emit-for-top-level ((form byte-to-native-func-def) for-late-load) (let* ((name (byte-to-native-func-def-name form)) (c-name (byte-to-native-func-def-c-name form)) (f (gethash c-name (comp-ctxt-funcs-h comp-ctxt))) - (args (comp-prepare-args-for-top-level f))) + (args (comp--prepare-args-for-top-level f))) (cl-assert (and name f)) - (comp-emit - `(set ,(make-comp-mvar :slot 1) - ,(comp-call (if for-late-load + (comp--emit + `(set ,(make--comp-mvar :slot 1) + ,(comp--call (if for-late-load 'comp--late-register-subr 'comp--register-subr) - (make-comp-mvar :constant name) - (make-comp-mvar :constant c-name) + (make--comp-mvar :constant name) + (make--comp-mvar :constant c-name) (car args) (cdr args) (setf (comp-func-type f) - (make-comp-mvar :constant nil)) - (make-comp-mvar + (make--comp-mvar :constant nil)) + (make--comp-mvar :constant (list (let* ((h (comp-ctxt-function-docs comp-ctxt)) @@ -1551,40 +1552,40 @@ and the annotation emission." (comp-func-command-modes f))) ;; This is the compilation unit it-self passed as ;; parameter. - (make-comp-mvar :slot 0)))))) + (make--comp-mvar :slot 0)))))) -(cl-defmethod comp-emit-for-top-level ((form byte-to-native-top-level) +(cl-defmethod comp--emit-for-top-level ((form byte-to-native-top-level) for-late-load) (unless for-late-load - (comp-emit - (comp-call 'eval + (comp--emit + (comp--call 'eval (let ((comp-curr-allocation-class 'd-impure)) - (make-comp-mvar :constant + (make--comp-mvar :constant (byte-to-native-top-level-form form))) - (make-comp-mvar :constant + (make--comp-mvar :constant (byte-to-native-top-level-lexical form)))))) -(defun comp-emit-lambda-for-top-level (func) +(defun comp--emit-lambda-for-top-level (func) "Emit the creation of subrs for lambda FUNC. These are stored in the reloc data array." - (let ((args (comp-prepare-args-for-top-level func))) + (let ((args (comp--prepare-args-for-top-level func))) (let ((comp-curr-allocation-class 'd-impure)) (comp--add-const-to-relocs (comp-func-byte-func func))) - (comp-emit - (comp-call 'comp--register-lambda + (comp--emit + (comp--call 'comp--register-lambda ;; mvar to be fixed-up when containers are ;; finalized. (or (gethash (comp-func-byte-func func) (comp-ctxt-lambda-fixups-h comp-ctxt)) (puthash (comp-func-byte-func func) - (make-comp-mvar :constant nil) + (make--comp-mvar :constant nil) (comp-ctxt-lambda-fixups-h comp-ctxt))) - (make-comp-mvar :constant (comp-func-c-name func)) + (make--comp-mvar :constant (comp-func-c-name func)) (car args) (cdr args) (setf (comp-func-type func) - (make-comp-mvar :constant nil)) - (make-comp-mvar + (make--comp-mvar :constant nil)) + (make--comp-mvar :constant (list (let* ((h (comp-ctxt-function-docs comp-ctxt)) @@ -1595,9 +1596,9 @@ These are stored in the reloc data array." (comp-func-command-modes func))) ;; This is the compilation unit it-self passed as ;; parameter. - (make-comp-mvar :slot 0))))) + (make--comp-mvar :slot 0))))) -(defun comp-limplify-top-level (for-late-load) +(defun comp--limplify-top-level (for-late-load) "Create a Limple function to modify the global environment at load. When FOR-LATE-LOAD is non-nil, the emitted function modifies only function definition. @@ -1627,22 +1628,22 @@ into the C code forwarding the compilation unit." (comp-func func) (comp-pass (make-comp-limplify :curr-block (make--comp-block-lap -1 0 'top-level) - :frame (comp-new-frame 1 0)))) - (comp-make-curr-block 'entry (comp-sp)) - (comp-emit-annotation (if for-late-load + :frame (comp--new-frame 1 0)))) + (comp--make-curr-block 'entry (comp--sp)) + (comp--emit-annotation (if for-late-load "Late top level" "Top level")) ;; Assign the compilation unit incoming as parameter to the slot frame 0. - (comp-emit `(set-par-to-local ,(comp-slot-n 0) 0)) + (comp--emit `(set-par-to-local ,(comp--slot-n 0) 0)) (maphash (lambda (_ func) - (comp-emit-lambda-for-top-level func)) + (comp--emit-lambda-for-top-level func)) (comp-ctxt-byte-func-to-func-h comp-ctxt)) - (mapc (lambda (x) (comp-emit-for-top-level x for-late-load)) + (mapc (lambda (x) (comp--emit-for-top-level x for-late-load)) (comp-ctxt-top-level-forms comp-ctxt)) - (comp-emit `(return ,(make-comp-mvar :slot 1))) - (comp-limplify-finalize-function func))) + (comp--emit `(return ,(make--comp-mvar :slot 1))) + (comp--limplify-finalize-function func))) -(defun comp-addr-to-bb-name (addr) +(defun comp--addr-to-bb-name (addr) "Search for a block starting at ADDR into pending or limplified blocks." ;; FIXME Actually we could have another hash for this. (cl-flet ((pred (bb) @@ -1654,7 +1655,7 @@ into the C code forwarding the compilation unit." when (pred bb) return (comp-block-name bb))))) -(defun comp-limplify-block (bb) +(defun comp--limplify-block (bb) "Limplify basic-block BB and add it to the current function." (setf (comp-limplify-curr-block comp-pass) bb (comp-limplify-sp comp-pass) (comp-block-lap-sp bb) @@ -1665,51 +1666,51 @@ into the C code forwarding the compilation unit." (comp-func-lap comp-func)) for inst = (car inst-cell) for next-inst = (car-safe (cdr inst-cell)) - do (comp-limplify-lap-inst inst) + do (comp--limplify-lap-inst inst) (cl-incf (comp-limplify-pc comp-pass)) - when (comp-lap-fall-through-p inst) + when (comp--lap-fall-through-p inst) do (pcase next-inst (`(TAG ,_label . ,label-sp) (when label-sp - (cl-assert (= (1- label-sp) (comp-sp)))) + (cl-assert (= (1- label-sp) (comp--sp)))) (let* ((stack-depth (if label-sp (1- label-sp) - (comp-sp))) - (next-bb (comp-block-name (comp-bb-maybe-add + (comp--sp))) + (next-bb (comp-block-name (comp--bb-maybe-add (comp-limplify-pc comp-pass) stack-depth)))) (unless (comp-block-closed bb) - (comp-emit `(jump ,next-bb)))) + (comp--emit `(jump ,next-bb)))) (cl-return))) - until (comp-lap-eob-p inst))) + until (comp--lap-eob-p inst))) -(defun comp-limplify-function (func) +(defun comp--limplify-function (func) "Limplify a single function FUNC." (let* ((frame-size (comp-func-frame-size func)) (comp-func func) (comp-pass (make-comp-limplify - :frame (comp-new-frame frame-size 0)))) - (comp-fill-label-h) + :frame (comp--new-frame frame-size 0)))) + (comp--fill-label-h) ;; Prologue - (comp-make-curr-block 'entry (comp-sp)) - (comp-emit-annotation (concat "Lisp function: " + (comp--make-curr-block 'entry (comp--sp)) + (comp--emit-annotation (concat "Lisp function: " (symbol-name (comp-func-name func)))) ;; Dynamic functions have parameters bound by the trampoline. (when (comp-func-l-p func) (let ((args (comp-func-l-args func))) (if (comp-args-p args) (cl-loop for i below (comp-args-max args) - do (cl-incf (comp-sp)) - (comp-emit `(set-par-to-local ,(comp-slot) ,i))) - (comp-emit-narg-prologue (comp-args-base-min args) + do (cl-incf (comp--sp)) + (comp--emit `(set-par-to-local ,(comp--slot) ,i))) + (comp--emit-narg-prologue (comp-args-base-min args) (comp-nargs-nonrest args) (comp-nargs-rest args))))) - (comp-emit '(jump bb_0)) + (comp--emit '(jump bb_0)) ;; Body - (comp-bb-maybe-add 0 (comp-sp)) + (comp--bb-maybe-add 0 (comp--sp)) (cl-loop for next-bb = (pop (comp-limplify-pending-blocks comp-pass)) while next-bb - do (comp-limplify-block next-bb)) + do (comp--limplify-block next-bb)) ;; Sanity check against block duplication. (cl-loop with addr-h = (make-hash-table) for bb being the hash-value in (comp-func-blocks func) @@ -1718,15 +1719,15 @@ into the C code forwarding the compilation unit." when addr do (cl-assert (null (gethash addr addr-h))) (puthash addr t addr-h)) - (comp-limplify-finalize-function func))) + (comp--limplify-finalize-function func))) -(defun comp-limplify (_) +(defun comp--limplify (_) "Compute LIMPLE IR for forms in `comp-ctxt'." - (maphash (lambda (_ f) (comp-limplify-function f)) + (maphash (lambda (_ f) (comp--limplify-function f)) (comp-ctxt-funcs-h comp-ctxt)) - (comp-add-func-to-ctxt (comp-limplify-top-level nil)) + (comp--add-func-to-ctxt (comp--limplify-top-level nil)) (when (comp-ctxt-with-late-load comp-ctxt) - (comp-add-func-to-ctxt (comp-limplify-top-level t)))) + (comp--add-func-to-ctxt (comp--limplify-top-level t)))) ;;; add-cstrs pass specific code. @@ -1750,22 +1751,22 @@ into the C code forwarding the compilation unit." ;; type specifier. -(defsubst comp-mvar-used-p (mvar) +(defsubst comp--mvar-used-p (mvar) "Non-nil when MVAR is used as lhs in the current function." (declare (gv-setter (lambda (val) `(puthash ,mvar ,val comp-pass)))) (gethash mvar comp-pass)) -(defun comp-collect-mvars (form) +(defun comp--collect-mvars (form) "Add rhs m-var present in FORM into `comp-pass'." (cl-loop for x in form if (consp x) - do (comp-collect-mvars x) + do (comp--collect-mvars x) else when (comp-mvar-p x) - do (setf (comp-mvar-used-p x) t))) + do (setf (comp--mvar-used-p x) t))) -(defun comp-collect-rhs () +(defun comp--collect-rhs () "Collect all lhs mvars into `comp-pass'." (cl-loop for b being each hash-value of (comp-func-blocks comp-func) @@ -1773,11 +1774,11 @@ into the C code forwarding the compilation unit." for insn in (comp-block-insns b) for (op . args) = insn if (comp--assign-op-p op) - do (comp-collect-mvars (cdr args)) + do (comp--collect-mvars (cdr args)) else - do (comp-collect-mvars args)))) + do (comp--collect-mvars args)))) -(defun comp-negate-arithm-cmp-fun (function) +(defun comp--negate-arithm-cmp-fun (function) "Negate FUNCTION. Return nil if we don't want to emit constraints for its negation." (cl-ecase function @@ -1787,7 +1788,7 @@ Return nil if we don't want to emit constraints for its negation." (>= '<) (<= '>))) -(defun comp-reverse-arithm-fun (function) +(defun comp--reverse-arithm-fun (function) "Reverse FUNCTION." (cl-case function (= '=) @@ -1797,7 +1798,7 @@ Return nil if we don't want to emit constraints for its negation." (<= '>=) (t function))) -(defun comp-emit-assume (kind lhs rhs bb negated) +(defun comp--emit-assume (kind lhs rhs bb negated) "Emit an assume of kind KIND for mvar LHS being RHS. When NEGATED is non-nil, the assumption is negated. The assume is emitted at the beginning of the block BB." @@ -1807,41 +1808,41 @@ The assume is emitted at the beginning of the block BB." ((or 'and 'and-nhc) (if (comp-mvar-p rhs) (let ((tmp-mvar (if negated - (make-comp-mvar :slot (comp-mvar-slot rhs)) + (make--comp-mvar :slot (comp-mvar-slot rhs)) rhs))) - (push `(assume ,(make-comp-mvar :slot lhs-slot) + (push `(assume ,(make--comp-mvar :slot lhs-slot) (,kind ,lhs ,tmp-mvar)) (comp-block-insns bb)) (if negated (push `(assume ,tmp-mvar (not ,rhs)) (comp-block-insns bb)))) ;; If is only a constraint we can negate it directly. - (push `(assume ,(make-comp-mvar :slot lhs-slot) + (push `(assume ,(make--comp-mvar :slot lhs-slot) (,kind ,lhs ,(if negated (comp-cstr-negation-make rhs) rhs))) (comp-block-insns bb)))) ((pred comp--arithm-cmp-fun-p) (when-let ((kind (if negated - (comp-negate-arithm-cmp-fun kind) + (comp--negate-arithm-cmp-fun kind) kind))) - (push `(assume ,(make-comp-mvar :slot lhs-slot) + (push `(assume ,(make--comp-mvar :slot lhs-slot) (,kind ,lhs ,(if-let* ((vld (comp-cstr-imm-vld-p rhs)) (val (comp-cstr-imm rhs)) (ok (and (integerp val) (not (memq kind '(= !=)))))) val - (make-comp-mvar :slot (comp-mvar-slot rhs))))) + (make--comp-mvar :slot (comp-mvar-slot rhs))))) (comp-block-insns bb)))) (_ (cl-assert nil))) (setf (comp-func-ssa-status comp-func) 'dirty))) -(defun comp-maybe-add-vmvar (op cmp-res insns-seq) +(defun comp--maybe-add-vmvar (op cmp-res insns-seq) "If CMP-RES is clobbering OP emit a new constrained mvar and return it. Return OP otherwise." (if-let ((match (eql (comp-mvar-slot op) (comp-mvar-slot cmp-res))) - (new-mvar (make-comp-mvar + (new-mvar (make--comp-mvar :slot (- (cl-incf (comp-func-vframe-size comp-func)))))) (progn @@ -1849,7 +1850,7 @@ Return OP otherwise." new-mvar) op)) -(defun comp-add-new-block-between (bb-symbol bb-a bb-b) +(defun comp--add-new-block-between (bb-symbol bb-a bb-b) "Create a new basic-block named BB-SYMBOL and add it between BB-A and BB-B." (cl-loop with new-bb = (make-comp-block-cstr :name bb-symbol @@ -1872,7 +1873,7 @@ Return OP otherwise." finally (cl-assert nil))) ;; Cheap substitute to a copy propagation pass... -(defun comp-cond-cstrs-target-mvar (mvar exit-insn bb) +(defun comp--cond-cstrs-target-mvar (mvar exit-insn bb) "Given MVAR, search in BB the original mvar MVAR got assigned from. Keep on searching till EXIT-INSN is encountered." (cl-flet ((targetp (x) @@ -1889,7 +1890,7 @@ Keep on searching till EXIT-INSN is encountered." (setf res rhs))) finally (cl-assert nil)))) -(defun comp-add-cond-cstrs-target-block (curr-bb target-bb-sym) +(defun comp--add-cond-cstrs-target-block (curr-bb target-bb-sym) "Return the appropriate basic block to add constraint assumptions into. CURR-BB is the current basic block. TARGET-BB-SYM is the symbol name of the target block." @@ -1909,10 +1910,10 @@ TARGET-BB-SYM is the symbol name of the target block." until (null (gethash new-name (comp-func-blocks comp-func))) finally ;; Add it. - (cl-return (comp-add-new-block-between new-name curr-bb target-bb)))))) + (cl-return (comp--add-new-block-between new-name curr-bb target-bb)))))) -(defun comp-add-cond-cstrs-simple () - "`comp-add-cstrs' worker function for each selected function." +(defun comp--add-cond-cstrs-simple () + "`comp--add-cstrs' worker function for each selected function." (cl-loop for b being each hash-value of (comp-func-blocks comp-func) do @@ -1928,26 +1929,26 @@ TARGET-BB-SYM is the symbol name of the target block." for branch-target-cell on blocks for branch-target = (car branch-target-cell) for negated in '(nil t) - when (comp-mvar-used-p tmp-mvar) + when (comp--mvar-used-p tmp-mvar) do - (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) + (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) - (comp-emit-assume 'and tmp-mvar obj2 block-target negated)) + (comp--emit-assume 'and tmp-mvar obj2 block-target negated)) finally (cl-return-from in-the-basic-block))) (`((cond-jump ,obj1 ,obj2 . ,blocks)) (cl-loop for branch-target-cell on blocks for branch-target = (car branch-target-cell) for negated in '(nil t) - when (comp-mvar-used-p obj1) + when (comp--mvar-used-p obj1) do - (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) + (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) - (comp-emit-assume 'and obj1 obj2 block-target negated)) + (comp--emit-assume 'and obj1 obj2 block-target negated)) finally (cl-return-from in-the-basic-block))))))) -(defun comp-add-cond-cstrs () - "`comp-add-cstrs' worker function for each selected function." +(defun comp--add-cond-cstrs () + "`comp--add-cstrs' worker function for each selected function." (cl-loop for b being each hash-value of (comp-func-blocks comp-func) do @@ -1966,13 +1967,13 @@ TARGET-BB-SYM is the symbol name of the target block." (set ,(and (pred comp-mvar-p) mvar-3) (call memq ,(and (pred comp-mvar-p) mvar-1) ,(and (pred comp-mvar-p) mvar-2))) (cond-jump ,(and (pred comp-mvar-p) mvar-3) ,(pred comp-mvar-p) ,bb1 ,bb2)) - (comp-emit-assume 'and mvar-tested - (make-comp-mvar :type (comp-cstr-cl-tag mvar-tag)) - (comp-add-cond-cstrs-target-block b bb2) + (comp--emit-assume 'and mvar-tested + (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag)) + (comp--add-cond-cstrs-target-block b bb2) nil) - (comp-emit-assume 'and mvar-tested - (make-comp-mvar :type (comp-cstr-cl-tag mvar-tag)) - (comp-add-cond-cstrs-target-block b bb1) + (comp--emit-assume 'and mvar-tested + (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag)) + (comp--add-cond-cstrs-target-block b bb1) t)) (`((set ,(and (pred comp-mvar-p) cmp-res) (,(pred comp--call-op-p) @@ -1983,8 +1984,8 @@ TARGET-BB-SYM is the symbol name of the target block." ;; (comment ,_comment-str) (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks)) (cl-loop - with target-mvar1 = (comp-cond-cstrs-target-mvar op1 (car insns-seq) b) - with target-mvar2 = (comp-cond-cstrs-target-mvar op2 (car insns-seq) b) + with target-mvar1 = (comp--cond-cstrs-target-mvar op1 (car insns-seq) b) + with target-mvar2 = (comp--cond-cstrs-target-mvar op2 (car insns-seq) b) for branch-target-cell on blocks for branch-target = (car branch-target-cell) for negated in '(t nil) @@ -1993,19 +1994,19 @@ TARGET-BB-SYM is the symbol name of the target block." (eql 'and-nhc) (eq 'and) (t fun)) - when (or (comp-mvar-used-p target-mvar1) - (comp-mvar-used-p target-mvar2)) + when (or (comp--mvar-used-p target-mvar1) + (comp--mvar-used-p target-mvar2)) do - (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) + (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) - (when (comp-mvar-used-p target-mvar1) - (comp-emit-assume kind target-mvar1 - (comp-maybe-add-vmvar op2 cmp-res prev-insns-seq) + (when (comp--mvar-used-p target-mvar1) + (comp--emit-assume kind target-mvar1 + (comp--maybe-add-vmvar op2 cmp-res prev-insns-seq) block-target negated)) - (when (comp-mvar-used-p target-mvar2) - (comp-emit-assume (comp-reverse-arithm-fun kind) + (when (comp--mvar-used-p target-mvar2) + (comp--emit-assume (comp--reverse-arithm-fun kind) target-mvar2 - (comp-maybe-add-vmvar op1 cmp-res prev-insns-seq) + (comp--maybe-add-vmvar op1 cmp-res prev-insns-seq) block-target negated))) finally (cl-return-from in-the-basic-block))) (`((set ,(and (pred comp-mvar-p) cmp-res) @@ -2015,16 +2016,16 @@ TARGET-BB-SYM is the symbol name of the target block." ;; (comment ,_comment-str) (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks)) (cl-loop - with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b) + with target-mvar = (comp--cond-cstrs-target-mvar op (car insns-seq) b) with cstr = (comp--pred-to-cstr fun) for branch-target-cell on blocks for branch-target = (car branch-target-cell) for negated in '(t nil) - when (comp-mvar-used-p target-mvar) + when (comp--mvar-used-p target-mvar) do - (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) + (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) - (comp-emit-assume 'and target-mvar cstr block-target negated)) + (comp--emit-assume 'and target-mvar cstr block-target negated)) finally (cl-return-from in-the-basic-block))) ;; Match predicate on the negated branch (unless). (`((set ,(and (pred comp-mvar-p) cmp-res) @@ -2034,20 +2035,20 @@ TARGET-BB-SYM is the symbol name of the target block." (set ,neg-cmp-res (call eq ,cmp-res ,(pred comp-cstr-null-p))) (cond-jump ,neg-cmp-res ,(pred comp-mvar-p) . ,blocks)) (cl-loop - with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b) + with target-mvar = (comp--cond-cstrs-target-mvar op (car insns-seq) b) with cstr = (comp--pred-to-cstr fun) for branch-target-cell on blocks for branch-target = (car branch-target-cell) for negated in '(nil t) - when (comp-mvar-used-p target-mvar) + when (comp--mvar-used-p target-mvar) do - (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) + (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) - (comp-emit-assume 'and target-mvar cstr block-target negated)) + (comp--emit-assume 'and target-mvar cstr block-target negated)) finally (cl-return-from in-the-basic-block)))) (setf prev-insns-seq insns-seq)))) -(defsubst comp-insert-insn (insn insn-cell) +(defsubst comp--insert-insn (insn insn-cell) "Insert INSN as second insn of INSN-CELL." (let ((next-cell (cdr insn-cell)) (new-cell `(,insn))) @@ -2055,15 +2056,15 @@ TARGET-BB-SYM is the symbol name of the target block." (cdr new-cell) next-cell (comp-func-ssa-status comp-func) 'dirty))) -(defun comp-emit-call-cstr (mvar call-cell cstr) +(defun comp--emit-call-cstr (mvar call-cell cstr) "Emit a constraint CSTR for MVAR after CALL-CELL." - (let* ((new-mvar (make-comp-mvar :slot (comp-mvar-slot mvar))) + (let* ((new-mvar (make--comp-mvar :slot (comp-mvar-slot mvar))) ;; Have new-mvar as LHS *and* RHS to ensure monotonicity and ;; fwprop convergence!! (insn `(assume ,new-mvar (and ,new-mvar ,mvar ,cstr)))) - (comp-insert-insn insn call-cell))) + (comp--insert-insn insn call-cell))) -(defun comp-lambda-list-gen (lambda-list) +(defun comp--lambda-list-gen (lambda-list) "Return a generator to iterate over LAMBDA-LIST." (lambda () (cl-case (car lambda-list) @@ -2079,12 +2080,12 @@ TARGET-BB-SYM is the symbol name of the target block." (car lambda-list) (setf lambda-list (cdr lambda-list))))))) -(defun comp-add-call-cstr () +(defun comp--add-call-cstr () "Add args assumptions for each function of which the type specifier is known." (cl-loop for bb being each hash-value of (comp-func-blocks comp-func) do - (comp-loop-insn-in-block bb + (comp--loop-insn-in-block bb (when-let ((match (pcase insn (`(set ,lhs (,(pred comp--call-op-p) ,f . ,args)) @@ -2095,10 +2096,10 @@ TARGET-BB-SYM is the symbol name of the target block." (cl-values f cstr-f nil args)))))) (cl-multiple-value-bind (f cstr-f lhs args) match (cl-loop - with gen = (comp-lambda-list-gen (comp-cstr-f-args cstr-f)) + with gen = (comp--lambda-list-gen (comp-cstr-f-args cstr-f)) for arg in args for cstr = (funcall gen) - for target = (comp-cond-cstrs-target-mvar arg insn bb) + for target = (comp--cond-cstrs-target-mvar arg insn bb) unless (comp-cstr-p cstr) do (signal 'native-ice (list "Incoherent type specifier for function" f)) @@ -2109,9 +2110,9 @@ TARGET-BB-SYM is the symbol name of the target block." (or (null lhs) (not (eql (comp-mvar-slot lhs) (comp-mvar-slot target))))) - do (comp-emit-call-cstr target insn-cell cstr))))))) + do (comp--emit-call-cstr target insn-cell cstr))))))) -(defun comp-add-cstrs (_) +(defun comp--add-cstrs (_) "Rewrite conditional branches adding appropriate `assume' insns. This is introducing and placing `assume' insns in use by fwprop to propagate conditional branch test information on target basic @@ -2125,10 +2126,10 @@ blocks." (not (comp-func-has-non-local f))) (let ((comp-func f) (comp-pass (make-hash-table :test #'eq))) - (comp-collect-rhs) - (comp-add-cond-cstrs-simple) - (comp-add-cond-cstrs) - (comp-add-call-cstr) + (comp--collect-rhs) + (comp--add-cond-cstrs-simple) + (comp--add-cond-cstrs) + (comp--add-call-cstr) (comp--log-func comp-func 3)))) (comp-ctxt-funcs-h comp-ctxt))) @@ -2140,7 +2141,7 @@ blocks." ;; avoid optimizing-out functions and preventing their redefinition ;; being effective. -(defun comp-collect-calls (f) +(defun comp--collect-calls (f) "Return a list with all the functions called by F." (cl-loop with h = (make-hash-table :test #'eq) @@ -2160,17 +2161,17 @@ blocks." (comp-ctxt-funcs-h comp-ctxt))) f)))) -(defun comp-pure-infer-func (f) +(defun comp--pure-infer-func (f) "If all functions called by F are pure then F is pure too." (when (and (cl-every (lambda (x) (or (comp--function-pure-p x) (eq x (comp-func-name f)))) - (comp-collect-calls f)) + (comp--collect-calls f)) (not (eq (comp-func-pure f) t))) (comp-log (format "%s inferred to be pure" (comp-func-name f))) (setf (comp-func-pure f) t))) -(defun comp-ipa-pure (_) +(defun comp--ipa-pure (_) "Infer function purity." (cl-loop with pure-n = 0 @@ -2183,7 +2184,7 @@ blocks." when (and (>= (comp-func-speed f) 3) (comp-func-l-p f) (not (comp-func-pure f))) - do (comp-pure-infer-func f) + do (comp--pure-infer-func f) count (comp-func-pure f)))) finally (comp-log (format "ipa-pure iterated %d times" n)))) @@ -2197,13 +2198,13 @@ blocks." ;; this form is called 'minimal SSA form'. ;; This pass should be run every time basic blocks or m-var are shuffled. -(cl-defun make-comp-ssa-mvar (&rest rest &key _slot _constant _type) - "Same as `make-comp-mvar' but set the `id' slot." - (let ((mvar (apply #'make-comp-mvar rest))) +(cl-defun make--comp--ssa-mvar (&rest rest &key _slot _constant _type) + "Same as `make--comp-mvar' but set the `id' slot." + (let ((mvar (apply #'make--comp-mvar rest))) (setf (comp-mvar-id mvar) (sxhash-eq mvar)) mvar)) -(defun comp-clean-ssa (f) +(defun comp--clean-ssa (f) "Clean-up SSA for function F." (setf (comp-func-edges-h f) (make-hash-table)) (cl-loop @@ -2219,7 +2220,7 @@ blocks." unless (eq 'phi (car insn)) collect insn)))) -(defun comp-compute-edges () +(defun comp--compute-edges () "Compute the basic block edges for the current function." (cl-loop with blocks = (comp-func-blocks comp-func) for bb being each hash-value of blocks @@ -2255,7 +2256,7 @@ blocks." (comp-block-in-edges (comp-edge-dst edge)))) (comp--log-edges comp-func))) -(defun comp-collect-rev-post-order (basic-block) +(defun comp--collect-rev-post-order (basic-block) "Walk BASIC-BLOCK children and return their name in reversed post-order." (let ((visited (make-hash-table)) (acc ())) @@ -2270,7 +2271,7 @@ blocks." (collect-rec basic-block) acc))) -(defun comp-compute-dominator-tree () +(defun comp--compute-dominator-tree () "Compute immediate dominators for each basic block in current function." ;; Originally based on: "A Simple, Fast Dominance Algorithm" ;; Cooper, Keith D.; Harvey, Timothy J.; Kennedy, Ken (2001). @@ -2295,7 +2296,7 @@ blocks." ;; No point to go on if the only bb is 'entry'. (bb0 (gethash 'bb_0 blocks))) (cl-loop - with rev-bb-list = (comp-collect-rev-post-order entry) + with rev-bb-list = (comp--collect-rev-post-order entry) with changed = t while changed initially (progn @@ -2322,7 +2323,7 @@ blocks." new-idom) changed t)))))) -(defun comp-compute-dominator-frontiers () +(defun comp--compute-dominator-frontiers () "Compute the dominator frontier for each basic block in `comp-func'." ;; Originally based on: "A Simple, Fast Dominance Algorithm" ;; Cooper, Keith D.; Harvey, Timothy J.; Kennedy, Ken (2001). @@ -2337,7 +2338,7 @@ blocks." (puthash b-name b (comp-block-df runner)) (setf runner (comp-block-idom runner)))))) -(defun comp-log-block-info () +(defun comp--log-block-info () "Log basic blocks info for the current function." (maphash (lambda (name bb) (let ((dom (comp-block-idom bb)) @@ -2350,7 +2351,7 @@ blocks." 3))) (comp-func-blocks comp-func))) -(defun comp-place-phis () +(defun comp--place-phis () "Place phi insns into the current function." ;; Originally based on: Static Single Assignment Book ;; Algorithm 3.1: Standard algorithm for inserting phi-functions @@ -2391,7 +2392,7 @@ blocks." (unless (cl-find y defs-v) (push y w)))))))) -(defun comp-dom-tree-walker (bb pre-lambda post-lambda) +(defun comp--dom-tree-walker (bb pre-lambda post-lambda) "Dominator tree walker function starting from basic block BB. PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." (when pre-lambda @@ -2401,18 +2402,18 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." for child = (comp-edge-dst ed) when (eq bb (comp-block-idom child)) ;; Current block is the immediate dominator then recur. - do (comp-dom-tree-walker child pre-lambda post-lambda))) + do (comp--dom-tree-walker child pre-lambda post-lambda))) (when post-lambda (funcall post-lambda bb))) -(cl-defstruct (comp-ssa (:copier nil)) +(cl-defstruct (comp--ssa (:copier nil)) "Support structure used while SSA renaming." - (frame (comp-new-frame (comp-func-frame-size comp-func) + (frame (comp--new-frame (comp-func-frame-size comp-func) (comp-func-vframe-size comp-func) t) :type comp-vec :documentation "`comp-vec' of m-vars.")) -(defun comp-ssa-rename-insn (insn frame) +(defun comp--ssa-rename-insn (insn frame) (cl-loop for slot-n from (- (comp-func-vframe-size comp-func)) below (comp-func-frame-size comp-func) @@ -2423,7 +2424,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." (eql slot-n (comp-mvar-slot x)))) (new-lvalue () ;; If is an assignment make a new mvar and put it as l-value. - (let ((mvar (make-comp-ssa-mvar :slot slot-n))) + (let ((mvar (make--comp--ssa-mvar :slot slot-n))) (setf (comp-vec-aref frame slot-n) mvar (cadr insn) mvar)))) (pcase insn @@ -2433,7 +2434,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." (new-lvalue)) (`(fetch-handler . ,_) ;; Clobber all no matter what! - (setf (comp-vec-aref frame slot-n) (make-comp-ssa-mvar :slot slot-n))) + (setf (comp-vec-aref frame slot-n) (make--comp--ssa-mvar :slot slot-n))) (`(phi ,n) (when (equal n slot-n) (new-lvalue))) @@ -2441,7 +2442,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." (let ((mvar (comp-vec-aref frame slot-n))) (setcdr insn (cl-nsubst-if mvar #'targetp (cdr insn))))))))) -(defun comp-ssa-rename () +(defun comp--ssa-rename () "Entry point to rename into SSA within the current function." (comp-log "Renaming\n" 2) (let ((visited (make-hash-table))) @@ -2449,7 +2450,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." (unless (gethash bb visited) (puthash bb t visited) (cl-loop for insn in (comp-block-insns bb) - do (comp-ssa-rename-insn insn in-frame)) + do (comp--ssa-rename-insn insn in-frame)) (setf (comp-block-final-frame bb) (copy-sequence in-frame)) (when-let ((out-edges (comp-block-out-edges bb))) @@ -2460,11 +2461,11 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." do (ssa-rename-rec child (comp-vec-copy in-frame))))))) (ssa-rename-rec (gethash 'entry (comp-func-blocks comp-func)) - (comp-new-frame (comp-func-frame-size comp-func) + (comp--new-frame (comp-func-frame-size comp-func) (comp-func-vframe-size comp-func) t))))) -(defun comp-finalize-phis () +(defun comp--finalize-phis () "Fixup r-values into phis in all basic blocks." (cl-flet ((finalize-phi (args b) ;; Concatenate into args all incoming m-vars for this phi. @@ -2481,7 +2482,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." when (eq op 'phi) do (finalize-phi args b))))) -(defun comp-remove-unreachable-blocks () +(defun comp--remove-unreachable-blocks () "Remove unreachable basic blocks. Return t when one or more block was removed, nil otherwise." (cl-loop @@ -2497,7 +2498,7 @@ Return t when one or more block was removed, nil otherwise." ret t) finally return ret)) -(defun comp-ssa () +(defun comp--ssa () "Port all functions into minimal SSA form." (maphash (lambda (_ f) (let* ((comp-func f) @@ -2505,15 +2506,15 @@ Return t when one or more block was removed, nil otherwise." (unless (eq ssa-status t) (cl-loop when (eq ssa-status 'dirty) - do (comp-clean-ssa f) - do (comp-compute-edges) - (comp-compute-dominator-tree) - until (null (comp-remove-unreachable-blocks))) - (comp-compute-dominator-frontiers) - (comp-log-block-info) - (comp-place-phis) - (comp-ssa-rename) - (comp-finalize-phis) + do (comp--clean-ssa f) + do (comp--compute-edges) + (comp--compute-dominator-tree) + until (null (comp--remove-unreachable-blocks))) + (comp--compute-dominator-frontiers) + (comp--log-block-info) + (comp--place-phis) + (comp--ssa-rename) + (comp--finalize-phis) (comp--log-func comp-func 3) (setf (comp-func-ssa-status f) t)))) (comp-ctxt-funcs-h comp-ctxt))) @@ -2525,12 +2526,12 @@ Return t when one or more block was removed, nil otherwise." ;; This is also responsible for removing function calls to pure functions if ;; possible. -(defconst comp-fwprop-max-insns-scan 4500 +(defconst comp--fwprop-max-insns-scan 4500 ;; Chosen as ~ the greatest required value for full convergence ;; native compiling all Emacs code-base. "Max number of scanned insn before giving-up.") -(defun comp-copy-insn (insn) +(defun comp--copy-insn (insn) "Deep copy INSN." ;; Adapted from `copy-tree'. (if (consp insn) @@ -2538,16 +2539,16 @@ Return t when one or more block was removed, nil otherwise." (while (consp insn) (let ((newcar (car insn))) (if (or (consp (car insn)) (comp-mvar-p (car insn))) - (setf newcar (comp-copy-insn (car insn)))) + (setf newcar (comp--copy-insn (car insn)))) (push newcar result)) (setf insn (cdr insn))) (nconc (nreverse result) - (if (comp-mvar-p insn) (comp-copy-insn insn) insn))) + (if (comp-mvar-p insn) (comp--copy-insn insn) insn))) (if (comp-mvar-p insn) (copy-comp-mvar insn) insn))) -(defmacro comp-apply-in-env (func &rest args) +(defmacro comp--apply-in-env (func &rest args) "Apply FUNC to ARGS in the current compilation environment." `(let ((env (cl-loop for f being the hash-value in (comp-ctxt-funcs-h comp-ctxt) @@ -2563,7 +2564,7 @@ Return t when one or more block was removed, nil otherwise." for (func-name . def) in env do (setf (symbol-function func-name) def))))) -(defun comp-fwprop-prologue () +(defun comp--fwprop-prologue () "Prologue for the propagate pass. Here goes everything that can be done not iteratively (read once). Forward propagate immediate involed in assignments." ; FIXME: Typo. Involved or invoked? @@ -2575,16 +2576,16 @@ Forward propagate immediate involed in assignments." ; FIXME: Typo. Involved or (`(setimm ,lval ,v) (setf (comp-cstr-imm lval) v)))))) -(defun comp-function-foldable-p (f args) +(defun comp--function-foldable-p (f args) "Given function F called with ARGS, return non-nil when optimizable." (and (comp--function-pure-p f) (cl-every #'comp-cstr-imm-vld-p args))) -(defun comp-function-call-maybe-fold (insn f args) +(defun comp--function-call-maybe-fold (insn f args) "Given INSN, when F is pure if all ARGS are known, remove the function call. Return non-nil if the function is folded successfully." (cl-flet ((rewrite-insn-as-setimm (insn value) - ;; See `comp-emit-setimm'. + ;; See `comp--emit-setimm'. (comp--add-const-to-relocs value) (setf (car insn) 'setimm (cddr insn) `(,value)))) @@ -2596,7 +2597,7 @@ Return non-nil if the function is folded successfully." comp-symbol-values-optimizable))) (rewrite-insn-as-setimm insn (symbol-value (comp-cstr-imm (car args)))))) - ((comp-function-foldable-p f args) + ((comp--function-foldable-p f args) (ignore-errors ;; No point to complain here in case of error because we ;; should do basic block pruning in order to be sure that this @@ -2607,14 +2608,14 @@ Return non-nil if the function is folded successfully." ;; and know to be pure. (comp-func-byte-func f-in-ctxt) f)) - (value (comp-apply-in-env f (mapcar #'comp-cstr-imm args)))) + (value (comp--apply-in-env f (mapcar #'comp-cstr-imm args)))) (rewrite-insn-as-setimm insn value))))))) -(defun comp-fwprop-call (insn lval f args) +(defun comp--fwprop-call (insn lval f args) "Propagate on a call INSN into LVAL. F is the function being called with arguments ARGS. Fold the call in case." - (unless (comp-function-call-maybe-fold insn f args) + (unless (comp--function-call-maybe-fold insn f args) (when (and (eq 'funcall f) (comp-cstr-imm-vld-p (car args))) (setf f (comp-cstr-imm (car args)) @@ -2635,16 +2636,16 @@ Fold the call in case." (comp-type-spec-to-cstr (comp-cstr-imm (car args))))))))) -(defun comp-fwprop-insn (insn) +(defun comp--fwprop-insn (insn) "Propagate within INSN." (pcase insn (`(set ,lval ,rval) (pcase rval (`(,(or 'call 'callref) ,f . ,args) - (comp-fwprop-call insn lval f args)) + (comp--fwprop-call insn lval f args)) (`(,(or 'direct-call 'direct-callref) ,f . ,args) (let ((f (comp-func-name (gethash f (comp-ctxt-funcs-h comp-ctxt))))) - (comp-fwprop-call insn lval f args))) + (comp--fwprop-call insn lval f args))) (_ (comp-cstr-shallow-copy lval rval)))) (`(assume ,lval ,(and (pred comp-mvar-p) rval)) @@ -2689,7 +2690,7 @@ Fold the call in case." (rvals (mapcar #'car rest))) (apply prop-fn lval rvals))))) -(defun comp-fwprop* () +(defun comp--fwprop* () "Propagate for set* and phi operands. Return t if something was changed." (cl-loop named outer @@ -2701,17 +2702,17 @@ Return t if something was changed." for insn in (comp-block-insns b) for orig-insn = (unless modified ;; Save consing after 1st change. - (comp-copy-insn insn)) + (comp--copy-insn insn)) do - (comp-fwprop-insn insn) + (comp--fwprop-insn insn) (cl-incf i) when (and (null modified) (not (equal insn orig-insn))) do (setf modified t)) - when (> i comp-fwprop-max-insns-scan) + when (> i comp--fwprop-max-insns-scan) do (cl-return-from outer nil) finally return modified)) -(defun comp-rewrite-non-locals () +(defun comp--rewrite-non-locals () "Make explicit in LIMPLE non-local exits if identified." (cl-loop for bb being each hash-value of (comp-func-blocks comp-func) @@ -2728,26 +2729,26 @@ Return t if something was changed." (cdr insn-seq) '((unreachable)) (comp-func-ssa-status comp-func) 'dirty)))) -(defun comp-fwprop (_) +(defun comp--fwprop (_) "Forward propagate types and consts within the lattice." - (comp-ssa) - (comp-dead-code) + (comp--ssa) + (comp--dead-code) (maphash (lambda (_ f) (when (and (>= (comp-func-speed f) 2) ;; FIXME remove the following condition when tested. (not (comp-func-has-non-local f))) (let ((comp-func f)) - (comp-fwprop-prologue) + (comp--fwprop-prologue) (cl-loop for i from 1 to 100 - while (comp-fwprop*) + while (comp--fwprop*) finally (when (= i 100) (display-warning 'comp (format "fwprop pass jammed into %s?" (comp-func-name f)))) (comp-log (format "Propagation run %d times\n" i) 2)) - (comp-rewrite-non-locals) + (comp--rewrite-non-locals) (comp--log-func comp-func 3)))) (comp-ctxt-funcs-h comp-ctxt))) @@ -2767,7 +2768,7 @@ Return t if something was changed." ;; the full compilation unit. ;; For this reason this is triggered only at native-comp-speed == 3. -(defun comp-func-in-unit (func) +(defun comp--func-in-unit (func) "Given FUNC return the `comp-fun' definition in the current context. FUNCTION can be a function-name or byte compiled function." (if (symbolp func) @@ -2775,11 +2776,11 @@ FUNCTION can be a function-name or byte compiled function." (cl-assert (byte-code-function-p func)) (gethash func (comp-ctxt-byte-func-to-func-h comp-ctxt)))) -(defun comp-call-optim-form-call (callee args) +(defun comp--call-optim-form-call (callee args) (cl-flet ((fill-args (args total) ;; Fill missing args to reach TOTAL (append args (cl-loop repeat (- total (length args)) - collect (make-comp-mvar :constant nil))))) + collect (make--comp-mvar :constant nil))))) (when (and callee (or (symbolp callee) (gethash callee (comp-ctxt-byte-func-to-func-h comp-ctxt))) @@ -2797,7 +2798,7 @@ FUNCTION can be a function-name or byte compiled function." ;; actually cheaper since it avoids the call to the ;; intermediate native trampoline (bug#67005). (subrp (subrp f)) - (comp-func-callee (comp-func-in-unit callee))) + (comp-func-callee (comp--func-in-unit callee))) (cond ((and subrp (not (subr-native-elisp-p f))) ;; Trampoline removal. @@ -2832,30 +2833,30 @@ FUNCTION can be a function-name or byte compiled function." ((comp--type-hint-p callee) `(call ,callee ,@args))))))) -(defun comp-call-optim-func () +(defun comp--call-optim-func () "Perform the trampoline call optimization for the current function." (cl-loop for b being each hash-value of (comp-func-blocks comp-func) - do (comp-loop-insn-in-block b + do (comp--loop-insn-in-block b (pcase insn (`(set ,lval (callref funcall ,f . ,rest)) (when-let ((ok (comp-cstr-imm-vld-p f)) - (new-form (comp-call-optim-form-call + (new-form (comp--call-optim-form-call (comp-cstr-imm f) rest))) (setf insn `(set ,lval ,new-form)))) (`(callref funcall ,f . ,rest) (when-let ((ok (comp-cstr-imm-vld-p f)) - (new-form (comp-call-optim-form-call + (new-form (comp--call-optim-form-call (comp-cstr-imm f) rest))) (setf insn new-form))))))) -(defun comp-call-optim (_) +(defun comp--call-optim (_) "Try to optimize out funcall trampoline usage when possible." (maphash (lambda (_ f) (when (and (>= (comp-func-speed f) 2) (comp-func-l-p f)) (let ((comp-func f)) - (comp-call-optim-func)))) + (comp--call-optim-func)))) (comp-ctxt-funcs-h comp-ctxt))) @@ -2866,16 +2867,16 @@ FUNCTION can be a function-name or byte compiled function." ;; ;; This pass can be run as last optim. -(defun comp-collect-mvar-ids (insn) +(defun comp--collect-mvar-ids (insn) "Collect the m-var unique identifiers into INSN." (cl-loop for x in insn if (consp x) - append (comp-collect-mvar-ids x) + append (comp--collect-mvar-ids x) else when (comp-mvar-p x) collect (comp-mvar-id x))) -(defun comp-dead-assignments-func () +(defun comp--dead-assignments-func () "Clean-up dead assignments into current function. Return the list of m-var ids nuked." (let ((l-vals ()) @@ -2888,9 +2889,9 @@ Return the list of m-var ids nuked." for (op arg0 . rest) = insn if (comp--assign-op-p op) do (push (comp-mvar-id arg0) l-vals) - (setf r-vals (nconc (comp-collect-mvar-ids rest) r-vals)) + (setf r-vals (nconc (comp--collect-mvar-ids rest) r-vals)) else - do (setf r-vals (nconc (comp-collect-mvar-ids insn) r-vals)))) + do (setf r-vals (nconc (comp--collect-mvar-ids insn) r-vals)))) ;; Every l-value appearing that does not appear as r-value has no right to ;; exist and gets nuked. (let ((nuke-list (cl-set-difference l-vals r-vals))) @@ -2902,7 +2903,7 @@ Return the list of m-var ids nuked." 3) (cl-loop for b being each hash-value of (comp-func-blocks comp-func) - do (comp-loop-insn-in-block b + do (comp--loop-insn-in-block b (cl-destructuring-bind (op &optional arg0 arg1 &rest rest) insn (when (and (comp--assign-op-p op) (memq (comp-mvar-id arg0) nuke-list)) @@ -2913,7 +2914,7 @@ Return the list of m-var ids nuked." insn)))))))) nuke-list))) -(defun comp-dead-code () +(defun comp--dead-code () "Dead code elimination." (maphash (lambda (_ f) (when (and (>= (comp-func-speed f) 2) @@ -2922,7 +2923,7 @@ Return the list of m-var ids nuked." (cl-loop for comp-func = f for i from 1 - while (comp-dead-assignments-func) + while (comp--dead-assignments-func) finally (comp-log (format "dead code rm run %d times\n" i) 2) (comp--log-func comp-func 3)))) (comp-ctxt-funcs-h comp-ctxt))) @@ -2930,14 +2931,14 @@ Return the list of m-var ids nuked." ;;; Tail Call Optimization pass specific code. -(defun comp-form-tco-call-seq (args) +(defun comp--form-tco-call-seq (args) "Generate a TCO sequence for ARGS." `(,@(cl-loop for arg in args for i from 0 - collect `(set ,(make-comp-mvar :slot i) ,arg)) + collect `(set ,(make--comp-mvar :slot i) ,arg)) (jump bb_0))) -(defun comp-tco-func () +(defun comp--tco-func () "Try to pattern match and perform TCO within the current function." (cl-loop for b being each hash-value of (comp-func-blocks comp-func) @@ -2950,20 +2951,20 @@ Return the list of m-var ids nuked." (return ,ret-val)) (when (and (string= func (comp-func-c-name comp-func)) (eq l-val ret-val)) - (let ((tco-seq (comp-form-tco-call-seq args))) + (let ((tco-seq (comp--form-tco-call-seq args))) (setf (car insns-seq) (car tco-seq) (cdr insns-seq) (cdr tco-seq) (comp-func-ssa-status comp-func) 'dirty) (cl-return-from in-the-basic-block)))))))) -(defun comp-tco (_) +(defun comp--tco (_) "Simple peephole pass performing self TCO." (maphash (lambda (_ f) (when (and (>= (comp-func-speed f) 3) (comp-func-l-p f) (not (comp-func-has-non-local f))) (let ((comp-func f)) - (comp-tco-func) + (comp--tco-func) (comp--log-func comp-func 3)))) (comp-ctxt-funcs-h comp-ctxt))) @@ -2973,29 +2974,29 @@ Return the list of m-var ids nuked." ;; This must run after all SSA prop not to have the type hint ;; information overwritten. -(defun comp-remove-type-hints-func () +(defun comp--remove-type-hints-func () "Remove type hints from the current function. These are substituted with a normal `set' op." (cl-loop for b being each hash-value of (comp-func-blocks comp-func) - do (comp-loop-insn-in-block b + do (comp--loop-insn-in-block b (pcase insn (`(set ,l-val (call ,(pred comp--type-hint-p) ,r-val)) (setf insn `(set ,l-val ,r-val))))))) -(defun comp-remove-type-hints (_) +(defun comp--remove-type-hints (_) "Dead code elimination." (maphash (lambda (_ f) (when (>= (comp-func-speed f) 2) (let ((comp-func f)) - (comp-remove-type-hints-func) + (comp--remove-type-hints-func) (comp--log-func comp-func 3)))) (comp-ctxt-funcs-h comp-ctxt))) ;;; Final pass specific code. -(defun comp-args-to-lambda-list (args) +(defun comp--args-to-lambda-list (args) "Return a lambda list for ARGS." (cl-loop with res @@ -3020,7 +3021,7 @@ These are substituted with a normal `set' op." (push 't res)))) (cl-return (reverse res)))) -(defun comp-compute-function-type (_ func) +(defun comp--compute-function-type (_ func) "Compute type specifier for `comp-func' FUNC. Set it into the `type' slot." (when (and (comp-func-l-p func) @@ -3040,13 +3041,13 @@ Set it into the `type' slot." (`(return ,mvar) (push mvar res)))) finally return res))) - (type `(function ,(comp-args-to-lambda-list (comp-func-l-args func)) + (type `(function ,(comp--args-to-lambda-list (comp-func-l-args func)) ,(comp-cstr-to-type-spec res-mvar)))) (comp--add-const-to-relocs type) ;; Fix it up. (setf (comp-cstr-imm (comp-func-type func)) type)))) -(defun comp-finalize-container (cont) +(defun comp--finalize-container (cont) "Finalize data container CONT." (setf (comp-data-container-l cont) (cl-loop with h = (comp-data-container-idx cont) @@ -3064,7 +3065,7 @@ Set it into the `type' slot." 'lambda-fixup obj)))) -(defun comp-finalize-relocs () +(defun comp--finalize-relocs () "Finalize data containers for each relocation class. Remove immediate duplicates within relocation classes. Update all insn accordingly." @@ -3080,7 +3081,7 @@ Update all insn accordingly." (d-ephemeral (comp-ctxt-d-ephemeral comp-ctxt)) (d-ephemeral-idx (comp-data-container-idx d-ephemeral))) ;; We never want compiled lambdas ending up in pure space. A copy must - ;; be already present in impure (see `comp-emit-lambda-for-top-level'). + ;; be already present in impure (see `comp--emit-lambda-for-top-level'). (cl-loop for obj being each hash-keys of d-default-idx when (gethash obj (comp-ctxt-lambda-fixups-h comp-ctxt)) do (cl-assert (gethash obj d-impure-idx)) @@ -3096,7 +3097,7 @@ Update all insn accordingly." do (remhash obj d-ephemeral-idx)) ;; Fix-up indexes in each relocation class and fill corresponding ;; reloc lists. - (mapc #'comp-finalize-container (list d-default d-impure d-ephemeral)) + (mapc #'comp--finalize-container (list d-default d-impure d-ephemeral)) ;; Make a vector from the function documentation hash table. (cl-loop with h = (comp-ctxt-function-docs comp-ctxt) with v = (make-vector (hash-table-count h) nil) @@ -3120,11 +3121,11 @@ Update all insn accordingly." (comp-mvar-range mvar) (list (cons idx idx))) (puthash idx t reverse-h)))) -(defun comp-compile-ctxt-to-file (name) +(defun comp--compile-ctxt-to-file (name) "Compile as native code the current context naming it NAME. Prepare every function for final compilation and drive the C back-end." (let ((dir (file-name-directory name))) - (comp-finalize-relocs) + (comp--finalize-relocs) (maphash (lambda (_ f) (comp--log-func f 1)) (comp-ctxt-funcs-h comp-ctxt)) @@ -3132,12 +3133,12 @@ Prepare every function for final compilation and drive the C back-end." ;; In case it's created in the meanwhile. (ignore-error file-already-exists (make-directory dir t))) - (comp--compile-ctxt-to-file name))) + (comp--compile-ctxt-to-file0 name))) -(defun comp-final1 () +(defun comp--final1 () (comp--init-ctxt) (unwind-protect - (comp-compile-ctxt-to-file (comp-ctxt-output comp-ctxt)) + (comp--compile-ctxt-to-file (comp-ctxt-output comp-ctxt)) (comp--release-ctxt))) (defvar comp-async-compilation nil @@ -3146,17 +3147,17 @@ Prepare every function for final compilation and drive the C back-end." (defvar comp-running-batch-compilation nil "Non-nil when compilation is driven by any `batch-*-compile' function.") -(defun comp-final (_) +(defun comp--final (_) "Final pass driving the C back-end for code emission." - (maphash #'comp-compute-function-type (comp-ctxt-funcs-h comp-ctxt)) + (maphash #'comp--compute-function-type (comp-ctxt-funcs-h comp-ctxt)) (unless comp-dry-run ;; Always run the C side of the compilation as a sub-process ;; unless during bootstrap or async compilation (bug#45056). GCC ;; leaks memory but also interfere with the ability of Emacs to ;; detect when a sub-process completes (TODO understand why). (if (or comp-running-batch-compilation comp-async-compilation) - (comp-final1) - ;; Call comp-final1 in a child process. + (comp--final1) + ;; Call comp--final1 in a child process. (let* ((output (comp-ctxt-output comp-ctxt)) (print-escape-newlines t) (print-length nil) @@ -3178,7 +3179,7 @@ Prepare every function for final compilation and drive the C back-end." load-path ',load-path) ,native-comp-async-env-modifier-form (message "Compiling %s..." ',output) - (comp-final1))) + (comp--final1))) (temp-file (make-temp-file (concat "emacs-int-comp-" (file-name-base output) "-") @@ -3222,7 +3223,7 @@ Prepare every function for final compilation and drive the C back-end." ;; Primitive function advice machinery -(defun comp-make-lambda-list-from-subr (subr) +(defun comp--make-lambda-list-from-subr (subr) "Given SUBR return the equivalent lambda-list." (pcase-let ((`(,min . ,max) (subr-arity subr)) (lambda-list '())) @@ -3266,7 +3267,7 @@ Prepare every function for final compilation and drive the C back-end." ;;;###autoload (defun comp-trampoline-compile (subr-name) "Synthesize compile and return a trampoline for SUBR-NAME." - (let* ((lambda-list (comp-make-lambda-list-from-subr + (let* ((lambda-list (comp--make-lambda-list-from-subr (symbol-function subr-name))) ;; The synthesized trampoline must expose the exact same ABI of ;; the primitive we are replacing in the function reloc table. @@ -3310,6 +3311,7 @@ filename (including FILE)." do (ignore-error file-error (comp-delete-or-replace-file f)))))) +;; In use by comp.c. (defun comp-delete-or-replace-file (oldfile &optional newfile) "Replace OLDFILE with NEWFILE. When NEWFILE is nil just delete OLDFILE. @@ -3493,7 +3495,7 @@ last directory in `native-comp-eln-load-path')." else collect (byte-compile-file file)))) -(defun comp-write-bytecode-file (eln-file) +(defun comp--write-bytecode-file (eln-file) "After native compilation write the bytecode file for ELN-FILE. Make sure that eln file is younger than byte-compiled one and return the filename of this last. @@ -3530,7 +3532,7 @@ variable \"NATIVE_DISABLED\" is set, only byte compile." (car (last native-comp-eln-load-path))) (byte-to-native-output-buffer-file nil) (eln-file (car (batch-native-compile)))) - (comp-write-bytecode-file eln-file) + (comp--write-bytecode-file eln-file) (setq command-line-args-left (cdr command-line-args-left))))) (defun native-compile-prune-cache () diff --git a/src/comp.c b/src/comp.c index 853757f6162..3f989c722d4 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4859,8 +4859,8 @@ add_compiler_options (void) #endif } -DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, - Scomp__compile_ctxt_to_file, +DEFUN ("comp--compile-ctxt-to-file0", Fcomp__compile_ctxt_to_file0, + Scomp__compile_ctxt_to_file0, 1, 1, 0, doc: /* Compile the current context as native code to file FILENAME. */) (Lisp_Object filename) @@ -5789,7 +5789,7 @@ natively-compiled one. */); defsubr (&Scomp__install_trampoline); defsubr (&Scomp__init_ctxt); defsubr (&Scomp__release_ctxt); - defsubr (&Scomp__compile_ctxt_to_file); + defsubr (&Scomp__compile_ctxt_to_file0); defsubr (&Scomp_libgccjit_version); defsubr (&Scomp__register_lambda); defsubr (&Scomp__register_subr); diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el index 4cee084e211..dc4abf50767 100644 --- a/test/src/comp-resources/comp-test-funcs.el +++ b/test/src/comp-resources/comp-test-funcs.el @@ -367,11 +367,11 @@ (while (consp insn) (let ((newcar (car insn))) (if (or (consp (car insn)) (comp-mvar-p (car insn))) - (setf newcar (comp-copy-insn (car insn)))) + (setf newcar (comp--copy-insn (car insn)))) (push newcar result)) (setf insn (cdr insn))) (nconc (nreverse result) - (if (comp-mvar-p insn) (comp-copy-insn insn) insn))) + (if (comp-mvar-p insn) (comp--copy-insn insn) insn))) (if (comp-mvar-p insn) (copy-comp-mvar insn) insn))) -- cgit v1.2.3 From c0f656617d6848b94413b79b390788565d338fcd Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sun, 11 Feb 2024 22:32:44 +0200 Subject: Make sure the binding shown by echo-keystrokes-help is not shadowed And choose just one binding to display rather than two together. (https://lists.gnu.org/archive/html/emacs-devel/2024-02/msg00311.html) * lisp/help.el (help--append-keystrokes-help): New function. * src/keyboard.c (syms_of_keyboard): Add a symbol for it. (echo_dash): Use them here. --- lisp/help.el | 21 +++++++++++++++++++++ src/keyboard.c | 13 +++++-------- 2 files changed, 26 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/help.el b/lisp/help.el index 72a4f8a800d..07eed2861c2 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -2253,6 +2253,27 @@ The `temp-buffer-window-setup-hook' hook is called." (with-output-to-temp-buffer " *Char Help*" (princ msg))))) +(defun help--append-keystrokes-help (str) + (let* ((keys (this-single-command-keys)) + (bindings (delete nil + (mapcar (lambda (map) (lookup-key map keys t)) + (current-active-maps t))))) + (catch 'res + (dolist (val help-event-list) + (let ((key (vector (if (eql val 'help) + help-char + val)))) + (unless (seq-find (lambda (map) (and (keymapp map) (lookup-key map key))) + bindings) + (throw 'res + (concat + str + (substitute-command-keys + (format + " (\\`%s' for help)" + (key-description key)))))))) + str))) + (defun help--docstring-quote (string) "Return a doc string that represents STRING. diff --git a/src/keyboard.c b/src/keyboard.c index 10cdef67348..4b5e20fb24c 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -594,14 +594,9 @@ echo_dash (void) concat2 (KVAR (current_kboard, echo_string), dash)); if (echo_keystrokes_help) - { - Lisp_Object help; - - help = build_string (" (\\`C-h' or \\`' for help)"); - kset_echo_string (current_kboard, - concat2 (KVAR (current_kboard, echo_string), - calln (Qsubstitute_command_keys, help))); - } + kset_echo_string (current_kboard, + calln (Qhelp__append_keystrokes_help, + KVAR (current_kboard, echo_string))); echo_now (); } @@ -12962,6 +12957,8 @@ syms_of_keyboard (void) DEFSYM (Qhelp_key_binding, "help-key-binding"); + DEFSYM (Qhelp__append_keystrokes_help, "help--append-keystrokes-help"); + DEFSYM (Qecho_keystrokes, "echo-keystrokes"); Fset (Qinput_method_exit_on_first_char, Qnil); -- cgit v1.2.3 From db195116a4279521e9cf03c52b7026032461e3e1 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 13 Sep 2023 12:26:22 +0200 Subject: Add the public API of Compat to the core * lisp/emacs-lisp/compat.el: Add stub file with minimal definitions, so that core packages, that haven't been installed from ELPA, can make use of the public API and use more recent function signatures. * lisp/progmodes/python.el (compat): Remove 'noerror flag, because Compat can now be required without the real package being available. * doc/lispref/package.texi (Forwards-Compatibility): Mention Compat and link to the manual. * etc/NEWS: Document change. (Bug#66554) --- doc/lispref/package.texi | 48 +++++++++++++++++++++++++ etc/NEWS | 7 ++++ lisp/emacs-lisp/compat.el | 92 +++++++++++++++++++++++++++++++++++++++++++++++ lisp/progmodes/python.el | 2 +- 4 files changed, 148 insertions(+), 1 deletion(-) create mode 100644 lisp/emacs-lisp/compat.el (limited to 'lisp') diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi index f75023d4039..421e64dd5d1 100644 --- a/doc/lispref/package.texi +++ b/doc/lispref/package.texi @@ -28,6 +28,7 @@ these archives). * Multi-file Packages:: How to package multiple files. * Package Archives:: Maintaining package archives. * Archive Web Server:: Interfacing to an archive web server. +* Forwards-Compatibility:: Supporting older versions of Emacs. @end menu @node Packaging Basics @@ -399,3 +400,50 @@ Return the file. This will be the tarball for a multi-file package, or the single file for a simple package. @end table + +@node Forwards-Compatibility +@section Supporting older versions of Emacs +@cindex compatibility compat + +Packages that wish to support older releases of Emacs, without giving +up on newer functionality from recent Emacs releases, one can make use +of the Compat package on GNU ELPA. By depending on the package, Emacs +can provide compatibility definitions for missing functionality. + +The versioning of Compat follows that of Emacs, so next to the oldest +version that a package relies on (via the @code{emacs}-package), one +can also indicate what the newest version of Emacs is, that a package +wishes to use definitions from: + +@example +;; Package-Requires: ((emacs "27.2") (compat "29.1")) +@end example + +Note that Compat provides replacement functions with extended +functionality for functions that are already defined (@code{sort}, +@code{assoc}, @dots{}). These functions may have changed their +calling convention (additional optional arguments) or may have changed +their behavior. These functions must be looked up explicitly with +@code{compat-function} or called explicitly with @code{compat-call}. +We call them @dfn{Extended Definitions}. In contrast, newly @dfn{Added +Definitions} can be called as usual. + +@defmac compat-call fun &rest args +This macro calls the compatibility function @var{fun} with @var{args}. +Many functions provided by Compat can be called directly without this +macro. However in the case where Compat provides an alternative +version of an existing function, the function call has to go through +@code{compat-call}. +@end defmac + +@defmac compat-function fun +This macro returns the compatibility function symbol for @var{fun}. +See @code{compat-call} for a more convenient macro to directly call +compatibility functions. +@end defmac + +For further details on how to make use of the package, see +@ref{Usage,, Usage, compat, "Compat" Manual}. In case you don't have +the manual installed, you can also read the +@url{https://elpa.gnu.org/packages/doc/compat.html#Usage, Online +Compat manual}. diff --git a/etc/NEWS b/etc/NEWS index 5ee1509859b..de1f2fd9d2a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1396,6 +1396,13 @@ This minor mode generates the tags table automatically based on the current project configuration, and later updates it as you edit the files and save the changes. ++++ +** New package Compat +Emacs now comes with a stub implementation of the +forwards-compatibility Compat package from GNU ELPA. This allows +built-in packages to use the library more effectively, and helps +preventing the installation of Compat if unnecessary. + * Incompatible Lisp Changes in Emacs 30.1 diff --git a/lisp/emacs-lisp/compat.el b/lisp/emacs-lisp/compat.el new file mode 100644 index 00000000000..f7037dc4101 --- /dev/null +++ b/lisp/emacs-lisp/compat.el @@ -0,0 +1,92 @@ +;;; compat.el --- Stub of the Compatibility Library -*- lexical-binding: t; -*- + +;; Copyright (C) 2021-2024 Free Software Foundation, Inc. + +;; Author: \ +;; Philip Kaludercic , \ +;; Daniel Mendler +;; Maintainer: \ +;; Daniel Mendler , \ +;; Compat Development <~pkal/compat-devel@lists.sr.ht>, +;; emacs-devel@gnu.org +;; URL: https://github.com/emacs-compat/compat +;; Keywords: lisp, maint + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The Compat package on ELPA provides forward-compatibility +;; definitions for other packages. While mostly transparent, a +;; minimal API is necessary whenever core definitions change calling +;; conventions (e.g. `plist-get' can be invoked with a predicate from +;; Emacs 29.1 onward). For core packages on ELPA to be able to take +;; advantage of this functionality, the macros `compat-function' and +;; `compat-call' have to be available in the core, usable even if +;; users do not have the Compat package installed, which this file +;; ensures. + +;; A basic introduction to Compat is given in the Info node `(elisp) +;; Forwards Compatibility'. Further details on Compat are documented +;; in the Info node `(compat) Top' (installed along with the Compat +;; package) or read the same manual online: +;; https://elpa.gnu.org/packages/doc/compat.html. + +;;; Code: + +(defmacro compat-function (fun) + "Return compatibility function symbol for FUN. +This is a pseudo-compatibility stub for core packages on ELPA, +that depend on the Compat package, whenever the user doesn't have +the package installed on their current system." + `#',fun) + +(defmacro compat-call (fun &rest args) + "Call compatibility function or macro FUN with ARGS. +This is a pseudo-compatibility stub for core packages on ELPA, +that depend on the Compat package, whenever the user doesn't have +the package installed on their current system." + (cons fun args)) + +;;;; Clever trick to avoid installing Compat if not necessary + +;; The versioning scheme of the Compat package follows that of Emacs, +;; to indicate the version of Emacs, that functionality is being +;; provided for. For example, the Compat version number 29.2.3.9 +;; would attempt to provide compatibility definitions up to Emacs +;; 29.2, while also designating that this is the third major release +;; and ninth minor release of Compat, for the specific Emacs release. + +;; The package version of this file is specified programmatically, +;; instead of giving a fixed version in the header of this file. This +;; is done to ensure that the version of compat.el provided by Emacs +;; always corresponds to the current version of Emacs. In addition to +;; the major-minor version, a large "major release" makes sure that +;; the built-in version of Compat is always preferred over an external +;; installation. This means that if a package specifies a dependency +;; on Compat which matches the current or an older version of Emacs +;; that is being used, no additional dependencies have to be +;; downloaded. +;; +;; Further details and background on this file can be found in the +;; bug#66554 discussion. + +;;;###autoload (push (list 'compat +;;;###autoload emacs-major-version +;;;###autoload emacs-minor-version +;;;###autoload 9999) +;;;###autoload package--builtin-versions) + +(provide 'compat) +;;; compat.el ends here diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index b1654b6a5aa..b7e43f3fc68 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -273,7 +273,7 @@ (eval-when-compile (require 'subr-x)) ;For `string-empty-p' and `string-join'. (require 'treesit) (require 'pcase) -(require 'compat nil 'noerror) +(require 'compat) (require 'project nil 'noerror) (require 'seq) -- cgit v1.2.3 From 998f9d98c3b0611b472f4be963d24a96c0a9e197 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 6 Feb 2024 20:12:15 +0100 Subject: Tolerate errors while recompiling all packages * lisp/emacs-lisp/package.el (package-recompile-all): Demote errors raised by 'package-recompile'. (Bug#68678) --- lisp/emacs-lisp/package.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 868373f46c2..fe7b10f569a 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2610,7 +2610,8 @@ This is meant to be used only in the case the byte-compiled files are invalid due to changed byte-code, macros or the like." (interactive) (pcase-dolist (`(_ ,pkg-desc) package-alist) - (package-recompile pkg-desc))) + (with-demoted-errors "Error while recompiling: %S" + (package-recompile pkg-desc)))) ;;;###autoload (defun package-autoremove () -- cgit v1.2.3 From 052c2ce0284c5193c9d6768a45a9b3508af51230 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Feb 2024 17:43:37 -0500 Subject: (pcase): Add buttons to the macros' defs in the docstring of `pcase` * lisp/emacs-lisp/pcase.el (pcase--find-macro-def-regexp): New var. (find-function-regexp-alist): Add entry for `pcase-macro`s. (help-fns--signature): Move declaration to where we know it is valid. (pcase--make-docstring): Add buttons to jump to the definition of Pcase macros. --- lisp/emacs-lisp/pcase.el | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 4754d4e720d..880a1829265 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -163,8 +163,12 @@ Emacs Lisp manual for more information and examples." ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2) expansion)))) -(declare-function help-fns--signature "help-fns" - (function doc real-def real-function buffer)) +(defconst pcase--find-macro-def-regexp "(pcase-defmacro[\s\t\n]+%s[\s\t\n]*(") + +(with-eval-after-load 'find-func + (defvar find-function-regexp-alist) + (add-to-list 'find-function-regexp-alist + `(pcase-macro . pcase--find-macro-def-regexp))) ;; FIXME: Obviously, this will collide with nadvice's use of ;; function-documentation if we happen to advise `pcase'. @@ -174,9 +178,10 @@ Emacs Lisp manual for more information and examples." (defun pcase--make-docstring () (let* ((main (documentation (symbol-function 'pcase) 'raw)) (ud (help-split-fundoc main 'pcase))) - ;; So that eg emacs -Q -l cl-lib --eval "(documentation 'pcase)" works, - ;; where cl-lib is anything using pcase-defmacro. (require 'help-fns) + (declare-function help-fns-short-filename "help-fns" (filename)) + (declare-function help-fns--signature "help-fns" + (function doc real-def real-function buffer)) (with-temp-buffer (insert (or (cdr ud) main)) ;; Presentation Note: For conceptual continuity, we guarantee @@ -197,11 +202,20 @@ Emacs Lisp manual for more information and examples." (let* ((pair (pop more)) (symbol (car pair)) (me (cdr pair)) - (doc (documentation me 'raw))) + (doc (documentation me 'raw)) + (filename (find-lisp-object-file-name me 'defun))) (insert "\n\n-- ") (setq doc (help-fns--signature symbol doc me (indirect-function me) nil)) + (when filename + (save-excursion + (forward-char -1) + (insert (format-message " in `")) + (help-insert-xref-button (help-fns-short-filename filename) + 'help-function-def symbol filename + 'pcase-macro) + (insert (format-message "'.")))) (insert "\n" (or doc "Not documented."))))) (let ((combined-doc (buffer-string))) (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc))))) -- cgit v1.2.3 From 9a1522197fb16986c2f641f777d6bef41c348567 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Feb 2024 18:13:27 -0500 Subject: (cl--generic-describe): Fix regression introduced by fix to bug#54628 Since that fix, we made other changes (put arg names in allcaps) which also happen to fix bug#54628, so we can remove the original fix which was suboptimal when the type includes quotes. * lisp/emacs-lisp/cl-generic.el (cl--generic-describe): Don't rebind `print-quoted` to nil. * test/lisp/emacs-lisp/cl-generic-tests.el (cl-generic-tests--print-quoted): New test. --- lisp/emacs-lisp/cl-generic.el | 5 ++--- test/lisp/emacs-lisp/cl-generic-tests.el | 14 ++++++++++++++ 2 files changed, 16 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index bdccdcc48ce..d1bd45120f1 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1145,7 +1145,7 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." (declare-function help-fns-short-filename "help-fns" (filename)) (let ((generic (if (symbolp function) (cl--generic function)))) (when generic - (require 'help-mode) ;Needed for `help-function-def' button! + (require 'help-mode) ;Needed for `help-function-def' button! (save-excursion ;; Ensure that we have two blank lines (but not more). (unless (looking-back "\n\n" (- (point) 2)) @@ -1157,8 +1157,7 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." (pcase-let* ((`(,qualifiers ,args ,doc) (cl--generic-method-info method))) ;; FIXME: Add hyperlinks for the types as well. - (let ((print-quoted nil) - (quals (if (length> qualifiers 0) + (let ((quals (if (length> qualifiers 0) (concat (substring qualifiers 0 (string-match " *\\'" qualifiers)) diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index 086ac399352..990fa580c54 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el @@ -319,5 +319,19 @@ Edebug symbols (Bug#42672)." (and (eq 'error (car err)) (string-match "Stray.*declare" (cadr err))))))) +(cl-defmethod cl-generic-tests--print-quoted-method ((function (eql '4))) + (+ function 1)) + +(ert-deftest cl-generic-tests--print-quoted () + (with-temp-buffer + (cl--generic-describe 'cl-generic-tests--print-quoted-method) + (goto-char (point-min)) + ;; Bug#54628: We don't want (function (eql '4)) to turn into #'(eql '4) + (should-not (re-search-forward "#'" nil t)) + (goto-char (point-min)) + ;; But we don't want (eql '4) to turn into (eql (quote 4)) either. + (should (re-search-forward "(eql '4)" nil t)))) + + (provide 'cl-generic-tests) ;;; cl-generic-tests.el ends here -- cgit v1.2.3 From 9ebc91795f22ca52ea019b8ce7fb1f6e4c8df826 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 12 Feb 2024 02:38:30 +0100 Subject: Remove redundant `apply` with `derived-mode-p` * lisp/cedet/mode-local.el (mode-local-map-mode-buffers): * lisp/progmodes/which-func.el (which-func-try-to-enable): (which-func-ff-hook): Remove redundant 'apply' with 'derived-mode-p'. Suggested by Philip Kaludercic . --- lisp/cedet/mode-local.el | 4 ++-- lisp/progmodes/which-func.el | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el index 28f14232704..9f11b9707bd 100644 --- a/lisp/cedet/mode-local.el +++ b/lisp/cedet/mode-local.el @@ -1,6 +1,6 @@ ;;; mode-local.el --- Support for mode local facilities -*- lexical-binding:t -*- ;; -;; Copyright (C) 2004-2005, 2007-2024 Free Software Foundation, Inc. +;; Copyright (C) 2004-2024 Free Software Foundation, Inc. ;; ;; Author: David Ponce ;; Created: 27 Apr 2004 @@ -84,7 +84,7 @@ MODES can be a symbol or a list of symbols. FUNCTION does not have arguments." (setq modes (ensure-list modes)) (mode-local-map-file-buffers - function (lambda () (apply #'derived-mode-p modes)))) + function (lambda () (derived-mode-p modes)))) ;;; Hook machinery ;; diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 631cb3b0aef..b36e13104e3 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -211,7 +211,7 @@ non-nil.") (when which-function-mode (unless (local-variable-p 'which-func-mode) (setq which-func-mode (or (eq which-func-modes t) - (apply #'derived-mode-p which-func-modes))) + (derived-mode-p which-func-modes))) (setq which-func--use-mode-line (member which-func-display '(mode mode-and-header))) (setq which-func--use-header-line @@ -239,7 +239,7 @@ It creates the Imenu index for the buffer, if necessary." (condition-case err (if (and which-func-mode - (not (apply #'derived-mode-p which-func-non-auto-modes)) + (not (derived-mode-p which-func-non-auto-modes)) (or (null which-func-maxout) (< buffer-saved-size which-func-maxout) (= which-func-maxout 0))) -- cgit v1.2.3 From 806759dc0a6a3b049ce35d0497011464e5fc4dcb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Feb 2024 22:00:44 -0500 Subject: (pcase): New `_` syntax in pred/app functions The current syntax for functions in `app` and `pred` patterns allows a shorthand (F ARGS) where the object being matched is added as an extra last argument. This is nice for things like (pred (< 5)) but sometimes the object needs to be at another position. Until now you had to use (pred (lambda (x) (memq x my-list))) or (pred (pcase--flip memq my-list)) in those cases. So, introduce a new shorthand where `_` can be used to indicate where the object should be passed: (pred (memq _ my-list)) * lisp/emacs-lisp/pcase.el (pcase--split-pred): Document new syntax for pred/app functions. (pcase--funcall): Support new syntax. (pcase--flip): Declare obsolete. (pcase--u1, \`): Use `_` instead. (pcase--split-pred): Adjust accordingly. * doc/lispref/control.texi (pcase Macro): Document new syntax for pred/app functions. * lisp/progmodes/opascal.el (pcase-defmacro): * lisp/emacs-lisp/seq.el (seq--make-pcase-bindings): * lisp/emacs-lisp/eieio.el (eieio): * lisp/emacs-lisp/cl-macs.el (cl-struct, cl-type): Use _ instead of `pcase--flip`. (cl--pcase-mutually-exclusive-p): Adjust accordingly. * lisp/emacs-lisp/map.el (map--pcase-map-elt): Declare obsolete. (map--make-pcase-bindings): Use `_` instead. --- doc/lispref/control.texi | 10 ++++++++++ etc/NEWS | 4 ++++ lisp/emacs-lisp/cl-macs.el | 15 ++++++++------- lisp/emacs-lisp/eieio.el | 4 ++-- lisp/emacs-lisp/map.el | 7 ++++--- lisp/emacs-lisp/pcase.el | 25 ++++++++++++++++--------- lisp/emacs-lisp/seq.el | 4 ++-- lisp/progmodes/opascal.el | 2 +- 8 files changed, 47 insertions(+), 24 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 0c6895332a0..78ad5b68a51 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -638,6 +638,16 @@ with @var{n} arguments (the other elements) and an additional Example: @code{(= 42)}@* In this example, the function is @code{=}, @var{n} is one, and the actual function call becomes: @w{@code{(= 42 @var{expval})}}. + +@item function call with an @code{_} arg +Call the function (the first element of the function call) +with the specified arguments (the other elements) and replacing +@code{_} with @var{expval}. + +Example: @code{(gethash _ memo-table)} +In this example, the function is @code{gethash}, and +the actual function call becomes: @w{@code{(gethash @var{expval} +memo-table)}}. @end table @item (app @var{function} @var{pattern}) diff --git a/etc/NEWS b/etc/NEWS index de1f2fd9d2a..afc2c22e68b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1526,6 +1526,10 @@ values. * Lisp Changes in Emacs 30.1 ++++ +** Pcase's functions (in 'pred' and 'app') can specify the argument position. +For example, instead of (pred (< 5)) you can write (pred (> _ 5)). + +++ ** 'define-advice' now sets the new advice's 'name' property to NAME. Named advices defined with 'define-advice' can now be removed with diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 88447203a64..06a09885c88 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3344,14 +3344,14 @@ Elements of FIELDS can be of the form (NAME PAT) in which case the contents of field NAME is matched against PAT, or they can be of the form NAME which is a shorthand for (NAME NAME)." (declare (debug (sexp &rest [&or (sexp pcase-PAT) sexp]))) - `(and (pred (pcase--flip cl-typep ',type)) + `(and (pred (cl-typep _ ',type)) ,@(mapcar (lambda (field) (let* ((name (if (consp field) (car field) field)) (pat (if (consp field) (cadr field) field))) `(app ,(if (eq (cl-struct-sequence-type type) 'list) `(nth ,(cl-struct-slot-offset type name)) - `(pcase--flip aref ,(cl-struct-slot-offset type name))) + `(aref _ ,(cl-struct-slot-offset type name))) ,pat))) fields))) @@ -3368,13 +3368,13 @@ the form NAME which is a shorthand for (NAME NAME)." "Extra special cases for `cl-typep' predicates." (let* ((x1 pred1) (x2 pred2) (t1 - (and (eq 'pcase--flip (car-safe x1)) (setq x1 (cdr x1)) - (eq 'cl-typep (car-safe x1)) (setq x1 (cdr x1)) + (and (eq 'cl-typep (car-safe x1)) (setq x1 (cdr x1)) + (eq '_ (car-safe x1)) (setq x1 (cdr x1)) (null (cdr-safe x1)) (setq x1 (car x1)) (eq 'quote (car-safe x1)) (cadr x1))) (t2 - (and (eq 'pcase--flip (car-safe x2)) (setq x2 (cdr x2)) - (eq 'cl-typep (car-safe x2)) (setq x2 (cdr x2)) + (and (eq 'cl-typep (car-safe x2)) (setq x2 (cdr x2)) + (eq '_ (car-safe x2)) (setq x2 (cdr x2)) (null (cdr-safe x2)) (setq x2 (car x2)) (eq 'quote (car-safe x2)) (cadr x2)))) (or @@ -3818,7 +3818,8 @@ STRUCT-TYPE and SLOT-NAME are symbols. INST is a structure instance." (pcase-defmacro cl-type (type) "Pcase pattern that matches objects of TYPE. TYPE is a type descriptor as accepted by `cl-typep', which see." - `(pred (pcase--flip cl-typep ',type))) + `(pred (cl-typep _ ',type))) + ;; Local variables: ;; generated-autoload-file: "cl-loaddefs.el" diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index df85a64baf3..fba69a36a97 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -387,9 +387,9 @@ contents of field NAME is matched against PAT, or they can be of ,@(mapcar (lambda (field) (pcase-exhaustive field (`(,name ,pat) - `(app (pcase--flip eieio-oref ',name) ,pat)) + `(app (eieio-oref _ ',name) ,pat)) ((pred symbolp) - `(app (pcase--flip eieio-oref ',field) ,field)))) + `(app (eieio-oref _ ',field) ,field)))) fields))) ;;; Simple generators, and query functions. None of these would do diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index ffbb29615da..95a25978d1c 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -608,18 +608,19 @@ This allows using default values for `map-elt', which can't be done using `pcase--flip'. KEY is the key sought in the map. DEFAULT is the default value." + (declare (obsolete _ "30.1")) `(map-elt ,map ,key ,default)) (defun map--make-pcase-bindings (args) "Return a list of pcase bindings from ARGS to the elements of a map." (mapcar (lambda (elt) (cond ((consp elt) - `(app (map--pcase-map-elt ,(car elt) ,(caddr elt)) + `(app (map-elt _ ,(car elt) ,(caddr elt)) ,(cadr elt))) ((keywordp elt) (let ((var (intern (substring (symbol-name elt) 1)))) - `(app (pcase--flip map-elt ,elt) ,var))) - (t `(app (pcase--flip map-elt ',elt) ,elt)))) + `(app (map-elt _ ,elt) ,var))) + (t `(app (map-elt _ ',elt) ,elt)))) args)) (defun map--make-pcase-patterns (args) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 880a1829265..ae9bd87997c 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -131,6 +131,8 @@ FUN in `pred' and `app' can take one of the forms: call it with one argument (F ARG1 .. ARGn) call F with ARG1..ARGn and EXPVAL as n+1'th argument + (F ARG1 .. _ .. ARGn) + call F, passing EXPVAL at the _ position. FUN, BOOLEXP, and subsequent PAT can refer to variables bound earlier in the pattern by a SYMBOL pattern. @@ -814,10 +816,10 @@ A and B can be one of: #'compiled-function-p)))) (pcase--mutually-exclusive-p (cadr upat) otherpred)) '(:pcase--fail . nil)) - ;; Since we turn (or 'a 'b 'c) into (pred (pcase--flip (memq '(a b c)))) + ;; Since we turn (or 'a 'b 'c) into (pred (memq _ '(a b c))) ;; try and preserve the info we get from that memq test. - ((and (eq 'pcase--flip (car-safe (cadr upat))) - (memq (cadr (cadr upat)) '(memq member memql)) + ((and (memq (car-safe (cadr upat)) '(memq member memql)) + (eq (cadr (cadr upat)) '_) (eq 'quote (car-safe (nth 2 (cadr upat)))) (eq 'quote (car-safe pat))) (let ((set (cadr (nth 2 (cadr upat))))) @@ -865,7 +867,7 @@ A and B can be one of: (defmacro pcase--flip (fun arg1 arg2) "Helper function, used internally to avoid (funcall (lambda ...) ...)." - (declare (debug (sexp body))) + (declare (debug (sexp body)) (obsolete _ "30.1")) `(,fun ,arg2 ,arg1)) (defun pcase--funcall (fun arg vars) @@ -886,9 +888,13 @@ A and B can be one of: (let ((newsym (gensym "x"))) (push (list newsym arg) env) (setq arg newsym))) - (if (or (functionp fun) (not (consp fun))) - `(funcall #',fun ,arg) - `(,@fun ,arg))))) + (cond + ((or (functionp fun) (not (consp fun))) + `(funcall #',fun ,arg)) + ((memq '_ fun) + (mapcar (lambda (x) (if (eq '_ x) arg x)) fun)) + (t + `(,@fun ,arg)))))) (if (null env) call ;; Let's not replace `vars' in `fun' since it's @@ -949,7 +955,7 @@ Otherwise, it defers to REST which is a list of branches of the form ;; Yes, we can use `memql' (or `member')! ((> (length simples) 1) (pcase--u1 (cons `(match ,var - . (pred (pcase--flip ,mem-fun ',simples))) + . (pred (,mem-fun _ ',simples))) (cdr matches)) code vars (if (null others) rest @@ -1096,12 +1102,13 @@ The predicate is the logical-AND of: (declare (debug (pcase-QPAT))) (cond ((eq (car-safe qpat) '\,) (cadr qpat)) + ((eq (car-safe qpat) '\,@) (error "Unsupported QPAT: %S" qpat)) ((vectorp qpat) `(and (pred vectorp) (app length ,(length qpat)) ,@(let ((upats nil)) (dotimes (i (length qpat)) - (push `(app (pcase--flip aref ,i) ,(list '\` (aref qpat i))) + (push `(app (aref _ ,i) ,(list '\` (aref qpat i))) upats)) (nreverse upats)))) ((consp qpat) diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 4c6553972c2..20077db9e60 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -619,12 +619,12 @@ SEQUENCE must be a sequence of numbers or markers." (unless rest-marker (pcase name (`&rest - (progn (push `(app (pcase--flip seq-drop ,index) + (progn (push `(app (seq-drop _ ,index) ,(seq--elt-safe args (1+ index))) bindings) (setq rest-marker t))) (_ - (push `(app (pcase--flip seq--elt-safe ,index) ,name) bindings)))) + (push `(app (seq--elt-safe _ ,index) ,name) bindings)))) (setq index (1+ index))) bindings)) diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el index 5e8263cb646..a80e12b8129 100644 --- a/lisp/progmodes/opascal.el +++ b/lisp/progmodes/opascal.el @@ -281,7 +281,7 @@ nested routine.") (eval-when-compile (pcase-defmacro opascal--in (set) - `(pred (pcase--flip memq ,set)))) + `(pred (memq _ ,set)))) (defun opascal-string-of (start end) ;; Returns the buffer string from start to end. -- cgit v1.2.3 From 57544fa2a2e1f2d04aa6b6bdf49bde71141b945d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Feb 2024 22:19:49 -0500 Subject: loaddefs-gen.el: Generate an autoload for `pcase-defmacro` Autoload cookies on uses of `pcase-defmacro` used to copy the definition wholesale instead of generating the expected autoload. * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--make-autoload): Look inside `eval-and-compile` as well. --- lisp/emacs-lisp/loaddefs-gen.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 1e91e84157d..238ec9d179b 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -183,7 +183,9 @@ expression, in which case we want to handle forms differently." (loaddefs-generate--shorten-autoload `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type)))) - ((and expansion (memq car '(progn prog1))) + ;; Look inside `progn', and `eval-and-compile', since these + ;; are often used in the expansion of things like `pcase-defmacro'. + ((and expansion (memq car '(progn prog1 eval-and-compile))) (let ((end (memq :autoload-end form))) (when end ;Cut-off anything after the :autoload-end marker. (setq form (copy-sequence form)) -- cgit v1.2.3 From 6aeeae68885e09a7253a0076d0f81cc46b37f20d Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Mon, 12 Feb 2024 17:37:16 +0100 Subject: Allow using 'vc-prepare-patch' in non-VC buffers * lisp/vc/vc.el (vc-prepare-patch): Remove 'vc-ensure-vc-buffer', as it is not necessary to verify this for the command to work. --- lisp/vc/vc.el | 1 - 1 file changed, 1 deletion(-) (limited to 'lisp') diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index f612daaa569..ca6efeabac2 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3639,7 +3639,6 @@ marked revisions, use those." (read-string "Subject: " "[PATCH] " nil nil t)) revs))) (save-current-buffer - (vc-ensure-vc-buffer) (let ((patches (mapcar (lambda (rev) (vc-call-backend (vc-responsible-backend default-directory) -- cgit v1.2.3 From 3b90e5052ce1eea47430c85c0c35741e25269ce2 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 12 Feb 2024 20:16:35 +0200 Subject: Tree-sitter support for outline-minor-mode (bug#68824) * doc/emacs/text.texi (Outline Format): Add 'outline-search-function'. * doc/lispref/elisp.texi (Top): Add new menu item "Outline Minor Mode" after "Imenu". * doc/lispref/modes.texi (Modes): Add new menu item "Outline Minor Mode" after "Imenu". (Major Mode Conventions): Mention "Outline Minor Mode" with @pxref. (Outline Minor Mode): New node. * doc/lispref/parsing.texi (Tree-sitter Major Modes): Mention 'treesit-outline-predicate' with @pxref. * lisp/treesit.el (treesit-outline-predicate): New buffer-local variable. (treesit-outline-predicate--from-imenu): New internal function. (treesit-outline-search, treesit-outline-level): New functions. (treesit-major-mode-setup): Set up treesit-outline-predicate, outline-search-function and outline-level. * lisp/progmodes/c-ts-mode.el (c-ts-mode--outline-predicate): New internal function. (c-ts-base-mode): Set 'treesit-outline-predicate' to 'c-ts-mode--outline-predicate'. * lisp/progmodes/heex-ts-mode.el (heex-ts-mode): Kill inherited local variables 'outline-heading-end-regexp', 'outline-regexp', 'outline-level'. * lisp/progmodes/lua-ts-mode.el (lua-ts-mode): Remove 'outline-regexp'. Suggested by john muhl . * lisp/textmodes/html-ts-mode.el (html-ts-mode): Kill inherited local variables 'outline-heading-end-regexp', 'outline-regexp', 'outline-level'. --- doc/emacs/text.texi | 6 ++++ doc/lispref/elisp.texi | 1 + doc/lispref/modes.texi | 62 ++++++++++++++++++++++++++++++++++ doc/lispref/parsing.texi | 4 +++ etc/NEWS | 7 ++++ lisp/progmodes/c-ts-mode.el | 15 +++++++++ lisp/progmodes/heex-ts-mode.el | 10 ++++++ lisp/progmodes/lua-ts-mode.el | 12 +------ lisp/textmodes/html-ts-mode.el | 11 ++++++ lisp/treesit.el | 76 ++++++++++++++++++++++++++++++++++++++++++ 10 files changed, 193 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index 338bf014208..cb347d59948 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -1097,6 +1097,12 @@ so that Outline mode will know that sections are contained in chapters. This works as long as no other command starts with @samp{@@chap}. +@vindex outline-search-function + Instead of setting the variable @code{outline-regexp}, you can set +the variable @code{outline-search-function} to a function that +matches the current heading and searches for the next one +(@pxref{Outline Minor Mode,,,elisp, the Emacs Lisp Reference Manual}). + @vindex outline-level You can explicitly specify a rule for calculating the level of a heading line by setting the variable @code{outline-level}. The value diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index cab1622337e..ed254795d90 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -883,6 +883,7 @@ Major and Minor Modes * Minor Modes:: Defining minor modes. * Mode Line Format:: Customizing the text that appears in the mode line. * Imenu:: Providing a menu of definitions made in a buffer. +* Outline Minor Mode:: Outline mode to use with other major modes. * Font Lock Mode:: How modes can highlight text according to syntax. * Auto-Indentation:: How to teach Emacs to indent for a major mode. * Desktop Save Mode:: How modes can have buffer state saved between diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 1d961249633..70d1a40f836 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -25,6 +25,7 @@ user. For related topics such as keymaps and syntax tables, see * Minor Modes:: Defining minor modes. * Mode Line Format:: Customizing the text that appears in the mode line. * Imenu:: Providing a menu of definitions made in a buffer. +* Outline Minor Mode:: Outline mode to use with other major modes. * Font Lock Mode:: How modes can highlight text according to syntax. * Auto-Indentation:: How to teach Emacs to indent for a major mode. * Desktop Save Mode:: How modes can have buffer state saved between @@ -507,6 +508,12 @@ variable @code{imenu-generic-expression}, for the two variables @code{imenu-extract-index-name-function}, or for the variable @code{imenu-create-index-function} (@pxref{Imenu}). +@item +The mode should specify how Outline minor mode should find the +heading lines, by setting up a buffer-local value for the variables +@code{outline-regexp} or @code{outline-search-function}, and also +for the variable @code{outline-level} (@pxref{Outline Minor Mode}). + @item The mode can tell ElDoc mode how to retrieve different types of documentation for whatever is at point, by adding one or more @@ -2994,6 +3001,61 @@ instead. automatically sets up Imenu if this variable is non-@code{nil}. @end defvar +@node Outline Minor Mode +@section Outline Minor Mode + +@cindex Outline minor mode + @dfn{Outline minor mode} is a buffer-local minor mode that hides +parts of the buffer and leaves only heading lines visible. +This minor mode can be used in conjunction with other major modes +(@pxref{Outline Minor Mode,, Outline Minor Mode, emacs, the Emacs Manual}). + + There are two ways to define which lines are headings: with the +variable @code{outline-regexp} or @code{outline-search-function}. + +@defvar outline-regexp +This variable is a regular expression. +Any line whose beginning has a match for this regexp is considered a +heading line. Matches that start within a line (not at the left +margin) do not count. +@end defvar + +@defvar outline-search-function +Alternatively, when it's impossible to create a regexp that +matches heading lines, you can define a function that helps +Outline minor mode to find heading lines. + +The variable @code{outline-search-function} specifies the function with +four arguments: @var{bound}, @var{move}, @var{backward}, and +@var{looking-at}. The function completes two tasks: to match the +current heading line, and to find the next or the previous heading line. +If the argument @var{looking-at} is non-@code{nil}, it should return +non-@code{nil} when point is at the beginning of the outline header line. +If the argument @var{looking-at} is @code{nil}, the first three arguments +are used. The argument @var{bound} is a buffer position that bounds +the search. The match found must not end after that position. A +value of nil means search to the end of the accessible portion of +the buffer. If the argument @var{move} is non-@code{nil}, the +failed search should move to the limit of search and return nil. +If the argument @var{backward} is non-@code{nil}, this function +should search for the previous heading backward. +@end defvar + +@defvar outline-level +This variable is a function that takes no arguments +and should return the level of the current heading. +It's required in both cases: whether you define +@code{outline-regexp} or @code{outline-search-function}. +@end defvar + +If built with tree-sitter, Emacs can automatically use +Outline minor mode if the major mode sets the following variable. + +@defvar treesit-outline-predicate +This variable instructs Emacs how to find lines with outline headings. +It should be a predicate that matches the node on the heading line. +@end defvar + @node Font Lock Mode @section Font Lock Mode @cindex Font Lock mode diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index d685b7f32dc..3d2192ace64 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -1897,6 +1897,10 @@ add-log functions used by @code{add-log-current-defun}. @item If @code{treesit-simple-imenu-settings} (@pxref{Imenu}) is non-@code{nil}, it sets up Imenu. + +@item +If @code{treesit-outline-predicate} (@pxref{Outline Minor Mode}) is +non-@code{nil}, it sets up Outline minor mode. @end itemize @c TODO: Add treesit-thing-settings stuff once we finalize it. diff --git a/etc/NEWS b/etc/NEWS index afc2c22e68b..f89c8ce1d8d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -130,6 +130,13 @@ the signature) the automatically inferred function type as well. This user option controls outline visibility in the output buffer of 'describe-bindings' when 'describe-bindings-outline' is non-nil. +** Outline Mode + ++++ +*** 'outline-minor-mode' is supported in tree-sitter major modes. +It can be used in all tree-sitter major modes that set either the +variable 'treesit-simple-imenu-settings' or 'treesit-outline-predicate'. + ** X selection requests are now handled much faster and asynchronously. This means it should be less necessary to disable the likes of 'select-active-regions' when Emacs is running over a slow network diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index e5835bdb62d..c4b48f03d12 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -922,6 +922,17 @@ Return nil if NODE is not a defun node or doesn't have a name." name))) t)) +;;; Outline minor mode + +(defun c-ts-mode--outline-predicate (node) + "Match outlines on lines with function names." + (and (treesit-node-match-p + node "\\`function_declarator\\'" t) + (when-let ((parent (treesit-node-parent node))) + (treesit-node-match-p + parent + "\\`function_definition\\'" t)))) + ;;; Defun navigation (defun c-ts-mode--defun-valid-p (node) @@ -1259,6 +1270,10 @@ BEG and END are described in `treesit-range-rules'." eos) c-ts-mode--defun-for-class-in-imenu-p nil)))) + ;; Outline minor mode + (setq-local treesit-outline-predicate + #'c-ts-mode--outline-predicate) + (setq-local treesit-font-lock-feature-list c-ts-mode--feature-list)) diff --git a/lisp/progmodes/heex-ts-mode.el b/lisp/progmodes/heex-ts-mode.el index 7b53a44deb2..22e8956661d 100644 --- a/lisp/progmodes/heex-ts-mode.el +++ b/lisp/progmodes/heex-ts-mode.el @@ -166,6 +166,16 @@ With ARG, do it many times. Negative ARG means move backward." ("Slot" "\\`slot\\'" nil nil) ("Tag" "\\`tag\\'" nil nil))) + ;; Outline minor mode + ;; `heex-ts-mode' inherits from `html-mode' that sets + ;; regexp-based outline variables. So need to restore + ;; the default values of outline variables to be able + ;; to use `treesit-outline-predicate' derived + ;; from `treesit-simple-imenu-settings' above. + (kill-local-variable 'outline-heading-end-regexp) + (kill-local-variable 'outline-regexp) + (kill-local-variable 'outline-level) + (setq-local treesit-font-lock-settings heex-ts--font-lock-settings) (setq-local treesit-simple-indent-rules heex-ts--indent-rules) diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 05a3ff6d7c6..dc2a8fcec1e 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -774,7 +774,7 @@ Calls REPORT-FN directly." "vararg_expression")))) (text "comment")))) - ;; Imenu. + ;; Imenu/Outline. (setq-local treesit-simple-imenu-settings `(("Requires" "\\`function_call\\'" @@ -789,16 +789,6 @@ Calls REPORT-FN directly." ;; Which-function. (setq-local which-func-functions (treesit-defun-at-point)) - ;; Outline. - (setq-local outline-regexp - (rx (seq (0+ space) - (or (seq "--[[" (0+ space) eol) - (seq symbol-start - (or "do" "for" "if" "repeat" "while" - (seq (? (seq "local" (1+ space))) - "function")) - symbol-end))))) - ;; Align. (setq-local align-indent-before-aligning t) diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el index 301f3e8791c..9af2aa6748f 100644 --- a/lisp/textmodes/html-ts-mode.el +++ b/lisp/textmodes/html-ts-mode.el @@ -121,6 +121,17 @@ Return nil if there is no name or if NODE is not a defun node." ;; Imenu. (setq-local treesit-simple-imenu-settings '(("Element" "\\`tag_name\\'" nil nil))) + + ;; Outline minor mode. + (setq-local treesit-outline-predicate "\\`element\\'") + ;; `html-ts-mode' inherits from `html-mode' that sets + ;; regexp-based outline variables. So need to restore + ;; the default values of outline variables to be able + ;; to use `treesit-outline-predicate' above. + (kill-local-variable 'outline-regexp) + (kill-local-variable 'outline-heading-end-regexp) + (kill-local-variable 'outline-level) + (treesit-major-mode-setup)) (if (treesit-ready-p 'html) diff --git a/lisp/treesit.el b/lisp/treesit.el index 6a485ae591a..25ac582276b 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2860,6 +2860,71 @@ ENTRY. MARKER marks the start of each tree-sitter node." index)))) treesit-simple-imenu-settings))) +;;; Outline minor mode + +(defvar-local treesit-outline-predicate nil + "Predicate used to find outline headings in the syntax tree. +The predicate can be a function, a regexp matching node type, +and more; see docstring of `treesit-thing-settings'. +It matches the nodes located on lines with outline headings. +Intended to be set by a major mode. When nil, the predicate +is constructed from the value of `treesit-simple-imenu-settings' +when a major mode sets it.") + +(defun treesit-outline-predicate--from-imenu (node) + ;; Return an outline searching predicate created from Imenu. + ;; Return the value suitable to set `treesit-outline-predicate'. + ;; Create this predicate from the value `treesit-simple-imenu-settings' + ;; that major modes set to find Imenu entries. The assumption here + ;; is that the positions of Imenu entries most of the time coincide + ;; with the lines of outline headings. When this assumption fails, + ;; you can directly set a proper value to `treesit-outline-predicate'. + (seq-some + (lambda (setting) + (and (string-match-p (nth 1 setting) (treesit-node-type node)) + (or (null (nth 2 setting)) + (funcall (nth 2 setting) node)))) + treesit-simple-imenu-settings)) + +(defun treesit-outline-search (&optional bound move backward looking-at) + "Search for the next outline heading in the syntax tree. +See the descriptions of arguments in `outline-search-function'." + (if looking-at + (when-let* ((node (or (treesit--thing-at (pos-eol) treesit-outline-predicate) + (treesit--thing-at (pos-bol) treesit-outline-predicate))) + (start (treesit-node-start node))) + (eq (pos-bol) (save-excursion (goto-char start) (pos-bol)))) + + (let* ((pos + ;; When function wants to find the current outline, point + ;; is at the beginning of the current line. When it wants + ;; to find the next outline, point is at the second column. + (if (eq (point) (pos-bol)) + (if (bobp) (point) (1- (point))) + (pos-eol))) + (found (treesit--navigate-thing pos (if backward -1 1) 'beg + treesit-outline-predicate))) + (if found + (if (or (not bound) (if backward (>= found bound) (<= found bound))) + (progn + (goto-char found) + (goto-char (pos-bol)) + (set-match-data (list (point) (pos-eol))) + t) + (when move (goto-char bound)) + nil) + (when move (goto-char (or bound (if backward (point-min) (point-max))))) + nil)))) + +(defun treesit-outline-level () + "Return the depth of the current outline heading." + (let* ((node (treesit-node-at (point))) + (level (if (treesit-node-match-p node treesit-outline-predicate t) + 1 0))) + (while (setq node (treesit-parent-until node treesit-outline-predicate)) + (setq level (1+ level))) + (if (zerop level) 1 level))) + ;;; Activating tree-sitter (defun treesit-ready-p (language &optional quiet) @@ -2990,6 +3055,17 @@ before calling this function." (setq-local imenu-create-index-function #'treesit-simple-imenu)) + ;; Outline minor mode. + (when (and (or treesit-outline-predicate treesit-simple-imenu-settings) + (not (seq-some #'local-variable-p + '(outline-search-function + outline-regexp outline-level)))) + (unless treesit-outline-predicate + (setq treesit-outline-predicate + #'treesit-outline-predicate--from-imenu)) + (setq-local outline-search-function #'treesit-outline-search + outline-level #'treesit-outline-level)) + ;; Remove existing local parsers. (dolist (ov (overlays-in (point-min) (point-max))) (when-let ((parser (overlay-get ov 'treesit-parser))) -- cgit v1.2.3 From 40994d2bafafa53464d3678b06f391fd13c884ec Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 12 Feb 2024 17:42:28 -0500 Subject: (cl--generic-describe): Refactor to ease reuse * lisp/emacs-lisp/cl-generic.el (cl--map-methods-documentation): New function, extrated from `cl--generic-describe`. (cl--generic-describe): Use it. --- lisp/emacs-lisp/cl-generic.el | 73 +++++++++++++++++++++++++------------------ 1 file changed, 43 insertions(+), 30 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index d1bd45120f1..f439a97f88c 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1140,12 +1140,8 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." (add-hook 'help-fns-describe-function-functions #'cl--generic-describe) (defun cl--generic-describe (function) - ;; Supposedly this is called from help-fns, so help-fns should be loaded at - ;; this point. - (declare-function help-fns-short-filename "help-fns" (filename)) (let ((generic (if (symbolp function) (cl--generic function)))) (when generic - (require 'help-mode) ;Needed for `help-function-def' button! (save-excursion ;; Ensure that we have two blank lines (but not more). (unless (looking-back "\n\n" (- (point) 2)) @@ -1153,32 +1149,49 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." (insert "This is a generic function.\n\n") (insert (propertize "Implementations:\n\n" 'face 'bold)) ;; Loop over fanciful generics - (dolist (method (cl--generic-method-table generic)) - (pcase-let* - ((`(,qualifiers ,args ,doc) (cl--generic-method-info method))) - ;; FIXME: Add hyperlinks for the types as well. - (let ((quals (if (length> qualifiers 0) - (concat (substring qualifiers - 0 (string-match " *\\'" - qualifiers)) - "\n") - ""))) - (insert (format "%s%S" - quals - (cons function - (cl--generic-upcase-formal-args args))))) - (let* ((met-name (cl--generic-load-hist-format - function - (cl--generic-method-qualifiers method) - (cl--generic-method-specializers method))) - (file (find-lisp-object-file-name met-name 'cl-defmethod))) - (when file - (insert (substitute-command-keys " in `")) - (help-insert-xref-button (help-fns-short-filename file) - 'help-function-def met-name file - 'cl-defmethod) - (insert (substitute-command-keys "'.\n")))) - (insert "\n" (or doc "Undocumented") "\n\n"))))))) + (cl--map-methods-documentation + function + (lambda (quals signature file doc) + (insert (format "%s%S%s\n\n%s\n\n" + quals signature + (if file (format-message " in `%s'." file) "") + (or doc "Undocumented"))))))))) + +(defun cl--map-methods-documentation (funname metname-printer) + "Iterate on FUNNAME's methods documentation at point." + ;; Supposedly this is called from help-fns, so help-fns should be loaded at + ;; this point. + (require 'help-fns) + (declare-function help-fns-short-filename "help-fns" (filename)) + (let ((generic (if (symbolp funname) (cl--generic funname)))) + (when generic + (require 'help-mode) ;Needed for `help-function-def' button! + ;; Loop over fanciful generics + (dolist (method (cl--generic-method-table generic)) + (pcase-let* + ((`(,qualifiers ,args ,doc) (cl--generic-method-info method)) + ;; FIXME: Add hyperlinks for the types as well. + (quals (if (length> qualifiers 0) + (concat (substring qualifiers + 0 (string-match " *\\'" + qualifiers)) + "\n") + "")) + (met-name (cl--generic-load-hist-format + funname + (cl--generic-method-qualifiers method) + (cl--generic-method-specializers method))) + (file (find-lisp-object-file-name met-name 'cl-defmethod))) + (funcall metname-printer + quals + (cons funname + (cl--generic-upcase-formal-args args)) + (when file + (make-text-button (help-fns-short-filename file) nil + 'type 'help-function-def + 'help-args + (list met-name file 'cl-defmethod))) + doc)))))) (defun cl--generic-specializers-apply-to-type-p (specializers type) "Return non-nil if a method with SPECIALIZERS applies to TYPE." -- cgit v1.2.3 From d570864bebf9f038f696768f2da571ed272f0058 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Thu, 1 Feb 2024 13:58:20 -0800 Subject: Make outline.el ignore field properties in text * lisp/outline.el (outline-back-to-heading, outline-on-heading-p) (outline-next-visible-heading, outline-mark-subtree) (outline-hide-sublevels, outline--insert-button) (outline--fix-up-all-buttons): Inhibit field text motion (bug#68881). --- lisp/outline.el | 24 +++++++++++------------- 1 file changed, 11 insertions(+), 13 deletions(-) (limited to 'lisp') diff --git a/lisp/outline.el b/lisp/outline.el index b50708c1a7b..5ac0f0707f1 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -686,7 +686,7 @@ If POS is nil, use `point' instead." (defun outline-back-to-heading (&optional invisible-ok) "Move to previous heading line, or beg of this line if it's a heading. Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." - (beginning-of-line) + (forward-line 0) (or (outline-on-heading-p invisible-ok) (let (found) (save-excursion @@ -705,7 +705,7 @@ Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." "Return t if point is on a (visible) heading line. If INVISIBLE-OK is non-nil, an invisible heading line is ok too." (save-excursion - (beginning-of-line) + (forward-line 0) (and (bolp) (or invisible-ok (not (outline-invisible-p))) (if outline-search-function (funcall outline-search-function nil nil nil t) @@ -725,7 +725,7 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok too." (not (string-match (concat "\\`\\(?:" outline-regexp "\\)") (concat head " ")))) (setq head (concat head " "))) - (unless (bolp) (end-of-line) (newline)) + (unless (bolp) (goto-char (pos-eol)) (newline)) (insert head) (unless (eolp) (save-excursion (newline-and-indent))) @@ -941,9 +941,7 @@ With ARG, repeats or can move backward if negative. A heading line is one that starts with a `*' (or that `outline-regexp' matches)." (interactive "p") - (if (< arg 0) - (beginning-of-line) - (end-of-line)) + (goto-char (if (< arg 0) (pos-bol) (pos-eol))) (let ((regexp (unless outline-search-function (concat "^\\(?:" outline-regexp "\\)"))) found-heading-p) @@ -963,7 +961,7 @@ A heading line is one that starts with a `*' (or that (re-search-forward regexp nil 'move))) (outline-invisible-p (match-beginning 0)))) (setq arg (1- arg))) - (if found-heading-p (beginning-of-line)))) + (if found-heading-p (forward-line 0)))) (defun outline-previous-visible-heading (arg) "Move to the previous heading line. @@ -980,7 +978,7 @@ This puts point at the start of the current subtree, and mark at the end." (let ((beg)) (if (outline-on-heading-p) ;; we are already looking at a heading - (beginning-of-line) + (forward-line 0) ;; else go back to previous heading (outline-previous-visible-heading 1)) (setq beg (point)) @@ -1183,7 +1181,7 @@ of the current heading, or to 1 if the current line is not a heading." (cond (current-prefix-arg (prefix-numeric-value current-prefix-arg)) ((save-excursion - (beginning-of-line) + (forward-line 0) (if outline-search-function (funcall outline-search-function nil nil nil t) (looking-at outline-regexp))) @@ -1243,7 +1241,7 @@ This also unhides the top heading-less body, if any." (interactive) (save-excursion (outline-back-to-heading) - (if (not (outline-invisible-p (line-end-position))) + (if (not (outline-invisible-p (pos-eol))) (outline-hide-subtree) (outline-show-children) (outline-show-entry)))) @@ -1834,7 +1832,7 @@ With a prefix argument, show headings up to that LEVEL." (defun outline--insert-button (type) (with-silent-modifications (save-excursion - (beginning-of-line) + (forward-line 0) (let ((icon (nth (if (eq type 'close) 1 0) outline--button-icons)) (o (seq-find (lambda (o) (overlay-get o 'outline-button)) (overlays-at (point))))) @@ -1842,7 +1840,7 @@ With a prefix argument, show headings up to that LEVEL." (when (eq outline-minor-mode-use-buttons 'insert) (let ((inhibit-read-only t)) (insert (apply #'propertize " " (text-properties-at (point)))) - (beginning-of-line))) + (forward-line 0))) (setq o (make-overlay (point) (1+ (point)))) (overlay-put o 'outline-button t) (overlay-put o 'evaporate t)) @@ -1866,7 +1864,7 @@ With a prefix argument, show headings up to that LEVEL." (when from (save-excursion (goto-char from) - (setq from (line-beginning-position)))) + (setq from (pos-bol)))) (outline-map-region (lambda () (let ((close-p (save-excursion -- cgit v1.2.3 From acc6732ca1d39352f1aae3074ad04564178c0954 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 13 Feb 2024 11:18:16 +0100 Subject: Reuse commit message when preparing a single patch * lisp/vc/vc.el (vc-prepare-patch): Check commit message if only a single revision was selected. --- lisp/vc/vc.el | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index ca6efeabac2..619b469bebb 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3623,7 +3623,15 @@ revisions. When invoked interactively in a Log View buffer with marked revisions, use those." (interactive - (let ((revs (vc-prepare-patch-prompt-revisions)) to) + (let* ((revs (vc-prepare-patch-prompt-revisions)) + (subject + (and (length= revs 1) + (plist-get + (vc-call-backend + (vc-responsible-backend default-directory) + 'prepare-patch (car revs)) + :subject))) + to) (require 'message) (while (null (setq to (completing-read-multiple (format-prompt @@ -3636,7 +3644,7 @@ marked revisions, use those." (sit-for blink-matching-delay)) (list (string-join to ", ") (and (not vc-prepare-patches-separately) - (read-string "Subject: " "[PATCH] " nil nil t)) + (read-string "Subject: " (or subject "[PATCH] ") nil nil t)) revs))) (save-current-buffer (let ((patches (mapcar (lambda (rev) -- cgit v1.2.3 From 6ef8d29f221e010705184092600ac124bd0a14fd Mon Sep 17 00:00:00 2001 From: Jörg Bornemann Date: Mon, 12 Feb 2024 21:56:42 +0100 Subject: ; Resolve a FIXME in rst.el * lisp/textmodes/rst.el (rst-define-key): Use :documentation for the dynamically created docstrings of deprecated bindings. (Bug#69087) Copyright-paperwork-exempt: yes --- lisp/textmodes/rst.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 2cd78943883..5fbff4ba888 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -1147,14 +1147,14 @@ as well but give an additional message." (unless (fboundp forwarder-function) (defalias forwarder-function (lambda () + (:documentation + (format "Deprecated binding for %s, use \\[%s] instead." + def def)) (interactive) (call-interactively def) (message "[Deprecated use of key %s; use key %s instead]" (key-description (this-command-keys)) - (key-description key))) - ;; FIXME: In Emacs-25 we could use (:documentation ...) instead. - (format "Deprecated binding for %s, use \\[%s] instead." - def def))) + (key-description key))))) (dolist (dep-key deprecated) (define-key keymap dep-key forwarder-function))))) -- cgit v1.2.3 From d61145cc8cfb31ca170cd1b5deab59f0a5cbea63 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 13 Feb 2024 19:02:21 +0200 Subject: More changes for treesitter support of outline-minor-mode (bug#68824) * lisp/treesit.el (treesit-outline-level): Set NAMED arg of 'treesit-node-at' to t. Don't set IGNORE-MISSING arg of 'treesit-node-match-p' to t. * lisp/progmodes/ruby-ts-mode.el (ruby-ts-mode): Add "singleton_method" to 'treesit-thing-settings'. Set 'treesit-outline-predicate'. Kill local variables 'outline-regexp' and 'outline-level'. --- lisp/progmodes/ruby-ts-mode.el | 14 ++++++++++++++ lisp/treesit.el | 4 ++-- 2 files changed, 16 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 598eaa461ff..426ae248cac 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -1133,6 +1133,7 @@ leading double colon is not added." "singleton_class" "module" "method" + "singleton_method" "array" "hash" "parenthesized_statements" @@ -1178,6 +1179,19 @@ leading double colon is not added." ;; Imenu. (setq-local imenu-create-index-function #'ruby-ts--imenu) + ;; Outline minor mode. + (setq-local treesit-outline-predicate + (rx bos (or "singleton_method" + "method" + "alias" + "class" + "module") + eos)) + ;; Restore default values of outline variables + ;; to use `treesit-outline-predicate'. + (kill-local-variable 'outline-regexp) + (kill-local-variable 'outline-level) + (setq-local treesit-simple-indent-rules (ruby-ts--indent-rules)) ;; Font-lock. diff --git a/lisp/treesit.el b/lisp/treesit.el index 25ac582276b..f811b8090bc 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2918,8 +2918,8 @@ See the descriptions of arguments in `outline-search-function'." (defun treesit-outline-level () "Return the depth of the current outline heading." - (let* ((node (treesit-node-at (point))) - (level (if (treesit-node-match-p node treesit-outline-predicate t) + (let* ((node (treesit-node-at (point) nil t)) + (level (if (treesit-node-match-p node treesit-outline-predicate) 1 0))) (while (setq node (treesit-parent-until node treesit-outline-predicate)) (setq level (1+ level))) -- cgit v1.2.3 From 10bf810e845061a83d466cd7367ab7d220653296 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 13 Feb 2024 21:59:03 +0200 Subject: Fix left-over from renaming 'comp-*' functions * lisp/progmodes/elisp-mode.el (comp--write-bytecode-file): Call this instead of 'comp-write-bytecode-file', its old name. Reported by Arthur Miller . --- lisp/progmodes/elisp-mode.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index da0cb96e1cf..4e0e7552f8e 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -221,7 +221,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map." (load (byte-compile-dest-file buffer-file-name))) (declare-function native-compile "comp") -(declare-function comp-write-bytecode-file "comp") +(declare-function comp--write-bytecode-file "comp") (defun emacs-lisp-native-compile () "Native-compile the current buffer's file (if it has changed). @@ -233,7 +233,7 @@ visited by the current buffer." (byte-to-native-output-buffer-file nil) (eln (native-compile buffer-file-name))) (when eln - (comp-write-bytecode-file eln)))) + (comp-write--bytecode-file eln)))) (defun emacs-lisp-native-compile-and-load () "Native-compile the current buffer's file (if it has changed), then load it. -- cgit v1.2.3 From 371ccf09fea26892a2fada028d27fb4b596636df Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Mon, 12 Feb 2024 18:29:50 +0100 Subject: Add 'custom-variable' command * lisp/cus-edit.el (customize-toggle-option): Add command. (toggle-option): Add shorter alias for 'customize-toggle-option'. * etc/NEWS: Document it. (Bug#69079) --- etc/NEWS | 4 ++++ lisp/cus-edit.el | 35 +++++++++++++++++++++++++++++++++++ 2 files changed, 39 insertions(+) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index f89c8ce1d8d..e6b1d424499 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1336,6 +1336,10 @@ in Buffer menu mode. *** New command 'customize-dirlocals'. This command pops up a buffer to edit the settings in ".dir-locals.el". +--- +** New command 'customize-toggle-option'. +This command can toggle boolean options for the duration of a session. + ** Calc +++ diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 38b6ec984ab..8fad51dc116 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1227,6 +1227,41 @@ If OTHER-WINDOW is non-nil, display in another window." (unless (eq symbol basevar) (message "`%s' is an alias for `%s'" symbol basevar)))) +;;;###autoload +(defun customize-toggle-option (symbol) + "Toggle the value of boolean option SYMBOL for this session." + (interactive (let ((prompt "Toggle boolean option: ") opts) + (mapatoms + (lambda (sym) + (when (eq (get sym 'custom-type) 'boolean) + (push sym opts)))) + (list (intern (completing-read prompt opts nil nil nil nil + (symbol-at-point)))))) + (let* ((setter (or (get symbol 'custom-set) #'set-default)) + (getter (or (get symbol 'custom-get) #'symbol-value)) + (value (condition-case nil + (funcall getter symbol) + (void-variable (error "`%s' is not bound" symbol)))) + (type (get symbol 'custom-type))) + (cond + ((eq type 'boolean)) + ((and (null type) + (yes-or-no-p + (format "`%s' doesn't have a type, and has the value %S. \ +Proceed to toggle?" symbol value)))) + ((yes-or-no-p + (format "`%s' is of type %s, and has the value %S. \ +Proceed to toggle?" + symbol type value))) + ((error "Abort toggling of option `%s'" symbol))) + (message "%s user options `%s'." + (if (funcall setter symbol (not value)) + "Enabled" "Disabled") + symbol))) + +;;;###autoload +(defalias 'toggle-option #'customize-toggle-option) + ;;;###autoload (defalias 'customize-variable-other-window 'customize-option-other-window) -- cgit v1.2.3 From 160165e8a97cfa3f3ffd803be373a3b34ed87597 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Tue, 13 Feb 2024 12:27:38 -0800 Subject: ; Compute the list of symbols for 'eshell-eval-using-options' once * lisp/eshell/esh-opt.el (eshell--get-option-symbols): New function... (eshell-eval-using-options): ... use it. (eshell--do-opts, eshell--process-args): Take OPTION-SYMS. * test/lisp/eshell/esh-opt-tests.el (esh-opt-test/process-args): (esh-opt-test/process-args-parse-leading-options-only): (esh-opt-test/process-args-external): Pass OPTION-SYMS in. --- lisp/eshell/esh-opt.el | 62 +++++++++++++++++++++------------------ test/lisp/eshell/esh-opt-tests.el | 24 ++++++++++----- 2 files changed, 50 insertions(+), 36 deletions(-) (limited to 'lisp') diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index d01e3569d57..e6f5fc9629a 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -100,29 +100,37 @@ the new process for its value. Lastly, any remaining arguments will be available in the locally let-bound variable `args'." (declare (debug (form form sexp body))) - `(let* ((temp-args - ,(if (memq ':preserve-args (cadr options)) - (list 'copy-tree macro-args) - (list 'eshell-stringify-list - (list 'flatten-tree macro-args)))) - (processed-args (eshell--do-opts ,name ,options temp-args ,macro-args)) - ,@(delete-dups - (delq nil (mapcar (lambda (opt) - (and (listp opt) (nth 3 opt) - `(,(nth 3 opt) (pop processed-args)))) - ;; `options' is of the form (quote OPTS). - (cadr options)))) - (args processed-args)) - ;; Silence unused lexical variable warning if body does not use `args'. - (ignore args) - ,@body-forms)) + (let ((option-syms (eshell--get-option-symbols + ;; `options' is of the form (quote OPTS). + (cadr options)))) + `(let* ((temp-args + ,(if (memq ':preserve-args (cadr options)) + (list 'copy-tree macro-args) + (list 'eshell-stringify-list + (list 'flatten-tree macro-args)))) + (args (eshell--do-opts ,name temp-args ,macro-args + ,options ',option-syms)) + ;; Bind all the option variables. When done, `args' will + ;; contain any remaining positional arguments. + ,@(mapcar (lambda (sym) `(,sym (pop args))) option-syms)) + ;; Silence unused lexical variable warning if body does not use `args'. + (ignore args) + ,@body-forms))) ;;; Internal Functions: ;; Documented part of the interface; see eshell-eval-using-options. (defvar eshell--args) -(defun eshell--do-opts (name options args orig-args) +(defun eshell--get-option-symbols (options) + "Get a list of symbols for the specified OPTIONS. +OPTIONS is a list of command-line options from +`eshell-eval-using-options' (which see)." + (delete-dups + (delq nil (mapcar (lambda (opt) (and (listp opt) (nth 3 opt))) + options)))) + +(defun eshell--do-opts (name args orig-args options option-syms) "Helper function for `eshell-eval-using-options'. This code doesn't really need to be macro expanded everywhere." (require 'esh-ext) @@ -134,7 +142,8 @@ This code doesn't really need to be macro expanded everywhere." (if (and (= (length args) 0) (memq ':show-usage options)) (eshell-show-usage name options) - (setq args (eshell--process-args name args options)) + (setq args (eshell--process-args name args options + option-syms)) nil)))) (when usage-msg (user-error "%s" usage-msg)))))) @@ -269,16 +278,13 @@ triggered to say that the switch is unrecognized." "%s: unrecognized option --%s") name (car switch))))))) -(defun eshell--process-args (name args options) - "Process the given ARGS using OPTIONS." - (let* ((seen ()) - (opt-vals (delq nil (mapcar (lambda (opt) - (when (listp opt) - (let ((sym (nth 3 opt))) - (when (and sym (not (memq sym seen))) - (push sym seen) - (list sym))))) - options))) +(defun eshell--process-args (name args options option-syms) + "Process the given ARGS for the command NAME using OPTIONS. +OPTION-SYMS is a list of symbols that will hold the processed arguments. + +Return a list of values corresponding to each element in OPTION-SYMS, +followed by any additional positional arguments." + (let* ((opt-vals (mapcar #'list option-syms)) (ai 0) arg (eshell--args args) (pos-argument-found nil)) diff --git a/test/lisp/eshell/esh-opt-tests.el b/test/lisp/eshell/esh-opt-tests.el index 8d6e0c1e426..4e5373e53cd 100644 --- a/test/lisp/eshell/esh-opt-tests.el +++ b/test/lisp/eshell/esh-opt-tests.el @@ -29,13 +29,15 @@ (eshell--process-args "sudo" '("-a") '((?a "all" nil show-all - "do not ignore entries starting with ."))))) + "do not ignore entries starting with .")) + '(show-all)))) (should (equal '("root" "world") (eshell--process-args "sudo" '("-u" "root" "world") '((?u "user" t user - "execute a command as another USER")))))) + "execute a command as another USER")) + '(user))))) (ert-deftest esh-opt-test/process-args-parse-leading-options-only () "Test behavior of :parse-leading-options-only in `eshell--process-args'." @@ -45,20 +47,23 @@ "sudo" '("emerge" "-uDN" "world") '((?u "user" t user "execute a command as another USER") - :parse-leading-options-only)))) + :parse-leading-options-only) + '(user)))) (should (equal '("root" "emerge" "-uDN" "world") (eshell--process-args "sudo" '("-u" "root" "emerge" "-uDN" "world") '((?u "user" t user "execute a command as another USER") - :parse-leading-options-only)))) + :parse-leading-options-only) + '(user)))) (should (equal '("DN" "emerge" "world") (eshell--process-args "sudo" '("-u" "root" "emerge" "-uDN" "world") '((?u "user" t user - "execute a command as another USER")))))) + "execute a command as another USER")) + '(user))))) (ert-deftest esh-opt-test/process-args-external () "Test behavior of :external in `eshell--process-args'." @@ -69,7 +74,8 @@ "ls" '("/some/path") '((?a "all" nil show-all "do not ignore entries starting with .") - :external "ls"))))) + :external "ls") + '(show-all))))) (cl-letf (((symbol-function 'eshell-search-path) #'identity)) (should (equal '(no-catch eshell-ext-command "ls") @@ -78,7 +84,8 @@ "ls" '("-u" "/some/path") '((?a "all" nil show-all "do not ignore entries starting with .") - :external "ls")) + :external "ls") + '(show-all)) :type 'no-catch)))) (cl-letf (((symbol-function 'eshell-search-path) #'ignore)) (should-error @@ -86,7 +93,8 @@ "ls" '("-u" "/some/path") '((?a "all" nil show-all "do not ignore entries starting with .") - :external "ls")) + :external "ls") + '(show-all)) :type 'error))) (ert-deftest esh-opt-test/eval-using-options-short () -- cgit v1.2.3 From 7c23234b4ea43a033e06eb466008e0dc8485920b Mon Sep 17 00:00:00 2001 From: Steven Allen Date: Sat, 10 Feb 2024 10:05:11 -0800 Subject: Respect :lisp-dir whilst scanning for VC package dependencies * lisp/emacs-lisp/package-vc.el (package-vc--unpack-1): Scan 'lisp-dir', if set, for lisp files instead of scanning the root package directory. (Bug#69019) --- lisp/emacs-lisp/package-vc.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index fc402716dab..37980c28b02 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -501,8 +501,10 @@ This includes downloading missing dependencies, generating autoloads, generating a package description file (used to identify a package as a VC package later on), building documentation and marking the package as installed." - (let ((pkg-spec (package-vc--desc->spec pkg-desc)) - missing) + (let* ((pkg-spec (package-vc--desc->spec pkg-desc)) + (lisp-dir (plist-get pkg-spec :lisp-dir)) + (lisp-path (file-name-concat pkg-dir lisp-dir)) + missing) ;; In case the package was installed directly from source, the ;; dependency list wasn't know beforehand, and they might have @@ -519,7 +521,7 @@ documentation and marking the package as installed." "\\|") regexp-unmatchable)) (deps '())) - (dolist (file (directory-files pkg-dir t "\\.el\\'" t)) + (dolist (file (directory-files lisp-path t "\\.el\\'" t)) (unless (string-match-p ignored-files file) (with-temp-buffer (insert-file-contents file) @@ -542,10 +544,8 @@ documentation and marking the package as installed." (pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir))) ;; Generate autoloads (let* ((name (package-desc-name pkg-desc)) - (auto-name (format "%s-autoloads.el" name)) - (lisp-dir (plist-get pkg-spec :lisp-dir))) - (package-generate-autoloads - name (file-name-concat pkg-dir lisp-dir)) + (auto-name (format "%s-autoloads.el" name))) + (package-generate-autoloads name lisp-path) (when lisp-dir (write-region (with-temp-buffer -- cgit v1.2.3 From 70d6f6c41c9b1985e0ec70b45aeeac6982a050bb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 13 Feb 2024 20:35:05 -0500 Subject: hideif.el: Minor cleanup * lisp/progmodes/hideif.el: Prefer #' to quote function names. (hif-eval): Use `lexical-binding`. (hif-ifx-regexp): Don't use `defconst` since `bovine/c.el` let-binds it. (hif--intern-safe): Rename from `intern-safe` to fix this namespace violation. (hif-strtok): Adjust accordingly. --- lisp/progmodes/hideif.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 71f55379d96..98e567299a1 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -390,7 +390,7 @@ If there is a marked region from START to END it only shows the symbols within." (defun hif-after-revert-function () (and hide-ifdef-mode hide-ifdef-hiding (hide-ifdefs nil nil t))) -(add-hook 'after-revert-hook 'hif-after-revert-function) +(add-hook 'after-revert-hook #'hif-after-revert-function) (defun hif-end-of-line () "Find the end-point of line concatenation." @@ -474,7 +474,7 @@ Everything including these lines is made invisible." (defun hif-eval (form) "Evaluate hideif internal representation." - (let ((val (eval form))) + (let ((val (eval form t))) (if (stringp val) (or (get-text-property 0 'hif-value val) val) @@ -542,7 +542,7 @@ that form should be displayed.") (defconst hif-cpp-prefix "\\(^\\|\r\\)?[ \t]*#[ \t]*") (defconst hif-ifxdef-regexp (concat hif-cpp-prefix "if\\(n\\)?def")) (defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef")) -(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\((\\|\\(n?def\\)?[ \t]+\\)")) +(defvar hif-ifx-regexp (concat hif-cpp-prefix "if\\((\\|\\(n?def\\)?[ \t]+\\)")) (defconst hif-elif-regexp (concat hif-cpp-prefix "elif")) (defconst hif-else-regexp (concat hif-cpp-prefix "else")) (defconst hif-endif-regexp (concat hif-cpp-prefix "endif")) @@ -679,7 +679,7 @@ that form should be displayed.") ("..." . hif-etc) ("defined" . hif-defined))) -(defconst hif-valid-token-list (mapcar 'cdr hif-token-alist)) +(defconst hif-valid-token-list (mapcar #'cdr hif-token-alist)) (defconst hif-token-regexp ;; The ordering of regexp grouping is crucial to `hif-strtok' @@ -690,7 +690,7 @@ that form should be displayed.") ;; decimal/octal: "\\|\\(\\([+-]?[0-9']+\\(\\.[0-9']*\\)?\\)\\([eE][+-]?[0-9]+\\)?" hif-numtype-suffix-regexp "?\\)" - "\\|" (regexp-opt (mapcar 'car hif-token-alist) t) + "\\|" (regexp-opt (mapcar #'car hif-token-alist) t) "\\|\\(\\w+\\)")) ;; C++11 Unicode string literals (L"" u8"" u"" U"" R"" LR"" u8R"" uR"") @@ -867,7 +867,7 @@ Assuming we've just performed a `hif-token-regexp' lookup." (t (setq hif-simple-token-only nil) - (intern-safe string))))) + (hif--intern-safe string))))) (defun hif-backward-comment (&optional start end) "If we're currently within a C(++) comment, skip them backwards." @@ -1448,7 +1448,7 @@ This macro cannot be evaluated alone without parameters input." (t (error "Invalid token to stringify")))) -(defun intern-safe (str) +(defun hif--intern-safe (str) (if (stringp str) (intern str))) -- cgit v1.2.3 From b54db9c9ac7599fc84f108eb6f469e2af4834bed Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 14 Feb 2024 05:24:36 +0200 Subject: ; * lisp/progmodes/elisp-mode.el (emacs-lisp-native-compile): Fix typo. --- lisp/progmodes/elisp-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 4e0e7552f8e..e0c18214ef7 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -233,7 +233,7 @@ visited by the current buffer." (byte-to-native-output-buffer-file nil) (eln (native-compile buffer-file-name))) (when eln - (comp-write--bytecode-file eln)))) + (comp--write-bytecode-file eln)))) (defun emacs-lisp-native-compile-and-load () "Native-compile the current buffer's file (if it has changed), then load it. -- cgit v1.2.3 From fa74c7f88a8f3216665ea386c5b6355e3660fb79 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 14 Feb 2024 09:20:48 +0200 Subject: Detect DEFUNs as outline-minor-mode headings in Emacs sources in c-ts-mode. * lisp/progmodes/c-ts-mode.el (c-ts-mode--outline-predicate): When c-ts-mode-emacs-sources-support is t, use c-ts-mode--emacs-defun-p (bug#68824). --- lisp/progmodes/c-ts-mode.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index c4b48f03d12..4ef17daf876 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -926,12 +926,12 @@ Return nil if NODE is not a defun node or doesn't have a name." (defun c-ts-mode--outline-predicate (node) "Match outlines on lines with function names." - (and (treesit-node-match-p - node "\\`function_declarator\\'" t) - (when-let ((parent (treesit-node-parent node))) - (treesit-node-match-p - parent - "\\`function_definition\\'" t)))) + (or (and (equal (treesit-node-type node) "function_declarator") + (equal (treesit-node-type (treesit-node-parent node)) + "function_definition")) + ;; DEFUNs in Emacs sources. + (and c-ts-mode-emacs-sources-support + (c-ts-mode--emacs-defun-p node)))) ;;; Defun navigation -- cgit v1.2.3 From decfdd4f1a1e3b1539eafdaaf11191e8477f0636 Mon Sep 17 00:00:00 2001 From: Gerd Möllmann Date: Wed, 14 Feb 2024 08:54:04 +0100 Subject: Take file-local variables into account in elint-file (bug#69076) * lisp/emacs-lisp/elint.el (elint-file): Use hack-local-variables. --- lisp/emacs-lisp/elint.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index a8bc4bdd1e0..27c169cc657 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el @@ -266,6 +266,7 @@ This environment can be passed to `macroexpand'." (insert-file-contents file) (let ((buffer-file-name file) (max-lisp-eval-depth (max 1000 max-lisp-eval-depth))) + (hack-local-variables) (with-syntax-table emacs-lisp-mode-syntax-table (mapc 'elint-top-form (elint-update-env))))) (elint-set-mode-line) -- cgit v1.2.3 From 0c7c8210cb6a87a06b61451d19f3601975569946 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 14 Feb 2024 17:27:43 +0100 Subject: Minor Tramp doc adaption * doc/misc/tramp.texi (Frequently Asked Questions): Be more precise with FIDO2 keys. * lisp/net/tramp.el: Adapt comments. --- doc/misc/tramp.texi | 4 ++-- lisp/net/tramp.el | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index db9cefbf966..0bed7dbe215 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5075,8 +5075,8 @@ the additional handshaking messages for them. This requires at least nitrokey, or titankey. @c @uref{https://docs.fedoraproject.org/en-US/quick-docs/using-yubikeys/} -@strong{Note} that there are reports on problems of handling yubikey -residential keys by @command{ssh-agent}. As workaround, you might +@strong{Note} that there are reports on problems of handling FIDO2 +(residential) keys by @command{ssh-agent}. As workaround, you might disable @command{ssh-agent} for such keys. @item diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index f3da56e7a4f..9d883c96252 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -763,9 +763,8 @@ The regexp should match at end of buffer." ;; A security key requires the user physically to touch the device ;; with their finger. We must tell it to the user. -;; Added in OpenSSH 8.2. I've tested it with yubikey. Nitrokey and -;; Titankey, which have also passed the tests, do not show such a -;; message. +;; Added in OpenSSH 8.2. I've tested it with Nitrokey, Titankey, and +;; Yubikey. (defcustom tramp-security-key-confirm-regexp (rx bol (* "\r") "Confirm user presence for key " (* nonl) (* (any "\r\n"))) "Regular expression matching security key confirmation message. @@ -788,6 +787,7 @@ The regexp should match at end of buffer." :version "28.1" :type 'regexp) +;; Needed only for FIDO2 (residential) keys. Tested with Nitrokey and Yubikey. (defcustom tramp-security-key-pin-regexp (rx bol (* "\r") (group "Enter PIN for " (* nonl)) (* (any "\r\n"))) "Regular expression matching security key PIN prompt. -- cgit v1.2.3 From 61a145076275a9da79d0372d50def4aaf5117587 Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Tue, 30 Jan 2024 00:52:39 -0800 Subject: Improve directory prompt used by package-vc-checkout * lisp/emacs-lisp/package-vc.el (package-vc--read-package-name): Use read-directory-name instead of read-file-name. (Bug#66114) --- lisp/emacs-lisp/package-vc.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index e89ead89d4b..5c5486de290 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -825,8 +825,8 @@ for the last released version of the package." (interactive (let* ((name (package-vc--read-package-name "Fetch package source: "))) (list (cadr (assoc name package-archive-contents #'string=)) - (read-file-name "Clone into new or empty directory: " nil nil t nil - (lambda (dir) (or (not (file-exists-p dir)) + (read-directory-name "Clone into new or empty directory: " nil nil + (lambda (dir) (or (not (file-exists-p dir)) (directory-empty-p dir)))) (and current-prefix-arg :last-release)))) (setf directory (expand-file-name directory)) -- cgit v1.2.3 From fbef8ff2a4106ff7f0f3d026071fb8096280cc61 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 14 Feb 2024 17:18:50 -0500 Subject: titdic-cnv.el: Bring all definitions under the `tit-` namespace Add a `tit-` or `tit--` prefix where necessary. Adjust all callers. I kept the old names via obsolete aliases for now, although it's probably not worth the trouble. * lisp/international/titdic-cnv.el: Bring all definitions under the `tit-` namespace. (tit-quail-cxterm-package-ext-info): Rename var from `quail-cxterm-package-ext-info`. Adjust value to new names. (tit-dic-convert): Rename from `titdic-convert`. (batch-tit-dic-convert): Rename from `batch-titdic-convert`. (tit-quail-misc-package-ext-info): Rename var from `quail-misc-package-ext-info`. Adjust value to new names. (tit--tsang-quick-converter): Rename from `tsang-quick-converter`. (tit--tsang-b5-converter): Rename from `tsang-b5-converter`. (tit--quick-b5-converter): Rename from `quick-b5-converter`. (tit--tsang-cns-converter): Rename from `tsang-cns-converter`. (tit--quick-cns-converter): Rename from `quick-cns-converter`. (tit--py-converter): Rename from `py-converter`. (tit--ziranma-converter): Rename from `ziranma-converter`. (tit--ctlau-converter): Rename from `ctlau-converter`. (tit--ctlau-gb-converter): Rename from `ctlau-gb-converter`. (tit--ctlau-b5-converter): Rename from `ctlau-b5-converter`. (tit-miscdic-convert): Rename from `miscdic-convert`. (batch-tit-miscdic-convert): Rename from `batch-miscdic-convert`. (tit-pinyin-convert): Rename from `pinyin-convert`. * leim/Makefile.in (${leimdir}/quail/%.el, misc_convert) (${srcdir}/../lisp/language/pinyin.el): Use the new names. --- etc/NEWS | 5 ++ leim/Makefile.in | 6 +- lisp/international/titdic-cnv.el | 119 +++++++++++++++++++++++---------------- 3 files changed, 79 insertions(+), 51 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index e6b1d424499..dc24d775bb1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -430,6 +430,11 @@ respectively, in addition to the existing translations 'C-x 8 / e' and * Changes in Specialized Modes and Packages in Emacs 30.1 +--- +** Titdic-cnv +Most of the variables and functions in the file have been renamed to +make sure they all use a 'tit-' namespace prefix. + --- ** Trace In batch mode, tracing now sends the trace to stdout. diff --git a/leim/Makefile.in b/leim/Makefile.in index f7a23178919..bc1eeb5e634 100644 --- a/leim/Makefile.in +++ b/leim/Makefile.in @@ -101,11 +101,11 @@ ${leimdir}/quail ${leimdir}/ja-dic: ## All of TIT_GB and TIT_BIG5. ${leimdir}/quail/%.el: ${srcdir}/CXTERM-DIC/%.tit $(AM_V_GEN)${RUN_EMACS} -l titdic-cnv \ - -f batch-titdic-convert -dir ${leimdir}/quail $< + -f batch-tit-dic-convert -dir ${leimdir}/quail $< misc_convert = $(AM_V_GEN)${RUN_EMACS} \ - -l titdic-cnv -f batch-miscdic-convert -dir ${leimdir}/quail + -l titdic-cnv -f batch-tit-miscdic-convert -dir ${leimdir}/quail ## CTLau.el, CTLau-b5.el. ${leimdir}/quail/CT%.el: ${srcdir}/MISC-DIC/CT%.html @@ -148,7 +148,7 @@ ${leimdir}/ja-dic/ja-dic.el: $(srcdir)/SKK-DIC/SKK-JISYO.L small-ja-dic-option -f batch-skkdic-convert -dir "$(leimdir)/ja-dic" $(JA_DIC_NO_REDUCTION_OPTION) "$<" ${srcdir}/../lisp/language/pinyin.el: ${srcdir}/MISC-DIC/pinyin.map - $(AM_V_GEN)${RUN_EMACS} -l titdic-cnv -f pinyin-convert $< $@ + $(AM_V_GEN)${RUN_EMACS} -l titdic-cnv -f tit-pinyin-convert $< $@ .PHONY: bootstrap-clean distclean maintainer-clean gen-clean diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el index c4706e061e3..42584f6548c 100644 --- a/lisp/international/titdic-cnv.el +++ b/lisp/international/titdic-cnv.el @@ -31,12 +31,12 @@ ;; Convert cxterm dictionary (of TIT format) to quail-package. ;; ;; Usage (within Emacs): -;; M-x titdic-convertCXTERM-DICTIONARY-NAME +;; M-x tit-dic-convertCXTERM-DICTIONARY-NAME ;; Usage (from shell): -;; % emacs -batch -l titdic-cnv -f batch-titdic-convert\ +;; % emacs -batch -l titdic-cnv -f batch-tit-dic-convert\ ;; [-dir DIR] [DIR | FILE] ... ;; -;; When you run titdic-convert within Emacs, you have a chance to +;; When you run `tit-dic-convert' within Emacs, you have a chance to ;; modify arguments of `quail-define-package' before saving the ;; converted file. For instance, you are likely to modify TITLE, ;; DOCSTRING, and KEY-BINDINGS. @@ -90,7 +90,8 @@ ;; \ is replaced by a description about ;; how to select a translation from a list of candidates. -(defvar quail-cxterm-package-ext-info +(define-obsolete-variable-alias 'quail-cxterm-package-ext-info 'tit-quail-cxterm-package-ext-info "30.1") +(defvar tit-quail-cxterm-package-ext-info '(("chinese-4corner" "四角") ("chinese-array30" "３０") ("chinese-ccdospy" "缩拼" @@ -277,7 +278,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, (tit-moveleft ",<") (tit-keyprompt nil)) - (generate-lisp-file-heading filename 'titdic-convert :code nil) + (generate-lisp-file-heading filename 'tit-dic-convert :code nil) (princ ";; Quail package `") (princ package) (princ "\n") @@ -354,7 +355,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, (princ "(quail-define-package ") ;; Args NAME, LANGUAGE, TITLE - (let ((title (nth 1 (assoc package quail-cxterm-package-ext-info)))) + (let ((title (nth 1 (assoc package tit-quail-cxterm-package-ext-info)))) (princ "\"") (princ package) (princ "\" \"") @@ -383,7 +384,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, (let ((doc (concat tit-prompt "\n")) (comments (if tit-comments (mapconcat #'identity (nreverse tit-comments) "\n"))) - (doc-ext (nth 2 (assoc package quail-cxterm-package-ext-info)))) + (doc-ext (nth 2 (assoc package tit-quail-cxterm-package-ext-info)))) (if comments (setq doc (concat doc "\n" comments "\n"))) (if doc-ext @@ -476,6 +477,9 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, ;;;###autoload (defun titdic-convert (filename &optional dirname) + (declare (obsolete tit-dic-convert "30.1")) + (tit-dic-convert filename dirname)) +(defun tit-dic-convert (filename &optional dirname) "Convert a TIT dictionary of FILENAME into a Quail package. Optional argument DIRNAME if specified is the directory name under which the generated Quail package is saved." @@ -531,21 +535,24 @@ the generated Quail package is saved." ;;;###autoload (defun batch-titdic-convert (&optional force) - "Run `titdic-convert' on the files remaining on the command line. + (declare (obsolete batch-tit-dic-convert "30.1")) + (batch-tit-dic-convert force)) +(defun batch-tit-dic-convert (&optional force) + "Run `tit-dic-convert' on the files remaining on the command line. Use this from the command line, with `-batch'; it won't work in an interactive Emacs. -For example, invoke \"emacs -batch -f batch-titdic-convert XXX.tit\" to +For example, invoke \"emacs -batch -f batch-tit-dic-convert XXX.tit\" to generate Quail package file \"xxx.el\" from TIT dictionary file \"XXX.tit\". -To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." +To get complete usage, invoke \"emacs -batch -f batch-tit-dic-convert -h\"." (defvar command-line-args-left) ; Avoid compiler warning. (if (not noninteractive) - (error "`batch-titdic-convert' should be used only with -batch")) + (error "`batch-tit-dic-convert' should be used only with -batch")) (if (string= (car command-line-args-left) "-h") (progn (message "To convert XXX.tit and YYY.tit into xxx.el and yyy.el:") - (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert XXX.tit YYY.tit") + (message " %% emacs -batch -l titdic-cnv -f batch-tit-dic-convert XXX.tit YYY.tit") (message "To convert XXX.tit into DIR/xxx.el:") - (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert -dir DIR XXX.tit")) + (message " %% emacs -batch -l titdic-cnv -f batch-tit-dic-convert -dir DIR XXX.tit")) (let (targetdir filename files file) (if (string= (car command-line-args-left) "-dir") (progn @@ -564,7 +571,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." (when (or force (file-newer-than-file-p file (tit-make-quail-package-file-name file targetdir))) - (titdic-convert file targetdir)) + (tit-dic-convert file targetdir)) (setq files (cdr files))) (setq command-line-args-left (cdr command-line-args-left))))) (kill-emacs 0)) @@ -583,10 +590,11 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ;; COPYRIGHT-NOTICE ;; Copyright notice of the source dictionary. ;; ) -(defvar quail-misc-package-ext-info +(define-obsolete-variable-alias 'quail-misc-package-ext-info 'tit-quail-misc-package-ext-info "30.1") +(defvar tit-quail-misc-package-ext-info '(("chinese-b5-tsangchi" "倉B" "cangjie-table.b5" big5 "tsang-b5.el" - tsang-b5-converter + tit--tsang-b5-converter "\ ;; # Copyright 2001 Christian Wittern ;; # @@ -596,7 +604,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-b5-quick" "簡B" "cangjie-table.b5" big5 "quick-b5.el" - quick-b5-converter + tit--quick-b5-converter "\ ;; # Copyright 2001 Christian Wittern ;; # @@ -606,7 +614,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-cns-tsangchi" "倉C" "cangjie-table.cns" iso-2022-cn-ext "tsang-cns.el" - tsang-cns-converter + tit--tsang-cns-converter "\ ;; # Copyright 2001 Christian Wittern ;; # @@ -616,7 +624,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-cns-quick" "簡C" "cangjie-table.cns" iso-2022-cn-ext "quick-cns.el" - quick-cns-converter + tit--quick-cns-converter "\ ;; # Copyright 2001 Christian Wittern ;; # @@ -626,7 +634,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-py" "拼G" "pinyin.map" cn-gb-2312 "PY.el" - py-converter + tit--py-converter "\ ;; \"pinyin.map\" is included in a free package called CCE. It is ;; available at: [link needs updating -- SK 2021-09-27] @@ -654,7 +662,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-ziranma" "自然" "ziranma.cin" cn-gb-2312 "ZIRANMA.el" - ziranma-converter + tit--ziranma-converter "\ ;; \"ziranma.cin\" is included in a free package called CCE. It is ;; available at: [link needs updating -- SK 2021-09-27] @@ -682,7 +690,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-ctlau" "刘粤" "CTLau.html" cn-gb-2312 "CTLau.el" - ctlau-gb-converter + tit--ctlau-gb-converter "\ ;; \"CTLau.html\" is available at: ;; @@ -707,7 +715,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-ctlaub" "劉粵" "CTLau-b5.html" big5 "CTLau-b5.el" - ctlau-b5-converter + tit--ctlau-b5-converter "\ ;; \"CTLau-b5.html\" is available at: ;; @@ -740,7 +748,8 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ;; input method is for inputting Big5 characters. Otherwise the input ;; method is for inputting CNS characters. -(defun tsang-quick-converter (dicbuf tsang-p big5-p) +(define-obsolete-function-alias 'tsang-quick-converter #'tit--tsang-quick-converter "30.1") +(defun tit--tsang-quick-converter (dicbuf tsang-p big5-p) (let ((fulltitle (if tsang-p "倉頡" "簡易")) dic) (goto-char (point-max)) @@ -822,23 +831,28 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." (if big5-p (nth 1 elt) (nth 2 elt)))))) (insert ")\n"))) -(defun tsang-b5-converter (dicbuf) - (tsang-quick-converter dicbuf t t)) +(define-obsolete-function-alias 'tsang-b5-converter #'tit--tsang-b5-converter "30.1") +(defun tit--tsang-b5-converter (dicbuf) + (tit--tsang-quick-converter dicbuf t t)) -(defun quick-b5-converter (dicbuf) - (tsang-quick-converter dicbuf nil t)) +(define-obsolete-function-alias 'quick-b5-converter #'tit--quick-b5-converter "30.1") +(defun tit--quick-b5-converter (dicbuf) + (tit--tsang-quick-converter dicbuf nil t)) -(defun tsang-cns-converter (dicbuf) - (tsang-quick-converter dicbuf t nil)) +(define-obsolete-function-alias 'tsang-cns-converter #'tit--tsang-cns-converter "30.1") +(defun tit--tsang-cns-converter (dicbuf) + (tit--tsang-quick-converter dicbuf t nil)) -(defun quick-cns-converter (dicbuf) - (tsang-quick-converter dicbuf nil nil)) +(define-obsolete-function-alias 'quick-cns-converter #'tit--quick-cns-converter "30.1") +(defun tit--quick-cns-converter (dicbuf) + (tit--tsang-quick-converter dicbuf nil nil)) ;; Generate a code of a Quail package in the current buffer from ;; Pinyin dictionary in the buffer DICBUF. The input method name of ;; the Quail package is NAME, and the title string is TITLE. -(defun py-converter (dicbuf) +(define-obsolete-function-alias 'py-converter #'tit--py-converter "30.1") +(defun tit--py-converter (dicbuf) (goto-char (point-max)) (insert (format "%S\n" "汉字输入∷拼音∷ @@ -913,7 +927,8 @@ method `chinese-tonepy' with which you must specify tones by digits ;; Ziranma dictionary in the buffer DICBUF. The input method name of ;; the Quail package is NAME, and the title string is TITLE. -(defun ziranma-converter (dicbuf) +(define-obsolete-function-alias 'ziranma-converter #'tit--ziranma-converter "30.1") +(defun tit--ziranma-converter (dicbuf) (let (dic) (with-current-buffer dicbuf (goto-char (point-min)) @@ -1022,7 +1037,8 @@ To input symbols and punctuation, type `/' followed by one of `a' to ;; method name of the Quail package is NAME, and the title string is ;; TITLE. DESCRIPTION is the string shown by describe-input-method. -(defun ctlau-converter (dicbuf description) +(define-obsolete-function-alias 'ctlau-converter #'tit--ctlau-converter "30.1") +(defun tit--ctlau-converter (dicbuf description) (goto-char (point-max)) (insert (format "%S\n" description)) (insert " '((\"\C-?\" . quail-delete-last-char) @@ -1071,8 +1087,9 @@ To input symbols and punctuation, type `/' followed by one of `a' to (forward-line 1))) (insert ")\n")) -(defun ctlau-gb-converter (dicbuf) - (ctlau-converter dicbuf +(define-obsolete-function-alias 'ctlau-gb-converter #'tit--ctlau-gb-converter "30.1") +(defun tit--ctlau-gb-converter (dicbuf) + (tit--ctlau-converter dicbuf "汉字输入∷刘锡祥式粤音∷ 刘锡祥式粤语注音方案 @@ -1085,8 +1102,9 @@ To input symbols and punctuation, type `/' followed by one of `a' to Some infrequent GB characters are accessed by typing \\, followed by the Cantonese romanization of the respective radical (部首).")) -(defun ctlau-b5-converter (dicbuf) - (ctlau-converter dicbuf +(define-obsolete-function-alias 'ctlau-b5-converter #'tit--ctlau-b5-converter "30.1") +(defun tit--ctlau-b5-converter (dicbuf) + (tit--ctlau-converter dicbuf "漢字輸入：劉錫祥式粵音： 劉錫祥式粵語注音方案 @@ -1101,14 +1119,15 @@ To input symbols and punctuation, type `/' followed by one of `a' to (declare-function dos-8+3-filename "dos-fns.el" (filename)) -(defun miscdic-convert (filename &optional dirname) +(define-obsolete-function-alias 'miscdic-convert #'tit-miscdic-convert "30.1") +(defun tit-miscdic-convert (filename &optional dirname) "Convert a dictionary file FILENAME into a Quail package. Optional argument DIRNAME if specified is the directory name under which the generated Quail package is saved." (interactive "FInput method dictionary file: ") (or (file-readable-p filename) (error "%s does not exist" filename)) - (let ((tail quail-misc-package-ext-info) + (let ((tail tit-quail-misc-package-ext-info) coding-system-for-write slot name title dicfile coding quailfile converter copyright) @@ -1137,7 +1156,7 @@ the generated Quail package is saved." ;; Explicitly set eol format to `unix'. (setq coding-system-for-write 'utf-8-unix) (with-temp-file (expand-file-name quailfile dirname) - (generate-lisp-file-heading quailfile 'miscdic-convert) + (generate-lisp-file-heading quailfile 'tit-miscdic-convert) (insert (format-message ";; Quail package `%s'\n" name)) (insert ";; Source dictionary file: " dicfile "\n") (insert ";; Copyright notice of the source file\n") @@ -1164,15 +1183,17 @@ the generated Quail package is saved." quailfile :inhibit-provide t :compile t :coding nil))) (setq tail (cdr tail))))) -(defun batch-miscdic-convert () - "Run `miscdic-convert' on the files remaining on the command line. +;; Used in `Makefile.in'. +(define-obsolete-function-alias 'batch-miscdic-convert #'batch-tit-miscdic-convert "30.1") +(defun batch-tit-miscdic-convert () + "Run `tit-miscdic-convert' on the files remaining on the command line. Use this from the command line, with `-batch'; it won't work in an interactive Emacs. If there's an argument \"-dir\", the next argument specifies a directory to store generated Quail packages." (defvar command-line-args-left) ; Avoid compiler warning. (if (not noninteractive) - (error "`batch-miscdic-convert' should be used only with -batch")) + (error "`batch-tit-miscdic-convert' should be used only with -batch")) (let ((dir default-directory) filename) (while command-line-args-left @@ -1186,11 +1207,13 @@ to store generated Quail packages." (if (file-directory-p filename) (dolist (file (directory-files filename t nil t)) (or (file-directory-p file) - (miscdic-convert file dir))) - (miscdic-convert filename dir)))) + (tit-miscdic-convert file dir))) + (tit-miscdic-convert filename dir)))) (kill-emacs 0)) -(defun pinyin-convert () +;; Used in `Makefile.in'. +(define-obsolete-function-alias 'pinyin-convert #'tit-pinyin-convert "30.1") +(defun tit-pinyin-convert () "Convert text file pinyin.map into an elisp library. The library is named pinyin.el, and contains the constant `pinyin-character-map'." -- cgit v1.2.3 From 783a511d1e31b5c9e5f9cb8ec27fd91d1b9078c9 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 15 Feb 2024 14:23:43 +0800 Subject: Handle /assets and /content file names in `android-browse-url' * lisp/net/browse-url.el (android-browse-url): New function. * lisp/term/android-win.el (android-browse-url-internal): Update function declaration. * src/androidselect.c (Fandroid_browse_url): Rename to... (Fandroid_browse_url_internal): ... this. (syms_of_androidselect): Adjust to match. --- lisp/net/browse-url.el | 2 +- lisp/term/android-win.el | 44 ++++++++++++++++++++++++++++++++++++++++++++ src/androidselect.c | 20 +++++++++++++------- 3 files changed, 58 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index bc2a7db9a8b..ddc57724343 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1324,7 +1324,7 @@ and instant messengers instead of opening it in a web browser." :type 'boolean :version "30.1") -(declare-function android-browse-url "androidselect.c") +(declare-function android-browse-url "../term/android-win") ;;;###autoload (defun browse-url-default-android-browser (url &optional _new-window) diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index e0d252f17e0..b7b0920626e 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -479,6 +479,50 @@ the UTF-8 coding system." ;; Return the concatenation of both these values. (concat locale-base locale-modifier))) + +;; Miscellaneous functions. + +(declare-function android-browse-url-internal "androidselect.c") + +(defun android-browse-url (url &optional send) + "Open URL in an external application. + +URL should be a URL-encoded URL with a scheme specified unless +SEND is non-nil. Signal an error upon failure. + +If SEND is nil, start a program that is able to display the URL, +such as a web browser. Otherwise, try to share URL using +programs such as email clients. + +If URL is a file URI, convert it into a `content' address +accessible to other programs." + (when-let* ((uri (url-generic-parse-url url)) + (filename (url-filename uri)) + ;; If `uri' is a file URI and the file resides in /content + ;; or /assets, copy it to a temporary file before + ;; providing it to other programs. + (replacement-url (and (string-match-p + "/\\(content\\|assets\\)[/$]" + filename) + (prog1 t + (copy-file + filename + (setq filename + (make-temp-file + "local" + nil + (let ((extension + (file-name-extension + filename))) + (if extension + (concat "." + extension) + nil)))) + t)) + (concat "file://" filename)))) + (setq url replacement-url)) + (android-browse-url-internal url send)) + (provide 'android-win) ;; android-win.el ends here. diff --git a/src/androidselect.c b/src/androidselect.c index 5b23c559d2c..61f1c6045db 100644 --- a/src/androidselect.c +++ b/src/androidselect.c @@ -237,15 +237,21 @@ DEFUN ("android-clipboard-exists-p", Fandroid_clipboard_exists_p, return rc ? Qt : Qnil; } -DEFUN ("android-browse-url", Fandroid_browse_url, - Sandroid_browse_url, 1, 2, 0, - doc: /* Open URL in an external application. URL should be a -URL-encoded URL with a scheme specified unless SEND is non-nil. -Signal an error upon failure. +DEFUN ("android-browse-url-internal", Fandroid_browse_url_internal, + Sandroid_browse_url_internal, 1, 2, 0, + doc: /* Open URL in an external application. + +URL should be a URL-encoded URL with a scheme specified unless SEND is +non-nil. Signal an error upon failure. If SEND is nil, start a program that is able to display the URL, such as a web browser. Otherwise, try to share URL using programs such as -email clients. */) +email clients. + +If URL is a file URI, convert it into a `content' address accessible to +other programs. Files inside the /content or /assets directories cannot +be opened through such addresses, which this function does not provide +for. Use `android-browse-url' instead. */) (Lisp_Object url, Lisp_Object send) { Lisp_Object value; @@ -803,7 +809,7 @@ syms_of_androidselect (void) defsubr (&Sandroid_set_clipboard); defsubr (&Sandroid_get_clipboard); defsubr (&Sandroid_clipboard_exists_p); - defsubr (&Sandroid_browse_url); + defsubr (&Sandroid_browse_url_internal); defsubr (&Sandroid_get_clipboard_targets); defsubr (&Sandroid_get_clipboard_data); -- cgit v1.2.3 From 60cff1ac9d216e5abcb350ea5e623ab0b377c131 Mon Sep 17 00:00:00 2001 From: Simen Heggestøyl Date: Tue, 16 Jan 2024 08:21:41 +0100 Subject: Add support for reading/writing IELM input history (bug#67000) * lisp/ielm.el (inferior-emacs-lisp-mode): Add support for saving input history to a file. (ielm--history-file-name): New variable indicating IELM input history file. (ielm--exit): Holds a function to call when Emacs is killed to write out the input history. (ielm--input-history-writer): Helper function for writing the IELM input history out to file. * lisp/comint.el (comint-input-ring-file-name): Improve defcustom tag. --- etc/NEWS | 8 ++++++++ lisp/comint.el | 2 +- lisp/ielm.el | 29 +++++++++++++++++++++++++++++ 3 files changed, 38 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index dc24d775bb1..5220a7fb337 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1357,6 +1357,14 @@ characters, such as ½ (U+00BD VULGAR FRACTION ONE HALF), are also recognized as rational fractions. They have been since 2004, but it looks like it was never mentioned in the NEWS, or even the manual. +** IELM + +--- +*** IELM now remembers input history between sessions. +The new user option 'ielm-history-file-name' is the name of the file +where IELM input history will be saved. Customize it to nil to revert +to the old behavior of not remembering input history between sessions. + * New Modes and Packages in Emacs 30.1 diff --git a/lisp/comint.el b/lisp/comint.el index 0a9cdb44bef..655ff30469c 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -254,7 +254,7 @@ This variable is buffer-local." See also `comint-read-input-ring' and `comint-write-input-ring'. `comint-mode' makes this a buffer-local variable. You probably want to set this in a mode hook, rather than customize the default value." - :type '(choice (const :tag "nil" nil) + :type '(choice (const :tag "Disable input history" nil) file) :group 'comint) diff --git a/lisp/ielm.el b/lisp/ielm.el index 777aebb70cf..e583e0fe32c 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -110,6 +110,13 @@ This gives more frame width for large indented sexps, and allows functions such as `edebug-defun' to work with such inputs." :type 'boolean) +(defcustom ielm-history-file-name + (locate-user-emacs-file "ielm-history.eld") + "If non-nil, name of the file to read/write IELM input history." + :type '(choice (const :tag "Disable input history" nil) + file) + :version "30.1") + (defvaralias 'inferior-emacs-lisp-mode-hook 'ielm-mode-hook) (defcustom ielm-mode-hook nil "Hooks to be run when IELM (`inferior-emacs-lisp-mode') is started." @@ -503,6 +510,17 @@ behavior of the indirect buffer." (funcall pp-default-function beg end) end)) +;;; Input history + +(defvar ielm--exit nil + "Function to call when Emacs is killed.") + +(defun ielm--input-history-writer (buf) + "Return a function writing IELM input history to BUF." + (lambda () + (with-current-buffer buf + (comint-write-input-ring)))) + ;;; Major mode (define-derived-mode inferior-emacs-lisp-mode comint-mode "IELM" @@ -605,6 +623,17 @@ Customized bindings may be defined in `ielm-map', which currently contains: #'ielm-indirect-setup-hook 'append t) (setq comint-indirect-setup-function #'emacs-lisp-mode) + ;; Input history + (setq-local comint-input-ring-file-name ielm-history-file-name) + (setq-local ielm--exit (ielm--input-history-writer (current-buffer))) + (setq-local kill-buffer-hook + (lambda () + (funcall ielm--exit) + (remove-hook 'kill-emacs-hook ielm--exit))) + (unless noninteractive + (add-hook 'kill-emacs-hook ielm--exit)) + (comint-read-input-ring t) + ;; A dummy process to keep comint happy. It will never get any input (unless (comint-check-proc (current-buffer)) ;; Was cat, but on non-Unix platforms that might not exist, so -- cgit v1.2.3 From 3d6137116f6be8ee38f9f49c9811b97ef92e0e58 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 15 Feb 2024 12:04:07 +0200 Subject: Allow font-spec in 'face-font-rescale-alist' set at startup * lisp/startup.el (startup--rescale-elt-match-p): New function. (normal-top-level): Use it, instead of the naive 'string-match-p', to match the default font against the elements of 'face-font-rescale-alist'. Reported by Rahguzar . --- lisp/startup.el | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/startup.el b/lisp/startup.el index 773765a4b97..1c21b5de857 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -556,6 +556,17 @@ the updated value." (setq startup--original-eln-load-path (copy-sequence native-comp-eln-load-path)))) +(defun startup--rescale-elt-match-p (font-pattern font-object) + "Test whether FONT-OBJECT matches an element of `face-font-rescale-alist'. +FONT-OBJECT is a font-object that specifies a font to test. +FONT-PATTERN is the car of an element of `face-font-rescale-alist', +which can be either a regexp matching a font name or a font-spec." + (if (stringp font-pattern) + ;; FONT-PATTERN is a regexp, we need the name of FONT-OBJECT to match. + (string-match-p font-pattern (font-xlfd-name font-object)) + ;; FONT-PATTERN is a font-spec. + (font-match-p font-pattern font-object))) + (defvar android-fonts-enumerated nil "Whether or not fonts have been enumerated already. On Android, Emacs uses this variable internally at startup.") @@ -816,8 +827,9 @@ It is the default value of the variable `top-level'." (when (and (display-multi-font-p) (not (eq face-font-rescale-alist old-face-font-rescale-alist)) - (assoc (font-xlfd-name (face-attribute 'default :font)) - face-font-rescale-alist #'string-match-p)) + (assoc (face-attribute 'default :font) + face-font-rescale-alist + #'startup--rescale-elt-match-p)) (set-face-attribute 'default nil :font (font-spec))) ;; Modify the initial frame based on what .emacs puts into -- cgit v1.2.3 From 8a63e50036f0d4284f21660efb5dd20b63748d1b Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 15 Feb 2024 16:08:00 +0100 Subject: * Define 'cl--type-hierarchy' and compute 'cl--typeof-types' from it * lisp/emacs-lisp/cl-preloaded.el (cl--type-hierarchy) (cl--direct-supertypes-of-type, cl--direct-subtypes-of-type): Define. (cl--typeof-types): Compute automatically. (cl--supertypes-for-typeof-types): New function. --- lisp/emacs-lisp/cl-preloaded.el | 97 +++++++++++++++++++++++++++-------------- 1 file changed, 64 insertions(+), 33 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 20e68555578..248c1fd7c24 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -50,44 +50,75 @@ (apply #'error string (append sargs args)) (signal 'cl-assertion-failed `(,form ,@sargs))))) -(defconst cl--typeof-types - ;; Hand made from the source code of `type-of'. - '((integer number integer-or-marker number-or-marker atom) - (symbol-with-pos symbol atom) (symbol atom) (string array sequence atom) - (cons list sequence) - ;; Markers aren't `numberp', yet they are accepted wherever integers are - ;; accepted, pretty much. - (marker integer-or-marker number-or-marker atom) - (overlay atom) (float number number-or-marker atom) - (window-configuration atom) (process atom) (window atom) - ;; FIXME: We'd want to put `function' here, but that's only true - ;; for those `subr's which aren't special forms! - (subr atom) - ;; FIXME: We should probably reverse the order between - ;; `compiled-function' and `byte-code-function' since arguably - ;; `subr' is also "compiled functions" but not "byte code functions", - ;; but it would require changing the value returned by `type-of' for - ;; byte code objects, which risks breaking existing code, which doesn't - ;; seem worth the trouble. - (compiled-function byte-code-function function atom) - (module-function function atom) - (buffer atom) (char-table array sequence atom) - (bool-vector array sequence atom) - (frame atom) (hash-table atom) (terminal atom) - (thread atom) (mutex atom) (condvar atom) - (font-spec atom) (font-entity atom) (font-object atom) - (vector array sequence atom) - (user-ptr atom) - (tree-sitter-parser atom) - (tree-sitter-node atom) - (tree-sitter-compiled-query atom) - ;; Plus, really hand made: - (null symbol list sequence atom)) + +(defconst cl--type-hierarchy + ;; Please run `sycdoc-update-type-hierarchy' in + ;; etc/syncdoc-type-hierarchy.el each time this is updated to + ;; reflect in the documentation. + '((t sequence atom) + (sequence list array) + (atom + class structure tree-sitter-compiled-query tree-sitter-node + tree-sitter-parser user-ptr font-object font-entity font-spec + condvar mutex thread terminal hash-table frame buffer function + window process window-configuration overlay integer-or-marker + number-or-marker symbol array) + (number float integer) + (number-or-marker marker number) + (integer bignum fixum) + (symbol keyword boolean symbol-with-pos) + (array vector bool-vector char-table string) + (list null cons) + (integer-or-marker integer marker) + (compiled-function byte-code-function) + (function subr module-function compiled-function) + (boolean null) + (subr subr-native-elisp subr-primitive) + (symbol-with-pos keyword)) + "List of lists describing all the edges of the builtin type +hierarchy. +Each sublist is in the form (TYPE . DIRECT_SUBTYPES)" + ;; Given type hierarchy is a DAG (but mostly a tree) I believe this + ;; is the most compact way to express it. + ) + +(defconst cl--direct-supertypes-of-type + (make-hash-table :test #'eq) + "Hash table TYPE -> SUPERTYPES.") + +(defconst cl--direct-subtypes-of-type + (make-hash-table :test #'eq) + "Hash table TYPE -> SUBTYPES.") + +(cl-loop for (parent . children) in cl--type-hierarchy + do (cl-loop + for child in children + do (cl-pushnew parent (gethash child cl--direct-supertypes-of-type)) + do (cl-pushnew child (gethash parent cl--direct-subtypes-of-type)))) + +(defconst cl--typeof-types nil "Alist of supertypes. Each element has the form (TYPE . SUPERTYPES) where TYPE is one of the symbols returned by `type-of', and SUPERTYPES is the list of its supertypes from the most specific to least specific.") +(defun cl--supertypes-for-typeof-types (type) + (cl-loop with res = () + with agenda = (list type) + while agenda + for element = (car agenda) + unless (or (eq element t) ;; no t in `cl--typeof-types'. + (memq element res)) + append (list element) into res + do (cl-loop for c in (gethash element cl--direct-supertypes-of-type) + do (setq agenda (append agenda (list c)))) + do (setq agenda (cdr agenda)) + finally (cl-return res))) + +(maphash (lambda (type _) + (push (cl--supertypes-for-typeof-types type) cl--typeof-types)) + cl--direct-supertypes-of-type) + (defconst cl--all-builtin-types (delete-dups (copy-sequence (apply #'append cl--typeof-types)))) -- cgit v1.2.3 From aa849984896ce393afe92dd4fb7fbce494e131a4 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 15 Feb 2024 16:13:16 +0100 Subject: * make use of 'cl--direct-supertypes-of-type' in the native-compiler * lisp/emacs-lisp/comp-cstr.el (comp--direct-supertypes): Use cl--direct-supertypes-of-type. --- lisp/emacs-lisp/comp-cstr.el | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 2984bedb1dd..0a8b3b7efb2 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -270,18 +270,19 @@ Return them as multiple value." (symbol-name y))) (defun comp--direct-supertypes (type) - "Return the direct supertypes of TYPE." - (let ((supers (comp-supertypes type))) - (cl-assert (eq type (car supers))) - (cl-loop - with notdirect = nil - with direct = nil - for parent in (cdr supers) - unless (memq parent notdirect) - do (progn - (push parent direct) - (setq notdirect (append notdirect (comp-supertypes parent)))) - finally return direct))) + (or + (gethash type cl--direct-supertypes-of-type) + (let ((supers (comp-supertypes type))) + (cl-assert (eq type (car supers))) + (cl-loop + with notdirect = nil + with direct = nil + for parent in (cdr supers) + unless (memq parent notdirect) + do (progn + (push parent direct) + (setq notdirect (append notdirect (comp-supertypes parent)))) + finally return direct)))) (defsubst comp-subtype-p (type1 type2) "Return t if TYPE1 is a subtype of TYPE2 or nil otherwise." -- cgit v1.2.3 From 80dce18a393a3267b72901328bf24e518d0a6fc9 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 15 Feb 2024 19:10:35 +0100 Subject: * lisp/emacs-lisp/cl-preloaded.el (cl--direct-subtypes-of-type): Remove. --- lisp/emacs-lisp/cl-preloaded.el | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 248c1fd7c24..323d826f323 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -86,15 +86,11 @@ Each sublist is in the form (TYPE . DIRECT_SUBTYPES)" (make-hash-table :test #'eq) "Hash table TYPE -> SUPERTYPES.") -(defconst cl--direct-subtypes-of-type - (make-hash-table :test #'eq) - "Hash table TYPE -> SUBTYPES.") - -(cl-loop for (parent . children) in cl--type-hierarchy - do (cl-loop - for child in children - do (cl-pushnew parent (gethash child cl--direct-supertypes-of-type)) - do (cl-pushnew child (gethash parent cl--direct-subtypes-of-type)))) +(cl-loop + for (parent . children) in cl--type-hierarchy + do (cl-loop + for child in children + do (cl-pushnew parent (gethash child cl--direct-supertypes-of-type)))) (defconst cl--typeof-types nil "Alist of supertypes. -- cgit v1.2.3 From 7b34bb5c928798e0d40fce062c1b6d4b2ce06979 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 15 Feb 2024 19:36:05 +0200 Subject: project-or-external-find-regexp: Fix the docstring * lisp/progmodes/project.el (project-or-external-find-regexp): Fix the docstring (bug#68958). --- lisp/progmodes/project.el | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 983c0ed2ac2..aa92a73336e 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -992,9 +992,7 @@ requires quoting, e.g. `\\[quoted-insert]'." ;;;###autoload (defun project-or-external-find-regexp (regexp) - "Find all matches for REGEXP in the project roots or external roots. -With \\[universal-argument] prefix, you can specify the file name -pattern to search for." + "Find all matches for REGEXP in the project roots or external roots." (interactive (list (project--read-regexp))) (require 'xref) (let* ((pr (project-current t)) -- cgit v1.2.3 From 4dbc3bbcc568182380d4646310a652285e210876 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 15 Feb 2024 19:17:07 +0100 Subject: ; * lisp/emacs-lisp/comp.el (comp--write-bytecode-file): Add comment. --- lisp/emacs-lisp/comp.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 6879e6aeeb9..593291a379e 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3495,6 +3495,7 @@ last directory in `native-comp-eln-load-path')." else collect (byte-compile-file file)))) +;; In use by elisp-mode.el (defun comp--write-bytecode-file (eln-file) "After native compilation write the bytecode file for ELN-FILE. Make sure that eln file is younger than byte-compiled one and -- cgit v1.2.3 From cea72c1757cc45b42baf3a35fb4d963f3e722b9c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 15 Feb 2024 15:09:13 -0500 Subject: (tex-font-lock-keywords-1): Fix bug#68827 * lisp/textmodes/tex-mode.el (tex-font-lock-keywords-1): Don't apply `tex-verbatim` in comments. --- lisp/textmodes/tex-mode.el | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 8968d8ec23b..5c5ca573f38 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -514,14 +514,19 @@ An alternative value is \" . \", if you use a font with a narrow period." (inbraces-re (lambda (re) (concat "\\(?:[^{}\\]\\|\\\\.\\|" re "\\)"))) (arg (concat "{\\(" (funcall inbraces-re "{[^}]*}") "+\\)"))) - `( ;; Highlight $$math$$ and $math$. + `(;; Verbatim-like args. + ;; Do it first, because we don't want to highlight them + ;; in comments (bug#68827), but we do want to highlight them + ;; in $math$. + (,(concat slash verbish opt arg) 3 'tex-verbatim keep) + ;; Highlight $$math$$ and $math$. ;; This is done at the very beginning so as to interact with the other ;; keywords in the same way as comments and strings. (,(concat "\\$\\$?\\(?:[^$\\{}]\\|\\\\.\\|{" (funcall inbraces-re (concat "{" (funcall inbraces-re "{[^}]*}") "*}")) "*}\\)+\\$?\\$") - (0 'tex-math)) + (0 'tex-math keep)) ;; Heading args. (,(concat slash headings "\\*?" opt arg) ;; If ARG ends up matching too much (if the {} don't match, e.g.) @@ -543,8 +548,6 @@ An alternative value is \" . \", if you use a font with a narrow period." (,(concat slash variables " *" arg) 2 font-lock-variable-name-face) ;; Include args. (,(concat slash includes opt arg) 3 font-lock-builtin-face) - ;; Verbatim-like args. - (,(concat slash verbish opt arg) 3 'tex-verbatim t) ;; Definitions. I think. ("^[ \t]*\\\\def *\\\\\\(\\(\\w\\|@\\)+\\)" 1 font-lock-function-name-face)))) -- cgit v1.2.3 From 572d58b5e8d0f1f1244b9ccab8f02c4f50ca8d12 Mon Sep 17 00:00:00 2001 From: Tomas Volf <~@wolfsden.cz> Date: Thu, 15 Feb 2024 18:23:23 -0800 Subject: When deleting output in Eshell, optionally add it to the kill ring. * lisp/eshell/esh-mode.el (eshell-kill-output): Rename to... (eshell-delete-output): ... this, for consistency with 'comint-mode', and accept KILL argument. Update callers. Copyright-paperwork-exempt: yes --- lisp/eshell/esh-mode.el | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index fd279f61673..b15f99a0359 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -290,7 +290,7 @@ non-interactive sessions, such as when using `eshell-command'.") "C-e" #'eshell-show-maximum-output "C-f" #'eshell-forward-argument "C-m" #'eshell-copy-old-input - "C-o" #'eshell-kill-output + "C-o" #'eshell-delete-output "C-r" #'eshell-show-output "C-t" #'eshell-truncate-buffer "C-u" #'eshell-kill-input @@ -832,15 +832,23 @@ This function should be in the list `eshell-output-filter-functions'." eshell-last-output-start eshell-last-output-end)) -(defun eshell-kill-output () - "Kill all output from interpreter since last input. -Does not delete the prompt." - (interactive) +(defun eshell-delete-output (&optional kill) + "Delete all output from interpreter since last input. +If KILL is non-nil (interactively, the prefix), save the killed text in +the kill ring. + +This command does not delete the prompt." + (interactive "P") (save-excursion (goto-char (eshell-beginning-of-output)) (insert "*** output flushed ***\n") + (when kill + (copy-region-as-kill (point) (eshell-end-of-output))) (delete-region (point) (eshell-end-of-output)))) +(define-obsolete-function-alias 'eshell-kill-output + #'eshell-delete-output "30.1") + (defun eshell-show-output (&optional arg) "Display start of this batch of interpreter output at top of window. Sets mark to the value of point when this command is run. -- cgit v1.2.3 From 44a1721156ec29e5799da94f7918f217f52fd751 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 16 Feb 2024 09:04:46 -0500 Subject: * lisp/loadup.el (lexical-binding): Add a comment --- lisp/loadup.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp') diff --git a/lisp/loadup.el b/lisp/loadup.el index c498c0e53af..c6a8dcbb909 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -635,6 +635,8 @@ directory got moved. This is set to be a pair in the form of: (unwind-protect (let ((tmp-dump-mode dump-mode) (dump-mode nil) + ;; Set `lexical-binding' to nil by default + ;; in the dumped Emacs. (lexical-binding nil)) (if (member tmp-dump-mode '("pdump" "pbootstrap")) (dump-emacs-portable (expand-file-name output invocation-directory)) -- cgit v1.2.3 From e288e1b2f352952e826727967a406c8675fd5594 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 15 Feb 2024 20:17:20 -0800 Subject: Remove "erc-" prefixed Compat definitions * lisp/erc/erc-compat.el: Remove NO-ERROR argument from top-level `require' for library `compat' because it's guaranteed to be present. (erc-compat-function, erc-compat-call): Redefine as obsolete aliases for unprefixed namesakes. * lisp/erc/erc-fill.el (erc-fill-wrap-nudge): Use `compat-call' instead of `erc-compat-call'. --- lisp/erc/erc-compat.el | 46 +++------------------------------------------- lisp/erc/erc-fill.el | 2 +- 2 files changed, 4 insertions(+), 44 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 9b8699f6949..b5b8fbaf8ab 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -31,51 +31,11 @@ ;;; Code: -(require 'compat nil 'noerror) +(require 'compat) (eval-when-compile (require 'cl-lib)) -;; Except for the "erc-" namespacing, these two definitions should be -;; continuously updated to match the latest upstream ones verbatim. -;; Although they're pretty simple, it's likely not worth checking for -;; and possibly deferring to the non-prefixed versions. -;; -;; BEGIN Compat macros - -;;;; Macros for extended compatibility function calls - -(defmacro erc-compat-function (fun) - "Return compatibility function symbol for FUN. - -If the Emacs version provides a sufficiently recent version of -FUN, the symbol FUN is returned itself. Otherwise the macro -returns the symbol of a compatibility function which supports the -behavior and calling convention of the current stable Emacs -version. For example Compat 29.1 will provide compatibility -functions which implement the behavior and calling convention of -Emacs 29.1. - -See also `compat-call' to directly call compatibility functions." - (let ((compat (intern (format "compat--%s" fun)))) - `#',(if (fboundp compat) compat fun))) - -(defmacro erc-compat-call (fun &rest args) - "Call compatibility function or macro FUN with ARGS. - -A good example function is `plist-get' which was extended with an -additional predicate argument in Emacs 29.1. The compatibility -function, which supports this additional argument, can be -obtained via (compat-function plist-get) and called -via (compat-call plist-get plist prop predicate). It is not -possible to directly call (plist-get plist prop predicate) on -Emacs older than 29.1, since the original `plist-get' function -does not yet support the predicate argument. Note that the -Compat library never overrides existing functions. - -See also `compat-function' to lookup compatibility functions." - (let ((compat (intern (format "compat--%s" fun)))) - `(,(if (fboundp compat) compat fun) ,@args))) - -;; END Compat macros +(define-obsolete-function-alias 'erc-compat-function #'compat-function "30.1") +(define-obsolete-function-alias 'erc-compat-call #'compat-call "30.1") ;;;###autoload(autoload 'erc-define-minor-mode "erc-compat") (define-obsolete-function-alias 'erc-define-minor-mode diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index b91ce007087..547b3a11043 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -832,7 +832,7 @@ decorations applied by third-party modules." (line (count-screen-lines (window-start) (window-point)))) (when (zerop arg) (setq arg 1)) - (erc-compat-call + (compat-call set-transient-map (let ((map (make-sparse-keymap))) (dolist (key '(?= ?- ?0)) -- cgit v1.2.3 From a43b062ee57fd9b7c410e741946e51281db5b92a Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 8 Feb 2024 19:19:53 -0800 Subject: ; Load erc-compat before ert-x in ERC tests Avoid eager macro-expansion error in tests files on Emacs 27 and 28 by ensuring definitions provided by Compat, like `macroexp-file-name', load first. * lisp/erc/erc-speedbar.el (erc-speedbar--reset-last-ran-on-timer): Suppress "`buffer-local-value' is an obsolete generalized variable" warning on Emacs 29 and below. * lisp/erc/erc-stamp.el (erc-stamp--time-as-day): Avoid "unused lexical variable `current-time-list'" warning on 28 and below. * lisp/erc/erc.el (erc-check-text-conversion): Add `defvar' for `text-conversion-style' to avoid "reference to free variable" warning on Emacs 29 and below. * test/lisp/erc/erc-button-tests.el: Load `erc-button' before `ert-x'. * test/lisp/erc/erc-fill-tests.el: Load `erc-fill' before `ert-x'. * test/lisp/erc/erc-goodies-tests.el: Load `erc-goodies' before `ert-x'. * test/lisp/erc/erc-networks-tests.el: Explicitly load `erc-compat' before anything else. * test/lisp/erc/erc-scenarios-base-renick.el: Update timeouts. * test/lisp/erc/erc-stamp-tests.el: Load `erc-stamp' before `ert-x'. * test/lisp/erc/erc-tests.el: Load `erc-ring' before `ert-x'. --- lisp/erc/erc-speedbar.el | 5 +++-- lisp/erc/erc-stamp.el | 1 + lisp/erc/erc.el | 1 + test/lisp/erc/erc-button-tests.el | 3 +-- test/lisp/erc/erc-fill-tests.el | 4 ++-- test/lisp/erc/erc-goodies-tests.el | 4 ++-- test/lisp/erc/erc-networks-tests.el | 1 + test/lisp/erc/erc-scenarios-base-renick.el | 8 ++++---- test/lisp/erc/erc-stamp-tests.el | 6 +++--- test/lisp/erc/erc-tests.el | 2 +- 10 files changed, 19 insertions(+), 16 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index e3d28aa60dd..a81a3869436 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -566,8 +566,9 @@ The INDENT level is ignored." (defun erc-speedbar--reset-last-ran-on-timer () "Reset `erc-speedbar--last-ran'." (when speedbar-buffer - (setf (buffer-local-value 'erc-speedbar--last-ran speedbar-buffer) - (current-time)))) + (with-suppressed-warnings ((obsolete buffer-local-value)) ; <=29 + (setf (buffer-local-value 'erc-speedbar--last-ran speedbar-buffer) + (current-time))))) ;;;###autoload(autoload 'erc-nickbar-mode "erc-speedbar" nil t) (define-erc-module nickbar nil diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index a11739a4195..a8190a2c94a 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -828,6 +828,7 @@ left-sided stamps and date stamps inserted by this function." ;; perform day alignments via this function only when needed. (defun erc-stamp--time-as-day (current-time) "Discard hour, minute, and second info from timestamp CURRENT-TIME." + (defvar current-time-list) ; <=28 (let* ((current-time-list) ; flag (decoded (decode-time current-time erc-stamp--tz))) (setf (decoded-time-second decoded) 0 diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 08dfa4b8f1b..88227688064 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -9492,6 +9492,7 @@ guarantee that the input method functions properly for the purpose of typing within the ERC prompt." (when (and (eq major-mode 'erc-mode) (fboundp 'set-text-conversion-style)) + (defvar text-conversion-style) ; avoid free variable warning on <=29 (if (>= (point) (erc-beg-of-input-line)) (unless (eq text-conversion-style 'action) (set-text-conversion-style 'action)) diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el index ba6fe9fd8c1..603b3745a27 100644 --- a/test/lisp/erc/erc-button-tests.el +++ b/test/lisp/erc/erc-button-tests.el @@ -20,14 +20,13 @@ ;;; Commentary: ;;; Code: +(require 'erc-button) (require 'ert-x) ; cl-lib (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-button) - (ert-deftest erc-button-alist--url () (erc-tests-common-init-server-proc "sleep" "1") (with-current-buffer (erc--open-target "#chan") diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 0f19b481f37..2c3537676a7 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -23,13 +23,13 @@ ;; scenarios. ;;; Code: +(require 'erc-fill) + (require 'ert-x) (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-fill) - (defvar erc-fill-tests--buffers nil) (defvar erc-fill-tests--current-time-value nil) diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index 170e28bda96..7013ce0c8fc 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -19,13 +19,13 @@ ;;; Commentary: ;;; Code: +(require 'erc-goodies) + (require 'ert-x) (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-goodies) - (defun erc-goodies-tests--assert-face (beg end-str present &optional absent) (setq beg (+ beg (point-min))) (let ((end (+ beg (1- (length end-str))))) diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index 53cff8f489c..90b8aa99741 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el @@ -18,6 +18,7 @@ ;; along with GNU Emacs. If not, see . ;;; Code: +(require 'erc-compat) (require 'ert-x) ; cl-lib (eval-and-compile diff --git a/test/lisp/erc/erc-scenarios-base-renick.el b/test/lisp/erc/erc-scenarios-base-renick.el index ca22728b152..e0fcb8b9366 100644 --- a/test/lisp/erc/erc-scenarios-base-renick.el +++ b/test/lisp/erc/erc-scenarios-base-renick.el @@ -281,12 +281,12 @@ (should-not (get-buffer "rando@barnet")) (with-current-buffer "frenemy@foonet" - (funcall expect 1 "now known as") - (funcall expect 1 "doubly so")) + (funcall expect 10 "now known as") + (funcall expect 10 "doubly so")) (with-current-buffer "frenemy@barnet" - (funcall expect 1 "now known as") - (funcall expect 1 "reality picture")) + (funcall expect 10 "now known as") + (funcall expect 10 "reality picture")) (when noninteractive (with-current-buffer "frenemy@barnet" (kill-buffer)) diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index 70ca224ac74..a49173ffa2f 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -20,14 +20,14 @@ ;;; Commentary: ;;; Code: +(require 'erc-stamp) +(require 'erc-goodies) ; for `erc-make-read-only' + (require 'ert-x) (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-stamp) -(require 'erc-goodies) ; for `erc-make-read-only' - ;; These display-oriented tests are brittle because many factors ;; influence how text properties are applied. We should just ;; rework these into full scenarios. diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 7d189d37929..dad161a2827 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -20,13 +20,13 @@ ;; along with GNU Emacs. If not, see . ;;; Code: +(require 'erc-ring) (require 'ert-x) (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-ring) (ert-deftest erc--read-time-period () (cl-letf (((symbol-function 'read-string) (lambda (&rest _) ""))) -- cgit v1.2.3 From 1a36d52413c784750f650ccba95436e4f76ab104 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 3 Feb 2024 17:17:48 -0800 Subject: Autoload custom-loads for new Custom groups in erc.el * lisp/erc/erc.el: Add `custom-loads' library features for group symbols `erc-spelling' and `erc-imenu' since they aren't defined in all supported Emacs versions. Also add groups `erc-sasl' and `erc-nicks', new libraries recently added to ERC. Note that this is unrelated to prefixes generated for the help system. (Bug#68943) --- lisp/erc/erc.el | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'lisp') diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 88227688064..db5a9baf5c3 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -135,6 +135,13 @@ concerning buffers." "Running scripts at startup and with /LOAD." :group 'erc) +;; Add `custom-loads' features for group symbols missing from a +;; supported Emacs version, possibly because they belong to a new ERC +;; library. These groups all share their library's feature name. +;;;###autoload(dolist (symbol '( erc-sasl erc-spelling ; 29 +;;;###autoload erc-imenu erc-nicks)) ; 30 +;;;###autoload (custom-add-load symbol symbol)) + (defvar erc-message-parsed) ; only known to this file (defvar erc--msg-props nil -- cgit v1.2.3 From 9668b4f97c2fc6bfff83258861d455a6d02516a8 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 13 Nov 2023 12:07:36 -0800 Subject: Make erc-fill-wrap depend on scrolltobottom * lisp/erc/erc-fill.el (erc-fill-mode): Add reference to `erc-fill-wrap-mode' in doc string. (erc--fill-wrap-scrolltobottom-exempt-p): New variable to allow tests involving `fill-wrap' to opt out of having to enable `scrolltobottom'. (erc-fill--wrap-ensure-dependencies): Warn and enable `erc-scrolltobottom-mode' if necessary. (erc-fill-wrap-mode): Mention workaround for automatically enabling `scrolltobottom'. * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--wrap-populate): Exempt tests from `scrolltobottom' dependency. * test/lisp/erc/resources/erc-scenarios-common.el: Load `erc-fill' when compiling. (erc-scenarios-common--print-trace): Exempt tests using `fill-wrap' from the `scrolltobottom' dependency by making `erc--fill-wrap-scrolltobottom-exempt-p' non-nil during test runs. (Bug#60936) --- lisp/erc/erc-fill.el | 62 +++++++++++++------------ test/lisp/erc/erc-fill-tests.el | 1 + test/lisp/erc/resources/erc-scenarios-common.el | 4 +- 3 files changed, 36 insertions(+), 31 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 547b3a11043..aa12b807fbc 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -44,11 +44,7 @@ (define-erc-module fill nil "Manage filling in ERC buffers. ERC fill mode is a global minor mode. When enabled, messages in -the channel buffers are filled." - ;; FIXME ensure a consistent ordering relative to hook members from - ;; other modules. Ideally, this module's processing should happen - ;; after "morphological" modifications to a message's text but - ;; before superficial decorations. +channel buffers are filled. See also `erc-fill-wrap-mode'." ((add-hook 'erc-insert-modify-hook #'erc-fill 60) (add-hook 'erc-send-modify-hook #'erc-fill 60)) ((remove-hook 'erc-insert-modify-hook #'erc-fill) @@ -425,8 +421,11 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." " " #'erc-fill--wrap-beginning-of-line) (defvar erc-button-mode) +(defvar erc-scrolltobottom-mode) (defvar erc-legacy-invisible-bounds-p) +(defvar erc--fill-wrap-scrolltobottom-exempt-p nil) + (defun erc-fill--wrap-ensure-dependencies () (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) (when erc-legacy-invisible-bounds-p @@ -439,6 +438,10 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." (unless erc-fill-mode (push 'fill missing-deps) (erc-fill-mode +1)) + (unless (or erc-scrolltobottom-mode erc--fill-wrap-scrolltobottom-exempt-p + (memq 'scrolltobottom erc-modules)) + (push 'scrolltobottom missing-deps) + (erc-scrolltobottom-mode +1)) (when erc-fill-wrap-merge (require 'erc-button) (unless erc-button-mode @@ -459,27 +462,25 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." ;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill) (define-erc-module fill-wrap nil "Fill style leveraging `visual-line-mode'. + This module displays nicks overhanging leftward to a common -offset, as determined by the option `erc-fill-static-center'. -And it \"wraps\" messages at a common margin width, as determined -by the option `erc-fill-wrap-margin-width'. To use it, either -include `fill-wrap' in `erc-modules' or set `erc-fill-function' -to `erc-fill-wrap'. Most users will want to enable the -`scrolltobottom' module as well. - -During sessions in which this module is active, use -\\[erc-fill-wrap-nudge] to adjust the width of the indent and the -stamp margin, and use \\[erc-fill-wrap-toggle-truncate-lines] for -cycling between logical- and screen-line oriented command -movement. Similarly, use \\[erc-fill-wrap-refill-buffer] to fix -alignment problems after running certain commands, like -`text-scale-adjust'. Also see related stylistic options -`erc-fill-wrap-merge', and `erc-fill-wrap-merge-indicator'. -\(Hint: in narrow windows, where is space tight, try setting -`erc-fill-static-center' to 1. And if you also use the option -`erc-fill-wrap-merge-indicator', set that to value-menu item -\"Leading MIDDLE DOT sans gap\" or one of the various -\"trailing\" items.) +offset, as determined by the option `erc-fill-static-center'. It +also \"wraps\" messages at a common width, as determined by the +option `erc-fill-wrap-margin-width'. To use it, either include +`fill-wrap' in `erc-modules' or set `erc-fill-function' to +`erc-fill-wrap'. + +Once enabled, use \\[erc-fill-wrap-nudge] to adjust the width of +the indent and the stamp margin. And For cycling between +logical- and screen-line oriented command movement, see +\\[erc-fill-wrap-toggle-truncate-lines]. Similarly, use +\\[erc-fill-wrap-refill-buffer] to fix alignment problems after +running certain commands, like `text-scale-adjust'. Also see +related stylistic options `erc-fill-wrap-merge', and +`erc-fill-wrap-merge-indicator'. (Hint: in narrow windows, try +setting `erc-fill-static-center' to 1, and if you use +`erc-fill-wrap-merge-indicator', choose \"Leading MIDDLE DOT sans +gap\" or one of the \"trailing\" items from the Customize menu.) This module imposes various restrictions on the appearance of timestamps. Most notably, it insists on displaying them in the @@ -497,11 +498,12 @@ a workaround provided by `erc-stamp-prefix-log-filter', which strips trailing stamps from logged messages and instead prepends them to every line. -As a so-called \"local\" module, `fill-wrap' depends on the -global modules `fill', `stamp', and `button'; it activates them -as needed when initializing. Please note that enabling and -disabling this module by invoking one of its minor-mode toggles -is not recommended." +A so-called \"local\" module, `fill-wrap' depends on the global +modules `fill', `stamp', `button', and `scrolltobottom'. It +activates them as needed when initializing and leaves them +enabled when shutting down. To opt out of `scrolltobottom' +specifically, disable its minor mode, `erc-scrolltobottom-mode', +via `erc-fill-wrap-mode-hook'." ((erc-fill--wrap-ensure-dependencies) (erc--restore-initialize-priors erc-fill-wrap-mode erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 2c3537676a7..3c4ad04abd7 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -52,6 +52,7 @@ (defun erc-fill-tests--wrap-populate (test) (let ((original-window-buffer (window-buffer (selected-window))) + (erc--fill-wrap-scrolltobottom-exempt-p t) (erc-stamp--tz t) (erc-fill-function 'erc-fill-wrap) (pre-command-hook pre-command-hook) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 042b3a8c05b..9ad5ce49429 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -94,7 +94,8 @@ (require 'erc) (eval-when-compile (require 'erc-join) - (require 'erc-services)) + (require 'erc-services) + (require 'erc-fill)) (declare-function erc-network "erc-networks") (defvar erc-network) @@ -148,6 +149,7 @@ (timer-list (copy-sequence timer-list)) (timer-idle-list (copy-sequence timer-idle-list)) (erc-auth-source-parameters-join-function nil) + (erc--fill-wrap-scrolltobottom-exempt-p t) (erc-autojoin-channels-alist nil) (erc-server-auto-reconnect nil) (erc-after-connect nil) -- cgit v1.2.3 From d7c18a7b4f218de8c4d2178c9124ea26c7dc5b6b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 11 Feb 2024 20:42:18 -0800 Subject: Ignore the TGT-LIST parameter in erc-open * etc/ERC-NEWS: Mention `erc-open' now ignores TGT-LIST. * lisp/erc/erc.el (erc-open): Set `erc-default-recipients' to a list containing only the supplied target. Other values may cause ERC to malfunction. Also redo doc string. --- etc/ERC-NEWS | 10 ++++++++++ lisp/erc/erc.el | 39 ++++++++++++++++----------------------- 2 files changed, 26 insertions(+), 23 deletions(-) (limited to 'lisp') diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 1e88500d169..b2aceaa9f39 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -502,6 +502,16 @@ encouraged to keep a module's name aligned with its group's as well as the provided feature of its containing library, if only for the usual reasons of namespace hygiene and discoverability. +*** The function 'erc-open' no longer uses the 'TGT-LIST' parameter. +ERC has always used the parameter to initialize the local variable +'erc-default-recipients', which stores a list of routing targets with +the topmost considered "active." However, since at least ERC 5.1, a +buffer and its active target effectively mate for life, making +'TGT-LIST', in practice, a read-only list of a single target. And +because that target must also appear as the 'CHANNEL' parameter, +'TGT-LIST' mainly serves to reinforce 'erc-open's reputation of being +unruly. + *** ERC supports arbitrary CHANTYPES. Specifically, channels can be prefixed with any predesignated character, mainly to afford more flexibility to specialty services, diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index db5a9baf5c3..94e98bd7660 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2486,29 +2486,22 @@ nil." (cl-assert (= (point) (point-max))))) (defun erc-open (&optional server port nick full-name - connect passwd tgt-list channel process + connect passwd _tgt-list channel process client-certificate user id) - "Connect to SERVER on PORT as NICK with USER and FULL-NAME. - -If CONNECT is non-nil, connect to the server. Otherwise assume -already connected and just create a separate buffer for the new -target given by CHANNEL, meaning these parameters are mutually -exclusive. Note that CHANNEL may also be a query; its name has -been retained for historical reasons. - -Use PASSWD as user password on the server. If TGT-LIST is -non-nil, use it to initialize `erc-default-recipients'. - -CLIENT-CERTIFICATE, if non-nil, should either be a list where the -first element is the file name of the private key corresponding -to a client certificate and the second element is the file name -of the client certificate itself to use when connecting over TLS, -or t, which means that `auth-source' will be queried for the -private key and the certificate. - -When non-nil, ID should be a symbol for identifying the connection. - -Returns the buffer for the given server or channel." + "Return a new or reinitialized server or target buffer. +If CONNECT is non-nil, connect to SERVER and return its new or +reassociated buffer. Otherwise, assume PROCESS is non-nil and belongs +to an active session, and return a new or refurbished target buffer for +CHANNEL, which may also be a query target (the parameter name remains +for historical reasons). Pass SERVER, PORT, NICK, USER, FULL-NAME, and +PASSWD to `erc-determine-parameters' for preserving as session-local +variables. Do something similar for CLIENT-CERTIFICATE and ID, which +should be as described by `erc-tls'. + +Note that ERC ignores TGT-LIST and initializes `erc-default-recipients' +with CHANNEL as its only member. Note also that this function has the +side effect of setting the current buffer to the one it returns. Use +`with-current-buffer' or `save-excursion' to nullify this effect." (let* ((target (and channel (erc--target-from-string channel))) (buffer (erc-get-buffer-create server port nil target id)) (old-buffer (current-buffer)) @@ -2545,7 +2538,7 @@ Returns the buffer for the given server or channel." ;; connection parameters (setq erc-server-process process) ;; stack of default recipients - (setq erc-default-recipients tgt-list) + (when channel (setq erc-default-recipients (list channel))) (when target (setq erc--target target erc-network (erc-network))) -- cgit v1.2.3 From 25d15391f2683ea95c4d7ee291fb82e0c9858d73 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 11 Feb 2024 17:15:14 -0800 Subject: Normalize ISUPPORT params with empty values in ERC * lisp/erc/erc-backend.el (erc-server-parameters) (erc--isupport-params): Mention parsing and storage behavior regarding nonstandard "FOO=" tokens. (erc--parse-isupport-value): Move comment closer to code. (erc--get-isupport-entry): Treat the empty string as truly null, as prescribed by the Brocklesby draft cited in the top-level comment. * test/lisp/erc/erc-tests.el (erc--get-isupport-entry): Add case for the empty string appearing as a value for an `erc-server-parameters' item. (erc-server-005): Assert compat-related behavior of retaining the empty string as a valid value from a raw "FOO=" token. (Bug#67220) --- lisp/erc/erc-backend.el | 21 +++++++++++++-------- test/lisp/erc/erc-tests.el | 26 ++++++++++++++++++-------- 2 files changed, 31 insertions(+), 16 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index e379066b08e..2aaedad1b64 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -254,6 +254,11 @@ Entries are of the form: or (PARAMETER) if no value is provided. +where PARAMETER is a string and VALUE is a string or nil. For +compatibility, a raw parameter of the form \"FOO=\" becomes +(\"FOO\" . \"\") even though it's equivalent to the preferred +canonical form \"FOO\" and its lisp representation (\"FOO\"). + Some examples of possible parameters sent by servers: CHANMODES=b,k,l,imnpst - list of supported channel modes CHANNELLEN=50 - maximum length of channel names @@ -273,7 +278,8 @@ WALLCHOPS - supports sending messages to all operators in a channel") (defvar-local erc--isupport-params nil "Hash map of \"ISUPPORT\" params. Keys are symbols. Values are lists of zero or more strings with hex -escapes removed.") +escapes removed. ERC normalizes incoming parameters of the form +\"FOO=\" to (FOO).") ;;; Server and connection state @@ -2150,10 +2156,6 @@ Then display the welcome message." ;; ;; > The server SHOULD send "X", not "X="; this is the normalized form. ;; - ;; Note: for now, assume the server will only send non-empty values, - ;; possibly with printable ASCII escapes. Though in practice, the - ;; only two escapes we're likely to see are backslash and space, - ;; meaning the pattern is too liberal. (let (case-fold-search) (mapcar (lambda (v) @@ -2164,7 +2166,9 @@ Then display the welcome message." (string-match "[\\]x[0-9A-F][0-9A-F]" v start)) (setq m (substring v (+ 2 (match-beginning 0)) (match-end 0)) c (string-to-number m 16)) - (if (<= ?\ c ?~) + ;; In practice, this range is too liberal. The only + ;; escapes we're likely to see are ?\\, ?=, and ?\s. + (if (<= ?\s c ?~) (setq v (concat (substring v 0 (match-beginning 0)) (string c) (substring v (match-end 0))) @@ -2189,8 +2193,9 @@ primitive value." (or erc-server-parameters (erc-with-server-buffer erc-server-parameters))))) - (if (cdr v) - (erc--parse-isupport-value (cdr v)) + (if-let ((val (cdr v)) + ((not (string-empty-p val)))) + (erc--parse-isupport-value val) '--empty--))))) (pcase value ('--empty-- (unless single (list key))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index dad161a2827..4762be468a5 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1054,7 +1054,8 @@ (ert-deftest erc--get-isupport-entry () (let ((erc--isupport-params (make-hash-table)) - (erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C"))) + (erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C") + ("SPAM" . ""))) (items (lambda () (cl-loop for k being the hash-keys of erc--isupport-params using (hash-values v) collect (cons k v))))) @@ -1075,7 +1076,9 @@ (should (equal (erc--get-isupport-entry 'FOO) '(FOO "1"))) (should (equal (funcall items) - '((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1")))))) + '((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1")))) + (should (equal (erc--get-isupport-entry 'SPAM) '(SPAM))) + (should-not (erc--get-isupport-entry 'SPAM 'single)))) (ert-deftest erc-server-005 () (let* ((hooked 0) @@ -1093,34 +1096,41 @@ (lambda (_ _ _ line) (push line calls)))) (ert-info ("Baseline") - (setq args '("tester" "BOT=B" "EXCEPTS" "PREFIX=(ov)@+" "are supp...") + (setq args '("tester" "BOT=B" "CHANTYPES=" "EXCEPTS" "PREFIX=(ov)@+" + "are supp...") parsed (make-erc-response :command-args args :command "005")) (setq verify (lambda () (should (equal erc-server-parameters '(("PREFIX" . "(ov)@+") ("EXCEPTS") + ;; Should be ("CHANTYPES") but + ;; retained for compatibility. + ("CHANTYPES" . "") ("BOT" . "B")))) (should (zerop (hash-table-count erc--isupport-params))) (should (equal "(ov)@+" (erc--get-isupport-entry 'PREFIX t))) (should (equal '(EXCEPTS) (erc--get-isupport-entry 'EXCEPTS))) (should (equal "B" (erc--get-isupport-entry 'BOT t))) - (should (string= (pop calls) - "BOT=B EXCEPTS PREFIX=(ov)@+ are supp...")) + (should (string= + (pop calls) + "BOT=B CHANTYPES= EXCEPTS PREFIX=(ov)@+ are supp...")) (should (equal args (erc-response.command-args parsed))))) (erc-call-hooks nil parsed)) (ert-info ("Negated, updated") - (setq args '("tester" "-EXCEPTS" "-FAKE" "PREFIX=(ohv)@%+" "are su...") + (setq args '("tester" "-EXCEPTS" "-CHANTYPES" "-FAKE" "PREFIX=(ohv)@%+" + "are su...") parsed (make-erc-response :command-args args :command "005")) (setq verify (lambda () (should (equal erc-server-parameters '(("PREFIX" . "(ohv)@%+") ("BOT" . "B")))) - (should (string= (pop calls) - "-EXCEPTS -FAKE PREFIX=(ohv)@%+ are su...")) + (should (string-prefix-p + "-EXCEPTS -CHANTYPES -FAKE PREFIX=(ohv)@%+ " + (pop calls))) (should (equal "(ohv)@%+" (erc--get-isupport-entry 'PREFIX t))) (should (equal "B" (erc--get-isupport-entry 'BOT t))) (should-not (erc--get-isupport-entry 'EXCEPTS)) -- cgit v1.2.3 From 3d87e343276081247102838b827b8a1f5e9e0c54 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 11 Feb 2024 20:01:54 -0800 Subject: Use modern fallback for channel name detection in ERC * lisp/erc/erc-backend.el (erc-query-buffer-p): Remove forward declaration. * lisp/erc/erc.el (erc-query-buffer-p): Defer to `erc-channel-p'. (erc-channel-p): Refactor and use `erc--fallback-channel-prefixes' for the default CHANTYPES value. Honor an empty CHANTYPES value as valid, e.g., for servers that only support direct messages. (erc--fallback-channel-prefixes): New variable to hold fallback CHANTYPES prefixes recommended by RFC1459 and modern authorities on the matter. * test/lisp/erc/erc-tests.el (erc-channel-p): Revise test. (Bug#67220) --- lisp/erc/erc-backend.el | 1 - lisp/erc/erc.el | 32 +++++++++++++++----------------- test/lisp/erc/erc-tests.el | 46 +++++++++++++++++++++++++++++----------------- 3 files changed, 44 insertions(+), 35 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 2aaedad1b64..7b782d0ef44 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -158,7 +158,6 @@ (declare-function erc-parse-user "erc" (string)) (declare-function erc-process-away "erc" (proc away-p)) (declare-function erc-process-ctcp-query "erc" (proc parsed nick login host)) -(declare-function erc-query-buffer-p "erc" (&optional buffer)) (declare-function erc-remove-channel-member "erc" (channel nick)) (declare-function erc-remove-channel-users "erc" nil) (declare-function erc-remove-user "erc" (nick)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 94e98bd7660..f250584e47a 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1663,11 +1663,7 @@ If BUFFER is nil, the current buffer is used." (defun erc-query-buffer-p (&optional buffer) "Return non-nil if BUFFER is an ERC query buffer. If BUFFER is nil, the current buffer is used." - (with-current-buffer (or buffer (current-buffer)) - (let ((target (erc-target))) - (and (eq major-mode 'erc-mode) - target - (not (memq (aref target 0) '(?# ?& ?+ ?!))))))) + (not (erc-channel-p (or buffer (current-buffer))))) (defun erc-ison-p (nick) "Return non-nil if NICK is online." @@ -1882,18 +1878,20 @@ buries those." :group 'erc-buffers :type 'boolean) -(defun erc-channel-p (channel) - "Return non-nil if CHANNEL seems to be an IRC channel name." - (cond ((stringp channel) - (memq (aref channel 0) - (if-let ((types (erc--get-isupport-entry 'CHANTYPES 'single))) - (append types nil) - '(?# ?& ?+ ?!)))) - ((and-let* (((bufferp channel)) - ((buffer-live-p channel)) - (target (buffer-local-value 'erc--target channel))) - (erc-channel-p (erc--target-string target)))) - (t nil))) +(defvar erc--fallback-channel-prefixes "#&" + "Prefix chars for distinguishing channel targets when CHANTYPES is unknown.") + +(defun erc-channel-p (target) + "Return non-nil if TARGET is a valid channel name or a channel buffer." + (cond ((stringp target) + (and-let* + (((not (string-empty-p target))) + (value (let ((entry (erc--get-isupport-entry 'CHANTYPES))) + (if entry (cadr entry) erc--fallback-channel-prefixes))) + ((erc--strpos (aref target 0) value))))) + ((and-let* (((buffer-live-p target)) + (target (buffer-local-value 'erc--target target)) + ((erc--target-channel-p target))))))) ;; For the sake of compatibility, a historical quirk concerning this ;; option, when nil, has been preserved: all buffers are suffixed with diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 4762be468a5..085b063bdb2 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1167,25 +1167,37 @@ (should (equal (erc-downcase "\\O/") "|o/" ))))) (ert-deftest erc-channel-p () - (let ((erc--isupport-params (make-hash-table)) - erc-server-parameters) - - (should (erc-channel-p "#chan")) - (should (erc-channel-p "##chan")) - (should (erc-channel-p "&chan")) - (should (erc-channel-p "+chan")) - (should (erc-channel-p "!chan")) - (should-not (erc-channel-p "@chan")) - - (push '("CHANTYPES" . "#&@+!") erc-server-parameters) + (erc-tests-common-make-server-buf) - (should (erc-channel-p "!chan")) - (should (erc-channel-p "#chan")) + (should (erc-channel-p "#chan")) + (should (erc-channel-p "##chan")) + (should (erc-channel-p "&chan")) + (should-not (erc-channel-p "+chan")) + (should-not (erc-channel-p "!chan")) + (should-not (erc-channel-p "@chan")) + + ;; Server sends "CHANTYPES=#&+!" + (should-not erc-server-parameters) + (setq erc-server-parameters '(("CHANTYPES" . "#&+!"))) + (should (erc-channel-p "#chan")) + (should (erc-channel-p "&chan")) + (should (erc-channel-p "+chan")) + (should (erc-channel-p "!chan")) + + (with-current-buffer (erc--open-target "#chan") + (should (erc-channel-p (current-buffer)))) + (with-current-buffer (erc--open-target "+chan") + (should (erc-channel-p (current-buffer)))) + (should (erc-channel-p (get-buffer "#chan"))) + (should (erc-channel-p (get-buffer "+chan"))) + + ;; Server sends "CHANTYPES=" because it's query only. + (puthash 'CHANTYPES '("CHANTYPES") erc--isupport-params) + (should-not (erc-channel-p "#spam")) + (should-not (erc-channel-p "&spam")) + (should-not (erc-channel-p (save-excursion (erc--open-target "#spam")))) - (with-current-buffer (get-buffer-create "#chan") - (setq erc--target (erc--target-from-string "#chan"))) - (should (erc-channel-p (get-buffer "#chan")))) - (kill-buffer "#chan")) + (erc-tests-common-kill-buffers)) (ert-deftest erc--valid-local-channel-p () (ert-info ("Local channels not supported") -- cgit v1.2.3 From ecb9641ecb5f42899042ff9c164ec7dbb8e166fe Mon Sep 17 00:00:00 2001 From: Kévin Le Gouguec Date: Sat, 10 Feb 2024 17:37:35 +0100 Subject: Support more complex env invocations in shebang lines This is not an exact re-implementation of what env accepts, but hopefully it should be "good enough". Example of known limitation: we assume that arguments for --long-options will be set with '=', but that is not necessarily the case. '--unset' (mandatory argument) can be passed as '--unset=VAR' or '--unset VAR', but '--default-signal' (optional argument) requires an '=' sign. For bug#64939. * lisp/files.el (auto-mode-interpreter-regexp): Account for supplementary arguments passed beside -S/--split-string. * test/lisp/files-tests.el (files-tests-auto-mode-interpreter): Test some of these combinations. --- lisp/files.el | 8 +++++++- test/lisp/files-tests.el | 8 +++++++- 2 files changed, 14 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/files.el b/lisp/files.el index f67b650cb92..5098d49048e 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3274,7 +3274,13 @@ and `inhibit-local-variables-suffixes'. If ;; Optional group 1: env(1) invocation. "\\(" "[^ \t\n]*/bin/env[ \t]*" - "\\(?:-S[ \t]*\\|--split-string\\(?:=\\|[ \t]*\\)\\)?" + ;; Within group 1: possible -S/--split-string. + "\\(?:" + ;; -S/--split-string + "\\(?:-[0a-z]*S[ \t]*\\|--split-string=\\)" + ;; More env arguments. + "\\(?:-[^ \t\n]+[ \t]+\\)*" + "\\)?" "\\)?" ;; Group 2: interpreter. "\\([^ \t\n]+\\)")) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 23516ff0d7d..0a5c3b897e4 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1687,8 +1687,14 @@ set to." (files-tests--check-shebang "#!/usr/bin/env python" 'python-base-mode) (files-tests--check-shebang "#!/usr/bin/env python3" 'python-base-mode) ;; Invocation through env, with supplementary arguments. + (files-tests--check-shebang "#!/usr/bin/env --split-string=bash -eux" 'sh-base-mode 'bash) + (files-tests--check-shebang "#!/usr/bin/env --split-string=-iv --default-signal bash -eux" 'sh-base-mode 'bash) (files-tests--check-shebang "#!/usr/bin/env -S awk -v FS=\"\\t\" -v OFS=\"\\t\" -f" 'awk-mode) - (files-tests--check-shebang "#!/usr/bin/env -S make -f" 'makefile-mode)) + (files-tests--check-shebang "#!/usr/bin/env -S make -f" 'makefile-mode) + (files-tests--check-shebang "#!/usr/bin/env -S-vi bash -eux" 'sh-base-mode 'bash) + (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal=INT bash -eux" 'sh-base-mode 'bash) + (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal bash -eux" 'sh-base-mode 'bash) + (files-tests--check-shebang "#!/usr/bin/env -vS -uFOOBAR bash -eux" 'sh-base-mode 'bash)) (ert-deftest files-test-dir-locals-auto-mode-alist () "Test an `auto-mode-alist' entry in `.dir-locals.el'" -- cgit v1.2.3 From c64e650fb346d92294703d22f8cd7deb7c47b49e Mon Sep 17 00:00:00 2001 From: Kévin Le Gouguec Date: Sat, 10 Feb 2024 17:56:57 +0100 Subject: Support shebang lines with amended environment For bug#64939. * lisp/files.el (auto-mode-interpreter-regexp): Account for possible VARIABLE=[VALUE] operands. * test/lisp/files-tests.el (files-tests-auto-mode-interpreter): Add an example from the coreutils manual. --- lisp/files.el | 5 ++++- test/lisp/files-tests.el | 4 +++- 2 files changed, 7 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/files.el b/lisp/files.el index 5098d49048e..524385edc84 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3274,12 +3274,15 @@ and `inhibit-local-variables-suffixes'. If ;; Optional group 1: env(1) invocation. "\\(" "[^ \t\n]*/bin/env[ \t]*" - ;; Within group 1: possible -S/--split-string. + ;; Within group 1: possible -S/--split-string and environment + ;; adjustments. "\\(?:" ;; -S/--split-string "\\(?:-[0a-z]*S[ \t]*\\|--split-string=\\)" ;; More env arguments. "\\(?:-[^ \t\n]+[ \t]+\\)*" + ;; Interpreter environment modifications. + "\\(?:[^ \t\n]+=[^ \t\n]*[ \t]+\\)*" "\\)?" "\\)?" ;; Group 2: interpreter. diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 0a5c3b897e4..d4c1ef3ba67 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1694,7 +1694,9 @@ set to." (files-tests--check-shebang "#!/usr/bin/env -S-vi bash -eux" 'sh-base-mode 'bash) (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal=INT bash -eux" 'sh-base-mode 'bash) (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal bash -eux" 'sh-base-mode 'bash) - (files-tests--check-shebang "#!/usr/bin/env -vS -uFOOBAR bash -eux" 'sh-base-mode 'bash)) + (files-tests--check-shebang "#!/usr/bin/env -vS -uFOOBAR bash -eux" 'sh-base-mode 'bash) + ;; Invocation through env, with modified environment. + (files-tests--check-shebang "#!/usr/bin/env -S PYTHONPATH=/...:${PYTHONPATH} python" 'python-base-mode)) (ert-deftest files-test-dir-locals-auto-mode-alist () "Test an `auto-mode-alist' entry in `.dir-locals.el'" -- cgit v1.2.3 From 84e4f1259b54442f52183c1ccee72a417e0a2658 Mon Sep 17 00:00:00 2001 From: john muhl Date: Mon, 12 Feb 2024 18:46:51 -0600 Subject: Eagerly indent first field in tables in 'lua-ts-mode' * lisp/progmodes/lua-ts-mode.el (lua-ts--simple-indent-rules): Properly indent the first field of a table when it appears on a line by itself. (Bug#69088) --- lisp/progmodes/lua-ts-mode.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp') diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index dc2a8fcec1e..c7f5ac50b04 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -317,6 +317,8 @@ values of OVERRIDE." (node-is ")") (node-is "}")) standalone-parent 0) + ((match null "table_constructor") + standalone-parent lua-ts-indent-offset) ((or (and (parent-is "arguments") lua-ts--first-child-matcher) (and (parent-is "parameters") lua-ts--first-child-matcher) (and (parent-is "table_constructor") lua-ts--first-child-matcher)) -- cgit v1.2.3 From 6477be93bd8a29cba8ce383f9ea3fba23c45f225 Mon Sep 17 00:00:00 2001 From: Aleksandr Vityazev Date: Thu, 15 Feb 2024 22:51:24 +0300 Subject: Make key selection method configurable in EPA. * lisp/epa.el (epa-keys-select-method): New defcustom. (epa--select-keys-in-minibuffer): New function. (epa-select-keys): Use new option and function. * etc/NEWS: Announce it. * doc/misc/epa.texi (Key Management): Document it. (Bug#69133) --- doc/misc/epa.texi | 7 +++++++ etc/NEWS | 8 ++++++++ lisp/epa.el | 33 ++++++++++++++++++++++++++++++++- 3 files changed, 47 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi index 27a9e2b0ebb..cd6da1dadba 100644 --- a/doc/misc/epa.texi +++ b/doc/misc/epa.texi @@ -289,6 +289,13 @@ also ask you whether or not to sign the text before encryption and if you answered yes, it will let you select the signing keys. @end deffn +You can change the default method that is used to select keys with the +variable @code{epa-file-select-keys}. + +@defvar epa-keys-select-method +Method used to select keys in @code{epa-select-keys}. +@end defvar + @node Cryptographic operations on files @section Cryptographic Operations on Files @cindex cryptographic operations on files diff --git a/etc/NEWS b/etc/NEWS index 5220a7fb337..4477116248e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1365,6 +1365,14 @@ The new user option 'ielm-history-file-name' is the name of the file where IELM input history will be saved. Customize it to nil to revert to the old behavior of not remembering input history between sessions. +** EasyPG + ++++ +*** New user option 'epa-keys-select-method'. +This allows the user to customize the key selection method, which can be +either by using a pop-up buffer or from the minibuffer. The pop-up +buffer method is the default, which preserves previous behavior. + * New Modes and Packages in Emacs 30.1 diff --git a/lisp/epa.el b/lisp/epa.el index 53da3bf6cce..b2593bc62ba 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -73,6 +73,16 @@ The command `epa-mail-encrypt' uses this." :group 'epa :version "24.4") +(defcustom epa-keys-select-method 'buffer + "Method used to select keys in `epa-select-keys'. +If the value is \\='buffer, the default, keys are selected via a +pop-up buffer. If the value is \\='minibuffer, keys are selected +via the minibuffer instead, using `completing-read-multiple'." + :type '(choice (const :tag "Read keys from a pop-up buffer" buffer) + (const :tag "Read keys from minibuffer" minibuffer)) + :group 'epa + :version "30.1") + ;;; Faces (defgroup epa-faces nil @@ -450,6 +460,25 @@ q trust status questionable. - trust status unspecified. (epa--marked-keys)) (kill-buffer epa-keys-buffer))))) +(defun epa--select-keys-in-minibuffer (prompt keys) + (let* ((prompt (pcase-let ((`(,first ,second ,third) + (string-split prompt "\\.")) + (hint "(separated by comma)")) + (if third + (format "%s %s. %s: " first hint second) + (format "%s %s: " first hint)))) + (keys-alist + (seq-map + (lambda (key) + (cons (substring-no-properties + (epa--button-key-text key)) + key)) + keys)) + (selected-keys (completing-read-multiple prompt keys-alist))) + (seq-map + (lambda (key) (cdr (assoc key keys-alist))) + selected-keys))) + ;;;###autoload (defun epa-select-keys (context prompt &optional names secret) "Display a user's keyring and ask him to select keys. @@ -459,7 +488,9 @@ NAMES is a list of strings to be matched with keys. If it is nil, all the keys are listed. If SECRET is non-nil, list secret keys instead of public keys." (let ((keys (epg-list-keys context names secret))) - (epa--select-keys prompt keys))) + (pcase epa-keys-select-method + ('minibuffer (epa--select-keys-in-minibuffer prompt keys)) + (_ (epa--select-keys prompt keys))))) ;;;; Key Details -- cgit v1.2.3 From d85461ac61c5ea99ea194f99c771de1efdabbef4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 17 Feb 2024 11:31:20 +0200 Subject: ; Fix last change * doc/misc/epa.texi (Cryptographic operations on regions): Fix wording of the 'epa-keys-select-method's documentation. * lisp/epa.el (epa-keys-select-method): Doc fix (bug#69133). --- doc/misc/epa.texi | 10 ++++++---- lisp/epa.el | 3 ++- 2 files changed, 8 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi index cd6da1dadba..f450b9cbdd9 100644 --- a/doc/misc/epa.texi +++ b/doc/misc/epa.texi @@ -289,11 +289,13 @@ also ask you whether or not to sign the text before encryption and if you answered yes, it will let you select the signing keys. @end deffn -You can change the default method that is used to select keys with the -variable @code{epa-file-select-keys}. - @defvar epa-keys-select-method -Method used to select keys in @code{epa-select-keys}. +This variable controls the method used for key selection in +@code{epa-select-keys}. The default value @code{buffer} pops up a +special buffer where you can select the keys. If the value is +@code{minibuffer}, @code{epa-select-keys} will instead prompt for the +keys in the minibuffer, where you should type the keys separated by +commas. @end defvar @node Cryptographic operations on files diff --git a/lisp/epa.el b/lisp/epa.el index b2593bc62ba..c29df18bb58 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -77,7 +77,8 @@ The command `epa-mail-encrypt' uses this." "Method used to select keys in `epa-select-keys'. If the value is \\='buffer, the default, keys are selected via a pop-up buffer. If the value is \\='minibuffer, keys are selected -via the minibuffer instead, using `completing-read-multiple'." +via the minibuffer instead, using `completing-read-multiple'. +Any other value is treated as \\='buffer." :type '(choice (const :tag "Read keys from a pop-up buffer" buffer) (const :tag "Read keys from minibuffer" minibuffer)) :group 'epa -- cgit v1.2.3 From 07a392f445eb21c5e4681027eee9d981300a4309 Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 17 Feb 2024 10:17:41 -0500 Subject: Update to Org 9.6.19 --- doc/misc/org.org | 22 +++++++--------------- etc/refcards/orgcard.tex | 2 +- lisp/org/ol-man.el | 14 ++++++++++++++ lisp/org/ol.el | 5 +---- lisp/org/org-compat.el | 2 +- lisp/org/org-id.el | 12 ++++++------ lisp/org/org-lint.el | 7 +++++-- lisp/org/org-table.el | 8 ++++---- lisp/org/org-tempo.el | 2 +- lisp/org/org-version.el | 4 ++-- lisp/org/org.el | 10 ++++++---- lisp/org/ox-latex.el | 5 +++-- lisp/org/ox-odt.el | 5 +++-- lisp/org/ox.el | 9 ++++----- 14 files changed, 58 insertions(+), 49 deletions(-) (limited to 'lisp') diff --git a/doc/misc/org.org b/doc/misc/org.org index 9535eccc1e6..441985c905f 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -16712,6 +16712,7 @@ to HTML, the following links all point to a dedicated anchor in :END: #+cindex: sitemap, of published pages +#+vindex: org-publish-project-alist The following properties may be used to control publishing of a map of files for a given project. @@ -16729,6 +16730,12 @@ a map of files for a given project. Title of sitemap page. Defaults to name of file. +- ~:sitemap-style~ :: + + Can be ~list~ (site-map is just an itemized list of the titles of + the files involved) or ~tree~ (the directory structure of the + source files is reflected in the site-map). Defaults to ~tree~. + - ~:sitemap-format-entry~ :: #+findex: org-publish-find-date @@ -16774,21 +16781,6 @@ a map of files for a given project. Should sorting be case-sensitive? Default ~nil~. -- ~:sitemap-file-entry-format~ :: - - With this option one can tell how a sitemap's entry is formatted in - the sitemap. This is a format string with some escape sequences: - ~%t~ stands for the title of the file, ~%a~ stands for the author of - the file and ~%d~ stands for the date of the file. The date is - retrieved with the ~org-publish-find-date~ function and formatted - with ~org-publish-sitemap-date-format~. Default ~%t~. - -- ~:sitemap-date-format~ :: - - Format string for the ~format-time-string~ function that tells how - a sitemap entry's date is to be formatted. This property bypasses - ~org-publish-sitemap-date-format~ which defaults to ~%Y-%m-%d~. - *** Generating an index :PROPERTIES: :DESCRIPTION: An index that reaches across pages. diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index 705ab62d69d..e1d40d8632f 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{9.6.15} +\def\orgversionnumber{9.6.19} \def\versionyear{2023} % latest update \input emacsver.tex diff --git a/lisp/org/ol-man.el b/lisp/org/ol-man.el index b6cada1b3c3..d3d7db04700 100644 --- a/lisp/org/ol-man.el +++ b/lisp/org/ol-man.el @@ -39,13 +39,27 @@ :group 'org-link :type '(choice (const man) (const woman))) +(declare-function Man-translate-references "man" (ref)) (defun org-man-open (path _) "Visit the manpage on PATH. PATH should be a topic that can be thrown at the man command. If PATH contains extra ::STRING which will use `occur' to search matched strings in man buffer." + (require 'man) ; For `Man-translate-references' (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?$" path) (let* ((command (match-string 1 path)) + ;; FIXME: Remove after we drop Emacs 29 support. + ;; Working around security bug #66390. + (command (if (not (equal (Man-translate-references ";id") ";id")) + ;; We are on Emacs that escapes man command args + ;; (see Emacs commit 820f0793f0b). + command + ;; Older Emacs without the fix - escape the + ;; arguments ourselves. + (mapconcat 'identity + (mapcar #'shell-quote-argument + (split-string command "\\s-+")) + " "))) (search (match-string 2 path)) (buffer (funcall org-man-command command))) (when search diff --git a/lisp/org/ol.el b/lisp/org/ol.el index 4c84e62f4c9..c3b03087842 100644 --- a/lisp/org/ol.el +++ b/lisp/org/ol.el @@ -291,10 +291,7 @@ or emacs-wiki packages to Org syntax. The function must accept two parameters, a TYPE containing the link protocol name like \"rmail\" or \"gnus\" as a string, and the linked path, which is everything after the link protocol. It should return a cons -with possibly modified values of type and path. -Org contains a function for this, so if you set this variable to -`org-translate-link-from-planner', you should be able follow many -links created by planner." +with possibly modified values of type and path." :group 'org-link-follow :type '(choice (const nil) (function)) :safe #'null) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index 33a510cd7f2..c17a100d3c1 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -664,7 +664,7 @@ You could use brackets to delimit on what part the link will be. %t is the title. %a is the author. -%d is the date formatted using `org-publish-sitemap-date-format'." +%d is the date." :group 'org-export-publish :type 'string) (make-obsolete-variable diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index 9561f2de184..fe7d5f4c1a5 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -29,13 +29,13 @@ ;; are provided that create and retrieve such identifiers, and that find ;; entries based on the identifier. -;; Identifiers consist of a prefix (default "Org" given by the variable +;; Identifiers consist of a prefix (given by the variable ;; `org-id-prefix') and a unique part that can be created by a number -;; of different methods, see the variable `org-id-method'. -;; Org has a builtin method that uses a compact encoding of the creation -;; time of the ID, with microsecond accuracy. This virtually -;; guarantees globally unique identifiers, even if several people are -;; creating IDs at the same time in files that will eventually be used +;; of different methods, see the variable `org-id-method'. Org has a +;; builtin method that uses a compact encoding of the creation time of +;; the ID, with microsecond accuracy. This virtually guarantees +;; globally unique identifiers, even if several people are creating +;; IDs at the same time in files that will eventually be used ;; together. ;; ;; By default Org uses UUIDs as global unique identifiers. diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el index dc12ec272fa..a503de7d364 100644 --- a/lisp/org/org-lint.el +++ b/lisp/org/org-lint.el @@ -1209,8 +1209,11 @@ Use \"export %s\" instead" (`(,(and (pred symbolp) name) ,(pred string-or-null-p) ,(pred string-or-null-p)) - (unless (org-cite-get-processor name) - (list source "Unknown cite export processor %S" name))) + (unless (or (org-cite-get-processor name) + (progn + (org-cite-try-load-processor name) + (org-cite-get-processor name))) + (list source (format "Unknown cite export processor %S" name)))) (_ (list source "Invalid cite export processor declaration"))) (error diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 6408f48ccbd..92490f9f6bf 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -1922,8 +1922,8 @@ However, when N is 0, do not increment the field at all." (let ((org-table-may-need-update nil)) (org-table-next-row)) (org-table-blank-field)) ;; Insert the new field. NEW-FIELD may be nil if - ;; `org-table-increment' is nil, or N = 0. In that case, copy - ;; FIELD. + ;; `org-table-copy-increment' is nil, or N = 0. In that case, + ;; copy FIELD. (insert (or next-field field)) (org-table-maybe-recalculate-line) (org-table-align))) @@ -4084,8 +4084,8 @@ already hidden." "Read column selection select as a list of numbers. SELECT is a string containing column ranges, separated by white -space characters, see `org-table-hide-column' for details. MAX -is the maximum column number. +space characters, see `org-table-toggle-column-width' for details. +MAX is the maximum column number. Return value is a sorted list of numbers. Ignore any number outside of the [1;MAX] range." diff --git a/lisp/org/org-tempo.el b/lisp/org/org-tempo.el index 44b04a9f4be..afa69867f2a 100644 --- a/lisp/org/org-tempo.el +++ b/lisp/org/org-tempo.el @@ -24,7 +24,7 @@ ;;; Commentary: ;; ;; Org Tempo reimplements completions of structure template before -;; point like `org-try-structure-completion' in Org v9.1 and earlier. +;; point in Org v9.1 and earlier. ;; For example, strings like " Date: Sat, 17 Feb 2024 18:53:05 +0200 Subject: Revert "Update to Org 9.6.19" This reverts commit 07a392f445eb21c5e4681027eee9d981300a4309. It was installed by mistake. --- doc/misc/org.org | 22 +++++++++++++++------- etc/refcards/orgcard.tex | 2 +- lisp/org/ol-man.el | 14 -------------- lisp/org/ol.el | 5 ++++- lisp/org/org-compat.el | 2 +- lisp/org/org-id.el | 12 ++++++------ lisp/org/org-lint.el | 7 ++----- lisp/org/org-table.el | 8 ++++---- lisp/org/org-tempo.el | 2 +- lisp/org/org-version.el | 4 ++-- lisp/org/org.el | 10 ++++------ lisp/org/ox-latex.el | 5 ++--- lisp/org/ox-odt.el | 5 ++--- lisp/org/ox.el | 9 +++++---- 14 files changed, 49 insertions(+), 58 deletions(-) (limited to 'lisp') 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: Fri, 2 Feb 2024 20:59:41 +0100 Subject: org: Fix security prompt for downloading remote resource * lisp/org.el (org--confirm-resource-safe): Do not assume that resource is safe when user replies "n" (do not download). Reported-by: Max Nikulin Link: https://orgmode.org/list/upj6uk$b7o$1@ciao.gmane.io --- lisp/org/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/org/org.el b/lisp/org/org.el index 3075729d01d..c75afbf5a67 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -4685,7 +4685,7 @@ returns non-nil if any of them match." (if (and (= char ?f) current-file) (concat "file://" current-file) uri)) "\\'"))))) - (prog1 (memq char '(?y ?n ?! ?d ?\s ?f)) + (prog1 (memq char '(?y ?! ?d ?\s ?f)) (quit-window t))))))) (defun org-extract-log-state-settings (x) -- cgit v1.2.3 From db5e84af202532b138918295ea6dd1b0ea910d78 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sat, 17 Feb 2024 09:31:50 -0800 Subject: Alias some gnus-specific do-nothing functions Replace with #'always and #'ignore * lisp/gnus/gnus-agent.el: `gnus-agent-true' and `gnus-agent-false' * lisp/gnus/gnus-util.el: `gnus-not-ignore' --- lisp/gnus/gnus-agent.el | 13 +++++-------- lisp/gnus/gnus-util.el | 3 +-- 2 files changed, 6 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 3ee93031119..0928b179787 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -2910,13 +2910,9 @@ The following commands are available: (car func) (gnus-byte-compile `(lambda () ,func))))) -(defun gnus-agent-true () - "Return t." - t) +(defalias 'gnus-agent-true #'always) -(defun gnus-agent-false () - "Return nil." - nil) +(defalias 'gnus-agent-false #'ignore) (defun gnus-category-make-function-1 (predicate) "Make a function from PREDICATE." @@ -2924,8 +2920,9 @@ The following commands are available: ;; Functions are just returned as is. ((or (symbolp predicate) (functionp predicate)) - `(,(or (cdr (assq predicate gnus-category-predicate-alist)) - predicate))) + (let ((fun (or (cdr (assq predicate gnus-category-predicate-alist)) + predicate))) + (if (symbolp fun) `(,fun) `(funcall ',fun)))) ;; More complex predicate. ((consp predicate) `(,(cond diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index b5aa0b02d34..7218c686a2a 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1113,8 +1113,7 @@ sure of changing the value of `foo'." (setq gnus-info-buffer (current-buffer)) (gnus-configure-windows 'info))) -(defun gnus-not-ignore (&rest _args) - t) +(defalias gnus-not-ignore #'always) (defvar gnus-directory-sep-char-regexp "/" "The regexp of directory separator character. -- cgit v1.2.3 From 32c5bdfa971220bae37991a298628605c82f866c Mon Sep 17 00:00:00 2001 From: Jakub Ječmínek Date: Sat, 17 Feb 2024 09:34:36 -0800 Subject: Provide better default value for date in Gnus scoring MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Bug#61002, thanks to Kamil Jońca for reporting * lisp/gnus/gnus-score.el (gnus-summary-score-entry): When scoring on Date header, the default value for the prompt should be number of days between the date of the article under point, and "now". --- lisp/gnus/gnus-score.el | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index bd19e7d7cd7..479b7496cf1 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -893,9 +893,14 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header." (t "permanent")) header (if (< score 0) "lower" "raise")) - (if (numberp match) - (int-to-string match) - match)))) + (cond ((numberp match) (int-to-string match)) + ((string= header "date") + (int-to-string + (- + (/ (car (time-convert (current-time) 1)) 86400) + (/ (car (time-convert (gnus-date-get-time match) 1)) + 86400)))) + (t match))))) ;; If this is an integer comparison, we transform from string to int. (if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) -- cgit v1.2.3 From 20997aa20728a6fc2a3de736e9fc718b97dcef99 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sat, 17 Feb 2024 19:20:42 +0100 Subject: ; Fix typo from commit 32c5bdfa971 * lisp/gnus/gnus-util.el (gnus-not-ignore): Quote the argument to defalias. --- lisp/gnus/gnus-util.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 7218c686a2a..0b0a9bbfc1d 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1113,7 +1113,7 @@ sure of changing the value of `foo'." (setq gnus-info-buffer (current-buffer)) (gnus-configure-windows 'info))) -(defalias gnus-not-ignore #'always) +(defalias 'gnus-not-ignore #'always) (defvar gnus-directory-sep-char-regexp "/" "The regexp of directory separator character. -- cgit v1.2.3 From 9e56bd5ed8775f53c3025b114525cee7c578e2d0 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 11 Feb 2024 18:38:13 +0100 Subject: Removed decommissioned PGP keyservers * lisp/epa-ks.el (epa-keyserver): Update the user option type of `epa-keyserver'. See https://mail.gnu.org/archive/html/emacs-devel/2023-11/msg00857.html. --- lisp/epa-ks.el | 3 --- 1 file changed, 3 deletions(-) (limited to 'lisp') diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el index c3c11bb0b0b..13840da0bd9 100644 --- a/lisp/epa-ks.el +++ b/lisp/epa-ks.el @@ -47,11 +47,8 @@ This is used by `epa-search-keys', for looking up public keys." (repeat :tag "Random pool" (string :tag "Keyserver address")) (const "keyring.debian.org") - (const "keys.gnupg.net") (const "keyserver.ubuntu.com") (const "pgp.mit.edu") - (const "pool.sks-keyservers.net") - (const "zimmermann.mayfirst.org") (string :tag "Custom keyserver")) :version "28.1") -- cgit v1.2.3 From 5a64d2c7595dc393504c6eee9321d74dbd8ae9e2 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sat, 17 Feb 2024 22:34:55 +0200 Subject: java-ts-mode: Indentation for opening brace on a separate line * lisp/progmodes/java-ts-mode.el (java-ts-mode--indent-rules): Support putting the opening brace on a separate line (bug#67556). * test/lisp/progmodes/java-ts-mode-resources/indent.erts: Add a test. --- lisp/progmodes/java-ts-mode.el | 13 ++++++--- .../progmodes/java-ts-mode-resources/indent.erts | 31 ++++++++++++++++++++++ 2 files changed, 40 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 52d025e365a..5c4bce340f0 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -74,7 +74,12 @@ ((parent-is "program") column-0 0) ((match "}" "element_value_array_initializer") parent-bol 0) - ((node-is "}") column-0 c-ts-common-statement-offset) + ((node-is + ,(format "\\`%s\\'" + (regexp-opt '("constructor_body" "class_body" "interface_body" + "block" "switch_block" "array_initializer")))) + parent-bol 0) + ((node-is "}") standalone-parent 0) ((node-is ")") parent-bol 0) ((node-is "else") parent-bol 0) ((node-is "]") parent-bol 0) @@ -86,10 +91,10 @@ ((parent-is "array_initializer") parent-bol java-ts-mode-indent-offset) ((parent-is "annotation_type_body") column-0 c-ts-common-statement-offset) ((parent-is "interface_body") column-0 c-ts-common-statement-offset) - ((parent-is "constructor_body") column-0 c-ts-common-statement-offset) + ((parent-is "constructor_body") standalone-parent java-ts-mode-indent-offset) ((parent-is "enum_body_declarations") parent-bol 0) ((parent-is "enum_body") column-0 c-ts-common-statement-offset) - ((parent-is "switch_block") column-0 c-ts-common-statement-offset) + ((parent-is "switch_block") standalone-parent java-ts-mode-indent-offset) ((parent-is "record_declaration_body") column-0 c-ts-common-statement-offset) ((query "(method_declaration (block _ @indent))") parent-bol java-ts-mode-indent-offset) ((query "(method_declaration (block (_) @indent))") parent-bol java-ts-mode-indent-offset) @@ -125,7 +130,7 @@ ((parent-is "case_statement") parent-bol java-ts-mode-indent-offset) ((parent-is "labeled_statement") parent-bol java-ts-mode-indent-offset) ((parent-is "do_statement") parent-bol java-ts-mode-indent-offset) - ((parent-is "block") column-0 c-ts-common-statement-offset))) + ((parent-is "block") standalone-parent java-ts-mode-indent-offset))) "Tree-sitter indent rules.") (defvar java-ts-mode--keywords diff --git a/test/lisp/progmodes/java-ts-mode-resources/indent.erts b/test/lisp/progmodes/java-ts-mode-resources/indent.erts index 4fca74dd2e1..514d2e08977 100644 --- a/test/lisp/progmodes/java-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/java-ts-mode-resources/indent.erts @@ -110,3 +110,34 @@ public class Java { } } =-=-= + +Name: Opening bracket on separate line (bug#67556) + +=-= +public class Java { + void foo( + String foo) + { + for (var f : rs) + return new String[] + { + "foo", + "bar" + }; + if (a == 0) + { + return 0; + } else if (a == 1) + { + return 1; + } + + switch(expr) + { + case x: + // code block + break; + } + } +} +=-=-= -- cgit v1.2.3 From 24e8fceb960e0b3b7e270211bd7f460c4c871008 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 18 Feb 2024 20:03:53 +0100 Subject: Fix typo in 'cl--type-hierarchy' * lisp/emacs-lisp/cl-preloaded.el (cl--type-hierarchy): Fix typo. * doc/lispref/type_hierarchy.txt: Regenerate. * doc/lispref/type_hierarchy.jpg: Likewise. --- doc/lispref/type_hierarchy.jpg | Bin 217746 -> 217931 bytes doc/lispref/type_hierarchy.txt | 2 +- lisp/emacs-lisp/cl-preloaded.el | 2 +- 3 files changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/type_hierarchy.jpg b/doc/lispref/type_hierarchy.jpg index 0b551b5f01e..72996897165 100644 Binary files a/doc/lispref/type_hierarchy.jpg and b/doc/lispref/type_hierarchy.jpg differ diff --git a/doc/lispref/type_hierarchy.txt b/doc/lispref/type_hierarchy.txt index c6e762b04a8..2ffee0b6a85 100644 --- a/doc/lispref/type_hierarchy.txt +++ b/doc/lispref/type_hierarchy.txt @@ -5,7 +5,7 @@ | v +-------------+ +--------------------+ +----------------------+ +--------+ - | fixum | --> | integer | --> | integer-or-marker | <-- | marker | + | fixnum | --> | integer | --> | integer-or-marker | <-- | marker | +-------------+ +--------------------+ +----------------------+ +--------+ | | | | | | diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 323d826f323..0b30e10b344 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -65,7 +65,7 @@ number-or-marker symbol array) (number float integer) (number-or-marker marker number) - (integer bignum fixum) + (integer bignum fixnum) (symbol keyword boolean symbol-with-pos) (array vector bool-vector char-table string) (list null cons) -- cgit v1.2.3 From f6743099cc907f1f2847f028ff8f3712288c559f Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sun, 18 Feb 2024 18:08:51 -0800 Subject: Back out part of commit db5e84af202 * lisp/gnus/gnus-agent.el (gnus-category-make-function-1): This code is untested and was not meant to be part of the earlier commit. --- lisp/gnus/gnus-agent.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 0928b179787..1726b806913 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -2920,9 +2920,8 @@ The following commands are available: ;; Functions are just returned as is. ((or (symbolp predicate) (functionp predicate)) - (let ((fun (or (cdr (assq predicate gnus-category-predicate-alist)) - predicate))) - (if (symbolp fun) `(,fun) `(funcall ',fun)))) + `(,(or (cdr (assq predicate gnus-category-predicate-alist)) + predicate))) ;; More complex predicate. ((consp predicate) `(,(cond -- cgit v1.2.3 From 8f260bb93f534b24d9a93d3315804ffe0c1fec4f Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sun, 18 Feb 2024 21:39:31 -0800 Subject: Don't update ranges for the whole buffer in treesit--pre-redisplay * lisp/treesit.el (treesit--pre-redisplay): Only update two screen-full of text around point. --- lisp/treesit.el | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index f811b8090bc..fa82ad898a9 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1382,7 +1382,15 @@ as comment due to incomplete parse tree." ;; `treesit-update-ranges' will force the host language's parser to ;; reparse and set correct ranges for embedded parsers. Then ;; `treesit-parser-root-node' will force those parsers to reparse. - (treesit-update-ranges) + (let ((len (+ (* (window-body-height) (window-body-width)) 800))) + ;; FIXME: As a temporary fix, this prevents Emacs from updating + ;; every single local parsers in the buffer every time there's an + ;; edit. Moving forward, we need some way to properly track the + ;; regions which need update on parser ranges, like what jit-lock + ;; and syntax-ppss does. + (treesit-update-ranges + (max (point-min) (- (point) len)) + (min (point-max) (+ (point) len)))) ;; Force repase on _all_ the parsers might not be necessary, but ;; this is probably the most robust way. (dolist (parser (treesit-parser-list)) -- cgit v1.2.3 From ddfba511c190e5bb44e44a50aef5ab8c08e3d798 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 19 Feb 2024 10:27:02 +0100 Subject: Check shortdoc keywords and fix one mistake * lisp/emacs-lisp/shortdoc.el (shortdoc--check) (define-short-documentation-group): Check that used keywords exist. * lisp/emacs-lisp/shortdoc.el (list): Fix a typo. --- lisp/emacs-lisp/shortdoc.el | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index a6a49c72f74..cde28985cd0 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -50,6 +50,17 @@ '((t :inherit variable-pitch)) "Face used for a section.") +;;;###autoload +(defun shortdoc--check (group functions) + (let ((keywords '( :no-manual :args :eval :no-eval :no-value :no-eval* + :result :result-string :eg-result :eg-result-string :doc))) + (dolist (f functions) + (when (consp f) + (dolist (x f) + (when (and (keywordp x) (not (memq x keywords))) + (error "Shortdoc %s function `%s': bad keyword `%s'" + group (car f) x))))))) + ;;;###autoload (progn (defvar shortdoc--groups nil) @@ -118,6 +129,7 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), `:no-eval*', `:result', `:result-string', `:eg-result' and `:eg-result-string' properties." (declare (indent defun)) + (shortdoc--check group functions) `(progn (setq shortdoc--groups (delq (assq ',group shortdoc--groups) shortdoc--groups)) @@ -715,7 +727,7 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (plist-get '(a 1 b 2 c 3) 'b)) (plist-put :no-eval (setq plist (plist-put plist 'd 4)) - :eq-result (a 1 b 2 c 3 d 4)) + :eg-result (a 1 b 2 c 3 d 4)) (plist-member :eval (plist-member '(a 1 b 2 c 3) 'b)) "Data About Lists" -- cgit v1.2.3 From 6893106fe9302b1be68dd04034441799e6d29b68 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Thu, 15 Feb 2024 12:10:12 +0100 Subject: Allow attaching files at point using 'gnus-dired-attach' * lisp/gnus/gnus-dired.el (gnus-dired-attach-at-end): Add option. (gnus-dired-attach): Respect it. * doc/misc/gnus.texi (Other modes): Document it. (Bug#69141) --- doc/misc/gnus.texi | 5 ++++- lisp/gnus/gnus-dired.el | 9 ++++++++- 2 files changed, 12 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 2f8f97e5845..98196310b5c 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -26695,9 +26695,12 @@ buffers. It is enabled with @table @kbd @item C-c C-m C-a @findex gnus-dired-attach +@vindex gnus-dired-attach-at-end @cindex attachments, selection via dired Send dired's marked files as an attachment (@code{gnus-dired-attach}). -You will be prompted for a message buffer. +You will be prompted for a message buffer. By default it will attach +files to the end of the message buffer, but you can modify that +behaviour by customising @code{gnus-dired-attach-at-end}. @item C-c C-m C-l @findex gnus-dired-find-file-mailcap diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index 48c1aef968b..f33c5f7f2e5 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -111,6 +111,12 @@ See `mail-user-agent' for more information." (autoload 'gnus-completing-read "gnus-util") +(defcustom gnus-dired-attach-at-end t + "Non-nil means that files should be attached at the end of a buffer." + :group 'mail ;; dired? + :version "30.1" + :type 'boolean) + ;; Method to attach files to a mail composition. (defun gnus-dired-attach (files-to-attach) "Attach dired's marked files to a gnus message composition. @@ -161,7 +167,8 @@ filenames." ;; set buffer to destination buffer, and attach files (set-buffer destination) - (goto-char (point-max)) ;attach at end of buffer + (when gnus-dired-attach-at-end + (goto-char (point-max))) ;attach at end of buffer (while files-to-attach (mml-attach-file (car files-to-attach) (or (mm-default-file-type (car files-to-attach)) -- cgit v1.2.3 From 4e9993cada32a866a75b458092de0028db2f5f41 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 20 Feb 2024 12:52:40 +0100 Subject: Add Tramp methods dockercp and podmancp * doc/misc/tramp.texi (External methods): Add dockercp and podmancp. * etc/NEWS: Add Tramp methods "dockercp" and "podmancp". * lisp/net/tramp.el (tramp-handle-make-process): * lisp/net/tramp-adb.el (tramp-adb-maybe-open-connection): * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band) (tramp-maybe-open-connection): * lisp/net/tramp-sshfs.el (tramp-sshfs-handle-process-file) (tramp-sshfs-maybe-open-connection): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-send-command): Adapt `tramp-expand-args' calls. * lisp/net/tramp-container.el (tramp-dockercp-method) (tramp-podmancp-method): New defconst. (tramp-methods) : Add new methods. (tramp-container--completion-function): Adapt docstring. Use it for "dockercp" and "podmancp" completion. * lisp/net/tramp.el (tramp-get-remote-tmpdir): * lisp/net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection): * lisp/net/tramp-sh.el (tramp-maybe-open-connection): Use a default value with `tramp-get-method-parameter'. * lisp/net/tramp-sh.el (tramp-methods) : Add `tramp-copy-file-name'. (tramp-default-copy-file-name): New defconst. (tramp-make-copy-file-name): Rename from `tramp-make-copy-program-file-name'. Use method parameter `tramp-copy-file-name'. (Bug#69085) (tramp-do-copy-or-rename-file-out-of-band): Adapt callees. * lisp/net/tramp.el (tramp-methods): Adapt docstring. (tramp-get-method-parameter, tramp-expand-args): New optional argument DEFAULT. * test/lisp/net/tramp-tests.el (tramp--test-container-p): Adapt. (tramp--test-container-oob-p): New defun. (tramp-test17-dired-with-wildcards, tramp-test35-remote-path) (tramp-test41-special-characters): Use it. (tramp--test-set-ert-test-documentation): Use `split-string'. --- doc/misc/tramp.texi | 14 ++++++++ etc/NEWS | 12 ++++--- lisp/net/tramp-adb.el | 2 +- lisp/net/tramp-container.el | 60 ++++++++++++++++++++++++++++++- lisp/net/tramp-gvfs.el | 4 +-- lisp/net/tramp-sh.el | 38 +++++++++++--------- lisp/net/tramp-sshfs.el | 4 +-- lisp/net/tramp-sudoedit.el | 2 +- lisp/net/tramp.el | 35 ++++++++++++------ test/lisp/net/tramp-tests.el | 85 ++++++++++++++++++++++++++------------------ 10 files changed, 182 insertions(+), 74 deletions(-) (limited to 'lisp') diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index affd760730b..6d4654f1a8a 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1059,6 +1059,20 @@ session. These methods support the @samp{-P} argument. +@item @option{dockercp} +@item @option{podmancp} +@cindex method @option{dockercp} +@cindex @option{dockercp} method +@cindex method @option{podmancp} +@cindex @option{podmancp} method + +These methods are similar to @option{docker} or @option{podman}, but +they use the command @command{docker cp} or @command{podman cp} for +transferring large files. + +These copy commands do not support file globs, and they ignore a user +name. + @item @option{fcp} @cindex method @option{fcp} @cindex @option{fcp} method diff --git a/etc/NEWS b/etc/NEWS index 4477116248e..7b248c3fe78 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -884,6 +884,10 @@ mode line. 'header' will display in the header line; ** Tramp ++++ +*** New connection methods "dockercp" and "podmancp". +These are the external methods counterparts of "docker" and "podman". + +++ *** New connection methods "toolbox" and "flatpak". They allow accessing system containers provided by Toolbox or @@ -1121,7 +1125,7 @@ the user option 'nnweb-type' to 'gmane'. *** New user option 'gnus-mode-line-logo'. This allows the user to either disable the display of any logo or specify which logo will be displayed as part of the -buffer-identification in the mode-line of Gnus-buffers. +buffer-identification in the mode-line of Gnus buffers. ** Rmail @@ -1333,7 +1337,7 @@ chat buffers use by default. This command toggles the display of internal buffers in Buffer Menu mode; that is, buffers not visiting a file and whose names start with a space. Previously, such buffers were never shown. This command is bound to 'I' -in Buffer menu mode. +in Buffer Menu mode. ** Customize @@ -1429,7 +1433,7 @@ current project configuration, and later updates it as you edit the files and save the changes. +++ -** New package Compat +** New package Compat. Emacs now comes with a stub implementation of the forwards-compatibility Compat package from GNU ELPA. This allows built-in packages to use the library more effectively, and helps @@ -1560,7 +1564,7 @@ values. +++ ** Pcase's functions (in 'pred' and 'app') can specify the argument position. -For example, instead of (pred (< 5)) you can write (pred (> _ 5)). +For example, instead of '(pred (< 5))' you can write '(pred (> _ 5))'. +++ ** 'define-advice' now sets the new advice's 'name' property to NAME. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 2e4ad1cc412..96625fc5680 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -1230,7 +1230,7 @@ connection if a previous connection has died for some reason." (let* ((coding-system-for-read 'utf-8-dos) ; Is this correct? (process-connection-type tramp-process-connection-type) (args (tramp-expand-args - vec 'tramp-login-args ?d (or device ""))) + vec 'tramp-login-args nil ?d (or device ""))) (p (let ((default-directory tramp-compat-temporary-file-directory)) (apply diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index 1f578949e4d..30639cbeb85 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -31,15 +31,20 @@ ;; Open a file on a running Docker container: ;; ;; C-x C-f /docker:USER@CONTAINER:/path/to/file +;; C-x C-f /dockercp:USER@CONTAINER:/path/to/file ;; ;; or Podman: ;; ;; C-x C-f /podman:USER@CONTAINER:/path/to/file +;; C-x C-f /podmancp:USER@CONTAINER:/path/to/file ;; ;; Where: ;; USER is the user on the container to connect as (optional). ;; CONTAINER is the container to connect to. ;; +;; "docker" and "podman" are inline methods, "dockercp" and "podmancp" +;; are out-of-band methods. +;; ;; ;; ;; Open file in a Kubernetes container: @@ -141,10 +146,20 @@ If it is nil, the default context will be used." (defconst tramp-docker-method "docker" "Tramp method name to use to connect to Docker containers.") +;;;###tramp-autoload +(defconst tramp-dockercp-method "dockercp" + "Tramp method name to use to connect to Docker containers. +This is for out-of-band connections.") + ;;;###tramp-autoload (defconst tramp-podman-method "podman" "Tramp method name to use to connect to Podman containers.") +;;;###tramp-autoload +(defconst tramp-podmancp-method "podmancp" + "Tramp method name to use to connect to Podman containers. +This is for out-of-band connections.") + ;;;###tramp-autoload (defconst tramp-kubernetes-method "kubernetes" "Tramp method name to use to connect to Kubernetes containers.") @@ -183,7 +198,8 @@ BODY is the backend specific code." (defun tramp-container--completion-function (method) "List running containers available for connection. METHOD is the Tramp method to be used for \"ps\", either -`tramp-docker-method' or `tramp-podman-method'. +`tramp-docker-method', `tramp-dockercp-method', `tramp-podman-method', +or `tramp-podmancp-method'. This function is used by `tramp-set-completion-function', please see its function help for a description of the format." @@ -375,6 +391,23 @@ see its function help for a description of the format." (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-i" "-c")))) + (add-to-list 'tramp-methods + `(,tramp-dockercp-method + (tramp-login-program ,tramp-docker-program) + (tramp-login-args (("exec") + ("-it") + ("-u" "%u") + ("%h") + ("%l"))) + (tramp-direct-async (,tramp-default-remote-shell "-c")) + (tramp-remote-shell ,tramp-default-remote-shell) + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-i" "-c")) + (tramp-copy-program ,tramp-docker-program) + (tramp-copy-args (("cp"))) + (tramp-copy-file-name (("%h" ":") ("%f"))) + (tramp-copy-recursive t))) + (add-to-list 'tramp-methods `(,tramp-podman-method (tramp-login-program ,tramp-podman-program) @@ -388,6 +421,23 @@ see its function help for a description of the format." (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-i" "-c")))) + (add-to-list 'tramp-methods + `(,tramp-podmancp-method + (tramp-login-program ,tramp-podman-program) + (tramp-login-args (("exec") + ("-it") + ("-u" "%u") + ("%h") + ("%l"))) + (tramp-direct-async (,tramp-default-remote-shell "-c")) + (tramp-remote-shell ,tramp-default-remote-shell) + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-i" "-c")) + (tramp-copy-program ,tramp-podman-program) + (tramp-copy-args (("cp"))) + (tramp-copy-file-name (("%h" ":") ("%f"))) + (tramp-copy-recursive t))) + (add-to-list 'tramp-methods `(,tramp-kubernetes-method (tramp-login-program ,tramp-kubernetes-program) @@ -431,10 +481,18 @@ see its function help for a description of the format." tramp-docker-method `((tramp-container--completion-function ,tramp-docker-method))) + (tramp-set-completion-function + tramp-dockercp-method + `((tramp-container--completion-function ,tramp-dockercp-method))) + (tramp-set-completion-function tramp-podman-method `((tramp-container--completion-function ,tramp-podman-method))) + (tramp-set-completion-function + tramp-podmancp-method + `((tramp-container--completion-function ,tramp-podmancp-method))) + (tramp-set-completion-function tramp-kubernetes-method `((tramp-kubernetes--completion-function ,tramp-kubernetes-method))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 4e949e7e60b..93071ed7350 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -2294,8 +2294,8 @@ connection if a previous connection has died for some reason." ;; indicated by the "mounted" signal, i.e. the ;; "fuse-mountpoint" file property. (with-timeout - ((or (tramp-get-method-parameter vec 'tramp-connection-timeout) - tramp-connection-timeout) + ((tramp-get-method-parameter + vec 'tramp-connection-timeout tramp-connection-timeout) (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec)) (tramp-error vec 'file-error diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 3557b3a1b64..66e648624b2 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -282,6 +282,7 @@ The string is used in `tramp-methods'.") (tramp-copy-program "nc") ;; We use "-v" for better error tracking. (tramp-copy-args (("-w" "1") ("-v") ("%h") ("%r"))) + (tramp-copy-file-name (("%f"))) (tramp-remote-copy-program "nc") ;; We use "-p" as required for newer busyboxes. For older ;; busybox/nc versions, the value must be (("-l") ("%r")). This @@ -428,6 +429,9 @@ The string is used in `tramp-methods'.") eos) nil ,(user-login-name)))) +(defconst tramp-default-copy-file-name '(("%u" "@") ("%h" ":") ("%f")) + "Default `tramp-copy-file-name' entry for out-of-band methods.") + ;;;###tramp-autoload (defconst tramp-completion-function-alist-rsh '((tramp-parse-rhosts "/etc/hosts.equiv") @@ -2399,10 +2403,10 @@ The method used must be an out-of-band method." #'file-name-as-directory #'identity) (if v1 - (tramp-make-copy-program-file-name v1) + (tramp-make-copy-file-name v1) (file-name-unquote filename))) target (if v2 - (tramp-make-copy-program-file-name v2) + (tramp-make-copy-file-name v2) (file-name-unquote newname))) ;; Check for listener port. @@ -2441,7 +2445,7 @@ The method used must be an out-of-band method." ;; " " has either been a replacement of "%k" (when ;; KEEP-DATE argument is non-nil), or a replacement for ;; the whole keep-date sublist. - (delete " " (apply #'tramp-expand-args v 'tramp-copy-args spec)) + (delete " " (apply #'tramp-expand-args v 'tramp-copy-args nil spec)) ;; `tramp-ssh-controlmaster-options' is a string instead ;; of a list. Unflatten it. copy-args @@ -2450,11 +2454,11 @@ The method used must be an out-of-band method." (lambda (x) (if (tramp-compat-string-search " " x) (split-string x) x)) copy-args)) - copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec) + copy-env (apply #'tramp-expand-args v 'tramp-copy-env nil spec) remote-copy-program (tramp-get-method-parameter v 'tramp-remote-copy-program) remote-copy-args - (apply #'tramp-expand-args v 'tramp-remote-copy-args spec)) + (apply #'tramp-expand-args v 'tramp-remote-copy-args nil spec)) ;; Check for local copy program. (unless (executable-find copy-program) @@ -5290,7 +5294,8 @@ connection if a previous connection has died for some reason." (tramp-get-method-parameter hop 'tramp-async-args))) (connection-timeout (tramp-get-method-parameter - hop 'tramp-connection-timeout)) + hop 'tramp-connection-timeout + tramp-connection-timeout)) (command (tramp-get-method-parameter hop 'tramp-login-program)) @@ -5348,7 +5353,7 @@ connection if a previous connection has died for some reason." ;; Add arguments for asynchronous processes. (when process-name async-args) (tramp-expand-args - hop 'tramp-login-args + hop 'tramp-login-args nil ?h (or l-host "") ?u (or l-user "") ?p (or l-port "") ?c (format-spec options (format-spec-make ?t tmpfile)) ?n (concat @@ -5365,8 +5370,7 @@ connection if a previous connection has died for some reason." p vec (min pos (with-current-buffer (process-buffer p) (point-max))) - tramp-actions-before-shell - (or connection-timeout tramp-connection-timeout)) + tramp-actions-before-shell connection-timeout) (tramp-message vec 3 "Found remote shell prompt on `%s'" l-host) @@ -5559,8 +5563,8 @@ raises an error." string "")) -(defun tramp-make-copy-program-file-name (vec) - "Create a file name suitable for `scp', `pscp', or `nc' and workalikes." +(defun tramp-make-copy-file-name (vec) + "Create a file name suitable for out-of-band methods." (let ((method (tramp-file-name-method vec)) (user (tramp-file-name-user vec)) (host (tramp-file-name-host vec)) @@ -5571,13 +5575,13 @@ raises an error." ;; This does not work for MS Windows scp, if there are characters ;; to be quoted. OpenSSH 8 supports disabling of strict file name ;; checking in scp, we use it when available. - (unless (string-match-p (rx "ftp" eos) method) + (unless (string-match-p (rx (| "dockercp" "podmancp" "ftp") eos) method) (setq localname (tramp-unquote-shell-quote-argument localname))) - (cond - ((tramp-get-method-parameter vec 'tramp-remote-copy-program) - localname) - ((tramp-string-empty-or-nil-p user) (format "%s:%s" host localname)) - (t (format "%s@%s:%s" user host localname))))) + (string-join + (apply #'tramp-expand-args vec + 'tramp-copy-file-name tramp-default-copy-file-name + (list ?h (or host "") ?u (or user "") ?f localname)) + ""))) (defun tramp-method-out-of-band-p (vec size) "Return t if this is an out-of-band method, nil otherwise." diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 8dad599c7e7..d0d56b8967e 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -322,7 +322,7 @@ arguments to pass to the OPERATION." v (tramp-get-method-parameter v 'tramp-login-program) nil outbuf display (tramp-expand-args - v 'tramp-login-args + v 'tramp-login-args nil ?h (or (tramp-file-name-host v) "") ?u (or (tramp-file-name-user v) "") ?p (or (tramp-file-name-port v) "") @@ -424,7 +424,7 @@ connection if a previous connection has died for some reason." (tramp-fuse-mount-spec vec) (tramp-fuse-mount-point vec) (tramp-expand-args - vec 'tramp-mount-args + vec 'tramp-mount-args nil ?p (or (tramp-file-name-port vec) "")))))) (tramp-error vec 'file-error "Error mounting %s" (tramp-fuse-mount-spec vec))) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 0c717c4a5aa..7bbfec62753 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -771,7 +771,7 @@ in case of error, t otherwise." (tramp-get-connection-name vec) (current-buffer) (append (tramp-expand-args - vec 'tramp-sudo-login + vec 'tramp-sudo-login nil ?h (or (tramp-file-name-host vec) "") ?u (or (tramp-file-name-user vec) "")) (flatten-tree args)))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 2efee2344d2..e6d6eb0ee66 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -301,6 +301,15 @@ pair of the form (KEY VALUE). The following KEYs are defined: This specifies the list of parameters to pass to the above mentioned program, the hints for `tramp-login-args' also apply here. + * `tramp-copy-file-name' + The remote source or destination file name for out-of-band methods. + You can use \"%u\" and \"%h\" like in `tramp-login-args'. + Additionally, \"%f\" denotes the local file name part. This list + will be expanded to a string without spaces between the elements of + the list. + + The default value is `tramp-default-copy-file-name'. + * `tramp-copy-env' A list of environment variables and their values, which will be set when calling `tramp-copy-program'. @@ -1545,21 +1554,23 @@ LOCALNAME and HOP do not count." (equal (tramp-file-name-unify vec1) (tramp-file-name-unify vec2)))) -(defun tramp-get-method-parameter (vec param) +(defun tramp-get-method-parameter (vec param &optional default) "Return the method parameter PARAM. If VEC is a vector, check first in connection properties. Afterwards, check in `tramp-methods'. If the `tramp-methods' -entry does not exist, return nil." +entry does not exist, return DEFAULT." (let ((hash-entry (replace-regexp-in-string (rx bos "tramp-") "" (symbol-name param)))) (if (tramp-connection-property-p vec hash-entry) ;; We use the cached property. (tramp-get-connection-property vec hash-entry) ;; Use the static value from `tramp-methods'. - (when-let ((methods-entry + (if-let ((methods-entry (assoc param (assoc (tramp-file-name-method vec) tramp-methods)))) - (cadr methods-entry))))) + (cadr methods-entry) + ;; Return the default value. + default)))) ;; The localname can be quoted with "/:". Extract this. (defun tramp-file-name-unquote-localname (vec) @@ -3943,6 +3954,9 @@ Let-bind it when necessary.") (tramp-get-method-parameter v 'tramp-case-insensitive) ;; There isn't. So we must check, in case there's a connection already. + ;; Note: We cannot use it as DEFAULT value of + ;; `tramp-get-method-parameter', because it would be evalled + ;; during the call. (and (let ((non-essential t)) (tramp-connectable-p v)) (with-tramp-connection-property v "case-insensitive" (ignore-errors @@ -4752,15 +4766,15 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (defvar tramp-extra-expand-args nil "Method specific arguments.") -(defun tramp-expand-args (vec parameter &rest spec-list) +(defun tramp-expand-args (vec parameter default &rest spec-list) "Expand login arguments as given by PARAMETER in `tramp-methods'. PARAMETER is a symbol like `tramp-login-args', denoting a list of list of strings from `tramp-methods', containing %-sequences for -substitution. +substitution. DEFAULT is used when PARAMETER is not specified. SPEC-LIST is a list of char/value pairs used for `format-spec-make'. It is appended by `tramp-extra-expand-args', a connection-local variable." - (let ((args (tramp-get-method-parameter vec parameter)) + (let ((args (tramp-get-method-parameter vec parameter default)) (extra-spec-list (mapcar #'eval @@ -4939,7 +4953,7 @@ a connection-local variable." (mapcar (lambda (x) (split-string x " ")) (tramp-expand-args - v 'tramp-login-args + v 'tramp-login-args nil ?h (or host "") ?u (or user "") ?p (or port "") ?c (format-spec (or options "") (format-spec-make ?t tmpfile)) ?d (or device "") ?a (or pta "") ?l "")))) @@ -6326,9 +6340,8 @@ This handles also chrooted environments, which are not regarded as local." (defun tramp-get-remote-tmpdir (vec) "Return directory for temporary files on the remote host identified by VEC." (with-tramp-connection-property (tramp-get-process vec) "remote-tmpdir" - (let ((dir - (tramp-make-tramp-file-name - vec (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp")))) + (let ((dir (tramp-make-tramp-file-name + vec (tramp-get-method-parameter vec 'tramp-tmpdir "/tmp")))) (or (and (file-directory-p dir) (file-writable-p dir) (tramp-file-local-name dir)) (tramp-error vec 'file-error "Directory %s not accessible" dir)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 623e0860a01..cdd2a1efdb2 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3493,6 +3493,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (skip-unless (not (tramp--test-rsync-p))) ;; Wildcards are not supported in tramp-crypt.el. (skip-unless (not (tramp--test-crypt-p))) + ;; Wildcards are not supported with "docker cp ..." or "podman cp ...". + (skip-unless (not (tramp--test-container-oob-p))) (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let* ((tmp-name1 @@ -3819,7 +3821,7 @@ This tests also `access-file', `file-readable-p', "Set the documentation string for a derived test. The test is derived from TEST and COMMAND." (let ((test-doc - (string-split (ert-test-documentation (get test 'ert--test)) "\n"))) + (split-string (ert-test-documentation (get test 'ert--test)) "\n"))) ;; The first line must be extended. (setcar test-doc (format "%s Use the \"%s\" command." (car test-doc) command)) @@ -6379,33 +6381,35 @@ INPUT, if non-nil, is a string sent to the process." (setq tramp-remote-path orig-tramp-remote-path) ;; We make a super long `tramp-remote-path'. - (make-directory tmp-name) - (should (file-directory-p tmp-name)) - (while (tramp-compat-length< (string-join orig-exec-path ":") 5000) - (let ((dir (make-temp-file (file-name-as-directory tmp-name) 'dir))) - (should (file-directory-p dir)) - (setq tramp-remote-path - (append - tramp-remote-path `(,(file-remote-p dir 'localname))) - orig-exec-path - (append - (butlast orig-exec-path) - `(,(file-remote-p dir 'localname)) - (last orig-exec-path))))) - (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) - (should (equal (exec-path) orig-exec-path)) - ;; Ignore trailing newline. - (setq path (substring (shell-command-to-string "echo $PATH") nil -1)) - ;; The shell doesn't handle such long strings. - (unless (tramp-compat-length> - path - (tramp-get-connection-property - tramp-test-vec "pipe-buf" 4096)) - ;; The last element of `exec-path' is `exec-directory'. - (should - (string-equal path (string-join (butlast orig-exec-path) ":")))) - ;; The shell "sh" shall always exist. - (should (executable-find "sh" 'remote))) + (unless (tramp--test-container-oob-p) + (make-directory tmp-name) + (should (file-directory-p tmp-name)) + (while (tramp-compat-length< (string-join orig-exec-path ":") 5000) + (let ((dir (make-temp-file + (file-name-as-directory tmp-name) 'dir))) + (should (file-directory-p dir)) + (setq tramp-remote-path + (append + tramp-remote-path `(,(file-remote-p dir 'localname))) + orig-exec-path + (append + (butlast orig-exec-path) + `(,(file-remote-p dir 'localname)) + (last orig-exec-path))))) + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) + (should (equal (exec-path) orig-exec-path)) + ;; Ignore trailing newline. + (setq path (substring (shell-command-to-string "echo $PATH") nil -1)) + ;; The shell doesn't handle such long strings. + (unless (tramp-compat-length> + path + (tramp-get-connection-property + tramp-test-vec "pipe-buf" 4096)) + ;; The last element of `exec-path' is `exec-directory'. + (should + (string-equal path (string-join (butlast orig-exec-path) ":")))) + ;; The shell "sh" shall always exist. + (should (executable-find "sh" 'remote)))) ;; Cleanup. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) @@ -7056,17 +7060,24 @@ This is used in tests which we don't want to tag (not (and (tramp--test-adb-p) (string-match-p (rx multibyte) default-directory))))) -(defun tramp--test-crypt-p () - "Check, whether the remote directory is encrypted." - (tramp-crypt-file-name-p ert-remote-temporary-file-directory)) - (defun tramp--test-container-p () "Check, whether a container method is used. This does not support some special file names." (string-match-p - (rx bol (| "docker" "podman") eol) + (rx bol (| "docker" "podman")) (file-remote-p ert-remote-temporary-file-directory 'method))) +(defun tramp--test-container-oob-p () + "Check, whether the dockercp or podmancp method is used. +They does not support wildcard copy." + (string-match-p + (rx bol (| "dockercp" "podmancp") eol) + (file-remote-p ert-remote-temporary-file-directory 'method))) + +(defun tramp--test-crypt-p () + "Check, whether the remote directory is encrypted." + (tramp-crypt-file-name-p ert-remote-temporary-file-directory)) + (defun tramp--test-expensive-test-p () "Whether expensive tests are run. This is used in tests which we don't want to tag `:expensive' @@ -7483,7 +7494,8 @@ This requires restrictions of file name syntax." (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) "?foo?bar?baz?") - (unless (or (tramp--test-ftp-p) + (unless (or (tramp--test-container-oob-p) + (tramp--test-ftp-p) (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) "*foo+bar*baz+") @@ -7503,7 +7515,10 @@ This requires restrictions of file name syntax." (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) "bar") "(foo)bar(baz)" - (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]") + (unless (or (tramp--test-container-oob-p) + (tramp--test-ftp-p) + (tramp--test-gvfs-p)) + "[foo]bar[baz]") "{foo}bar{baz}"))) ;; Simplify test in order to speed up. (apply #'tramp--test-check-files -- cgit v1.2.3 From d5775ae4d3ac8a1a4d2625e05307c9296df28d6f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 20 Feb 2024 12:53:15 +0100 Subject: ; Copyedits --- lisp/net/tramp-compat.el | 2 ++ lisp/net/tramp-integration.el | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 061766090a0..98de0dba7ff 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -337,6 +337,8 @@ Also see `ignore'." ;; ;; * Starting with Emacs 29.1, use `buffer-match-p'. ;; +;; * Starting with Emacs 29.1, use `string-split'. +;; ;; * Starting with Emacs 30.1, there is `handler-bind'. Use it ;; instead of `condition-case' when the origin of an error shall be ;; kept, for example when the HANDLER propagates the error with diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index c0b60f57e40..e1f0b2a3495 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -69,7 +69,7 @@ special handling of `substitute-in-file-name'." (when minibuffer-completing-file-name (setq tramp-rfn-eshadow-overlay (make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end))) - ;; Copy rfn-eshadow-overlay properties. + ;; Copy `rfn-eshadow-overlay' properties. (let ((props (overlay-properties rfn-eshadow-overlay))) (while props ;; The `field' property prevents correct minibuffer -- cgit v1.2.3 From d9afa1f30fdf9d00b447fea0a8343397333e172f Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Mon, 19 Feb 2024 23:36:17 +0100 Subject: Make find-function-regexp also find transient-define-* * lisp/emacs-lisp/find-func.el (find-function-regexp): Also find transient-define-prefix, transient-define-suffix, transient-define-infix and transient-define-argument. --- lisp/emacs-lisp/find-func.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 63f547ebeb8..411602ef166 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -60,6 +60,7 @@ ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\ foo\\|\\(?:[^icfgv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\ cl-\\(?:defun\\|defmethod\\|defgeneric\\)\\|\ +transient-define-\\(?:prefix\\|suffix\\|infix\\|argument\\)\\|\ menu-bar-make-toggle\\|menu-bar-make-toggle-command\\)" find-function-space-re "\\('\\|(quote \\)?%s\\(\\s-\\|$\\|[()]\\)") -- cgit v1.2.3 From 4c6653f23aef097e3a6ed687e21decea6c790b5e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 20 Feb 2024 15:44:13 +0200 Subject: ; * lisp/emacs-lisp/pcase.el (pcase-let*, pcase-let): Doc fix. --- lisp/emacs-lisp/pcase.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 47db2b89b9e..692c8f9b3fe 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -261,7 +261,7 @@ As with `pcase-let', BINDINGS are of the form (PATTERN EXP), but the EXP in each binding in BINDINGS can use the results of the destructuring bindings that precede it in BINDINGS' order. -Each EXP should match (i.e. be of compatible structure) to its +Each EXP should match (i.e. be of compatible structure) its respective PATTERN; a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil." (declare (indent 1) @@ -283,7 +283,7 @@ All EXPs are evaluated first, and then used to perform destructuring bindings by matching each EXP against its respective PATTERN. Then BODY is evaluated with those bindings in effect. -Each EXP should match (i.e. be of compatible structure) to its +Each EXP should match (i.e. be of compatible structure) its respective PATTERN; a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil." (declare (indent 1) (debug pcase-let*)) -- cgit v1.2.3 From 2eb85a9de1a5068d09b21464601dbd3263e55c85 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 20 Feb 2024 19:15:38 +0200 Subject: ; * lisp/emacs-lisp/pcase.el (pcase-let*, pcase-let): Another doc fix. --- lisp/emacs-lisp/pcase.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 692c8f9b3fe..ff68203eaea 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -261,8 +261,8 @@ As with `pcase-let', BINDINGS are of the form (PATTERN EXP), but the EXP in each binding in BINDINGS can use the results of the destructuring bindings that precede it in BINDINGS' order. -Each EXP should match (i.e. be of compatible structure) its -respective PATTERN; a mismatch may signal an error or may go +Each EXP should match its respective PATTERN (i.e. be of structure +compatible to PATTERN); a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil." (declare (indent 1) (debug ((&rest (pcase-PAT &optional form)) body))) @@ -283,8 +283,8 @@ All EXPs are evaluated first, and then used to perform destructuring bindings by matching each EXP against its respective PATTERN. Then BODY is evaluated with those bindings in effect. -Each EXP should match (i.e. be of compatible structure) its -respective PATTERN; a mismatch may signal an error or may go +Each EXP should match its respective PATTERN (i.e. be of structure +compatible to PATTERN); a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil." (declare (indent 1) (debug pcase-let*)) (if (null (cdr bindings)) -- cgit v1.2.3 From bbf0b7d0407883ea0a59c09b501c6e550bb8e10c Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 20 Feb 2024 19:47:29 +0100 Subject: * Fix missing entry in 'cl--typeof-types' * lisp/emacs-lisp/cl-preloaded.el (cl--typeof-types): Add 'native-comp-unit'. --- lisp/emacs-lisp/cl-preloaded.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 20e68555578..d533eea9e73 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -81,6 +81,7 @@ (tree-sitter-parser atom) (tree-sitter-node atom) (tree-sitter-compiled-query atom) + (native-comp-unit atom) ;; Plus, really hand made: (null symbol list sequence atom)) "Alist of supertypes. -- cgit v1.2.3 From 167d9b9040333a5bff64325423750243c60edfa1 Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Tue, 20 Feb 2024 18:49:20 +0100 Subject: Allow trivially autoloading uses of transient's define macros Since 49e41991b2f transient-define-prefix itself was autoloaded, but that meant that when ever an autoload file was loaded, which contained an autoload for a command defined using that macro, transient itself had to be loaded. That shouldn't be necessary. For commands using these macros, an autoload that is identical to what would have been generated if it had been defined using defun, works just fine. * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--make-autoload): Allow uses of transient-define-prefix, transient-define-suffix, transient-define-infix and transient-define-argument to be autoloaded using just ";;;autoload". * lisp/transient.el (transient-define-prefix): No longer autoload. --- lisp/emacs-lisp/loaddefs-gen.el | 17 ++++++++++++----- lisp/transient.el | 1 - 2 files changed, 12 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 238ec9d179b..581053f6304 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -201,8 +201,7 @@ expression, in which case we want to handle forms differently." define-globalized-minor-mode defun defmacro easy-mmode-define-minor-mode define-minor-mode define-inline cl-defun cl-defmacro cl-defgeneric - cl-defstruct pcase-defmacro iter-defun cl-iter-defun - transient-define-prefix)) + cl-defstruct pcase-defmacro iter-defun cl-iter-defun)) (macrop car) (setq expand (let ((load-true-file-name file) (load-file-name file)) @@ -218,13 +217,17 @@ expression, in which case we want to handle forms differently." define-globalized-minor-mode easy-mmode-define-minor-mode define-minor-mode cl-defun defun* cl-defmacro defmacro* - define-overloadable-function)) + define-overloadable-function + transient-define-prefix transient-define-suffix + transient-define-infix transient-define-argument)) (let* ((macrop (memq car '(defmacro cl-defmacro defmacro*))) (name (nth 1 form)) (args (pcase car ((or 'defun 'defmacro 'defun* 'defmacro* 'cl-defun 'cl-defmacro - 'define-overloadable-function) + 'define-overloadable-function + 'transient-define-prefix 'transient-define-suffix + 'transient-define-infix 'transient-define-argument) (nth 2 form)) ('define-skeleton '(&optional str arg)) ((or 'define-generic-mode 'define-derived-mode @@ -246,7 +249,11 @@ expression, in which case we want to handle forms differently." define-global-minor-mode define-globalized-minor-mode easy-mmode-define-minor-mode - define-minor-mode)) + define-minor-mode + transient-define-prefix + transient-define-suffix + transient-define-infix + transient-define-argument)) t) (and (eq (car-safe (car body)) 'interactive) ;; List of modes or just t. diff --git a/lisp/transient.el b/lisp/transient.el index f9060f5ba85..bb35746e186 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -855,7 +855,6 @@ elements themselves.") ;;; Define -;;;###autoload (defmacro transient-define-prefix (name arglist &rest args) "Define NAME as a transient prefix command. -- cgit v1.2.3 From 1acc7cb851417b83ae90fe4d0ee9f01af2e03722 Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Tue, 20 Feb 2024 22:49:07 +0100 Subject: Do not attempt to check declarations in lock files * lisp/emacs-lisp/check-declare.el (check-declare-directory): Do not attempt to check declarations in lock files. (Bug#69084) --- lisp/emacs-lisp/check-declare.el | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el index a6d1a330d90..faa7824c8bd 100644 --- a/lisp/emacs-lisp/check-declare.el +++ b/lisp/emacs-lisp/check-declare.el @@ -328,9 +328,14 @@ Returns non-nil if any false statements are found." (setq root (directory-file-name (file-relative-name root))) (or (file-directory-p root) (error "Directory `%s' not found" root)) - (let ((files (directory-files-recursively root "\\.el\\'"))) - (when files - (apply #'check-declare-files files)))) + (when-let* ((files (directory-files-recursively root "\\.el\\'")) + (files (mapcan (lambda (file) + ;; Filter out lock files. + (and (not (string-prefix-p + ".#" (file-name-nondirectory file))) + (list file))) + files))) + (apply #'check-declare-files files))) (provide 'check-declare) -- cgit v1.2.3 From d6131b5902a70339305285f9861bdfd24c567eab Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 21 Feb 2024 09:02:33 +0100 Subject: * lisp/net/tramp.el (tramp-methods): Fix typo in docstring. (Bug#69294) --- lisp/net/tramp.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 9d883c96252..2d6db31fee8 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -332,8 +332,8 @@ pair of the form (KEY VALUE). The following KEYs are defined: chosen port for the remote listener. * `tramp-copy-keep-date' - This specifies whether the copying program when the preserves the - timestamp of the original file. + This specifies whether the copying program preserves the timestamp + of the original file. * `tramp-copy-keep-tmpfile' This specifies whether a temporary local file shall be kept -- cgit v1.2.3 From 3b34c5e4a583dd88f476570cbd58655a18e9a6b4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 21 Feb 2024 08:49:15 -0500 Subject: * lisp/emacs-lisp/map.el (map--make-pcase-bindings): Fix use in Emacs<30 --- lisp/emacs-lisp/map.el | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 95a25978d1c..d3d71a36ee4 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -608,19 +608,30 @@ This allows using default values for `map-elt', which can't be done using `pcase--flip'. KEY is the key sought in the map. DEFAULT is the default value." + ;; It's obsolete in Emacs>29, but `map.el' is distributed via GNU ELPA + ;; for earlier Emacsen. (declare (obsolete _ "30.1")) `(map-elt ,map ,key ,default)) (defun map--make-pcase-bindings (args) "Return a list of pcase bindings from ARGS to the elements of a map." - (mapcar (lambda (elt) - (cond ((consp elt) - `(app (map-elt _ ,(car elt) ,(caddr elt)) - ,(cadr elt))) - ((keywordp elt) - (let ((var (intern (substring (symbol-name elt) 1)))) - `(app (map-elt _ ,elt) ,var))) - (t `(app (map-elt _ ',elt) ,elt)))) + (mapcar (if (< emacs-major-version 30) + (lambda (elt) + (cond ((consp elt) + `(app (map--pcase-map-elt ,(car elt) ,(caddr elt)) + ,(cadr elt))) + ((keywordp elt) + (let ((var (intern (substring (symbol-name elt) 1)))) + `(app (pcase--flip map-elt ,elt) ,var))) + (t `(app (pcase--flip map-elt ',elt) ,elt)))) + (lambda (elt) + (cond ((consp elt) + `(app (map-elt _ ,(car elt) ,(caddr elt)) + ,(cadr elt))) + ((keywordp elt) + (let ((var (intern (substring (symbol-name elt) 1)))) + `(app (map-elt _ ,elt) ,var))) + (t `(app (map-elt _ ',elt) ,elt))))) args)) (defun map--make-pcase-patterns (args) -- cgit v1.2.3 From d5757178464ca51f79c7fc1ab199a1582e92ab32 Mon Sep 17 00:00:00 2001 From: kobarity Date: Fri, 16 Feb 2024 22:52:06 +0900 Subject: Set tty mode to raw when setting up Inferior Python * lisp/progmodes/python.el (python-shell-setup-code): New constant. (python-shell-comint-watch-for-first-prompt-output-filter): Send `python-shell-setup-code' to the Inferior Python process. * test/lisp/progmodes/python-tests.el (python-ffap-module-path-1): Eliminate skipping on Mac. (Bug#68559) --- lisp/progmodes/python.el | 11 +++++++++++ test/lisp/progmodes/python-tests.el | 5 ----- 2 files changed, 11 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index b7e43f3fc68..5501926e69d 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -3521,6 +3521,16 @@ eventually provide a shell." :version "25.1" :type 'hook) +(defconst python-shell-setup-code + "\ +try: + import tty +except ImportError: + pass +else: + tty.setraw(0)" + "Code used to setup the inferior Python processes.") + (defconst python-shell-eval-setup-code "\ def __PYTHON_EL_eval(source, filename): @@ -3586,6 +3596,7 @@ The coding cookie regexp is specified in PEP 263.") (format "exec(%s)\n" (python-shell--encode-string string)))))) ;; Bootstrap: the normal definition of `python-shell-send-string' ;; depends on the Python code sent here. + (python-shell-send-string-no-output python-shell-setup-code) (python-shell-send-string-no-output python-shell-eval-setup-code) (python-shell-send-string-no-output python-shell-eval-file-setup-code)) (with-current-buffer (current-buffer) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index af6c199b5bd..6c6cd9eee2b 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -5037,11 +5037,6 @@ import abc (ert-deftest python-ffap-module-path-1 () (skip-unless (executable-find python-tests-shell-interpreter)) - ;; Skip the test on macOS, since the standard Python installation uses - ;; libedit rather than readline which confuses the running of an inferior - ;; interpreter in this case (see bug#59477 and bug#25753). - (skip-when (eq system-type 'darwin)) - (trace-function 'python-shell-output-filter) (python-tests-with-temp-buffer-with-shell " import abc -- cgit v1.2.3 From 7215c63fc0f9d7f48ac20578d310a8b3d86b0eae Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 11:18:06 +0100 Subject: * Make 'comp--compute-function-types' a pass * lisp/emacs-lisp/comp.el (comp-passes): Add comp--compute-function-types. (comp--compute-function-types): New function. (comp--compute-function-type): Move it. (comp--final): Update it. --- lisp/emacs-lisp/comp.el | 61 +++++++++++++++++++++++++++---------------------- 1 file changed, 34 insertions(+), 27 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 593291a379e..b27cf2b6620 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -165,6 +165,7 @@ Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.") comp--tco comp--fwprop comp--remove-type-hints + comp--compute-function-types comp--final) "Passes to be executed in order.") @@ -2994,32 +2995,7 @@ These are substituted with a normal `set' op." (comp-ctxt-funcs-h comp-ctxt))) -;;; Final pass specific code. - -(defun comp--args-to-lambda-list (args) - "Return a lambda list for ARGS." - (cl-loop - with res - repeat (comp-args-base-min args) - do (push t res) - finally - (if (comp-args-p args) - (cl-loop - with n = (- (comp-args-max args) (comp-args-min args)) - initially (unless (zerop n) - (push '&optional res)) - repeat n - do (push t res)) - (cl-loop - with n = (- (comp-nargs-nonrest args) (comp-nargs-min args)) - initially (unless (zerop n) - (push '&optional res)) - repeat n - do (push t res) - finally (when (comp-nargs-rest args) - (push '&rest res) - (push 't res)))) - (cl-return (reverse res)))) +;;; Function types pass specific code. (defun comp--compute-function-type (_ func) "Compute type specifier for `comp-func' FUNC. @@ -3047,6 +3023,38 @@ Set it into the `type' slot." ;; Fix it up. (setf (comp-cstr-imm (comp-func-type func)) type)))) +(defun comp--compute-function-types (_) + "" + (maphash #'comp--compute-function-type (comp-ctxt-funcs-h comp-ctxt))) + + +;;; Final pass specific code. + +(defun comp--args-to-lambda-list (args) + "Return a lambda list for ARGS." + (cl-loop + with res + repeat (comp-args-base-min args) + do (push t res) + finally + (if (comp-args-p args) + (cl-loop + with n = (- (comp-args-max args) (comp-args-min args)) + initially (unless (zerop n) + (push '&optional res)) + repeat n + do (push t res)) + (cl-loop + with n = (- (comp-nargs-nonrest args) (comp-nargs-min args)) + initially (unless (zerop n) + (push '&optional res)) + repeat n + do (push t res) + finally (when (comp-nargs-rest args) + (push '&rest res) + (push 't res)))) + (cl-return (reverse res)))) + (defun comp--finalize-container (cont) "Finalize data container CONT." (setf (comp-data-container-l cont) @@ -3149,7 +3157,6 @@ Prepare every function for final compilation and drive the C back-end." (defun comp--final (_) "Final pass driving the C back-end for code emission." - (maphash #'comp--compute-function-type (comp-ctxt-funcs-h comp-ctxt)) (unless comp-dry-run ;; Always run the C side of the compilation as a sub-process ;; unless during bootstrap or async compilation (bug#45056). GCC -- cgit v1.2.3 From 1e1d3f3acd8567addc0dab4bc34dc5c7f2405556 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 11:18:28 +0100 Subject: ; * lisp/emacs-lisp/comp.el (native-comp-debug): Fix spacing. --- lisp/emacs-lisp/comp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index b27cf2b6620..6532fb8d1ce 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -68,7 +68,7 @@ :safe #'integerp :version "28.1") -(defcustom native-comp-debug 0 +(defcustom native-comp-debug 0 "Debug level for native compilation, a number between 0 and 3. This is intended for debugging the compiler itself. 0 no debug output. -- cgit v1.2.3 From 5aeea8dc2c0bdd01de3ad271723e9d1737d8a056 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 15:06:18 +0100 Subject: * lisp/emacs-lisp/comp-cstr.el (comp-cstr): Rename constructors. --- lisp/emacs-lisp/comp-cstr.el | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 0bc97e51592..48e3645629b 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -44,7 +44,7 @@ ;; TODO can we just add t in `cl--typeof-types'? "Like `cl--typeof-types' but with t as common supertype.") -(cl-defstruct (comp-cstr (:constructor comp-type-to-cstr +(cl-defstruct (comp-cstr (:constructor comp--type-to-cstr (type &aux (null (eq type 'null)) (integer (eq type 'integer)) @@ -55,7 +55,7 @@ '(nil))) (range (when integer '((- . +)))))) - (:constructor comp-value-to-cstr + (:constructor comp--value-to-cstr (value &aux (integer (integerp value)) (valset (unless integer @@ -63,7 +63,7 @@ (range (when integer `((,value . ,value)))) (typeset ()))) - (:constructor comp-irange-to-cstr + (:constructor comp--irange-to-cstr (irange &aux (range (list irange)) (typeset ()))) @@ -229,10 +229,10 @@ Return them as multiple value." ;; builds. (defvar comp-ctxt nil) -(defvar comp-cstr-one (comp-value-to-cstr 1) +(defvar comp-cstr-one (comp--value-to-cstr 1) "Represent the integer immediate one.") -(defvar comp-cstr-t (comp-type-to-cstr t) +(defvar comp-cstr-t (comp--type-to-cstr t) "Represent the superclass t.") @@ -1212,14 +1212,14 @@ FN non-nil indicates we are parsing a function lambda list." ('nil (make-comp-cstr :typeset ())) ('fixnum - (comp-irange-to-cstr `(,most-negative-fixnum . ,most-positive-fixnum))) + (comp--irange-to-cstr `(,most-negative-fixnum . ,most-positive-fixnum))) ('boolean (comp-type-spec-to-cstr '(member t nil))) ('integer - (comp-irange-to-cstr '(- . +))) - ('null (comp-value-to-cstr nil)) + (comp--irange-to-cstr '(- . +))) + ('null (comp--value-to-cstr nil)) ((pred atom) - (comp-type-to-cstr type-spec)) + (comp--type-to-cstr type-spec)) (`(or . ,rest) (apply #'comp-cstr-union-make (mapcar #'comp-type-spec-to-cstr rest))) @@ -1229,16 +1229,16 @@ FN non-nil indicates we are parsing a function lambda list." (`(not ,cstr) (comp-cstr-negation-make (comp-type-spec-to-cstr cstr))) (`(integer ,(and (pred integerp) l) ,(and (pred integerp) h)) - (comp-irange-to-cstr `(,l . ,h))) + (comp--irange-to-cstr `(,l . ,h))) (`(integer * ,(and (pred integerp) h)) - (comp-irange-to-cstr `(- . ,h))) + (comp--irange-to-cstr `(- . ,h))) (`(integer ,(and (pred integerp) l) *) - (comp-irange-to-cstr `(,l . +))) + (comp--irange-to-cstr `(,l . +))) (`(float ,(pred comp-star-or-num-p) ,(pred comp-star-or-num-p)) ;; No float range support :/ - (comp-type-to-cstr 'float)) + (comp--type-to-cstr 'float)) (`(member . ,rest) - (apply #'comp-cstr-union-make (mapcar #'comp-value-to-cstr rest))) + (apply #'comp-cstr-union-make (mapcar #'comp--value-to-cstr rest))) (`(function ,args ,ret) (make-comp-cstr-f :args (mapcar (lambda (x) -- cgit v1.2.3 From c65a59a9e90524efa23d9151c31dad66a08ccb90 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 15:45:10 +0100 Subject: * Add few missing entries in 'comp-known-predicates' * lisp/emacs-lisp/comp.el (comp-known-predicates): Add framep, markerp, number-or-marker-p, overlayp, processp, subrp and windowp and sort it alphabetically. --- lisp/emacs-lisp/comp.el | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 6532fb8d1ce..a833bf5bfc4 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -191,28 +191,34 @@ Useful to hook into pass checkers.") (defconst comp-known-predicates '((arrayp . array) (atom . atom) - (characterp . fixnum) - (booleanp . boolean) (bool-vector-p . bool-vector) + (booleanp . boolean) (bufferp . buffer) - (natnump . (integer 0 *)) (char-table-p . char-table) - (hash-table-p . hash-table) + (characterp . fixnum) (consp . cons) - (integerp . integer) (floatp . float) + (framep . frame) (functionp . (or function symbol)) + (hash-table-p . hash-table) + (integer-or-marker-p . integer-or-marker) (integerp . integer) (keywordp . keyword) (listp . list) - (numberp . number) + (markerp . marker) + (natnump . (integer 0 *)) (null . null) + (number-or-marker-p . number-or-marker) + (numberp . number) (numberp . number) + (overlayp . overlay) + (processp . process) (sequencep . sequence) (stringp . string) + (subrp . subr) (symbolp . symbol) (vectorp . vector) - (integer-or-marker-p . integer-or-marker)) + (windowp . window)) "Alist predicate -> matched type specifier.") (defconst comp-known-predicates-h -- cgit v1.2.3 From 88abbf00af69cf7e5f36e318e6935f7d1500af7f Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 15:45:40 +0100 Subject: ; Add two comments on comp-known-predicates cl-deftype-satisfies * lisp/emacs-lisp/comp.el (comp-known-predicates): Add comment. * lisp/emacs-lisp/cl-macs.el: Likewise. --- lisp/emacs-lisp/cl-macs.el | 1 + lisp/emacs-lisp/comp.el | 3 +++ 2 files changed, 4 insertions(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 06a09885c88..44ebadeebff 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3460,6 +3460,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." (or (cdr (assq sym byte-compile-function-environment)) (cdr (assq sym macroexpand-all-environment)))))) +;; Please keep it in sync with `comp-known-predicates'. (pcase-dolist (`(,type . ,pred) ;; Mostly kept in alphabetical order. '((array . arrayp) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index a833bf5bfc4..46d2896f2be 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -188,6 +188,9 @@ Useful to hook into pass checkers.") finally return h) "Hash table function -> `comp-constraint'.") +;; Keep it in sync with the `cl-deftype-satisfies' property set in +;; cl-macs.el. We can't use `cl-deftype-satisfies' directly as the +;; relation type <-> predicate is not bijective (bug#45576). (defconst comp-known-predicates '((arrayp . array) (atom . atom) -- cgit v1.2.3 From 35d99b1ec7c56d4a5c09af36e6bbd7f0f959cccc Mon Sep 17 00:00:00 2001 From: john muhl Date: Wed, 21 Feb 2024 10:14:05 -0600 Subject: ; Update URL of the tree-sitter-lua grammar * admin/notes/tree-sitter/build-module/build.sh: * lisp/progmodes/lua-ts-mode.el: * test/infra/Dockerfile.emba: Use the new URL. (bug#69304) --- admin/notes/tree-sitter/build-module/build.sh | 2 +- lisp/progmodes/lua-ts-mode.el | 4 ++-- test/infra/Dockerfile.emba | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/admin/notes/tree-sitter/build-module/build.sh b/admin/notes/tree-sitter/build-module/build.sh index 969187b7f92..9a567bb094d 100755 --- a/admin/notes/tree-sitter/build-module/build.sh +++ b/admin/notes/tree-sitter/build-module/build.sh @@ -43,7 +43,7 @@ case "${lang}" in org="phoenixframework" ;; "lua") - org="MunifTanjim" + org="tree-sitter-grammars" ;; "typescript") sourcedir="tree-sitter-typescript/typescript/src" diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index c7f5ac50b04..8bd3db2b75f 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -26,8 +26,8 @@ ;; This package provides `lua-ts-mode' which is a major mode for Lua ;; files that uses Tree Sitter to parse the language. ;; -;; This package is compatible with and tested against the grammar -;; for Lua found at https://github.com/MunifTanjim/tree-sitter-lua +;; This package is compatible with and tested against the grammar for +;; Lua found at https://github.com/tree-sitter-grammars/tree-sitter-lua ;;; Code: diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba index 8e583fade9f..d79072b06b5 100644 --- a/test/infra/Dockerfile.emba +++ b/test/infra/Dockerfile.emba @@ -126,7 +126,7 @@ RUN src/emacs -Q --batch \ (java "https://github.com/tree-sitter/tree-sitter-java") \ (javascript "https://github.com/tree-sitter/tree-sitter-javascript") \ (json "https://github.com/tree-sitter/tree-sitter-json") \ - (lua "https://github.com/MunifTanjim/tree-sitter-lua") \ + (lua "https://github.com/tree-sitter-grammars/tree-sitter-lua") \ (python "https://github.com/tree-sitter/tree-sitter-python") \ (ruby "https://github.com/tree-sitter/tree-sitter-ruby") \ (tsx "https://github.com/tree-sitter/tree-sitter-typescript" "master" "tsx/src") \ -- cgit v1.2.3 From e6882a5cc89d9375dfa73156db6836af19ef7b8a Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Thu, 1 Feb 2024 12:30:24 +0100 Subject: ; Fix mid-symbol updating/cycling completion preview This fixes an issue where 'completion-preview-next-candidate' would fail to take into account the part of the symbol that follows point (the suffix) when point is at the middle of a symbol, as well as a similar issue in 'completion-preview--show' that would manifest with slow 'completion-at-point-functions'. * lisp/completion-preview.el (completion-preview-next-candidate) (completion-preview--show): Ensure that the completion preview remains at the end of a symbol, when updating it while point is in the middle of that symbol. * test/lisp/completion-preview-tests.el (completion-preview-mid-symbol-cycle): New test. (Bug#68875) --- lisp/completion-preview.el | 24 ++++++++++++------------ test/lisp/completion-preview-tests.el | 15 +++++++++++++++ 2 files changed, 27 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 6fd60f3c416..e827da43a08 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -302,21 +302,21 @@ point, otherwise hide it." ;; never display a stale preview and that the preview doesn't ;; flicker, even with slow completion backends. (let* ((beg (completion-preview--get 'completion-preview-beg)) + (end (max (point) (overlay-start completion-preview--overlay))) (cands (completion-preview--get 'completion-preview-cands)) (index (completion-preview--get 'completion-preview-index)) (cand (nth index cands)) - (len (length cand)) - (end (+ beg len)) - (cur (point)) - (face (get-text-property 0 'face (completion-preview--get 'after-string)))) - (if (and (< beg cur end) (string-prefix-p (buffer-substring beg cur) cand)) + (after (completion-preview--get 'after-string)) + (face (get-text-property 0 'face after))) + (if (and (<= beg (point) end (1- (+ beg (length cand)))) + (string-prefix-p (buffer-substring beg end) cand)) ;; The previous preview is still applicable, update it. (overlay-put (completion-preview--make-overlay - cur (propertize (substring cand (- cur beg)) + end (propertize (substring cand (- end beg)) 'face face 'mouse-face 'completion-preview-highlight 'keymap completion-preview--mouse-map)) - 'completion-preview-end cur) + 'completion-preview-end end) ;; The previous preview is no longer applicable, hide it. (completion-preview-active-mode -1)))) ;; Run `completion-at-point-functions' to get a new candidate. @@ -366,16 +366,16 @@ prefix argument and defaults to 1." (interactive "p") (when completion-preview-active-mode (let* ((beg (completion-preview--get 'completion-preview-beg)) + (end (completion-preview--get 'completion-preview-end)) (all (completion-preview--get 'completion-preview-cands)) (cur (completion-preview--get 'completion-preview-index)) (len (length all)) (new (mod (+ cur direction) len)) - (str (nth new all)) - (pos (point))) - (while (or (<= (+ beg (length str)) pos) - (not (string-prefix-p (buffer-substring beg pos) str))) + (str (nth new all))) + (while (or (<= (+ beg (length str)) end) + (not (string-prefix-p (buffer-substring beg end) str))) (setq new (mod (+ new direction) len) str (nth new all))) - (let ((aft (propertize (substring str (- pos beg)) + (let ((aft (propertize (substring str (- end beg)) 'face (if (< 1 len) 'completion-preview 'completion-preview-exact) diff --git a/test/lisp/completion-preview-tests.el b/test/lisp/completion-preview-tests.el index 190764e9125..5b2c28bd3dd 100644 --- a/test/lisp/completion-preview-tests.el +++ b/test/lisp/completion-preview-tests.el @@ -181,4 +181,19 @@ instead." (completion-preview--post-command)) (completion-preview-tests--check-preview "barbaz" 'exact))) +(ert-deftest completion-preview-mid-symbol-cycle () + "Test cycling the completion preview with point at the middle of a symbol." + (with-temp-buffer + (setq-local completion-at-point-functions + (list + (completion-preview-tests--capf + '("foobar" "foobaz")))) + (insert "fooba") + (forward-char -2) + (let ((this-command 'self-insert-command)) + (completion-preview--post-command)) + (completion-preview-tests--check-preview "r") + (completion-preview-next-candidate 1) + (completion-preview-tests--check-preview "z"))) + ;;; completion-preview-tests.el ends here -- cgit v1.2.3 From 44d5c667d7775f881473c7c6f7d9bdef7594bd79 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 17:45:41 +0100 Subject: * lisp/emacs-lisp/comp.el (comp--compute-function-types): Fix missing doc. --- lisp/emacs-lisp/comp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 46d2896f2be..e0da01bcc5d 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3033,7 +3033,7 @@ Set it into the `type' slot." (setf (comp-cstr-imm (comp-func-type func)) type)))) (defun comp--compute-function-types (_) - "" + "Compute and store the type specifier for all functions." (maphash #'comp--compute-function-type (comp-ctxt-funcs-h comp-ctxt))) -- cgit v1.2.3 From b214cb2843851c410d603e7fb487a462d5f7bee1 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 21:38:11 +0100 Subject: ; * lisp/emacs-lisp/comp-run.el: Fix typo. --- lisp/emacs-lisp/comp-run.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index 5d1a193269d..8fcbe31cf0b 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -25,7 +25,7 @@ ;; While the main native compiler is implemented in comp.el, when ;; commonly used as a jit compiler it is only loaded by Emacs sub -;; processes performing async compilation. This files contains all +;; processes performing async compilation. This file contains all ;; the code needed to drive async compilations and any Lisp code ;; needed at runtime to run native code. -- cgit v1.2.3 From 6b6761d534259ab4d5409e72754e46af13623dda Mon Sep 17 00:00:00 2001 From: Jörg Bornemann Date: Sat, 17 Feb 2024 21:18:02 +0100 Subject: Recognize functions and macros as defuns in 'cmake-ts-mode' * lisp/progmodes/cmake-ts-mode.el (cmake-ts-mode--function-name): Renamed to 'cmake-ts-mode--defun-name' since the function handles now functions and macros. (cmake-ts-mode--defun-name): Return text of the first 'argument' node below 'function_def' and 'macro_def' nodes. (cmake-ts-mode): Set up treesit-defun-type-regexp and 'treesit-defun-name-function'. Change the imenu setup to recognize macros too. Since we have set up 'treesit-defun-name-function', we don't have to pass 'cmake-ts-mode--function-name' anymore. (Bug#69186) To make `treesit-defun-at-point' work properly, we have to recognize function_def/macro_def nodes, not the lower-level *_command nodes. --- lisp/progmodes/cmake-ts-mode.el | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el index 29c9e957d3c..45c4882d873 100644 --- a/lisp/progmodes/cmake-ts-mode.el +++ b/lisp/progmodes/cmake-ts-mode.el @@ -193,13 +193,13 @@ Check if a node type is available, then return the right font lock rules." '((ERROR) @font-lock-warning-face)) "Tree-sitter font-lock settings for `cmake-ts-mode'.") -(defun cmake-ts-mode--function-name (node) - "Return the function name of NODE. -Return nil if there is no name or if NODE is not a function node." +(defun cmake-ts-mode--defun-name (node) + "Return the defun name of NODE. +Return nil if there is no name or if NODE is not a defun node." (pcase (treesit-node-type node) - ("function_command" + ((or "function_def" "macro_def") (treesit-node-text - (treesit-search-subtree node "^argument$" nil nil 2) + (treesit-search-subtree node "^argument$" nil nil 3) t)))) ;;;###autoload @@ -216,9 +216,15 @@ Return nil if there is no name or if NODE is not a function node." (setq-local comment-end "") (setq-local comment-start-skip (rx "#" (* (syntax whitespace)))) + ;; Defuns. + (setq-local treesit-defun-type-regexp (rx (or "function" "macro") + "_def")) + (setq-local treesit-defun-name-function #'cmake-ts-mode--defun-name) + ;; Imenu. (setq-local treesit-simple-imenu-settings - `(("Function" "\\`function_command\\'" nil cmake-ts-mode--function-name))) + `(("Function" "^function_def$") + ("Macro" "^macro_def$"))) (setq-local which-func-functions nil) ;; Indent. -- cgit v1.2.3 From cc58626f643c1b19e66bab9c6a39026c7e419ab9 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 22 Feb 2024 19:38:17 +0200 Subject: * lisp/help-fns.el (describe-mode-outline): New user option (bug#64684). (describe-mode, describe-mode--minor-modes): Use 'describe-mode-outline'. * lisp/help-mode.el (help-setup-xref): After disabling outline-minor-mode also kill all outline-related local variables. So that they won't affect the output of other help commands in the same help buffer. --- etc/NEWS | 4 +++ lisp/help-fns.el | 97 ++++++++++++++++++++++++++++++++++++++----------------- lisp/help-mode.el | 12 ++++++- 3 files changed, 83 insertions(+), 30 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index 7b248c3fe78..13b41feccbc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -130,6 +130,10 @@ the signature) the automatically inferred function type as well. This user option controls outline visibility in the output buffer of 'describe-bindings' when 'describe-bindings-outline' is non-nil. +--- +*** 'C-h m' ('describe-mode') uses outlining by default. +Set 'describe-mode-outline' to nil to get back the old behavior. + ** Outline Mode +++ diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 1ba848c107d..15d87f9925c 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -2133,6 +2133,12 @@ keymap value." (when used-gentemp (makunbound keymap)))) +(defcustom describe-mode-outline t + "Non-nil enables outlines in the output buffer of `describe-mode'." + :type 'boolean + :group 'help + :version "30.1") + ;;;###autoload (defun describe-mode (&optional buffer) "Display documentation of current major mode and minor modes. @@ -2145,7 +2151,10 @@ variable \(listed in `minor-mode-alist') must also be a function whose documentation describes the minor mode. If called from Lisp with a non-nil BUFFER argument, display -documentation for the major and minor modes of that buffer." +documentation for the major and minor modes of that buffer. + +When `describe-mode-outline' is non-nil, Outline minor mode +is enabled in the Help buffer." (interactive "@") (unless buffer (setq buffer (current-buffer))) @@ -2159,13 +2168,20 @@ documentation for the major and minor modes of that buffer." (with-current-buffer (help-buffer) ;; Add the local minor modes at the start. (when local-minors - (insert (format "Minor mode%s enabled in this buffer:" - (if (length> local-minors 1) - "s" ""))) + (unless describe-mode-outline + (insert (format "Minor mode%s enabled in this buffer:" + (if (length> local-minors 1) + "s" "")))) (describe-mode--minor-modes local-minors)) ;; Document the major mode. (let ((major (buffer-local-value 'major-mode buffer))) + (when describe-mode-outline + (goto-char (point-min)) + (put-text-property + (point) (progn (insert (format "Major mode %S" major)) (point)) + 'outline-level 1) + (insert "\n\n")) (insert "The major mode is " (buttonize (propertize (format-mode-line @@ -2189,36 +2205,56 @@ documentation for the major and minor modes of that buffer." ;; Insert the global minor modes after the major mode. (when global-minor-modes - (insert (format "Global minor mode%s enabled:" - (if (length> global-minor-modes 1) - "s" ""))) - (describe-mode--minor-modes global-minor-modes) - (when (re-search-forward "^\f") - (beginning-of-line) - (ensure-empty-lines 1))) + (unless describe-mode-outline + (insert (format "Global minor mode%s enabled:" + (if (length> global-minor-modes 1) + "s" "")))) + (describe-mode--minor-modes global-minor-modes t) + (unless describe-mode-outline + (when (re-search-forward "^\f") + (beginning-of-line) + (ensure-empty-lines 1)))) + + (when describe-mode-outline + (setq-local outline-search-function #'outline-search-level) + (setq-local outline-level (lambda () 1)) + (setq-local outline-minor-mode-cycle t + outline-minor-mode-highlight t + outline-minor-mode-use-buttons 'insert) + (outline-minor-mode 1)) + ;; For the sake of IELM and maybe others nil))))) -(defun describe-mode--minor-modes (modes) +(defun describe-mode--minor-modes (modes &optional global) (dolist (mode (seq-sort #'string< modes)) (let ((pretty-minor-mode (capitalize (replace-regexp-in-string "\\(\\(-minor\\)?-mode\\)?\\'" "" (symbol-name mode))))) - (insert - " " - (buttonize - pretty-minor-mode - (lambda (mode) - (goto-char (point-min)) - (text-property-search-forward - 'help-minor-mode mode t) - (beginning-of-line)) - mode)) + (if (not describe-mode-outline) + (insert + " " + (buttonize + pretty-minor-mode + (lambda (mode) + (goto-char (point-min)) + (text-property-search-forward + 'help-minor-mode mode t) + (beginning-of-line)) + mode)) + (goto-char (point-max)) + (put-text-property + (point) (progn (insert (if global "Global" "Local") + (format " minor mode %S" mode)) + (point)) + 'outline-level 1) + (insert "\n\n")) (save-excursion - (goto-char (point-max)) - (insert "\n\n\f\n") + (unless describe-mode-outline + (goto-char (point-max)) + (insert "\n\n\f\n")) ;; Document the minor modes fully. (insert (buttonize (propertize pretty-minor-mode 'help-minor-mode mode) @@ -2232,11 +2268,14 @@ documentation for the major and minor modes of that buffer." (format "indicator%s" indicator))))) (insert (or (help-split-fundoc (documentation mode) nil 'doc) - "No docstring"))))) - (forward-line -1) - (fill-paragraph nil) - (forward-paragraph 1) - (ensure-empty-lines 1)) + "No docstring")) + (when describe-mode-outline + (insert "\n\n"))))) + (unless describe-mode-outline + (forward-line -1) + (fill-paragraph nil) + (forward-paragraph 1) + (ensure-empty-lines 1))) (defun help-fns--list-local-commands () (let ((functions nil)) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 9c405efeee5..f9ec8a5cc2b 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -501,7 +501,17 @@ restore it properly when going back." ;; Disable `outline-minor-mode' in a reused Help buffer ;; created by `describe-bindings' that enables this mode. (when (bound-and-true-p outline-minor-mode) - (outline-minor-mode -1)) + (outline-minor-mode -1) + (mapc #'kill-local-variable + '(outline-search-function + outline-regexp + outline-heading-end-regexp + outline-level + outline-minor-mode-cycle + outline-minor-mode-highlight + outline-minor-mode-use-buttons + outline-default-state + outline-default-rules))) (when help-xref-stack-item (push (cons (point) help-xref-stack-item) help-xref-stack) (setq help-xref-forward-stack nil)) -- cgit v1.2.3 From 58ca91fe0723c861d53375f52e5b6dd54a49a2e3 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 22 Feb 2024 20:40:57 +0100 Subject: * Fix 'parse-colon-path' entry in 'comp-known-type-specifiers' * lisp/emacs-lisp/comp-common.el (comp-known-type-specifiers): Fix 'parse-colon-path'. --- lisp/emacs-lisp/comp-common.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index 6ba9664ea5c..ca21ed05bb4 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -309,7 +309,7 @@ Used to modify the compiler environment." (numberp (function (t) boolean)) (one-window-p (function (&optional t t) boolean)) (overlayp (function (t) boolean)) - (parse-colon-path (function (string) cons)) + (parse-colon-path (function (string) list)) (plist-get (function (list t &optional t) t)) (plist-member (function (list t &optional t) list)) (point (function () integer)) -- cgit v1.2.3 From f85280503a3a67e1618069b1c7d6810efa924fe8 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 22 Feb 2024 17:20:58 +0100 Subject: Tone down python-mode warning to a simple message (bug#68559) * lisp/progmodes/python.el (python-shell-completion-native-turn-on-maybe): There is no need for an alarming warning when using an inferior Python without GNU readline; a calm message will do. --- lisp/progmodes/python.el | 17 +++++------------ 1 file changed, 5 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 5501926e69d..bedc61408ef 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4536,18 +4536,11 @@ With argument MSG show activation/deactivation message." ((python-shell-completion-native-setup) (when msg (message "Shell native completion is enabled."))) - (t (lwarn - '(python python-shell-completion-native-turn-on-maybe) - :warning - (concat - "Your `python-shell-interpreter' doesn't seem to " - "support readline, yet `python-shell-completion-native-enable' " - (format "was t and %S is not part of the " - (file-name-nondirectory python-shell-interpreter)) - "`python-shell-completion-native-disabled-interpreters' " - "list. Native completions have been disabled locally. " - "Consider installing the python package \"readline\". ")) - (python-shell-completion-native-turn-off msg)))))) + (t + (when msg + (message (concat "Python does not use GNU readline;" + " no completion in multi-line commands."))) + (python-shell-completion-native-turn-off nil)))))) (defun python-shell-completion-native-turn-on-maybe-with-msg () "Like `python-shell-completion-native-turn-on-maybe' but force messages." -- cgit v1.2.3 From aa82fe9931851e66aa335e96ae35fd967951b281 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 8 Feb 2024 18:23:00 +0100 Subject: Use obarray-make instead of make-vector to create obarrays This prepares for the introduction of an actual obarray type. * lisp/cedet/semantic/lex-spp.el (semantic-lex-spp-dynamic-map) (semantic-lex-spp-dynamic-map-stack, semantic-lex-make-spp-table): * lisp/cedet/semantic/lex.el (semantic-lex-make-keyword-table) (semantic-lex-make-type-table): * lisp/completion.el (cmpl-prefix-obarray, cmpl-obarray) (clear-all-completions): * lisp/emacs-lisp/checkdoc.el (checkdoc-defun-info): * lisp/emacs-lisp/eldoc.el (eldoc-message-commands) (eldoc-edit-message-commands): * lisp/mail/mail-extr.el (mail-extr-all-top-level-domains): * lisp/mail/rmailkwd.el (rmail-label-obarray): * lisp/net/dns.el (dns-cache): * lisp/net/eww.el (eww-suggested-uris): * lisp/net/imap.el (imap-open, imap-mailbox-select-1) (imap-message-copyuid-1, imap-message-appenduid-1): * lisp/obsolete/pgg.el (pgg-passphrase-cache, pgg-pending-timers): * lisp/play/cookie1.el (cookie-cache): * lisp/progmodes/cc-defs.el (c-lang-constants, c-define-lang-constant): * lisp/progmodes/cc-langs.el (c-keywords-obarray): * lisp/vc/vc-hooks.el (vc-file-prop-obarray): * test/lisp/obarray-tests.el (obarrayp-test): * test/src/minibuf-tests.el (minibuf-tests--strings-to-obarray): Use obarray-make instead of obarray-make. --- lisp/cedet/semantic/lex-spp.el | 6 +++--- lisp/cedet/semantic/lex.el | 4 ++-- lisp/completion.el | 8 ++++---- lisp/emacs-lisp/checkdoc.el | 2 +- lisp/emacs-lisp/eldoc.el | 4 ++-- lisp/mail/mail-extr.el | 2 +- lisp/mail/rmailkwd.el | 2 +- lisp/net/dns.el | 2 +- lisp/net/eww.el | 2 +- lisp/net/imap.el | 8 ++++---- lisp/obsolete/pgg.el | 4 ++-- lisp/play/cookie1.el | 2 +- lisp/progmodes/cc-defs.el | 4 ++-- lisp/progmodes/cc-langs.el | 2 +- lisp/vc/vc-hooks.el | 2 +- test/lisp/obarray-tests.el | 3 ++- test/src/minibuf-tests.el | 2 +- 17 files changed, 30 insertions(+), 29 deletions(-) (limited to 'lisp') diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index a4be5bf67e2..f63d316c1ac 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -153,13 +153,13 @@ The search priority is: "Return the dynamic macro map for the current buffer." (or semantic-lex-spp-dynamic-macro-symbol-obarray (setq semantic-lex-spp-dynamic-macro-symbol-obarray - (make-vector 13 0)))) + (obarray-make 13)))) (defsubst semantic-lex-spp-dynamic-map-stack () "Return the dynamic macro map for the current buffer." (or semantic-lex-spp-dynamic-macro-symbol-obarray-stack (setq semantic-lex-spp-dynamic-macro-symbol-obarray-stack - (make-vector 13 0)))) + (obarray-make 13)))) (defun semantic-lex-spp-value-valid-p (value) "Return non-nil if VALUE is valid." @@ -260,7 +260,7 @@ NAME is the name of the spp macro symbol to define. REPLACEMENT a string that would be substituted in for NAME." ;; Create the symbol hash table - (let ((semantic-lex-spp-macro-symbol-obarray (make-vector 13 0)) + (let ((semantic-lex-spp-macro-symbol-obarray (obarray-make 13)) spec) ;; fill it with stuff (while specs diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index b32cb96bed9..f3d671ac312 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -259,7 +259,7 @@ If optional argument PROPSPECS is non-nil, then interpret it, and apply those properties. PROPSPECS must be a list of (NAME PROPERTY VALUE) elements." ;; Create the symbol hash table - (let ((semantic-flex-keywords-obarray (make-vector 13 0)) + (let ((semantic-flex-keywords-obarray (obarray-make 13)) spec) ;; fill it with stuff (while specs @@ -416,7 +416,7 @@ If optional argument PROPSPECS is non-nil, then interpret it, and apply those properties. PROPSPECS must be a list of (TYPE PROPERTY VALUE)." ;; Create the symbol hash table - (let* ((semantic-lex-types-obarray (make-vector 13 0)) + (let* ((semantic-lex-types-obarray (obarray-make 13)) spec type tokens token alist default) ;; fill it with stuff (while specs diff --git a/lisp/completion.el b/lisp/completion.el index ab7f2a7bc52..6c758e56eab 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -875,11 +875,11 @@ This is sensitive to `case-fold-search'." ;; GNU implements obarrays (defconst cmpl-obarray-length 511) -(defvar cmpl-prefix-obarray (make-vector cmpl-obarray-length 0) +(defvar cmpl-prefix-obarray (obarray-make cmpl-obarray-length) "An obarray used to store the downcased completion prefixes. Each symbol is bound to a list of completion entries.") -(defvar cmpl-obarray (make-vector cmpl-obarray-length 0) +(defvar cmpl-obarray (obarray-make cmpl-obarray-length) "An obarray used to store the downcased completions. Each symbol is bound to a single completion entry.") @@ -962,8 +962,8 @@ Each symbol is bound to a single completion entry.") (defun clear-all-completions () "Initialize the completion storage. All existing completions are lost." (interactive) - (setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0)) - (setq cmpl-obarray (make-vector cmpl-obarray-length 0))) + (setq cmpl-prefix-obarray (obarray-make cmpl-obarray-length)) + (setq cmpl-obarray (obarray-make cmpl-obarray-length))) (defun list-all-completions () "Return a list of all the known completion entries." diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 82c6c03a592..02c11cae573 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1994,7 +1994,7 @@ from the comment." (defun-depth (ppss-depth (syntax-ppss))) (lst nil) (ret nil) - (oo (make-vector 3 0))) ;substitute obarray for `read' + (oo (obarray-make 3))) ;substitute obarray for `read' (forward-char 1) (forward-sexp 1) (skip-chars-forward " \n\t") diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 912a7357ca7..24afd03fbe6 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -155,7 +155,7 @@ Remember to keep it a prime number to improve hash performance.") (defvar eldoc-message-commands ;; Don't define as `defconst' since it would then go to (read-only) purespace. - (make-vector eldoc-message-commands-table-size 0) + (obarray-make eldoc-message-commands-table-size) "Commands after which it is appropriate to print in the echo area. ElDoc does not try to print function arglists, etc., after just any command, because some commands print their own messages in the echo area and these @@ -191,7 +191,7 @@ It should receive the same arguments as `message'.") When `eldoc-print-after-edit' is non-nil, ElDoc messages are only printed after commands contained in this obarray." - (let ((cmds (make-vector 31 0)) + (let ((cmds (obarray-make 31)) (re (regexp-opt '("delete" "insert" "edit" "electric" "newline")))) (mapatoms (lambda (s) (and (commandp s) diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index 668cae05521..cfdbc1b2509 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -1845,7 +1845,7 @@ place. It affects how `mail-extract-address-components' works." ;; https://en.wikipedia.org/wiki/List_of_Internet_top-level_domains (defconst mail-extr-all-top-level-domains - (let ((ob (make-vector 739 0))) + (let ((ob (obarray-make 739))) (mapc (lambda (x) (put (intern (downcase (car x)) ob) diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el index d9c4cb8cfee..a13c42edb5c 100644 --- a/lisp/mail/rmailkwd.el +++ b/lisp/mail/rmailkwd.el @@ -31,7 +31,7 @@ ;; Global to all RMAIL buffers. It exists for the sake of completion. ;; It is better to use strings with the label functions and let them ;; worry about making the label. -(defvar rmail-label-obarray (make-vector 47 0) +(defvar rmail-label-obarray (obarray-make 47) "Obarray of labels used by Rmail. `rmail-read-label' uses this to offer completion.") diff --git a/lisp/net/dns.el b/lisp/net/dns.el index 23ea88ef4ad..54f4d227a49 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el @@ -359,7 +359,7 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"." result)) ;;; Interface functions. -(defvar dns-cache (make-vector 4096 0)) +(defvar dns-cache (obarray-make 4096)) (defun dns-query-cached (name &optional type fullp reversep) (let* ((key (format "%s:%s:%s:%s" name type fullp reversep)) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 6ae1e6d3d0a..5a25eef9e3c 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -340,7 +340,7 @@ parameter, and should return the (possibly) transformed URL." (defun eww-suggested-uris nil "Return the list of URIs to suggest at the `eww' prompt. This list can be customized via `eww-suggest-uris'." - (let ((obseen (make-vector 42 0)) + (let ((obseen (obarray-make 42)) (uris nil)) (dolist (fun eww-suggest-uris) (let ((ret (funcall fun))) diff --git a/lisp/net/imap.el b/lisp/net/imap.el index f10b5b8fc12..a06740528e9 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -1057,7 +1057,7 @@ necessary. If nil, the buffer name is generated." (setq imap-capability nil) (setq streams nil)))))) (when (imap-opened buffer) - (setq imap-mailbox-data (make-vector imap-mailbox-prime 0))) + (setq imap-mailbox-data (obarray-make imap-mailbox-prime))) ;; (debug "opened+state+auth+buffer" (imap-opened buffer) imap-state imap-auth buffer) (when imap-stream buffer)))) @@ -1280,7 +1280,7 @@ If EXAMINE is non-nil, do a read-only select." (concat (if examine "EXAMINE" "SELECT") " \"" mailbox "\""))) (progn - (setq imap-message-data (make-vector imap-message-prime 0) + (setq imap-message-data (obarray-make imap-message-prime) imap-state (if examine 'examine 'selected)) imap-current-mailbox) ;; Failed SELECT/EXAMINE unselects current mailbox @@ -1722,7 +1722,7 @@ See `imap-enable-exchange-bug-workaround'." (string-to-number (nth 2 (imap-mailbox-get-1 'copyuid mailbox)))) (let ((old-mailbox imap-current-mailbox) (state imap-state) - (imap-message-data (make-vector 2 0))) + (imap-message-data (obarray-make 2))) (when (imap-mailbox-examine-1 mailbox) (prog1 (and (imap-fetch-safe '("*" . "*:*") "UID") @@ -1768,7 +1768,7 @@ first element. The rest of list contains the saved articles' UIDs." (imap-mailbox-get-1 'appenduid mailbox) (let ((old-mailbox imap-current-mailbox) (state imap-state) - (imap-message-data (make-vector 2 0))) + (imap-message-data (obarray-make 2))) (when (imap-mailbox-examine-1 mailbox) (prog1 (and (imap-fetch-safe '("*" . "*:*") "UID") diff --git a/lisp/obsolete/pgg.el b/lisp/obsolete/pgg.el index 6c00ad201f1..4c7b653155e 100644 --- a/lisp/obsolete/pgg.el +++ b/lisp/obsolete/pgg.el @@ -85,9 +85,9 @@ is true, or else the output buffer is displayed." (set-buffer standard-output) (insert-buffer-substring pgg-errors-buffer)))) -(defvar pgg-passphrase-cache (make-vector 7 0)) +(defvar pgg-passphrase-cache (obarray-make 7)) -(defvar pgg-pending-timers (make-vector 7 0) +(defvar pgg-pending-timers (obarray-make 7) "Hash table for managing scheduled pgg cache management timers. We associate key and timer, so the timer can be canceled if a new diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el index c8e9d097a5f..c4697a0d3b9 100644 --- a/lisp/play/cookie1.el +++ b/lisp/play/cookie1.el @@ -65,7 +65,7 @@ (defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0" "Delimiter used to separate cookie file entries.") -(defvar cookie-cache (make-vector 511 0) +(defvar cookie-cache (obarray-make 511) "Cache of cookie files that have already been snarfed.") (defun cookie-check-file (file) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index f84d95dbc94..e45ab76ec07 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -2425,7 +2425,7 @@ system." (error "Unknown base mode `%s'" base-mode)) (put mode 'c-fallback-mode base-mode)) -(defvar c-lang-constants (make-vector 151 0)) +(defvar c-lang-constants (obarray-make 151)) ;; Obarray used as a cache to keep track of the language constants. ;; The constants stored are those defined by `c-lang-defconst' and the values ;; computed by `c-lang-const'. It's mostly used at compile time but it's not @@ -2630,7 +2630,7 @@ constant. A file is identified by its base name." ;; Clear the evaluated values that depend on this source. (let ((agenda (get sym 'dependents)) - (visited (make-vector 101 0)) + (visited (obarray-make 101)) ptr) (while agenda (setq sym (car agenda) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index ba0d1d0fc49..ae2389c75c2 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -3511,7 +3511,7 @@ Note that Java specific rules are currently applied to tell this from (let* ((alist (c-lang-const c-keyword-member-alist)) kwd lang-const-list - (obarray (make-vector (* (length alist) 2) 0))) + (obarray (obarray-make (* (length alist) 2)))) (while alist (setq kwd (caar alist) lang-const-list (cdar alist) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 1493845e2d9..a95cc732dab 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -197,7 +197,7 @@ VC commands are globally reachable under the prefix \\[vc-prefix-map]: ;; during any subsequent VC operations, and forget them when ;; the buffer is killed. -(defvar vc-file-prop-obarray (make-vector 17 0) +(defvar vc-file-prop-obarray (obarray-make 17) "Obarray for per-file properties.") (defvar vc-touched-properties nil) diff --git a/test/lisp/obarray-tests.el b/test/lisp/obarray-tests.el index d7e547fcf29..dd8f1c8abd4 100644 --- a/test/lisp/obarray-tests.el +++ b/test/lisp/obarray-tests.el @@ -32,7 +32,8 @@ (should-not (obarrayp "aoeu")) (should-not (obarrayp '())) (should-not (obarrayp [])) - (should (obarrayp (make-vector 7 0)))) + (should (obarrayp (obarray-make 7))) + (should (obarrayp (make-vector 7 0)))) ; for compatibility? (ert-deftest obarrayp-unchecked-content-test () "Should fail to check content of passed obarray." diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el index cb305ca0e55..99d522d1856 100644 --- a/test/src/minibuf-tests.el +++ b/test/src/minibuf-tests.el @@ -34,7 +34,7 @@ (let ((num 0)) (mapcar (lambda (str) (cons str (cl-incf num))) list))) (defun minibuf-tests--strings-to-obarray (list) - (let ((ob (make-vector 7 0))) + (let ((ob (obarray-make 7))) (mapc (lambda (str) (intern str ob)) list) ob)) (defun minibuf-tests--strings-to-string-hashtable (list) -- cgit v1.2.3 From 3beaa3131e78bea618cb93d03c5d8b0f8977fb94 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 10 Feb 2024 20:59:42 +0100 Subject: Use obarrayp, not vectorp, to detect obarrays * lisp/abbrev.el (abbrev--active-tables): * lisp/mail/mailabbrev.el (mail-abbrevs-setup, build-mail-abbrevs) (define-mail-abbrev, mail-resolve-all-aliases) (mail-abbrev-insert-alias): * lisp/mail/rmail.el (rmail-resend): * lisp/minibuffer.el (completion-table-with-context): * lisp/progmodes/etags.el (etags-tags-apropos-additional): (etags--xref-apropos-additional): Use obarrayp as predicate for obarrays. --- lisp/abbrev.el | 2 +- lisp/mail/mailabbrev.el | 12 ++++++------ lisp/mail/rmail.el | 2 +- lisp/minibuffer.el | 2 +- lisp/progmodes/etags.el | 4 ++-- 5 files changed, 11 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 2bd9faad69d..b523977fed5 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -721,7 +721,7 @@ either a single abbrev table or a list of abbrev tables." ;; to treat the distinction between a single table and a list of tables. (cond ((consp tables) tables) - ((vectorp tables) (list tables)) + ((obarrayp tables) (list tables)) (t (let ((tables (if (listp local-abbrev-table) (append local-abbrev-table diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el index 68d325ea261..c8006294a7d 100644 --- a/lisp/mail/mailabbrev.el +++ b/lisp/mail/mailabbrev.el @@ -171,7 +171,7 @@ no aliases, which is represented by this being a table with no entries.)") ;;;###autoload (defun mail-abbrevs-setup () "Initialize use of the `mailabbrev' package." - (if (and (not (vectorp mail-abbrevs)) + (if (and (not (obarrayp mail-abbrevs)) (file-exists-p mail-personal-alias-file)) (progn (setq mail-abbrev-modtime @@ -196,7 +196,7 @@ no aliases, which is represented by this being a table with no entries.)") "Read mail aliases from personal mail alias file and set `mail-abbrevs'. By default this is the file specified by `mail-personal-alias-file'." (setq file (expand-file-name (or file mail-personal-alias-file))) - (if (vectorp mail-abbrevs) + (if (obarrayp mail-abbrevs) nil (setq mail-abbrevs nil) (define-abbrev-table 'mail-abbrevs '())) @@ -278,7 +278,7 @@ double-quotes." ;; true, and we do some evil space->comma hacking like /bin/mail does. (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ") ;; Read the defaults first, if we have not done so. - (unless (vectorp mail-abbrevs) (build-mail-abbrevs)) + (unless (obarrayp mail-abbrevs) (build-mail-abbrevs)) ;; strip garbage from front and end (if (string-match "\\`[ \t\n,]+" definition) (setq definition (substring definition (match-end 0)))) @@ -355,7 +355,7 @@ double-quotes." (if mail-abbrev-aliases-need-to-be-resolved (progn ;; (message "Resolving mail aliases...") - (if (vectorp mail-abbrevs) + (if (obarrayp mail-abbrevs) (mapatoms (function mail-resolve-all-aliases-1) mail-abbrevs)) (setq mail-abbrev-aliases-need-to-be-resolved nil) ;; (message "Resolving mail aliases... done.") @@ -555,9 +555,9 @@ of a mail alias. The value is set up, buffer-local, when first needed.") (defun mail-abbrev-insert-alias (&optional alias) "Prompt for and insert a mail alias." (interactive (progn - (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup)) + (if (not (obarrayp mail-abbrevs)) (mail-abbrevs-setup)) (list (completing-read "Expand alias: " mail-abbrevs nil t)))) - (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup)) + (if (not (obarrayp mail-abbrevs)) (mail-abbrevs-setup)) (insert (or (and alias (symbol-value (intern-soft alias mail-abbrevs))) "")) (mail-abbrev-expand-hook)) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 85eaec33660..6f343c23bbe 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4097,7 +4097,7 @@ typically for purposes of moderating a list." (let ((end (point-marker)) (local-abbrev-table mail-abbrevs) (old-syntax-table (syntax-table))) - (if (and (not (vectorp mail-abbrevs)) + (if (and (not (obarrayp mail-abbrevs)) (file-exists-p mail-personal-alias-file)) (build-mail-abbrevs)) (unless mail-abbrev-syntax-table diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 708f3684d11..099fa1599d5 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -321,7 +321,7 @@ the form (concat S2 S)." ;; Predicates are called differently depending on the nature of ;; the completion table :-( (cond - ((vectorp table) ;Obarray. + ((obarrayp table) (lambda (sym) (funcall pred (concat prefix (symbol-name sym))))) ((hash-table-p table) (lambda (s _v) (funcall pred (concat prefix s)))) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index b9bd772ddfc..476037eb8bd 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1488,7 +1488,7 @@ hits the start of file." (setq symbs (symbol-value symbs)) (insert (format-message "symbol `%s' has no value\n" symbs)) (setq symbs nil))) - (if (vectorp symbs) + (if (obarrayp symbs) (mapatoms ins-symb symbs) (dolist (sy symbs) (funcall ins-symb (car sy)))) @@ -2183,7 +2183,7 @@ file name, add `tag-partial-file-name-match-p' to the list value.") (setq symbs (symbol-value symbs)) (warn "symbol `%s' has no value" symbs) (setq symbs nil)) - (if (vectorp symbs) + (if (obarrayp symbs) (mapatoms add-xref symbs) (dolist (sy symbs) (funcall add-xref (car sy)))) -- cgit v1.2.3 From 6a182658a533acab94d8fa0aec3e2b7a4f7d6a93 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 11 Feb 2024 18:30:22 +0100 Subject: Add obarray-clear and use it * lisp/obarray.el (obarray-clear): New. * lisp/abbrev.el (clear-abbrev-table): * lisp/vc/vc.el (vc-clear-context): Use it instead of assuming the obarray is a vector that can be 0-filled. * test/lisp/obarray-tests.el (obarray-clear): New test. --- lisp/abbrev.el | 3 +-- lisp/obarray.el | 5 +++++ lisp/vc/vc.el | 2 +- test/lisp/obarray-tests.el | 10 ++++++++++ 4 files changed, 17 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/abbrev.el b/lisp/abbrev.el index b523977fed5..188eeb720c0 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -602,8 +602,7 @@ It is nil if the abbrev has already been unexpanded.") "Undefine all abbrevs in abbrev table TABLE, leaving TABLE empty." (setq abbrevs-changed t) (let* ((sym (obarray-get table ""))) - (dotimes (i (length table)) - (aset table i 0)) + (obarray-clear table) ;; Preserve the table's properties. (cl-assert sym) (let ((newsym (obarray-put table ""))) diff --git a/lisp/obarray.el b/lisp/obarray.el index a26992df8e2..e1ebb2ade51 100644 --- a/lisp/obarray.el +++ b/lisp/obarray.el @@ -66,5 +66,10 @@ Return t on success, nil otherwise." "Call function FN on every symbol in obarray OB and return nil." (mapatoms fn ob)) +(defun obarray-clear (ob) + "Remove all symbols from obarray OB." + ;; FIXME: This doesn't change the symbols to uninterned status. + (fillarray ob 0)) + (provide 'obarray) ;;; obarray.el ends here diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 619b469bebb..3cd17276fa4 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -935,7 +935,7 @@ is sensitive to blank lines." (defun vc-clear-context () "Clear all cached file properties." (interactive) - (fillarray vc-file-prop-obarray 0)) + (obarray-clear vc-file-prop-obarray)) (defmacro with-vc-properties (files form settings) "Execute FORM, then maybe set per-file properties for FILES. diff --git a/test/lisp/obarray-tests.el b/test/lisp/obarray-tests.el index dd8f1c8abd4..dd40d0f4d76 100644 --- a/test/lisp/obarray-tests.el +++ b/test/lisp/obarray-tests.el @@ -89,5 +89,15 @@ (obarray-map collect-names table) (should (equal (sort syms #'string<) '("a" "b" "c"))))) +(ert-deftest obarray-clear () + (let ((o (obarray-make))) + (intern "a" o) + (intern "b" o) + (intern "c" o) + (obarray-clear o) + (let ((n 0)) + (mapatoms (lambda (_) (setq n (1+ n))) o) + (should (equal n 0))))) + (provide 'obarray-tests) ;;; obarray-tests.el ends here -- cgit v1.2.3 From 462d8ba813e07a25b71f5c1b38810a29e21f784c Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 10 Feb 2024 21:14:09 +0100 Subject: Add a proper type for obarrays The new opaque type replaces the previous use of vectors for obarrays. `obarray-make` now returns objects of this type. Functions that take obarrays continue to accept vectors for compatibility, now just using their first slot to store an actual obarray object. obarray-size and obarray-default-size now obsolete. * lisp/obarray.el (obarray-default-size, obarray-size): Declare obsolete. (obarray-make, obarrayp, obarray-clear): Remove from here. * src/fns.c (reduce_emacs_uint_to_hash_hash): Remove from here. * src/lisp.h (struct Lisp_Obarray, OBARRAYP, XOBARRAY, CHECK_OBARRAY) (make_lisp_obarray, obarray_size, check_obarray) (obarray_iter_t, make_obarray_iter, obarray_iter_at_end) (obarray_iter_step, obarray_iter_symbol, DOOBARRAY, knuth_hash): New. (reduce_emacs_uint_to_hash_hash): Moved here. * src/lread.c (check_obarray): Renamed and reworked as... (checked_obarray_slow): ...this. (intern_sym, Funintern, oblookup, map_obarray) (Finternal__obarray_buckets): Adapt to new type. (obarray_index, allocate_obarray, make_obarray, grow_obarray) (obarray_default_bits, Fobarray_make, Fobarrayp, Fobarray_clear): New. * etc/emacs_lldb.py (Lisp_Object): * lisp/emacs-lisp/cl-macs.el (`(,type . ,pred)): * lisp/emacs-lisp/cl-preloaded.el (cl--typeof-types): * lisp/emacs-lisp/comp-common.el (comp-known-type-specifiers): * lisp/emacs-lisp/comp.el (comp-known-predicates): * src/alloc.c (cleanup_vector, process_mark_stack): * src/data.c (Ftype_of, syms_of_data): * src/minibuf.c (Ftry_completion, Fall_completions, Ftest_completion): * src/pdumper.c (dump_obarray_buckets, dump_obarray, dump_vectorlike): * src/print.c (print_vectorlike_unreadable): * test/lisp/abbrev-tests.el (abbrev-make-abbrev-table-test): * test/lisp/obarray-tests.el (obarrayp-test) (obarrayp-unchecked-content-test, obarray-make-default-test) (obarray-make-with-size-test): Adapt to new type. --- etc/emacs_lldb.py | 1 + lisp/emacs-lisp/cl-macs.el | 1 + lisp/emacs-lisp/cl-preloaded.el | 2 +- lisp/emacs-lisp/comp-common.el | 3 +- lisp/emacs-lisp/comp.el | 1 + lisp/emacs-lisp/shortdoc.el | 19 ++- lisp/obarray.el | 27 +--- src/alloc.c | 26 +++- src/data.c | 2 + src/fns.c | 17 +-- src/lisp.h | 136 +++++++++++++++++- src/lread.c | 297 ++++++++++++++++++++++++++++------------ src/minibuf.c | 110 +++++---------- src/pdumper.c | 47 +++++++ src/print.c | 10 ++ test/lisp/abbrev-tests.el | 4 +- test/lisp/obarray-tests.el | 22 +-- 17 files changed, 499 insertions(+), 226 deletions(-) (limited to 'lisp') diff --git a/etc/emacs_lldb.py b/etc/emacs_lldb.py index fdf4314e2d0..9865fe391a2 100644 --- a/etc/emacs_lldb.py +++ b/etc/emacs_lldb.py @@ -56,6 +56,7 @@ class Lisp_Object: "PVEC_BOOL_VECTOR": "struct Lisp_Bool_Vector", "PVEC_BUFFER": "struct buffer", "PVEC_HASH_TABLE": "struct Lisp_Hash_Table", + "PVEC_OBARRAY": "struct Lisp_Obarray", "PVEC_TERMINAL": "struct terminal", "PVEC_WINDOW_CONFIGURATION": "struct save_window_data", "PVEC_SUBR": "struct Lisp_Subr", diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 44ebadeebff..ddc9775bcce 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3488,6 +3488,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." (natnum . natnump) (number . numberp) (null . null) + (obarray . obarrayp) (overlay . overlayp) (process . processp) (real . numberp) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index d533eea9e73..840219c2260 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -73,7 +73,7 @@ (module-function function atom) (buffer atom) (char-table array sequence atom) (bool-vector array sequence atom) - (frame atom) (hash-table atom) (terminal atom) + (frame atom) (hash-table atom) (terminal atom) (obarray atom) (thread atom) (mutex atom) (condvar atom) (font-spec atom) (font-entity atom) (font-object atom) (vector array sequence atom) diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index ca21ed05bb4..221f819e474 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -240,7 +240,8 @@ Used to modify the compiler environment." (integer-or-marker-p (function (t) boolean)) (integerp (function (t) boolean)) (interactive-p (function () boolean)) - (intern-soft (function ((or string symbol) &optional vector) symbol)) + (intern-soft (function ((or string symbol) &optional (or obarray vector)) + symbol)) (invocation-directory (function () string)) (invocation-name (function () string)) (isnan (function (float) boolean)) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index e0da01bcc5d..ae964b041d0 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -214,6 +214,7 @@ Useful to hook into pass checkers.") (number-or-marker-p . number-or-marker) (numberp . number) (numberp . number) + (obarrayp . obarray) (overlayp . overlay) (processp . process) (sequencep . sequence) diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index cde28985cd0..cbb5618ffce 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -747,9 +747,13 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), (intern :eval (intern "abc")) (intern-soft + :eval (intern-soft "list") :eval (intern-soft "Phooey!")) (make-symbol :eval (make-symbol "abc")) + (gensym + :no-eval (gensym) + :eg-result g37) "Comparing symbols" (eq :eval (eq 'abc 'abc) @@ -760,7 +764,20 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (equal 'abc 'abc)) "Name" (symbol-name - :eval (symbol-name 'abc))) + :eval (symbol-name 'abc)) + "Obarrays" + (obarray-make + :eval (obarray-make)) + (obarrayp + :eval (obarrayp (obarray-make)) + :eval (obarrayp nil)) + (unintern + :no-eval (unintern "abc" my-obarray) + :eg-result t) + (mapatoms + :no-eval (mapatoms (lambda (symbol) (print symbol)) my-obarray)) + (obarray-clear + :no-eval (obarray-clear my-obarray))) (define-short-documentation-group comparison "General-purpose" diff --git a/lisp/obarray.el b/lisp/obarray.el index e1ebb2ade51..e6e51c1382a 100644 --- a/lisp/obarray.el +++ b/lisp/obarray.el @@ -27,24 +27,12 @@ ;;; Code: -(defconst obarray-default-size 59 - "The value 59 is an arbitrary prime number that gives a good hash.") +(defconst obarray-default-size 4) +(make-obsolete-variable 'obarray-default-size + "obarrays now grow automatically" "30.1") -(defun obarray-make (&optional size) - "Return a new obarray of size SIZE or `obarray-default-size'." - (let ((size (or size obarray-default-size))) - (if (< 0 size) - (make-vector size 0) - (signal 'wrong-type-argument '(size 0))))) - -(defun obarray-size (ob) - "Return the number of slots of obarray OB." - (length ob)) - -(defun obarrayp (object) - "Return t if OBJECT is an obarray." - (and (vectorp object) - (< 0 (length object)))) +(defun obarray-size (_ob) obarray-default-size) +(make-obsolete 'obarray-size "obarrays now grow automatically" "30.1") ;; Don’t use obarray as a variable name to avoid shadowing. (defun obarray-get (ob name) @@ -66,10 +54,5 @@ Return t on success, nil otherwise." "Call function FN on every symbol in obarray OB and return nil." (mapatoms fn ob)) -(defun obarray-clear (ob) - "Remove all symbols from obarray OB." - ;; FIXME: This doesn't change the symbols to uninterned status. - (fillarray ob 0)) - (provide 'obarray) ;;; obarray.el ends here diff --git a/src/alloc.c b/src/alloc.c index 8c94c7eb33c..2ffd2415447 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -360,13 +360,13 @@ static struct gcstat object_ct total_intervals, total_free_intervals; object_ct total_buffers; - /* Size of the ancillary arrays of live hash-table objects. + /* Size of the ancillary arrays of live hash-table and obarray objects. The objects themselves are not included (counted as vectors above). */ byte_ct total_hash_table_bytes; } gcstat; -/* Total size of ancillary arrays of all allocated hash-table objects, - both dead and alive. This number is always kept up-to-date. */ +/* Total size of ancillary arrays of all allocated hash-table and obarray + objects, both dead and alive. This number is always kept up-to-date. */ static ptrdiff_t hash_table_allocated_bytes = 0; /* Points to memory space allocated as "spare", to be freed if we run @@ -3455,6 +3455,15 @@ cleanup_vector (struct Lisp_Vector *vector) hash_table_allocated_bytes -= bytes; } } + break; + case PVEC_OBARRAY: + { + struct Lisp_Obarray *o = PSEUDOVEC_STRUCT (vector, Lisp_Obarray); + xfree (o->buckets); + ptrdiff_t bytes = obarray_size (o) * sizeof *o->buckets; + hash_table_allocated_bytes -= bytes; + } + break; /* Keep the switch exhaustive. */ case PVEC_NORMAL_VECTOR: case PVEC_FREE: @@ -5632,7 +5641,8 @@ valid_lisp_object_p (Lisp_Object obj) return 0; } -/* Like xmalloc, but makes allocation count toward the total consing. +/* Like xmalloc, but makes allocation count toward the total consing + and hash table or obarray usage. Return NULL for a zero-sized allocation. */ void * hash_table_alloc_bytes (ptrdiff_t nbytes) @@ -7310,6 +7320,14 @@ process_mark_stack (ptrdiff_t base_sp) break; } + case PVEC_OBARRAY: + { + struct Lisp_Obarray *o = (struct Lisp_Obarray *)ptr; + set_vector_marked (ptr); + mark_stack_push_values (o->buckets, obarray_size (o)); + break; + } + case PVEC_CHAR_TABLE: case PVEC_SUB_CHAR_TABLE: mark_char_table (ptr, (enum pvec_type) pvectype); diff --git a/src/data.c b/src/data.c index f2f35fb355a..bb4cdd62d66 100644 --- a/src/data.c +++ b/src/data.c @@ -231,6 +231,7 @@ for example, (type-of 1) returns `integer'. */) case PVEC_BOOL_VECTOR: return Qbool_vector; case PVEC_FRAME: return Qframe; case PVEC_HASH_TABLE: return Qhash_table; + case PVEC_OBARRAY: return Qobarray; case PVEC_FONT: if (FONT_SPEC_P (object)) return Qfont_spec; @@ -4229,6 +4230,7 @@ syms_of_data (void) DEFSYM (Qtreesit_parser, "treesit-parser"); DEFSYM (Qtreesit_node, "treesit-node"); DEFSYM (Qtreesit_compiled_query, "treesit-compiled-query"); + DEFSYM (Qobarray, "obarray"); DEFSYM (Qdefun, "defun"); diff --git a/src/fns.c b/src/fns.c index 550545d1486..0a64e515402 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4450,16 +4450,6 @@ cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2, return hash_table_user_defined_call (ARRAYELTS (args), args, h); } -/* Reduce an EMACS_UINT hash value to hash_hash_t. */ -static inline hash_hash_t -reduce_emacs_uint_to_hash_hash (EMACS_UINT x) -{ - verify (sizeof x <= 2 * sizeof (hash_hash_t)); - return (sizeof x == sizeof (hash_hash_t) - ? x - : x ^ (x >> (8 * (sizeof x - sizeof (hash_hash_t))))); -} - static EMACS_INT sxhash_eq (Lisp_Object key) { @@ -4645,16 +4635,11 @@ copy_hash_table (struct Lisp_Hash_Table *h1) return make_lisp_hash_table (h2); } - /* Compute index into the index vector from a hash value. */ static inline ptrdiff_t hash_index_index (struct Lisp_Hash_Table *h, hash_hash_t hash) { - /* Knuth multiplicative hashing, tailored for 32-bit indices - (avoiding a 64-bit multiply). */ - uint32_t alpha = 2654435769; /* 2**32/phi */ - /* Note the cast to uint64_t, to make it work for index_bits=0. */ - return (uint64_t)((uint32_t)hash * alpha) >> (32 - h->index_bits); + return knuth_hash (hash, h->index_bits); } /* Resize hash table H if it's too full. If H cannot be resized diff --git a/src/lisp.h b/src/lisp.h index b02466390f1..5fbbef80e8e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1032,6 +1032,7 @@ enum pvec_type PVEC_BOOL_VECTOR, PVEC_BUFFER, PVEC_HASH_TABLE, + PVEC_OBARRAY, PVEC_TERMINAL, PVEC_WINDOW_CONFIGURATION, PVEC_SUBR, @@ -2386,6 +2387,118 @@ INLINE int definition is done by lread.c's define_symbol. */ #define DEFSYM(sym, name) /* empty */ + +struct Lisp_Obarray +{ + union vectorlike_header header; + + /* Array of 2**size_bits values, each being either a (bare) symbol or + the fixnum 0. The symbols for each bucket are chained via + their s.next field. */ + Lisp_Object *buckets; + + unsigned size_bits; /* log2(size of buckets vector) */ + unsigned count; /* number of symbols in obarray */ +}; + +INLINE bool +OBARRAYP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_OBARRAY); +} + +INLINE struct Lisp_Obarray * +XOBARRAY (Lisp_Object a) +{ + eassert (OBARRAYP (a)); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Obarray); +} + +INLINE void +CHECK_OBARRAY (Lisp_Object x) +{ + CHECK_TYPE (OBARRAYP (x), Qobarrayp, x); +} + +INLINE Lisp_Object +make_lisp_obarray (struct Lisp_Obarray *o) +{ + eassert (PSEUDOVECTOR_TYPEP (&o->header, PVEC_OBARRAY)); + return make_lisp_ptr (o, Lisp_Vectorlike); +} + +INLINE ptrdiff_t +obarray_size (const struct Lisp_Obarray *o) +{ + return (ptrdiff_t)1 << o->size_bits; +} + +Lisp_Object check_obarray_slow (Lisp_Object); + +/* Return an obarray object from OBARRAY or signal an error. */ +INLINE Lisp_Object +check_obarray (Lisp_Object obarray) +{ + return OBARRAYP (obarray) ? obarray : check_obarray_slow (obarray); +} + +/* Obarray iterator state. Don't access these members directly. + The iterator functions must be called in the order followed by DOOBARRAY. */ +typedef struct { + struct Lisp_Obarray *o; + ptrdiff_t idx; /* Current bucket index. */ + struct Lisp_Symbol *symbol; /* Current symbol, or NULL if at end + of current bucket. */ +} obarray_iter_t; + +INLINE obarray_iter_t +make_obarray_iter (struct Lisp_Obarray *oa) +{ + return (obarray_iter_t){.o = oa, .idx = -1, .symbol = NULL}; +} + +/* Whether IT has reached the end and there are no more symbols. + If true, IT is dead and cannot be used any more. */ +INLINE bool +obarray_iter_at_end (obarray_iter_t *it) +{ + if (it->symbol) + return false; + ptrdiff_t size = obarray_size (it->o); + while (++it->idx < size) + { + Lisp_Object obj = it->o->buckets[it->idx]; + if (!BASE_EQ (obj, make_fixnum (0))) + { + it->symbol = XBARE_SYMBOL (obj); + return false; + } + } + return true; +} + +/* Advance IT to the next symbol if any. */ +INLINE void +obarray_iter_step (obarray_iter_t *it) +{ + it->symbol = it->symbol->u.s.next; +} + +/* The Lisp symbol at IT, if obarray_iter_at_end returned false. */ +INLINE Lisp_Object +obarray_iter_symbol (obarray_iter_t *it) +{ + return make_lisp_symbol (it->symbol); +} + +/* Iterate IT over the symbols of the obarray OA. + The body shouldn't add or remove symbols in OA, but disobeying that rule + only risks symbols to be iterated more than once or not at all, + not crashes or data corruption. */ +#define DOOBARRAY(oa, it) \ + for (obarray_iter_t it = make_obarray_iter (oa); \ + !obarray_iter_at_end (&it); obarray_iter_step (&it)) + /*********************************************************************** Hash Tables @@ -2666,6 +2779,28 @@ SXHASH_REDUCE (EMACS_UINT x) return (x ^ x >> (EMACS_INT_WIDTH - FIXNUM_BITS)) & INTMASK; } +/* Reduce an EMACS_UINT hash value to hash_hash_t. */ +INLINE hash_hash_t +reduce_emacs_uint_to_hash_hash (EMACS_UINT x) +{ + verify (sizeof x <= 2 * sizeof (hash_hash_t)); + return (sizeof x == sizeof (hash_hash_t) + ? x + : x ^ (x >> (8 * (sizeof x - sizeof (hash_hash_t))))); +} + +/* Reduce HASH to a value BITS wide. */ +INLINE ptrdiff_t +knuth_hash (hash_hash_t hash, unsigned bits) +{ + /* Knuth multiplicative hashing, tailored for 32-bit indices + (avoiding a 64-bit multiply). */ + uint32_t alpha = 2654435769; /* 2**32/phi */ + /* Note the cast to uint64_t, to make it work for bits=0. */ + return (uint64_t)((uint32_t)hash * alpha) >> (32 - bits); +} + + struct Lisp_Marker { union vectorlike_header header; @@ -4585,7 +4720,6 @@ extern ptrdiff_t evxprintf (char **, ptrdiff_t *, char *, ptrdiff_t, ATTRIBUTE_FORMAT_PRINTF (5, 0); /* Defined in lread.c. */ -extern Lisp_Object check_obarray (Lisp_Object); extern Lisp_Object intern_1 (const char *, ptrdiff_t); extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t); extern Lisp_Object intern_driver (Lisp_Object, Lisp_Object, Lisp_Object); diff --git a/src/lread.c b/src/lread.c index c11c641440d..c4a34c5d73f 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4886,30 +4886,43 @@ static Lisp_Object initial_obarray; static size_t oblookup_last_bucket_number; -/* Get an error if OBARRAY is not an obarray. - If it is one, return it. */ +static Lisp_Object make_obarray (unsigned bits); +/* Slow path obarray check: return the obarray to use or signal an error. */ Lisp_Object -check_obarray (Lisp_Object obarray) +check_obarray_slow (Lisp_Object obarray) { - /* We don't want to signal a wrong-type-argument error when we are - shutting down due to a fatal error, and we don't want to hit - assertions in VECTORP and ASIZE if the fatal error was during GC. */ - if (!fatal_error_in_progress - && (!VECTORP (obarray) || ASIZE (obarray) == 0)) + /* For compatibility, we accept vectors whose first element is 0, + and store an obarray object there. */ + if (VECTORP (obarray) && ASIZE (obarray) > 0) { - /* If Vobarray is now invalid, force it to be valid. */ - if (EQ (Vobarray, obarray)) Vobarray = initial_obarray; - wrong_type_argument (Qvectorp, obarray); + Lisp_Object obj = AREF (obarray, 0); + if (OBARRAYP (obj)) + return obj; + if (BASE_EQ (obj, make_fixnum (0))) + { + /* Put an actual obarray object in the first slot. + The rest of the vector remains unused. */ + obj = make_obarray (0); + ASET (obarray, 0, obj); + return obj; + } } - return obarray; + /* Reset Vobarray to the standard obarray for nicer error handling. */ + if (BASE_EQ (Vobarray, obarray)) Vobarray = initial_obarray; + + wrong_type_argument (Qobarrayp, obarray); } +static void grow_obarray (struct Lisp_Obarray *o); + /* Intern symbol SYM in OBARRAY using bucket INDEX. */ +/* FIXME: retype arguments as pure C types */ static Lisp_Object intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) { + eassert (BARE_SYMBOL_P (sym) && OBARRAYP (obarray) && FIXNUMP (index)); struct Lisp_Symbol *s = XBARE_SYMBOL (sym); s->u.s.interned = (BASE_EQ (obarray, initial_obarray) ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY @@ -4925,9 +4938,13 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) SET_SYMBOL_VAL (s, sym); } - Lisp_Object *ptr = aref_addr (obarray, XFIXNUM (index)); + struct Lisp_Obarray *o = XOBARRAY (obarray); + Lisp_Object *ptr = o->buckets + XFIXNUM (index); s->u.s.next = BARE_SYMBOL_P (*ptr) ? XBARE_SYMBOL (*ptr) : NULL; *ptr = sym; + o->count++; + if (o->count > obarray_size (o)) + grow_obarray (o); return sym; } @@ -5082,7 +5099,6 @@ usage: (unintern NAME OBARRAY) */) { register Lisp_Object tem; Lisp_Object string; - size_t hash; if (NILP (obarray)) obarray = Vobarray; obarray = check_obarray (obarray); @@ -5122,41 +5138,42 @@ usage: (unintern NAME OBARRAY) */) /* if (NILP (tem) || EQ (tem, Qt)) error ("Attempt to unintern t or nil"); */ - XBARE_SYMBOL (tem)->u.s.interned = SYMBOL_UNINTERNED; + struct Lisp_Symbol *sym = XBARE_SYMBOL (tem); + sym->u.s.interned = SYMBOL_UNINTERNED; - hash = oblookup_last_bucket_number; + ptrdiff_t idx = oblookup_last_bucket_number; + Lisp_Object *loc = &XOBARRAY (obarray)->buckets[idx]; - if (BASE_EQ (AREF (obarray, hash), tem)) - { - if (XBARE_SYMBOL (tem)->u.s.next) - { - Lisp_Object sym; - XSETSYMBOL (sym, XBARE_SYMBOL (tem)->u.s.next); - ASET (obarray, hash, sym); - } - else - ASET (obarray, hash, make_fixnum (0)); - } + eassert (BARE_SYMBOL_P (*loc)); + struct Lisp_Symbol *prev = XBARE_SYMBOL (*loc); + if (sym == prev) + *loc = sym->u.s.next ? make_lisp_symbol (sym->u.s.next) : make_fixnum (0); else - { - Lisp_Object tail, following; + while (1) + { + struct Lisp_Symbol *next = prev->u.s.next; + if (next == sym) + { + prev->u.s.next = next->u.s.next; + break; + } + prev = next; + } - for (tail = AREF (obarray, hash); - XBARE_SYMBOL (tail)->u.s.next; - tail = following) - { - XSETSYMBOL (following, XBARE_SYMBOL (tail)->u.s.next); - if (BASE_EQ (following, tem)) - { - set_symbol_next (tail, XBARE_SYMBOL (following)->u.s.next); - break; - } - } - } + XOBARRAY (obarray)->count--; return Qt; } + +/* Bucket index of the string STR of length SIZE_BYTE bytes in obarray OA. */ +static ptrdiff_t +obarray_index (struct Lisp_Obarray *oa, const char *str, ptrdiff_t size_byte) +{ + EMACS_UINT hash = hash_string (str, size_byte); + return knuth_hash (reduce_emacs_uint_to_hash_hash (hash), oa->size_bits); +} + /* Return the symbol in OBARRAY whose names matches the string of SIZE characters (SIZE_BYTE bytes) at PTR. If there is no such symbol, return the integer bucket number of @@ -5167,36 +5184,27 @@ usage: (unintern NAME OBARRAY) */) Lisp_Object oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff_t size_byte) { - size_t hash; - size_t obsize; - register Lisp_Object tail; - Lisp_Object bucket, tem; + struct Lisp_Obarray *o = XOBARRAY (obarray); + ptrdiff_t idx = obarray_index (o, ptr, size_byte); + Lisp_Object bucket = o->buckets[idx]; - obarray = check_obarray (obarray); - /* This is sometimes needed in the middle of GC. */ - obsize = gc_asize (obarray); - hash = hash_string (ptr, size_byte) % obsize; - bucket = AREF (obarray, hash); - oblookup_last_bucket_number = hash; - if (BASE_EQ (bucket, make_fixnum (0))) - ; - else if (!BARE_SYMBOL_P (bucket)) - /* Like CADR error message. */ - xsignal2 (Qwrong_type_argument, Qobarrayp, - build_string ("Bad data in guts of obarray")); - else - for (tail = bucket; ; XSETSYMBOL (tail, XBARE_SYMBOL (tail)->u.s.next)) - { - Lisp_Object name = XBARE_SYMBOL (tail)->u.s.name; - if (SBYTES (name) == size_byte - && SCHARS (name) == size - && !memcmp (SDATA (name), ptr, size_byte)) - return tail; - else if (XBARE_SYMBOL (tail)->u.s.next == 0) - break; - } - XSETINT (tem, hash); - return tem; + oblookup_last_bucket_number = idx; + if (!BASE_EQ (bucket, make_fixnum (0))) + { + Lisp_Object sym = bucket; + while (1) + { + struct Lisp_Symbol *s = XBARE_SYMBOL (sym); + Lisp_Object name = s->u.s.name; + if (SBYTES (name) == size_byte && SCHARS (name) == size + && memcmp (SDATA (name), ptr, size_byte) == 0) + return sym; + if (s->u.s.next == NULL) + break; + sym = make_lisp_symbol(s->u.s.next); + } + } + return make_fixnum (idx); } /* Like 'oblookup', but considers 'Vread_symbol_shorthands', @@ -5263,24 +5271,134 @@ oblookup_considering_shorthand (Lisp_Object obarray, const char *in, } -void -map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg) +static struct Lisp_Obarray * +allocate_obarray (void) { - ptrdiff_t i; - register Lisp_Object tail; - CHECK_VECTOR (obarray); - for (i = ASIZE (obarray) - 1; i >= 0; i--) + return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Obarray, PVEC_OBARRAY); +} + +static Lisp_Object +make_obarray (unsigned bits) +{ + struct Lisp_Obarray *o = allocate_obarray (); + o->count = 0; + o->size_bits = bits; + ptrdiff_t size = (ptrdiff_t)1 << bits; + o->buckets = hash_table_alloc_bytes (size * sizeof *o->buckets); + for (ptrdiff_t i = 0; i < size; i++) + o->buckets[i] = make_fixnum (0); + return make_lisp_obarray (o); +} + +enum { + obarray_default_bits = 3, + word_size_log2 = word_size < 8 ? 5 : 6, /* good enough */ + obarray_max_bits = min (8 * sizeof (int), + 8 * sizeof (ptrdiff_t) - word_size_log2) - 1, +}; + +static void +grow_obarray (struct Lisp_Obarray *o) +{ + ptrdiff_t old_size = obarray_size (o); + eassert (o->count > old_size); + Lisp_Object *old_buckets = o->buckets; + + int new_bits = o->size_bits + 1; + if (new_bits > obarray_max_bits) + error ("Obarray too big"); + ptrdiff_t new_size = (ptrdiff_t)1 << new_bits; + o->buckets = hash_table_alloc_bytes (new_size * sizeof *o->buckets); + for (ptrdiff_t i = 0; i < new_size; i++) + o->buckets[i] = make_fixnum (0); + o->size_bits = new_bits; + + /* Rehash symbols. + FIXME: this is expensive since we need to recompute the hash for every + symbol name. Would it be reasonable to store it in the symbol? */ + for (ptrdiff_t i = 0; i < old_size; i++) { - tail = AREF (obarray, i); - if (BARE_SYMBOL_P (tail)) - while (1) - { - (*fn) (tail, arg); - if (XBARE_SYMBOL (tail)->u.s.next == 0) - break; - XSETSYMBOL (tail, XBARE_SYMBOL (tail)->u.s.next); - } + Lisp_Object obj = old_buckets[i]; + if (BARE_SYMBOL_P (obj)) + { + struct Lisp_Symbol *s = XBARE_SYMBOL (obj); + while (1) + { + Lisp_Object name = s->u.s.name; + ptrdiff_t idx = obarray_index (o, SSDATA (name), SBYTES (name)); + Lisp_Object *loc = o->buckets + idx; + struct Lisp_Symbol *next = s->u.s.next; + s->u.s.next = BARE_SYMBOL_P (*loc) ? XBARE_SYMBOL (*loc) : NULL; + *loc = make_lisp_symbol (s); + if (next == NULL) + break; + s = next; + } + } } + + hash_table_free_bytes (old_buckets, old_size * sizeof *old_buckets); +} + +DEFUN ("obarray-make", Fobarray_make, Sobarray_make, 0, 1, 0, + doc: /* Return a new obarray of size SIZE. +The obarray will grow to accommodate any number of symbols; the size, if +given, is only a hint for the expected number. */) + (Lisp_Object size) +{ + int bits; + if (NILP (size)) + bits = obarray_default_bits; + else + { + CHECK_FIXNAT (size); + EMACS_UINT n = XFIXNUM (size); + bits = elogb (n) + 1; + if (bits > obarray_max_bits) + xsignal (Qargs_out_of_range, size); + } + return make_obarray (bits); +} + +DEFUN ("obarrayp", Fobarrayp, Sobarrayp, 1, 1, 0, + doc: /* Return t iff OBJECT is an obarray. */) + (Lisp_Object object) +{ + return OBARRAYP (object) ? Qt : Qnil; +} + +DEFUN ("obarray-clear", Fobarray_clear, Sobarray_clear, 1, 1, 0, + doc: /* Remove all symbols from OBARRAY. */) + (Lisp_Object obarray) +{ + CHECK_OBARRAY (obarray); + struct Lisp_Obarray *o = XOBARRAY (obarray); + + /* This function does not bother setting the status of its contained symbols + to uninterned. It doesn't matter very much. */ + int new_bits = obarray_default_bits; + int new_size = (ptrdiff_t)1 << new_bits; + Lisp_Object *new_buckets + = hash_table_alloc_bytes (new_size * sizeof *new_buckets); + for (ptrdiff_t i = 0; i < new_size; i++) + new_buckets[i] = make_fixnum (0); + + int old_size = obarray_size (o); + hash_table_free_bytes (o->buckets, old_size * sizeof *o->buckets); + o->buckets = new_buckets; + o->size_bits = new_bits; + o->count = 0; + + return Qnil; +} + +void +map_obarray (Lisp_Object obarray, + void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg) +{ + CHECK_OBARRAY (obarray); + DOOBARRAY (XOBARRAY (obarray), it) + (*fn) (obarray_iter_symbol (&it), arg); } static void @@ -5307,12 +5425,13 @@ DEFUN ("internal--obarray-buckets", (Lisp_Object obarray) { obarray = check_obarray (obarray); - ptrdiff_t size = ASIZE (obarray); + ptrdiff_t size = obarray_size (XOBARRAY (obarray)); + Lisp_Object ret = Qnil; for (ptrdiff_t i = 0; i < size; i++) { Lisp_Object bucket = Qnil; - Lisp_Object sym = AREF (obarray, i); + Lisp_Object sym = XOBARRAY (obarray)->buckets[i]; if (BARE_SYMBOL_P (sym)) while (1) { @@ -5332,6 +5451,7 @@ DEFUN ("internal--obarray-buckets", void init_obarray_once (void) { + /* FIXME: use PVEC_OBARRAY */ Vobarray = make_vector (OBARRAY_SIZE, make_fixnum (0)); initial_obarray = Vobarray; staticpro (&initial_obarray); @@ -5715,6 +5835,9 @@ syms_of_lread (void) defsubr (&Smapatoms); defsubr (&Slocate_file_internal); defsubr (&Sinternal__obarray_buckets); + defsubr (&Sobarray_make); + defsubr (&Sobarrayp); + defsubr (&Sobarray_clear); DEFVAR_LISP ("obarray", Vobarray, doc: /* Symbol table for use by `intern' and `read'. diff --git a/src/minibuf.c b/src/minibuf.c index 7c0c9799a60..df6ca7ce1d8 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1615,13 +1615,15 @@ or from one of the possible completions. */) ptrdiff_t bestmatchsize = 0; /* These are in bytes, too. */ ptrdiff_t compare, matchsize; + if (VECTORP (collection)) + collection = check_obarray (collection); enum { function_table, list_table, obarray_table, hash_table} type = (HASH_TABLE_P (collection) ? hash_table - : VECTORP (collection) ? obarray_table + : OBARRAYP (collection) ? obarray_table : ((NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection))) ? list_table : function_table)); - ptrdiff_t idx = 0, obsize = 0; + ptrdiff_t idx = 0; int matchcount = 0; Lisp_Object bucket, zero, end, tem; @@ -1634,12 +1636,9 @@ or from one of the possible completions. */) /* If COLLECTION is not a list, set TAIL just for gc pro. */ tail = collection; + obarray_iter_t obit; if (type == obarray_table) - { - collection = check_obarray (collection); - obsize = ASIZE (collection); - bucket = AREF (collection, idx); - } + obit = make_obarray_iter (XOBARRAY (collection)); while (1) { @@ -1658,24 +1657,10 @@ or from one of the possible completions. */) } else if (type == obarray_table) { - if (!EQ (bucket, zero)) - { - if (!SYMBOLP (bucket)) - error ("Bad data in guts of obarray"); - elt = bucket; - eltstring = elt; - if (XSYMBOL (bucket)->u.s.next) - XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next); - else - XSETFASTINT (bucket, 0); - } - else if (++idx >= obsize) + if (obarray_iter_at_end (&obit)) break; - else - { - bucket = AREF (collection, idx); - continue; - } + elt = eltstring = obarray_iter_symbol (&obit); + obarray_iter_step (&obit); } else /* if (type == hash_table) */ { @@ -1858,10 +1843,12 @@ with a space are ignored unless STRING itself starts with a space. */) { Lisp_Object tail, elt, eltstring; Lisp_Object allmatches; + if (VECTORP (collection)) + collection = check_obarray (collection); int type = HASH_TABLE_P (collection) ? 3 - : VECTORP (collection) ? 2 + : OBARRAYP (collection) ? 2 : NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection)); - ptrdiff_t idx = 0, obsize = 0; + ptrdiff_t idx = 0; Lisp_Object bucket, tem, zero; CHECK_STRING (string); @@ -1872,12 +1859,9 @@ with a space are ignored unless STRING itself starts with a space. */) /* If COLLECTION is not a list, set TAIL just for gc pro. */ tail = collection; + obarray_iter_t obit; if (type == 2) - { - collection = check_obarray (collection); - obsize = ASIZE (collection); - bucket = AREF (collection, idx); - } + obit = make_obarray_iter (XOBARRAY (collection)); while (1) { @@ -1896,24 +1880,10 @@ with a space are ignored unless STRING itself starts with a space. */) } else if (type == 2) { - if (!EQ (bucket, zero)) - { - if (!SYMBOLP (bucket)) - error ("Bad data in guts of obarray"); - elt = bucket; - eltstring = elt; - if (XSYMBOL (bucket)->u.s.next) - XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next); - else - XSETFASTINT (bucket, 0); - } - else if (++idx >= obsize) + if (obarray_iter_at_end (&obit)) break; - else - { - bucket = AREF (collection, idx); - continue; - } + elt = eltstring = obarray_iter_symbol (&obit); + obarray_iter_step (&obit); } else /* if (type == 3) */ { @@ -2059,7 +2029,7 @@ If COLLECTION is a function, it is called with three arguments: the values STRING, PREDICATE and `lambda'. */) (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate) { - Lisp_Object tail, tem = Qnil, arg = Qnil; + Lisp_Object tem = Qnil, arg = Qnil; CHECK_STRING (string); @@ -2069,38 +2039,30 @@ the values STRING, PREDICATE and `lambda'. */) if (NILP (tem)) return Qnil; } - else if (VECTORP (collection)) + else if (OBARRAYP (collection) || VECTORP (collection)) { + collection = check_obarray (collection); /* Bypass intern-soft as that loses for nil. */ tem = oblookup (collection, SSDATA (string), SCHARS (string), SBYTES (string)); - if (completion_ignore_case && !SYMBOLP (tem)) - { - for (ptrdiff_t i = ASIZE (collection) - 1; i >= 0; i--) - { - tail = AREF (collection, i); - if (SYMBOLP (tail)) - while (1) - { - if (BASE_EQ (Fcompare_strings (string, make_fixnum (0), - Qnil, - Fsymbol_name (tail), - make_fixnum (0) , Qnil, Qt), - Qt)) - { - tem = tail; - break; - } - if (XSYMBOL (tail)->u.s.next == 0) - break; - XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next); - } - } - } + if (completion_ignore_case && !BARE_SYMBOL_P (tem)) + DOOBARRAY (XOBARRAY (collection), it) + { + Lisp_Object obj = obarray_iter_symbol (&it); + if (BASE_EQ (Fcompare_strings (string, make_fixnum (0), + Qnil, + Fsymbol_name (obj), + make_fixnum (0) , Qnil, Qt), + Qt)) + { + tem = obj; + break; + } + } - if (!SYMBOLP (tem)) + if (!BARE_SYMBOL_P (tem)) return Qnil; } else if (HASH_TABLE_P (collection)) diff --git a/src/pdumper.c b/src/pdumper.c index 778d8facabd..ca457858219 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2748,6 +2748,51 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object) return offset; } +static dump_off +dump_obarray_buckets (struct dump_context *ctx, const struct Lisp_Obarray *o) +{ + dump_align_output (ctx, DUMP_ALIGNMENT); + dump_off start_offset = ctx->offset; + ptrdiff_t n = obarray_size (o); + + struct dump_flags old_flags = ctx->flags; + ctx->flags.pack_objects = true; + + for (ptrdiff_t i = 0; i < n; i++) + { + Lisp_Object out; + const Lisp_Object *slot = &o->buckets[i]; + dump_object_start (ctx, &out, sizeof out); + dump_field_lv (ctx, &out, slot, slot, WEIGHT_STRONG); + dump_object_finish (ctx, &out, sizeof out); + } + + ctx->flags = old_flags; + return start_offset; +} + +static dump_off +dump_obarray (struct dump_context *ctx, Lisp_Object object) +{ +#if CHECK_STRUCTS && !defined HASH_Lisp_Obarray_XXXXXXXXXX +# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h." +#endif + const struct Lisp_Obarray *in_oa = XOBARRAY (object); + struct Lisp_Obarray munged_oa = *in_oa; + struct Lisp_Obarray *oa = &munged_oa; + START_DUMP_PVEC (ctx, &oa->header, struct Lisp_Obarray, out); + dump_pseudovector_lisp_fields (ctx, &out->header, &oa->header); + DUMP_FIELD_COPY (out, oa, count); + DUMP_FIELD_COPY (out, oa, size_bits); + dump_field_fixup_later (ctx, out, oa, &oa->buckets); + dump_off offset = finish_dump_pvec (ctx, &out->header); + dump_remember_fixup_ptr_raw + (ctx, + offset + dump_offsetof (struct Lisp_Obarray, buckets), + dump_obarray_buckets (ctx, oa)); + return offset; +} + static dump_off dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) { @@ -3031,6 +3076,8 @@ dump_vectorlike (struct dump_context *ctx, return dump_bool_vector(ctx, v); case PVEC_HASH_TABLE: return dump_hash_table (ctx, lv); + case PVEC_OBARRAY: + return dump_obarray (ctx, lv); case PVEC_BUFFER: return dump_buffer (ctx, XBUFFER (lv)); case PVEC_SUBR: diff --git a/src/print.c b/src/print.c index e2252562915..76c577ec800 100644 --- a/src/print.c +++ b/src/print.c @@ -2078,6 +2078,16 @@ print_vectorlike_unreadable (Lisp_Object obj, Lisp_Object printcharfun, } return; + case PVEC_OBARRAY: + { + struct Lisp_Obarray *o = XOBARRAY (obj); + /* FIXME: Would it make sense to print the actual symbols (up to + a limit)? */ + int i = sprintf (buf, "#", o->count); + strout (buf, i, i, printcharfun); + return; + } + /* Types handled earlier. */ case PVEC_NORMAL_VECTOR: case PVEC_RECORD: diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el index bfdfac8be1b..cdd1a7832d3 100644 --- a/test/lisp/abbrev-tests.el +++ b/test/lisp/abbrev-tests.el @@ -57,12 +57,10 @@ (ert-deftest abbrev-make-abbrev-table-test () ;; Table without properties: (let ((table (make-abbrev-table))) - (should (abbrev-table-p table)) - (should (= (length table) obarray-default-size))) + (should (abbrev-table-p table))) ;; Table with one property 'foo with value 'bar: (let ((table (make-abbrev-table '(foo bar)))) (should (abbrev-table-p table)) - (should (= (length table) obarray-default-size)) (should (eq (abbrev-table-get table 'foo) 'bar)))) (ert-deftest abbrev--table-symbols-test () diff --git a/test/lisp/obarray-tests.el b/test/lisp/obarray-tests.el index dd40d0f4d76..f9f97dba535 100644 --- a/test/lisp/obarray-tests.el +++ b/test/lisp/obarray-tests.el @@ -32,28 +32,18 @@ (should-not (obarrayp "aoeu")) (should-not (obarrayp '())) (should-not (obarrayp [])) - (should (obarrayp (obarray-make 7))) - (should (obarrayp (make-vector 7 0)))) ; for compatibility? - -(ert-deftest obarrayp-unchecked-content-test () - "Should fail to check content of passed obarray." - :expected-result :failed (should-not (obarrayp ["a" "b" "c"])) - (should-not (obarrayp [1 2 3]))) - -(ert-deftest obarray-make-default-test () - (let ((table (obarray-make))) - (should (obarrayp table)) - (should (eq (obarray-size table) obarray-default-size)))) + (should-not (obarrayp [1 2 3])) + (should-not (obarrayp (make-vector 7 0))) + (should-not (obarrayp (vector (obarray-make)))) + (should (obarrayp (obarray-make))) + (should (obarrayp (obarray-make 7)))) (ert-deftest obarray-make-with-size-test () ;; FIXME: Actually, `wrong-type-argument' is not the right error to signal, ;; so we shouldn't enforce this misbehavior in tests! (should-error (obarray-make -1) :type 'wrong-type-argument) - (should-error (obarray-make 0) :type 'wrong-type-argument) - (let ((table (obarray-make 1))) - (should (obarrayp table)) - (should (eq (obarray-size table) 1)))) + (should-error (obarray-make 'a) :type 'wrong-type-argument)) (ert-deftest obarray-get-test () (let ((table (obarray-make 3))) -- cgit v1.2.3 From 90d3b3408e404aba383302c3147d3ca614619986 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 23 Feb 2024 13:57:04 +0100 Subject: Warn about docstrings with control characters It is easy to include control chars in doc strings by mistake, and the result is often an unreadable mess. * lisp/emacs-lisp/bytecomp.el (byte-compile-warning-types) (byte-compile-warnings, byte-compile--docstring-style-warn): Add `docstrings-control-chars` warning. * etc/NEWS: Announce. --- etc/NEWS | 14 ++++++++++++++ lisp/emacs-lisp/bytecomp.el | 21 +++++++++++++++++++++ 2 files changed, 35 insertions(+) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index 1a5ddf0f7e3..6725b596ea9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1921,6 +1921,20 @@ name 'ignored-return-value'. The warning will only be issued for calls to functions declared 'important-return-value' or 'side-effect-free' (but not 'error-free'). +--- +*** Warn about docstrings that contain control characters. +The compiler now warns about docstrings with control characters other +than newline and tab. This is often a result of improper escaping. +Example: + + (defun my-fun () + "Uses c:\remote\dir\files and the key \C-x." + ...) + +where the doc string contains four control characters CR, DEL, FF and ^X. + +The warning name is 'docstrings-control-chars'. + --- *** The warning about wide docstrings can now be disabled separately. Its warning name is 'docstrings-wide'. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5d2aa3355be..c3355eedd75 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -285,6 +285,7 @@ The information is logged to `byte-compile-log-buffer'." (defconst byte-compile-warning-types '( callargs constants docstrings docstrings-non-ascii-quotes docstrings-wide + docstrings-control-chars empty-body free-vars ignored-return-value interactive-only lexical lexical-dynamic make-local mapcar ; obsolete @@ -307,6 +308,8 @@ Elements of the list may be: docstrings that are too wide, containing lines longer than both `byte-compile-docstring-max-column' and `fill-column' characters. Only enabled when `docstrings' also is. + docstrings-control-chars + docstrings that contain control characters other than NL and TAB empty-body body argument to a special form or macro is empty. free-vars references to variables not in the current lexical scope. ignored-return-value @@ -1769,6 +1772,24 @@ It is too wide if it has any lines longer than the largest of (byte-compile-warn-x name "%sdocstring wider than %s characters" (funcall prefix) col))) + + (when (byte-compile-warning-enabled-p 'docstrings-control-chars) + (let ((start 0) + (len (length docs))) + (while (and (< start len) + (string-match (rx (intersection (in (0 . 31) 127) + (not (in "\n\t")))) + docs start)) + (let* ((ofs (match-beginning 0)) + (c (aref docs ofs))) + ;; FIXME: it should be possible to use the exact source position + ;; of the control char in most cases, and it would be helpful + (byte-compile-warn-x + name + "%sdocstring contains control char #x%02x (position %d)" + (funcall prefix) c ofs) + (setq start (1+ ofs)))))) + ;; There's a "naked" ' character before a symbol/list, so it ;; should probably be quoted with \=. (when (string-match-p (rx (| (in " \t") bol) -- cgit v1.2.3 From 2b7dc7fef814753f1c6d4c352fe69bb6e167cd07 Mon Sep 17 00:00:00 2001 From: "Robert A. Burks" Date: Fri, 16 Feb 2024 18:17:52 -0500 Subject: Fix Flymake lighter tool-tip from generating errors Flymake tool-tip was generating errors on mouse over of mode-line lighter on inactive windows and on the minor mode indicator in the describe-mode Help page. * lisp/progmodes/flymake.el (flymake--mode-line-title): 'help-echo' now uses buffer local state and makes null check. (Bug#69248) Copyright-paperwork-exempt: yes --- lisp/progmodes/flymake.el | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 5974f076556..db00cc59c0e 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1569,13 +1569,19 @@ correctly.") ,flymake-mode-line-lighter mouse-face mode-line-highlight help-echo - ,(lambda (&rest _) - (concat - (format "%s known backends\n" (hash-table-count flymake--state)) - (format "%s running\n" (length (flymake-running-backends))) - (format "%s disabled\n" (length (flymake-disabled-backends))) - "mouse-1: Display minor mode menu\n" - "mouse-2: Show help for minor mode")) + ,(lambda (w &rest _) + (with-current-buffer (window-buffer w) + ;; Mouse can activate tool-tip without window being active. + ;; `flymake--state' is buffer local and is null when line + ;; lighter appears in *Help* `describe-mode'. + (concat + (unless (null flymake--state) + (concat + (format "%s known backends\n" (hash-table-count flymake--state)) + (format "%s running\n" (length (flymake-running-backends))) + (format "%s disabled\n" (length (flymake-disabled-backends))))) + "mouse-1: Display minor mode menu\n" + "mouse-2: Show help for minor mode"))) keymap ,(let ((map (make-sparse-keymap))) (define-key map [mode-line down-mouse-1] -- cgit v1.2.3 From 0b855e1465b26f69156a35befebb4167145cdccf Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 23 Feb 2024 11:31:43 -0500 Subject: (rmail-font-lock-keywords): Avoid old-style `font-lock*-face` variables * lisp/mail/rmail.el (rmail-font-lock-keywords): Refer directly to the font-lock faces. --- lisp/mail/rmail.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 6f343c23bbe..7ebfff3d7af 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -805,8 +805,8 @@ that knows the exact ordering of the \\( \\) subexpressions.") "\\(" cite-chars "[ \t]*\\)\\)+\\)" "\\(.*\\)") (beginning-of-line) (end-of-line) - (1 font-lock-comment-delimiter-face nil t) - (5 font-lock-comment-face nil t))) + (1 'font-lock-comment-delimiter-face nil t) + (5 'font-lock-comment-face nil t))) '("^\\(X-[a-z0-9-]+\\|In-Reply-To\\|Date\\):.*\\(\n[ \t]+.*\\)*$" . 'rmail-header-name)))) "Additional expressions to highlight in Rmail mode.") -- cgit v1.2.3 From 048eaadd8cc97faf0f3e70a8d81d06f915c52081 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 23 Feb 2024 11:37:24 -0500 Subject: rmail.el: Prefer #' to quote function names * lisp/mail/rmail.el (rmail-pop-to-buffer, rmail-mode-map) (rmail-mode-1, rmail-generate-viewer-buffer, rmail-variables) (rmail-find-all-files, rmail-insert-inbox-text) (rmail-set-message-counters, rmail-only-expunge, rmail-reply) (rmail-resend, rmail-fontify-buffer-function) (rmail-unfontify-buffer-function, rmail-install-speedbar-variables) (after-save-hook): Use #' where applicable. --- lisp/mail/rmail.el | 160 +++++++++++++++++++++++++++-------------------------- 1 file changed, 81 insertions(+), 79 deletions(-) (limited to 'lisp') diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 7ebfff3d7af..7006d59be66 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -815,7 +815,7 @@ that knows the exact ordering of the \\( \\) subexpressions.") (defun rmail-pop-to-buffer (&rest args) "Like `pop-to-buffer', but with `split-width-threshold' set to nil." (let (split-width-threshold) - (apply 'pop-to-buffer args))) + (apply #'pop-to-buffer args))) ;; Perform BODY in the summary buffer ;; in such a way that its cursor is properly updated in its own window. @@ -1008,66 +1008,66 @@ The buffer is expected to be narrowed to just the header of the message." (defvar rmail-mode-map (let ((map (make-keymap))) (suppress-keymap map) - (define-key map "a" 'rmail-add-label) - (define-key map "b" 'rmail-bury) - (define-key map "c" 'rmail-continue) - (define-key map "d" 'rmail-delete-forward) - (define-key map "\C-d" 'rmail-delete-backward) - (define-key map "e" 'rmail-edit-current-message) + (define-key map "a" #'rmail-add-label) + (define-key map "b" #'rmail-bury) + (define-key map "c" #'rmail-continue) + (define-key map "d" #'rmail-delete-forward) + (define-key map "\C-d" #'rmail-delete-backward) + (define-key map "e" #'rmail-edit-current-message) ;; If you change this, change the rmail-resend menu-item's :keys. - (define-key map "f" 'rmail-forward) - (define-key map "g" 'rmail-get-new-mail) - (define-key map "h" 'rmail-summary) - (define-key map "i" 'rmail-input) - (define-key map "j" 'rmail-show-message) - (define-key map "k" 'rmail-kill-label) - (define-key map "l" 'rmail-summary-by-labels) - (define-key map "\e\C-h" 'rmail-summary) - (define-key map "\e\C-l" 'rmail-summary-by-labels) - (define-key map "\e\C-r" 'rmail-summary-by-recipients) - (define-key map "\e\C-s" 'rmail-summary-by-regexp) - (define-key map "\e\C-f" 'rmail-summary-by-senders) - (define-key map "\e\C-t" 'rmail-summary-by-topic) - (define-key map "m" 'rmail-mail) - (define-key map "\em" 'rmail-retry-failure) - (define-key map "n" 'rmail-next-undeleted-message) - (define-key map "\en" 'rmail-next-message) - (define-key map "\e\C-n" 'rmail-next-labeled-message) - (define-key map "o" 'rmail-output) - (define-key map "\C-o" 'rmail-output-as-seen) - (define-key map "p" 'rmail-previous-undeleted-message) - (define-key map "\ep" 'rmail-previous-message) - (define-key map "\e\C-p" 'rmail-previous-labeled-message) - (define-key map "q" 'rmail-quit) - (define-key map "r" 'rmail-reply) + (define-key map "f" #'rmail-forward) + (define-key map "g" #'rmail-get-new-mail) + (define-key map "h" #'rmail-summary) + (define-key map "i" #'rmail-input) + (define-key map "j" #'rmail-show-message) + (define-key map "k" #'rmail-kill-label) + (define-key map "l" #'rmail-summary-by-labels) + (define-key map "\e\C-h" #'rmail-summary) + (define-key map "\e\C-l" #'rmail-summary-by-labels) + (define-key map "\e\C-r" #'rmail-summary-by-recipients) + (define-key map "\e\C-s" #'rmail-summary-by-regexp) + (define-key map "\e\C-f" #'rmail-summary-by-senders) + (define-key map "\e\C-t" #'rmail-summary-by-topic) + (define-key map "m" #'rmail-mail) + (define-key map "\em" #'rmail-retry-failure) + (define-key map "n" #'rmail-next-undeleted-message) + (define-key map "\en" #'rmail-next-message) + (define-key map "\e\C-n" #'rmail-next-labeled-message) + (define-key map "o" #'rmail-output) + (define-key map "\C-o" #'rmail-output-as-seen) + (define-key map "p" #'rmail-previous-undeleted-message) + (define-key map "\ep" #'rmail-previous-message) + (define-key map "\e\C-p" #'rmail-previous-labeled-message) + (define-key map "q" #'rmail-quit) + (define-key map "r" #'rmail-reply) ;; I find I can't live without the default M-r command -- rms. - ;; (define-key rmail-mode-map "\er" 'rmail-search-backwards) - (define-key map "s" 'rmail-expunge-and-save) - (define-key map "\es" 'rmail-search) - (define-key map "t" 'rmail-toggle-header) - (define-key map "u" 'rmail-undelete-previous-message) - (define-key map "v" 'rmail-mime) - (define-key map "w" 'rmail-output-body-to-file) - (define-key map "\C-c\C-w" 'rmail-widen) - (define-key map "x" 'rmail-expunge) - (define-key map "." 'rmail-beginning-of-message) - (define-key map "/" 'rmail-end-of-message) - (define-key map "<" 'rmail-first-message) - (define-key map ">" 'rmail-last-message) - (define-key map " " 'scroll-up-command) - (define-key map [?\S-\ ] 'scroll-down-command) - (define-key map "\177" 'scroll-down-command) - (define-key map "?" 'describe-mode) - (define-key map "\C-c\C-d" 'rmail-epa-decrypt) - (define-key map "\C-c\C-s\C-d" 'rmail-sort-by-date) - (define-key map "\C-c\C-s\C-s" 'rmail-sort-by-subject) - (define-key map "\C-c\C-s\C-a" 'rmail-sort-by-author) - (define-key map "\C-c\C-s\C-r" 'rmail-sort-by-recipient) - (define-key map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent) - (define-key map "\C-c\C-s\C-l" 'rmail-sort-by-lines) - (define-key map "\C-c\C-s\C-k" 'rmail-sort-by-labels) - (define-key map "\C-c\C-n" 'rmail-next-same-subject) - (define-key map "\C-c\C-p" 'rmail-previous-same-subject) + ;; (define-key rmail-mode-map "\er" #'rmail-search-backwards) + (define-key map "s" #'rmail-expunge-and-save) + (define-key map "\es" #'rmail-search) + (define-key map "t" #'rmail-toggle-header) + (define-key map "u" #'rmail-undelete-previous-message) + (define-key map "v" #'rmail-mime) + (define-key map "w" #'rmail-output-body-to-file) + (define-key map "\C-c\C-w" #'rmail-widen) + (define-key map "x" #'rmail-expunge) + (define-key map "." #'rmail-beginning-of-message) + (define-key map "/" #'rmail-end-of-message) + (define-key map "<" #'rmail-first-message) + (define-key map ">" #'rmail-last-message) + (define-key map " " #'scroll-up-command) + (define-key map [?\S-\ ] #'scroll-down-command) + (define-key map "\177" #'scroll-down-command) + (define-key map "?" #'describe-mode) + (define-key map "\C-c\C-d" #'rmail-epa-decrypt) + (define-key map "\C-c\C-s\C-d" #'rmail-sort-by-date) + (define-key map "\C-c\C-s\C-s" #'rmail-sort-by-subject) + (define-key map "\C-c\C-s\C-a" #'rmail-sort-by-author) + (define-key map "\C-c\C-s\C-r" #'rmail-sort-by-recipient) + (define-key map "\C-c\C-s\C-c" #'rmail-sort-by-correspondent) + (define-key map "\C-c\C-s\C-l" #'rmail-sort-by-lines) + (define-key map "\C-c\C-s\C-k" #'rmail-sort-by-labels) + (define-key map "\C-c\C-n" #'rmail-next-same-subject) + (define-key map "\C-c\C-p" #'rmail-previous-same-subject) (define-key map [menu-bar] (make-sparse-keymap)) @@ -1344,9 +1344,9 @@ Instead, these commands are available: (setq local-abbrev-table text-mode-abbrev-table) ;; Functions to support buffer swapping: (add-hook 'write-region-annotate-functions - 'rmail-write-region-annotate nil t) - (add-hook 'kill-buffer-hook 'rmail-mode-kill-buffer-hook nil t) - (add-hook 'change-major-mode-hook 'rmail-change-major-mode-hook nil t)) + #'rmail-write-region-annotate nil t) + (add-hook 'kill-buffer-hook #'rmail-mode-kill-buffer-hook nil t) + (add-hook 'change-major-mode-hook #'rmail-change-major-mode-hook nil t)) (defun rmail-generate-viewer-buffer () "Return a reusable buffer suitable for viewing messages. @@ -1363,7 +1363,7 @@ Create the buffer if necessary." (file-name-nondirectory (or buffer-file-name (buffer-name))))))) (with-current-buffer newbuf - (add-hook 'kill-buffer-hook 'rmail-view-buffer-kill-buffer-hook nil t)) + (add-hook 'kill-buffer-hook #'rmail-view-buffer-kill-buffer-hook nil t)) newbuf))) (defun rmail-swap-buffers () @@ -1479,7 +1479,7 @@ If so restore the actual mbox message collection." ;; Don't turn off auto-saving based on the size of the buffer ;; because that code does not understand buffer-swapping. (setq-local auto-save-include-big-deletions t) - (setq-local revert-buffer-function 'rmail-revert) + (setq-local revert-buffer-function #'rmail-revert) (setq-local font-lock-defaults '(rmail-font-lock-keywords t t nil nil @@ -1490,7 +1490,7 @@ If so restore the actual mbox message collection." (setq-local file-precious-flag t) (setq-local desktop-save-buffer t) (setq-local save-buffer-coding-system 'no-conversion) - (setq next-error-move-function 'rmail-next-error-move)) + (setq next-error-move-function #'rmail-next-error-move)) ;; Handle M-x revert-buffer done in an rmail-mode buffer. (defun rmail-revert (arg noconfirm) @@ -1606,7 +1606,7 @@ The duplicate copy goes into the Rmail file just after the original." (files (directory-files start t rmail-secondary-file-regexp))) ;; Sort here instead of in directory-files ;; because this list is usually much shorter. - (sort files 'string<)))) + (sort files #'string<)))) (defun rmail-list-to-menu (menu-name l action &optional full-name) (let ((menu (make-sparse-keymap menu-name)) @@ -2026,7 +2026,7 @@ Value is the size of the newly read mail after conversion." rmail-movemail-flags) (list file tofile) (if password (list password) nil)))) - (apply 'call-process args)) + (apply #'call-process args)) (if (not (buffer-modified-p errors)) ;; No output => movemail won nil @@ -2518,7 +2518,7 @@ Output a helpful message unless NOMSG is non-nil." ;; which will never be used. (push nil messages-head) (push ?0 deleted-head) - (setq rmail-message-vector (apply 'vector messages-head) + (setq rmail-message-vector (apply #'vector messages-head) rmail-deleted-vector (concat deleted-head)) (setq rmail-summary-vector (make-vector rmail-total-messages nil) @@ -3605,10 +3605,10 @@ If `rmail-confirm-expunge' is non-nil, ask user to confirm." (cons (aref messages number) nil))) (setq rmail-current-message new-message-number rmail-total-messages counter - rmail-message-vector (apply 'vector messages-head) + rmail-message-vector (apply #'vector messages-head) rmail-deleted-vector (make-string (1+ counter) ?\s) rmail-summary-vector (vconcat (nreverse new-summary)) - rmail-msgref-vector (apply 'vector (nreverse new-msgref)) + rmail-msgref-vector (apply #'vector (nreverse new-msgref)) win t))) (message "Expunging deleted messages...done") (if (not win) @@ -3891,7 +3891,7 @@ use \\[mail-yank-original] to yank the original message into it." (if (or references message-id) (list (cons "References" (if references (concat - (mapconcat 'identity references " ") + (mapconcat #'identity references " ") " " message-id) message-id))))))) @@ -4089,7 +4089,7 @@ typically for purposes of moderating a list." (insert "Resent-Bcc: " (user-login-name) "\n")) (insert "Resent-To: " (if (stringp address) address - (mapconcat 'identity address ",\n\t")) + (mapconcat #'identity address ",\n\t")) "\n") ;; Expand abbrevs in the recipients. (save-excursion @@ -4335,7 +4335,7 @@ This has an effect only if a summary buffer exists." (defun rmail-fontify-buffer-function () ;; This function's symbol is bound to font-lock-fontify-buffer-function. - (add-hook 'rmail-show-message-hook 'rmail-fontify-message nil t) + (add-hook 'rmail-show-message-hook #'rmail-fontify-message nil t) ;; If we're already showing a message, fontify it now. (if rmail-current-message (rmail-fontify-message)) ;; Prevent Font Lock mode from kicking in. @@ -4346,7 +4346,7 @@ This has an effect only if a summary buffer exists." (with-silent-modifications (save-restriction (widen) - (remove-hook 'rmail-show-message-hook 'rmail-fontify-message t) + (remove-hook 'rmail-show-message-hook #'rmail-fontify-message t) (remove-text-properties (point-min) (point-max) '(rmail-fontified nil)) (font-lock-default-unfontify-buffer)))) @@ -4381,11 +4381,12 @@ browsing, and moving of messages." "Install those variables used by speedbar to enhance rmail." (unless rmail-speedbar-key-map (setq rmail-speedbar-key-map (speedbar-make-specialized-keymap)) - (define-key rmail-speedbar-key-map "e" 'speedbar-edit-line) - (define-key rmail-speedbar-key-map "r" 'speedbar-edit-line) - (define-key rmail-speedbar-key-map "\C-m" 'speedbar-edit-line) + (declare-function speedbar-edit-line "speedbar") + (define-key rmail-speedbar-key-map "e" #'speedbar-edit-line) + (define-key rmail-speedbar-key-map "r" #'speedbar-edit-line) + (define-key rmail-speedbar-key-map "\C-m" #'speedbar-edit-line) (define-key rmail-speedbar-key-map "M" - 'rmail-speedbar-move-message-to-folder-on-line))) + #'rmail-speedbar-move-message-to-folder-on-line))) ;; Mouse-3. (defvar rmail-speedbar-menu-items @@ -4829,7 +4830,8 @@ Content-Transfer-Encoding: base64\n") (with-current-buffer (if (rmail-buffers-swapped-p) rmail-buffer rmail-view-buffer) (setq buffer-file-coding-system rmail-message-encoding)))) -(add-hook 'after-save-hook 'rmail-after-save-hook) +;; FIXME: Don't do it globally!! +(add-hook 'after-save-hook #'rmail-after-save-hook) ;;; Mailing list support -- cgit v1.2.3 From 3599a9a1cf1f8bed7c7f00fd8f00b2bfc0c4271f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 23 Feb 2024 11:38:48 -0500 Subject: * lisp/mail/rmail.el (rmail-resend): Use `with-syntax-table` --- lisp/mail/rmail.el | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 7006d59be66..d422383acdf 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4095,20 +4095,18 @@ typically for purposes of moderating a list." (save-excursion (if (featurep 'mailabbrev) (let ((end (point-marker)) - (local-abbrev-table mail-abbrevs) - (old-syntax-table (syntax-table))) + (local-abbrev-table mail-abbrevs)) (if (and (not (obarrayp mail-abbrevs)) (file-exists-p mail-personal-alias-file)) (build-mail-abbrevs)) (unless mail-abbrev-syntax-table (mail-abbrev-make-syntax-table)) - (set-syntax-table mail-abbrev-syntax-table) - (goto-char before) - (while (and (< (point) end) - (progn (forward-word-strictly 1) - (<= (point) end))) - (expand-abbrev)) - (set-syntax-table old-syntax-table)) + (with-syntax-table mail-abbrev-syntax-table + (goto-char before) + (while (and (< (point) end) + (progn (forward-word-strictly 1) + (<= (point) end))) + (expand-abbrev)))) (expand-mail-aliases before (point))))) ;;>> Set up comment, if any. (if (and (sequencep comment) (not (zerop (length comment)))) -- cgit v1.2.3 From 84f72f19e514db8f8f6e469340fb5fa0719d40b6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 23 Feb 2024 16:46:01 -0500 Subject: elisp-mode.el: Use `handler-bind` instead of `debug-on-error` * lisp/progmodes/elisp-mode.el (elisp-enable-lexical-binding): Don't get fooled by a global binding of `lexical-binding` to t. (elisp--eval-last-sexp-fake-value): Delete var. (elisp--eval-defun): Don't let-bind `debug-on-error` since it's already arranged by the only caller. (eval-last-sexp, eval-defun): Use `handler-bind` instead of `debug-on-error`. --- lisp/progmodes/elisp-mode.el | 38 +++++++++++++------------------------- 1 file changed, 13 insertions(+), 25 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index e0c18214ef7..4b1f8022f81 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -309,7 +309,7 @@ Comments in the form will be lost." INTERACTIVE non-nil means ask the user for confirmation; this happens in interactive invocations." (interactive "p") - (if lexical-binding + (if (and (local-variable-p 'lexical-binding) lexical-binding) (when interactive (message "lexical-binding already enabled!") (ding)) @@ -371,6 +371,12 @@ be used instead. ;; Font-locking support. +(defun elisp--font-lock-shorthand (_limit) + ;; Add faces on shorthands between point and LIMIT. + ;; ... + ;; Return nil to tell font-lock, that there's nothing left to do. + nil) + (defun elisp--font-lock-flush-elisp-buffers (&optional file) ;; We're only ever called from after-load-functions, load-in-progress can ;; still be t in case of nested loads. @@ -1582,9 +1588,6 @@ character)." (buffer-substring-no-properties beg end)) )))) - -(defvar elisp--eval-last-sexp-fake-value (make-symbol "t")) - (defun eval-sexp-add-defvars (exp &optional pos) "Prepend EXP with all the `defvar's that precede it in the buffer. POS specifies the starting position where EXP was found and defaults to point." @@ -1626,16 +1629,9 @@ integer value is also printed as a character of that codepoint. If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger." (interactive "P") - (if (null eval-expression-debug-on-error) - (values--store-value - (elisp--eval-last-sexp eval-last-sexp-arg-internal)) - (let ((value - (let ((debug-on-error elisp--eval-last-sexp-fake-value)) - (cons (elisp--eval-last-sexp eval-last-sexp-arg-internal) - debug-on-error)))) - (unless (eq (cdr value) elisp--eval-last-sexp-fake-value) - (setq debug-on-error (cdr value))) - (car value)))) + (values--store-value + (handler-bind ((error (if #'eval-expression--debug #'ignore))) + (elisp--eval-last-sexp eval-last-sexp-arg-internal)))) (defun elisp--eval-defun-1 (form) "Treat some expressions in FORM specially. @@ -1694,8 +1690,7 @@ Return the result of evaluation." ;; FIXME: the print-length/level bindings should only be applied while ;; printing, not while evaluating. (defvar elisp--eval-defun-result) - (let ((debug-on-error eval-expression-debug-on-error) - (edebugging edebug-all-defs) + (let ((edebugging edebug-all-defs) elisp--eval-defun-result) (save-excursion ;; Arrange for eval-region to "read" the (possibly) altered form. @@ -1774,15 +1769,8 @@ which see." (defvar edebug-all-defs) (eval-defun (not edebug-all-defs))) (t - (if (null eval-expression-debug-on-error) - (elisp--eval-defun) - (let (new-value value) - (let ((debug-on-error elisp--eval-last-sexp-fake-value)) - (setq value (elisp--eval-defun)) - (setq new-value debug-on-error)) - (unless (eq elisp--eval-last-sexp-fake-value new-value) - (setq debug-on-error new-value)) - value))))) + (handler-bind ((error (if #'eval-expression--debug #'ignore))) + (elisp--eval-defun))))) ;;; ElDoc Support -- cgit v1.2.3 From 26290870b3505b8971c73fe3a82b69e3c4e86b88 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 23 Feb 2024 17:03:10 -0500 Subject: diff-mode.el (diff-refine-nonmodified): New option * lisp/vc/diff-mode.el (diff-font-lock-keywords): Refer directly to font-lock faces. (diff-apply-hunk): Use `user-error` for errors usually not due to bugs. (diff--refine-propertize): New function. (diff-refine-nonmodified): New custom var (bug#61396). (diff--refine-hunk): Use them. --- etc/NEWS | 5 +++++ lisp/vc/diff-mode.el | 51 +++++++++++++++++++++++++++++++++++++-------------- 2 files changed, 42 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index 6725b596ea9..5653b51784f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -596,6 +596,11 @@ It allows tweaking the thresholds for rename and copy detection. ** Diff mode +--- +*** New user option 'diff-refine-nonmodified'. +Makes 'diff-refine' highlight added and removed whole lines with the +same faces as the words added and removed within modified lines. + +++ *** 'diff-ignore-whitespace-hunk' can now be applied to all hunks. When called with a non-nil prefix argument, diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 34a4b70691d..f914cc76790 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -517,8 +517,8 @@ use the face `diff-removed' for removed lines, and the face ("^Only in .*\n" . 'diff-nonexistent) ("^Binary files .* differ\n" . 'diff-file-header) ("^\\(#\\)\\(.*\\)" - (1 font-lock-comment-delimiter-face) - (2 font-lock-comment-face)) + (1 'font-lock-comment-delimiter-face) + (2 'font-lock-comment-face)) ("^diff: .*" (0 'diff-error)) ("^[^-=+*!<>#].*\n" (0 'diff-context)) (,#'diff--font-lock-syntax) @@ -944,7 +944,8 @@ like \(diff-merge-strings \"b/foo\" \"b/bar\" \"/a/c/foo\")." (when (and (string-match (concat "\\`\\(.*?\\)\\(.*\\)\\(.*\\)\n" "\\1\\(.*\\)\\3\n" - "\\(.*\\(\\2\\).*\\)\\'") str) + "\\(.*\\(\\2\\).*\\)\\'") + str) (equal to (match-string 5 str))) (concat (substring str (match-beginning 5) (match-beginning 6)) (match-string 4 str) @@ -1999,7 +2000,7 @@ With a prefix argument, REVERSE the hunk." (diff-find-source-location nil reverse))) (cond ((null line-offset) - (error "Can't find the text to patch")) + (user-error "Can't find the text to patch")) ((with-current-buffer buf (and buffer-file-name (backup-file-name-p buffer-file-name) @@ -2008,7 +2009,7 @@ With a prefix argument, REVERSE the hunk." (yes-or-no-p (format "Really apply this hunk to %s? " (file-name-nondirectory buffer-file-name))))))) - (error "%s" + (user-error "%s" (substitute-command-keys (format "Use %s\\[diff-apply-hunk] to apply it to the other file" (if (not reverse) "\\[universal-argument] "))))) @@ -2275,6 +2276,18 @@ Return new point, if it was moved." (end (progn (diff-end-of-hunk) (point)))) (diff--refine-hunk beg end))))) +(defun diff--refine-propertize (beg end face) + (let ((ol (make-overlay beg end))) + (overlay-put ol 'diff-mode 'fine) + (overlay-put ol 'evaporate t) + (overlay-put ol 'face face))) + +(defcustom diff-refine-nonmodified nil + "If non-nil also highlight as \"refined\" the added/removed lines. +This is currently only implemented for `unified' diffs." + :version "30.1" + :type 'boolean) + (defun diff--refine-hunk (start end) (require 'smerge-mode) (goto-char start) @@ -2289,18 +2302,28 @@ Return new point, if it was moved." (goto-char beg) (pcase style ('unified - (while (re-search-forward "^-" end t) + (while (re-search-forward "^[-+]" end t) (let ((beg-del (progn (beginning-of-line) (point))) beg-add end-add) - (when (and (diff--forward-while-leading-char ?- end) - ;; Allow for "\ No newline at end of file". - (progn (diff--forward-while-leading-char ?\\ end) - (setq beg-add (point))) - (diff--forward-while-leading-char ?+ end) - (progn (diff--forward-while-leading-char ?\\ end) - (setq end-add (point)))) + (cond + ((eq (char-after) ?+) + (diff--forward-while-leading-char ?+ end) + (when diff-refine-nonmodified + (diff--refine-propertize beg-del (point) 'diff-refine-added))) + ((and (diff--forward-while-leading-char ?- end) + ;; Allow for "\ No newline at end of file". + (progn (diff--forward-while-leading-char ?\\ end) + (setq beg-add (point))) + (diff--forward-while-leading-char ?+ end) + (progn (diff--forward-while-leading-char ?\\ end) + (setq end-add (point)))) (smerge-refine-regions beg-del beg-add beg-add end-add - nil #'diff-refine-preproc props-r props-a))))) + nil #'diff-refine-preproc props-r props-a)) + (t ;; If we're here, it's because + ;; (diff--forward-while-leading-char ?+ end) failed. + (when diff-refine-nonmodified + (diff--refine-propertize beg-del (point) + 'diff-refine-removed))))))) ('context (let* ((middle (save-excursion (re-search-forward "^---" end t))) (other middle)) -- cgit v1.2.3 From 56706254a8ee09e651097fb5075cae75b3bd4e22 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 21 Feb 2024 20:08:37 -0800 Subject: ; Don't mention erc-branded Compat macros in ERC-NEWS * doc/misc/erc.texi: Change fancy SASL example to also demonstrate `let'-binding a local module. * etc/ERC-NEWS: Don't mention `erc-compat-call' and `erc-compat-function' because Emacs now ships with a compat.el stub library. * lisp/erc/erc-backend.el (erc-decode-parsed-server-response): Add comments. * lisp/erc/erc.el (erc): Mention return value. --- doc/misc/erc.texi | 33 +++++++++++++++++++-------------- etc/ERC-NEWS | 2 -- lisp/erc/erc-backend.el | 2 ++ lisp/erc/erc.el | 5 +++-- 4 files changed, 24 insertions(+), 18 deletions(-) (limited to 'lisp') diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index f877fb681fe..c7ab7e7bf21 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -1230,25 +1230,30 @@ machine Example.Net login aph-bot password sesame (defun my-erc-up (network) (interactive "Snetwork: ") - - (pcase network - ('libera - (let ((erc-sasl-mechanism 'external)) - (erc-tls :server "irc.libera.chat" :port 6697 - :client-certificate t))) - ('example - (let ((erc-sasl-auth-source-function - #'erc-sasl-auth-source-password-as-host)) - (erc-tls :server "irc.example.net" :port 6697 - :user "alyssa" - :password "Example.Net"))))) + (require 'erc-sasl) + (or (let ((erc-modules (cons 'sasl erc-modules))) + (pcase network + ('libera + (let ((erc-sasl-mechanism 'external)) + (erc-tls :server "irc.libera.chat" + :client-certificate t))) + ('example + (let ((erc-sasl-auth-source-function + #'erc-sasl-auth-source-password-as-host)) + (erc-tls :server "irc.example.net" + :user "alyssa" + :password "Example.Net"))))) + ;; Non-SASL + (call-interactively #'erc-tls))) @end lisp You've started storing your credentials with auth-source and have decided to try SASL on another network as well. But there's a catch: this network doesn't support @samp{EXTERNAL}. You use -@code{let}-binding to get around this and successfully authenticate to -both networks. +@code{let}-binding to work around this and successfully authenticate +to both networks. (Note that this example assumes you've removed +@code{sasl} from @code{erc-modules} globally and have instead opted to +add it locally when connecting to preconfigured networks.) @end itemize diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index b2aceaa9f39..e8082582de3 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -694,8 +694,6 @@ by toggling a provided compatibility switch. See source code around the function 'erc-send-action' for details. *** Miscellaneous changes -Two helper macros from GNU ELPA's Compat library are now available to -third-party modules as 'erc-compat-call' and 'erc-compat-function'. In 'erc-button-alist', 'Info-goto-node' has been supplanted by plain old 'info', and the "" entry has been removed because it was more or less redundant. In all ERC buffers, the "" key is now diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 7b782d0ef44..9fc8a4d29f4 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1479,10 +1479,12 @@ for decoding." (let ((args (erc-response.command-args parsed-response)) (decode-target nil) (decoded-args ())) + ;; FIXME this should stop after the first match. (dolist (arg args nil) (when (string-match "^[#&].*" arg) (setq decode-target arg))) (when (stringp decode-target) + ;; FIXME `decode-target' should be passed as TARGET. (setq decode-target (erc-decode-string-from-target decode-target nil))) (setf (erc-response.unparsed parsed-response) (erc-decode-string-from-target diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index f250584e47a..5c8b3785bc6 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2772,8 +2772,9 @@ PORT, NICK, and PASSWORD, along with USER and FULL-NAME when given a prefix argument. Non-interactively, expect the rarely needed ID parameter, when non-nil, to be a symbol or a string for naming the server buffer and identifying the connection -unequivocally. (See Info node `(erc) Connecting' for details -about all mentioned parameters.) +unequivocally. Once connected, return the server buffer. (See +Info node `(erc) Connecting' for details about all mentioned +parameters.) Together with `erc-tls', this command serves as the main entry point for ERC, the powerful, modular, and extensible IRC client. -- cgit v1.2.3 From 15a140a24664e96620838136640d660f842dfa49 Mon Sep 17 00:00:00 2001 From: Emanuel Berg Date: Tue, 23 Jan 2024 14:21:49 +0100 Subject: Make erc-cmd-AMSG session local; add /GMSG, /AME and /GME * etc/ERC-NEWS: Mention new slash commands. * lisp/erc/erc.el (erc-cmd-AMSG): Make it consistent with the doc string by only affecting the current connection. (erc-cmd-GMSG, erc-cmd-AME, erc-cmd-GME): New IRC slash commands. * test/lisp/erc/erc-scenarios-misc-commands.el (erc-scenarios-misc-commands--AMSG-GMSG-AME-GME): New test. * test/lisp/erc/resources/commands/amsg-barnet.eld: New file. * test/lisp/erc/resources/commands/amsg-foonet.eld: New file. (Bug#68401) --- etc/ERC-NEWS | 9 ++- lisp/erc/erc.el | 38 ++++++++-- test/lisp/erc/erc-scenarios-misc-commands.el | 90 ++++++++++++++++++++++++ test/lisp/erc/resources/commands/amsg-barnet.eld | 54 ++++++++++++++ test/lisp/erc/resources/commands/amsg-foonet.eld | 56 +++++++++++++++ 5 files changed, 239 insertions(+), 8 deletions(-) create mode 100644 test/lisp/erc/resources/commands/amsg-barnet.eld create mode 100644 test/lisp/erc/resources/commands/amsg-foonet.eld (limited to 'lisp') diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index e8082582de3..d7f513addfb 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -334,6 +334,11 @@ has changed in some way. At present, ERC does not perform this step automatically on your behalf, even if a change was made in a 'Custom-mode' buffer or via 'setopt'. +** New broadcast-oriented slash commands /AME, /GME, and /GMSG. +Also available as the library functions 'erc-cmd-AME', 'erc-cmd-GME', +and 'erc-cmd-GMSG', these new slash commands can prove handy in test +environments. + ** Miscellaneous UX changes. Some minor quality-of-life niceties have finally made their way to ERC. For example, fool visibility has become togglable with the new @@ -1375,7 +1380,7 @@ reconnection attempts that ERC will make per server. in seconds, that ERC will wait between successive reconnect attempts. *** erc-server-send-ping-timeout: Determines when to consider a connection -stalled and restart it. The default is after 120 seconds. +stalled and restart it. The default is after 120 seconds. *** erc-system-name: Determines the system name to use when logging in. The default is to figure this out by calling `system-name'. @@ -2336,7 +2341,7 @@ in XEmacs. Please use M-x customize-variable RET erc-modules RET to change the default if it does not suite your needs. -** THe symbol used in `erc-nickserv-passwords' for debian.org IRC servers +** The symbol used in `erc-nickserv-passwords' for debian.org IRC servers (formerly called OpenProjects, now FreeNode) has changed from openprojects to freenode. You may need to update your configuration for a successful automatic nickserv identification. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 5c8b3785bc6..cce3b2508fb 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4046,16 +4046,42 @@ this function from interpreting the line as a command." ;; Input commands handlers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun erc-cmd-AMSG (line) - "Send LINE to all channels of the current server that you are on." - (interactive "sSend to all channels you're on: ") - (setq line (erc-trim-string line)) +(defun erc--connected-and-joined-p () + (and (erc--current-buffer-joined-p) + erc-server-connected)) + +(defun erc-cmd-GMSG (line) + "Send LINE to all channels on all networks you are on." + (setq line (string-remove-prefix " " line)) (erc-with-all-buffers-of-server nil - (lambda () - (erc-channel-p (erc-default-target))) + #'erc--connected-and-joined-p + (erc-send-message line))) +(put 'erc-cmd-GMSG 'do-not-parse-args t) + +(defun erc-cmd-AMSG (line) + "Send LINE to all channels of the current network. +Interactively, prompt for the line of text to send." + (interactive "sSend to all channels on this network: ") + (setq line (string-remove-prefix " " line)) + (erc-with-all-buffers-of-server erc-server-process + #'erc--connected-and-joined-p (erc-send-message line))) (put 'erc-cmd-AMSG 'do-not-parse-args t) +(defun erc-cmd-GME (line) + "Send LINE as an action to all channels on all networks you are on." + (erc-with-all-buffers-of-server nil + #'erc--connected-and-joined-p + (erc-cmd-ME line))) +(put 'erc-cmd-GME 'do-not-parse-args t) + +(defun erc-cmd-AME (line) + "Send LINE as an action to all channels on the current network." + (erc-with-all-buffers-of-server erc-server-process + #'erc--connected-and-joined-p + (erc-cmd-ME line))) +(put 'erc-cmd-AME 'do-not-parse-args t) + (defun erc-cmd-SAY (line) "Send LINE to the current query or channel as a message, not a command. diff --git a/test/lisp/erc/erc-scenarios-misc-commands.el b/test/lisp/erc/erc-scenarios-misc-commands.el index d6ed53b5358..da6855caf57 100644 --- a/test/lisp/erc/erc-scenarios-misc-commands.el +++ b/test/lisp/erc/erc-scenarios-misc-commands.el @@ -123,4 +123,94 @@ (should (string= (erc-server-user-host (erc-get-server-user "tester")) "some.host.test.cc")))))) +;; This tests four related slash commands, /AMSG, /GMSG, /AME, /GME, +;; the latter three introduced by bug#68401. It mainly asserts +;; correct routing behavior, especially not sending or inserting +;; messages in buffers belonging to disconnected sessions. Left +;; unaddressed are interactions with the `command-indicator' module +;; (`erc-noncommands-list') and whatever future `echo-message' +;; implementation manifests out of bug#49860. +(ert-deftest erc-scenarios-misc-commands--AMSG-GMSG-AME-GME () + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "commands") + (erc-server-flood-penalty 0.1) + (dumb-server-foonet (erc-d-run "localhost" t "srv-foonet" 'amsg-foonet)) + (dumb-server-barnet (erc-d-run "localhost" t "srv-barnet" 'amsg-barnet)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to foonet and join #foo") + (with-current-buffer + (erc :server "127.0.0.1" + :port (process-contact dumb-server-foonet :service) + :nick "tester") + (funcall expect 10 "debug mode") + (erc-cmd-JOIN "#foo"))) + + (ert-info ("Connect to barnet and join #bar") + (with-current-buffer + (erc :server "127.0.0.1" + :port (process-contact dumb-server-barnet :service) + :nick "tester") + (funcall expect 10 "debug mode") + (erc-cmd-JOIN "#bar"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#foo")) + (funcall expect 10 "welcome")) + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#bar")) + (funcall expect 10 "welcome")) + + (ert-info ("/AMSG only sent to issuing context's server") + (with-current-buffer "foonet" + (erc-scenarios-common-say "/amsg 1 foonet only")) + (with-current-buffer "barnet" + (erc-scenarios-common-say "/amsg 2 barnet only")) + (with-current-buffer "#foo" + (funcall expect 10 " 1 foonet only") + (funcall expect 10 " bob: Our queen and all")) + (with-current-buffer "#bar" + (funcall expect 10 " 2 barnet only") + (funcall expect 10 " mike: And secretly to greet"))) + + (ert-info ("/AME only sent to issuing context's server") + (with-current-buffer "foonet" + (erc-scenarios-common-say "/ame 3 foonet only")) + (with-current-buffer "barnet" + (erc-scenarios-common-say "/ame 4 barnet only")) + (with-current-buffer "#foo" + (funcall expect 10 "* tester 3 foonet only") + (funcall expect 10 " bob: You have discharged this")) + (with-current-buffer "#bar" + (funcall expect 10 "* tester 4 barnet only") + (funcall expect 10 " mike: That same Berowne"))) + + (ert-info ("/GMSG and /GME sent to all servers") + (with-current-buffer "foonet" + (erc-scenarios-common-say "/gmsg 5 all nets") + (erc-scenarios-common-say "/gme 6 all nets")) + (with-current-buffer "#bar" + (funcall expect 10 " 5 all nets") + (funcall expect 10 "* tester 6 all nets") + (funcall expect 10 " mike: Mehercle! if their sons"))) + + (ert-info ("/GMSG and /GME only sent to connected servers") + (with-current-buffer "barnet" + (erc-cmd-QUIT "") + (funcall expect 10 "ERC finished")) + (with-current-buffer "#foo" + (funcall expect 10 " 5 all nets") + (funcall expect 10 "* tester 6 all nets") + (funcall expect 10 " bob: Stand you!")) + (with-current-buffer "foonet" + (erc-scenarios-common-say "/gmsg 7 all live nets") + (erc-scenarios-common-say "/gme 8 all live nets")) + ;; Message *not* inserted in disconnected buffer. + (with-current-buffer "#bar" + (funcall expect -0.1 " 7 all live nets") + (funcall expect -0.1 "* tester 8 all live nets"))) + + (with-current-buffer "#foo" + (funcall expect 10 " 7 all live nets") + (funcall expect 10 "* tester 8 all live nets") + (funcall expect 10 " alice: Live, and be prosperous;")))) + ;;; erc-scenarios-misc-commands.el ends here diff --git a/test/lisp/erc/resources/commands/amsg-barnet.eld b/test/lisp/erc/resources/commands/amsg-barnet.eld new file mode 100644 index 00000000000..53b3e18651a --- /dev/null +++ b/test/lisp/erc/resources/commands/amsg-barnet.eld @@ -0,0 +1,54 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :unknown") + (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester") + (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16") + (0 ":irc.barnet.org 003 tester :This server was created Tue, 04 May 2021 05:06:19 UTC") + (0 ":irc.barnet.org 004 tester irc.barnet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0 ":irc.barnet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") + (0 ":irc.barnet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server") + (0 ":irc.barnet.org 005 tester draft/CHATHISTORY=100 :are supported by this server") + (0 ":irc.barnet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0 ":irc.barnet.org 252 tester 0 :IRC Operators online") + (0 ":irc.barnet.org 253 tester 0 :unregistered connections") + (0 ":irc.barnet.org 254 tester 1 :channels formed") + (0 ":irc.barnet.org 255 tester :I have 3 clients and 0 servers") + (0 ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3") + (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3") + (0 ":irc.barnet.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0 ":irc.barnet.org 221 tester +i") + (0 ":irc.barnet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((join 10 "JOIN #bar") + (0 ":tester!~u@jnu48g2wrycbw.irc JOIN #bar") + (0 ":irc.barnet.org 353 tester = #bar :@mike joe tester") + (0 ":irc.barnet.org 366 tester #bar :End of NAMES list")) + +((mode-bar 10 "MODE #bar") + (0 ":irc.barnet.org 324 tester #bar +nt") + (0 ":irc.barnet.org 329 tester #bar 1620104779") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :tester, welcome!") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :tester, welcome!") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: Whipp'd first, sir, and hang'd after.") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: We have yet many among us can gripe as hard as Cassibelan; I do not say I am one, but I have a hand. Why tribute ? why should we pay tribute ? If C sar can hide the sun from us with a blanket, or put the moon in his pocket, we will pay him tribute for light; else, sir, no more tribute, pray you now.")) + +((privmsg-2 10 "PRIVMSG #bar :2 barnet only") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: Double and treble admonition, and still forfeit in the same kind ? This would make mercy swear, and play the tyrant.") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: And secretly to greet the empress' friends.")) + +((privmsg-4 10 "PRIVMSG #bar :\1ACTION 4 barnet only\1") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: You have not been inquired after: I have sat here all day.") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: That same Berowne I'll torture ere I go.")) + +((privmsg-5 10 "PRIVMSG #bar :5 all nets")) + +((privmsg-6 10 "PRIVMSG #bar :\1ACTION 6 all nets\1") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: For mine own part,no offence to the general, nor any man of quality,I hope to be saved.") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: Mehercle! if their sons be ingenuous, they shall want no instruction; if their daughters be capable, I will put it to them. But, vir sapit qui pauca loquitur. A soul feminine saluteth us.")) + +((quit 5 "QUIT :\2ERC\2") + (0 ":tester!~u@jnu48g2wrycbw.irc QUIT :Quit")) + +((drop 0 DROP)) diff --git a/test/lisp/erc/resources/commands/amsg-foonet.eld b/test/lisp/erc/resources/commands/amsg-foonet.eld new file mode 100644 index 00000000000..eb3d84d646a --- /dev/null +++ b/test/lisp/erc/resources/commands/amsg-foonet.eld @@ -0,0 +1,56 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :unknown") + (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16") + (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC") + (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") + (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server") + (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server") + (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0 ":irc.foonet.org 254 tester 1 :channels formed") + (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0 ":irc.foonet.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0 ":irc.foonet.org 221 tester +i") + (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((join 10 "JOIN #foo") + (0 ":tester!~u@9g6b728983yd2.irc JOIN #foo") + (0 ":irc.foonet.org 353 tester = #foo :alice tester @bob") + (0 ":irc.foonet.org 366 tester #foo :End of NAMES list")) + +((mode-foo 10 "MODE #foo") + (0 ":irc.foonet.org 324 tester #foo +nt") + (0 ":irc.foonet.org 329 tester #foo 1620104779") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :tester, welcome!") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :tester, welcome!") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: But, as it seems, did violence on herself.") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Well, this is the forest of Arden.")) + +((privmsg-1 10 "PRIVMSG #foo :1 foonet only") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Signior Iachimo will not from it. Pray, let us follow 'em.") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Our queen and all her elves come here anon.")) + +((privmsg-3 10 "PRIVMSG #foo :\1ACTION 3 foonet only\1") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: The ground is bloody; search about the churchyard.") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: You have discharged this honestly: keep it to yourself. Many likelihoods informed me of this before, which hung so tottering in the balance that I could neither believe nor misdoubt. Pray you, leave me: stall this in your bosom; and I thank you for your honest care. I will speak with you further anon.")) + +((privmsg-5 10 "PRIVMSG #foo :5 all nets")) + +((privmsg-6 10 "PRIVMSG #foo :\1ACTION 6 all nets\1") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Give me that mattock, and the wrenching iron.") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Stand you! You have land enough of your own; but he added to your having, gave you some ground.")) + +((privmsg-6 10 "PRIVMSG #foo :7 all live nets") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Excellent workman! Thou canst not paint a man so bad as is thyself.")) + +((privmsg-6 10 "PRIVMSG #foo :\1ACTION 8 all live nets\1") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: And will you, being a man of your breeding, be married under a bush, like a beggar ? Get you to church, and have a good priest that can tell you what marriage is: this fellow will but join you together as they join wainscot; then one of you will prove a shrunk panel, and like green timber, warp, warp.") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Live, and be prosperous; and farewell, good fellow.")) -- cgit v1.2.3 From d1fe392f93ce7e71cd378326814ec4e3a4143f0c Mon Sep 17 00:00:00 2001 From: Arash Esbati Date: Sat, 24 Feb 2024 09:30:16 +0100 Subject: ; Fix compiler warning * lisp/textmodes/reftex-vars.el (reftex-cite-format-builtin): Fix character escaping in the docstring. (bug#69341) --- lisp/textmodes/reftex-vars.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index a0bc5c11ece..791b10412c9 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -235,11 +235,10 @@ distribution. Mixed-case symbols are convenience aliases.") "ConTeXt bib module" ((?\C-m . "\\cite[%l]") (?s . "\\cite[][%l]") - (?n . "\\nocite[%l]"))) - ) + (?n . "\\nocite[%l]")))) "Builtin versions of the citation format. The following conventions are valid for all alist entries: -`?\C-m' should always point to a straight \\cite{%l} macro. +`?\\C-m' should always point to a straight \\cite{%l} macro. `?t' should point to a textual citation (citation as a noun). `?p' should point to a parenthetical citation.") -- cgit v1.2.3 From 0bdd2eb9af171fa9d825bc6d09e0ad5d114684c4 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Wed, 14 Feb 2024 11:09:33 -0500 Subject: Add context to errors thrown by server-start during startup When server-start errors during startup, the error is printed to the terminal without context. To help the user understand better what went wrong, that printed error now mentions that the error came from starting up the daemon. * lisp/startup.el (command-line): Catch and annotate errors thrown by server-start. (bug#68799) --- lisp/startup.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/startup.el b/lisp/startup.el index 1c21b5de857..33e1124b998 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1639,7 +1639,9 @@ Consider using a subdirectory instead, e.g.: %s" (let ((dn (daemonp))) (when dn (when (stringp dn) (setq server-name dn)) - (server-start) + (condition-case err + (server-start) + (error (error "Unable to start daemon: %s; exiting" (error-message-string err)))) (if server-process (daemon-initialized) (if (stringp dn) -- cgit v1.2.3 From 01ebc95114fe89ef623bc7ebdd3c3e1b9ef06b4e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Feb 2024 11:59:30 +0200 Subject: Fix 'help-quick-toggle' * lisp/help.el (help-quick-sections): Fix "kill-region" command. Add a doc string. (Bug#69345) --- lisp/help.el | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/help.el b/lisp/help.el index accd01e56f5..24e4b9890a7 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -151,7 +151,7 @@ buffer.") ("Mark & Kill" (set-mark-command . "mark") (kill-line . "kill line") - (kill-ring-save . "kill region") + (kill-region . "kill region") (yank . "yank") (exchange-point-and-mark . "swap")) ("Projects" @@ -165,7 +165,15 @@ buffer.") (isearch-forward . "search") (isearch-backward . "reverse search") (query-replace . "search & replace") - (fill-paragraph . "reformat")))) + (fill-paragraph . "reformat"))) + "Data structure for `help-quick'. +Value should be a list of elements, each element should of the form + + (GROUP-NAME (COMMAND . DESCRIPTION) (COMMAND . DESCRIPTION)...) + +where GROUP-NAME is the name of the group of the commands, +COMMAND is the symbol of a command and DESCRIPTION is its short +description, 10 to 15 char5acters at most.") (declare-function prop-match-value "text-property-search" (match)) -- cgit v1.2.3 From 477eb882b57b3defd43ea8dd9510cfdf5fd9ee79 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 13 Feb 2024 10:38:48 +0100 Subject: Add sml-mode entry to 'eglot-server-programs' * lisp/progmodes/eglot.el (eglot-server-programs): Use the "millet" LSP server (https://github.com/azdavis/millet). --- lisp/progmodes/eglot.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 2f32a8e6eda..f341428cac3 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -310,7 +310,10 @@ automatically)." ("vscode-markdown-language-server" "--stdio")))) (graphviz-dot-mode . ("dot-language-server" "--stdio")) (terraform-mode . ("terraform-ls" "serve")) - ((uiua-ts-mode uiua-mode) . ("uiua" "lsp"))) + ((uiua-ts-mode uiua-mode) . ("uiua" "lsp")) + (sml-mode + . ,(lambda (_interactive project) + (list "millet-ls" (project-root project))))) "How the command `eglot' guesses the server to start. An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE identifies the buffers that are to be managed by a specific -- cgit v1.2.3 From eeb89a5cb292bffe40ba7d0b0cf81f82f8452bf8 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 24 Feb 2024 12:08:09 +0100 Subject: Suppress docstring control char warning in macro-generated function * lisp/progmodes/cc-defs.el (c-lang-defconst): Make sure that `val` won't be treated as a docstring. --- lisp/progmodes/cc-defs.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index e45ab76ec07..2c793c8a99d 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -2579,7 +2579,8 @@ constant. A file is identified by its base name." ;; dependencies on the `c-lang-const's in VAL.) (setq val (c--macroexpand-all val)) - (setq bindings `(cons (cons ',assigned-mode (lambda () ,val)) ,bindings) + (setq bindings `(cons (cons ',assigned-mode (lambda () nil ,val)) + ,bindings) args (cdr args)))) ;; Compile in the other files that have provided source -- cgit v1.2.3 From 0530800175913769cb55ae7997ee4487a755a0a4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Feb 2024 15:12:57 +0200 Subject: Fix infinite recursion in gdb-mi.el * lisp/progmodes/gdb-mi.el: (gdb-clear-partial-output) (gdb-clear-inferior-io): Set inhibit-read-only, to avoid signaling errors in process filter. (Bug#69327) --- lisp/progmodes/gdb-mi.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index d119eeb74ac..312b71ba640 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1849,7 +1849,8 @@ this trigger is subscribed to `gdb-buf-publisher' and called with (defun gdb-clear-inferior-io () (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io) - (erase-buffer))) + (let ((inhibit-read-only t)) + (erase-buffer)))) (defconst breakpoint-xpm-data @@ -2819,7 +2820,8 @@ current thread and update GDB buffers." (defun gdb-clear-partial-output () (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) - (erase-buffer))) + (let ((inhibit-read-only t)) + (erase-buffer)))) ;; Parse GDB/MI result records: this process converts ;; list [...] -> list -- cgit v1.2.3 From 3076e79a6a11f9df33c5bcaa7aa58955550aeef0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Feb 2024 17:13:47 +0200 Subject: ; Fix a recent change in diff-mode.el * lisp/vc/diff-mode.el (diff-refine-nonmodified): Doc fix. * etc/NEWS: Improve wording. --- etc/NEWS | 7 +++++-- lisp/vc/diff-mode.el | 10 ++++++++-- 2 files changed, 13 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index 0578da899bb..882d97ec423 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -598,8 +598,11 @@ It allows tweaking the thresholds for rename and copy detection. --- *** New user option 'diff-refine-nonmodified'. -Makes 'diff-refine' highlight added and removed whole lines with the -same faces as the words added and removed within modified lines. +When this is non-nil, 'diff-refine' will highlight lines that were added +or removed in their entirety (as opposed to modified lines, where some +parts of the line were modified), using the same faces as for +highlighting the words added and removed within modified lines. The +default value is nil. +++ *** 'diff-ignore-whitespace-hunk' can now be applied to all hunks. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index f914cc76790..14a401667e9 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2283,8 +2283,14 @@ Return new point, if it was moved." (overlay-put ol 'face face))) (defcustom diff-refine-nonmodified nil - "If non-nil also highlight as \"refined\" the added/removed lines. -This is currently only implemented for `unified' diffs." + "If non-nil, also highlight the added/removed lines as \"refined\". +The lines highlighted when this is non-nil are those that were +added or removed in their entirety, as opposed to lines some +parts of which were modified. The added lines are highlighted +using the `diff-refine-added' face, while the removed lines are +highlighted using the `diff-refine-removed' face. +This is currently implemented only for diff formats supported +by `diff-refine-hunk'." :version "30.1" :type 'boolean) -- cgit v1.2.3 From 68096a716bfe3c212a68b3d285a0386ea0867130 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 24 Feb 2024 11:02:37 -0500 Subject: (diff-refine-nonmodified): Complete the implementation * lisp/vc/diff-mode.el (diff--refine-hunk): Implement `diff-refine-nonmodified` for old-style-context and "normal" diffs. --- lisp/vc/diff-mode.el | 47 ++++++++++++++++++++++++++++++++--------------- 1 file changed, 32 insertions(+), 15 deletions(-) (limited to 'lisp') diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 14a401667e9..99ac50c155a 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2333,26 +2333,43 @@ by `diff-refine-hunk'." ('context (let* ((middle (save-excursion (re-search-forward "^---" end t))) (other middle)) - (while (and middle - (re-search-forward "^\\(?:!.*\n\\)+" middle t)) - (smerge-refine-regions (match-beginning 0) (match-end 0) - (save-excursion - (goto-char other) - (re-search-forward "^\\(?:!.*\n\\)+" end) - (setq other (match-end 0)) - (match-beginning 0)) - other - (if diff-use-changed-face props-c) - #'diff-refine-preproc - (unless diff-use-changed-face props-r) - (unless diff-use-changed-face props-a))))) + (when middle + (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) + (smerge-refine-regions (match-beginning 0) (match-end 0) + (save-excursion + (goto-char other) + (re-search-forward "^\\(?:!.*\n\\)+" end) + (setq other (match-end 0)) + (match-beginning 0)) + other + (if diff-use-changed-face props-c) + #'diff-refine-preproc + (unless diff-use-changed-face props-r) + (unless diff-use-changed-face props-a))) + (when diff-refine-nonmodified + (goto-char beg) + (while (re-search-forward "^\\(?:-.*\n\\)+" middle t) + (diff--refine-propertize (match-beginning 0) + (match-end 0) + 'diff-refine-removed)) + (goto-char middle) + (while (re-search-forward "^\\(?:+.*\n\\)+" end t) + (diff--refine-propertize (match-beginning 0) + (match-end 0) + 'diff-refine-added)))))) (_ ;; Normal diffs. (let ((beg1 (1+ (point)))) - (when (re-search-forward "^---.*\n" end t) + (cond + ((re-search-forward "^---.*\n" end t) ;; It's a combined add&remove, so there's something to do. (smerge-refine-regions beg1 (match-beginning 0) (match-end 0) end - nil #'diff-refine-preproc props-r props-a))))))) + nil #'diff-refine-preproc props-r props-a)) + (diff-refine-nonmodified + (diff--refine-propertize + beg1 end + (if (eq (char-after beg1) ?<) + 'diff-refine-removed 'diff-refine-added))))))))) (defun diff--iterate-hunks (max fun) "Iterate over all hunks between point and MAX. -- cgit v1.2.3 From 9a801f0b4621a46149ccf650ed1dc27942157562 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 24 Feb 2024 17:52:14 -0500 Subject: * lisp/progmodes/elisp-mode.el (eval-last-sexp, eval-defun): Fix thinko --- lisp/progmodes/elisp-mode.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 4b1f8022f81..8a713bd19a2 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1630,7 +1630,8 @@ If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger." (interactive "P") (values--store-value - (handler-bind ((error (if #'eval-expression--debug #'ignore))) + (handler-bind ((error (if eval-expression-debug-on-error + #'eval-expression--debug #'ignore))) (elisp--eval-last-sexp eval-last-sexp-arg-internal)))) (defun elisp--eval-defun-1 (form) @@ -1769,7 +1770,8 @@ which see." (defvar edebug-all-defs) (eval-defun (not edebug-all-defs))) (t - (handler-bind ((error (if #'eval-expression--debug #'ignore))) + (handler-bind ((error (if eval-expression-debug-on-error + #'eval-expression--debug #'ignore))) (elisp--eval-defun))))) ;;; ElDoc Support -- cgit v1.2.3 From 05116eac0c199b0c8409a32b349a42a21b5a0fb0 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 25 Feb 2024 11:41:02 +0800 Subject: Arrange for dialog boxes during emacsclient requests on Android * lisp/server.el (server-execute): Bind use-dialog-box-override if (featurep 'android). * lisp/subr.el (use-dialog-box-override): New option. (use-dialog-box-p): Always display dialog boxes if variable is set. --- lisp/server.el | 6 +++++- lisp/subr.el | 22 ++++++++++++++-------- 2 files changed, 19 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/server.el b/lisp/server.el index 66e6d729f8a..b65053267a6 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1439,7 +1439,11 @@ invocations of \"emacs\".") ;; including code that needs to wait. (with-local-quit (condition-case err - (let ((buffers (server-visit-files files proc nowait))) + (let ((buffers (server-visit-files files proc nowait)) + ;; On Android, the Emacs server generally can't provide + ;; feedback to the user except by means of dialog boxes, + ;; which are displayed in the GUI emacsclient wrapper. + (use-dialog-box-override (featurep 'android))) (mapc 'funcall (nreverse commands)) (let ((server-eval-args-left (nreverse evalexprs))) (while server-eval-args-left diff --git a/lisp/subr.el b/lisp/subr.el index c317d558e24..30314343650 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3832,16 +3832,22 @@ confusing to some users.") (declare-function android-detect-keyboard "androidfns.c") +(defvar use-dialog-box-override nil + "Whether `use-dialog-box-p' should always return t.") + (defun use-dialog-box-p () "Return non-nil if the current command should prompt the user via a dialog box." - (and last-input-event ; not during startup - (or (consp last-nonmenu-event) ; invoked by a mouse event - (and (null last-nonmenu-event) - (consp last-input-event)) - (and (featurep 'android) ; Prefer dialog boxes on Android. - (not (android-detect-keyboard))) ; If no keyboard is connected. - from--tty-menu-p) ; invoked via TTY menu - use-dialog-box)) + (or use-dialog-box-override + (and last-input-event ; not during startup + (or (consp last-nonmenu-event) ; invoked by a mouse event + (and (null last-nonmenu-event) + (consp last-input-event)) + (and (featurep 'android) ; Prefer dialog boxes on + ; Android. + (not (android-detect-keyboard))) ; If no keyboard is + ; connected. + from--tty-menu-p) ; invoked via TTY menu + use-dialog-box))) ;; Actually in textconv.c. (defvar overriding-text-conversion-style) -- cgit v1.2.3 From 6b800f9adf3506bf113539cf22cd07c7cda9f7b8 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 25 Feb 2024 09:32:45 +0200 Subject: * lisp/progmodes/project.el (project-any-command): Allow local keymaps. Use overriding-terminal-local-map instead of overriding-local-map. This allows using keys from local maps (bug#69242). --- lisp/progmodes/project.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index aa92a73336e..9622b1b6768 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1866,12 +1866,12 @@ Otherwise, `default-directory' is temporarily set to the current project's root. If OVERRIDING-MAP is non-nil, it will be used as -`overriding-local-map' to provide shorter bindings from that map -which will take priority over the global ones." +`overriding-terminal-local-map' to provide shorter bindings +from that map which will take priority over the global ones." (interactive) (let* ((pr (project-current t)) (prompt-format (or prompt-format "[execute in %s]:")) - (command (let ((overriding-local-map overriding-map)) + (command (let ((overriding-terminal-local-map overriding-map)) (key-binding (read-key-sequence (format prompt-format (project-root pr))) t))) -- cgit v1.2.3 From e680827e814e155cf79175d87ff7c6ee3a08b69a Mon Sep 17 00:00:00 2001 From: Michael Heerdegen Date: Fri, 16 Feb 2024 22:07:18 +0100 Subject: Don't warn about _ not left unused in if-let and alike The macro expansions did not leave a variable _ unused; this triggered an irritating compiler warning (bug#69108). * lisp/subr.el (internal--build-binding): Handle bindings of the form (_ EXPR) separately. --- lisp/subr.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp') diff --git a/lisp/subr.el b/lisp/subr.el index 30314343650..301e2e42566 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2580,6 +2580,8 @@ Affects only hooks run in the current buffer." (list binding binding)) ((null (cdr binding)) (list (make-symbol "s") (car binding))) + ((eq '_ (car binding)) + (list (make-symbol "s") (cadr binding))) (t binding))) (when (> (length binding) 2) (signal 'error -- cgit v1.2.3 From 67ba629a91aee3db39f3c81744e88c02ee710bdc Mon Sep 17 00:00:00 2001 From: Michael Heerdegen Date: Sun, 18 Feb 2024 02:27:56 +0100 Subject: ; * lisp/subr.el (if-let, and-let*): Tweak doc strings. (Bug#69108) --- lisp/subr.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/subr.el b/lisp/subr.el index 301e2e42566..e2279170297 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2622,7 +2622,7 @@ This is like `when-let' but doesn't handle a VARLIST of the form (defmacro and-let* (varlist &rest body) "Bind variables according to VARLIST and conditionally evaluate BODY. Like `when-let*', except if BODY is empty and all the bindings -are non-nil, then the result is non-nil." +are non-nil, then the result is the value of the last binding." (declare (indent 1) (debug if-let*)) (let (res) (if varlist @@ -2635,7 +2635,8 @@ are non-nil, then the result is non-nil." "Bind variables according to SPEC and evaluate THEN or ELSE. Evaluate each binding in turn, as in `let*', stopping if a binding value is nil. If all are non-nil return the value of -THEN, otherwise the last form in ELSE. +THEN, otherwise the value of the last form in ELSE, or nil if +there are none. Each element of SPEC is a list (SYMBOL VALUEFORM) that binds SYMBOL to the value of VALUEFORM. An element can additionally be -- cgit v1.2.3 From 39e3fce0d5e0f5db00e44905bcd2590170098d63 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 25 Feb 2024 10:06:09 +0100 Subject: 'read-passwd' can toggle the visibility of passwords * doc/lispref/minibuf.texi (Reading a Password): * etc/NEWS: 'read-passwd' can toggle the visibility of passwords. * etc/images/README: Mention the new images below. * etc/images/conceal.pbm: * etc/images/conceal.svg: * etc/images/reveal.pbm: * etc/images/reveal.svg: New images. * lisp/simple.el (read-passwd--mode-line-buffer) (read-passwd--mode-line-icon): New defvars. (read-passwd--toggle-visibility, read-passwd-mode): New defuns. * lisp/subr.el (read-passwd-map): Add 'TAB' binding. (read-passwd--hide-password): New defvar. (read-passwd--hide-password): Rename function from `read-password--hide-password'. Adapt callees. Implement both hiding and showing the password. (Bug#69237) (read-passwd): Call `read-passwd-mode'. --- doc/lispref/minibuf.texi | 8 +++++ etc/NEWS | 11 +++++-- etc/images/README | 7 +++- etc/images/conceal.pbm | Bin 0 -> 41 bytes etc/images/conceal.svg | 4 +++ etc/images/reveal.pbm | Bin 0 -> 41 bytes etc/images/reveal.svg | 4 +++ lisp/simple.el | 81 +++++++++++++++++++++++++++++++++++++++++++++++ lisp/subr.el | 21 +++++++++--- 9 files changed, 128 insertions(+), 8 deletions(-) create mode 100644 etc/images/conceal.pbm create mode 100644 etc/images/conceal.svg create mode 100644 etc/images/reveal.pbm create mode 100644 etc/images/reveal.svg (limited to 'lisp') diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index aa27de72ba0..0247c93f7b8 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -2562,6 +2562,14 @@ times match. The optional argument @var{default} specifies the default password to return if the user enters empty input. If @var{default} is @code{nil}, then @code{read-passwd} returns the null string in that case. + +This function uses @code{read-passwd-mode}, a minor mode. It binds two +keys in the minbuffer: @kbd{C-u} (@code{delete-minibuffer-contents}) +deletes the password, and @kbd{TAB} +(@code{read-passwd--toggle-visibility}) toggles the visibility of the +password. There is also an additional icon in the mode-line. Clicking +on this icon with @key{mouse-1} toggles the visibility of the password +as well. @end defun @node Minibuffer Commands diff --git a/etc/NEWS b/etc/NEWS index 882d97ec423..6d444daf152 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -322,6 +322,12 @@ Previously, it was set to t but this broke remote file name detection. ** Multi-character key echo now ends with a suggestion to use Help. Customize 'echo-keystrokes-help' to nil to prevent that. ++++ +** 'read-passwd' can toggle the visibility of passwords. +Use 'TAB' in the minibuffer to show or hide the password. Likewise, +there is an icon on the mode-line, which toggles the visibility of the +password when clicking with 'mouse-1'. + * Editing Changes in Emacs 30.1 @@ -1939,7 +1945,8 @@ Example: "Uses c:\remote\dir\files and the key \C-x." ...) -where the doc string contains four control characters CR, DEL, FF and ^X. +where the docstring contains four control characters 'CR', 'DEL', 'FF' +and 'C-x'. The warning name is 'docstrings-control-chars'. @@ -2025,7 +2032,7 @@ automatically, which means that the size parameter to 'obarray-make' can safely be omitted. That is, they do not become slower as they fill up. The old vector representation is still accepted by functions operating -on obarrays, but 'obarrayp' only returns 't' for obarray objects. +on obarrays, but 'obarrayp' only returns t for obarray objects. 'type-of' now returns 'obarray' for obarray objects. Old code which (incorrectly) created "obarrays" as Lisp vectors filled diff --git a/etc/images/README b/etc/images/README index a778d9ce6c3..8e112448373 100644 --- a/etc/images/README +++ b/etc/images/README @@ -125,7 +125,7 @@ For more information see the adwaita-icon-theme repository at: https://gitlab.gnome.org/GNOME/adwaita-icon-theme -Emacs images and their source in the Adwaita/scalable directory: +Emacs images and their source in the Adwaita/symbolic directory: checked.svg ui/checkbox-checked-symbolic.svg unchecked.svg ui/checkbox-symbolic.svg @@ -137,3 +137,8 @@ Emacs images and their source in the Adwaita/scalable directory: left.svg ui/pan-start-symbolic.svg right.svg ui/pan-end-symbolic.svg up.svg ui/pan-up-symbolic.svg + conceal.svg actions/view-conceal-symbolic.svg + reveal.svg actions/view-reveal-symbolic.svg + +conceal.pbm and reveal.pbm are generated from the respective *.svg +files, using the ImageMagick converter tool. diff --git a/etc/images/conceal.pbm b/etc/images/conceal.pbm new file mode 100644 index 00000000000..3df787d6fd6 Binary files /dev/null and b/etc/images/conceal.pbm differ diff --git a/etc/images/conceal.svg b/etc/images/conceal.svg new file mode 100644 index 00000000000..172b73ed3d3 --- /dev/null +++ b/etc/images/conceal.svg @@ -0,0 +1,4 @@ + + + + diff --git a/etc/images/reveal.pbm b/etc/images/reveal.pbm new file mode 100644 index 00000000000..79d2f1f3307 Binary files /dev/null and b/etc/images/reveal.pbm differ diff --git a/etc/images/reveal.svg b/etc/images/reveal.svg new file mode 100644 index 00000000000..41ae3733a53 --- /dev/null +++ b/etc/images/reveal.svg @@ -0,0 +1,4 @@ + + + + diff --git a/lisp/simple.el b/lisp/simple.el index 9a33049f4ca..5992afec255 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10858,6 +10858,87 @@ and setting it to nil." (setq-local vis-mode-saved-buffer-invisibility-spec buffer-invisibility-spec) (setq buffer-invisibility-spec nil))) + + +(defvar read-passwd--mode-line-buffer nil + "Buffer to modify `mode-line-format' for showing/hiding passwords.") + +(defvar read-passwd--mode-line-icon nil + "Propertized mode line icon for showing/hiding passwords.") + +(defun read-passwd--toggle-visibility () + "Toggle minibuffer contents visibility. +Adapt also mode line." + (interactive) + (setq read-passwd--hide-password (not read-passwd--hide-password)) + (with-current-buffer read-passwd--mode-line-buffer + (setq read-passwd--mode-line-icon + `(:propertize + ,(if icon-preference + (icon-string + (if read-passwd--hide-password + 'read-passwd--show-password-icon + 'read-passwd--hide-password-icon)) + "") + mouse-face mode-line-highlight + local-map + (keymap + (mode-line keymap (mouse-1 . read-passwd--toggle-visibility))))) + (force-mode-line-update)) + (read-passwd--hide-password)) + +(define-minor-mode read-passwd-mode + "Toggle visibility of password in minibuffer." + :group 'mode-line + :group 'minibuffer + :keymap read-passwd-map + :version "30.1" + + (require 'icons) + ;; It would be preferable to use "👁" ("\N{EYE}"). However, there is + ;; no corresponding Unicode char with a slash. So we use symbols as + ;; fallback only, with "⦵" ("\N{CIRCLE WITH HORIZONTAL BAR}") for + ;; hiding the password. + (define-icon read-passwd--show-password-icon nil + '((image "reveal.svg" "reveal.pbm" :height (0.8 . em)) + (symbol "👁") + (text "o")) + "Mode line icon to show a hidden password." + :group mode-line-faces + :version "30.1" + :help-echo "mouse-1: Toggle password visibility") + (define-icon read-passwd--hide-password-icon nil + '((image "conceal.svg" "conceal.pbm" :height (0.8 . em)) + (symbol "⦵") + (text "x")) + "Mode line icon to hide a visible password." + :group mode-line-faces + :version "30.1" + :help-echo "mouse-1: Toggle password visibility") + + (setq read-passwd--hide-password nil + ;; Stolen from `eldoc-minibuffer-message'. + read-passwd--mode-line-buffer + (window-buffer + (or (window-in-direction 'above (minibuffer-window)) + (minibuffer-selected-window) + (get-largest-window)))) + + (if read-passwd-mode + (with-current-buffer read-passwd--mode-line-buffer + ;; Add `read-passwd--mode-line-icon'. + (when (listp mode-line-format) + (setq mode-line-format + (cons '(:eval read-passwd--mode-line-icon) + mode-line-format)))) + (with-current-buffer read-passwd--mode-line-buffer + ;; Remove `read-passwd--mode-line-icon'. + (when (listp mode-line-format) + (setq mode-line-format (cdr mode-line-format))))) + + (when read-passwd-mode + (read-passwd--toggle-visibility))) + (defvar messages-buffer-mode-map (let ((map (make-sparse-keymap))) diff --git a/lisp/subr.el b/lisp/subr.el index e2279170297..d89c69976e4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3378,14 +3378,23 @@ with Emacs. Do not call it directly in your own packages." (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) (define-key map "\C-u" #'delete-minibuffer-contents) ;bug#12570 + (define-key map "\t" #'read-passwd--toggle-visibility) map) "Keymap used while reading passwords.") -(defun read-password--hide-password () +(defvar read-passwd--hide-password t) + +(defun read-passwd--hide-password () + "Make password in minibuffer hidden or visible." (let ((beg (minibuffer-prompt-end))) (dotimes (i (1+ (- (buffer-size) beg))) - (put-text-property (+ i beg) (+ 1 i beg) - 'display (string (or read-hide-char ?*)))))) + (if read-passwd--hide-password + (put-text-property + (+ i beg) (+ 1 i beg) 'display (string (or read-hide-char ?*))) + (remove-list-of-text-properties (+ i beg) (+ 1 i beg) '(display))) + (put-text-property + (+ i beg) (+ 1 i beg) + 'help-echo "C-u: Clear password\nTAB: Toggle password visibility")))) (defun read-passwd (prompt &optional confirm default) "Read a password, prompting with PROMPT, and return it. @@ -3423,18 +3432,20 @@ by doing (clear-string STRING)." (setq-local inhibit-modification-hooks nil) ;bug#15501. (setq-local show-paren-mode nil) ;bug#16091. (setq-local inhibit--record-char t) - (add-hook 'post-command-hook #'read-password--hide-password nil t)) + (read-passwd-mode 1) + (add-hook 'post-command-hook #'read-passwd--hide-password nil t)) (unwind-protect (let ((enable-recursive-minibuffers t) (read-hide-char (or read-hide-char ?*))) (read-string prompt nil t default)) ; t = "no history" (when (buffer-live-p minibuf) (with-current-buffer minibuf + (read-passwd-mode -1) ;; Not sure why but it seems that there might be cases where the ;; minibuffer is not always properly reset later on, so undo ;; whatever we've done here (bug#11392). (remove-hook 'after-change-functions - #'read-password--hide-password 'local) + #'read-passwd--hide-password 'local) (kill-local-variable 'post-self-insert-hook) ;; And of course, don't keep the sensitive data around. (erase-buffer)))))))) -- cgit v1.2.3 From e02c4a864f02787f0e194c9e8a6d4ab0b18ca39f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 25 Feb 2024 15:37:06 +0100 Subject: Modify last change acc to comments * lisp/simple.el (read-passwd-mode): Change `text' entry of icons. (read-passwd-toggle-visibility): Rename. (read-passwd-mode): * lisp/subr.el (read-passwd-map): Adapt callees. --- lisp/simple.el | 10 +++++----- lisp/subr.el | 2 +- 2 files changed, 6 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/simple.el b/lisp/simple.el index 5992afec255..f127290231b 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10866,7 +10866,7 @@ and setting it to nil." (defvar read-passwd--mode-line-icon nil "Propertized mode line icon for showing/hiding passwords.") -(defun read-passwd--toggle-visibility () +(defun read-passwd-toggle-visibility () "Toggle minibuffer contents visibility. Adapt also mode line." (interactive) @@ -10883,7 +10883,7 @@ Adapt also mode line." mouse-face mode-line-highlight local-map (keymap - (mode-line keymap (mouse-1 . read-passwd--toggle-visibility))))) + (mode-line keymap (mouse-1 . read-passwd-toggle-visibility))))) (force-mode-line-update)) (read-passwd--hide-password)) @@ -10902,7 +10902,7 @@ Adapt also mode line." (define-icon read-passwd--show-password-icon nil '((image "reveal.svg" "reveal.pbm" :height (0.8 . em)) (symbol "👁") - (text "o")) + (text "")) "Mode line icon to show a hidden password." :group mode-line-faces :version "30.1" @@ -10910,7 +10910,7 @@ Adapt also mode line." (define-icon read-passwd--hide-password-icon nil '((image "conceal.svg" "conceal.pbm" :height (0.8 . em)) (symbol "⦵") - (text "x")) + (text "<\\>")) "Mode line icon to hide a visible password." :group mode-line-faces :version "30.1" @@ -10937,7 +10937,7 @@ Adapt also mode line." (setq mode-line-format (cdr mode-line-format))))) (when read-passwd-mode - (read-passwd--toggle-visibility))) + (read-passwd-toggle-visibility))) (defvar messages-buffer-mode-map diff --git a/lisp/subr.el b/lisp/subr.el index d89c69976e4..d58f8ba3b27 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3378,7 +3378,7 @@ with Emacs. Do not call it directly in your own packages." (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) (define-key map "\C-u" #'delete-minibuffer-contents) ;bug#12570 - (define-key map "\t" #'read-passwd--toggle-visibility) + (define-key map "\t" #'read-passwd-toggle-visibility) map) "Keymap used while reading passwords.") -- cgit v1.2.3 From b7cef701cb587ecb66f192e4d41aa202645560e0 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 25 Feb 2024 11:35:44 -0500 Subject: * lisp/files.el (hack-one-local-variable): Use `set-auto-mode-0` This fixes bug#69373. --- lisp/files.el | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/files.el b/lisp/files.el index 1e7f00e4254..c0d26b2343c 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4238,10 +4238,8 @@ already the major mode." (pcase var ('mode (let ((mode (intern (concat (downcase (symbol-name val)) - "-mode")))) - (unless (eq (indirect-function mode) - (indirect-function major-mode)) - (funcall mode)))) + "-mode")))) + (set-auto-mode-0 mode t))) ('eval (pcase val (`(add-hook ',hook . ,_) (hack-one-local-variable--obsolete hook))) -- cgit v1.2.3 From c6f2add964ce1ac69ba6705bc869ee2f447da3cb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 25 Feb 2024 13:18:08 -0500 Subject: * lisp/vc/vc-hooks.el (vc-mode): Give a body to the function (bug#69387) --- lisp/vc/vc-hooks.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index a95cc732dab..75f68dd80d1 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -186,7 +186,8 @@ revision number and lock status." This minor mode is automatically activated whenever you visit a file under control of one of the revision control systems in `vc-handled-backends'. VC commands are globally reachable under the prefix \\[vc-prefix-map]: -\\{vc-prefix-map}") +\\{vc-prefix-map}" + nil) (defmacro vc-error-occurred (&rest body) `(condition-case nil (progn ,@body nil) (error t))) -- cgit v1.2.3 From babe6a5e948985f961ffd36f64323950abd98b7f Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 26 Feb 2024 14:13:14 +0800 Subject: Introduce a new TRAMP method `androidsu' * doc/misc/tramp.texi (Quick Start Guide): Document the new method. * etc/NEWS (Tramp): Announce new method. * lisp/net/tramp-adb.el (tramp-adb-handle-file-attributes) (tramp-adb-handle-directory-files-and-attributes) (tramp-adb-handle-file-name-all-completions): Properly print ls's exit status in the presence of a pipe. (tramp-adb-handle-copy-file): If the androidsu backend is in use, call cp rather than adb push. (tramp-adb-send-command): Disable ADB-specific code under androidsu. (tramp-adb-send-command-and-check): New argument COMMAND-AUGMENTED-P. * lisp/net/tramp-androidsu.el (tramp, tramp-adb, tramp-sh) (tramp-androidsu-method, add-to-list) (tramp-androidsu-maybe-open-connection) (tramp-androidsu-generate-wrapper) (tramp-androidsu-handle-access-file) (tramp-androidsu-handle-add-name-to-file) (tramp-androidsu-handle-copy-directory) (tramp-androidsu-adb-handle-copy-file) (tramp-androidsu-adb-handle-delete-directory) (tramp-androidsu-adb-handle-delete-file) (tramp-androidsu-handle-directory-file-name) (tramp-androidsu-handle-directory-files) (tramp-androidsu-adb-handle-directory-files-and-attributes) (tramp-androidsu-handle-dired-uncache) (tramp-androidsu-adb-handle-exec-path) (tramp-androidsu-handle-expand-file-name) (tramp-androidsu-handle-file-accessible-directory-p) (tramp-androidsu-adb-handle-file-attributes) (tramp-androidsu-handle-file-directory-p) (tramp-androidsu-handle-file-equal-p) (tramp-androidsu-adb-handle-file-executable-p) (tramp-androidsu-adb-handle-file-exists-p) (tramp-androidsu-handle-file-group-gid) (tramp-androidsu-handle-file-in-directory-p) (tramp-androidsu-sh-handle-file-local-copy) (tramp-androidsu-handle-file-locked-p) (tramp-androidsu-handle-file-modes) (tramp-androidsu-adb-handle-file-name-all-completions) (tramp-androidsu-handle-file-name-as-directory) (tramp-androidsu-handle-file-name-case-insensitive-p) (tramp-androidsu-handle-file-name-completion) (tramp-androidsu-handle-file-name-directory) (tramp-androidsu-handle-file-name-nondirectory) (tramp-androidsu-handle-file-newer-than-file-p) (tramp-androidsu-handle-file-notify-add-watch) (tramp-androidsu-handle-file-notify-rm-watch) (tramp-androidsu-handle-file-notify-valid-p) (tramp-androidsu-adb-handle-file-readable-p) (tramp-androidsu-handle-file-regular-p) (tramp-androidsu-handle-file-remote-p) (tramp-androidsu-handle-file-selinux-context) (tramp-androidsu-handle-file-symlink-p) (tramp-androidsu-adb-handle-file-system-info) (tramp-androidsu-handle-file-truename) (tramp-androidsu-handle-file-user-uid) (tramp-androidsu-adb-handle-file-writable-p) (tramp-androidsu-handle-find-backup-file-name) (tramp-androidsu-handle-insert-directory) (tramp-androidsu-handle-insert-file-contents) (tramp-androidsu-handle-list-system-processes) (tramp-androidsu-handle-load, tramp-androidsu-handle-lock-file) (tramp-androidsu-handle-make-auto-save-file-name) (tramp-androidsu-adb-handle-make-directory) (tramp-androidsu-handle-make-lock-file-name) (tramp-androidsu-handle-make-nearby-temp-file) (tramp-androidsu-adb-handle-make-process) (tramp-androidsu-sh-handle-make-symbolic-link) (tramp-androidsu-handle-memory-info) (tramp-androidsu-handle-process-attributes) (tramp-androidsu-adb-handle-process-file) (tramp-androidsu-adb-handle-rename-file) (tramp-androidsu-adb-handle-set-file-modes) (tramp-androidsu-adb-handle-set-file-times) (tramp-androidsu-handle-set-visited-file-modtime) (tramp-androidsu-handle-shell-command) (tramp-androidsu-handle-start-file-process) (tramp-androidsu-handle-substitute-in-file-name) (tramp-androidsu-handle-temporary-file-directory) (tramp-androidsu-adb-handle-get-remote-gid) (tramp-androidsu-adb-handle-get-remote-groups) (tramp-androidsu-adb-handle-get-remote-uid) (tramp-androidsu-handle-unlock-file) (tramp-androidsu-handle-verify-visited-file-modtime) (tramp-androidsu-handle-write-region) (tramp-androidsu-file-name-handler-alist) (tramp-androidsu-file-name-p, tramp-androidsu-file-name-handler) (tramp-register-foreign-file-name-handler) (tramp-adb-connection-local-default-ps-profile, shell) (tramp-unload-hook, tramp-androidsu): New file. --- doc/misc/tramp.texi | 7 + etc/NEWS | 6 + lisp/net/tramp-adb.el | 54 +++-- lisp/net/tramp-androidsu.el | 537 ++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 589 insertions(+), 15 deletions(-) create mode 100644 lisp/net/tramp-androidsu.el (limited to 'lisp') diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 6d4654f1a8a..09b875ad3fa 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -523,6 +523,8 @@ is used as the group to change to. The default host name is the same. @cindex @option{sudo} method @cindex method @option{doas} @cindex @option{doas} method +@cindex method @option{androidsu} +@cindex @option{androidsu} method If the @option{su}, @option{sudo} or @option{doas} option should be performed on another host, it can be combined with a leading @@ -533,6 +535,11 @@ a simple case, the syntax looks like @file{@trampfn{ssh@value{postfixhop}user@@host|sudo,,/path/to/file}}. @xref{Ad-hoc multi-hops}. +The @option{su} method and other shell-based methods conflict with +non-standard @command{su} implementations popular among Android users +and the restricted command-line utilities distributed with that system. +The @option{androidsu} method enables accessing files through +@command{su} on such systems, but multi-hops are not supported. @anchor{Quick Start Guide sudoedit method} @section Using @command{sudoedit} diff --git a/etc/NEWS b/etc/NEWS index 6d444daf152..b4a1c887f2e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -902,6 +902,12 @@ mode line. 'header' will display in the header line; ** Tramp ++++ +*** New connection method "androidsu". +This provides access to system files with elevated privileges granted by +the idiosyncratic 'su' implementations and system utilities customary on +Android. + +++ *** New connection methods "dockercp" and "podmancp". These are the external methods counterparts of "docker" and "podman". diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 96625fc5680..4f04912c032 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -263,9 +263,10 @@ arguments to pass to the OPERATION." (tramp-convert-file-attributes v localname id-format (and (tramp-adb-send-command-and-check - v (format "%s -d -l %s | cat" + v (format "(%s -d -l %s; echo tramp_exit_status $?) | cat" (tramp-adb-get-ls-command v) - (tramp-shell-quote-argument localname))) + (tramp-shell-quote-argument localname)) + nil t) (with-current-buffer (tramp-get-buffer v) (tramp-adb-sh-fix-ls-output) (cdar (tramp-do-parse-file-attributes-with-ls v))))))) @@ -316,9 +317,10 @@ arguments to pass to the OPERATION." directory full match nosort id-format count (with-current-buffer (tramp-get-buffer v) (when (tramp-adb-send-command-and-check - v (format "%s -a -l %s | cat" + v (format "(%s -a -l %s; echo tramp_exit_status $?) | cat" (tramp-adb-get-ls-command v) - (tramp-shell-quote-argument localname))) + (tramp-shell-quote-argument localname)) + nil t) ;; We insert also filename/. and filename/.., because "ls" ;; doesn't on some file systems, like "sdcard". (unless (search-backward-regexp (rx "." eol) nil t) @@ -440,10 +442,12 @@ Emacs dired can't find files." filename (with-parsed-tramp-file-name (expand-file-name directory) nil (with-tramp-file-property v localname "file-name-all-completions" - (tramp-adb-send-command - v (format "%s -a %s | cat" - (tramp-adb-get-ls-command v) - (tramp-shell-quote-argument localname))) + (unless (tramp-adb-send-command-and-check + v (format "(%s -a %s; echo tramp_exit_status $?) | cat" + (tramp-adb-get-ls-command v) + (tramp-shell-quote-argument localname)) + nil t) + (erase-buffer)) (mapcar (lambda (f) (if (file-directory-p (expand-file-name f directory)) @@ -637,10 +641,23 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; because `file-attributes' reads the values from ;; there. (tramp-flush-file-properties v localname) - (unless (tramp-adb-execute-adb-command - v "push" - (file-name-unquote filename) - (file-name-unquote localname)) + (unless (if (tramp-adb-file-name-p v) + (tramp-adb-execute-adb-command + v "push" + (file-name-unquote filename) + (file-name-unquote localname)) + ;; Otherwise, this operation was initiated + ;; by the androidsu backend, so both files + ;; must be present on the local machine and + ;; transferable with a simple local copy. + (tramp-adb-send-command-and-check + v + (format + "cp -f %s %s" + (tramp-shell-quote-argument + (file-name-unquote filename)) + (tramp-shell-quote-argument + (file-name-unquote localname))))) (tramp-error v 'file-error "Cannot copy `%s' `%s'" filename newname))))))))) @@ -1110,7 +1127,9 @@ error and non-nil on success." (defun tramp-adb-send-command (vec command &optional neveropen nooutput) "Send the COMMAND to connection VEC." - (if (string-match-p (rx multibyte) command) + (if (and (equal (tramp-file-name-method vec) + tramp-androidsu-method) + (string-match-p (rx multibyte) command)) ;; Multibyte codepoints with four bytes are not supported at ;; least by toybox. @@ -1142,17 +1161,22 @@ error and non-nil on success." (while (search-forward-regexp (rx (+ "\r") eol) nil t) (replace-match "" nil nil))))))) -(defun tramp-adb-send-command-and-check (vec command &optional exit-status) +(defun tramp-adb-send-command-and-check (vec command &optional exit-status + command-augmented-p) "Run COMMAND and check its exit status. Sends `echo $?' along with the COMMAND for checking the exit status. If COMMAND is nil, just sends `echo $?'. Returns nil if the exit status is not equal 0, and t otherwise. +If COMMAND-AUGMENTED-P, COMMAND is already configured to print exit +status upon completion and need not be modified. + Optional argument EXIT-STATUS, if non-nil, triggers the return of the exit status." (tramp-adb-send-command vec (if command - (format "%s; echo tramp_exit_status $?" command) + (if command-augmented-p command + (format "%s; echo tramp_exit_status $?" command)) "echo tramp_exit_status $?")) (with-current-buffer (tramp-get-connection-buffer vec) (unless (tramp-search-regexp (rx "tramp_exit_status " (+ digit))) diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el new file mode 100644 index 00000000000..417ef25ed8a --- /dev/null +++ b/lisp/net/tramp-androidsu.el @@ -0,0 +1,537 @@ +;;; tramp-androidsu.el --- TRAMP method for Android superuser shells -*- lexical-binding:t -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; Keywords: comm, processes +;; Package: tramp + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; The `su' method struggles (as do other shell-based methods) with the +;; crippled versions of many Unix utilities installed on Android, +;; workarounds for which are implemented in the `adb' method. This +;; method defines a shell-based method that is identical in function to +;; `su', but reuses such code from the `adb' method where applicable and +;; also provides for certain mannerisms of popular Android `su' +;; implementations. + +;;; Code: + +(require 'tramp) +(require 'tramp-adb) +(require 'tramp-sh) + +;;;###tramp-autoload +(defconst tramp-androidsu-method "androidsu" + "When this method name is used, forward all calls to su.") + +;;;###tramp-autoload +(tramp--with-startup + (add-to-list 'tramp-methods + `(,tramp-androidsu-method + (tramp-login-program "su") + (tramp-login-args (("-") ("%u"))) + (tramp-remote-shell "/system/bin/sh") + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-c")) + (tramp-tmpdir "/data/local/tmp") + (tramp-connection-timeout 10))) + + (add-to-list 'tramp-default-host-alist + `(,tramp-androidsu-method nil "localhost"))) + +(defun tramp-androidsu-maybe-open-connection (vec) + "Open a connection VEC if not already open. +Mostly identical to `tramp-adb-maybe-open-connection', but also disables +multibyte mode and waits for the shell prompt to appear." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + + (with-tramp-debug-message vec "Opening connection" + (let ((p (tramp-get-connection-process vec)) + (process-name (tramp-get-connection-property vec "process-name")) + (process-environment (copy-sequence process-environment))) + ;; Open a new connection. + (condition-case err + (unless (process-live-p p) + (with-tramp-progress-reporter + vec 3 + (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec)) + (format "Opening connection %s for %s using %s" + process-name + (tramp-file-name-host vec) + (tramp-file-name-method vec)) + (format "Opening connection %s for %s@%s using %s" + process-name + (tramp-file-name-user vec) + (tramp-file-name-host vec) + (tramp-file-name-method vec))) + (let* ((coding-system-for-read 'utf-8-unix) + (process-connection-type tramp-process-connection-type) + (p (apply + #'start-process + (tramp-get-connection-name vec) + (tramp-get-connection-buffer vec) + (append + `(,tramp-encoding-shell) + (and tramp-encoding-command-interactive + `(,tramp-encoding-command-interactive))))) + (user (tramp-file-name-user vec)) + command) + ;; Set sentinel. Initialize variables. + (set-process-sentinel p #'tramp-process-sentinel) + (tramp-post-process-creation p vec) + + ;; Replace `login-args' place holders. + (setq command (format "exec su - %s || exit" + (or user "root"))) + ;; Send the command. + (tramp-message vec 3 "Sending command `%s'" command) + (tramp-adb-send-command vec command t t) + + ;; Android su binaries contact a background service to + ;; obtain authentication; during this process, input + ;; received is discarded, so input cannot be + ;; guaranteed to reach the root shell until its prompt + ;; is displayed. + (with-current-buffer (process-buffer p) + (tramp-wait-for-regexp p tramp-connection-timeout + "#[[:space:]]*$")) + + ;; Set connection-local variables. + (tramp-set-connection-local-variables vec) + + ;; Change prompt. + (tramp-adb-send-command + vec (format "PS1=%s" + (tramp-shell-quote-argument tramp-end-of-output))) + + ;; Disable line editing. + (tramp-adb-send-command + vec "set +o vi +o vi-esccomplete +o vi-tabcomplete +o emacs") + + ;; Dump option settings in the traces. + (when (>= tramp-verbose 9) + (tramp-adb-send-command vec "set -o")) + + ;; Disable Unicode. + (tramp-adb-send-command vec "set +U") + + ;; Disable echo expansion. + (tramp-adb-send-command + vec "stty -inlcr -onlcr -echo kill '^U' erase '^H'" t) + + ;; Check whether the echo has really been disabled. + ;; Some implementations, like busybox, don't support + ;; disabling. + (tramp-adb-send-command vec "echo foo" t) + (with-current-buffer (process-buffer p) + (goto-char (point-min)) + (when (looking-at-p "echo foo") + (tramp-set-connection-property p "remote-echo" t) + (tramp-message vec 5 "Remote echo still on. Ok.") + ;; Make sure backspaces and their echo are enabled + ;; and no line width magic interferes with them. + (tramp-adb-send-command vec + "stty icanon erase ^H cols 32767" + t))) + + ;; Set the remote PATH to a suitable value. + (tramp-set-connection-property vec "remote-path" + "/system/bin:/system/xbin") + + ;; Mark it as connected. + (tramp-set-connection-property p "connected" t)))) + + ;; Cleanup, and propagate the signal. + ((error quit) + (tramp-cleanup-connection vec t) + (signal (car err) (cdr err))))))) + +(defun tramp-androidsu-generate-wrapper (function) + "Return connection wrapper function for FUNCTION. +Return a function which temporarily substitutes local replacements for +the `adb' method's connection management functions around a call to +FUNCTION." + (lambda (&rest args) + (let ((tramp-adb-wait-for-output + (symbol-function #'tramp-adb-wait-for-output)) + (tramp-adb-maybe-open-connection + (symbol-function #'tramp-adb-maybe-open-connection))) + (unwind-protect + (progn + ;; tramp-adb-wait-for-output addresses problems introduced + ;; by the adb utility itself, not Android utilities, so + ;; replace it with the regular TRAMP function. + (fset 'tramp-adb-wait-for-output #'tramp-wait-for-output) + ;; Likewise, except some special treatment is necessary on + ;; account of flaws in Android's su implementation. + (fset 'tramp-adb-maybe-open-connection + #'tramp-androidsu-maybe-open-connection) + (apply function args)) + ;; Restore the original definitions of the functions overridden + ;; above. + (fset 'tramp-adb-wait-for-output tramp-adb-wait-for-output) + (fset 'tramp-adb-maybe-open-connection tramp-adb-maybe-open-connection))))) + +(defalias 'tramp-androidsu-handle-access-file + (tramp-androidsu-generate-wrapper #'tramp-handle-access-file)) + +(defalias 'tramp-androidsu-handle-add-name-to-file + (tramp-androidsu-generate-wrapper #'tramp-handle-add-name-to-file)) + +(defalias 'tramp-androidsu-handle-copy-directory + (tramp-androidsu-generate-wrapper #'tramp-handle-copy-directory)) + +(defalias 'tramp-androidsu-adb-handle-copy-file + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-copy-file)) + +(defalias 'tramp-androidsu-adb-handle-delete-directory + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-directory)) + +(defalias 'tramp-androidsu-adb-handle-delete-file + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-file)) + +(defalias 'tramp-androidsu-handle-directory-file-name + (tramp-androidsu-generate-wrapper #'tramp-handle-directory-file-name)) + +(defalias 'tramp-androidsu-handle-directory-files + (tramp-androidsu-generate-wrapper #'tramp-handle-directory-files)) + +(defalias 'tramp-androidsu-adb-handle-directory-files-and-attributes + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-directory-files-and-attributes)) + +(defalias 'tramp-androidsu-handle-dired-uncache + (tramp-androidsu-generate-wrapper #'tramp-handle-dired-uncache)) + +(defalias 'tramp-androidsu-adb-handle-exec-path + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-exec-path)) + +(defalias 'tramp-androidsu-handle-expand-file-name + (tramp-androidsu-generate-wrapper #'tramp-handle-expand-file-name)) + +(defalias 'tramp-androidsu-handle-file-accessible-directory-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-accessible-directory-p)) + +(defalias 'tramp-androidsu-adb-handle-file-attributes + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-attributes)) + +(defalias 'tramp-androidsu-handle-file-directory-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-directory-p)) + +(defalias 'tramp-androidsu-handle-file-equal-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-equal-p)) + +(defalias 'tramp-androidsu-adb-handle-file-executable-p + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-executable-p)) + +(defalias 'tramp-androidsu-adb-handle-file-exists-p + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-exists-p)) + +(defalias 'tramp-androidsu-handle-file-group-gid + (tramp-androidsu-generate-wrapper #'tramp-handle-file-group-gid)) + +(defalias 'tramp-androidsu-handle-file-in-directory-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-in-directory-p)) + +(defalias 'tramp-androidsu-sh-handle-file-local-copy + (tramp-androidsu-generate-wrapper #'tramp-sh-handle-file-local-copy)) + +(defalias 'tramp-androidsu-handle-file-locked-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-locked-p)) + +(defalias 'tramp-androidsu-handle-file-modes + (tramp-androidsu-generate-wrapper #'tramp-handle-file-modes)) + +(defalias 'tramp-androidsu-adb-handle-file-name-all-completions + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-name-all-completions)) + +(defalias 'tramp-androidsu-handle-file-name-as-directory + (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-as-directory)) + +(defalias 'tramp-androidsu-handle-file-name-case-insensitive-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-case-insensitive-p)) + +(defalias 'tramp-androidsu-handle-file-name-completion + (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-completion)) + +(defalias 'tramp-androidsu-handle-file-name-directory + (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-directory)) + +(defalias 'tramp-androidsu-handle-file-name-nondirectory + (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-nondirectory)) + +(defalias 'tramp-androidsu-handle-file-newer-than-file-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-newer-than-file-p)) + +(defalias 'tramp-androidsu-handle-file-notify-add-watch + (tramp-androidsu-generate-wrapper #'tramp-handle-file-notify-add-watch)) + +(defalias 'tramp-androidsu-handle-file-notify-rm-watch + (tramp-androidsu-generate-wrapper #'tramp-handle-file-notify-rm-watch)) + +(defalias 'tramp-androidsu-handle-file-notify-valid-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-notify-valid-p)) + +(defalias 'tramp-androidsu-adb-handle-file-readable-p + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-readable-p)) + +(defalias 'tramp-androidsu-handle-file-regular-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-regular-p)) + +(defalias 'tramp-androidsu-handle-file-remote-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-remote-p)) + +(defalias 'tramp-androidsu-handle-file-selinux-context + (tramp-androidsu-generate-wrapper #'tramp-handle-file-selinux-context)) + +(defalias 'tramp-androidsu-handle-file-symlink-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-symlink-p)) + +(defalias 'tramp-androidsu-adb-handle-file-system-info + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-system-info)) + +(defalias 'tramp-androidsu-handle-file-truename + (tramp-androidsu-generate-wrapper #'tramp-handle-file-truename)) + +(defalias 'tramp-androidsu-handle-file-user-uid + (tramp-androidsu-generate-wrapper #'tramp-handle-file-user-uid)) + +(defalias 'tramp-androidsu-adb-handle-file-writable-p + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-writable-p)) + +(defalias 'tramp-androidsu-handle-find-backup-file-name + (tramp-androidsu-generate-wrapper #'tramp-handle-find-backup-file-name)) + +(defalias 'tramp-androidsu-handle-insert-directory + (tramp-androidsu-generate-wrapper #'tramp-handle-insert-directory)) + +(defalias 'tramp-androidsu-handle-insert-file-contents + (tramp-androidsu-generate-wrapper #'tramp-handle-insert-file-contents)) + +(defalias 'tramp-androidsu-handle-list-system-processes + (tramp-androidsu-generate-wrapper #'tramp-handle-list-system-processes)) + +(defalias 'tramp-androidsu-handle-load + (tramp-androidsu-generate-wrapper #'tramp-handle-load)) + +(defalias 'tramp-androidsu-handle-lock-file + (tramp-androidsu-generate-wrapper #'tramp-handle-lock-file)) + +(defalias 'tramp-androidsu-handle-make-auto-save-file-name + (tramp-androidsu-generate-wrapper #'tramp-handle-make-auto-save-file-name)) + +(defalias 'tramp-androidsu-adb-handle-make-directory + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-make-directory)) + +(defalias 'tramp-androidsu-handle-make-lock-file-name + (tramp-androidsu-generate-wrapper #'tramp-handle-make-lock-file-name)) + +(defalias 'tramp-androidsu-handle-make-nearby-temp-file + (tramp-androidsu-generate-wrapper #'tramp-handle-make-nearby-temp-file)) + +(defalias 'tramp-androidsu-adb-handle-make-process + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-make-process)) + +(defalias 'tramp-androidsu-sh-handle-make-symbolic-link + (tramp-androidsu-generate-wrapper + #'tramp-sh-handle-make-symbolic-link)) + +(defalias 'tramp-androidsu-handle-memory-info + (tramp-androidsu-generate-wrapper #'tramp-handle-memory-info)) + +(defalias 'tramp-androidsu-handle-process-attributes + (tramp-androidsu-generate-wrapper #'tramp-handle-process-attributes)) + +(defalias 'tramp-androidsu-adb-handle-process-file + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-process-file)) + +(defalias 'tramp-androidsu-adb-handle-rename-file + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-rename-file)) + +(defalias 'tramp-androidsu-adb-handle-set-file-modes + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-modes)) + +(defalias 'tramp-androidsu-adb-handle-set-file-times + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-times)) + +(defalias 'tramp-androidsu-handle-set-visited-file-modtime + (tramp-androidsu-generate-wrapper #'tramp-handle-set-visited-file-modtime)) + +(defalias 'tramp-androidsu-handle-shell-command + (tramp-androidsu-generate-wrapper #'tramp-handle-shell-command)) + +(defalias 'tramp-androidsu-handle-start-file-process + (tramp-androidsu-generate-wrapper #'tramp-handle-start-file-process)) + +(defalias 'tramp-androidsu-handle-substitute-in-file-name + (tramp-androidsu-generate-wrapper #'tramp-handle-substitute-in-file-name)) + +(defalias 'tramp-androidsu-handle-temporary-file-directory + (tramp-androidsu-generate-wrapper #'tramp-handle-temporary-file-directory)) + +(defalias 'tramp-androidsu-adb-handle-get-remote-gid + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-gid)) + +(defalias 'tramp-androidsu-adb-handle-get-remote-groups + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-groups)) + +(defalias 'tramp-androidsu-adb-handle-get-remote-uid + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-uid)) + +(defalias 'tramp-androidsu-handle-unlock-file + (tramp-androidsu-generate-wrapper #'tramp-handle-unlock-file)) + +(defalias 'tramp-androidsu-handle-verify-visited-file-modtime + (tramp-androidsu-generate-wrapper #'tramp-handle-verify-visited-file-modtime)) + +(defalias 'tramp-androidsu-handle-write-region + (tramp-androidsu-generate-wrapper #'tramp-handle-write-region)) + +;;;###tramp-autoload +(defconst tramp-androidsu-file-name-handler-alist + '(;; `abbreviate-file-name' performed by default handler. + (access-file . tramp-androidsu-handle-access-file) + (add-name-to-file . tramp-androidsu-handle-add-name-to-file) + ;; `byte-compiler-base-file-name' performed by default handler. + (copy-directory . tramp-androidsu-handle-copy-directory) + (copy-file . tramp-androidsu-adb-handle-copy-file) + (delete-directory . tramp-androidsu-adb-handle-delete-directory) + (delete-file . tramp-androidsu-adb-handle-delete-file) + ;; `diff-latest-backup-file' performed by default handler. + (directory-file-name . tramp-androidsu-handle-directory-file-name) + (directory-files . tramp-androidsu-handle-directory-files) + (directory-files-and-attributes + . tramp-androidsu-adb-handle-directory-files-and-attributes) + (dired-compress-file . ignore) + (dired-uncache . tramp-androidsu-handle-dired-uncache) + (exec-path . tramp-androidsu-adb-handle-exec-path) + (expand-file-name . tramp-androidsu-handle-expand-file-name) + (file-accessible-directory-p . tramp-androidsu-handle-file-accessible-directory-p) + (file-acl . ignore) + (file-attributes . tramp-androidsu-adb-handle-file-attributes) + (file-directory-p . tramp-androidsu-handle-file-directory-p) + (file-equal-p . tramp-androidsu-handle-file-equal-p) + (file-executable-p . tramp-androidsu-adb-handle-file-executable-p) + (file-exists-p . tramp-androidsu-adb-handle-file-exists-p) + (file-group-gid . tramp-androidsu-handle-file-group-gid) + (file-in-directory-p . tramp-androidsu-handle-file-in-directory-p) + (file-local-copy . tramp-androidsu-sh-handle-file-local-copy) + (file-locked-p . tramp-androidsu-handle-file-locked-p) + (file-modes . tramp-androidsu-handle-file-modes) + (file-name-all-completions . tramp-androidsu-adb-handle-file-name-all-completions) + (file-name-as-directory . tramp-androidsu-handle-file-name-as-directory) + (file-name-case-insensitive-p . tramp-androidsu-handle-file-name-case-insensitive-p) + (file-name-completion . tramp-androidsu-handle-file-name-completion) + (file-name-directory . tramp-androidsu-handle-file-name-directory) + (file-name-nondirectory . tramp-androidsu-handle-file-name-nondirectory) + ;; `file-name-sans-versions' performed by default handler. + (file-newer-than-file-p . tramp-androidsu-handle-file-newer-than-file-p) + (file-notify-add-watch . tramp-androidsu-handle-file-notify-add-watch) + (file-notify-rm-watch . tramp-androidsu-handle-file-notify-rm-watch) + (file-notify-valid-p . tramp-androidsu-handle-file-notify-valid-p) + (file-ownership-preserved-p . ignore) + (file-readable-p . tramp-androidsu-adb-handle-file-readable-p) + (file-regular-p . tramp-androidsu-handle-file-regular-p) + (file-remote-p . tramp-androidsu-handle-file-remote-p) + (file-selinux-context . tramp-androidsu-handle-file-selinux-context) + (file-symlink-p . tramp-androidsu-handle-file-symlink-p) + (file-system-info . tramp-androidsu-adb-handle-file-system-info) + (file-truename . tramp-androidsu-handle-file-truename) + (file-user-uid . tramp-androidsu-handle-file-user-uid) + (file-writable-p . tramp-androidsu-adb-handle-file-writable-p) + (find-backup-file-name . tramp-androidsu-handle-find-backup-file-name) + ;; `get-file-buffer' performed by default handler. + (insert-directory . tramp-androidsu-handle-insert-directory) + (insert-file-contents . tramp-androidsu-handle-insert-file-contents) + (list-system-processes . tramp-androidsu-handle-list-system-processes) + (load . tramp-androidsu-handle-load) + (lock-file . tramp-androidsu-handle-lock-file) + (make-auto-save-file-name . tramp-androidsu-handle-make-auto-save-file-name) + (make-directory . tramp-androidsu-adb-handle-make-directory) + (make-directory-internal . ignore) + (make-lock-file-name . tramp-androidsu-handle-make-lock-file-name) + (make-nearby-temp-file . tramp-androidsu-handle-make-nearby-temp-file) + (make-process . tramp-androidsu-adb-handle-make-process) + (make-symbolic-link . tramp-androidsu-sh-handle-make-symbolic-link) + (memory-info . tramp-androidsu-handle-memory-info) + (process-attributes . tramp-androidsu-handle-process-attributes) + (process-file . tramp-androidsu-adb-handle-process-file) + (rename-file . tramp-androidsu-adb-handle-rename-file) + (set-file-acl . ignore) + (set-file-modes . tramp-androidsu-adb-handle-set-file-modes) + (set-file-selinux-context . ignore) + (set-file-times . tramp-androidsu-adb-handle-set-file-times) + (set-visited-file-modtime . tramp-androidsu-handle-set-visited-file-modtime) + (shell-command . tramp-androidsu-handle-shell-command) + (start-file-process . tramp-androidsu-handle-start-file-process) + (substitute-in-file-name . tramp-androidsu-handle-substitute-in-file-name) + (temporary-file-directory . tramp-androidsu-handle-temporary-file-directory) + (tramp-get-home-directory . ignore) + (tramp-get-remote-gid . tramp-androidsu-adb-handle-get-remote-gid) + (tramp-get-remote-groups . tramp-androidsu-adb-handle-get-remote-groups) + (tramp-get-remote-uid . tramp-androidsu-adb-handle-get-remote-uid) + (tramp-set-file-uid-gid . ignore) + (unhandled-file-name-directory . ignore) + (unlock-file . tramp-androidsu-handle-unlock-file) + (vc-registered . ignore) + (verify-visited-file-modtime . tramp-androidsu-handle-verify-visited-file-modtime) + (write-region . tramp-androidsu-handle-write-region)) + "Alist of TRAMP handler functions for superuser sessions on Android.") + +;; It must be a `defsubst' in order to push the whole code into +;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading. +;;;###tramp-autoload +(defsubst tramp-androidsu-file-name-p (vec-or-filename) + "Check whether VEC-OR-FILENAME is for the `androidsu' method." + (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))) + (equal (tramp-file-name-method vec) tramp-androidsu-method))) + +;;;###tramp-autoload +(defun tramp-androidsu-file-name-handler (operation &rest args) + "Invoke the `androidsu' handler for OPERATION. +First arg specifies the OPERATION, second arg is a list of +arguments to pass to the OPERATION." + (if-let ((fn (assoc operation tramp-androidsu-file-name-handler-alist))) + (prog1 (save-match-data (apply (cdr fn) args)) + (setq tramp-debug-message-fnh-function (cdr fn))) + (prog1 (tramp-run-real-handler operation args) + (setq tramp-debug-message-fnh-function operation)))) + +;;;###tramp-autoload +(tramp--with-startup + (tramp-register-foreign-file-name-handler + #'tramp-androidsu-file-name-p #'tramp-androidsu-file-name-handler)) + +(connection-local-set-profile-variables + 'tramp-adb-connection-local-default-ps-profile + tramp-adb-connection-local-default-ps-variables) + +(with-eval-after-load 'shell + (connection-local-set-profiles + `(:application tramp :protocol ,tramp-adb-method) + 'tramp-adb-connection-local-default-shell-profile + 'tramp-adb-connection-local-default-ps-profile)) + +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-androidsu 'force))) + +(provide 'tramp-androidsu) +;;; tramp-androidsu.el ends here -- cgit v1.2.3 From 1687adcb5c93b490e2e7edcd14615af295e791ed Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 26 Feb 2024 14:13:49 +0800 Subject: ; Delete trailing whitespace * lisp/net/tramp-androidsu.el (tramp-androidsu-maybe-open-connection): Delete trailing whitespace. --- lisp/net/tramp-androidsu.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index 417ef25ed8a..06800205f2e 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -158,7 +158,7 @@ multibyte mode and waits for the shell prompt to appear." ;; Mark it as connected. (tramp-set-connection-property p "connected" t)))) - + ;; Cleanup, and propagate the signal. ((error quit) (tramp-cleanup-connection vec t) -- cgit v1.2.3 From b3eb49a4661e31306555e82bdf24db6c36d67ad2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 26 Feb 2024 14:32:08 -0500 Subject: tex-mode.el: Increase depth of braces highlighted in $...$ blocks * lisp/textmodes/tex-mode.el (tex-font-lock-keywords-1): Increase depth of braces supported in $...$ blocks. (tex-font-lock-keywords-2, tex-font-lock-syntactic-face-function): Refer directly to font-lock faces. --- lisp/textmodes/tex-mode.el | 32 ++++++++++++++++++-------------- 1 file changed, 18 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 5c5ca573f38..616b8871090 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -511,9 +511,14 @@ An alternative value is \" . \", if you use a font with a narrow period." ;; This would allow highlighting \newcommand\CMD but requires ;; adapting subgroup numbers below. ;; (arg "\\(?:{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)\\|\\\\[a-z*]+\\)")) - (inbraces-re (lambda (re) - (concat "\\(?:[^{}\\]\\|\\\\.\\|" re "\\)"))) - (arg (concat "{\\(" (funcall inbraces-re "{[^}]*}") "+\\)"))) + (inbraces-re + (lambda (n) ;; Level of nesting of braces we should support. + (let ((re "[^}]")) + (dotimes (_ n) + (setq re + (concat "\\(?:[^{}\\]\\|\\\\.\\|{" re "*}\\)"))) + re))) + (arg (concat "{\\(" (funcall inbraces-re 2) "+\\)"))) `(;; Verbatim-like args. ;; Do it first, because we don't want to highlight them ;; in comments (bug#68827), but we do want to highlight them @@ -523,8 +528,7 @@ An alternative value is \" . \", if you use a font with a narrow period." ;; This is done at the very beginning so as to interact with the other ;; keywords in the same way as comments and strings. (,(concat "\\$\\$?\\(?:[^$\\{}]\\|\\\\.\\|{" - (funcall inbraces-re - (concat "{" (funcall inbraces-re "{[^}]*}") "*}")) + (funcall inbraces-re 6) "*}\\)+\\$?\\$") (0 'tex-math keep)) ;; Heading args. @@ -605,14 +609,14 @@ An alternative value is \" . \", if you use a font with a narrow period." (list (concat (regexp-opt '("``" "\"<" "\"`" "<<" "«") t) "\\(\\(.\\|\n\\)+?\\)" (regexp-opt `("''" "\">" "\"'" ">>" "»") t)) - '(1 font-lock-keyword-face) - '(2 font-lock-string-face) - '(4 font-lock-keyword-face)) + '(1 'font-lock-keyword-face) + '(2 'font-lock-string-face) + '(4 'font-lock-keyword-face)) ;; ;; Command names, special and general. (cons (concat slash specials-1) 'font-lock-warning-face) (list (concat "\\(" slash specials-2 "\\)\\([^a-zA-Z@]\\|\\'\\)") - 1 'font-lock-warning-face) + '(1 'font-lock-warning-face)) (concat slash general) ;; ;; Font environments. It seems a bit dubious to use `bold' etc. faces @@ -680,7 +684,7 @@ An alternative value is \" . \", if you use a font with a narrow period." (eval-when-compile (defconst tex-syntax-propertize-rules (syntax-propertize-precompile-rules - ("\\\\verb\\**\\([^a-z@*]\\)" + ("\\\\verb\\**\\([^a-z@*]\\)" (1 (prog1 "\"" (tex-font-lock-verb (match-beginning 0) (char-after (match-beginning 1)))))))) @@ -764,7 +768,7 @@ automatically inserts its partner." (regexp-quote (buffer-substring arg-start arg-end))) (text-clone-create arg-start arg-end)))))))) (scan-error nil) - (error (message "Error in latex-env-before-change: %s" err))))) + (error (message "Error in latex-env-before-change: %S" err))))) (defun tex-font-lock-unfontify-region (beg end) (font-lock-default-unfontify-region beg end) @@ -852,7 +856,7 @@ START is the position of the \\ and DELIM is the delimiter char." (let ((char (nth 3 state))) (cond ((not char) - (if (eq 2 (nth 7 state)) 'tex-verbatim font-lock-comment-face)) + (if (eq 2 (nth 7 state)) 'tex-verbatim 'font-lock-comment-face)) ((eq char ?$) 'tex-math) ;; A \verb element. (t 'tex-verbatim)))) @@ -1265,8 +1269,8 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook (setq-local facemenu-end-add-face "}") (setq-local facemenu-remove-face-function t) (setq-local font-lock-defaults - '((tex-font-lock-keywords tex-font-lock-keywords-1 - tex-font-lock-keywords-2 tex-font-lock-keywords-3) + '(( tex-font-lock-keywords tex-font-lock-keywords-1 + tex-font-lock-keywords-2 tex-font-lock-keywords-3) nil nil nil nil ;; Who ever uses that anyway ??? (font-lock-mark-block-function . mark-paragraph) -- cgit v1.2.3 From 32b4f9d21b14190f1ed1611515751abe4b90fa68 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 27 Feb 2024 10:05:56 +0800 Subject: Disable process tracing before launching /system/bin/su * lisp/net/tramp-androidsu.el (tramp-androidsu-maybe-open-connection): Disable process tracing around start-process, that the setuid su binary may be started regardless of its status. --- lisp/net/tramp-androidsu.el | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index 06800205f2e..cf6b0d7202c 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -55,6 +55,8 @@ (add-to-list 'tramp-default-host-alist `(,tramp-androidsu-method nil "localhost"))) +(defvar android-use-exec-loader) ; androidfns.c. + (defun tramp-androidsu-maybe-open-connection (vec) "Open a connection VEC if not already open. Mostly identical to `tramp-adb-maybe-open-connection', but also disables @@ -84,14 +86,17 @@ multibyte mode and waits for the shell prompt to appear." (tramp-file-name-method vec))) (let* ((coding-system-for-read 'utf-8-unix) (process-connection-type tramp-process-connection-type) - (p (apply - #'start-process - (tramp-get-connection-name vec) - (tramp-get-connection-buffer vec) - (append - `(,tramp-encoding-shell) - (and tramp-encoding-command-interactive - `(,tramp-encoding-command-interactive))))) + ;; The executable loader cannot execute setuid + ;; binaries, such as su. + (android-use-exec-loader nil) + (p (start-process (tramp-get-connection-name vec) + (tramp-get-connection-buffer vec) + ;; Disregard + ;; tramp-encoding-shell, as + ;; there's no guarantee that it's + ;; possible to execute with + ;; `android-use-exec-loader' off. + "/system/bin/sh" "-i")) (user (tramp-file-name-user vec)) command) ;; Set sentinel. Initialize variables. -- cgit v1.2.3 From b59d7094b6cb1a09f46f933807e9cd00a8bd1547 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 27 Feb 2024 10:32:08 +0100 Subject: Allow vc-git-clone to check-out arbitrary revisions * lisp/vc/vc-git.el (vc-git-clone): If "git clone --branch" fails, then clone the repository regularly and checkout the requested revision. --- lisp/vc/vc-git.el | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 456417e566e..18b4a8691e9 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1411,9 +1411,16 @@ This prompts for a branch to merge from." (vc-message-unresolved-conflicts buffer-file-name))) (defun vc-git-clone (remote directory rev) - (if rev - (vc-git--out-ok "clone" "--branch" rev remote directory) + "Attempt to clone REMOTE repository into DIRECTORY at revision REV." + (cond + ((null rev) (vc-git--out-ok "clone" remote directory)) + ((ignore-errors + (vc-git--out-ok "clone" "--branch" rev remote directory))) + ((vc-git--out-ok "clone" remote directory) + (let ((default-directory directory)) + (vc-git--out-ok "checkout" rev))) + ((error "Failed to check out %s at %s" remote rev))) directory) ;;; HISTORY FUNCTIONS -- cgit v1.2.3 From 647cecc853e53a3be0bb2cf5328cd19e677217c9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 27 Feb 2024 15:11:58 +0200 Subject: ; * lisp/vc/vc.el (vc-clone): Fix wording of doc string. --- lisp/vc/vc.el | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 549eae6e663..25540406b4e 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3676,11 +3676,16 @@ to provide the `find-revision' operation instead." (vc-call-backend (vc-backend buffer-file-name) 'check-headers)) (defun vc-clone (remote &optional backend directory rev) - "Use BACKEND to clone REMOTE into DIRECTORY. -If successful, returns the string with the directory of the -checkout. If BACKEND is nil, iterate through every known backend -in `vc-handled-backends' until one succeeds. If REV is non-nil, -it indicates a specific revision to check out." + "Clone repository REMOTE using version-control BACKEND, into DIRECTORY. +If successful, return the string with the directory of the checkout; +otherwise return nil. +REMOTE should be a string, the URL of the remote repository or the name +of a directory (if the repository is local). +If DIRECTORY is nil or omitted, it defaults to `default-directory'. +If BACKEND is nil or omitted, the function iterates through every known +backend in `vc-handled-backends' until one succeeds to clone REMOTE. +If REV is non-nil, it indicates a specific revision to check out after +cloning; the syntax of REV depends on what BACKEND accepts." (unless directory (setq directory default-directory)) (if backend -- cgit v1.2.3 From 6a77355527b2f7f1dca9c2296c2684033c9aa875 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 27 Feb 2024 08:24:45 -0500 Subject: vhdl-mode.el: Reduce use of `eval` * lisp/progmodes/vhdl-mode.el (vhdl--re2-region): New function. (vhdl--signal-regions-functions): New constant, extracted from `vhdl-update-sensitivity-list`. (vhdl-update-sensitivity-list): Use it. --- lisp/progmodes/vhdl-mode.el | 76 ++++++++++++++++++++++++--------------------- 1 file changed, 41 insertions(+), 35 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index f52baf049aa..144bfa944d3 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -8398,6 +8398,44 @@ buffer." (message "Updating sensitivity lists...done"))) (when noninteractive (save-buffer))) +(defun vhdl--re2-region (beg-re end-re) + "Return a function searching for a region delimited by a pair of regexps. +BEG-RE and END-RE are the regexps delimiting the region to search for." + (lambda (proc-end) + (when (vhdl-re-search-forward beg-re proc-end t) + (save-excursion + (vhdl-re-search-forward end-re proc-end t))))) + +(defconst vhdl--signal-regions-functions + (list + ;; right-hand side of signal/variable assignment + ;; (special case: "<=" is relational operator in a condition) + (vhdl--re2-region "[<:]=" + ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>") + ;; if condition + (vhdl--re2-region "^\\s-*if\\>" "\\") + ;; elsif condition + (vhdl--re2-region "\\" "\\") + ;; while loop condition + (vhdl--re2-region "^\\s-*while\\>" "\\") + ;; exit/next condition + (vhdl--re2-region "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" ";") + ;; assert condition + (vhdl--re2-region "\\" "\\(\\\\|\\\\|;\\)") + ;; case expression + (vhdl--re2-region "^\\s-*case\\>" "\\") + ;; parameter list of procedure call, array index + (lambda (proc-end) + (when (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t) + (forward-char -1) + (save-excursion + (forward-sexp) + (while (looking-at "(") (forward-sexp)) (point))))) + "Define syntactic regions where signals are read. +Each function is called with one arg (a limit for the (forward) search) and +should return either nil or the end position of the region (in which case +point will be set to its beginning).") + (defun vhdl-update-sensitivity-list () "Update sensitivity list." (let ((proc-beg (point)) @@ -8418,35 +8456,6 @@ buffer." (let ;; scan for visible signals ((visible-list (vhdl-get-visible-signals)) - ;; define syntactic regions where signals are read - (scan-regions-list - `(;; right-hand side of signal/variable assignment - ;; (special case: "<=" is relational operator in a condition) - ((vhdl-re-search-forward "[<:]=" ,proc-end t) - (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" ,proc-end t)) - ;; if condition - ((vhdl-re-search-forward "^\\s-*if\\>" ,proc-end t) - (vhdl-re-search-forward "\\" ,proc-end t)) - ;; elsif condition - ((vhdl-re-search-forward "\\" ,proc-end t) - (vhdl-re-search-forward "\\" ,proc-end t)) - ;; while loop condition - ((vhdl-re-search-forward "^\\s-*while\\>" ,proc-end t) - (vhdl-re-search-forward "\\" ,proc-end t)) - ;; exit/next condition - ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" ,proc-end t) - (vhdl-re-search-forward ";" ,proc-end t)) - ;; assert condition - ((vhdl-re-search-forward "\\" ,proc-end t) - (vhdl-re-search-forward "\\(\\\\|\\\\|;\\)" ,proc-end t)) - ;; case expression - ((vhdl-re-search-forward "^\\s-*case\\>" ,proc-end t) - (vhdl-re-search-forward "\\" ,proc-end t)) - ;; parameter list of procedure call, array index - ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" ,proc-end t) - (1- (point))) - (progn (backward-char) (forward-sexp) - (while (looking-at "(") (forward-sexp)) (point))))) name field read-list sens-list signal-list tmp-list sens-beg sens-end beg end margin) ;; scan for signals in old sensitivity list @@ -8475,11 +8484,9 @@ buffer." (push (cons end (point)) seq-region-list) (beginning-of-line))) ;; scan for signals read in process - (while scan-regions-list + (dolist (scan-fun vhdl--signal-regions-functions) (goto-char proc-mid) - (while (and (setq beg (eval (nth 0 (car scan-regions-list)))) - (setq end (eval (nth 1 (car scan-regions-list))))) - (goto-char beg) + (while (setq end (funcall scan-fun proc-end)) (unless (or (vhdl-in-literal) (and seq-region-list (let ((tmp-list seq-region-list)) @@ -8518,8 +8525,7 @@ buffer." (car tmp-list)) (setq read-list (delete (car tmp-list) read-list))) (setq tmp-list (cdr tmp-list))))) - (goto-char (match-end 1))))) - (setq scan-regions-list (cdr scan-regions-list))) + (goto-char (match-end 1)))))) ;; update sensitivity list (goto-char sens-beg) (if sens-end -- cgit v1.2.3 From f1db8cf9a0595f7db29b548b38ce98196f36e09b Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 28 Feb 2024 12:05:59 +0800 Subject: Lift restrictions on `tramp-androidsu's app data access * lisp/net/tramp-adb.el (tramp-adb-handle-copy-file): Remove code now unnecessary. * lisp/net/tramp-androidsu.el (tramp-androidsu-mount-global-namespace): New user option. (tramp-androidsu-su-mm-supported): New variable. (tramp-androidsu-maybe-open-connection): Detect whether su supports the -mm option, and provide it if so. (tramp-androidsu-adb-handle-copy-file) (tramp-androidsu-adb-handle-rename-file): Delete functions. (tramp-androidsu-sh-handle-copy-file) (tramp-androidsu-sh-handle-rename-file): New functions. (tramp-androidsu-file-name-handler-alist): Switch to tramp-sh's copy and rename handlers. --- lisp/net/tramp-adb.el | 21 ++++------------- lisp/net/tramp-androidsu.el | 55 ++++++++++++++++++++++++++++++++++++--------- 2 files changed, 49 insertions(+), 27 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 4f04912c032..3f216ba403a 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -641,23 +641,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; because `file-attributes' reads the values from ;; there. (tramp-flush-file-properties v localname) - (unless (if (tramp-adb-file-name-p v) - (tramp-adb-execute-adb-command - v "push" - (file-name-unquote filename) - (file-name-unquote localname)) - ;; Otherwise, this operation was initiated - ;; by the androidsu backend, so both files - ;; must be present on the local machine and - ;; transferable with a simple local copy. - (tramp-adb-send-command-and-check - v - (format - "cp -f %s %s" - (tramp-shell-quote-argument - (file-name-unquote filename)) - (tramp-shell-quote-argument - (file-name-unquote localname))))) + (unless (tramp-adb-execute-adb-command + v "push" + (file-name-unquote filename) + (file-name-unquote localname)) (tramp-error v 'file-error "Cannot copy `%s' `%s'" filename newname))))))))) diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index cf6b0d7202c..6d4ac2c17f1 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -40,6 +40,22 @@ (defconst tramp-androidsu-method "androidsu" "When this method name is used, forward all calls to su.") +;;;###tramp-autoload +(defcustom tramp-androidsu-mount-global-namespace t + "When non-nil, browse files from within the global mount namespace. +On systems that assign each application a unique view of the filesystem +by executing them within individual mount namespaces and thus conceal +each application's data directories from others, invoke `su' with the +option `-mm' in order for the shell launched to run within the global +mount namespace, so that TRAMP may edit files belonging to any and all +applications." + :group 'tramp + :version "30.1" + :type 'boolean) + +(defvar tramp-androidsu-su-mm-supported 'unknown + "Whether `su -mm' is supported on this system.") + ;;;###tramp-autoload (tramp--with-startup (add-to-list 'tramp-methods @@ -94,7 +110,7 @@ multibyte mode and waits for the shell prompt to appear." ;; Disregard ;; tramp-encoding-shell, as ;; there's no guarantee that it's - ;; possible to execute with + ;; possible to execute it with ;; `android-use-exec-loader' off. "/system/bin/sh" "-i")) (user (tramp-file-name-user vec)) @@ -103,13 +119,32 @@ multibyte mode and waits for the shell prompt to appear." (set-process-sentinel p #'tramp-process-sentinel) (tramp-post-process-creation p vec) - ;; Replace `login-args' place holders. + ;; Replace `login-args' place holders. (setq command (format "exec su - %s || exit" (or user "root"))) - ;; Send the command. + + ;; Attempt to execute the shell inside the global mount + ;; namespace if requested. + (when tramp-androidsu-mount-global-namespace + (progn + (when (eq tramp-androidsu-su-mm-supported 'unknown) + ;; Change the prompt in advance so that + ;; tramp-adb-send-command-and-check can call + ;; tramp-search-regexp. + (tramp-adb-send-command + vec (format "PS1=%s" + (tramp-shell-quote-argument + tramp-end-of-output))) + (setq tramp-androidsu-su-mm-supported + ;; Detect support for `su -mm'. + (tramp-adb-send-command-and-check + vec "su -mm -c 'exit 24'" 24))) + (when tramp-androidsu-su-mm-supported + (setq command (format "exec su -mm - %s || exit" + (or user "root")))))) + ;; Send the command. (tramp-message vec 3 "Sending command `%s'" command) (tramp-adb-send-command vec command t t) - ;; Android su binaries contact a background service to ;; obtain authentication; during this process, input ;; received is discarded, so input cannot be @@ -204,8 +239,8 @@ FUNCTION." (defalias 'tramp-androidsu-handle-copy-directory (tramp-androidsu-generate-wrapper #'tramp-handle-copy-directory)) -(defalias 'tramp-androidsu-adb-handle-copy-file - (tramp-androidsu-generate-wrapper #'tramp-adb-handle-copy-file)) +(defalias 'tramp-androidsu-sh-handle-copy-file + (tramp-androidsu-generate-wrapper #'tramp-sh-handle-copy-file)) (defalias 'tramp-androidsu-adb-handle-delete-directory (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-directory)) @@ -367,8 +402,8 @@ FUNCTION." (defalias 'tramp-androidsu-adb-handle-process-file (tramp-androidsu-generate-wrapper #'tramp-adb-handle-process-file)) -(defalias 'tramp-androidsu-adb-handle-rename-file - (tramp-androidsu-generate-wrapper #'tramp-adb-handle-rename-file)) +(defalias 'tramp-androidsu-sh-handle-rename-file + (tramp-androidsu-generate-wrapper #'tramp-sh-handle-rename-file)) (defalias 'tramp-androidsu-adb-handle-set-file-modes (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-modes)) @@ -416,7 +451,7 @@ FUNCTION." (add-name-to-file . tramp-androidsu-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. (copy-directory . tramp-androidsu-handle-copy-directory) - (copy-file . tramp-androidsu-adb-handle-copy-file) + (copy-file . tramp-androidsu-sh-handle-copy-file) (delete-directory . tramp-androidsu-adb-handle-delete-directory) (delete-file . tramp-androidsu-adb-handle-delete-file) ;; `diff-latest-backup-file' performed by default handler. @@ -478,7 +513,7 @@ FUNCTION." (memory-info . tramp-androidsu-handle-memory-info) (process-attributes . tramp-androidsu-handle-process-attributes) (process-file . tramp-androidsu-adb-handle-process-file) - (rename-file . tramp-androidsu-adb-handle-rename-file) + (rename-file . tramp-androidsu-sh-handle-rename-file) (set-file-acl . ignore) (set-file-modes . tramp-androidsu-adb-handle-set-file-modes) (set-file-selinux-context . ignore) -- cgit v1.2.3 From 977a56d5c7d71b958767dbae05b75c5e5cb87571 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 28 Feb 2024 12:23:32 +0800 Subject: ; Fix last change * lisp/net/tramp-androidsu.el (tramp-androidsu-handle-write-region): Delete function. (tramp-androidsu-sh-handle-write-region): New function. (tramp-androidsu-file-name-handler-alist): Avoid infinite recursion by replacing handle-write-region with the tramp-sh implementation. --- lisp/net/tramp-androidsu.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index 6d4ac2c17f1..fd9edb6a92e 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -441,8 +441,8 @@ FUNCTION." (defalias 'tramp-androidsu-handle-verify-visited-file-modtime (tramp-androidsu-generate-wrapper #'tramp-handle-verify-visited-file-modtime)) -(defalias 'tramp-androidsu-handle-write-region - (tramp-androidsu-generate-wrapper #'tramp-handle-write-region)) +(defalias 'tramp-androidsu-sh-handle-write-region + (tramp-androidsu-generate-wrapper #'tramp-sh-handle-write-region)) ;;;###tramp-autoload (defconst tramp-androidsu-file-name-handler-alist @@ -532,7 +532,7 @@ FUNCTION." (unlock-file . tramp-androidsu-handle-unlock-file) (vc-registered . ignore) (verify-visited-file-modtime . tramp-androidsu-handle-verify-visited-file-modtime) - (write-region . tramp-androidsu-handle-write-region)) + (write-region . tramp-androidsu-sh-handle-write-region)) "Alist of TRAMP handler functions for superuser sessions on Android.") ;; It must be a `defsubst' in order to push the whole code into -- cgit v1.2.3 From e490d2f8724c5e47d83c40c388f60e84f541dae5 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 28 Feb 2024 16:31:25 +0100 Subject: Revert change in tramp-adb-send-command * lisp/net/tramp-adb.el (tramp-adb-send-command): Revert check for `tramp-androidsu-method'. There is no need to restrict the check. --- lisp/net/tramp-adb.el | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 3f216ba403a..8ad7c271b4f 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -1114,9 +1114,7 @@ error and non-nil on success." (defun tramp-adb-send-command (vec command &optional neveropen nooutput) "Send the COMMAND to connection VEC." - (if (and (equal (tramp-file-name-method vec) - tramp-androidsu-method) - (string-match-p (rx multibyte) command)) + (if (string-match-p (rx multibyte) command) ;; Multibyte codepoints with four bytes are not supported at ;; least by toybox. @@ -1148,8 +1146,8 @@ error and non-nil on success." (while (search-forward-regexp (rx (+ "\r") eol) nil t) (replace-match "" nil nil))))))) -(defun tramp-adb-send-command-and-check (vec command &optional exit-status - command-augmented-p) +(defun tramp-adb-send-command-and-check + (vec command &optional exit-status command-augmented-p) "Run COMMAND and check its exit status. Sends `echo $?' along with the COMMAND for checking the exit status. If COMMAND is nil, just sends `echo $?'. Returns nil if @@ -1162,7 +1160,8 @@ Optional argument EXIT-STATUS, if non-nil, triggers the return of the exit status." (tramp-adb-send-command vec (if command - (if command-augmented-p command + (if command-augmented-p + command (format "%s; echo tramp_exit_status $?" command)) "echo tramp_exit_status $?")) (with-current-buffer (tramp-get-connection-buffer vec) -- cgit v1.2.3 From f7c2fe3337bb5e5721d17f40f79dbc1275e17b0d Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 28 Feb 2024 16:38:21 +0100 Subject: Pacify some docstring control char warnings Other instances are discussed in the following thread: https://lists.gnu.org/r/emacs-devel/2024-02/msg00797.html * lisp/allout.el (allout-command-prefix): Declare :type as key-sequence. Mark up key sequences in docstring. * lisp/auth-source.el (auth-source--decode-octal-string): * lisp/ffap.el (ffap-search-backward-file-end): * lisp/gnus/gnus-art.el (gnus-page-delimiter): * lisp/gnus/nnheader.el (nnheader-strip-cr): * lisp/proced.el (proced-log): * lisp/progmodes/idlw-shell.el (idlwave-shell-prompt-pattern): * lisp/url/url-http.el (url-http-clean-headers): * lisp/vcursor.el (vcursor-interpret-input): Quote control characters in docstrings. --- lisp/allout.el | 6 +++--- lisp/auth-source.el | 2 +- lisp/ffap.el | 4 ++-- lisp/gnus/gnus-art.el | 2 +- lisp/gnus/nnheader.el | 2 +- lisp/proced.el | 2 +- lisp/progmodes/idlw-shell.el | 4 ++-- lisp/url/url-http.el | 2 +- lisp/vcursor.el | 2 +- 9 files changed, 13 insertions(+), 13 deletions(-) (limited to 'lisp') diff --git a/lisp/allout.el b/lisp/allout.el index a7121efb14a..e3fe8d08841 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -161,9 +161,9 @@ respective `allout-mode' keybinding variables, `allout-command-prefix', (defcustom allout-command-prefix "\C-c " "Key sequence to be used as prefix for outline mode command key bindings. -Default is `\C-c'; just `\C-c' is more short-and-sweet, if you're -willing to let allout use a bunch of \C-c keybindings." - :type 'string +Default is \\`C-c SPC'; just \\`C-c' is more short-and-sweet, if you're +willing to let allout use a bunch of \\`C-c' keybindings." + :type 'key-sequence :group 'allout-keybindings :set #'allout-compose-and-institute-keymap) ;;;_ = allout-keybindings-binding diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 1f233f9f60f..5f5629d9cfc 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -1985,7 +1985,7 @@ entries for git.gnus.org: (defun auth-source--decode-octal-string (string) - "Convert octal STRING to utf-8 string. E.g: \"a\134b\" to \"a\b\"." + "Convert octal STRING to utf-8 string. E.g.: \"a\\134b\" to \"a\\b\"." (let ((list (string-to-list string)) (size (length string))) (decode-coding-string diff --git a/lisp/ffap.el b/lisp/ffap.el index 3492dcbf17a..5383f743878 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1098,12 +1098,12 @@ Suppose the cursor is somewhere that might be near end of file, the guessing would position point before punctuation (like comma) after the file extension: - C:\temp\file.log, which contain .... + C:\\temp\\file.log, which contain .... =============================== (before) ---------------- (after) - C:\temp\file.log on Windows or /tmp/file.log on Unix + C:\\temp\\file.log on Windows or /tmp/file.log on Unix =============================== (before) ---------------- (after) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index c3c5eab7d89..9f313108089 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -694,7 +694,7 @@ used as possible file names." (defcustom gnus-page-delimiter "^\^L" "Regexp describing what to use as article page delimiters. -The default value is \"^\^L\", which is a form linefeed at the +The default value is \"^\\^L\", which is a form linefeed at the beginning of a line." :type 'regexp :group 'gnus-article-various) diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 97821894b48..ea679759f3e 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -1016,7 +1016,7 @@ See `find-file-noselect' for the arguments." (nnheader-skeleton-replace from to t)) (defun nnheader-strip-cr () - "Strip all \r's from the current buffer." + "Strip all \\r's from the current buffer." (nnheader-skeleton-replace "\r")) (define-obsolete-function-alias 'nnheader-cancel-timer 'cancel-timer "27.1") diff --git a/lisp/proced.el b/lisp/proced.el index 3435f1ab8cd..7d7de1e2ce3 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -2261,7 +2261,7 @@ If LOG is a string and there are more args, it is formatted with those ARGS. Usually the LOG string ends with a \\n. End each bunch of errors with (proced-log t signal): this inserts the current time, buffer and signal at the start of the page, -and \f (formfeed) at the end." +and \\f (formfeed) at the end." (let ((obuf (current-buffer))) (with-current-buffer (get-buffer-create proced-log-buffer) (goto-char (point-max)) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 0f11103cf02..b5d91f46b17 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -96,8 +96,8 @@ (defcustom idlwave-shell-prompt-pattern "^\r? ?IDL> " "Regexp to match IDL prompt at beginning of a line. -For example, \"^\r?IDL> \" or \"^\r?WAVE> \". -The \"^\r?\" is needed, to indicate the beginning of the line, with +For example, \"^\\r?IDL> \" or \"^\\r?WAVE> \". +The \"^\\r?\" is needed, to indicate the beginning of the line, with optional return character (which IDL seems to output randomly). This variable is used to initialize `comint-prompt-regexp' in the process buffer." diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index d6a1d0eade8..184c1278072 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -427,7 +427,7 @@ Use `url-http-referer' as the Referer-header (subject to `url-privacy-level')." ;; Parsing routines (defun url-http-clean-headers () - "Remove trailing \r from header lines. + "Remove trailing \\r from header lines. This allows us to use `mail-fetch-field', etc. Return the number of characters removed." (let ((end (marker-position url-http-end-of-headers))) diff --git a/lisp/vcursor.el b/lisp/vcursor.el index ec5adbd832c..15791285b13 100644 --- a/lisp/vcursor.el +++ b/lisp/vcursor.el @@ -433,7 +433,7 @@ Default is nil." (defcustom vcursor-interpret-input nil "If non-nil, input from the vcursor is treated as interactive input. This will cause text insertion to be much slower. Note that no special -interpretation of strings is done: \"\C-x\" is a string of four +interpretation of strings is done: \"\\C-x\" is a string of four characters. The default is simply to copy strings." :type 'boolean :version "20.3") -- cgit v1.2.3 From bca3c9b466e24aacd561c818f2d19665af6efc11 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 28 Feb 2024 17:02:41 +0100 Subject: ; Fix :type of text-mode-ispell-word-completion. --- lisp/textmodes/text-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index 87f6668cecb..e8e1f4898ce 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -88,7 +88,7 @@ nor does it extend `completion-at-point-functions'. This user option only takes effect when you customize it in Custom or with `setopt', not with `setq'." :group 'text - :type 'boolean + :type '(choice (const completion-at-point) boolean) :version "30.1" :set (lambda (sym val) (if (and (set sym val) -- cgit v1.2.3 From 91b90885aca17b5140b56fa3b5c4960baf8672a1 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 28 Feb 2024 20:38:02 +0100 Subject: * lisp/emacs-lisp/comp.el (comp-known-predicates): Add 'symbol-with-pos-p'. --- lisp/emacs-lisp/comp.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index ae964b041d0..21e2bb01ed0 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -220,6 +220,7 @@ Useful to hook into pass checkers.") (sequencep . sequence) (stringp . string) (subrp . subr) + (symbol-with-pos-p . symbol-with-pos) (symbolp . symbol) (vectorp . vector) (windowp . window)) -- cgit v1.2.3 From 05195e129fc933db32c9e08a155a94bfa4d75b54 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 28 Feb 2024 20:38:30 +0100 Subject: * lisp/emacs-lisp/cl-macs.el (cl-deftype-satisfies): Add 'symbol-with-pos'. --- lisp/emacs-lisp/cl-macs.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index ddc9775bcce..be477b7a6df 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3496,6 +3496,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." (subr . subrp) (string . stringp) (symbol . symbolp) + (symbol-with-pos . symbol-with-pos-p) (vector . vectorp) (window . windowp) ;; FIXME: Do we really want to consider these types? -- cgit v1.2.3 From 15ed441fd53ddb476a2a21c8717697a74cf094e1 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 29 Feb 2024 10:59:09 +0800 Subject: Fix subprocess creation in directories managed by tramp-androidsu * lisp/net/tramp-androidsu.el (tramp-androidsu-maybe-open-connection): Set connection property remote-namespace to t or nil subject to whether su runs in the global mount namespace. (tramp-androidsu-adb-handle-make-process): Delete function. (tramp-androidsu-make-process): New function. (tramp-androidsu-file-name-handler-alist): Switch to tramp-androidsu-make-process. --- lisp/net/tramp-androidsu.el | 134 +++++++++++++++++++++++++++++++++++++++----- 1 file changed, 119 insertions(+), 15 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index fd9edb6a92e..1623a0341b2 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -118,11 +118,10 @@ multibyte mode and waits for the shell prompt to appear." ;; Set sentinel. Initialize variables. (set-process-sentinel p #'tramp-process-sentinel) (tramp-post-process-creation p vec) - ;; Replace `login-args' place holders. (setq command (format "exec su - %s || exit" (or user "root"))) - + (tramp-set-connection-property vec "remote-namespace" nil) ;; Attempt to execute the shell inside the global mount ;; namespace if requested. (when tramp-androidsu-mount-global-namespace @@ -140,6 +139,8 @@ multibyte mode and waits for the shell prompt to appear." (tramp-adb-send-command-and-check vec "su -mm -c 'exit 24'" 24))) (when tramp-androidsu-su-mm-supported + (tramp-set-connection-property + vec "remote-namespace" t) (setq command (format "exec su -mm - %s || exit" (or user "root")))))) ;; Send the command. @@ -156,27 +157,21 @@ multibyte mode and waits for the shell prompt to appear." ;; Set connection-local variables. (tramp-set-connection-local-variables vec) - ;; Change prompt. (tramp-adb-send-command vec (format "PS1=%s" (tramp-shell-quote-argument tramp-end-of-output))) - ;; Disable line editing. (tramp-adb-send-command vec "set +o vi +o vi-esccomplete +o vi-tabcomplete +o emacs") - ;; Dump option settings in the traces. (when (>= tramp-verbose 9) (tramp-adb-send-command vec "set -o")) - ;; Disable Unicode. (tramp-adb-send-command vec "set +U") - ;; Disable echo expansion. (tramp-adb-send-command vec "stty -inlcr -onlcr -echo kill '^U' erase '^H'" t) - ;; Check whether the echo has really been disabled. ;; Some implementations, like busybox, don't support ;; disabling. @@ -191,14 +186,12 @@ multibyte mode and waits for the shell prompt to appear." (tramp-adb-send-command vec "stty icanon erase ^H cols 32767" t))) - ;; Set the remote PATH to a suitable value. (tramp-set-connection-property vec "remote-path" - "/system/bin:/system/xbin") - + '("/system/bin" + "/system/xbin")) ;; Mark it as connected. (tramp-set-connection-property p "connected" t)))) - ;; Cleanup, and propagate the signal. ((error quit) (tramp-cleanup-connection vec t) @@ -386,8 +379,119 @@ FUNCTION." (defalias 'tramp-androidsu-handle-make-nearby-temp-file (tramp-androidsu-generate-wrapper #'tramp-handle-make-nearby-temp-file)) -(defalias 'tramp-androidsu-adb-handle-make-process - (tramp-androidsu-generate-wrapper #'tramp-adb-handle-make-process)) +(defun tramp-androidsu-make-process (&rest args) + "Like `tramp-handle-make-process', but modified for Android." + (when args + (with-parsed-tramp-file-name (expand-file-name default-directory) nil + (let ((default-directory tramp-compat-temporary-file-directory) + (name (plist-get args :name)) + (buffer (plist-get args :buffer)) + (command (plist-get args :command)) + (coding (plist-get args :coding)) + (noquery (plist-get args :noquery)) + (connection-type + (or (plist-get args :connection-type) process-connection-type)) + (filter (plist-get args :filter)) + (sentinel (plist-get args :sentinel)) + (stderr (plist-get args :stderr))) + (unless (stringp name) + (signal 'wrong-type-argument (list #'stringp name))) + (unless (or (bufferp buffer) (string-or-null-p buffer)) + (signal 'wrong-type-argument (list #'bufferp buffer))) + (unless (consp command) + (signal 'wrong-type-argument (list #'consp command))) + (unless (or (null coding) + (and (symbolp coding) (memq coding coding-system-list)) + (and (consp coding) + (memq (car coding) coding-system-list) + (memq (cdr coding) coding-system-list))) + (signal 'wrong-type-argument (list #'symbolp coding))) + (when (eq connection-type t) + (setq connection-type 'pty)) + (unless (or (and (consp connection-type) + (memq (car connection-type) '(nil pipe pty)) + (memq (cdr connection-type) '(nil pipe pty))) + (memq connection-type '(nil pipe pty))) + (signal 'wrong-type-argument (list #'symbolp connection-type))) + (unless (or (null filter) (eq filter t) (functionp filter)) + (signal 'wrong-type-argument (list #'functionp filter))) + (unless (or (null sentinel) (functionp sentinel)) + (signal 'wrong-type-argument (list #'functionp sentinel))) + (unless (or (null stderr) (bufferp stderr)) + (signal 'wrong-type-argument (list #'bufferp stderr))) + (let* ((buffer + (if buffer + (get-buffer-create buffer) + ;; BUFFER can be nil. We use a temporary buffer. + (generate-new-buffer tramp-temp-buffer-name))) + (orig-command command) + (env (mapcar + (lambda (elt) + (when (tramp-compat-string-search "=" elt) elt)) + tramp-remote-process-environment)) + ;; We use as environment the difference to toplevel + ;; `process-environment'. + (env (dolist (elt process-environment env) + (when + (and + (tramp-compat-string-search "=" elt) + (not + (member + elt (default-toplevel-value 'process-environment)))) + (setq env (cons elt env))))) + ;; Add remote path if exists. + (env (let ((remote-path + (string-join (tramp-get-remote-path v) ":"))) + (setenv-internal env "PATH" remote-path 'keep))) + (env (setenv-internal + env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)) + (env (mapcar #'tramp-shell-quote-argument (delq nil env))) + ;; Quote command. + (command (mapconcat #'tramp-shell-quote-argument command " ")) + ;; Set cwd and environment variables. + (command + (append + `("cd" ,(tramp-shell-quote-argument localname) "&&" "(" "env") + env `(,command ")"))) + ;; Add remote shell if needed. + (command + (if (consp (tramp-get-method-parameter v 'tramp-direct-async)) + (append + (tramp-get-method-parameter v 'tramp-direct-async) + `(,(string-join command " "))) + command)) + p) + ;; Generate a command to start the process using `su' with + ;; suitable options for specifying the mount namespace and + ;; suchlike. + (setq + p (make-process + :name name :buffer buffer + :command (if (tramp-get-connection-property v "remote-namespace") + (append (list "su" "-mm" "-" (or user "root") "-c") + command) + (append (list "su" "-" (or user "root") "-c") + command)) + :coding coding :noquery noquery :connection-type connection-type + :sentinel sentinel :stderr stderr)) + ;; Set filter. Prior Emacs 29.1, it doesn't work reliably + ;; to provide it as `make-process' argument when filter is + ;; t. See Bug#51177. + (when filter + (set-process-filter p filter)) + (tramp-post-process-creation p v) + ;; Query flag is overwritten in `tramp-post-process-creation', + ;; so we reset it. + (set-process-query-on-exit-flag p (null noquery)) + ;; This is needed for ssh or PuTTY based processes, and + ;; only if the respective options are set. Perhaps, the + ;; setting could be more fine-grained. + ;; (process-put p 'tramp-shared-socket t) + (process-put p 'remote-command orig-command) + (tramp-set-connection-property p "remote-command" orig-command) + (when (bufferp stderr) + (tramp-taint-remote-process-buffer stderr)) + p))))) (defalias 'tramp-androidsu-sh-handle-make-symbolic-link (tramp-androidsu-generate-wrapper @@ -508,7 +612,7 @@ FUNCTION." (make-directory-internal . ignore) (make-lock-file-name . tramp-androidsu-handle-make-lock-file-name) (make-nearby-temp-file . tramp-androidsu-handle-make-nearby-temp-file) - (make-process . tramp-androidsu-adb-handle-make-process) + (make-process . tramp-androidsu-make-process) (make-symbolic-link . tramp-androidsu-sh-handle-make-symbolic-link) (memory-info . tramp-androidsu-handle-memory-info) (process-attributes . tramp-androidsu-handle-process-attributes) -- cgit v1.2.3 From 862dfef88d8e62d12bac3ca2e44e035a2ff5b298 Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Thu, 29 Feb 2024 09:29:04 +0100 Subject: Pacify more docstring control char warnings * lisp/org/org-macs.el (org-split-string): Escape control chars. * lisp/org/ox-latex.el (org-latex-guess-babel-language): And here. --- lisp/org/org-macs.el | 2 +- lisp/org/ox-latex.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 2332c0c927c..aafbdf0e0aa 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -982,7 +982,7 @@ Otherwise, return nil." "Splits STRING into substrings at SEPARATORS. SEPARATORS is a regular expression. When nil, it defaults to -\"[ \f\t\n\r\v]+\". +\"[ \\f\\t\\n\\r\\v]+\". Unlike `split-string', matching SEPARATORS at the beginning and end of string are ignored." diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index b409f552a2b..bca387e5935 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -1632,7 +1632,7 @@ explicitly been loaded. Then it is added to the rest of package's options. The optional argument to Babel or the mandatory argument to -`\babelprovide' command may be \"AUTO\" which is then replaced +`\\babelprovide' command may be \"AUTO\" which is then replaced with the language of the document or `org-export-default-language' unless language in question is already loaded. -- cgit v1.2.3 From b8ba3cb7f00504ec58fda867a44631cc14b3343d Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 29 Feb 2024 11:04:07 +0100 Subject: * Improve 'native-comp-async-report-warnings-errors' tag * lisp/emacs-lisp/comp-run.el (native-comp-async-report-warnings-errors): Improve tag. --- lisp/emacs-lisp/comp-run.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index 8fcbe31cf0b..c78b5ece9bd 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -72,9 +72,9 @@ Set this variable to nil to suppress warnings altogether, or to the symbol `silent' to log warnings but not pop up the *Warnings* buffer." :type '(choice - (const :tag "Do not report warnings" nil) - (const :tag "Report and display warnings" t) - (const :tag "Report but do not display warnings" silent)) + (const :tag "Do not report warnings/errors" nil) + (const :tag "Report and display warnings/errors" t) + (const :tag "Report but do not display warnings/errors" silent)) :version "28.1") (defcustom native-comp-always-compile nil -- cgit v1.2.3 From 8e5baaddec2d6a7f48ca0a08e0a95a51c6cbb151 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 29 Feb 2024 11:25:00 +0100 Subject: * Add 'native-comp-async-report-warnings-errors-kind' * lisp/emacs-lisp/comp-run.el (native-comp-async-report-warnings-errors-kind): Add new customize. --- lisp/emacs-lisp/comp-run.el | 27 ++++++++++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index c78b5ece9bd..eec50c39c68 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -77,6 +77,19 @@ buffer." (const :tag "Report but do not display warnings/errors" silent)) :version "28.1") +(defcustom native-comp-async-report-warnings-errors-kind 'importants + "Select which kind of warnings and errors to report. + +Set this variable to `importants' to have only important warnings and +all errors to be reported. + +Set this variable to `all' to have all warnings and errors to be +reported." + :type '(choice + (const :tag "Report all warnings/errors" all) + (const :tag "Report only important warnings and errors" importants)) + :version "30.1") + (defcustom native-comp-always-compile nil "Non-nil means unconditionally (re-)compile all files." :type 'boolean @@ -184,13 +197,21 @@ processes from `comp-async-compilations'" (let ((warning-suppress-types (if (eq native-comp-async-report-warnings-errors 'silent) (cons '(comp) warning-suppress-types) - warning-suppress-types))) + warning-suppress-types)) + (regexp (if (eq native-comp-async-report-warnings-errors-kind 'all) + "^.*?\\(?:Error\\|Warning\\): .*$" + (rx bol + (*? nonl) + (or + (seq "Error: " (*? nonl)) + (seq "Warning: the function ‘" (1+ (not "’")) + "’ is not known to be defined.")) + eol)))) (with-current-buffer (process-buffer process) (save-excursion (accept-process-output process) (goto-char (or comp-last-scanned-async-output (point-min))) - (while (re-search-forward "^.*?\\(?:Error\\|Warning\\): .*$" - nil t) + (while (re-search-forward regexp nil t) (display-warning 'comp (match-string 0))) (setq comp-last-scanned-async-output (point-max))))) (accept-process-output process))) -- cgit v1.2.3 From 39239982403f01a37d42d1cd8db0b2ed0b48b50c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 29 Feb 2024 15:37:19 +0200 Subject: Improve documentation of recent changes in comp-run.el * lisp/emacs-lisp/comp-run.el (native-comp-async-warnings-errors-kind): Rename from 'native-comp-async-report-warnings-errors-kind', and rename 'importants' to 'important'; all users changed. Doc fix. * etc/NEWS: Announce the new option. --- etc/NEWS | 6 ++++++ lisp/emacs-lisp/comp-run.el | 17 ++++++++--------- 2 files changed, 14 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index b4a1c887f2e..b1e3130ab79 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1960,6 +1960,12 @@ The warning name is 'docstrings-control-chars'. *** The warning about wide docstrings can now be disabled separately. Its warning name is 'docstrings-wide'. +--- +** New user option 'native-comp-async-warnings-errors-kind'. +It allows control of what kinds of warnings and errors from asynchronous +native compilation are reported to the parent Emacs process. The +default is to report all errors and only important warnings. + +++ ** New function declaration and property 'important-return-value'. The declaration '(important-return-value t)' sets the diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index eec50c39c68..057760322ab 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -77,17 +77,16 @@ buffer." (const :tag "Report but do not display warnings/errors" silent)) :version "28.1") -(defcustom native-comp-async-report-warnings-errors-kind 'importants - "Select which kind of warnings and errors to report. +(defcustom native-comp-async-warnings-errors-kind 'important + "Which kind of warnings and errors to report from async native compilation. -Set this variable to `importants' to have only important warnings and -all errors to be reported. - -Set this variable to `all' to have all warnings and errors to be -reported." +Setting this variable to `important' (the default) will report +only important warnings and all errors. +Setting this variable to `all' will report all warnings and +errors." :type '(choice (const :tag "Report all warnings/errors" all) - (const :tag "Report only important warnings and errors" importants)) + (const :tag "Report important warnings and all errors" important)) :version "30.1") (defcustom native-comp-always-compile nil @@ -198,7 +197,7 @@ processes from `comp-async-compilations'" (if (eq native-comp-async-report-warnings-errors 'silent) (cons '(comp) warning-suppress-types) warning-suppress-types)) - (regexp (if (eq native-comp-async-report-warnings-errors-kind 'all) + (regexp (if (eq native-comp-async-warnings-errors-kind 'all) "^.*?\\(?:Error\\|Warning\\): .*$" (rx bol (*? nonl) -- cgit v1.2.3 From 093c2e1ab9db5e0309bf9bbb5deb9a7dcbad6267 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Thu, 29 Feb 2024 16:21:05 +0100 Subject: ; Fix some wording in recent obarray changes. --- doc/lispref/symbols.texi | 2 +- lisp/obarray.el | 9 +++++---- 2 files changed, 6 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 5207ea4ea7b..6f9b1ef0ec7 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -231,7 +231,7 @@ Emacs Lisp provides a different namespacing system called This function creates and returns a new obarray. The optional @var{size} may be used to specify the number of symbols that it is expected to hold, but since obarrays grow automatically -as needed, this rarely provide any benefit. +as needed, this rarely provides any benefit. @end defun @defun obarrayp object diff --git a/lisp/obarray.el b/lisp/obarray.el index e6e51c1382a..5e646db9ab7 100644 --- a/lisp/obarray.el +++ b/lisp/obarray.el @@ -29,10 +29,11 @@ (defconst obarray-default-size 4) (make-obsolete-variable 'obarray-default-size - "obarrays now grow automatically" "30.1") + "obarrays now grow automatically." "30.1") -(defun obarray-size (_ob) obarray-default-size) -(make-obsolete 'obarray-size "obarrays now grow automatically" "30.1") +(defun obarray-size (_ob) + (declare (obsolete "obarrays now grow automatically." "30.1")) + obarray-default-size) ;; Don’t use obarray as a variable name to avoid shadowing. (defun obarray-get (ob name) @@ -42,7 +43,7 @@ Return nil otherwise." (defun obarray-put (ob name) "Return symbol named NAME from obarray OB. -Creates and adds the symbol if doesn't exist." +Creates and adds the symbol if it doesn't exist." (intern name ob)) (defun obarray-remove (ob name) -- cgit v1.2.3 From 8305d0e0c909a5dd91a21cc1daea6298aae9eda7 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 29 Feb 2024 19:50:04 +0200 Subject: Add tabulated-list-groups and Buffer-menu-group-by (bug#69305) * doc/lispref/modes.texi (Tabulated List Mode): Add defvar tabulated-list-groups. * lisp/buff-menu.el (Buffer-menu-group-by): New defcustom. (Buffer-menu-unmark-all-buffers): Use tabulated-list-get-entry to check whether the current line contains an entry. (list-buffers-noselect): Enable outline-minor-mode for tabulated-list-groups. (list-buffers--refresh): When Buffer-menu-group-by is non-nil, set tabulated-list-groups. (Buffer-menu-group-by-mode, Buffer-menu-group-by-root): New functions. * lisp/emacs-lisp/tabulated-list.el (tabulated-list-groups): New buffer-local variable. (tabulated-list-print-fake-header): Add distinct overlay property 'fake-header'. (tabulated-list-header-overlay-p): Filter out overlays that don't have the property 'fake-header'. (tabulated-list-print): Use the variable 'tabulated-list-groups' to sort entries in groups separately. (tabulated-list-print-entries): New function factored out from 'tabulated-list-print'. * test/lisp/emacs-lisp/tabulated-list-tests.el (tabulated-list-groups): New test. --- doc/lispref/modes.texi | 35 ++++++++++++++ etc/NEWS | 9 ++++ lisp/buff-menu.el | 54 ++++++++++++++++++---- lisp/emacs-lisp/tabulated-list.el | 68 ++++++++++++++++++++++------ test/lisp/emacs-lisp/tabulated-list-tests.el | 41 +++++++++++++++++ 5 files changed, 185 insertions(+), 22 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 630e42e6878..7a4a722d595 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1246,6 +1246,41 @@ Otherwise, the value should be a function which returns a list of the above form when called with no arguments. @end defvar +@defvar tabulated-list-groups +This buffer-local variable specifies the groups of entries displayed in +the Tabulated List buffer. Its value should be either a list, or a +function. + +If the value is a list, each list element corresponds to one group, and +should have the form @w{@code{(@var{group-name} @var{entries})}}, where +@var{group-name} is a string inserted before all group entries, and +@var{entries} have the same format as @code{tabulated-list-entries} +(see above). + +Otherwise, the value should be a function which returns a list of the +above form when called with no arguments. + +You can use @code{seq-group-by} to create @code{tabulated-list-groups} +from @code{tabulated-list-entries}. For example: + +@smallexample +@group + (setq tabulated-list-groups + (seq-group-by 'Buffer-menu-group-by-mode + tabulated-list-entries)) +@end group +@end smallexample + +where you can define @code{Buffer-menu-group-by-mode} like this: + +@smallexample +@group +(defun Buffer-menu-group-by-mode (entry) + (concat "* " (aref (cadr entry) 5))) +@end group +@end smallexample +@end defvar + @defvar tabulated-list-revert-hook This normal hook is run prior to reverting a Tabulated List buffer. A derived mode can add a function to this hook to recompute diff --git a/etc/NEWS b/etc/NEWS index 198563e0fc0..72757622958 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1356,6 +1356,11 @@ will return the URL for that bug. This allows for rcirc logs to use a custom timestamp format, than the chat buffers use by default. +--- +*** New user option 'Buffer-menu-group-by'. +It splits buffers by groups that are displayed with headings +in Outline minor mode. + --- *** New command 'Buffer-menu-toggle-internal'. This command toggles the display of internal buffers in Buffer Menu mode; @@ -2070,6 +2075,10 @@ inside 'treesit-language-source-alist', so that calling It may be useful, for example, for the purposes of bisecting a treesitter grammar. ++++ +** New buffer-local variable 'tabulated-list-groups'. +It prints and sorts the groups of entries separately. + * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index e13c3b56b4e..1d52feb5733 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -95,6 +95,25 @@ as it is by default." :group 'Buffer-menu :version "22.1") +(defcustom Buffer-menu-group-by nil + "If non-nil, buffers are grouped by function. +This function takes one argument: a list of entries in the same format +as in `tabulated-list-entries', and should return a list in the format +suitable for `tabulated-list-groups'. Also when this variable is non-nil, +then `outline-minor-mode' is enabled in the Buffer Menu. Then with the +default value of `outline-regexp' you can use Outline minor mode commands +to show/hide groups of buffers. +The default options can group by a mode, and by a root directory of +a project or just `default-directory'." + :type '(choice (const :tag "No grouping" nil) + (function-item :tag "Group by mode" + Buffer-menu-group-by-mode) + (function-item :tag "Group by project root or directory" + Buffer-menu-group-by-root) + (function :tag "Custom function")) + :group 'Buffer-menu + :version "30.1") + (defvar-local Buffer-menu-files-only nil "Non-nil if the current Buffer Menu lists only file buffers. This is set by the prefix argument to `buffer-menu' and related @@ -408,14 +427,12 @@ When called interactively prompt for MARK; RET remove all marks." (interactive "cRemove marks (RET means all):" Buffer-menu-mode) (save-excursion (goto-char (point-min)) - (when (tabulated-list-header-overlay-p) - (forward-line)) (while (not (eobp)) - (let ((xmarks (list (aref (tabulated-list-get-entry) 0) - (aref (tabulated-list-get-entry) 2)))) - (when (or (char-equal mark ?\r) - (member (char-to-string mark) xmarks)) - (Buffer-menu--unmark))) + (when-let ((entry (tabulated-list-get-entry))) + (let ((xmarks (list (aref entry 0) (aref entry 2)))) + (when (or (char-equal mark ?\r) + (member (char-to-string mark) xmarks)) + (Buffer-menu--unmark)))) (forward-line)))) (defun Buffer-menu-unmark-all () @@ -674,7 +691,12 @@ See more at `Buffer-menu-filter-predicate'." (setq Buffer-menu-buffer-list buffer-list) (setq Buffer-menu-filter-predicate filter-predicate) (list-buffers--refresh buffer-list old-buffer) - (tabulated-list-print)) + (tabulated-list-print) + (when tabulated-list-groups + (setq-local outline-minor-mode-cycle t + outline-minor-mode-highlight t + outline-minor-mode-use-buttons 'in-margins) + (outline-minor-mode 1))) buffer)) (defun Buffer-menu-mouse-select (event) @@ -750,7 +772,11 @@ See more at `Buffer-menu-filter-predicate'." `("Mode" ,Buffer-menu-mode-width t) '("File" 1 t))) (setq tabulated-list-use-header-line Buffer-menu-use-header-line) - (setq tabulated-list-entries (nreverse entries))) + (setq tabulated-list-entries (nreverse entries)) + (when Buffer-menu-group-by + (setq tabulated-list-groups + (seq-group-by Buffer-menu-group-by + tabulated-list-entries)))) (tabulated-list-init-header)) (defun tabulated-list-entry-size-> (entry1 entry2) @@ -769,4 +795,14 @@ See more at `Buffer-menu-filter-predicate'." (abbreviate-file-name list-buffers-directory)) (t ""))) +(defun Buffer-menu-group-by-mode (entry) + (concat "* " (aref (cadr entry) 5))) + +(declare-function project-root "project" (project)) +(defun Buffer-menu-group-by-root (entry) + (concat "* " (with-current-buffer (car entry) + (if-let ((project (project-current))) + (project-root project) + default-directory)))) + ;;; buff-menu.el ends here diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 9884a2fc24b..c86e3f9c5df 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -139,6 +139,21 @@ If `tabulated-list-entries' is a function, it is called with no arguments and must return a list of the above form.") (put 'tabulated-list-entries 'permanent-local t) +(defvar-local tabulated-list-groups nil + "Groups displayed in the current Tabulated List buffer. +This should be either a function, or a list. +If a list, each element has the form (GROUP-NAME ENTRIES), +where: + + - GROUP-NAME is a group name as a string, which is displayed + at the top line of each group. + + - ENTRIES is a list described in `tabulated-list-entries'. + +If `tabulated-list-groups' is a function, it is called with no +arguments and must return a list of the above form.") +(put 'tabulated-list-groups 'permanent-local t) + (defvar-local tabulated-list-padding 0 "Number of characters preceding each Tabulated List mode entry. By default, lines are padded with spaces, but you can use the @@ -362,15 +377,17 @@ Do nothing if `tabulated-list--header-string' is nil." (if tabulated-list--header-overlay (move-overlay tabulated-list--header-overlay (point-min) (point)) (setq-local tabulated-list--header-overlay - (make-overlay (point-min) (point)))) - (overlay-put tabulated-list--header-overlay - 'face 'tabulated-list-fake-header)))) + (make-overlay (point-min) (point))) + (overlay-put tabulated-list--header-overlay 'fake-header t) + (overlay-put tabulated-list--header-overlay + 'face 'tabulated-list-fake-header))))) (defsubst tabulated-list-header-overlay-p (&optional pos) "Return non-nil if there is a fake header. Optional arg POS is a buffer position where to look for a fake header; defaults to `point-min'." - (overlays-at (or pos (point-min)))) + (seq-find (lambda (o) (overlay-get o 'fake-header)) + (overlays-at (or pos (point-min))))) (defun tabulated-list-revert (&rest _ignored) "The `revert-buffer-function' for `tabulated-list-mode'. @@ -427,6 +444,9 @@ This sorts the `tabulated-list-entries' list if sorting is specified by `tabulated-list-sort-key'. It then erases the buffer and inserts the entries with `tabulated-list-printer'. +If `tabulated-list-groups' is non-nil, each group of entries +is printed and sorted separately. + Optional argument REMEMBER-POS, if non-nil, means to move point to the entry with the same ID element as the current line. @@ -437,6 +457,9 @@ be removed from entries that haven't changed (see `tabulated-list-put-tag'). Don't use this immediately after changing `tabulated-list-sort-key'." (let ((inhibit-read-only t) + (groups (if (functionp tabulated-list-groups) + (funcall tabulated-list-groups) + tabulated-list-groups)) (entries (if (functionp tabulated-list-entries) (funcall tabulated-list-entries) tabulated-list-entries)) @@ -447,7 +470,14 @@ changing `tabulated-list-sort-key'." (setq saved-col (current-column))) ;; Sort the entries, if necessary. (when sorter - (setq entries (sort entries sorter))) + (if groups + (setq groups + (mapcar (lambda (group) + (cons (car group) (sort (cdr group) sorter))) + groups)) + (setq entries (sort entries sorter)))) + (unless (functionp tabulated-list-groups) + (setq tabulated-list-groups groups)) (unless (functionp tabulated-list-entries) (setq tabulated-list-entries entries)) ;; Without a sorter, we have no way to just update. @@ -459,6 +489,25 @@ changing `tabulated-list-sort-key'." (unless tabulated-list-use-header-line (tabulated-list-print-fake-header))) ;; Finally, print the resulting list. + (if groups + (dolist (group groups) + (insert (car group) ?\n) + (when-let ((saved-pt-new (tabulated-list-print-entries + (cdr group) sorter update entry-id))) + (setq saved-pt saved-pt-new))) + (setq saved-pt (tabulated-list-print-entries + entries sorter update entry-id))) + (when update + (delete-region (point) (point-max))) + (set-buffer-modified-p nil) + ;; If REMEMBER-POS was specified, move to the "old" location. + (if saved-pt + (progn (goto-char saved-pt) + (move-to-column saved-col)) + (goto-char (point-min))))) + +(defun tabulated-list-print-entries (entries sorter update entry-id) + (let (saved-pt) (while entries (let* ((elt (car entries)) (tabulated-list--near-rows @@ -495,14 +544,7 @@ changing `tabulated-list-sort-key'." (forward-line 1) (delete-region old (point)))))) (setq entries (cdr entries))) - (when update - (delete-region (point) (point-max))) - (set-buffer-modified-p nil) - ;; If REMEMBER-POS was specified, move to the "old" location. - (if saved-pt - (progn (goto-char saved-pt) - (move-to-column saved-col)) - (goto-char (point-min))))) + saved-pt)) (defun tabulated-list-print-entry (id cols) "Insert a Tabulated List entry at point. diff --git a/test/lisp/emacs-lisp/tabulated-list-tests.el b/test/lisp/emacs-lisp/tabulated-list-tests.el index 8be2be3139e..e53268b3f14 100644 --- a/test/lisp/emacs-lisp/tabulated-list-tests.el +++ b/test/lisp/emacs-lisp/tabulated-list-tests.el @@ -130,4 +130,45 @@ (should-error (tabulated-list-sort) :type 'user-error) (should-error (tabulated-list-sort 4) :type 'user-error))) +(ert-deftest tabulated-list-groups () + (with-temp-buffer + (tabulated-list-mode) + (setq tabulated-list-groups + (reverse + (seq-group-by (lambda (b) (concat "* " (aref (cadr b) 3))) + tabulated-list--test-entries))) + (setq tabulated-list-format tabulated-list--test-format) + (setq tabulated-list-padding 7) + (tabulated-list-init-header) + (tabulated-list-print) + ;; Basic printing. + (should (string-equal + (buffer-substring-no-properties (point-min) (point-max)) + "\ +* installed + zzzz-game zzzz-game 2113 installed play zzzz in Emacs + mode mode 1128 installed A simple mode for editing Actionscript 3 files +* available + abc-mode abc-mode 944 available Major mode for editing abc music files +* obsolete + 4clojure 4clojure 1507 obsolete Open and evaluate 4clojure.com questions +")) + ;; Sort and preserve position. + (forward-line 2) + (let ((pos (thing-at-point 'line))) + (tabulated-list-next-column 2) + (tabulated-list-sort) + (should (equal (thing-at-point 'line) pos)) + (should (string-equal + (buffer-substring-no-properties (point-min) (point-max)) + "\ +* installed + mode mode 1128 installed A simple mode for editing Actionscript 3 files + zzzz-game zzzz-game 2113 installed play zzzz in Emacs +* available + abc-mode abc-mode 944 available Major mode for editing abc music files +* obsolete + 4clojure 4clojure 1507 obsolete Open and evaluate 4clojure.com questions +"))))) + ;;; tabulated-list-tests.el ends here -- cgit v1.2.3 From 4dd4f145b8528d5a742af4268073c24d629801d8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 29 Feb 2024 20:57:12 +0200 Subject: ; Improve documentation of last changeset (bug#69305) * etc/NEWS (Example): * doc/lispref/modes.texi (Tabulated List Mode): Improve documentation of 'Buffer-menu-group-by' and 'tabulated-list-groups'. * lisp/buff-menu.el (Buffer-menu-group-by): Doc fix. --- doc/lispref/modes.texi | 3 ++- etc/NEWS | 6 +++--- lisp/buff-menu.el | 17 +++++++++-------- 3 files changed, 14 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 7a4a722d595..8bdf596bf9e 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1248,7 +1248,7 @@ above form when called with no arguments. @defvar tabulated-list-groups This buffer-local variable specifies the groups of entries displayed in -the Tabulated List buffer. Its value should be either a list, or a +the Tabulated List buffer. Its value should be either a list or a function. If the value is a list, each list element corresponds to one group, and @@ -1271,6 +1271,7 @@ from @code{tabulated-list-entries}. For example: @end group @end smallexample +@noindent where you can define @code{Buffer-menu-group-by-mode} like this: @smallexample diff --git a/etc/NEWS b/etc/NEWS index 72757622958..df07b2a9d79 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1358,8 +1358,8 @@ chat buffers use by default. --- *** New user option 'Buffer-menu-group-by'. -It splits buffers by groups that are displayed with headings -in Outline minor mode. +It controls how buffers are divided into groups that are displayed with +headings using Outline minor mode. --- *** New command 'Buffer-menu-toggle-internal'. @@ -2077,7 +2077,7 @@ treesitter grammar. +++ ** New buffer-local variable 'tabulated-list-groups'. -It prints and sorts the groups of entries separately. +It controls display and separate sorting of groups of entries. * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 1d52feb5733..ca417290018 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -96,15 +96,16 @@ as it is by default." :version "22.1") (defcustom Buffer-menu-group-by nil - "If non-nil, buffers are grouped by function. -This function takes one argument: a list of entries in the same format -as in `tabulated-list-entries', and should return a list in the format -suitable for `tabulated-list-groups'. Also when this variable is non-nil, -then `outline-minor-mode' is enabled in the Buffer Menu. Then with the -default value of `outline-regexp' you can use Outline minor mode commands -to show/hide groups of buffers. + "If non-nil, a function to call to divide buffer-menu buffers into groups. +This function is called with one argument: a list of entries in the same +format as in `tabulated-list-entries', and should return a list in the +format suitable for `tabulated-list-groups'. Also, when this variable +is non-nil, `outline-minor-mode' is enabled in the Buffer Menu and you +can use Outline minor mode commands to show/hide groups of buffers, +according to the value of `outline-regexp'. The default options can group by a mode, and by a root directory of -a project or just `default-directory'." +a project or just `default-directory'. +If this is nil, buffers are not divided into groups." :type '(choice (const :tag "No grouping" nil) (function-item :tag "Group by mode" Buffer-menu-group-by-mode) -- cgit v1.2.3 From 2549eabc97f191ecea65d88d59cf21e5e0c81be8 Mon Sep 17 00:00:00 2001 From: Dan Jacobson Date: Fri, 1 Mar 2024 12:44:44 +0800 Subject: Fix typos in vnvni.el. * lisp/leim/quail/vnvni.el ("vietnamese-vni"): Fix typos. (Bug#69485) Copyright-paperwork-exempt: yes --- lisp/leim/quail/vnvni.el | 54 ++++++++++++++++++++++++------------------------ 1 file changed, 27 insertions(+), 27 deletions(-) (limited to 'lisp') diff --git a/lisp/leim/quail/vnvni.el b/lisp/leim/quail/vnvni.el index 59d1a82eb21..ae5941cbfc7 100644 --- a/lisp/leim/quail/vnvni.el +++ b/lisp/leim/quail/vnvni.el @@ -125,8 +125,8 @@ and postfix: E66 -> E6, a55 -> a5, etc. ("A61" ?Ấ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND ACUTE ("a62" ?ầ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE ("A62" ?Ầ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND GRAVE - ("a63" ?ẩ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND HO6K ABOVE - ("A63" ?Ẩ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HO6K ABOVE + ("a63" ?ẩ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE + ("A63" ?Ẩ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE ("a64" ?ẫ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE ("A64" ?Ẫ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND TILDE ("a65" ?ậ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW @@ -135,42 +135,42 @@ and postfix: E66 -> E6, a55 -> a5, etc. ("A81" ?Ắ) ; LATIN CAPITAL LETTER A WITH BREVE AND ACUTE ("a82" ?ằ) ; LATIN SMALL LETTER A WITH BREVE AND GRAVE ("A82" ?Ằ) ; LATIN CAPITAL LETTER A WITH BREVE AND GRAVE - ("a83" ?ẳ) ; LATIN SMALL LETTER A WITH BREVE AND HO6K ABOVE - ("A83" ?Ẳ) ; LATIN CAPITAL LETTER A WITH BREVE AND HO6K ABOVE + ("a83" ?ẳ) ; LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE + ("A83" ?Ẳ) ; LATIN CAPITAL LETTER A WITH BREVE AND HOOK ABOVE ("a84" ?ẵ) ; LATIN SMALL LETTER A WITH BREVE AND TILDE ("A84" ?Ẵ) ; LATIN CAPITAL LETTER A WITH BREVE AND TILDE ("a85" ?ặ) ; LATIN SMALL LETTER A WITH BREVE AND DOT BELOW ("A85" ?Ặ) ; LATIN CAPITAL LETTER A WITH BREVE AND DOT BELOW ("e5" ?ẹ) ; LATIN SMALL LETTER E WITH DOT BELOW ("E5" ?Ẹ) ; LATIN CAPITAL LETTER E WITH DOT BELOW - ("e3" ?ẻ) ; LATIN SMALL LETTER E WITH HO6K ABOVE - ("E3" ?Ẻ) ; LATIN CAPITAL LETTER E WITH HO6K ABOVE + ("e3" ?ẻ) ; LATIN SMALL LETTER E WITH HOOK ABOVE + ("E3" ?Ẻ) ; LATIN CAPITAL LETTER E WITH HOOK ABOVE ("e4" ?ẽ) ; LATIN SMALL LETTER E WITH TILDE ("E4" ?Ẽ) ; LATIN CAPITAL LETTER E WITH TILDE ("e61" ?ế) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE ("E61" ?Ế) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND ACUTE ("e62" ?ề) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE ("E62" ?Ề) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND GRAVE - ("e63" ?ể) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND HO6K ABOVE - ("E63" ?Ể) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HO6K ABOVE + ("e63" ?ể) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE + ("E63" ?Ể) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE ("e64" ?ễ) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE ("E64" ?Ễ) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND TILDE ("e65" ?ệ) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW ("E65" ?Ệ) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND DOT BELOW - ("i3" ?ỉ) ; LATIN SMALL LETTER I WITH HO6K ABOVE - ("I3" ?Ỉ) ; LATIN CAPITAL LETTER I WITH HO6K ABOVE + ("i3" ?ỉ) ; LATIN SMALL LETTER I WITH HOOK ABOVE + ("I3" ?Ỉ) ; LATIN CAPITAL LETTER I WITH HOOK ABOVE ("i5" ?ị) ; LATIN SMALL LETTER I WITH DOT BELOW ("I5" ?Ị) ; LATIN CAPITAL LETTER I WITH DOT BELOW ("o5" ?ọ) ; LATIN SMALL LETTER O WITH DOT BELOW ("O5" ?Ọ) ; LATIN CAPITAL LETTER O WITH DOT BELOW - ("o3" ?ỏ) ; LATIN SMALL LETTER O WITH HO6K ABOVE - ("O3" ?Ỏ) ; LATIN CAPITAL LETTER O WITH HO6K ABOVE + ("o3" ?ỏ) ; LATIN SMALL LETTER O WITH HOOK ABOVE + ("O3" ?Ỏ) ; LATIN CAPITAL LETTER O WITH HOOK ABOVE ("o61" ?ố) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE ("O61" ?Ố) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND ACUTE ("o62" ?ồ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE ("O62" ?Ồ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND GRAVE - ("o63" ?ổ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND HO6K ABOVE - ("O63" ?Ổ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HO6K ABOVE + ("o63" ?ổ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE + ("O63" ?Ổ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE ("o64" ?ỗ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE ("O64" ?Ỗ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND TILDE ("o65" ?ộ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELO7 @@ -179,22 +179,22 @@ and postfix: E66 -> E6, a55 -> a5, etc. ("O71" ?Ớ) ; LATIN CAPITAL LETTER O WITH HORN AND ACUTE ("o72" ?ờ) ; LATIN SMALL LETTER O WITH HORN AND GRAVE ("O72" ?Ờ) ; LATIN CAPITAL LETTER O WITH HORN AND GRAVE - ("o73" ?ở) ; LATIN SMALL LETTER O WITH HORN AND HO6K ABOVE - ("O73" ?Ở) ; LATIN CAPITAL LETTER O WITH HORN AND HO6K ABOVE + ("o73" ?ở) ; LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE + ("O73" ?Ở) ; LATIN CAPITAL LETTER O WITH HORN AND HOOK ABOVE ("o74" ?ỡ) ; LATIN SMALL LETTER O WITH HORN AND TILDE ("O74" ?Ỡ) ; LATIN CAPITAL LETTER O WITH HORN AND TILDE ("o75" ?ợ) ; LATIN SMALL LETTER O WITH HORN AND DOT BELO7 ("O75" ?Ợ) ; LATIN CAPITAL LETTER O WITH HORN AND DOT BELO7 ("u5" ?ụ) ; LATIN SMALL LETTER U WITH DOT BELO7 ("U5" ?Ụ) ; LATIN CAPITAL LETTER U WITH DOT BELO7 - ("u3" ?ủ) ; LATIN SMALL LETTER U WITH HO6K ABOVE - ("U3" ?Ủ) ; LATIN CAPITAL LETTER U WITH HO6K ABOVE + ("u3" ?ủ) ; LATIN SMALL LETTER U WITH HOOK ABOVE + ("U3" ?Ủ) ; LATIN CAPITAL LETTER U WITH HOOK ABOVE ("u71" ?ứ) ; LATIN SMALL LETTER U WITH HORN AND ACUTE ("U71" ?Ứ) ; LATIN CAPITAL LETTER U WITH HORN AND ACUTE ("u72" ?ừ) ; LATIN SMALL LETTER U WITH HORN AND GRAVE ("U72" ?Ừ) ; LATIN CAPITAL LETTER U WITH HORN AND GRAVE - ("u73" ?ử) ; LATIN SMALL LETTER U WITH HORN AND HO6K ABOVE - ("U73" ?Ử) ; LATIN CAPITAL LETTER U WITH HORN AND HO6K ABOVE + ("u73" ?ử) ; LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE + ("U73" ?Ử) ; LATIN CAPITAL LETTER U WITH HORN AND HOOK ABOVE ("u74" ?ữ) ; LATIN SMALL LETTER U WITH HORN AND TILDE ("U74" ?Ữ) ; LATIN CAPITAL LETTER U WITH HORN AND TILDE ("u75" ?ự) ; LATIN SMALL LETTER U WITH HORN AND DOT BELO7 @@ -203,20 +203,20 @@ and postfix: E66 -> E6, a55 -> a5, etc. ("Y2" ?Ỳ) ; LATIN CAPITAL LETTER Y WITH GRAVE ("y5" ?ỵ) ; LATIN SMALL LETTER Y WITH DOT BELO7 ("Y5" ?Ỵ) ; LATIN CAPITAL LETTER Y WITH DOT BELO7 - ("y3" ?ỷ) ; LATIN SMALL LETTER Y WITH HO6K ABOVE - ("Y3" ?Ỷ) ; LATIN CAPITAL LETTER Y WITH HO6K ABOVE + ("y3" ?ỷ) ; LATIN SMALL LETTER Y WITH HOOK ABOVE + ("Y3" ?Ỷ) ; LATIN CAPITAL LETTER Y WITH HOOK ABOVE ("y4" ?ỹ) ; LATIN SMALL LETTER Y WITH TILDE ("Y4" ?Ỹ) ; LATIN CAPITAL LETTER Y WITH TILDE ("d9" ?đ) ; LATIN SMALL LETTER D WITH STROKE ("D9" ?Đ) ; LATIN CAPITAL LETTER D WITH STROKE ;("$$" ?₫) ; U+20AB DONG SIGN (#### check) - ("a22" ["a22"]) + ("a22" ["a2"]) ("A22" ["A2"]) ("a11" ["a1"]) ("A11" ["A1"]) - ("a66"' ["a6"]) - ("A66"' ["A6"]) + ("a66" ["a6"]) + ("A66" ["A6"]) ("a44" ["a4"]) ("A44" ["A4"]) ("e22" ["e2"]) @@ -248,7 +248,7 @@ and postfix: E66 -> E6, a55 -> a5, etc. ("i44" ["i4"]) ("I44" ["I4"]) ("u44" ["u4"]) - ("U44" ["u4"]) + ("U44" ["U4"]) ("o77" ["o7"]) ("O77" ["O7"]) ("u77" ["u7"]) @@ -283,7 +283,7 @@ and postfix: E66 -> E6, a55 -> a5, etc. ("Y33" ["Y3"]) ("y44" ["y4"]) ("Y44" ["Y4"]) - ("d9" ["d9"]) + ("d99" ["d9"]) ("D99" ["D9"]) ;("$$$" ["$$"]) -- cgit v1.2.3 From 0567f3b817ba25c8e216347cc7118fa7786039d9 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 1 Mar 2024 09:16:38 +0100 Subject: * Fix compilation warning in 'cl--supertypes-for-typeof-types' * lisp/emacs-lisp/cl-preloaded.el (cl--supertypes-for-typeof-types): Fix warning. --- lisp/emacs-lisp/cl-preloaded.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index fb06b127676..30753bcd5c5 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -99,8 +99,7 @@ the symbols returned by `type-of', and SUPERTYPES is the list of its supertypes from the most specific to least specific.") (defun cl--supertypes-for-typeof-types (type) - (cl-loop with res = () - with agenda = (list type) + (cl-loop with agenda = (list type) while agenda for element = (car agenda) unless (or (eq element t) ;; no t in `cl--typeof-types'. -- cgit v1.2.3 From b2d18ff944ae374fa03579ca2574f1fba8ae2e4b Mon Sep 17 00:00:00 2001 From: Wilson Snyder Date: Fri, 1 Mar 2024 12:11:07 -0500 Subject: Verilog-mode update from upstream https://github.com/veripool/verilog-mode MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/progmodes/verilog-mode.el (verilog-auto-inst) (verilog-auto-inst-param): Remove intended formfeeds. Our ability to detect unintended formfeeds elsewhere outweighs their limited utility here. Contributed by Mattias Engdegård. (verilog-at-constraint-p) (verilog-at-struct-mv-p, verilog-at-struct-p, verilog-calc-1) (verilog-in-case-region-p, verilog-in-fork-region-p) (verilog-in-generate-region-p, verilog-set-auto-endcomments): Fix indentation problem when there is a signal named "module_something" (#1861). Cleanup RexEx groupings. (verilog-read-sub-decls-expr): Fix apostrophe parser in AUTOWIRE (#1854) (#1855). (verilog-auto-inst-port): Fix AUTOINST multi-dimensional array [] substitution. Reported by Caleb Begly. (verilog-property-re, verilog-beg-of-statement, verilog-calc-1): Concurrent SVA statement pattern-matching learns 'restrict property' and 'cover sequence' expression for proper indentation around those constructs. This addresses more patterns in IEEE 1800-2017's 'concurrent_sasertion_statement' grammar. (verilog-read-sub-decls-line): Fix `verilog-auto-ignore-concat' with parenthesis signals. Reported by Dmitri Sorkin. (verilog-simplify-range-expression): Fix `verilog-auto-inst-param-value' confusing structure selects. Reported by Mike Bertone. --- lisp/progmodes/verilog-mode.el | 114 +++++++++++++++++++++++++---------------- 1 file changed, 69 insertions(+), 45 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 6081372af33..7af78f2229a 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -9,7 +9,7 @@ ;; Keywords: languages ;; The "Version" is the date followed by the decimal rendition of the Git ;; commit hex. -;; Version: 2023.06.06.141322628 +;; Version: 2024.03.01.121933719 ;; Yoni Rabkin contacted the maintainer of this ;; file on 19/3/2008, and the maintainer agreed that when a bug is @@ -124,7 +124,7 @@ ;; ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2023-06-06-86c6984-vpo-GNU" +(defconst verilog-mode-version "2024-03-01-7448f97-vpo-GNU" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -2556,11 +2556,13 @@ find the errors." (defconst verilog-assignment-operation-re-2 (concat "\\(.*?\\)" verilog-assignment-operator-re)) +;; Loosely related to IEEE 1800's concurrent_assertion_statement +(defconst verilog-concurrent-assertion-statement-re + "\\(\\<\\(assert\\|assume\\|cover\\|restrict\\)\\>\\s-+\\<\\(property\\|sequence\\)\\>\\)\\|\\(\\\\)") + (defconst verilog-label-re (concat verilog-identifier-sym-re "\\s-*:\\s-*")) (defconst verilog-property-re - (concat "\\(" verilog-label-re "\\)?" - ;; "\\(assert\\|assume\\|cover\\)\\s-+property\\>" - "\\(\\(assert\\|assume\\|cover\\)\\>\\s-+\\\\)\\|\\(assert\\)")) + (concat "\\(" verilog-label-re "\\)?" verilog-concurrent-assertion-statement-re)) (defconst verilog-no-indent-begin-re (eval-when-compile @@ -2715,7 +2717,6 @@ find the errors." "\\(\\\\)\\|" ; 7 "\\(\\\\)\\|" verilog-property-re "\\|" - "\\(\\(" verilog-label-re "\\)?\\\\)\\|" "\\(\\\\)\\|" "\\(\\\\)\\|" "\\(\\\\)\\|" @@ -4843,7 +4844,7 @@ Uses `verilog-scan' cache." (not (or (looking-at "\\<") (forward-word-strictly -1))) ;; stop if we see an assertion (perhaps labeled) (and - (looking-at "\\(\\w+\\W*:\\W*\\)?\\(\\<\\(assert\\|assume\\|cover\\)\\>\\s-+\\\\)\\|\\(\\\\)") + (looking-at (concat "\\(\\w+\\W*:\\W*\\)?" verilog-concurrent-assertion-statement-re)) (progn (setq h (point)) (save-excursion @@ -4970,7 +4971,7 @@ More specifically, point @ in the line foo : @ begin" (while t (verilog-re-search-backward (concat "\\(\\\\)\\|\\(\\\\)\\|\\(\\\\|\\[^:]\\)\\|" - "\\(\\\\)\\>") + "\\(\\\\)") nil 'move) (cond ((match-end 4) @@ -5010,7 +5011,7 @@ More specifically, after a generate and before an endgenerate." (while (and (/= nest 0) (verilog-re-search-backward - "\\<\\(module\\)\\|\\(connectmodule\\)\\|\\(endmodule\\)\\|\\(generate\\)\\|\\(endgenerate\\)\\|\\(if\\)\\|\\(case\\)\\|\\(for\\)\\>" nil 'move) + "\\<\\(?:\\(module\\)\\|\\(connectmodule\\)\\|\\(endmodule\\)\\|\\(generate\\)\\|\\(endgenerate\\)\\|\\(if\\)\\|\\(case\\)\\|\\(for\\)\\)\\>" nil 'move) (cond ((match-end 1) ; module - we have crawled out (throw 'done 1)) @@ -5038,7 +5039,7 @@ More specifically, after a generate and before an endgenerate." (save-excursion (while (and (/= nest 0) - (verilog-re-search-backward "\\<\\(fork\\)\\|\\(join\\(_any\\|_none\\)?\\)\\>" lim 'move) + (verilog-re-search-backward "\\<\\(?:\\(fork\\)\\|\\(join\\(_any\\|_none\\)?\\)\\)\\>" lim 'move) (cond ((match-end 1) ; fork (setq nest (1- nest))) @@ -5335,7 +5336,7 @@ primitive or interface named NAME." (match-end 3) (goto-char there) (let ((nest 0) - (reg "\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)\\|\\(assert\\)")) + (reg "\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)")) (catch 'skip (while (verilog-re-search-backward reg nil 'move) (cond @@ -6244,7 +6245,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (match-end 22)) (throw 'continue 'foo)) - ((looking-at "\\") + ((looking-at "\\<\\(?:class\\|struct\\|function\\|task\\)\\>") ;; *sigh* These words have an optional prefix: ;; extern {virtual|protected}? function a(); ;; and we don't want to confuse this with @@ -6268,12 +6269,16 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (throw 'nesting 'defun)))) ;; - ((looking-at "\\") + ((looking-at "\\<\\(property\\|sequence\\)\\>") ;; *sigh* - ;; {assert|assume|cover} property (); are complete - ;; and could also be labeled: - foo: assert property - ;; but - ;; property ID () ... needs endproperty + ;; - {assert|assume|cover|restrict} property (); are complete + ;; - cover sequence (); is complete + ;; and could also be labeled: + ;; - foo: assert property + ;; - bar: cover sequence + ;; but: + ;; - property ID () ... needs endproperty + ;; - sequence ID () ... needs endsequence (verilog-beg-of-statement) (if (looking-at verilog-property-re) (throw 'continue 'statement) ; We don't need an endproperty for these @@ -6940,7 +6945,7 @@ Also move point to constraint." (let ( (pt (point)) (pass 0)) (verilog-backward-ws&directives) (verilog-backward-token) - (if (looking-at (concat "\\\\|" verilog-in-constraint-re)) + (if (looking-at (concat "\\<\\(?:constraint\\|coverpoint\\|cross\\|with\\)\\>\\|" verilog-in-constraint-re)) (progn (setq pass 1) (if (looking-at "\\") (progn (verilog-backward-ws&directives) @@ -6981,7 +6986,7 @@ Also move point to constraint." (save-excursion (if (and (equal (char-after) ?\{) (verilog-backward-token)) - (looking-at "\\") + (looking-at "\\<\\(?:struct\\|union\\|packed\\|\\(un\\)?signed\\)\\>") nil))) (defun verilog-at-struct-mv-p () @@ -6989,7 +6994,7 @@ Also move point to constraint." (let ((pt (point))) (if (and (equal (char-after) ?\{) (verilog-backward-token)) - (if (looking-at "\\") + (if (looking-at "\\<\\(?:struct\\|union\\|packed\\|\\(un\\)?signed\\)\\>") (progn (verilog-beg-of-statement) (point)) (progn (goto-char pt) nil)) (progn (goto-char pt) nil)))) @@ -9675,7 +9680,7 @@ Return an array of [outputs inouts inputs wire reg assign const gparam intf]." (cond ;; {..., a, b} requires us to recurse on a,b ;; To support {#{},{#{a,b}} we'll just split everything on [{},] - ((string-match "^\\s-*{\\(.*\\)}\\s-*$" expr) + ((string-match "^\\s-*'?{\\(.*\\)}\\s-*$" expr) (let ((mlst (split-string (match-string 1 expr) "[{},]")) mstr) (while (setq mstr (pop mlst)) @@ -9755,7 +9760,10 @@ Inserts the list of signals found, using submodi to look up each port." ;; We intentionally ignore (non-escaped) signals with .s in them ;; this prevents AUTOWIRE etc from noticing hierarchical sigs. (when port - (cond ((looking-at "[^\n]*AUTONOHOOKUP")) + (cond ((and verilog-auto-ignore-concat + (looking-at "[({]")) + nil) ; {...} or (...) historically ignored with auto-ignore-concat + ((looking-at "[^\n]*AUTONOHOOKUP")) ((looking-at "\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\s-*)") (verilog-read-sub-decls-sig submoddecls par-values comment port @@ -11436,7 +11444,7 @@ This repairs those mis-inserted by an AUTOARG." (while (string-match (concat "\\([[({:*/<>+-]\\)" ; - must be last "(\\<\\([0-9A-Za-z_]+\\))" - "\\([])}:*/<>+-]\\)") + "\\([])}:*/<>.+-]\\)") out) (setq out (replace-match "\\1\\2\\3" nil nil out))) (while (string-match @@ -11531,7 +11539,8 @@ This repairs those mis-inserted by an AUTOARG." ;;(verilog-simplify-range-expression "[(TEST[1])-1:0]") ;;(verilog-simplify-range-expression "[1<<2:8>>2]") ; [4:2] ;;(verilog-simplify-range-expression "[2*4/(4-2) +2+4 <<4 >>2]") -;;(verilog-simplify-range-expression "[WIDTH*2/8-1:0]") +;;(verilog-simplify-range-expression "[WIDTH*2/8-1:0]") ; "[WIDTH*2/8-1:0]" +;;(verilog-simplify-range-expression "[(FOO).size:0]") ; "[FOO.size:0]" (defun verilog-clog2 (value) "Compute $clog2 - ceiling log2 of VALUE." @@ -12247,18 +12256,12 @@ If PAR-VALUES replace final strings with these parameter values." (vl-memory (verilog-sig-memory port-st)) (vl-mbits (if (verilog-sig-multidim port-st) (verilog-sig-multidim-string port-st) "")) - (vl-bits (if (or (eq verilog-auto-inst-vector t) - (and (eq verilog-auto-inst-vector `unsigned) - (not (verilog-sig-signed port-st))) - (not (assoc port (verilog-decls-get-signals moddecls))) - (not (equal (verilog-sig-bits port-st) - (verilog-sig-bits - (assoc port (verilog-decls-get-signals moddecls)))))) - (or (verilog-sig-bits port-st) "") - "")) + (vl-bits (or (verilog-sig-bits port-st) "")) (case-fold-search nil) (check-values par-values) - tpl-net dflt-bits) + auto-inst-vector + auto-inst-vector-tpl + tpl-net dflt-bits) ;; Replace parameters in bit-width (when (and check-values (not (equal vl-bits ""))) @@ -12281,6 +12284,16 @@ If PAR-VALUES replace final strings with these parameter values." vl-mbits (verilog-simplify-range-expression vl-mbits) vl-memory (when vl-memory (verilog-simplify-range-expression vl-memory)) vl-width (verilog-make-width-expression vl-bits))) ; Not in the loop for speed + (setq auto-inst-vector + (if (or (eq verilog-auto-inst-vector t) + (and (eq verilog-auto-inst-vector `unsigned) + (not (verilog-sig-signed port-st))) + (not (assoc port (verilog-decls-get-signals moddecls))) + (not (equal (verilog-sig-bits port-st) + (verilog-sig-bits + (assoc port (verilog-decls-get-signals moddecls)))))) + vl-bits + "")) ;; Default net value if not found (setq dflt-bits (if (or (and (verilog-sig-bits port-st) (verilog-sig-multidim port-st)) @@ -12290,7 +12303,7 @@ If PAR-VALUES replace final strings with these parameter values." (if vl-memory "." "") (if vl-memory vl-memory "") "*/") - (concat vl-bits)) + (concat auto-inst-vector)) tpl-net (concat port (if (and vl-modport ;; .modport cannot be added if attachment is @@ -12329,10 +12342,21 @@ If PAR-VALUES replace final strings with these parameter values." (if (numberp value) (setq value (number-to-string value))) value)) (substring tpl-net (match-end 0)))))) + ;; Get range based off template net + (setq auto-inst-vector-tpl + (if (or (eq verilog-auto-inst-vector t) + (and (eq verilog-auto-inst-vector `unsigned) + (not (verilog-sig-signed port-st))) + (not (assoc tpl-net (verilog-decls-get-signals moddecls))) + (not (equal (verilog-sig-bits port-st) + (verilog-sig-bits + (assoc tpl-net (verilog-decls-get-signals moddecls)))))) + vl-bits + "")) ;; Replace @ and [] magic variables in final output (setq tpl-net (verilog-string-replace-matches "@" tpl-num nil nil tpl-net)) (setq tpl-net (verilog-string-replace-matches "\\[\\]\\[\\]" dflt-bits nil nil tpl-net)) - (setq tpl-net (verilog-string-replace-matches "\\[\\]" vl-bits nil nil tpl-net))) + (setq tpl-net (verilog-string-replace-matches "\\[\\]" auto-inst-vector-tpl nil nil tpl-net))) ;; Insert it (when (or tpl-ass (not verilog-auto-inst-template-required)) (verilog--auto-inst-first indent-pt section) @@ -12502,7 +12526,7 @@ Typing \\[verilog-auto] will make this into: endmodule Where the list of inputs and outputs came from the inst module. - + Exceptions: Unless you are instantiating a module multiple times, or the module is @@ -12527,7 +12551,7 @@ Exceptions: // Outputs .o (o[31:0])); - + Templates: For multiple instantiations based upon a single template, create a @@ -12598,7 +12622,7 @@ Templates: .ptl_bus (ptl_busnew[3:0]), .... - + Multiple Module Templates: The same template lines can be applied to multiple modules with @@ -12613,7 +12637,7 @@ Multiple Module Templates: */ Note there is only one AUTO_TEMPLATE opening parenthesis. - + @ Templates: It is common to instantiate a cell multiple times, so templates make it @@ -12678,7 +12702,7 @@ Multiple Module Templates: .ptl_mapvalidx (BAR_ptl_mapvalid), .ptl_mapvalidp1x (ptl_mapvalid_BAR)); - + Regexp Templates: A template entry of the form @@ -12702,7 +12726,7 @@ Regexp Templates: subscript: .\\(.*\\)_l (\\1_[]), - + Lisp Templates: First any regular expression template is expanded. @@ -12747,7 +12771,7 @@ Lisp Templates: After the evaluation is completed, @ substitution and [] substitution occur. - + Ignoring Hookup: AUTOWIRE and related AUTOs will read the signals created by a template. @@ -12756,7 +12780,7 @@ Ignoring Hookup: .pci_req_l (pci_req_not_to_wire), //AUTONOHOOKUP - + For more information see the \\[verilog-faq] and forums at URL `https://www.veripool.org'." (save-excursion @@ -12910,7 +12934,7 @@ Typing \\[verilog-auto] will make this into: endmodule Where the list of parameter connections come from the inst module. - + Templates: You can customize the parameter connections using AUTO_TEMPLATEs, -- cgit v1.2.3 From 8b96503b6e8514f1f9f92895a0707c78b1bbd1fd Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 1 Mar 2024 18:56:02 +0100 Subject: * lisp/emacs-lisp/cl-preloaded.el (cl--typeof-types): Define as var. --- lisp/emacs-lisp/cl-preloaded.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 30753bcd5c5..b2b921192ff 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -92,7 +92,7 @@ Each sublist is in the form (TYPE . DIRECT_SUBTYPES)" for child in children do (cl-pushnew parent (gethash child cl--direct-supertypes-of-type)))) -(defconst cl--typeof-types nil +(defvar cl--typeof-types nil "Alist of supertypes. Each element has the form (TYPE . SUPERTYPES) where TYPE is one of the symbols returned by `type-of', and SUPERTYPES is the list of its -- cgit v1.2.3 From f89cb6b63612a3dce113fa454fece82953fb5d5c Mon Sep 17 00:00:00 2001 From: Kazuhiro Ito Date: Sat, 2 Mar 2024 08:44:56 +0900 Subject: Fix Japanese language environment on Cygwin and MS-Windows * lisp/language/japan-util.el (setup-japanese-environment-internal): Prefer UTF-8 for Cygwin and other Posix hosts; prefer Codepage 932 on DOS/Windows. (Bug#69493) --- lisp/language/japan-util.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el index 93e8ab24971..b058eab7029 100644 --- a/lisp/language/japan-util.el +++ b/lisp/language/japan-util.el @@ -29,8 +29,8 @@ ;;;###autoload (defun setup-japanese-environment-internal () - (prefer-coding-system (if (memq system-type '(windows-nt ms-dos cygwin)) - 'japanese-shift-jis + (prefer-coding-system (if (memq system-type '(windows-nt ms-dos)) + 'japanese-cp932 'utf-8)) (use-cjk-char-width-table 'ja_JP)) -- cgit v1.2.3 From e581c111165c4d138b72b6493717ed22fcb68a8e Mon Sep 17 00:00:00 2001 From: Kazuhiro Ito Date: Sat, 2 Mar 2024 08:49:15 +0900 Subject: * lisp/language/japanese.el (map): Fix typo (bug#69494). --- lisp/language/japanese.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/language/japanese.el b/lisp/language/japanese.el index dd65409c839..8957d1a49af 100644 --- a/lisp/language/japanese.el +++ b/lisp/language/japanese.el @@ -79,7 +79,7 @@ (#x00A2 . #xFFE0) ; CENT SIGN FULLWIDTH CENT SIGN (#x00A3 . #xFFE1) ; POUND SIGN FULLWIDTH POUND SIGN (#x00AC . #xFFE2) ; NOT SIGN FULLWIDTH NOT SIGN - (#x00A6 . #xFFE4) ; BROKEN LINE FULLWIDTH BROKEN LINE + (#x00A6 . #xFFE4) ; BROKEN BAR FULLWIDTH BROKEN BAR ))) (define-translation-table 'japanese-ucs-jis-to-cp932-map map) (setq map (mapcar (lambda (x) (cons (cdr x) (car x))) map)) -- cgit v1.2.3 From c3dc64a1071acc1f622094f91d8f046afedb7b45 Mon Sep 17 00:00:00 2001 From: Yoshiku Onu Date: Thu, 29 Feb 2024 13:29:44 +0500 Subject: Add new input method "english-colemak" * lisp/leim/quail/latin-post.el ("english-colemak"): New input method. (Bug#69471) * etc/NEWS: Announce it. Copyright-paperwork-exempt: yes --- etc/NEWS | 4 ++++ lisp/leim/quail/latin-post.el | 50 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 54 insertions(+) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index df07b2a9d79..792e178c3b6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -432,6 +432,10 @@ functions in CJK locales. *** New input methods for the Urdu, Pashto, and Sindhi languages. These languages are spoken in Pakistan and Afghanistan. +--- +*** New input method "english-colemak". +This input method supports the Colemak keyboard layout. + *** Additional 'C-x 8' key translations for "æ" and "Æ". These characters can now be input with 'C-x 8 a e' and 'C-x 8 A E', respectively, in addition to the existing translations 'C-x 8 / e' and diff --git a/lisp/leim/quail/latin-post.el b/lisp/leim/quail/latin-post.el index 0d2c1888426..25e7c4a64a8 100644 --- a/lisp/leim/quail/latin-post.el +++ b/lisp/leim/quail/latin-post.el @@ -1616,6 +1616,7 @@ Doubling the postfix separates the letter and postfix: e.g. a^^ -> a^ ;; Italian (itln) ;; Spanish (spnsh) ;; Dvorak (dvorak) +;; Colemak (colemak) ;; ;;; 92.12.15 created for Mule Ver.0.9.6 by Takahashi N. ;;; 92.12.29 modified by Takahashi N. @@ -2224,6 +2225,55 @@ Dead accent is right to æ." nil t t t t nil nil nil nil nil t) ("?" ?Z) ) +;; +(quail-define-package + "english-colemak" "English" "CM@" t + "English (ASCII) input method simulating Colemak keyboard" + nil t t t t nil nil nil nil nil t) + +;; 1! 2@ 3# 4$ 5% 6^ 7& 8* 9( 0) -_ =+ `~ +;; qQ wW fF pP gG jJ lL uU yY ;: [{ ]} +;; aA rR sS tT dD hH nN eE iI oO '" \| +;; zZ xX cC vV bB kK mM ,< .> /? + +(quail-define-rules + ("e" ?f) + ("r" ?p) + ("t" ?g) + ("y" ?j) + ("u" ?l) + ("i" ?u) + ("o" ?y) + ("p" ?\;) + ("s" ?r) + ("d" ?s) + ("f" ?t) + ("g" ?d) + ("j" ?n) + ("k" ?e) + ("l" ?i) + (";" ?o) + ("n" ?k) + + ("E" ?F) + ("R" ?P) + ("T" ?G) + ("Y" ?J) + ("U" ?L) + ("I" ?U) + ("O" ?Y) + ("P" ?\:) + ("S" ?R) + ("D" ?S) + ("F" ?T) + ("G" ?D) + ("J" ?N) + ("K" ?E) + ("L" ?I) + (":" ?O) + ("N" ?K) + ) + (quail-define-package "latin-postfix" "Latin" "L<" t "Latin character input method with postfix modifiers. -- cgit v1.2.3 From 7b4c4e68464272cc7941cb53b4421cf0e3d3c3cd Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 2 Mar 2024 19:15:14 +0200 Subject: * lisp/buff-menu.el (Buffer-menu-marked-buffers): Add save-excursion. --- lisp/buff-menu.el | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index ca417290018..ec5337e3fda 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -556,15 +556,16 @@ in the selected frame, and will remove any marks." (defun Buffer-menu-marked-buffers (&optional unmark) "Return the list of buffers marked with `Buffer-menu-mark'. If UNMARK is non-nil, unmark them." - (let (buffers) - (Buffer-menu-beginning) - (while (re-search-forward "^>" nil t) - (let ((buffer (Buffer-menu-buffer))) - (if (and buffer unmark) - (tabulated-list-set-col 0 " " t)) - (if (buffer-live-p buffer) - (push buffer buffers)))) - (nreverse buffers))) + (save-excursion + (let (buffers) + (Buffer-menu-beginning) + (while (re-search-forward "^>" nil t) + (let ((buffer (Buffer-menu-buffer))) + (if (and buffer unmark) + (tabulated-list-set-col 0 " " t)) + (if (buffer-live-p buffer) + (push buffer buffers)))) + (nreverse buffers)))) (defun Buffer-menu-isearch-buffers () "Search for a string through all marked buffers using Isearch." -- cgit v1.2.3 From ebab7276139888266ae0f27bd3b2874e2ed8c077 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 2 Mar 2024 19:22:30 +0200 Subject: * lisp/replace.el (perform-replace): Accept default bindings in lookup-key. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Set ACCEPT-DEFAULT arg of lookup-key to t (bug#69342). This will allow the users to ignore unbound keys with ‘(define-key query-replace-map [t] 'ignore)’. --- lisp/replace.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/replace.el b/lisp/replace.el index fa460a16063..49e7c85c487 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2916,7 +2916,7 @@ characters." ;; If last typed key in previous call of multi-buffer perform-replace ;; was `automatic-all', don't ask more questions in next files - (when (eq (lookup-key map (vector last-input-event)) 'automatic-all) + (when (eq (lookup-key map (vector last-input-event) t) 'automatic-all) (setq query-flag nil multi-buffer t)) (cond @@ -3100,7 +3100,7 @@ characters." ;; read-event that clobbers the match data. (set-match-data real-match-data) (setq key (vector key)) - (setq def (lookup-key map key)) + (setq def (lookup-key map key t)) ;; Restore the match data while we process the command. (cond ((eq def 'help) (let ((display-buffer-overriding-action -- cgit v1.2.3 From 5f543fb4b2f24639c7a6215991b14fca24daf194 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 2 Mar 2024 19:31:07 +0200 Subject: * lisp/net/dictionary.el: Better handling of messages and errors. (dictionary-do-search, dictionary-do-matching): Insert formatted messages to the top of the output buffer instead of displaying transient messages in the echo area (bug#69312). (dictionary-do-matching, dictionary-lookup-definition) (dictionary-popup-matching-words): Use 'user-error' instead of 'error' for non-technical errors. --- lisp/net/dictionary.el | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 1981b757017..e8ac9b679a0 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -787,7 +787,7 @@ FUNCTION is the callback which is called for each search result." Optional argument NOMATCHING controls whether to suppress the display of matching words." - (message "Searching for %s in %s" word dictionary) + (insert (format-message "Searching for `%s' in `%s'\n" word dictionary)) (dictionary-send-command (concat "define " (dictionary-encode-charset dictionary "") " \"" @@ -799,13 +799,13 @@ of matching words." (if (dictionary-check-reply reply 552) (progn (unless nomatching - (insert "Word not found") + (insert (format-message "Word `%s' not found\n" word)) (dictionary-do-matching word dictionary "." (lambda (reply) - (insert ", maybe you are looking for one of these words\n\n") + (insert "Maybe you are looking for one of these words\n") (dictionary-display-only-match-result reply))) (dictionary-post-buffer))) (if (dictionary-check-reply reply 550) @@ -1128,8 +1128,8 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (defun dictionary-do-matching (word dictionary strategy function) "Search for WORD with STRATEGY in DICTIONARY and display them with FUNCTION." - (message "Lookup matching words for %s in %s using %s" - word dictionary strategy) + (insert (format-message "Lookup matching words for `%s' in `%s' using `%s'\n" + word dictionary strategy)) (dictionary-send-command (concat "match " (dictionary-encode-charset dictionary "") " " (dictionary-encode-charset strategy "") " \"" @@ -1141,10 +1141,13 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (if (dictionary-check-reply reply 551) (error "Strategy \"%s\" is invalid" strategy)) (if (dictionary-check-reply reply 552) - (error (concat - "No match for \"%s\" with strategy \"%s\" in " - "dictionary \"%s\".") - word strategy dictionary)) + (let ((errmsg (format-message + (concat + "No match for `%s' with strategy `%s' in " + "dictionary `%s'.") + word strategy dictionary))) + (insert errmsg "\n") + (user-error errmsg))) (unless (dictionary-check-reply reply 152) (error "Unknown server answer: %s" (dictionary-reply reply))) (funcall function reply))) @@ -1271,7 +1274,7 @@ prompt for DICTIONARY." (interactive) (let ((word (current-word))) (unless word - (error "No word at point")) + (user-error "No word at point")) (dictionary-new-search (cons word dictionary-default-dictionary)))) (defun dictionary-previous () @@ -1311,7 +1314,8 @@ prompt for DICTIONARY." (defun dictionary-popup-matching-words (&optional word) "Display entries matching WORD or the current word if not given." (interactive) - (dictionary-do-matching (or word (current-word) (error "Nothing to search for")) + (dictionary-do-matching (or word (current-word) + (user-error "Nothing to search for")) dictionary-default-dictionary dictionary-default-popup-strategy 'dictionary-process-popup-replies)) -- cgit v1.2.3 From 7f8717c6fd3e19b41048ce9a391d59540886cdee Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sat, 2 Mar 2024 18:07:36 -0800 Subject: Use funcall on function values in gnus-agent.el See bug#68931 * lisp/gnus/gnus-agent.el (gnus-category-make-function-1): Don't just pass function values in to be byte compiled, wrap them in funcall first. --- lisp/gnus/gnus-agent.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 1726b806913..0928b179787 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -2920,8 +2920,9 @@ The following commands are available: ;; Functions are just returned as is. ((or (symbolp predicate) (functionp predicate)) - `(,(or (cdr (assq predicate gnus-category-predicate-alist)) - predicate))) + (let ((fun (or (cdr (assq predicate gnus-category-predicate-alist)) + predicate))) + (if (symbolp fun) `(,fun) `(funcall ',fun)))) ;; More complex predicate. ((consp predicate) `(,(cond -- cgit v1.2.3 From 8d11b7e4275affdf66f28ec4a719fc8124252a3d Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 3 Mar 2024 16:33:53 +0100 Subject: * Fix 'cl--typeof-types' computation * lisp/emacs-lisp/cl-preloaded.el (cl--supertypes-lane) (cl--supertypes-lanes-res): Define vars. (cl--supertypes-for-typeof-types-rec): Define function. (cl--supertypes-for-typeof-types): Reimplement. --- lisp/emacs-lisp/cl-preloaded.el | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index b2b921192ff..512cf31ead5 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -98,17 +98,24 @@ Each element has the form (TYPE . SUPERTYPES) where TYPE is one of the symbols returned by `type-of', and SUPERTYPES is the list of its supertypes from the most specific to least specific.") +(defvar cl--supertypes-lane nil) +(defvar cl--supertypes-lanes-res nil) + +(defun cl--supertypes-for-typeof-types-rec (type) + ;; Walk recursively the DAG upwards, when the top is reached collect + ;; the current lane in `cl--supertypes-lanes-res'. + (push type cl--supertypes-lane) + (if-let ((parents (gethash type cl--direct-supertypes-of-type))) + (dolist (parent parents) + (cl--supertypes-for-typeof-types-rec parent)) + (push (reverse (cdr cl--supertypes-lane)) ;; Don't include `t'. + cl--supertypes-lanes-res )) + (pop cl--supertypes-lane)) + (defun cl--supertypes-for-typeof-types (type) - (cl-loop with agenda = (list type) - while agenda - for element = (car agenda) - unless (or (eq element t) ;; no t in `cl--typeof-types'. - (memq element res)) - append (list element) into res - do (cl-loop for c in (gethash element cl--direct-supertypes-of-type) - do (setq agenda (append agenda (list c)))) - do (setq agenda (cdr agenda)) - finally (cl-return res))) + (let (cl--supertypes-lane cl--supertypes-lanes-res) + (cl--supertypes-for-typeof-types-rec type) + (merge-ordered-lists cl--supertypes-lanes-res))) (maphash (lambda (type _) (push (cl--supertypes-for-typeof-types type) cl--typeof-types)) -- cgit v1.2.3 From 23c984a7dea950e15b969fe5b7ca0395315f207a Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 3 Mar 2024 18:58:47 +0200 Subject: * lisp/net/dictionary.el (dictionary-new-matching): Add dictionary-pre-buffer. This is necessary to prepare the dictionary buffer for further processing that also includes setting buffer-read-only to nil to be able to insert text. (bug#69312) --- lisp/net/dictionary.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index e8ac9b679a0..e9e6b1292b5 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1118,6 +1118,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." "Run a new matching search on WORD." (dictionary-ensure-buffer) (dictionary-store-positions) + (dictionary-pre-buffer) (dictionary-do-matching word dictionary-default-dictionary dictionary-default-strategy 'dictionary-display-match-result) -- cgit v1.2.3 From db7b87867b3002d72444f06110e3625aa8de680e Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 3 Mar 2024 19:49:36 +0200 Subject: * lisp/net/dictionary.el (dictionary-display-match-result): More fixes. Remove 'dictionary-pre-buffer' that was moved to 'dictionary-new-matching' in the previous commit (bug#69312). --- lisp/net/dictionary.el | 2 -- 1 file changed, 2 deletions(-) (limited to 'lisp') diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index e9e6b1292b5..7967c650999 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1176,8 +1176,6 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (defun dictionary-display-match-result (reply) "Display the results in REPLY from a match operation." - (dictionary-pre-buffer) - (let ((number (nth 1 (dictionary-reply-list reply))) (list (dictionary-simple-split-string (dictionary-read-answer) "\n+"))) (insert number " matching word" (if (equal number "1") "" "s") -- cgit v1.2.3 From 5254c582efb3e7171e955dde653e7530d2d3ffef Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 2 Mar 2024 14:48:29 -0500 Subject: ox-texinfo:: Require only TEXINFO_DIR_CATEGORY Until now @dircategory/@direntry entries were added only if both TEXINFO_DIR_CATEGORY and TEXINFO_DIR_TITLE were set. And the setting of TEXINFO_DIR_TITLE had to be careful to provide exactly the right syntax. This patch changes various things in this regard: - Only require TEXINFO_DIR_CATEGORY in order to generate `@dircategory` and `@direntry`. - Use the document title by default if TEXINFO_DIR_DESC is missing. - Use the filename by default when TEXINFO_DIR_TITLE is missing. - Try and make it harder to provide a direntry that does not have the right format or refers to a different filename than the one we're outputting to. * lisp/org/ox-texinfo.el: Remove redundant `:group` arguments. Prefer #' to quote function names. (org-texinfo-template): Use sane defaults for `@direntry`. * doc/misc/org.org (Texinfo specific export settings): Adjust accordingly. --- doc/misc/org.org | 11 ++++++++-- lisp/org/ox-texinfo.el | 58 ++++++++++++++++++++++++-------------------------- 2 files changed, 37 insertions(+), 32 deletions(-) (limited to 'lisp') diff --git a/doc/misc/org.org b/doc/misc/org.org index 05ab5b36ca0..f4590525892 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -15322,11 +15322,18 @@ the general options (see [[*Export Settings]]). #+cindex: @samp{TEXINFO_DIR_TITLE}, keyword The directory title of the document. + This is the short name under which the ~m~ command will find your + manual in the main Info directory. It defaults to the base name of + the Texinfo file. + + If you need more control, it can also be the full entry using the + syntax ~* TITLE: (FILENAME).~. - =TEXINFO_DIR_DESC= :: #+cindex: @samp{TEXINFO_DIR_DESC}, keyword The directory description of the document. + Defaults to the title of the document. - =TEXINFO_PRINTED_TITLE= :: @@ -15422,7 +15429,7 @@ Here is an example that writes to the Info directory file: #+begin_example ,#+TEXINFO_DIR_CATEGORY: Emacs -,#+TEXINFO_DIR_TITLE: Org Mode: (org) +,#+TEXINFO_DIR_TITLE: Org Mode ,#+TEXINFO_DIR_DESC: Outline-based notes management and organizer #+end_example @@ -15830,7 +15837,7 @@ Texinfo code. ,#+TEXINFO_HEADER: @syncodeindex pg cp ,#+TEXINFO_DIR_CATEGORY: Texinfo documentation system -,#+TEXINFO_DIR_TITLE: sample: (sample) +,#+TEXINFO_DIR_TITLE: sample ,#+TEXINFO_DIR_DESC: Invoking sample ,#+TEXINFO_PRINTED_TITLE: GNU Sample diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el index 84313645e6e..5065c3fb63c 100644 --- a/lisp/org/ox-texinfo.el +++ b/lisp/org/ox-texinfo.el @@ -110,6 +110,10 @@ (:subtitle "SUBTITLE" nil nil parse) (:subauthor "SUBAUTHOR" nil nil newline) (:texinfo-dircat "TEXINFO_DIR_CATEGORY" nil nil t) + ;; FIXME: The naming of these options is unsatisfactory: + ;; TEXINFO_DIR_DESC corresponds (and defaults) to the document's + ;; title, whereas TEXINFO_DIR_TITLE corresponds (and defaults) to + ;; its filename. (:texinfo-dirtitle "TEXINFO_DIR_TITLE" nil nil t) (:texinfo-dirdesc "TEXINFO_DIR_DESC" nil nil t) (:texinfo-printed-title "TEXINFO_PRINTED_TITLE" nil nil t) @@ -147,12 +151,10 @@ "Default document encoding for Texinfo output. If nil it will default to `buffer-file-coding-system'." - :group 'org-export-texinfo :type 'coding-system) (defcustom org-texinfo-default-class "info" "The default Texinfo class." - :group 'org-export-texinfo :type '(string :tag "Texinfo class")) (defcustom org-texinfo-classes @@ -205,7 +207,6 @@ The sectioning structure of the class is given by the elements following the header string. For each sectioning level, a number of strings is specified. A %s formatter is mandatory in each section string and will be replaced by the title of the section." - :group 'org-export-texinfo :version "27.1" :package-version '(Org . "9.2") :type '(repeat @@ -233,7 +234,6 @@ TEXT the main headline text (string). TAGS the tags as a list of strings (list of strings or nil). The function result will be used in the section format string." - :group 'org-export-texinfo :type 'function :version "26.1" :package-version '(Org . "8.3")) @@ -244,38 +244,32 @@ The function result will be used in the section format string." "Column at which to start the description in the node listings. If a node title is greater than this length, the description will be placed after the end of the title." - :group 'org-export-texinfo :type 'integer) ;;;; Timestamps (defcustom org-texinfo-active-timestamp-format "@emph{%s}" "A printf format string to be applied to active timestamps." - :group 'org-export-texinfo :type 'string) (defcustom org-texinfo-inactive-timestamp-format "@emph{%s}" "A printf format string to be applied to inactive timestamps." - :group 'org-export-texinfo :type 'string) (defcustom org-texinfo-diary-timestamp-format "@emph{%s}" "A printf format string to be applied to diary timestamps." - :group 'org-export-texinfo :type 'string) ;;;; Links (defcustom org-texinfo-link-with-unknown-path-format "@indicateurl{%s}" "Format string for links with unknown path type." - :group 'org-export-texinfo :type 'string) ;;;; Tables (defcustom org-texinfo-tables-verbatim nil "When non-nil, tables are exported verbatim." - :group 'org-export-texinfo :type 'boolean) (defcustom org-texinfo-table-scientific-notation nil @@ -285,7 +279,6 @@ The format should have \"%s\" twice, for mantissa and exponent \(i.e. \"%s\\\\times10^{%s}\"). When nil, no transformation is made." - :group 'org-export-texinfo :type '(choice (string :tag "Format string") (const :tag "No formatting" nil))) @@ -297,7 +290,6 @@ This should an indicating command, e.g., \"@code\", \"@kbd\" or \"@samp\". It can be overridden locally using the \":indic\" attribute." - :group 'org-export-texinfo :type 'string :version "26.1" :package-version '(Org . "9.1") @@ -323,7 +315,6 @@ to typeset and protects special characters. When no association is found for a given markup, text is returned as-is." - :group 'org-export-texinfo :version "26.1" :package-version '(Org . "9.1") :type 'alist @@ -341,7 +332,6 @@ The function must accept two parameters: The function should return the string to be exported. The default function simply returns the value of CONTENTS." - :group 'org-export-texinfo :version "24.4" :package-version '(Org . "8.2") :type 'function) @@ -361,7 +351,6 @@ The function must accept six parameters: CONTENTS the contents of the inlinetask, as a string. The function should return the string to be exported." - :group 'org-export-texinfo :type 'function) ;;;; LaTeX @@ -374,7 +363,6 @@ fragments as Texinfo \"@displaymath\" and \"@math\" commands respectively. Alternatively, when set to `detect', the exporter does so only if the installed version of Texinfo supports the necessary commands." - :group 'org-export-texinfo :package-version '(Org . "9.6") :type '(choice (const :tag "Detect" detect) @@ -391,7 +379,6 @@ body but is followed by another item, then the second item is transcoded to `@itemx'. See info node `(org)Plain lists in Texinfo export' for how to enable this for individual lists." :package-version '(Org . "9.6") - :group 'org-export-texinfo :type 'boolean :safe t) @@ -406,7 +393,6 @@ relative file name, %F by the absolute file name, %b by the file base name (i.e. without directory and extension parts), %o by the base directory of the file and %O by the absolute file name of the output file." - :group 'org-export-texinfo :version "26.1" :package-version '(Org . "9.1") :type '(repeat :tag "Shell command sequence" @@ -416,8 +402,8 @@ the output file." '("aux" "toc" "cp" "fn" "ky" "pg" "tp" "vr") "The list of file extensions to consider as Texinfo logfiles. The logfiles will be remove if `org-texinfo-remove-logfiles' is + non-nil." - :group 'org-export-texinfo :type '(repeat (string :tag "Extension"))) (defcustom org-texinfo-remove-logfiles t @@ -815,19 +801,31 @@ holding export options." (format "@copying\n%s@end copying\n\n" (org-element-normalize-string (org-export-data copying info)))) - ;; Info directory information. Only supply if both title and - ;; category are provided. - (let ((dircat (plist-get info :texinfo-dircat)) - (dirtitle - (let ((title (plist-get info :texinfo-dirtitle))) - (and title - (string-match "^\\(?:\\* \\)?\\(.*?\\)\\(\\.\\)?$" title) - (format "* %s." (match-string 1 title)))))) - (when (and dircat dirtitle) + ;; Info directory information. Only supply if category is provided. + ;; FIXME: A Texinfo doc without a direntry is significantly less useful + ;; since it won't appear in the main Info-directory, so maybe we should + ;; use a default category like "misc"? + (let* ((dircat (plist-get info :texinfo-dircat)) + (dt (plist-get info :texinfo-dirtitle)) + (file (file-name-sans-extension + (or (org-strip-quotes (plist-get info :texinfo-filename)) + (plist-get info :output-file)))) + (dirtitle + (cond + ((and dt + (or (string-match "\\`\\* \\(.*?\\)\\(\\.\\)?\\'" dt) + (string-match "\\`\\(.*(.*)\\)\\(\\.\\)?\\'" dt))) + ;; `dt' is already "complete". + (format "* %s." (match-string 1 dt))) + ((and dt (not (equal dt file))) + (format "* %s: (%s)." dt file)) + (t (format "* %s." file))))) + (when dircat (concat "@dircategory " dircat "\n" "@direntry\n" (let ((dirdesc - (let ((desc (plist-get info :texinfo-dirdesc))) + (let ((desc (or (plist-get info :texinfo-dirdesc) + title))) (cond ((not desc) nil) ((string-suffix-p "." desc) desc) (t (concat desc ".")))))) @@ -1590,7 +1588,7 @@ information." (concat "@noindent" (mapconcat - 'identity + #'identity (delq nil (list (let ((closed (org-element-property :closed planning))) -- cgit v1.2.3 From 99483e214fdafa76e8001c7009dff13a76c33f32 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 2 Mar 2024 15:23:17 -0500 Subject: Set org-macro-templates more lazily --- lisp/org/org-macro.el | 8 +++++--- lisp/org/org-macs.el | 4 +++- lisp/org/org.el | 21 ++++++++++----------- 3 files changed, 18 insertions(+), 15 deletions(-) (limited to 'lisp') diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el index 737eab5d2bb..acc8f5e593b 100644 --- a/lisp/org/org-macro.el +++ b/lisp/org/org-macro.el @@ -78,12 +78,14 @@ ;;; Variables -(defvar-local org-macro-templates nil +(defvar-local org-macro-templates t "Alist containing all macro templates in current buffer. Associations are in the shape of (NAME . TEMPLATE) where NAME stands for macro's name and template for its replacement value, -both as strings. This is an internal variable. Do not set it -directly, use instead: +both as strings. +`t' means that it has not yet been initialized. + +This is an internal variable. Do not set it directly, use instead: #+MACRO: name template") diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index aafbdf0e0aa..53943d343d8 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -132,6 +132,8 @@ Version mismatch is commonly encountered in the following situations: ;; Use `with-silent-modifications' to ignore cosmetic changes and ;; `org-unmodified' to ignore real text modifications. +;; FIXME: Won't "real text modifications" break the undo data if +;; `buffer-undo-list' is let-bound to t? (defmacro org-unmodified (&rest body) "Run BODY while preserving the buffer's `buffer-modified-p' state." (declare (debug (body))) @@ -141,7 +143,7 @@ Version mismatch is commonly encountered in the following situations: (let ((buffer-undo-list t) (inhibit-modification-hooks t)) ,@body) - (set-buffer-modified-p ,was-modified))))) + (restore-buffer-modified-p ,was-modified))))) (defmacro org-with-base-buffer (buffer &rest body) "Run BODY in base buffer for BUFFER. diff --git a/lisp/org/org.el b/lisp/org/org.el index d361408eaca..3fb8fce78d3 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -716,8 +716,9 @@ defined in org-duration.el.") "Load all extensions listed in `org-modules'." (when (or force (not org-modules-loaded)) (dolist (ext org-modules) - (condition-case nil (require ext) - (error (message "Problems while trying to load feature `%s'" ext)))) + (condition-case err (require ext) + (error (message "Problems while trying to load feature `%s':\n%S" + ext err)))) (setq org-modules-loaded t))) (defun org-set-modules (var value) @@ -855,7 +856,7 @@ depends on, if any." :group 'org-export :version "26.1" :package-version '(Org . "9.0") - :initialize 'custom-initialize-set + :initialize #'custom-initialize-set :set (lambda (var val) (if (not (featurep 'ox)) (set-default-toplevel-value var val) ;; Any back-end not required anymore (not present in VAL and not @@ -905,9 +906,9 @@ depends on, if any." (eval-after-load 'ox '(dolist (backend org-export-backends) - (condition-case nil (require (intern (format "ox-%s" backend))) - (error (message "Problems while trying to load export back-end `%s'" - backend))))) + (condition-case err (require (intern (format "ox-%s" backend))) + (error (message "Problems while trying to load export back-end `%s':\n%S" + backend err))))) (defcustom org-support-shift-select nil "Non-nil means make shift-cursor commands select text when possible. @@ -4772,7 +4773,7 @@ This is for getting out of special buffers like capture.") (require 'org-pcomplete) (require 'org-src) (require 'org-footnote) -(require 'org-macro) +;; (require 'org-macro) ;; babel (require 'ob) @@ -4852,8 +4853,6 @@ The following commands are available: (when (and org-element-cache-persistent org-element-use-cache) (org-persist-load 'org-element--cache (current-buffer) t)) - ;; Initialize macros templates. - (org-macro-initialize-templates) ;; Initialize radio targets. (org-update-radio-target-regexp) ;; Indentation. @@ -10459,7 +10458,7 @@ EXTRA is additional text that will be inserted into the notes buffer." org-log-note-this-command this-command org-log-note-recursion-depth (recursion-depth) org-log-setup t) - (add-hook 'post-command-hook 'org-add-log-note 'append)) + (add-hook 'post-command-hook #'org-add-log-note 'append)) (defun org-skip-over-state-notes () "Skip past the list of State notes in an entry." @@ -10488,7 +10487,7 @@ EXTRA is additional text that will be inserted into the notes buffer." "Pop up a window for taking a note, and add this note later." (when (and (equal org-log-note-this-command this-command) (= org-log-note-recursion-depth (recursion-depth))) - (remove-hook 'post-command-hook 'org-add-log-note) + (remove-hook 'post-command-hook #'org-add-log-note) (setq org-log-setup nil) (setq org-log-note-window-configuration (current-window-configuration)) (delete-other-windows) -- cgit v1.2.3 From 1d9d07fb00e6b62641c07af68f986e700b5f6cee Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 3 Mar 2024 18:08:50 -0500 Subject: (cl--typeof-types): Rework to fix some regressions Initialize the variables directly in their declaration, so there no time where they exist but aren't yet initialized. This also allows us to mark `cl--typeof-types` as a `defconst` again. More importantly, specify the DAG by direct supertypes rather than direct subtypes. This is slightly less compact, but it's necessary to let us specify the *order* of the supertypes, which is necessary for example to preserve the desired ordering of methods when several methods can be applied. Fix a few more regressions, such as removing `atom` from the parents of `function` since some lists are considered as functions, adding `number-or-marker` as supertype of `integer-or-marker`, and re-adding `native-comp-unit`. I carefully compared all elements of `cl--typeof-types` to make sure they are the same as before (with one exception for `null`). * lisp/emacs-lisp/cl-preloaded.el (cl--type-hierarchy): Delete var. (cl--direct-supertypes-of-type, cl--typeof-types): Initialize directly in the declaration. (cl--supertypes-lane, cl--supertypes-lanes-res): Delete vars. (cl--supertypes-for-typeof-types-rec) (cl--supertypes-for-typeof-types): Delete functions. --- lisp/emacs-lisp/cl-preloaded.el | 117 +++++++++++++++++++--------------------- 1 file changed, 54 insertions(+), 63 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 512cf31ead5..a4ddc55b257 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -50,77 +50,68 @@ (apply #'error string (append sargs args)) (signal 'cl-assertion-failed `(,form ,@sargs))))) - -(defconst cl--type-hierarchy - ;; Please run `sycdoc-update-type-hierarchy' in - ;; etc/syncdoc-type-hierarchy.el each time this is updated to - ;; reflect in the documentation. - '((t sequence atom) - (sequence list array) - (atom - class structure tree-sitter-compiled-query tree-sitter-node - tree-sitter-parser user-ptr font-object font-entity font-spec - condvar mutex thread terminal hash-table frame buffer function - window process window-configuration overlay integer-or-marker - number-or-marker symbol array obarray) - (number float integer) - (number-or-marker marker number) - (integer bignum fixnum) - (symbol keyword boolean symbol-with-pos) - (array vector bool-vector char-table string) - (list null cons) - (integer-or-marker integer marker) - (compiled-function byte-code-function) - (function subr module-function compiled-function) - (boolean null) - (subr subr-native-elisp subr-primitive) - (symbol-with-pos keyword)) - "List of lists describing all the edges of the builtin type -hierarchy. -Each sublist is in the form (TYPE . DIRECT_SUBTYPES)" - ;; Given type hierarchy is a DAG (but mostly a tree) I believe this - ;; is the most compact way to express it. - ) - (defconst cl--direct-supertypes-of-type - (make-hash-table :test #'eq) + (let ((table (make-hash-table :test #'eq))) + (dolist (x '((sequence t) + (atom t) + (list sequence) + (array sequence atom) + (float number) + (integer number integer-or-marker) + (marker integer-or-marker number-or-marker) + (integer-or-marker number-or-marker) + (number number-or-marker) + (bignum integer) + (fixnum integer) + (keyword symbol) + (boolean symbol) + (symbol-with-pos symbol) + (vector array) + (bool-vector array) + (char-table array) + (string array) + ;; FIXME: This results in `atom' coming before `list' :-( + (null boolean list) + (cons list) + (byte-code-function compiled-function) + (subr compiled-function) + (module-function function atom) + (compiled-function function atom) + (subr-native-elisp subr) + (subr-primitive subr))) + (puthash (car x) (cdr x) table)) + ;; And here's the flat part of the hierarchy. + (dolist (atom '( tree-sitter-compiled-query tree-sitter-node + tree-sitter-parser user-ptr + font-object font-entity font-spec + condvar mutex thread terminal hash-table frame + ;; function ;; FIXME: can be a list as well. + buffer window process window-configuration + overlay number-or-marker + symbol obarray native-comp-unit)) + (cl-assert (null (gethash atom table))) + (puthash atom '(atom) table)) + table) "Hash table TYPE -> SUPERTYPES.") -(cl-loop - for (parent . children) in cl--type-hierarchy - do (cl-loop - for child in children - do (cl-pushnew parent (gethash child cl--direct-supertypes-of-type)))) - -(defvar cl--typeof-types nil +(defconst cl--typeof-types + (letrec ((alist nil) + (allparents + (lambda (type) + ;; FIXME: copy&pasted from `cl--class-allparents'. + (let ((parents (gethash type cl--direct-supertypes-of-type))) + (cons type + (merge-ordered-lists + (mapcar allparents (remq t parents)))))))) + (maphash (lambda (type _) + (push (funcall allparents type) alist)) + cl--direct-supertypes-of-type) + alist) "Alist of supertypes. Each element has the form (TYPE . SUPERTYPES) where TYPE is one of the symbols returned by `type-of', and SUPERTYPES is the list of its supertypes from the most specific to least specific.") -(defvar cl--supertypes-lane nil) -(defvar cl--supertypes-lanes-res nil) - -(defun cl--supertypes-for-typeof-types-rec (type) - ;; Walk recursively the DAG upwards, when the top is reached collect - ;; the current lane in `cl--supertypes-lanes-res'. - (push type cl--supertypes-lane) - (if-let ((parents (gethash type cl--direct-supertypes-of-type))) - (dolist (parent parents) - (cl--supertypes-for-typeof-types-rec parent)) - (push (reverse (cdr cl--supertypes-lane)) ;; Don't include `t'. - cl--supertypes-lanes-res )) - (pop cl--supertypes-lane)) - -(defun cl--supertypes-for-typeof-types (type) - (let (cl--supertypes-lane cl--supertypes-lanes-res) - (cl--supertypes-for-typeof-types-rec type) - (merge-ordered-lists cl--supertypes-lanes-res))) - -(maphash (lambda (type _) - (push (cl--supertypes-for-typeof-types type) cl--typeof-types)) - cl--direct-supertypes-of-type) - (defconst cl--all-builtin-types (delete-dups (copy-sequence (apply #'append cl--typeof-types)))) -- cgit v1.2.3 From 1a37fe3a66930bb8151a29c722dbe3bebc20d033 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 3 Mar 2024 22:09:19 -0500 Subject: Revert "Set org-macro-templates more lazily" This reverts commit 99483e214fdafa76e8001c7009dff13a76c33f32. --- lisp/org/org-macro.el | 8 +++----- lisp/org/org-macs.el | 4 +--- lisp/org/org.el | 21 +++++++++++---------- 3 files changed, 15 insertions(+), 18 deletions(-) (limited to 'lisp') diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el index acc8f5e593b..737eab5d2bb 100644 --- a/lisp/org/org-macro.el +++ b/lisp/org/org-macro.el @@ -78,14 +78,12 @@ ;;; Variables -(defvar-local org-macro-templates t +(defvar-local org-macro-templates nil "Alist containing all macro templates in current buffer. Associations are in the shape of (NAME . TEMPLATE) where NAME stands for macro's name and template for its replacement value, -both as strings. -`t' means that it has not yet been initialized. - -This is an internal variable. Do not set it directly, use instead: +both as strings. This is an internal variable. Do not set it +directly, use instead: #+MACRO: name template") diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 53943d343d8..aafbdf0e0aa 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -132,8 +132,6 @@ Version mismatch is commonly encountered in the following situations: ;; Use `with-silent-modifications' to ignore cosmetic changes and ;; `org-unmodified' to ignore real text modifications. -;; FIXME: Won't "real text modifications" break the undo data if -;; `buffer-undo-list' is let-bound to t? (defmacro org-unmodified (&rest body) "Run BODY while preserving the buffer's `buffer-modified-p' state." (declare (debug (body))) @@ -143,7 +141,7 @@ Version mismatch is commonly encountered in the following situations: (let ((buffer-undo-list t) (inhibit-modification-hooks t)) ,@body) - (restore-buffer-modified-p ,was-modified))))) + (set-buffer-modified-p ,was-modified))))) (defmacro org-with-base-buffer (buffer &rest body) "Run BODY in base buffer for BUFFER. diff --git a/lisp/org/org.el b/lisp/org/org.el index 3fb8fce78d3..d361408eaca 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -716,9 +716,8 @@ defined in org-duration.el.") "Load all extensions listed in `org-modules'." (when (or force (not org-modules-loaded)) (dolist (ext org-modules) - (condition-case err (require ext) - (error (message "Problems while trying to load feature `%s':\n%S" - ext err)))) + (condition-case nil (require ext) + (error (message "Problems while trying to load feature `%s'" ext)))) (setq org-modules-loaded t))) (defun org-set-modules (var value) @@ -856,7 +855,7 @@ depends on, if any." :group 'org-export :version "26.1" :package-version '(Org . "9.0") - :initialize #'custom-initialize-set + :initialize 'custom-initialize-set :set (lambda (var val) (if (not (featurep 'ox)) (set-default-toplevel-value var val) ;; Any back-end not required anymore (not present in VAL and not @@ -906,9 +905,9 @@ depends on, if any." (eval-after-load 'ox '(dolist (backend org-export-backends) - (condition-case err (require (intern (format "ox-%s" backend))) - (error (message "Problems while trying to load export back-end `%s':\n%S" - backend err))))) + (condition-case nil (require (intern (format "ox-%s" backend))) + (error (message "Problems while trying to load export back-end `%s'" + backend))))) (defcustom org-support-shift-select nil "Non-nil means make shift-cursor commands select text when possible. @@ -4773,7 +4772,7 @@ This is for getting out of special buffers like capture.") (require 'org-pcomplete) (require 'org-src) (require 'org-footnote) -;; (require 'org-macro) +(require 'org-macro) ;; babel (require 'ob) @@ -4853,6 +4852,8 @@ The following commands are available: (when (and org-element-cache-persistent org-element-use-cache) (org-persist-load 'org-element--cache (current-buffer) t)) + ;; Initialize macros templates. + (org-macro-initialize-templates) ;; Initialize radio targets. (org-update-radio-target-regexp) ;; Indentation. @@ -10458,7 +10459,7 @@ EXTRA is additional text that will be inserted into the notes buffer." org-log-note-this-command this-command org-log-note-recursion-depth (recursion-depth) org-log-setup t) - (add-hook 'post-command-hook #'org-add-log-note 'append)) + (add-hook 'post-command-hook 'org-add-log-note 'append)) (defun org-skip-over-state-notes () "Skip past the list of State notes in an entry." @@ -10487,7 +10488,7 @@ EXTRA is additional text that will be inserted into the notes buffer." "Pop up a window for taking a note, and add this note later." (when (and (equal org-log-note-this-command this-command) (= org-log-note-recursion-depth (recursion-depth))) - (remove-hook 'post-command-hook #'org-add-log-note) + (remove-hook 'post-command-hook 'org-add-log-note) (setq org-log-setup nil) (setq org-log-note-window-configuration (current-window-configuration)) (delete-other-windows) -- cgit v1.2.3 From 445f376e4e613ebee94d2844926269bfa8793858 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 3 Mar 2024 22:09:24 -0500 Subject: Revert "ox-texinfo:: Require only TEXINFO_DIR_CATEGORY" This reverts commit 5254c582efb3e7171e955dde653e7530d2d3ffef. --- doc/misc/org.org | 11 ++-------- lisp/org/ox-texinfo.el | 58 ++++++++++++++++++++++++++------------------------ 2 files changed, 32 insertions(+), 37 deletions(-) (limited to 'lisp') diff --git a/doc/misc/org.org b/doc/misc/org.org index f4590525892..05ab5b36ca0 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -15322,18 +15322,11 @@ the general options (see [[*Export Settings]]). #+cindex: @samp{TEXINFO_DIR_TITLE}, keyword The directory title of the document. - This is the short name under which the ~m~ command will find your - manual in the main Info directory. It defaults to the base name of - the Texinfo file. - - If you need more control, it can also be the full entry using the - syntax ~* TITLE: (FILENAME).~. - =TEXINFO_DIR_DESC= :: #+cindex: @samp{TEXINFO_DIR_DESC}, keyword The directory description of the document. - Defaults to the title of the document. - =TEXINFO_PRINTED_TITLE= :: @@ -15429,7 +15422,7 @@ Here is an example that writes to the Info directory file: #+begin_example ,#+TEXINFO_DIR_CATEGORY: Emacs -,#+TEXINFO_DIR_TITLE: Org Mode +,#+TEXINFO_DIR_TITLE: Org Mode: (org) ,#+TEXINFO_DIR_DESC: Outline-based notes management and organizer #+end_example @@ -15837,7 +15830,7 @@ Texinfo code. ,#+TEXINFO_HEADER: @syncodeindex pg cp ,#+TEXINFO_DIR_CATEGORY: Texinfo documentation system -,#+TEXINFO_DIR_TITLE: sample +,#+TEXINFO_DIR_TITLE: sample: (sample) ,#+TEXINFO_DIR_DESC: Invoking sample ,#+TEXINFO_PRINTED_TITLE: GNU Sample diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el index 5065c3fb63c..84313645e6e 100644 --- a/lisp/org/ox-texinfo.el +++ b/lisp/org/ox-texinfo.el @@ -110,10 +110,6 @@ (:subtitle "SUBTITLE" nil nil parse) (:subauthor "SUBAUTHOR" nil nil newline) (:texinfo-dircat "TEXINFO_DIR_CATEGORY" nil nil t) - ;; FIXME: The naming of these options is unsatisfactory: - ;; TEXINFO_DIR_DESC corresponds (and defaults) to the document's - ;; title, whereas TEXINFO_DIR_TITLE corresponds (and defaults) to - ;; its filename. (:texinfo-dirtitle "TEXINFO_DIR_TITLE" nil nil t) (:texinfo-dirdesc "TEXINFO_DIR_DESC" nil nil t) (:texinfo-printed-title "TEXINFO_PRINTED_TITLE" nil nil t) @@ -151,10 +147,12 @@ "Default document encoding for Texinfo output. If nil it will default to `buffer-file-coding-system'." + :group 'org-export-texinfo :type 'coding-system) (defcustom org-texinfo-default-class "info" "The default Texinfo class." + :group 'org-export-texinfo :type '(string :tag "Texinfo class")) (defcustom org-texinfo-classes @@ -207,6 +205,7 @@ The sectioning structure of the class is given by the elements following the header string. For each sectioning level, a number of strings is specified. A %s formatter is mandatory in each section string and will be replaced by the title of the section." + :group 'org-export-texinfo :version "27.1" :package-version '(Org . "9.2") :type '(repeat @@ -234,6 +233,7 @@ TEXT the main headline text (string). TAGS the tags as a list of strings (list of strings or nil). The function result will be used in the section format string." + :group 'org-export-texinfo :type 'function :version "26.1" :package-version '(Org . "8.3")) @@ -244,32 +244,38 @@ The function result will be used in the section format string." "Column at which to start the description in the node listings. If a node title is greater than this length, the description will be placed after the end of the title." + :group 'org-export-texinfo :type 'integer) ;;;; Timestamps (defcustom org-texinfo-active-timestamp-format "@emph{%s}" "A printf format string to be applied to active timestamps." + :group 'org-export-texinfo :type 'string) (defcustom org-texinfo-inactive-timestamp-format "@emph{%s}" "A printf format string to be applied to inactive timestamps." + :group 'org-export-texinfo :type 'string) (defcustom org-texinfo-diary-timestamp-format "@emph{%s}" "A printf format string to be applied to diary timestamps." + :group 'org-export-texinfo :type 'string) ;;;; Links (defcustom org-texinfo-link-with-unknown-path-format "@indicateurl{%s}" "Format string for links with unknown path type." + :group 'org-export-texinfo :type 'string) ;;;; Tables (defcustom org-texinfo-tables-verbatim nil "When non-nil, tables are exported verbatim." + :group 'org-export-texinfo :type 'boolean) (defcustom org-texinfo-table-scientific-notation nil @@ -279,6 +285,7 @@ The format should have \"%s\" twice, for mantissa and exponent \(i.e. \"%s\\\\times10^{%s}\"). When nil, no transformation is made." + :group 'org-export-texinfo :type '(choice (string :tag "Format string") (const :tag "No formatting" nil))) @@ -290,6 +297,7 @@ This should an indicating command, e.g., \"@code\", \"@kbd\" or \"@samp\". It can be overridden locally using the \":indic\" attribute." + :group 'org-export-texinfo :type 'string :version "26.1" :package-version '(Org . "9.1") @@ -315,6 +323,7 @@ to typeset and protects special characters. When no association is found for a given markup, text is returned as-is." + :group 'org-export-texinfo :version "26.1" :package-version '(Org . "9.1") :type 'alist @@ -332,6 +341,7 @@ The function must accept two parameters: The function should return the string to be exported. The default function simply returns the value of CONTENTS." + :group 'org-export-texinfo :version "24.4" :package-version '(Org . "8.2") :type 'function) @@ -351,6 +361,7 @@ The function must accept six parameters: CONTENTS the contents of the inlinetask, as a string. The function should return the string to be exported." + :group 'org-export-texinfo :type 'function) ;;;; LaTeX @@ -363,6 +374,7 @@ fragments as Texinfo \"@displaymath\" and \"@math\" commands respectively. Alternatively, when set to `detect', the exporter does so only if the installed version of Texinfo supports the necessary commands." + :group 'org-export-texinfo :package-version '(Org . "9.6") :type '(choice (const :tag "Detect" detect) @@ -379,6 +391,7 @@ body but is followed by another item, then the second item is transcoded to `@itemx'. See info node `(org)Plain lists in Texinfo export' for how to enable this for individual lists." :package-version '(Org . "9.6") + :group 'org-export-texinfo :type 'boolean :safe t) @@ -393,6 +406,7 @@ relative file name, %F by the absolute file name, %b by the file base name (i.e. without directory and extension parts), %o by the base directory of the file and %O by the absolute file name of the output file." + :group 'org-export-texinfo :version "26.1" :package-version '(Org . "9.1") :type '(repeat :tag "Shell command sequence" @@ -402,8 +416,8 @@ the output file." '("aux" "toc" "cp" "fn" "ky" "pg" "tp" "vr") "The list of file extensions to consider as Texinfo logfiles. The logfiles will be remove if `org-texinfo-remove-logfiles' is - non-nil." + :group 'org-export-texinfo :type '(repeat (string :tag "Extension"))) (defcustom org-texinfo-remove-logfiles t @@ -801,31 +815,19 @@ holding export options." (format "@copying\n%s@end copying\n\n" (org-element-normalize-string (org-export-data copying info)))) - ;; Info directory information. Only supply if category is provided. - ;; FIXME: A Texinfo doc without a direntry is significantly less useful - ;; since it won't appear in the main Info-directory, so maybe we should - ;; use a default category like "misc"? - (let* ((dircat (plist-get info :texinfo-dircat)) - (dt (plist-get info :texinfo-dirtitle)) - (file (file-name-sans-extension - (or (org-strip-quotes (plist-get info :texinfo-filename)) - (plist-get info :output-file)))) - (dirtitle - (cond - ((and dt - (or (string-match "\\`\\* \\(.*?\\)\\(\\.\\)?\\'" dt) - (string-match "\\`\\(.*(.*)\\)\\(\\.\\)?\\'" dt))) - ;; `dt' is already "complete". - (format "* %s." (match-string 1 dt))) - ((and dt (not (equal dt file))) - (format "* %s: (%s)." dt file)) - (t (format "* %s." file))))) - (when dircat + ;; Info directory information. Only supply if both title and + ;; category are provided. + (let ((dircat (plist-get info :texinfo-dircat)) + (dirtitle + (let ((title (plist-get info :texinfo-dirtitle))) + (and title + (string-match "^\\(?:\\* \\)?\\(.*?\\)\\(\\.\\)?$" title) + (format "* %s." (match-string 1 title)))))) + (when (and dircat dirtitle) (concat "@dircategory " dircat "\n" "@direntry\n" (let ((dirdesc - (let ((desc (or (plist-get info :texinfo-dirdesc) - title))) + (let ((desc (plist-get info :texinfo-dirdesc))) (cond ((not desc) nil) ((string-suffix-p "." desc) desc) (t (concat desc ".")))))) @@ -1588,7 +1590,7 @@ information." (concat "@noindent" (mapconcat - #'identity + 'identity (delq nil (list (let ((closed (org-element-property :closed planning))) -- cgit v1.2.3 From f5c65dae099485f4df128b61d36ae9e5af8518a8 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 4 Mar 2024 11:21:53 +0800 Subject: Update tramp-androidsu * doc/misc/tramp.texi (Quick Start Guide): Remove documentation pertaining to tramp-androidsu.el. (Inline methods): Document it here instead. * lisp/net/tramp-androidsu.el (tramp-androidsu-mount-global-namespace) (tramp-androidsu-remote-path, tramp-androidsu-local-shell-name) (tramp-androidsu-local-tmp-directory, add-to-list) (tramp-androidsu-maybe-open-connection) (tramp-androidsu-handle-access-file) (tramp-androidsu-handle-add-name-to-file) (tramp-androidsu-handle-copy-directory) (tramp-androidsu-sh-handle-copy-file) (tramp-androidsu-handle-copy-file) (tramp-androidsu-adb-handle-delete-directory) (tramp-androidsu-handle-delete-directory) (tramp-androidsu-adb-handle-delete-file) (tramp-androidsu-handle-delete-file) (tramp-androidsu-handle-directory-file-name) (tramp-androidsu-handle-directory-files) (tramp-androidsu-adb-handle-directory-files-and-attributes) (tramp-androidsu-handle-directory-files-and-attributes) (tramp-androidsu-handle-dired-uncache) (tramp-androidsu-adb-handle-exec-path) (tramp-androidsu-handle-exec-path) (tramp-androidsu-handle-expand-file-name) (tramp-androidsu-handle-file-accessible-directory-p) (tramp-androidsu-adb-handle-file-attributes) (tramp-androidsu-handle-file-attributes) (tramp-androidsu-handle-file-directory-p) (tramp-androidsu-handle-file-equal-p) (tramp-androidsu-adb-handle-file-executable-p) (tramp-androidsu-handle-file-executable-p) (tramp-androidsu-adb-handle-file-exists-p) (tramp-androidsu-handle-file-exists-p) (tramp-androidsu-handle-file-group-gid) (tramp-androidsu-handle-file-in-directory-p) (tramp-androidsu-sh-handle-file-local-copy) (tramp-androidsu-handle-file-local-copy) (tramp-androidsu-handle-file-locked-p) (tramp-androidsu-handle-file-modes) (tramp-androidsu-adb-handle-file-name-all-completions) (tramp-androidsu-handle-file-name-all-completions) (tramp-androidsu-handle-file-name-as-directory) (tramp-androidsu-handle-file-name-case-insensitive-p) (tramp-androidsu-handle-file-name-completion) (tramp-androidsu-handle-file-name-directory) (tramp-androidsu-handle-file-name-nondirectory) (tramp-androidsu-handle-file-newer-than-file-p) (tramp-androidsu-handle-file-notify-add-watch) (tramp-androidsu-handle-file-notify-rm-watch) (tramp-androidsu-handle-file-notify-valid-p) (tramp-androidsu-adb-handle-file-readable-p) (tramp-androidsu-handle-file-readable-p) (tramp-androidsu-handle-file-regular-p) (tramp-androidsu-handle-file-remote-p) (tramp-androidsu-handle-file-selinux-context) (tramp-androidsu-handle-file-symlink-p) (tramp-androidsu-adb-handle-file-system-info) (tramp-androidsu-handle-file-system-info) (tramp-androidsu-handle-file-truename) (tramp-androidsu-handle-file-user-uid) (tramp-androidsu-adb-handle-file-writable-p) (tramp-androidsu-handle-file-writable-p) (tramp-androidsu-handle-find-backup-file-name) (tramp-androidsu-handle-insert-directory) (tramp-androidsu-handle-insert-file-contents) (tramp-androidsu-handle-list-system-processes) (tramp-androidsu-handle-load, tramp-androidsu-handle-lock-file) (tramp-androidsu-handle-make-auto-save-file-name) (tramp-androidsu-adb-handle-make-directory) (tramp-androidsu-handle-make-directory) (tramp-androidsu-handle-make-lock-file-name) (tramp-androidsu-handle-make-nearby-temp-file) (tramp-androidsu-make-process) (tramp-androidsu-sh-handle-make-symbolic-link) (tramp-androidsu-handle-make-symbolic-link) (tramp-androidsu-handle-memory-info) (tramp-androidsu-handle-process-attributes) (tramp-androidsu-adb-handle-process-file) (tramp-androidsu-handle-process-file) (tramp-androidsu-sh-handle-rename-file) (tramp-androidsu-handle-rename-file) (tramp-androidsu-adb-handle-set-file-modes) (tramp-androidsu-handle-set-file-modes) (tramp-androidsu-adb-handle-set-file-times) (tramp-androidsu-handle-set-file-times) (tramp-androidsu-handle-set-visited-file-modtime) (tramp-androidsu-handle-shell-command) (tramp-androidsu-handle-start-file-process) (tramp-androidsu-handle-substitute-in-file-name) (tramp-androidsu-handle-temporary-file-directory) (tramp-androidsu-adb-handle-get-remote-gid) (tramp-androidsu-handle-get-remote-gid) (tramp-androidsu-adb-handle-get-remote-groups) (tramp-androidsu-handle-get-remote-groups) (tramp-androidsu-adb-handle-get-remote-uid) (tramp-androidsu-handle-get-remote-uid) (tramp-androidsu-handle-unlock-file) (tramp-androidsu-handle-verify-visited-file-modtime) (tramp-androidsu-sh-handle-write-region) (tramp-androidsu-handle-write-region) (tramp-androidsu-file-name-handler-alist): Make hard-coded executable and file names defconsts, remove redundant wrapper functions and remove names of wrapped functions from their wrappers. --- doc/misc/tramp.texi | 19 ++- lisp/net/tramp-androidsu.el | 405 ++++++++++++++++---------------------------- 2 files changed, 152 insertions(+), 272 deletions(-) (limited to 'lisp') diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 09b875ad3fa..d67e2fcb64c 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -510,7 +510,6 @@ default host name. Therefore, it is convenient to open a file as The method @option{sg} stands for ``switch group''; here the user name is used as the group to change to. The default host name is the same. - @anchor{Quick Start Guide Combining ssh, plink, su, sudo and doas methods} @section Combining @option{ssh} or @option{plink} with @option{su}, @option{sudo} or @option{doas} @cindex method @option{ssh} @@ -523,8 +522,6 @@ is used as the group to change to. The default host name is the same. @cindex @option{sudo} method @cindex method @option{doas} @cindex @option{doas} method -@cindex method @option{androidsu} -@cindex @option{androidsu} method If the @option{su}, @option{sudo} or @option{doas} option should be performed on another host, it can be combined with a leading @@ -535,12 +532,6 @@ a simple case, the syntax looks like @file{@trampfn{ssh@value{postfixhop}user@@host|sudo,,/path/to/file}}. @xref{Ad-hoc multi-hops}. -The @option{su} method and other shell-based methods conflict with -non-standard @command{su} implementations popular among Android users -and the restricted command-line utilities distributed with that system. -The @option{androidsu} method enables accessing files through -@command{su} on such systems, but multi-hops are not supported. - @anchor{Quick Start Guide sudoedit method} @section Using @command{sudoedit} @cindex method @option{sudoedit} @@ -826,6 +817,16 @@ editing as another user. The host can be either @samp{localhost} or the host returned by the function @command{(system-name)}. See @ref{Multi-hops} for an exception to this behavior. +@cindex method @option{androidsu} +@cindex @option{androidsu} method +Because the default implementation of the @option{su} method and other +shell-based methods conflict with non-standard @command{su} +implementations popular among Android users and the restricted +command-line utilities distributed with that system, a largely +equivalent @option{androidsu} method is provided for that system with +workarounds for its many idiosyncrasies, with the exception that +multi-hops are unsupported. + @item @option{sudo} @cindex method @option{sudo} @cindex @option{sudo} method diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index 1623a0341b2..12453d40acd 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -1,7 +1,8 @@ -;;; tramp-androidsu.el --- TRAMP method for Android superuser shells -*- lexical-binding:t -*- +;;; tramp-androidsu.el --- Tramp method for Android superuser shells -*- lexical-binding:t -*- ;; Copyright (C) 2024 Free Software Foundation, Inc. +;; Author: Po Lu ;; Keywords: comm, processes ;; Package: tramp @@ -22,12 +23,15 @@ ;;; Commentary: +;; `su' method implementation for Android. +;; ;; The `su' method struggles (as do other shell-based methods) with the ;; crippled versions of many Unix utilities installed on Android, ;; workarounds for which are implemented in the `adb' method. This ;; method defines a shell-based method that is identical in function to -;; `su', but reuses such code from the `adb' method where applicable and -;; also provides for certain mannerisms of popular Android `su' +;; and replaces if connecting to a local Android machine `su', but +;; reuses such code from the `adb' method where applicable and also +;; provides for certain mannerisms of popular Android `su' ;; implementations. ;;; Code: @@ -43,33 +47,51 @@ ;;;###tramp-autoload (defcustom tramp-androidsu-mount-global-namespace t "When non-nil, browse files from within the global mount namespace. -On systems that assign each application a unique view of the filesystem -by executing them within individual mount namespaces and thus conceal -each application's data directories from others, invoke `su' with the -option `-mm' in order for the shell launched to run within the global -mount namespace, so that TRAMP may edit files belonging to any and all -applications." +On systems that assign each application a unique view of the +filesystem by executing them within individual mount namespaces +and thus conceal each application's data directories from +others, invoke `su' with the option `-mm' in order for the shell +launched to run within the global mount namespace, so that Tramp +may edit files belonging to any and all applications." :group 'tramp :version "30.1" :type 'boolean) +;;;###tramp-autoload +(defcustom tramp-androidsu-remote-path '("/system/bin" + "/system/xbin") + "Directories in which to search for transfer programs and the like." + :group 'tramp + :version "30.1" + :type '(list string)) + (defvar tramp-androidsu-su-mm-supported 'unknown "Whether `su -mm' is supported on this system.") +;;;###tramp-autoload +(defconst tramp-androidsu-local-shell-name "/system/bin/sh" + "Name of the local shell on Android.") + +;;;###tramp-autoload +(defconst tramp-androidsu-local-tmp-directory "/data/local/tmp" + "Name of the local temporary directory on Android.") + ;;;###tramp-autoload (tramp--with-startup (add-to-list 'tramp-methods `(,tramp-androidsu-method - (tramp-login-program "su") - (tramp-login-args (("-") ("%u"))) - (tramp-remote-shell "/system/bin/sh") - (tramp-remote-shell-login ("-l")) - (tramp-remote-shell-args ("-c")) - (tramp-tmpdir "/data/local/tmp") - (tramp-connection-timeout 10))) - + (tramp-login-program "su") + (tramp-login-args (("-") ("%u"))) + (tramp-remote-shell ,tramp-androidsu-local-shell-name) + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-c")) + (tramp-tmpdir ,tramp-androidsu-local-tmp-directory) + (tramp-connection-timeout 10) + (tramp-shell-name ,tramp-androidsu-local-shell-name))) (add-to-list 'tramp-default-host-alist - `(,tramp-androidsu-method nil "localhost"))) + `(,tramp-androidsu-method nil "localhost")) + (add-to-list 'tramp-default-user-alist + `(,tramp-androidsu-method nil ,tramp-root-id-string))) (defvar android-use-exec-loader) ; androidfns.c. @@ -112,15 +134,14 @@ multibyte mode and waits for the shell prompt to appear." ;; there's no guarantee that it's ;; possible to execute it with ;; `android-use-exec-loader' off. - "/system/bin/sh" "-i")) + tramp-androidsu-local-shell-name "-i")) (user (tramp-file-name-user vec)) command) ;; Set sentinel. Initialize variables. (set-process-sentinel p #'tramp-process-sentinel) (tramp-post-process-creation p vec) ;; Replace `login-args' place holders. - (setq command (format "exec su - %s || exit" - (or user "root"))) + (setq command (format "exec su - %s || exit" user)) (tramp-set-connection-property vec "remote-namespace" nil) ;; Attempt to execute the shell inside the global mount ;; namespace if requested. @@ -142,7 +163,7 @@ multibyte mode and waits for the shell prompt to appear." (tramp-set-connection-property vec "remote-namespace" t) (setq command (format "exec su -mm - %s || exit" - (or user "root")))))) + user))))) ;; Send the command. (tramp-message vec 3 "Sending command `%s'" command) (tramp-adb-send-command vec command t t) @@ -154,7 +175,6 @@ multibyte mode and waits for the shell prompt to appear." (with-current-buffer (process-buffer p) (tramp-wait-for-regexp p tramp-connection-timeout "#[[:space:]]*$")) - ;; Set connection-local variables. (tramp-set-connection-local-variables vec) ;; Change prompt. @@ -167,7 +187,8 @@ multibyte mode and waits for the shell prompt to appear." ;; Dump option settings in the traces. (when (>= tramp-verbose 9) (tramp-adb-send-command vec "set -o")) - ;; Disable Unicode. + ;; Disable Unicode, for otherwise Unicode filenames will + ;; not be decoded correctly. (tramp-adb-send-command vec "set +U") ;; Disable echo expansion. (tramp-adb-send-command @@ -188,8 +209,7 @@ multibyte mode and waits for the shell prompt to appear." t))) ;; Set the remote PATH to a suitable value. (tramp-set-connection-property vec "remote-path" - '("/system/bin" - "/system/xbin")) + tramp-androidsu-remote-path) ;; Mark it as connected. (tramp-set-connection-property p "connected" t)))) ;; Cleanup, and propagate the signal. @@ -223,163 +243,49 @@ FUNCTION." (fset 'tramp-adb-wait-for-output tramp-adb-wait-for-output) (fset 'tramp-adb-maybe-open-connection tramp-adb-maybe-open-connection))))) -(defalias 'tramp-androidsu-handle-access-file - (tramp-androidsu-generate-wrapper #'tramp-handle-access-file)) - -(defalias 'tramp-androidsu-handle-add-name-to-file - (tramp-androidsu-generate-wrapper #'tramp-handle-add-name-to-file)) - -(defalias 'tramp-androidsu-handle-copy-directory - (tramp-androidsu-generate-wrapper #'tramp-handle-copy-directory)) - -(defalias 'tramp-androidsu-sh-handle-copy-file +(defalias 'tramp-androidsu-handle-copy-file (tramp-androidsu-generate-wrapper #'tramp-sh-handle-copy-file)) -(defalias 'tramp-androidsu-adb-handle-delete-directory +(defalias 'tramp-androidsu-handle-delete-directory (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-directory)) -(defalias 'tramp-androidsu-adb-handle-delete-file +(defalias 'tramp-androidsu-handle-delete-file (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-file)) -(defalias 'tramp-androidsu-handle-directory-file-name - (tramp-androidsu-generate-wrapper #'tramp-handle-directory-file-name)) - -(defalias 'tramp-androidsu-handle-directory-files - (tramp-androidsu-generate-wrapper #'tramp-handle-directory-files)) - -(defalias 'tramp-androidsu-adb-handle-directory-files-and-attributes +(defalias 'tramp-androidsu-handle-directory-files-and-attributes (tramp-androidsu-generate-wrapper #'tramp-adb-handle-directory-files-and-attributes)) -(defalias 'tramp-androidsu-handle-dired-uncache - (tramp-androidsu-generate-wrapper #'tramp-handle-dired-uncache)) - -(defalias 'tramp-androidsu-adb-handle-exec-path +(defalias 'tramp-androidsu-handle-exec-path (tramp-androidsu-generate-wrapper #'tramp-adb-handle-exec-path)) -(defalias 'tramp-androidsu-handle-expand-file-name - (tramp-androidsu-generate-wrapper #'tramp-handle-expand-file-name)) - -(defalias 'tramp-androidsu-handle-file-accessible-directory-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-accessible-directory-p)) - -(defalias 'tramp-androidsu-adb-handle-file-attributes +(defalias 'tramp-androidsu-handle-file-attributes (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-attributes)) -(defalias 'tramp-androidsu-handle-file-directory-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-directory-p)) - -(defalias 'tramp-androidsu-handle-file-equal-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-equal-p)) - -(defalias 'tramp-androidsu-adb-handle-file-executable-p +(defalias 'tramp-androidsu-handle-file-executable-p (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-executable-p)) -(defalias 'tramp-androidsu-adb-handle-file-exists-p +(defalias 'tramp-androidsu-handle-file-exists-p (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-exists-p)) -(defalias 'tramp-androidsu-handle-file-group-gid - (tramp-androidsu-generate-wrapper #'tramp-handle-file-group-gid)) - -(defalias 'tramp-androidsu-handle-file-in-directory-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-in-directory-p)) - -(defalias 'tramp-androidsu-sh-handle-file-local-copy +(defalias 'tramp-androidsu-handle-file-local-copy (tramp-androidsu-generate-wrapper #'tramp-sh-handle-file-local-copy)) -(defalias 'tramp-androidsu-handle-file-locked-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-locked-p)) - -(defalias 'tramp-androidsu-handle-file-modes - (tramp-androidsu-generate-wrapper #'tramp-handle-file-modes)) - -(defalias 'tramp-androidsu-adb-handle-file-name-all-completions +(defalias 'tramp-androidsu-handle-file-name-all-completions (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-name-all-completions)) -(defalias 'tramp-androidsu-handle-file-name-as-directory - (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-as-directory)) - -(defalias 'tramp-androidsu-handle-file-name-case-insensitive-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-case-insensitive-p)) - -(defalias 'tramp-androidsu-handle-file-name-completion - (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-completion)) - -(defalias 'tramp-androidsu-handle-file-name-directory - (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-directory)) - -(defalias 'tramp-androidsu-handle-file-name-nondirectory - (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-nondirectory)) - -(defalias 'tramp-androidsu-handle-file-newer-than-file-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-newer-than-file-p)) - -(defalias 'tramp-androidsu-handle-file-notify-add-watch - (tramp-androidsu-generate-wrapper #'tramp-handle-file-notify-add-watch)) - -(defalias 'tramp-androidsu-handle-file-notify-rm-watch - (tramp-androidsu-generate-wrapper #'tramp-handle-file-notify-rm-watch)) - -(defalias 'tramp-androidsu-handle-file-notify-valid-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-notify-valid-p)) - -(defalias 'tramp-androidsu-adb-handle-file-readable-p +(defalias 'tramp-androidsu-handle-file-readable-p (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-readable-p)) -(defalias 'tramp-androidsu-handle-file-regular-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-regular-p)) - -(defalias 'tramp-androidsu-handle-file-remote-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-remote-p)) - -(defalias 'tramp-androidsu-handle-file-selinux-context - (tramp-androidsu-generate-wrapper #'tramp-handle-file-selinux-context)) - -(defalias 'tramp-androidsu-handle-file-symlink-p - (tramp-androidsu-generate-wrapper #'tramp-handle-file-symlink-p)) - -(defalias 'tramp-androidsu-adb-handle-file-system-info +(defalias 'tramp-androidsu-handle-file-system-info (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-system-info)) -(defalias 'tramp-androidsu-handle-file-truename - (tramp-androidsu-generate-wrapper #'tramp-handle-file-truename)) - -(defalias 'tramp-androidsu-handle-file-user-uid - (tramp-androidsu-generate-wrapper #'tramp-handle-file-user-uid)) - -(defalias 'tramp-androidsu-adb-handle-file-writable-p +(defalias 'tramp-androidsu-handle-file-writable-p (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-writable-p)) -(defalias 'tramp-androidsu-handle-find-backup-file-name - (tramp-androidsu-generate-wrapper #'tramp-handle-find-backup-file-name)) - -(defalias 'tramp-androidsu-handle-insert-directory - (tramp-androidsu-generate-wrapper #'tramp-handle-insert-directory)) - -(defalias 'tramp-androidsu-handle-insert-file-contents - (tramp-androidsu-generate-wrapper #'tramp-handle-insert-file-contents)) - -(defalias 'tramp-androidsu-handle-list-system-processes - (tramp-androidsu-generate-wrapper #'tramp-handle-list-system-processes)) - -(defalias 'tramp-androidsu-handle-load - (tramp-androidsu-generate-wrapper #'tramp-handle-load)) - -(defalias 'tramp-androidsu-handle-lock-file - (tramp-androidsu-generate-wrapper #'tramp-handle-lock-file)) - -(defalias 'tramp-androidsu-handle-make-auto-save-file-name - (tramp-androidsu-generate-wrapper #'tramp-handle-make-auto-save-file-name)) - -(defalias 'tramp-androidsu-adb-handle-make-directory +(defalias 'tramp-androidsu-handle-make-directory (tramp-androidsu-generate-wrapper #'tramp-adb-handle-make-directory)) -(defalias 'tramp-androidsu-handle-make-lock-file-name - (tramp-androidsu-generate-wrapper #'tramp-handle-make-lock-file-name)) - -(defalias 'tramp-androidsu-handle-make-nearby-temp-file - (tramp-androidsu-generate-wrapper #'tramp-handle-make-nearby-temp-file)) - -(defun tramp-androidsu-make-process (&rest args) +(defun tramp-androidsu-handle-make-process (&rest args) "Like `tramp-handle-make-process', but modified for Android." (when args (with-parsed-tramp-file-name (expand-file-name default-directory) nil @@ -493,150 +399,123 @@ FUNCTION." (tramp-taint-remote-process-buffer stderr)) p))))) -(defalias 'tramp-androidsu-sh-handle-make-symbolic-link +(defalias 'tramp-androidsu-handle-make-symbolic-link (tramp-androidsu-generate-wrapper #'tramp-sh-handle-make-symbolic-link)) -(defalias 'tramp-androidsu-handle-memory-info - (tramp-androidsu-generate-wrapper #'tramp-handle-memory-info)) - -(defalias 'tramp-androidsu-handle-process-attributes - (tramp-androidsu-generate-wrapper #'tramp-handle-process-attributes)) - -(defalias 'tramp-androidsu-adb-handle-process-file +(defalias 'tramp-androidsu-handle-process-file (tramp-androidsu-generate-wrapper #'tramp-adb-handle-process-file)) -(defalias 'tramp-androidsu-sh-handle-rename-file +(defalias 'tramp-androidsu-handle-rename-file (tramp-androidsu-generate-wrapper #'tramp-sh-handle-rename-file)) -(defalias 'tramp-androidsu-adb-handle-set-file-modes +(defalias 'tramp-androidsu-handle-set-file-modes (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-modes)) -(defalias 'tramp-androidsu-adb-handle-set-file-times +(defalias 'tramp-androidsu-handle-set-file-times (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-times)) -(defalias 'tramp-androidsu-handle-set-visited-file-modtime - (tramp-androidsu-generate-wrapper #'tramp-handle-set-visited-file-modtime)) - -(defalias 'tramp-androidsu-handle-shell-command - (tramp-androidsu-generate-wrapper #'tramp-handle-shell-command)) - -(defalias 'tramp-androidsu-handle-start-file-process - (tramp-androidsu-generate-wrapper #'tramp-handle-start-file-process)) - -(defalias 'tramp-androidsu-handle-substitute-in-file-name - (tramp-androidsu-generate-wrapper #'tramp-handle-substitute-in-file-name)) - -(defalias 'tramp-androidsu-handle-temporary-file-directory - (tramp-androidsu-generate-wrapper #'tramp-handle-temporary-file-directory)) - -(defalias 'tramp-androidsu-adb-handle-get-remote-gid +(defalias 'tramp-androidsu-handle-get-remote-gid (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-gid)) -(defalias 'tramp-androidsu-adb-handle-get-remote-groups +(defalias 'tramp-androidsu-handle-get-remote-groups (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-groups)) -(defalias 'tramp-androidsu-adb-handle-get-remote-uid +(defalias 'tramp-androidsu-handle-get-remote-uid (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-uid)) -(defalias 'tramp-androidsu-handle-unlock-file - (tramp-androidsu-generate-wrapper #'tramp-handle-unlock-file)) - -(defalias 'tramp-androidsu-handle-verify-visited-file-modtime - (tramp-androidsu-generate-wrapper #'tramp-handle-verify-visited-file-modtime)) - -(defalias 'tramp-androidsu-sh-handle-write-region +(defalias 'tramp-androidsu-handle-write-region (tramp-androidsu-generate-wrapper #'tramp-sh-handle-write-region)) ;;;###tramp-autoload (defconst tramp-androidsu-file-name-handler-alist '(;; `abbreviate-file-name' performed by default handler. - (access-file . tramp-androidsu-handle-access-file) - (add-name-to-file . tramp-androidsu-handle-add-name-to-file) + (access-file . tramp-handle-access-file) + (add-name-to-file . tramp-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. - (copy-directory . tramp-androidsu-handle-copy-directory) - (copy-file . tramp-androidsu-sh-handle-copy-file) - (delete-directory . tramp-androidsu-adb-handle-delete-directory) - (delete-file . tramp-androidsu-adb-handle-delete-file) + (copy-directory . tramp-handle-copy-directory) + (copy-file . tramp-androidsu-handle-copy-file) + (delete-directory . tramp-androidsu-handle-delete-directory) + (delete-file . tramp-androidsu-handle-delete-file) ;; `diff-latest-backup-file' performed by default handler. - (directory-file-name . tramp-androidsu-handle-directory-file-name) - (directory-files . tramp-androidsu-handle-directory-files) + (directory-file-name . tramp-handle-directory-file-name) + (directory-files . tramp-handle-directory-files) (directory-files-and-attributes - . tramp-androidsu-adb-handle-directory-files-and-attributes) + . tramp-androidsu-handle-directory-files-and-attributes) (dired-compress-file . ignore) - (dired-uncache . tramp-androidsu-handle-dired-uncache) - (exec-path . tramp-androidsu-adb-handle-exec-path) - (expand-file-name . tramp-androidsu-handle-expand-file-name) - (file-accessible-directory-p . tramp-androidsu-handle-file-accessible-directory-p) + (dired-uncache . tramp-handle-dired-uncache) + (exec-path . tramp-androidsu-handle-exec-path) + (expand-file-name . tramp-handle-expand-file-name) + (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) (file-acl . ignore) - (file-attributes . tramp-androidsu-adb-handle-file-attributes) - (file-directory-p . tramp-androidsu-handle-file-directory-p) - (file-equal-p . tramp-androidsu-handle-file-equal-p) - (file-executable-p . tramp-androidsu-adb-handle-file-executable-p) - (file-exists-p . tramp-androidsu-adb-handle-file-exists-p) - (file-group-gid . tramp-androidsu-handle-file-group-gid) - (file-in-directory-p . tramp-androidsu-handle-file-in-directory-p) - (file-local-copy . tramp-androidsu-sh-handle-file-local-copy) - (file-locked-p . tramp-androidsu-handle-file-locked-p) - (file-modes . tramp-androidsu-handle-file-modes) - (file-name-all-completions . tramp-androidsu-adb-handle-file-name-all-completions) - (file-name-as-directory . tramp-androidsu-handle-file-name-as-directory) - (file-name-case-insensitive-p . tramp-androidsu-handle-file-name-case-insensitive-p) - (file-name-completion . tramp-androidsu-handle-file-name-completion) - (file-name-directory . tramp-androidsu-handle-file-name-directory) - (file-name-nondirectory . tramp-androidsu-handle-file-name-nondirectory) + (file-attributes . tramp-androidsu-handle-file-attributes) + (file-directory-p . tramp-handle-file-directory-p) + (file-equal-p . tramp-handle-file-equal-p) + (file-executable-p . tramp-androidsu-handle-file-executable-p) + (file-exists-p . tramp-androidsu-handle-file-exists-p) + (file-group-gid . tramp-handle-file-group-gid) + (file-in-directory-p . tramp-handle-file-in-directory-p) + (file-local-copy . tramp-androidsu-handle-file-local-copy) + (file-locked-p . tramp-handle-file-locked-p) + (file-modes . tramp-handle-file-modes) + (file-name-all-completions . tramp-androidsu-handle-file-name-all-completions) + (file-name-as-directory . tramp-handle-file-name-as-directory) + (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p) + (file-name-completion . tramp-handle-file-name-completion) + (file-name-directory . tramp-handle-file-name-directory) + (file-name-nondirectory . tramp-handle-file-name-nondirectory) ;; `file-name-sans-versions' performed by default handler. - (file-newer-than-file-p . tramp-androidsu-handle-file-newer-than-file-p) - (file-notify-add-watch . tramp-androidsu-handle-file-notify-add-watch) - (file-notify-rm-watch . tramp-androidsu-handle-file-notify-rm-watch) - (file-notify-valid-p . tramp-androidsu-handle-file-notify-valid-p) + (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) + (file-notify-add-watch . tramp-handle-file-notify-add-watch) + (file-notify-rm-watch . tramp-handle-file-notify-rm-watch) + (file-notify-valid-p . tramp-handle-file-notify-valid-p) (file-ownership-preserved-p . ignore) - (file-readable-p . tramp-androidsu-adb-handle-file-readable-p) - (file-regular-p . tramp-androidsu-handle-file-regular-p) - (file-remote-p . tramp-androidsu-handle-file-remote-p) - (file-selinux-context . tramp-androidsu-handle-file-selinux-context) - (file-symlink-p . tramp-androidsu-handle-file-symlink-p) - (file-system-info . tramp-androidsu-adb-handle-file-system-info) - (file-truename . tramp-androidsu-handle-file-truename) - (file-user-uid . tramp-androidsu-handle-file-user-uid) - (file-writable-p . tramp-androidsu-adb-handle-file-writable-p) - (find-backup-file-name . tramp-androidsu-handle-find-backup-file-name) + (file-readable-p . tramp-androidsu-handle-file-readable-p) + (file-regular-p . tramp-handle-file-regular-p) + (file-remote-p . tramp-handle-file-remote-p) + (file-selinux-context . tramp-handle-file-selinux-context) + (file-symlink-p . tramp-handle-file-symlink-p) + (file-system-info . tramp-androidsu-handle-file-system-info) + (file-truename . tramp-handle-file-truename) + (file-user-uid . tramp-handle-file-user-uid) + (file-writable-p . tramp-androidsu-handle-file-writable-p) + (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. - (insert-directory . tramp-androidsu-handle-insert-directory) - (insert-file-contents . tramp-androidsu-handle-insert-file-contents) - (list-system-processes . tramp-androidsu-handle-list-system-processes) - (load . tramp-androidsu-handle-load) - (lock-file . tramp-androidsu-handle-lock-file) - (make-auto-save-file-name . tramp-androidsu-handle-make-auto-save-file-name) - (make-directory . tramp-androidsu-adb-handle-make-directory) + (insert-directory . tramp-handle-insert-directory) + (insert-file-contents . tramp-handle-insert-file-contents) + (list-system-processes . tramp-handle-list-system-processes) + (load . tramp-handle-load) + (lock-file . tramp-handle-lock-file) + (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) + (make-directory . tramp-androidsu-handle-make-directory) (make-directory-internal . ignore) - (make-lock-file-name . tramp-androidsu-handle-make-lock-file-name) - (make-nearby-temp-file . tramp-androidsu-handle-make-nearby-temp-file) - (make-process . tramp-androidsu-make-process) - (make-symbolic-link . tramp-androidsu-sh-handle-make-symbolic-link) - (memory-info . tramp-androidsu-handle-memory-info) - (process-attributes . tramp-androidsu-handle-process-attributes) - (process-file . tramp-androidsu-adb-handle-process-file) - (rename-file . tramp-androidsu-sh-handle-rename-file) + (make-lock-file-name . tramp-handle-make-lock-file-name) + (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) + (make-process . tramp-androidsu-handle-make-process) + (make-symbolic-link . tramp-androidsu-handle-make-symbolic-link) + (memory-info . tramp-handle-memory-info) + (process-attributes . tramp-handle-process-attributes) + (process-file . tramp-androidsu-handle-process-file) + (rename-file . tramp-androidsu-handle-rename-file) (set-file-acl . ignore) - (set-file-modes . tramp-androidsu-adb-handle-set-file-modes) + (set-file-modes . tramp-androidsu-handle-set-file-modes) (set-file-selinux-context . ignore) - (set-file-times . tramp-androidsu-adb-handle-set-file-times) - (set-visited-file-modtime . tramp-androidsu-handle-set-visited-file-modtime) - (shell-command . tramp-androidsu-handle-shell-command) - (start-file-process . tramp-androidsu-handle-start-file-process) - (substitute-in-file-name . tramp-androidsu-handle-substitute-in-file-name) - (temporary-file-directory . tramp-androidsu-handle-temporary-file-directory) + (set-file-times . tramp-androidsu-handle-set-file-times) + (set-visited-file-modtime . tramp-handle-set-visited-file-modtime) + (shell-command . tramp-handle-shell-command) + (start-file-process . tramp-handle-start-file-process) + (substitute-in-file-name . tramp-handle-substitute-in-file-name) + (temporary-file-directory . tramp-handle-temporary-file-directory) (tramp-get-home-directory . ignore) - (tramp-get-remote-gid . tramp-androidsu-adb-handle-get-remote-gid) - (tramp-get-remote-groups . tramp-androidsu-adb-handle-get-remote-groups) - (tramp-get-remote-uid . tramp-androidsu-adb-handle-get-remote-uid) + (tramp-get-remote-gid . tramp-androidsu-handle-get-remote-gid) + (tramp-get-remote-groups . tramp-androidsu-handle-get-remote-groups) + (tramp-get-remote-uid . tramp-androidsu-handle-get-remote-uid) (tramp-set-file-uid-gid . ignore) (unhandled-file-name-directory . ignore) - (unlock-file . tramp-androidsu-handle-unlock-file) + (unlock-file . tramp-handle-unlock-file) (vc-registered . ignore) - (verify-visited-file-modtime . tramp-androidsu-handle-verify-visited-file-modtime) - (write-region . tramp-androidsu-sh-handle-write-region)) + (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) + (write-region . tramp-androidsu-handle-write-region)) "Alist of TRAMP handler functions for superuser sessions on Android.") ;; It must be a `defsubst' in order to push the whole code into @@ -669,7 +548,7 @@ arguments to pass to the OPERATION." (with-eval-after-load 'shell (connection-local-set-profiles - `(:application tramp :protocol ,tramp-adb-method) + `(:application tramp :protocol ,tramp-androidsu-method) 'tramp-adb-connection-local-default-shell-profile 'tramp-adb-connection-local-default-ps-profile)) -- cgit v1.2.3 From 2b5d43081a30f816dd38a16c7b5bfbad712a779b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 3 Mar 2024 23:08:16 -0500 Subject: (major-mode-remap(-defaults)): New var and function (bug#69191) While `major-mode-remap-alist` provides a way for users to indicate the major mode of their choice, we need a similar variable for the use of packages. This patch adds a new `major-mode-remap-defaults` and changes various packages to obey it or make use of it. I think it nicely cleans the regexp duplication between CC-mode and `c-ts-mode.el` and also makes it easier/cleaner for users to override the changes made by `*-ts-mode.el`. * lisp/files.el (major-mode-remap-defaults): New variable. (major-mode-remap): New function. (set-auto-mode-0): Use it. * doc/lispref/modes.texi (Auto Major Mode): Document them. * lisp/textmodes/tex-mode.el (tex--redirect-to-submode): Use `major-mode-remap`. (major-mode-remap-defaults): Set it to remap AUCTeX modes by default. * lisp/progmodes/ruby-ts-mode.el (auto-mode-alist): Leave it alone. (major-mode-remap-defaults): Set this one instead. * lisp/progmodes/c-ts-mode.el (c-or-c++-ts-mode): Use `major-mode-remap`. (auto-mode-alist): Leave it alone. (major-mode-remap-defaults): Set this one instead. * lisp/org/ox.el (org-export-to-buffer): Modernize docstring accordingly. * lisp/progmodes/cc-mode.el (c-or-c++-mode): * lisp/org/ox-latex.el (org-latex-export-as-latex): * lisp/org/ox-koma-letter.el (org-koma-letter-export-as-latex): * lisp/org/ox-beamer.el (org-beamer-export-as-latex): Use `major-mode-remap` when available. --- doc/lispref/modes.texi | 33 +++++++++++++++++++++++++++++++ etc/NEWS | 4 ++++ lisp/files.el | 19 +++++++++++++++--- lisp/org/ox-beamer.el | 5 ++++- lisp/org/ox-koma-letter.el | 4 +++- lisp/org/ox-latex.el | 5 ++++- lisp/org/ox.el | 2 +- lisp/progmodes/c-ts-mode.el | 44 +++++++++++++++++++----------------------- lisp/progmodes/cc-mode.el | 22 ++++++++++++--------- lisp/progmodes/go-ts-mode.el | 2 ++ lisp/progmodes/ruby-ts-mode.el | 14 ++------------ lisp/textmodes/tex-mode.el | 18 +++++++++++------ 12 files changed, 114 insertions(+), 58 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index a2e8f42cf1d..b034fecd77b 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -791,6 +791,39 @@ init file.) @end smallexample @end defvar +@defvar major-mode-remap-defaults +This variable contains an association list indicating which function +to call to activate a given major mode. This is used for file formats +that can be supported by various major modes, where this variable can be +used to indicate which alternative should be used by default. + +For example, a third-party package providing a much improved Pascal +major mode, can use the following to tell @code{normal-mode} to use +@code{spiffy-pascal-mode} for all the files that would normally use @code{pascal-mode}: + +@smallexample +@group +(add-to-list 'major-mode-remap-defaults '(pascal-mode . spiffy-pascal-mode)) +@end group +@end smallexample + +This variable has the same format as @code{major-mode-remap-alist}. +If both lists match a major mode, the entry in +@code{major-mode-remap-alist} takes precedence. +@end defvar + +@defun major-mode-remap mode +This function returns the major mode to use instead of @var{mode} +according to @code{major-mode-remap-alist} and +@code{major-mode-remap-defaults}. It returns @var{mode} if the mode +is not remapped by those variables. + +When a package wants to activate a major mode for a particular file +format, it should use this function, passing as @code{mode} argument the +canonical major mode for that file format, to find which specific major +mode to activate, so as to take into account the user's preferences. +@end defun + @node Mode Help @subsection Getting Help about a Major Mode @cindex mode help diff --git a/etc/NEWS b/etc/NEWS index 792e178c3b6..41bff184676 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1595,6 +1595,10 @@ values. * Lisp Changes in Emacs 30.1 +** New var 'major-mode-remap-defaults' and function 'major-mode-remap'. +The first is like Emacs-29's 'major-mode-remap-alist' but to be set by +packages (instead of users). The second looks up those two variables. + +++ ** Pcase's functions (in 'pred' and 'app') can specify the argument position. For example, instead of '(pred (< 5))' you can write '(pred (> _ 5))'. diff --git a/lisp/files.el b/lisp/files.el index ed18bc5841e..dd7580b6580 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3413,7 +3413,7 @@ checks if it uses an interpreter listed in `interpreter-mode-alist', matches the buffer beginning against `magic-mode-alist', compares the file name against the entries in `auto-mode-alist', then matches the buffer beginning against `magic-fallback-mode-alist'. -It also obeys `major-mode-remap-alist'. +It also obeys `major-mode-remap-alist' and `major-mode-remap-defaults'. If `enable-local-variables' is nil, or if the file name matches `inhibit-local-variables-regexps', this function does not check @@ -3559,9 +3559,22 @@ we don't actually set it to the same mode the buffer already has." Every entry is of the form (MODE . FUNCTION) which means that in order to activate the major mode MODE (specified via something like `auto-mode-alist', file-local variables, ...) we should actually call -FUNCTION instead." +FUNCTION instead. +FUNCTION can be nil to hide other entries (either in this var or in +`major-mode-remap-defaults') and means that we should call MODE." :type '(alist (symbol) (function))) +(defvar major-mode-remap-defaults nil + "Alist mapping file-specified mode to actual mode. +This works like `major-mode-remap-alist' except it has lower priority +and it is meant to be modified by packages rather than users.") + +(defun major-mode-remap (mode) + "Return the function to use to enable MODE." + (or (cdr (or (assq mode major-mode-remap-alist) + (assq mode major-mode-remap-defaults))) + mode)) + ;; When `keep-mode-if-same' is set, we are working on behalf of ;; set-visited-file-name. In that case, if the major mode specified is the ;; same one we already have, don't actually reset it. We don't want to lose @@ -3578,7 +3591,7 @@ same, do nothing and return nil." (eq mode (car set-auto-mode--last)) (eq major-mode (cdr set-auto-mode--last))))) (when mode - (funcall (alist-get mode major-mode-remap-alist mode)) + (funcall (major-mode-remap mode)) (unless (eq mode major-mode) (setq set-auto-mode--last (cons mode major-mode))) mode))) diff --git a/lisp/org/ox-beamer.el b/lisp/org/ox-beamer.el index 3d4d998432d..d3a90179d73 100644 --- a/lisp/org/ox-beamer.el +++ b/lisp/org/ox-beamer.el @@ -1008,7 +1008,10 @@ will be displayed when `org-export-show-temporary-export-buffer' is non-nil." (interactive) (org-export-to-buffer 'beamer "*Org BEAMER Export*" - async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) + async subtreep visible-only body-only ext-plist + (if (fboundp 'major-mode-remap) + (major-mode-remap 'latex-mode) + #'LaTeX-mode))) ;;;###autoload (defun org-beamer-export-to-latex diff --git a/lisp/org/ox-koma-letter.el b/lisp/org/ox-koma-letter.el index aef25232c20..38460d1749e 100644 --- a/lisp/org/ox-koma-letter.el +++ b/lisp/org/ox-koma-letter.el @@ -911,7 +911,9 @@ non-nil." (let (org-koma-letter-special-contents) (org-export-to-buffer 'koma-letter "*Org KOMA-LETTER Export*" async subtreep visible-only body-only ext-plist - (lambda () (LaTeX-mode))))) + (if (fboundp 'major-mode-remap) + (major-mode-remap 'latex-mode) + #'LaTeX-mode)))) ;;;###autoload (defun org-koma-letter-export-to-latex diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index bca387e5935..98b388081ea 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -4160,7 +4160,10 @@ will be displayed when `org-export-show-temporary-export-buffer' is non-nil." (interactive) (org-export-to-buffer 'latex "*Org LATEX Export*" - async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) + async subtreep visible-only body-only ext-plist + (if (fboundp 'major-mode-remap) + (major-mode-remap 'latex-mode) + #'LaTeX-mode))) ;;;###autoload (defun org-latex-convert-region-to-latex () diff --git a/lisp/org/ox.el b/lisp/org/ox.el index 19bf559c9e7..8e2fdd22acd 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -6608,7 +6608,7 @@ use it to set a major mode there, e.g., (interactive) (org-export-to-buffer \\='latex \"*Org LATEX Export*\" async subtreep visible-only body-only ext-plist - #\\='LaTeX-mode)) + (major-mode-remap 'latex-mode))) When expressed as an anonymous function, using `lambda', POST-PROCESS needs to be quoted. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 4ef17daf876..315bb68699e 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -1190,7 +1190,6 @@ BEG and END are described in `treesit-range-rules'." "C-c C-c" #'comment-region "C-c C-k" #'c-ts-mode-toggle-comment-style) -;;;###autoload (define-derived-mode c-ts-base-mode prog-mode "C" "Major mode for editing C, powered by tree-sitter. @@ -1439,36 +1438,33 @@ should be used. This function attempts to use file contents to determine whether the code is C or C++ and based on that chooses whether to enable `c-ts-mode' or `c++-ts-mode'." + (declare (obsolete c-or-c++-mode "30.1"))? (interactive) - (if (save-excursion - (save-restriction - (save-match-data ; Why `save-match-data'? - (widen) - (goto-char (point-min)) - (re-search-forward c-ts-mode--c-or-c++-regexp nil t)))) - (c++-ts-mode) - (c-ts-mode))) + (let ((mode + (if (save-excursion + (save-restriction + (save-match-data ; Why `save-match-data'? + (widen) + (goto-char (point-min)) + (re-search-forward c-ts-mode--c-or-c++-regexp nil t)))) + 'c++-ts-mode) + 'c-ts-mode)) + (funcall (major-mode-remap mode)))) + ;; The entries for C++ must come first to prevent *.c files be taken ;; as C++ on case-insensitive filesystems, since *.C files are C++, ;; not C. (if (treesit-ready-p 'cpp) - (add-to-list 'auto-mode-alist - '("\\(\\.ii\\|\\.\\(CC?\\|HH?\\)\\|\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\|\\.\\(cc\\|hh\\)\\)\\'" - . c++-ts-mode))) + (add-to-list 'major-mode-remap-defaults + '(c++-mode . c++-ts-mode))) (when (treesit-ready-p 'c) - (add-to-list 'auto-mode-alist - '("\\(\\.[chi]\\|\\.lex\\|\\.y\\(acc\\)?\\)\\'" . c-ts-mode)) - (add-to-list 'auto-mode-alist '("\\.x[pb]m\\'" . c-ts-mode)) - ;; image-mode's association must be before the C mode, otherwise XPM - ;; images will be initially visited as C files. Also note that the - ;; regexp must be different from what files.el does, or else - ;; add-to-list will not add the association where we want it. - (add-to-list 'auto-mode-alist '("\\.x[pb]m\\'" . image-mode))) - -(if (and (treesit-ready-p 'cpp) - (treesit-ready-p 'c)) - (add-to-list 'auto-mode-alist '("\\.h\\'" . c-or-c++-ts-mode))) + (add-to-list 'major-mode-remap-defaults '(c++-mode . c++-ts-mode)) + (add-to-list 'major-mode-remap-defaults '(c-mode . c-ts-mode))) + +(when (and (treesit-ready-p 'cpp) + (treesit-ready-p 'c)) + (add-to-list 'major-mode-remap-defaults '(c-or-c++-mode . c-or-c++-ts-mode))) (provide 'c-ts-mode) (provide 'c++-ts-mode) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 64a679eacc7..e46ac2e2178 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -2902,15 +2902,19 @@ This function attempts to use file contents to determine whether the code is C or C++ and based on that chooses whether to enable `c-mode' or `c++-mode'." (interactive) - (if (save-excursion - (save-restriction - (save-match-data - (widen) - (goto-char (point-min)) - (re-search-forward c-or-c++-mode--regexp - (+ (point) c-guess-region-max) t)))) - (c++-mode) - (c-mode))) + (let ((mode + (if (save-excursion + (save-restriction + (save-match-data + (widen) + (goto-char (point-min)) + (re-search-forward c-or-c++-mode--regexp + (+ (point) c-guess-region-max) t)))) + 'c++-mode) + 'c-mode)) + (funcall (if (fboundp 'major-mode-remap) + (major-mode-remap mode) + mode)))) ;; Support for C++ diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index 65adc1c55ea..296e4d0037d 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -262,6 +262,8 @@ (treesit-major-mode-setup))) (if (treesit-ready-p 'go) + ;; FIXME: Should we instead put `go-mode' in `auto-mode-alist' + ;; and then use `major-mode-remap-defaults' to map it to `go-ts-mode'? (add-to-list 'auto-mode-alist '("\\.go\\'" . go-ts-mode))) (defun go-ts-mode--defun-name (node &optional skip-prefix) diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 426ae248cac..cdfa3dca498 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -1211,18 +1211,8 @@ leading double colon is not added." (setq-local syntax-propertize-function #'ruby-ts--syntax-propertize)) (if (treesit-ready-p 'ruby) - ;; Copied from ruby-mode.el. - (add-to-list 'auto-mode-alist - (cons (concat "\\(?:\\.\\(?:" - "rbw?\\|ru\\|rake\\|thor" - "\\|jbuilder\\|rabl\\|gemspec\\|podspec" - "\\)" - "\\|/" - "\\(?:Gem\\|Rake\\|Cap\\|Thor" - "\\|Puppet\\|Berks\\|Brew" - "\\|Vagrant\\|Guard\\|Pod\\)file" - "\\)\\'") - 'ruby-ts-mode))) + (add-to-list 'major-mode-remap-defaults + '(ruby-mode . ruby-ts-mode))) (provide 'ruby-ts-mode) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 616b8871090..02ee1242c72 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1036,14 +1036,20 @@ says which mode to use." ;; `tex--guess-mode' really tries to guess the *type* of file, ;; so we still need to consult `major-mode-remap-alist' ;; to see which mode to use for that type. - (alist-get mode major-mode-remap-alist mode)))))) + (major-mode-remap mode)))))) -;; The following three autoloaded aliases appear to conflict with -;; AUCTeX. We keep those confusing aliases for those users who may -;; have files annotated with -*- LaTeX -*- (e.g. because they received +;; Support files annotated with -*- LaTeX -*- (e.g. because they received ;; them from someone using AUCTeX). -;; FIXME: Turn them into autoloads so that AUCTeX can override them -;; with its own autoloads? Or maybe rely on `major-mode-remap-alist'? +;;;###autoload (add-to-list 'major-mode-remap-defaults '(TeX-mode . tex-mode)) +;;;###autoload (add-to-list 'major-mode-remap-defaults '(plain-TeX-mode . plain-tex-mode)) +;;;###autoload (add-to-list 'major-mode-remap-defaults '(LaTeX-mode . latex-mode)) + +;; FIXME: These aliases conflict with AUCTeX, but we still need them +;; because of packages out there which call these functions directly. +;; They should be patched to use `major-mode-remap'. +;; It would be nice to mark them obsolete somehow to encourage using +;; something else, but the obsolete declaration would become invalid +;; and confusing when AUCTeX *is* installed. ;;;###autoload (defalias 'TeX-mode #'tex-mode) ;;;###autoload (defalias 'plain-TeX-mode #'plain-tex-mode) ;;;###autoload (defalias 'LaTeX-mode #'latex-mode) -- cgit v1.2.3 From 6dacb60bb135dbb002c2ce1c70f70430c5d1bbff Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Mon, 4 Mar 2024 07:19:22 +0100 Subject: ; Fix last major-mode-remap-defaults change. --- lisp/org/ox.el | 2 +- lisp/progmodes/c-ts-mode.el | 6 +++--- lisp/progmodes/cc-mode.el | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/org/ox.el b/lisp/org/ox.el index 8e2fdd22acd..bf2d9b569af 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -6608,7 +6608,7 @@ use it to set a major mode there, e.g., (interactive) (org-export-to-buffer \\='latex \"*Org LATEX Export*\" async subtreep visible-only body-only ext-plist - (major-mode-remap 'latex-mode))) + (major-mode-remap \\='latex-mode))) When expressed as an anonymous function, using `lambda', POST-PROCESS needs to be quoted. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 315bb68699e..38b72e59388 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -1438,7 +1438,7 @@ should be used. This function attempts to use file contents to determine whether the code is C or C++ and based on that chooses whether to enable `c-ts-mode' or `c++-ts-mode'." - (declare (obsolete c-or-c++-mode "30.1"))? + (declare (obsolete c-or-c++-mode "30.1")) (interactive) (let ((mode (if (save-excursion @@ -1447,8 +1447,8 @@ the code is C or C++ and based on that chooses whether to enable (widen) (goto-char (point-min)) (re-search-forward c-ts-mode--c-or-c++-regexp nil t)))) - 'c++-ts-mode) - 'c-ts-mode)) + 'c++-ts-mode + 'c-ts-mode))) (funcall (major-mode-remap mode)))) ;; The entries for C++ must come first to prevent *.c files be taken diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index e46ac2e2178..1a9d0907bd0 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -2910,8 +2910,8 @@ the code is C or C++ and based on that chooses whether to enable (goto-char (point-min)) (re-search-forward c-or-c++-mode--regexp (+ (point) c-guess-region-max) t)))) - 'c++-mode) - 'c-mode)) + 'c++-mode + 'c-mode))) (funcall (if (fboundp 'major-mode-remap) (major-mode-remap mode) mode)))) -- cgit v1.2.3 From 912e37b811107768e0cb3bc95184177f817dbdb2 Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Mon, 4 Mar 2024 10:33:49 +0100 Subject: Fix 'set-window-configuration' and 'window-state-put' Fix some bugs with 'window-state-put' (Bug#69093). Add new hook 'window-kept-windows-functions' (Bug#68235). * doc/lispref/windows.texi (Window Configurations): Mention 'window-kept-windows-functions'. (Window Hooks): Describe new abnormal hook 'window-kept-windows-functions'. * src/marker.c (Fmarker_last_position): New function to return the last position of a marker even if its buffer is now dead. * src/window.c (Fset_window_configuration): If 'window-kept-windows-functions' is non-nil, do not delete any window whose buffer is now dead but remember all such windows in a list to pass to 'window-kept-windows-functions'. Run 'window-kept-windows-functions' if it is non-nil. (Vwindow_kept_windows_functions): New abnormal hook run by Fset_window_configuration and 'window-state-put' with two arguments - the frame whose configuration is restored and a list of entries for each window whose buffer was found dead during restoration. Each entry is a list of four elements, the window, the dead buffer, and the last know positions of the start and point of that window. * lisp/window.el (window-state-put-kept-windows) (window-state-put-selected-window): New variables. (window--state-put-2): Make sure buffer is live before restoring its state. Set 'window-state-put-selected-window' to state's selected window. If 'window-kept-windows-functions' is non-nil, do not delete any windows whose buffer is found dead but remember all such windows in a list to pass to 'window-kept-windows-functions'. (window-state-put): Run 'window-kept-windows-functions' if it is non-nil. Select window recorded in 'window-state-put-selected-window'. --- doc/lispref/windows.texi | 40 +++++++++++++++++++++++++-- lisp/window.el | 65 +++++++++++++++++++++++++++++++++++++++----- src/marker.c | 13 +++++++++ src/window.c | 71 ++++++++++++++++++++++++++++++++++++++++++++---- 4 files changed, 173 insertions(+), 16 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index f14e74bc785..fe3dc573df5 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -6266,9 +6266,13 @@ this function does is to restore the value of the variable If the buffer of a window of @var{configuration} has been killed since @var{configuration} was made, that window is, as a rule, removed from -the restored configuration. However, if that window is the last -window remaining in the restored configuration, another live buffer is -shown in it. +the restored configuration. However, if that window is the last window +remaining in the restored configuration, another live buffer is shown in +it. Also, if the variable @var{window-kept-windows-functions} is +non-@code{nil}, any window whose buffer is now dead is not deleted. +Rather, this function will show another live buffer in that window and +include an entry for that window when calling any function in +@var{window-kept-windows-functions} (@pxref{Window Hooks}). Here is a way of using this function to get the same effect as @code{save-window-excursion}: @@ -6357,6 +6361,15 @@ a live window, it is replaced by a new live window created on the same frame before putting @var{state} into it. If @var{window} is @code{nil}, it puts the window state into a new window. +If the buffer of any window recorded in @var{state} has been killed +since @var{state} was made, that window is, as a rule, not restored. +However, if that window is the only window in @var{state}, another live +buffer will be shown in it. Also, if the variable +@var{window-kept-windows-functions} is non-@code{nil}, any window whose +buffer is now dead is restored. This function will show another live +buffer in it and include an entry for that window when calling a +function in @var{window-kept-windows-functions} (@pxref{Window Hooks}). + If the optional argument @var{ignore} is non-@code{nil}, it means to ignore minimum window sizes and fixed-size restrictions. If @var{ignore} is @code{safe}, this means windows can get as small as one line @@ -6623,6 +6636,27 @@ Lock fontification function, which will be called whenever parts of a buffer are (re)fontified because a window was scrolled or its size changed. @xref{Other Font Lock Variables}. +@cindex window kept windows functions +@defvar window-kept-windows-functions + This variable holds a list of functions that Emacs will call after +restoring a window configuration via @code{set-window-configuration} or +state via @code{window-state-put} (@pxref{Window Configurations}). When +the value of this variable is non-@code{nil}, these functions will not +delete any window whose buffer has been killed since the corresponding +configuration or state was saved, but show some live buffer in it. + +The value should be a list of functions that take two arguments. The +first argument specifies the frame whose windows have been restored. +The second argument specifies a list of entries for each window whose +buffer has been found dead at the time @code{set-window-configuration} +or @code{window-state-put} tried to restore it. Each entry is a list of +four values - the window whose buffer was found dead, the dead buffer, +and the last known positions of start and point of the buffer in that +window. Any function run by this hook should check that the window is +live since another function run by this hook may have deleted it in the +meantime. +@end defvar + @cindex window change functions The remainder of this section covers six hooks that are called during redisplay provided a significant, non-scrolling change of a diff --git a/lisp/window.el b/lisp/window.el index 6df20353b5e..29336f573f8 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -6174,6 +6174,12 @@ value can be also stored on disk and read back in a new session." (defvar window-state-put-stale-windows nil "Helper variable for `window-state-put'.") +(defvar window-state-put-kept-windows nil + "Helper variable for `window-state-put'.") + +(defvar window-state-put-selected-window nil + "Helper variable for `window-state-put'.") + (defun window--state-put-1 (state &optional window ignore totals pixelwise) "Helper function for `window-state-put'." (let ((type (car state))) @@ -6278,9 +6284,10 @@ value can be also stored on disk and read back in a new session." (set-window-parameter window (car parameter) (cdr parameter)))) ;; Process buffer related state. (when state - (let ((buffer (get-buffer (car state))) - (state (cdr state))) - (if buffer + (let* ((old-buffer-or-name (car state)) + (buffer (get-buffer old-buffer-or-name)) + (state (cdr state))) + (if (buffer-live-p buffer) (with-current-buffer buffer (set-window-buffer window buffer) (set-window-hscroll window (cdr (assq 'hscroll state))) @@ -6348,7 +6355,18 @@ value can be also stored on disk and read back in a new session." (set-window-point window (cdr (assq 'point state)))) ;; Select window if it's the selected one. (when (cdr (assq 'selected state)) - (select-window window)) + ;; This used to call 'select-window' which, however, + ;; can be partially undone because the current buffer + ;; may subsequently change twice: When leaving the + ;; present 'with-current-buffer' and when leaving the + ;; containing 'with-temp-buffer' form (Bug#69093). + ;; 'window-state-put-selected-window' should now work + ;; around that bug but we leave this 'select-window' + ;; in since some code run before the part that fixed + ;; it might still refer to this window as the selected + ;; one. + (select-window window) + (setq window-state-put-selected-window window)) (set-window-next-buffers window (delq nil (mapcar (lambda (buffer) @@ -6375,7 +6393,20 @@ value can be also stored on disk and read back in a new session." ;; save the window with the intention of deleting it later ;; if possible. (switch-to-prev-buffer window) - (push window window-state-put-stale-windows))))))) + (if window-kept-windows-functions + (let* ((start (cdr (assq 'start state))) + ;; Handle both - marker positions from writable + ;; states and markers from non-writable states. + (start-pos (if (markerp start) + (marker-last-position start) + start)) + (point (cdr (assq 'point state))) + (point-pos (if (markerp point) + (marker-last-position point) + point))) + (push (list window old-buffer-or-name start-pos point-pos) + window-state-put-kept-windows)) + (push window window-state-put-stale-windows)))))))) (defun window-state-put (state &optional window ignore) "Put window state STATE into WINDOW. @@ -6388,8 +6419,20 @@ If WINDOW is nil, create a new window before putting STATE into it. Optional argument IGNORE non-nil means ignore minimum window sizes and fixed size restrictions. IGNORE equal `safe' means windows can get as small as `window-safe-min-height' and -`window-safe-min-width'." +`window-safe-min-width'. + +If the abnormal hook `window-kept-windows-functions' is non-nil, +do not delete any windows saved by STATE whose buffers were +deleted since STATE was saved. Rather, show some live buffer in +them and call the functions in `window-kept-windows-functions' +with a list of two arguments: the frame where STATE was put and a +list of entries for each such window. Each entry contains four +elements - the window, its old buffer and the last positions of +`window-start' and `window-point' for the buffer in that window. +Always check the window for liveness because another function run +by this hook may have deleted it." (setq window-state-put-stale-windows nil) + (setq window-state-put-kept-windows nil) ;; When WINDOW is internal or nil, reduce it to a live one, ;; then create a new window on the same frame to put STATE into. @@ -6482,6 +6525,7 @@ windows can get as small as `window-safe-min-height' and (error "Window %s too small to accommodate state" window) (setq state (cdr state)) (setq window-state-put-list nil) + (setq window-state-put-selected-window nil) ;; Work on the windows of a temporary buffer to make sure that ;; splitting proceeds regardless of any buffer local values of ;; `window-size-fixed'. Release that buffer after the buffers of @@ -6490,14 +6534,21 @@ windows can get as small as `window-safe-min-height' and (set-window-buffer window (current-buffer)) (window--state-put-1 state window nil totals pixelwise) (window--state-put-2 ignore pixelwise)) + (when (window-live-p window-state-put-selected-window) + (select-window window-state-put-selected-window)) (while window-state-put-stale-windows (let ((window (pop window-state-put-stale-windows))) - ;; Avoid that 'window-deletable-p' throws an error if window + ;; Avoid that 'window-deletable-p' throws an error if window ;; was already deleted when exiting 'with-temp-buffer' above ;; (Bug#54028). (when (and (window-valid-p window) (eq (window-deletable-p window) t)) (delete-window window)))) + (when window-kept-windows-functions + (run-hook-with-args + 'window-kept-windows-functions + frame window-state-put-kept-windows) + (setq window-state-put-kept-windows nil)) (window--check frame)))) (defun window-state-buffers (state) diff --git a/src/marker.c b/src/marker.c index 1559dd52719..2abc951fc76 100644 --- a/src/marker.c +++ b/src/marker.c @@ -463,6 +463,18 @@ DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0, return Qnil; } +DEFUN ("marker-last-position", Fmarker_last_position, Smarker_last_position, 1, 1, 0, + doc: /* Return last position of MARKER in its buffer. +This is like `marker-position' with one exception: If the buffer of +MARKER is dead, it returns the last position of MARKER in that buffer +before it was killed. */) + (Lisp_Object marker) +{ + CHECK_MARKER (marker); + + return make_fixnum (XMARKER (marker)->charpos); +} + /* Change M so it points to B at CHARPOS and BYTEPOS. */ static void @@ -830,6 +842,7 @@ void syms_of_marker (void) { defsubr (&Smarker_position); + defsubr (&Smarker_last_position); defsubr (&Smarker_buffer); defsubr (&Sset_marker); defsubr (&Scopy_marker); diff --git a/src/window.c b/src/window.c index 0c84b4f4bf3..ea761fad8bc 100644 --- a/src/window.c +++ b/src/window.c @@ -7109,6 +7109,24 @@ current at the start of the function. If DONT-SET-MINIWINDOW is non-nil, the mini-window of the frame doesn't get set to the corresponding element of CONFIGURATION. +Normally, this function will try to delete any dead window in +CONFIGURATION whose buffer has been deleted since CONFIGURATION was +made. However, if the abnormal hook `window-kept-windows-functions' is +non-nil, it will preserve such a window in the restored layout and show +another buffer in it. + +After restoring the frame layout, this function runs the abnormal hook +`window-kept-windows-functions' with two arguments - the frame whose +layout it has restored and a list of entries for each window whose +buffer has been found dead when it tried to restore CONFIGURATION: Each +entry is a list of four elements where +`window' denotes the window whose buffer was found dead, `buffer' +denotes the dead buffer, and `start' and `point' denote the last known +positions of `window-start' and `window-point' of the buffer in that +window. Any function run by this hook should check such a window for +liveness because another function run by this hook may have deleted it +in the meantime." + If CONFIGURATION was made from a frame that is now deleted, only frame-independent values can be restored. In this case, the return value is nil. Otherwise the value is t. */) @@ -7119,6 +7137,7 @@ the return value is nil. Otherwise the value is t. */) struct Lisp_Vector *saved_windows; Lisp_Object new_current_buffer; Lisp_Object frame; + Lisp_Object kept_windows = Qnil; Lisp_Object old_frame = selected_frame; struct frame *f; ptrdiff_t old_point = -1; @@ -7359,6 +7378,11 @@ the return value is nil. Otherwise the value is t. */) BUF_PT (XBUFFER (w->contents)), BUF_PT_BYTE (XBUFFER (w->contents))); w->start_at_line_beg = true; + if (!NILP (Vwindow_kept_windows_functions)) + kept_windows = Fcons (list4 (window, p->buffer, + Fmarker_last_position (p->start), + Fmarker_last_position (p->pointm)), + kept_windows); } else if (!NILP (w->start)) /* Leaf window has no live buffer, get one. */ @@ -7379,6 +7403,11 @@ the return value is nil. Otherwise the value is t. */) dead_windows = Fcons (window, dead_windows); /* Make sure window is no more dedicated. */ wset_dedicated (w, Qnil); + if (!NILP (Vwindow_kept_windows_functions)) + kept_windows = Fcons (list4 (window, p->buffer, + Fmarker_last_position (p->start), + Fmarker_last_position (p->pointm)), + kept_windows); } } @@ -7430,12 +7459,13 @@ the return value is nil. Otherwise the value is t. */) unblock_input (); /* Scan dead buffer windows. */ - for (; CONSP (dead_windows); dead_windows = XCDR (dead_windows)) - { - window = XCAR (dead_windows); - if (WINDOW_LIVE_P (window) && !EQ (window, FRAME_ROOT_WINDOW (f))) - delete_deletable_window (window); - } + if (!NILP (Vwindow_kept_windows_functions)) + for (; CONSP (dead_windows); dead_windows = XCDR (dead_windows)) + { + window = XCAR (dead_windows); + if (WINDOW_LIVE_P (window) && !EQ (window, FRAME_ROOT_WINDOW (f))) + delete_deletable_window (window); + } /* Record the selected window's buffer here. The window should already be the selected one from the call above. */ @@ -7482,6 +7512,11 @@ the return value is nil. Otherwise the value is t. */) minibuf_selected_window = data->minibuf_selected_window; SAFE_FREE (); + + if (!NILP (Vrun_hooks) && !NILP (Vwindow_kept_windows_functions)) + run_hook_with_args_2 (Qwindow_kept_windows_functions, frame, + kept_windows); + return FRAME_LIVE_P (f) ? Qt : Qnil; } @@ -8479,6 +8514,8 @@ syms_of_window (void) DEFSYM (Qheader_line_format, "header-line-format"); DEFSYM (Qtab_line_format, "tab-line-format"); DEFSYM (Qno_other_window, "no-other-window"); + DEFSYM (Qwindow_kept_windows_functions, + "window-kept-windows-functions"); DEFVAR_LISP ("temp-buffer-show-function", Vtemp_buffer_show_function, doc: /* Non-nil means call as function to display a help buffer. @@ -8636,6 +8673,28 @@ its buffer or its total or body size since the last redisplay. Each call is performed with the frame temporarily selected. */); Vwindow_configuration_change_hook = Qnil; + DEFVAR_LISP ("window-kept-windows-functions", + Vwindow_kept_windows_functions, + doc: /* Functions run after restoring a window configuration or state. +These functions are called by `set-window-configuration' and +`window-state-put'. When the value of this variable is non-nil, these +functions restore any window whose buffer has been deleted since the +corresponding configuration or state was saved. Rather than deleting +such a window, `set-window-configuration' and `window-state-put' show +some live buffer in it. + +The value should be a list of functions that take two arguments. The +first argument specifies the frame whose configuration has been +restored. The second argument, if non-nil, specifies a list of entries +for each window whose buffer has been found dead at the time +'set-window-configuration' or `window-state-put' tried to restore it in +that window. Each entry is a list of four values - the window whose +buffer was found dead, the dead buffer, and the positions of start and +point of the buffer in that window. Note that the window may be already +dead since another function on this list may have deleted it in the +meantime. */); + Vwindow_kept_windows_functions = Qnil; + DEFVAR_LISP ("recenter-redisplay", Vrecenter_redisplay, doc: /* Non-nil means `recenter' redraws entire frame. If this option is non-nil, then the `recenter' command with a nil -- cgit v1.2.3 From 2c2a15bd171ecbf87fdac4405c7ea5f567fcf38a Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 3 Mar 2024 15:55:30 +0100 Subject: ; * lisp/vc/diff-mode.el (diff--refine-hunk): Escape literal `+`. --- lisp/vc/diff-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 99ac50c155a..ac7d55c8a46 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2353,7 +2353,7 @@ by `diff-refine-hunk'." (match-end 0) 'diff-refine-removed)) (goto-char middle) - (while (re-search-forward "^\\(?:+.*\n\\)+" end t) + (while (re-search-forward "^\\(?:\\+.*\n\\)+" end t) (diff--refine-propertize (match-beginning 0) (match-end 0) 'diff-refine-added)))))) -- cgit v1.2.3 From b9e8474a4470f71c30a4b89651fd3c5f2ef92ba2 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 4 Mar 2024 10:44:19 +0100 Subject: Repair miscompilation of single-arg `apply` (bug#69533) * lisp/emacs-lisp/byte-opt.el (byte-optimize-apply): Don't optimise single-argument `apply`; it's a legacy construct. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases): Add test case. --- lisp/emacs-lisp/byte-opt.el | 3 ++- test/lisp/emacs-lisp/bytecomp-tests.el | 3 +++ 2 files changed, 5 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index add13a5c312..f75be3f71ad 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1448,7 +1448,8 @@ See Info node `(elisp) Integer Basics'." (defun byte-optimize-apply (form) (let ((len (length form))) - (if (>= len 2) + ;; Single-arg `apply' is an abomination that we don't bother optimizing. + (if (> len 2) (let ((fn (nth 1 form)) (last (nth (1- len) form))) (cond diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 8ccac492141..26408e8685a 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -800,6 +800,9 @@ inner loops respectively." ;; Aristotelian identity optimization (let ((x (bytecomp-test-identity 1))) (list (eq x x) (eql x x) (equal x x))) + + ;; Legacy single-arg `apply' call + (apply '(* 2 3)) ) "List of expressions for cross-testing interpreted and compiled code.") -- cgit v1.2.3 From 5b49a38d1b37707bbbc8c069ed20ce7cd18fb2ac Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 4 Mar 2024 15:44:24 +0100 Subject: tramp-androidsu.el code cleanup * lisp/net/tramp-androidsu.el (tramp-androidsu-generate-wrapper): Prefer #' notation for function names. (tramp-androidsu-handle-copy-file) (tramp-androidsu-handle-file-local-copy) (tramp-androidsu-handle-make-symbolic-link) (tramp-androidsu-handle-rename-file) (tramp-androidsu-handle-write-region): Don't use a wrapper. (tramp-adb-connection-local-default-ps-profile): Don't initialize, this happens in tramp-db.el. --- lisp/net/tramp-androidsu.el | 36 ++++++++++++++++-------------------- 1 file changed, 16 insertions(+), 20 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index 12453d40acd..c7fb67d4081 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -232,19 +232,19 @@ FUNCTION." ;; tramp-adb-wait-for-output addresses problems introduced ;; by the adb utility itself, not Android utilities, so ;; replace it with the regular TRAMP function. - (fset 'tramp-adb-wait-for-output #'tramp-wait-for-output) + (fset #'tramp-adb-wait-for-output #'tramp-wait-for-output) ;; Likewise, except some special treatment is necessary on ;; account of flaws in Android's su implementation. - (fset 'tramp-adb-maybe-open-connection + (fset #'tramp-adb-maybe-open-connection #'tramp-androidsu-maybe-open-connection) (apply function args)) ;; Restore the original definitions of the functions overridden ;; above. - (fset 'tramp-adb-wait-for-output tramp-adb-wait-for-output) - (fset 'tramp-adb-maybe-open-connection tramp-adb-maybe-open-connection))))) + (fset #'tramp-adb-wait-for-output tramp-adb-wait-for-output) + (fset #'tramp-adb-maybe-open-connection + tramp-adb-maybe-open-connection))))) -(defalias 'tramp-androidsu-handle-copy-file - (tramp-androidsu-generate-wrapper #'tramp-sh-handle-copy-file)) +(defalias 'tramp-androidsu-handle-copy-file #'tramp-sh-handle-copy-file) (defalias 'tramp-androidsu-handle-delete-directory (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-directory)) @@ -253,7 +253,8 @@ FUNCTION." (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-file)) (defalias 'tramp-androidsu-handle-directory-files-and-attributes - (tramp-androidsu-generate-wrapper #'tramp-adb-handle-directory-files-and-attributes)) + (tramp-androidsu-generate-wrapper + #'tramp-adb-handle-directory-files-and-attributes)) (defalias 'tramp-androidsu-handle-exec-path (tramp-androidsu-generate-wrapper #'tramp-adb-handle-exec-path)) @@ -268,10 +269,11 @@ FUNCTION." (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-exists-p)) (defalias 'tramp-androidsu-handle-file-local-copy - (tramp-androidsu-generate-wrapper #'tramp-sh-handle-file-local-copy)) + #'tramp-sh-handle-file-local-copy) (defalias 'tramp-androidsu-handle-file-name-all-completions - (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-name-all-completions)) + (tramp-androidsu-generate-wrapper + #'tramp-adb-handle-file-name-all-completions)) (defalias 'tramp-androidsu-handle-file-readable-p (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-readable-p)) @@ -400,14 +402,12 @@ FUNCTION." p))))) (defalias 'tramp-androidsu-handle-make-symbolic-link - (tramp-androidsu-generate-wrapper - #'tramp-sh-handle-make-symbolic-link)) + #'tramp-sh-handle-make-symbolic-link) (defalias 'tramp-androidsu-handle-process-file (tramp-androidsu-generate-wrapper #'tramp-adb-handle-process-file)) -(defalias 'tramp-androidsu-handle-rename-file - (tramp-androidsu-generate-wrapper #'tramp-sh-handle-rename-file)) +(defalias 'tramp-androidsu-handle-rename-file #'tramp-sh-handle-rename-file) (defalias 'tramp-androidsu-handle-set-file-modes (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-modes)) @@ -424,8 +424,7 @@ FUNCTION." (defalias 'tramp-androidsu-handle-get-remote-uid (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-uid)) -(defalias 'tramp-androidsu-handle-write-region - (tramp-androidsu-generate-wrapper #'tramp-sh-handle-write-region)) +(defalias 'tramp-androidsu-handle-write-region #'tramp-sh-handle-write-region) ;;;###tramp-autoload (defconst tramp-androidsu-file-name-handler-alist @@ -458,7 +457,8 @@ FUNCTION." (file-local-copy . tramp-androidsu-handle-file-local-copy) (file-locked-p . tramp-handle-file-locked-p) (file-modes . tramp-handle-file-modes) - (file-name-all-completions . tramp-androidsu-handle-file-name-all-completions) + (file-name-all-completions + . tramp-androidsu-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p) (file-name-completion . tramp-handle-file-name-completion) @@ -542,10 +542,6 @@ arguments to pass to the OPERATION." (tramp-register-foreign-file-name-handler #'tramp-androidsu-file-name-p #'tramp-androidsu-file-name-handler)) -(connection-local-set-profile-variables - 'tramp-adb-connection-local-default-ps-profile - tramp-adb-connection-local-default-ps-variables) - (with-eval-after-load 'shell (connection-local-set-profiles `(:application tramp :protocol ,tramp-androidsu-method) -- cgit v1.2.3 From 1a35eb86b8cb75ce390525dd3394a52376b622a6 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 5 Mar 2024 11:23:27 +0800 Subject: Rearrange Android splash screen messages * lisp/startup.el (fancy-startup-tail, fancy-startup-screen) (normal-splash-screen): Adjust for function renaming; move the storage permissions notice to the top of the splash screen. * lisp/term/android-win.el (android-after-splash-screen): Rename from android-before-splash-screen and adjust layout lightly. * src/android.c (android_wc_lookup_string): Terminate character composition after a character is returned, whether it contain a Unicode character or not. --- lisp/startup.el | 19 ++++++++----------- lisp/term/android-win.el | 14 +++++++------- src/android.c | 4 ++++ 3 files changed, 19 insertions(+), 18 deletions(-) (limited to 'lisp') diff --git a/lisp/startup.el b/lisp/startup.el index 33e1124b998..357a4154e4c 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -2040,10 +2040,6 @@ a face or button specification." (call-interactively 'recover-session))) " to recover the files you were editing.")))) - ;; Insert the permissions notice if the user has yet to grant Emacs - ;; storage permissions. - (when (fboundp 'android-after-splash-screen) - (funcall 'android-after-splash-screen t)) (when concise (fancy-splash-insert :face 'variable-pitch "\n" @@ -2096,6 +2092,10 @@ splash screen in another window." (make-local-variable 'startup-screen-inhibit-startup-screen) (if pure-space-overflow (insert pure-space-overflow-message)) + ;; Insert the permissions notice if the user has yet to grant Emacs + ;; storage permissions. + (when (fboundp 'android-before-splash-screen) + (funcall 'android-before-splash-screen t)) (unless concise (fancy-splash-head)) (dolist (text fancy-startup-text) @@ -2202,7 +2202,10 @@ splash screen in another window." (if pure-space-overflow (insert pure-space-overflow-message)) - + ;; Insert the permissions notice if the user has yet to grant + ;; Emacs storage permissions. + (when (fboundp 'android-before-splash-screen) + (funcall 'android-before-splash-screen nil)) ;; The convention for this piece of code is that ;; each piece of output starts with one or two newlines ;; and does not end with any newlines. @@ -2244,12 +2247,6 @@ splash screen in another window." (insert "\n\nIf an Emacs session crashed recently, " "type M-x recover-session RET\nto recover" " the files you were editing.\n")) - - ;; Insert the permissions notice if the user has yet to grant - ;; Emacs storage permissions. - (when (fboundp 'android-after-splash-screen) - (funcall 'android-after-splash-screen nil)) - (use-local-map splash-screen-keymap) ;; Display the input that we set up in the buffer. diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index b7b0920626e..1d10402b15d 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -398,7 +398,7 @@ directory /content/storage. (inhibit-read-only t)) (fill-region (point-min) (point-max)))))))) -(defun android-after-splash-screen (fancy-p) +(defun android-before-splash-screen (fancy-p) "Insert a brief notice on the absence of storage permissions. If storage permissions are as yet denied to Emacs, insert a short notice to that effect, followed by a button that enables the user @@ -412,14 +412,14 @@ screen display; see `fancy-splash-insert'." (fancy-splash-insert :face '(variable-pitch font-lock-function-call-face) - "\nPermissions necessary to access external storage directories have -been denied. Click " + "Permissions necessary to access external storage directories have" + "\nbeen denied. Click " :link '("here" android-display-storage-permission-popup) - " to grant them.") + " to grant them.\n") (insert - "\nPermissions necessary to access external storage directories have been -denied. ") - (insert-button "Click here to grant them." + "Permissions necessary to access external storage directories" + "\nhave been denied. ") + (insert-button "Click here to grant them.\n" 'action #'android-display-storage-permission-popup 'follow-link t) (newline)))) diff --git a/src/android.c b/src/android.c index eb6981093be..5b3fbb25373 100644 --- a/src/android.c +++ b/src/android.c @@ -5533,6 +5533,10 @@ android_wc_lookup_string (android_key_pressed_event *event, rc = 0; } + /* Terminate any ongoing character composition after a key is + registered. */ + if (compose_status) + compose_status->chars_matched = 0; *status_return = status; return rc; } -- cgit v1.2.3 From 418ad866bf846a6a3328d91df28c958be75337be Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 4 Mar 2024 23:12:29 -0500 Subject: cl-preloaded.el: Further fine-tuning * lisp/emacs-lisp/cl-preloaded.el (cl--direct-supertypes-of-type): Fix some left over issues: - Remove redundant `number-or-marker` from `marker`s parents. - Add `function` to the types, since it was missing. (cl--typeof-types): Add a warning for missing type info. * admin/syncdoc-type-hierarchy.el (syncdoc-hierarchy): Fix parent of `oclosure`. * doc/lispref/type_hierarchy.txt: * doc/lispref/type_hierarchy.jpg: Update. --- admin/syncdoc-type-hierarchy.el | 2 +- doc/lispref/type_hierarchy.jpg | Bin 223501 -> 237291 bytes doc/lispref/type_hierarchy.txt | 49 ++++++++++++++++++++++------------------ lisp/emacs-lisp/cl-preloaded.el | 21 ++++++++++++++--- 4 files changed, 46 insertions(+), 26 deletions(-) (limited to 'lisp') diff --git a/admin/syncdoc-type-hierarchy.el b/admin/syncdoc-type-hierarchy.el index cb4df63a312..6448369625b 100644 --- a/admin/syncdoc-type-hierarchy.el +++ b/admin/syncdoc-type-hierarchy.el @@ -69,7 +69,7 @@ (not (eq type 'eieio-default-superclass))) '(eieio-default-superclass)) ;; OClosures can still be lists :-( - ((eq 'oclosure type) '(t)) + ((eq 'oclosure type) '(function)) (t '(atom))) ht))))) ht)) diff --git a/doc/lispref/type_hierarchy.jpg b/doc/lispref/type_hierarchy.jpg index b7eba7d1cf7..6b9be985817 100644 Binary files a/doc/lispref/type_hierarchy.jpg and b/doc/lispref/type_hierarchy.jpg differ diff --git a/doc/lispref/type_hierarchy.txt b/doc/lispref/type_hierarchy.txt index c74bc45635b..6827bbbc580 100644 --- a/doc/lispref/type_hierarchy.txt +++ b/doc/lispref/type_hierarchy.txt @@ -1,22 +1,27 @@ -| Type | Derived Types | -|-------------------+----------------------------------------------------------| -| t | sequence atom | -| sequence | list array | -| atom | class structure tree-sitter-compiled-query | -| | tree-sitter-node tree-sitter-parser user-ptr font-object | -| | font-entity font-spec condvar mutex thread terminal | -| | hash-table frame buffer function window process | -| | window-configuration overlay integer-or-marker | -| | number-or-marker symbol array obarray | -| number | float integer | -| number-or-marker | marker number | -| integer | bignum fixnum | -| symbol | keyword boolean symbol-with-pos | -| array | vector bool-vector char-table string | -| list | null cons | -| integer-or-marker | integer marker | -| compiled-function | byte-code-function | -| function | subr module-function compiled-function | -| boolean | null | -| subr | subr-native-elisp subr-primitive | -| symbol-with-pos | keyword | +| Type | Derived Types | +|--------------------------+------------------------------------------------------------| +| t | sequence atom | +| sequence | list array | +| atom | array function tree-sitter-compiled-query tree-sitter-node | +| | tree-sitter-parser user-ptr font-object font-entity | +| | font-spec condvar mutex thread terminal hash-table frame | +| | buffer window process window-configuration overlay | +| | number-or-marker symbol obarray native-comp-unit | +| | cl-structure-object eieio-default-superclass | +| number | float integer | +| integer-or-marker | integer marker | +| number-or-marker | integer-or-marker number | +| integer | bignum fixnum | +| symbol | keyword boolean symbol-with-pos | +| array | vector bool-vector char-table string | +| boolean | null | +| list | null cons | +| compiled-function | byte-code-function subr | +| function | module-function compiled-function oclosure | +| subr | subr-native-elisp subr-primitive | +| oclosure | advice kmacro | +| cl--class | oclosure--class cl-structure-class eieio--class | +| cl-structure-object | cl--class xref-elisp-location frameset-register | +| eieio-default-superclass | eieio-named transient-child | +| transient-suffix | transient-infix | +| transient-child | transient-suffix | diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index a4ddc55b257..ea08d35ecec 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -51,14 +51,25 @@ (signal 'cl-assertion-failed `(,form ,@sargs))))) (defconst cl--direct-supertypes-of-type + ;; Please run `sycdoc-update-type-hierarchy' in + ;; `admin/syncdoc-type-hierarchy.el' each time this is modified to + ;; reflect the change in the documentation. (let ((table (make-hash-table :test #'eq))) + ;; FIXME: Our type DAG has various quirks: + ;; - `subr' says it's a `compiled-function' but that's not true + ;; for those subrs that are special forms! + ;; - Some `keyword's are also `symbol-with-pos' but that's not reflected + ;; in the DAG. + ;; - An OClosure can be an interpreted function or a `byte-code-function', + ;; so the DAG of OClosure types is "orthogonal" to the distinction + ;; between interpreted and compiled functions. (dolist (x '((sequence t) (atom t) (list sequence) (array sequence atom) (float number) (integer number integer-or-marker) - (marker integer-or-marker number-or-marker) + (marker integer-or-marker) (integer-or-marker number-or-marker) (number number-or-marker) (bignum integer) @@ -73,10 +84,11 @@ ;; FIXME: This results in `atom' coming before `list' :-( (null boolean list) (cons list) + (function atom) (byte-code-function compiled-function) (subr compiled-function) - (module-function function atom) - (compiled-function function atom) + (module-function function) + (compiled-function function) (subr-native-elisp subr) (subr-primitive subr))) (puthash (car x) (cdr x) table)) @@ -100,8 +112,11 @@ (lambda (type) ;; FIXME: copy&pasted from `cl--class-allparents'. (let ((parents (gethash type cl--direct-supertypes-of-type))) + (unless parents + (message "Warning: Type without parent: %S!" type)) (cons type (merge-ordered-lists + ;; FIXME: Can't remember why `t' is excluded. (mapcar allparents (remq t parents)))))))) (maphash (lambda (type _) (push (funcall allparents type) alist)) -- cgit v1.2.3 From 218748c26287ae865229fe8a3c520facfa12fede Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 4 Mar 2024 23:42:50 -0500 Subject: disass.el (disassemble-1): Minor simplification * lisp/emacs-lisp/disass.el (disassemble-1): Remove code for functions of the form (lambda ARGS (byte-code ...)) which we don't use any more nowadays. --- lisp/emacs-lisp/disass.el | 39 ++++++++++++++++----------------------- 1 file changed, 16 insertions(+), 23 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index b7db2adde59..850cc2085f7 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -54,7 +54,7 @@ (defun disassemble (object &optional buffer indent interactive-p) "Print disassembled code for OBJECT in (optional) BUFFER. OBJECT can be a symbol defined as a function, or a function itself -\(a lambda expression or a compiled-function object). +\(a lambda expression or a byte-code-function object). If OBJECT is not already compiled, we compile it, but do not redefine OBJECT if it is a symbol." (interactive @@ -70,7 +70,7 @@ redefine OBJECT if it is a symbol." (save-excursion (if (or interactive-p (null buffer)) (with-output-to-temp-buffer "*Disassemble*" - (set-buffer "*Disassemble*") + (set-buffer standard-output) (let ((lexical-binding lb)) (disassemble-internal object indent (not interactive-p)))) (set-buffer buffer) @@ -250,29 +250,22 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler." ;; if the succeeding op is byte-switch, display the jump table ;; used (cond ((eq (car-safe (car-safe (cdr lap))) 'byte-switch) - (insert (format "")) - ;; if the value of the constant is compiled code, then - ;; recursively disassemble it. - ((or (byte-code-function-p arg) - (and (consp arg) (functionp arg) - (assq 'byte-code arg)) + (insert (format "")) + ;; if the value of the constant is compiled code, then + ;; recursively disassemble it. + ((or (byte-code-function-p arg) (and (eq (car-safe arg) 'macro) - (or (byte-code-function-p (cdr arg)) - (and (consp (cdr arg)) - (functionp (cdr arg)) - (assq 'byte-code (cdr arg)))))) + (byte-code-function-p (cdr arg)))) (cond ((byte-code-function-p arg) (insert "\n")) - ((functionp arg) - (insert "")) (t (insert "\n"))) (disassemble-internal arg @@ -285,7 +278,7 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler." (+ indent disassemble-recursive-indent))) ((eq (car-safe (car-safe arg)) 'byte-code) (insert "(...)\n") - (mapc ;recurse on list of byte-code objects + (mapc ;Recurse on list of byte-code objects. (lambda (obj) (disassemble-1 obj -- cgit v1.2.3 From 9cf0f254bae79f6b6cda01e7a4b77fabec9f3f8f Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 5 Mar 2024 18:42:49 +0200 Subject: * lisp/net/dictionary.el: More fixes for dictionary-new-matching (bug#69312) (dictionary-new-matching): Change the order of standard calls to be the same as in 'dictionary-new-search'. Use new function 'dictionary-new-matching-internal'. (dictionary-new-matching-internal): New function based on 'dictionary-new-search-internal'. --- lisp/net/dictionary.el | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 7967c650999..d4dfa33716c 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1116,17 +1116,22 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (defun dictionary-new-matching (word) "Run a new matching search on WORD." - (dictionary-ensure-buffer) (dictionary-store-positions) - (dictionary-pre-buffer) - (dictionary-do-matching word dictionary-default-dictionary - dictionary-default-strategy - 'dictionary-display-match-result) - (dictionary-store-state 'dictionary-do-matching + (dictionary-ensure-buffer) + (dictionary-new-matching-internal word dictionary-default-dictionary + dictionary-default-strategy + 'dictionary-display-match-result) + (dictionary-store-state 'dictionary-new-matching-internal (list word dictionary-default-dictionary dictionary-default-strategy 'dictionary-display-match-result))) +(defun dictionary-new-matching-internal (word dictionary strategy function) + "Start a new matching for WORD in DICTIONARY after preparing the buffer. +FUNCTION is the callback which is called for each search result." + (dictionary-pre-buffer) + (dictionary-do-matching word dictionary strategy function)) + (defun dictionary-do-matching (word dictionary strategy function) "Search for WORD with STRATEGY in DICTIONARY and display them with FUNCTION." (insert (format-message "Lookup matching words for `%s' in `%s' using `%s'\n" -- cgit v1.2.3 From f16a85e317d940aa2e0f0375ec5d1917cb04ade3 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 5 Mar 2024 18:50:51 +0200 Subject: New property 'context-menu-functions' (bug#62250) * lisp/iimage.el (iimage-mode-buffer): Set context-menu-functions text property to '(image-context-menu)'. * lisp/image.el (image-context-menu): New function. (put-image): Set context-menu-functions overlay property to '(image-context-menu)'. (insert-image, insert-sliced-image): Set context-menu-functions text property to '(image-context-menu)'. * lisp/mouse.el (context-menu-map): Use mouse-posn-property 'context-menu-functions' and call its funs at the end. --- etc/NEWS | 4 ++++ lisp/iimage.el | 1 + lisp/image.el | 33 ++++++++++++++++++++++++++++++--- lisp/mouse.el | 14 ++++++++++---- 4 files changed, 45 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index 06856602ea8..a4b42263c36 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2087,6 +2087,10 @@ treesitter grammar. ** New buffer-local variable 'tabulated-list-groups'. It controls display and separate sorting of groups of entries. +--- +** New property 'context-menu-functions'. +Like the variable with the same name it adds a list of context menus. + * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/lisp/iimage.el b/lisp/iimage.el index 205141577c9..0f2297465fe 100644 --- a/lisp/iimage.el +++ b/lisp/iimage.el @@ -134,6 +134,7 @@ Examples of image filename patterns to match: :max-width (- (nth 2 edges) (nth 0 edges)) :max-height (- (nth 3 edges) (nth 1 edges))) keymap ,image-map + context-menu-functions (image-context-menu) modification-hooks (iimage-modification-hook))) (remove-list-of-text-properties diff --git a/lisp/image.el b/lisp/image.el index 2ebce59a98c..662e7eaf25d 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -193,6 +193,29 @@ or \"ffmpeg\") is installed." "h" #'image-flip-horizontally "v" #'image-flip-vertically)) +(defun image-context-menu (menu click) + "Populate MENU with image-related commands at CLICK." + (when (mouse-posn-property (event-start click) 'display) + (define-key menu [image-separator] menu-bar-separator) + (let ((easy-menu (make-sparse-keymap "Image"))) + (easy-menu-define nil easy-menu nil + '("Image" + ["Zoom In" image-increase-size + :help "Enlarge the image"] + ["Zoom Out" image-decrease-size + :help "Shrink the image"] + ["Rotate Clockwise" image-rotate + :help "Rotate the image"] + ["Flip horizontally" image-flip-horizontally + :help "Flip horizontally"] + ["Flip vertically" image-flip-vertically + :help "Flip vertically"])) + (dolist (item (reverse (lookup-key easy-menu [menu-bar image]))) + (when (consp item) + (define-key menu (vector (car item)) (cdr item)))))) + + menu) + (defun image-load-path-for-library (library image &optional path no-error) "Return a suitable search path for images used by LIBRARY. @@ -620,6 +643,7 @@ means display it in the right marginal area." (overlay-put overlay 'put-image t) (overlay-put overlay 'before-string string) (overlay-put overlay 'keymap image-map) + (overlay-put overlay 'context-menu-functions '(image-context-menu)) overlay))) @@ -672,8 +696,9 @@ is non-nil, this is inhibited." inhibit-isearch ,inhibit-isearch keymap ,(if slice image-slice-map - image-map))))) - + image-map) + context-menu-functions + (image-context-menu))))) ;;;###autoload (defun insert-sliced-image (image &optional string area rows cols) @@ -709,7 +734,9 @@ The image is automatically split into ROWS x COLS slices." (add-text-properties start (point) `(display ,(list (list 'slice x y dx dy) image) rear-nonsticky (display keymap) - keymap ,image-slice-map)) + keymap ,image-slice-map + context-menu-functions + (image-context-menu))) (setq x (+ x dx)))) (setq x 0.0 y (+ y dy)) diff --git a/lisp/mouse.el b/lisp/mouse.el index d1b06c2040d..26835437c08 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -414,13 +414,17 @@ Each function receives the menu and the mouse click event and returns the same menu after adding own menu items to the composite menu. When there is a text property `context-menu-function' at CLICK, it overrides all functions from `context-menu-functions'. +Whereas the property `context-menu-functions' doesn't override +the variable `context-menu-functions', but adds menus from the +list in the property after adding menus from the variable. At the end, it's possible to modify the final menu by specifying the function `context-menu-filter-function'." (let* ((menu (make-sparse-keymap (propertize "Context Menu" 'hide t))) (click (or click last-input-event)) - (window (posn-window (event-start click))) - (fun (mouse-posn-property (event-start click) - 'context-menu-function))) + (start (event-start click)) + (window (posn-window start)) + (fun (mouse-posn-property start 'context-menu-function)) + (funs (mouse-posn-property start 'context-menu-functions))) (unless (eq (selected-window) window) (select-window window)) @@ -430,7 +434,9 @@ the function `context-menu-filter-function'." (run-hook-wrapped 'context-menu-functions (lambda (fun) (setq menu (funcall fun menu click)) - nil))) + nil)) + (dolist (fun funs) + (setq menu (funcall fun menu click)))) ;; Remove duplicate separators as well as ones at the beginning or ;; end of the menu. -- cgit v1.2.3 From 3cb06145070ff5d4a220f1144434f1ba6c1976f7 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 5 Mar 2024 19:14:28 +0200 Subject: * lisp/tab-bar.el (tab-bar-tab-post-select-functions): New hook (bug#69093). (tab-bar-select-tab): Call tab-bar-tab-post-select-functions at the end. --- etc/NEWS | 4 ++++ lisp/tab-bar.el | 13 ++++++++++++- 2 files changed, 16 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index a4b42263c36..b4343a7941b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -275,10 +275,14 @@ selected or deselected at the end of executing the current command. ** Tab Bars and Tab Lines +--- *** New user option 'tab-bar-tab-name-format-functions'. It can be used to add, remove and reorder functions that change the appearance of every tab on the tab bar. +--- +*** New hook 'tab-bar-tab-post-select-functions'. + +++ ** New optional argument for modifying directory-local variables. The commands 'add-dir-local-variable', 'delete-dir-local-variable' and diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 3e1d8278b04..61efa332e0b 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1385,6 +1385,14 @@ inherits the current tab's `explicit-name' parameter." tabs)))) +(defcustom tab-bar-tab-post-select-functions nil + "List of functions to call after selecting a tab. +Two arguments are supplied: the previous tab that was selected before, +and the newly selected tab." + :type '(repeat function) + :group 'tab-bar + :version "30.1") + (defvar tab-bar-minibuffer-restore-tab nil "Tab number for `tab-bar-minibuffer-restore-tab'.") @@ -1499,7 +1507,10 @@ Negative TAB-NUMBER counts tabs from the end of the tab bar." (tab-bar--current-tab-make (nth to-index tabs))) (unless tab-bar-mode - (message "Selected tab '%s'" (alist-get 'name to-tab)))) + (message "Selected tab '%s'" (alist-get 'name to-tab))) + + (run-hook-with-args 'tab-bar-tab-post-select-functions + from-tab to-tab)) (force-mode-line-update)))) -- cgit v1.2.3 From 845d334c10ab8a12ac5eead90abfa9cae1f4b67c Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 6 Mar 2024 10:20:36 +0800 Subject: ; Fix last change * lisp/net/tramp-androidsu.el (tramp-androidsu-generate-wrapper): Arguments to fset must be symbols rather than functions. --- lisp/net/tramp-androidsu.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index c7fb67d4081..c24ac079022 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -232,16 +232,16 @@ FUNCTION." ;; tramp-adb-wait-for-output addresses problems introduced ;; by the adb utility itself, not Android utilities, so ;; replace it with the regular TRAMP function. - (fset #'tramp-adb-wait-for-output #'tramp-wait-for-output) + (fset 'tramp-adb-wait-for-output #'tramp-wait-for-output) ;; Likewise, except some special treatment is necessary on ;; account of flaws in Android's su implementation. - (fset #'tramp-adb-maybe-open-connection + (fset 'tramp-adb-maybe-open-connection #'tramp-androidsu-maybe-open-connection) (apply function args)) ;; Restore the original definitions of the functions overridden ;; above. - (fset #'tramp-adb-wait-for-output tramp-adb-wait-for-output) - (fset #'tramp-adb-maybe-open-connection + (fset 'tramp-adb-wait-for-output tramp-adb-wait-for-output) + (fset 'tramp-adb-maybe-open-connection tramp-adb-maybe-open-connection))))) (defalias 'tramp-androidsu-handle-copy-file #'tramp-sh-handle-copy-file) -- cgit v1.2.3 From 1a5850a3af0693f022bb0a62e36bb84f762287c7 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 6 Mar 2024 10:48:28 +0800 Subject: Don't report files from read-only adb partitions as writable * lisp/net/tramp-adb.el (tramp-adb-handle-file-writable-p): Ignore the file-attributes cache, since file mode is not a reliable indicator of writability. --- lisp/net/tramp-adb.el | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 8ad7c271b4f..aaeb5fabb80 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -508,12 +508,11 @@ Emacs dired can't find files." (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-writable-p" (if (file-exists-p filename) - ;; Examine `file-attributes' cache to see if request can be - ;; satisfied without remote operation. - (if (tramp-file-property-p v localname "file-attributes") - (tramp-check-cached-permissions v ?w) - (tramp-adb-send-command-and-check - v (format "test -w %s" (tramp-shell-quote-argument localname)))) + ;; The file-attributes cache is unreliable since its + ;; information does not take partition writability into + ;; account, so a call to test must never be skipped. + (tramp-adb-send-command-and-check + v (format "test -w %s" (tramp-shell-quote-argument localname))) ;; If file doesn't exist, check if directory is writable. (and (file-directory-p (file-name-directory filename)) -- cgit v1.2.3 From b12059e4c320f374735a9c00975ef12cb964043f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 6 Mar 2024 17:51:42 +0100 Subject: Tramp fixes after running regression tests on Android * lisp/net/tramp-adb.el (tramp-adb-maybe-open-connection): Unset environment variable PS2. * lisp/net/tramp-androidsu.el (tramp-default-host-alist): Don't add an entry; `tramp-default-host' is set properly. (tramp-androidsu-maybe-open-connection): Don't set connection property "remote-namespace" to nil, this is the default anyway. Don't set connection property "remote-path", we use connection-local values instead. Unset environment variable PS2. Dump shell options after setting all of them. (tramp-androidsu-handle-make-process): Don't use hard-coded user "root". (tramp-androidsu-connection-local-default-variables): New defvar. Add it to connection-local profiles. --- lisp/net/tramp-adb.el | 2 +- lisp/net/tramp-androidsu.el | 53 +++++++++++++++++++++++++-------------------- 2 files changed, 30 insertions(+), 25 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index aaeb5fabb80..da23d062c2e 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -1266,7 +1266,7 @@ connection if a previous connection has died for some reason." (tramp-set-connection-property p "prompt" (rx "///" (literal prompt) "#$")) (tramp-adb-send-command - vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt)) + vec (format "PS1=\"///\"\"%s\"\"#$\" PS2=''" prompt)) ;; Disable line editing. (tramp-adb-send-command diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index c24ac079022..09bee323f5e 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -88,8 +88,6 @@ may edit files belonging to any and all applications." (tramp-tmpdir ,tramp-androidsu-local-tmp-directory) (tramp-connection-timeout 10) (tramp-shell-name ,tramp-androidsu-local-shell-name))) - (add-to-list 'tramp-default-host-alist - `(,tramp-androidsu-method nil "localhost")) (add-to-list 'tramp-default-user-alist `(,tramp-androidsu-method nil ,tramp-root-id-string))) @@ -130,7 +128,7 @@ multibyte mode and waits for the shell prompt to appear." (p (start-process (tramp-get-connection-name vec) (tramp-get-connection-buffer vec) ;; Disregard - ;; tramp-encoding-shell, as + ;; `tramp-encoding-shell', as ;; there's no guarantee that it's ;; possible to execute it with ;; `android-use-exec-loader' off. @@ -142,17 +140,16 @@ multibyte mode and waits for the shell prompt to appear." (tramp-post-process-creation p vec) ;; Replace `login-args' place holders. (setq command (format "exec su - %s || exit" user)) - (tramp-set-connection-property vec "remote-namespace" nil) ;; Attempt to execute the shell inside the global mount ;; namespace if requested. (when tramp-androidsu-mount-global-namespace (progn (when (eq tramp-androidsu-su-mm-supported 'unknown) ;; Change the prompt in advance so that - ;; tramp-adb-send-command-and-check can call - ;; tramp-search-regexp. + ;; `tramp-adb-send-command-and-check' can call + ;; `tramp-search-regexp'. (tramp-adb-send-command - vec (format "PS1=%s" + vec (format "PS1=%s PS2=''" (tramp-shell-quote-argument tramp-end-of-output))) (setq tramp-androidsu-su-mm-supported @@ -179,17 +176,17 @@ multibyte mode and waits for the shell prompt to appear." (tramp-set-connection-local-variables vec) ;; Change prompt. (tramp-adb-send-command - vec (format "PS1=%s" + vec (format "PS1=%s PS2=''" (tramp-shell-quote-argument tramp-end-of-output))) ;; Disable line editing. (tramp-adb-send-command vec "set +o vi +o vi-esccomplete +o vi-tabcomplete +o emacs") - ;; Dump option settings in the traces. - (when (>= tramp-verbose 9) - (tramp-adb-send-command vec "set -o")) ;; Disable Unicode, for otherwise Unicode filenames will ;; not be decoded correctly. (tramp-adb-send-command vec "set +U") + ;; Dump option settings in the traces. + (when (>= tramp-verbose 9) + (tramp-adb-send-command vec "set -o")) ;; Disable echo expansion. (tramp-adb-send-command vec "stty -inlcr -onlcr -echo kill '^U' erase '^H'" t) @@ -204,12 +201,8 @@ multibyte mode and waits for the shell prompt to appear." (tramp-message vec 5 "Remote echo still on. Ok.") ;; Make sure backspaces and their echo are enabled ;; and no line width magic interferes with them. - (tramp-adb-send-command vec - "stty icanon erase ^H cols 32767" - t))) - ;; Set the remote PATH to a suitable value. - (tramp-set-connection-property vec "remote-path" - tramp-androidsu-remote-path) + (tramp-adb-send-command + vec "stty icanon erase ^H cols 32767" t))) ;; Mark it as connected. (tramp-set-connection-property p "connected" t)))) ;; Cleanup, and propagate the signal. @@ -229,9 +222,9 @@ FUNCTION." (symbol-function #'tramp-adb-maybe-open-connection))) (unwind-protect (progn - ;; tramp-adb-wait-for-output addresses problems introduced + ;; `tramp-adb-wait-for-output' addresses problems introduced ;; by the adb utility itself, not Android utilities, so - ;; replace it with the regular TRAMP function. + ;; replace it with the regular Tramp function. (fset 'tramp-adb-wait-for-output #'tramp-wait-for-output) ;; Likewise, except some special treatment is necessary on ;; account of flaws in Android's su implementation. @@ -376,10 +369,8 @@ FUNCTION." p (make-process :name name :buffer buffer :command (if (tramp-get-connection-property v "remote-namespace") - (append (list "su" "-mm" "-" (or user "root") "-c") - command) - (append (list "su" "-" (or user "root") "-c") - command)) + (append (list "su" "-mm" "-" user "-c") command) + (append (list "su" "-" user "-c") command)) :coding coding :noquery noquery :connection-type connection-type :sentinel sentinel :stderr stderr)) ;; Set filter. Prior Emacs 29.1, it doesn't work reliably @@ -516,7 +507,7 @@ FUNCTION." (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (write-region . tramp-androidsu-handle-write-region)) - "Alist of TRAMP handler functions for superuser sessions on Android.") + "Alist of Tramp handler functions for superuser sessions on Android.") ;; It must be a `defsubst' in order to push the whole code into ;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading. @@ -542,6 +533,20 @@ arguments to pass to the OPERATION." (tramp-register-foreign-file-name-handler #'tramp-androidsu-file-name-p #'tramp-androidsu-file-name-handler)) +;;; Default connection-local variables for Tramp. + +(defconst tramp-androidsu-connection-local-default-variables + `((tramp-remote-path . ,tramp-androidsu-remote-path)) + "Default connection-local variables for remote androidsu connections.") + +(connection-local-set-profile-variables + 'tramp-androidsu-connection-local-default-profile + tramp-androidsu-connection-local-default-variables) + +(connection-local-set-profiles + `(:application tramp :protocol ,tramp-androidsu-method) + 'tramp-androidsu-connection-local-default-profile) + (with-eval-after-load 'shell (connection-local-set-profiles `(:application tramp :protocol ,tramp-androidsu-method) -- cgit v1.2.3 From 59e470dd5de6e75c4d3bb91c876c8540faf33fdb Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Sat, 17 Feb 2024 20:49:15 -0800 Subject: When navigating through history in EWW, don't keep adding to 'eww-history' This resolves an issue where navigating back and then forward kept adding new history entries so you could never hit the "end" (bug#69232). * lisp/net/eww.el (eww-before-browse-history-function): New option. (eww-history-position): Add docstring. (eww-mode-map, eww-context-menu): Use correct predicates for when to enable back/forward. (eww-save-history): Save history entry in its original place when viewing a historical page. (eww--before-browse): New function... (eww, eww-follow-link, eww-readable): ... call it. (eww-render): Don't set 'eww-history-position' here... (eww--before-browse): ... instead, set it here. (eww-back-url): Set 'eww-history-position' based on the result of 'eww-save-history'. (eww-forward-url): Set 'eww-history-position' directly, since 'eww-save-history' no longer adds a new entry in this case. (eww-delete-future-history, eww-clone-previous-history): New functions. * test/lisp/net/eww-tests.el: New file. * etc/NEWS: Announce this change. --- doc/misc/eww.texi | 9 +++ etc/NEWS | 13 ++++ lisp/net/eww.el | 123 ++++++++++++++++++++++++++++--- test/lisp/net/eww-tests.el | 179 +++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 312 insertions(+), 12 deletions(-) create mode 100644 test/lisp/net/eww-tests.el (limited to 'lisp') diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index 5e69b11d347..d31fcf1802b 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -192,6 +192,15 @@ history press @kbd{H} (@code{eww-list-histories}) to open the history buffer @file{*eww history*}. The history is lost when EWW is quit. If you want to remember websites you can use bookmarks. +@vindex eww-before-browse-history-function + By default, when browsing to a new page from a ``historical'' one +(i.e.@: a page loaded by navigating back via @code{eww-back-url}), EWW +will first delete any history entries newer than the current page. This +is the same behavior as most other web browsers. You can change this by +customizing @code{eww-before-browse-history-function} to another value. +For example, setting it to @code{ignore} will preserve the existing +history entries and simply prepend the new page to the history list. + @vindex eww-history-limit Along with the URLs visited, EWW also remembers both the rendered page (as it appears in the buffer) and its source. This can take a diff --git a/etc/NEWS b/etc/NEWS index fd957fdb115..745b3b12936 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1018,6 +1018,19 @@ When invoked with the prefix argument ('C-u'), This is useful for continuing reading the URL in the current buffer when the new URL is fetched. +--- +*** History navigation in EWW now works like other browsers. +Previously, when navigating back and forward through page history, EWW +would add a duplicate entry to the end of the history list each time. +This made it impossible to navigate to the "end" of the history list. +Now, navigating through history in EWW simply changes your position in +the history list, allowing you to reach the end as expected. In +addition, when browsing to a new page from a "historical" one (i.e. a +page loaded by navigating back through history), EWW deletes the history +entries newer than the current page. To change the behavior when +browsing from "historical" pages, you can customize +'eww-before-browse-history-function'. + ** go-ts-mode +++ diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 5a25eef9e3c..2936bc8f099 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -182,6 +182,33 @@ the tab bar is enabled." (const :tag "Open new tab when tab bar is enabled" tab-bar) (const :tag "Never open URL in new tab" nil))) +(defcustom eww-before-browse-history-function #'eww-delete-future-history + "A function to call to update history before browsing to a new page. +EWW provides the following values for this option: + +* `eww-delete-future-history': Delete any history entries after the + currently-shown one. This is the default behavior, and works the same + as in most other web browsers. + +* `eww-clone-previous-history': Clone and prepend any history entries up + to the currently-shown one. This is like `eww-delete-future-history', + except that it preserves the previous contents of the history list at + the end. + +* `ignore': Preserve the current history unchanged. This will result in + the new page simply being prepended to the existing history list. + +You can also set this to any other function you wish." + :version "30.1" + :group 'eww + :type '(choice (function-item :tag "Delete future history" + eww-delete-future-history) + (function-item :tag "Clone previous history" + eww-clone-previous-history) + (function-item :tag "Preserve history" + ignore) + (function :tag "Custom function"))) + (defcustom eww-after-render-hook nil "A hook called after eww has finished rendering the buffer." :version "25.1" @@ -312,7 +339,10 @@ parameter, and should return the (possibly) transformed URL." (defvar eww-data nil) (defvar eww-history nil) -(defvar eww-history-position 0) +(defvar eww-history-position 0 + "The 1-indexed position in `eww-history'. +If zero, EWW is at the newest page, which isn't yet present in +`eww-history'.") (defvar eww-prompt-history nil) (defvar eww-local-regex "localhost" @@ -402,6 +432,7 @@ For more information, see Info node `(eww) Top'." (t (get-buffer-create "*eww*")))) (eww-setup-buffer) + (eww--before-browse) ;; Check whether the domain only uses "Highly Restricted" Unicode ;; IDNA characters. If not, transform to punycode to indicate that ;; there may be funny business going on. @@ -654,7 +685,6 @@ The renaming scheme is performed in accordance with (with-current-buffer buffer (plist-put eww-data :url url) (eww--after-page-change) - (setq eww-history-position 0) (and last-coding-system-used (set-buffer-file-coding-system last-coding-system-used)) (unless shr-fill-text @@ -905,6 +935,11 @@ The renaming scheme is performed in accordance with `((?u . ,(or url "")) (?t . ,title)))))))) +(defun eww--before-browse () + (funcall eww-before-browse-history-function) + (setq eww-history-position 0 + eww-data (list :title ""))) + (defun eww--after-page-change () (eww-update-header-line-format) (eww--rename-buffer)) @@ -1037,6 +1072,7 @@ the like." (base (plist-get eww-data :url))) (eww-score-readability dom) (eww-save-history) + (eww--before-browse) (eww-display-html nil nil (list 'base (list (cons 'href base)) (eww-highest-readability dom)) @@ -1129,9 +1165,9 @@ the like." ["Reload" eww-reload t] ["Follow URL in new buffer" eww-open-in-new-buffer] ["Back to previous page" eww-back-url - :active (not (zerop (length eww-history)))] + :active (< eww-history-position (length eww-history))] ["Forward to next page" eww-forward-url - :active (not (zerop eww-history-position))] + :active (> eww-history-position 1)] ["Browse with external browser" eww-browse-with-external-browser t] ["Download" eww-download t] ["View page source" eww-view-source] @@ -1155,9 +1191,9 @@ the like." (easy-menu-define nil easy-menu nil '("Eww" ["Back to previous page" eww-back-url - :visible (not (zerop (length eww-history)))] + :active (< eww-history-position (length eww-history))] ["Forward to next page" eww-forward-url - :visible (not (zerop eww-history-position))] + :active (> eww-history-position 1)] ["Reload" eww-reload t])) (dolist (item (reverse (lookup-key easy-menu [menu-bar eww]))) (when (consp item) @@ -1280,16 +1316,20 @@ instead of `browse-url-new-window-flag'." (interactive nil eww-mode) (when (>= eww-history-position (length eww-history)) (user-error "No previous page")) - (eww-save-history) - (setq eww-history-position (+ eww-history-position 2)) + (if (eww-save-history) + ;; We were at the latest page (which was just added to the + ;; history), so go back two entries. + (setq eww-history-position 2) + (setq eww-history-position (1+ eww-history-position))) (eww-restore-history (elt eww-history (1- eww-history-position)))) (defun eww-forward-url () "Go to the next displayed page." (interactive nil eww-mode) - (when (zerop eww-history-position) + (when (<= eww-history-position 1) (user-error "No next page")) (eww-save-history) + (setq eww-history-position (1- eww-history-position)) (eww-restore-history (elt eww-history (1- eww-history-position)))) (defun eww-restore-history (elem) @@ -1959,6 +1999,7 @@ If EXTERNAL is double prefix, browse in new buffer." (eww-same-page-p url (plist-get eww-data :url))) (let ((point (point))) (eww-save-history) + (eww--before-browse) (plist-put eww-data :url url) (goto-char (point-min)) (if-let ((match (text-property-search-forward 'shr-target-id target #'member))) @@ -2289,11 +2330,69 @@ If ERROR-OUT, signal user-error if there are no bookmarks." ;;; History code (defun eww-save-history () + "Save the current page's data to the history. +If the current page is a historial one loaded from +`eww-history' (e.g. by calling `eww-back-url'), this will update the +page's entry in `eww-history' and return nil. Otherwise, add a new +entry to `eww-history' and return t." (plist-put eww-data :point (point)) (plist-put eww-data :text (buffer-string)) - (let ((history-delete-duplicates nil)) - (add-to-history 'eww-history eww-data eww-history-limit t)) - (setq eww-data (list :title ""))) + (if (zerop eww-history-position) + (let ((history-delete-duplicates nil)) + (add-to-history 'eww-history eww-data eww-history-limit t) + (setq eww-history-position 1) + t) + (setf (elt eww-history (1- eww-history-position)) eww-data) + nil)) + +(defun eww-delete-future-history () + "Remove any entries in `eww-history' after the currently-shown one. +This is useful for `eww-before-browse-history-function' to make EWW's +navigation to a new page from a historical one work like other web +browsers: it will delete any \"future\" history elements before adding +the new page to the end of the history. + +For example, if `eww-history' looks like this (going from newest to +oldest, with \"*\" marking the current page): + + E D C* B A + +then calling this function updates `eww-history' to: + + C* B A" + (when (> eww-history-position 1) + (setq eww-history (nthcdr (1- eww-history-position) eww-history) + ;; We don't really need to set this since `eww--before-browse' + ;; sets it too, but this ensures that other callers can use + ;; this function and get the expected results. + eww-history-position 1))) + +(defun eww-clone-previous-history () + "Clone and prepend entries in `eww-history' up to the currently-shown one. +These cloned entries get added to the beginning of `eww-history' so that +it's possible to navigate back to the very first page for this EWW +without deleting any history entries. + +For example, if `eww-history' looks like this (going from newest to +oldest, with \"*\" marking the current page): + + E D C* B A + +then calling this function updates `eww-history' to: + + C* B A E D C B A + +This is useful for setting `eww-before-browse-history-function' (which +see)." + (when (> eww-history-position 1) + (setq eww-history (take eww-history-limit + (append (nthcdr (1- eww-history-position) + eww-history) + eww-history)) + ;; As with `eww-delete-future-history', we don't really need + ;; to set this since `eww--before-browse' sets it too, but + ;; let's be thorough. + eww-history-position 1))) (defvar eww-current-buffer) diff --git a/test/lisp/net/eww-tests.el b/test/lisp/net/eww-tests.el new file mode 100644 index 00000000000..ced84322e3a --- /dev/null +++ b/test/lisp/net/eww-tests.el @@ -0,0 +1,179 @@ +;;; eww-tests.el --- tests for eww.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'eww) + +(defvar eww-test--response-function (lambda (url) (concat "\n" url)) + "A function for returning a mock response for URL. +The default just returns an empty list of headers URL as the body.") + +(defmacro eww-test--with-mock-retrieve (&rest body) + "Evaluate BODY with a mock implementation of `eww-retrieve'. +This avoids network requests during our tests. Additionally, prepare a +temporary EWW buffer for our tests." + (declare (indent 1)) + `(cl-letf (((symbol-function 'eww-retrieve) + (lambda (url callback args) + (with-temp-buffer + (insert (funcall eww-test--response-function url)) + (apply callback nil args))))) + (with-temp-buffer + (eww-mode) + ,@body))) + +(defun eww-test--history-urls () + (mapcar (lambda (elem) (plist-get elem :url)) eww-history)) + +;;; Tests: + +(ert-deftest eww-test/history/new-page () + "Test that when visiting a new page, the previous one goes into the history." + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (should (equal (eww-test--history-urls) + '("http://one.invalid/"))) + (eww "three.invalid") + (should (equal (eww-test--history-urls) + '("http://two.invalid/" + "http://one.invalid/"))))) + +(ert-deftest eww-test/history/back-forward () + "Test that navigating through history just changes our history position. +See bug#69232." + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (let ((url-history '("http://three.invalid/" + "http://two.invalid/" + "http://one.invalid/"))) + ;; Go back one page. This should add "three.invalid" to the + ;; history, making our position in the list 2. + (eww-back-url) + (should (equal (eww-test--history-urls) url-history)) + (should (= eww-history-position 2)) + ;; Go back again. + (eww-back-url) + (should (equal (eww-test--history-urls) url-history)) + (should (= eww-history-position 3)) + ;; At the beginning of the history, so trying to go back should + ;; signal an error. + (should-error (eww-back-url)) + ;; Go forward once. + (eww-forward-url) + (should (equal (eww-test--history-urls) url-history)) + (should (= eww-history-position 2)) + ;; Go forward again. + (eww-forward-url) + (should (equal (eww-test--history-urls) url-history)) + (should (= eww-history-position 1)) + ;; At the end of the history, so trying to go forward should + ;; signal an error. + (should-error (eww-forward-url))))) + +(ert-deftest eww-test/history/reload-in-place () + "Test that reloading historical pages updates their history entry in-place. +See bug#69232." + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (eww-back-url) + ;; Make sure our history has the original page text. + (should (equal (plist-get (nth 1 eww-history) :text) + "http://two.invalid/")) + (should (= eww-history-position 2)) + ;; Reload the page. + (let ((eww-test--response-function + (lambda (url) (concat "\nreloaded " url)))) + (eww-reload) + (should (= eww-history-position 2))) + ;; Go to another page, and make sure the history is correct, + ;; including the reloaded page text. + (eww "four.invalid") + (should (equal (eww-test--history-urls) '("http://two.invalid/" + "http://one.invalid/"))) + (should (equal (plist-get (nth 0 eww-history) :text) + "reloaded http://two.invalid/")) + (should (= eww-history-position 0)))) + +(ert-deftest eww-test/history/before-navigate/delete-future-history () + "Test that going to a new page from a historical one deletes future history. +See bug#69232." + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (eww-back-url) + (eww "four.invalid") + (eww "five.invalid") + (should (equal (eww-test--history-urls) '("http://four.invalid/" + "http://two.invalid/" + "http://one.invalid/"))) + (should (= eww-history-position 0)))) + +(ert-deftest eww-test/history/before-navigate/ignore-history () + "Test that going to a new page from a historical one preserves history. +This sets `eww-before-browse-history-function' to `ignore' to preserve +history. See bug#69232." + (let ((eww-before-browse-history-function #'ignore)) + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (eww-back-url) + (eww "four.invalid") + (eww "five.invalid") + (should (equal (eww-test--history-urls) '("http://four.invalid/" + "http://three.invalid/" + "http://two.invalid/" + "http://one.invalid/"))) + (should (= eww-history-position 0))))) + +(ert-deftest eww-test/history/before-navigate/clone-previous () + "Test that going to a new page from a historical one clones prior history. +This sets `eww-before-browse-history-function' to +`eww-clone-previous-history' to clone the history. See bug#69232." + (let ((eww-before-browse-history-function #'eww-clone-previous-history)) + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (eww-back-url) + (eww "four.invalid") + (eww "five.invalid") + (should (equal (eww-test--history-urls) + '(;; New page and cloned history. + "http://four.invalid/" + "http://two.invalid/" + "http://one.invalid/" + ;; Original history. + "http://three.invalid/" + "http://two.invalid/" + "http://one.invalid/"))) + (should (= eww-history-position 0))))) + +(provide 'eww-tests) +;; eww-tests.el ends here -- cgit v1.2.3 From 8aabd835747297818d538cc16b3f53fcc1dd67f6 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 7 Mar 2024 09:56:02 +0200 Subject: * lisp/follow.el: Put property 'isearch-scroll' on 'follow-recenter'. --- lisp/follow.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/follow.el b/lisp/follow.el index ce40317ca59..874e546bd6d 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -874,6 +874,7 @@ from the bottom." (when (< dest win-s) (setq follow-internal-force-redisplay t)))))) +(put 'follow-recenter 'isearch-scroll t) (defun follow-redraw () "Arrange windows displaying the same buffer in successor order. -- cgit v1.2.3 From 5ffcca121bb79b97c6a0f941c71a61505032d8f8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 7 Mar 2024 10:11:44 +0200 Subject: ; Improve documentation of image properties * lisp/image.el (create-image, image-property): Add to do strings link to description of image properties in ELisp manual. * doc/lispref/display.texi (Defining Images): Fix example and add cross-reference to where image properties are described. (Image Descriptors): Add index entry. --- doc/lispref/display.texi | 9 +++++++-- lisp/image.el | 16 ++++++++++++---- 2 files changed, 19 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 34f215820ed..c6b29e87b3a 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -6041,6 +6041,7 @@ event is composed by combining the @var{id} of the hot-spot with the mouse event; for instance, @code{[area4 mouse-1]} if the hot-spot's @var{id} is @code{area4}. +@findex image-compute-scaling-factor Note that the map's coordinates should reflect the displayed image after all transforms have been done (rotation, scaling and so on), and also note that Emacs (by default) performs auto-scaling of images, so @@ -6759,11 +6760,15 @@ from the file's name. The remaining arguments, @var{props}, specify additional image properties---for example, -@c ':heuristic-mask' is not documented? @example -(create-image "foo.xpm" 'xpm nil :heuristic-mask t) +(create-image "foo.xpm" 'xpm nil :mask 'heuristic) @end example +@noindent +@xref{Image Descriptors}, for the list of supported properties. Some +properties are specific to certain image types, and are described in +subsections specific to those types. + The function returns @code{nil} if images of this type are not supported. Otherwise it returns an image descriptor. @end defun diff --git a/lisp/image.el b/lisp/image.el index ef29698f647..4e50f678433 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -494,9 +494,13 @@ use its file extension as image type. Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data. Optional PROPS are additional image attributes to assign to the image, -like, e.g. `:mask MASK'. If the property `:scale' is not given and the -display has a high resolution (more exactly, when the average width of a -character in the default font is more than 10 pixels), the image is +like, e.g. `:mask MASK'. See Info node `(elisp)Image Descriptors' for +the list of supported properties; see the nodes following that node +for properties specific to certain image types. + +If the property `:scale' is not given and the display has a high +resolution (more exactly, when the average width of a character +in the default font is more than 10 pixels), the image is automatically scaled up in proportion to the default font. Value is the image created, or nil if images of type TYPE are not supported. @@ -571,7 +575,11 @@ Internal use only." Properties can be set with (setf (image-property IMAGE PROPERTY) VALUE) -If VALUE is nil, PROPERTY is removed from IMAGE." +If VALUE is nil, PROPERTY is removed from IMAGE. + +See Info node `(elisp)Image Descriptors' for the list of +supported properties; see the nodes following that node for +properties specific to certain image types." (declare (gv-setter image--set-property)) (plist-get (cdr image) property)) -- cgit v1.2.3 From 61b2f5f96b1d9dfd2fd908e09fac0d4163049c42 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Wed, 6 Mar 2024 12:03:06 +0100 Subject: Single string literal in body is return value only, not doc string A function or macro body consisting of a single string literal now only uses it as a return value. Previously, it had the dual uses as return value and doc string, which was never what the programmer wanted and had some inconvenient consequences (bug#69387). This change applies to `lambda`, `defun`, `defsubst` and `defmacro` forms; most other defining forms already worked in the sensible way. * lisp/emacs-lisp/bytecomp.el (byte-compile-lambda): Don't use a lone string literal as doc string. * test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el (foo): Update docstring warning test. * doc/lispref/functions.texi (Function Documentation): Update. * etc/NEWS: Announce. --- doc/lispref/functions.texi | 13 ++++++------- etc/NEWS | 16 ++++++++++++++++ lisp/emacs-lisp/bytecomp.el | 9 ++++----- .../bytecomp-resources/warn-wide-docstring-defun.el | 3 ++- 4 files changed, 28 insertions(+), 13 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 344b3ff3a50..ff635fc54b2 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -498,13 +498,12 @@ indentation of the following lines is inside the string; what looks nice in the source code will look ugly when displayed by the help commands. - You may wonder how the documentation string could be optional, since -there are required components of the function that follow it (the body). -Since evaluation of a string returns that string, without any side effects, -it has no effect if it is not the last form in the body. Thus, in -practice, there is no confusion between the first form of the body and the -documentation string; if the only body form is a string then it serves both -as the return value and as the documentation. + A documentation string must always be followed by at least one Lisp +expression; otherwise, it is not a documentation string at all but the +single expression of the body and used as the return value. +When there is no meaningful value to return from a function, it is +standard practice to return @code{nil} by adding it after the +documentation string. The last line of the documentation string can specify calling conventions different from the actual function arguments. Write diff --git a/etc/NEWS b/etc/NEWS index 745b3b12936..3a57084688d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1818,6 +1818,22 @@ Tree-sitter conditionally sets 'forward-sexp-function' for major modes that have defined 'sexp' in 'treesit-thing-settings' to enable sexp-related motion commands. ++++ +** Returned strings are never docstrings. +Functions and macros whose bodies consist of a single string literal now +only return that string; it is not used as a docstring. Example: + + (defun sing-a-song () + "Sing a song.") + +The above function returns the string '"Sing a song."' but has no +docstring. Previously, that string was used as both a docstring and +return value, which was never what the programmer wanted. If you want +the string to be a docstring, add an explicit return value. + +This change applies to 'defun', 'defsubst', 'defmacro' and 'lambda' +forms; other defining forms such as 'cl-defun' already worked this way. + ** New or changed byte-compilation warnings --- diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index c3355eedd75..cf0e6d600dd 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3061,12 +3061,11 @@ lambda-expression." (append (if (not lexical-binding) arglistvars) byte-compile-bound-variables)) (body (cdr (cdr fun))) - (doc (if (stringp (car body)) + ;; Treat a final string literal as a value, not a doc string. + (doc (if (and (cdr body) (stringp (car body))) (prog1 (car body) - ;; Discard the doc string from the body - ;; unless it is the last element of the body. - (if (cdr body) - (setq body (cdr body)))))) + ;; Discard the doc string from the body. + (setq body (cdr body))))) (int (assq 'interactive body)) command-modes) (when lexical-binding diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el index 94b0e80c979..571f7f6f095 100644 --- a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el @@ -1,3 +1,4 @@ ;;; -*- lexical-binding: t -*- (defun foo () - "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") + "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" + nil) -- cgit v1.2.3 From 90c2e287b7654c22b66012059c953c976c1596c1 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 7 Mar 2024 14:29:36 +0100 Subject: Revert "Suppress docstring control char warning in macro-generated function" This reverts commit eeb89a5cb292bffe40ba7d0b0cf81f82f8452bf8. It is no longer needed now that (lambda (...) "string") does not have a doc string (bug#69387). --- lisp/progmodes/cc-defs.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 2c793c8a99d..e45ab76ec07 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -2579,8 +2579,7 @@ constant. A file is identified by its base name." ;; dependencies on the `c-lang-const's in VAL.) (setq val (c--macroexpand-all val)) - (setq bindings `(cons (cons ',assigned-mode (lambda () nil ,val)) - ,bindings) + (setq bindings `(cons (cons ',assigned-mode (lambda () ,val)) ,bindings) args (cdr args)))) ;; Compile in the other files that have provided source -- cgit v1.2.3 From e42f14f0e034d0b20c6b9fd0fea23686699e7df0 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Wed, 6 Mar 2024 13:27:07 -0800 Subject: Support expanding Eshell globs for remote file names * lisp/eshell/em-glob.el (eshell-glob-chars-regexp): New function... (eshell-glob-regexp): ... use it. (eshell-glob-p): New function... (eshell-glob-convert): ... use it, and return the deepest start directory possible. * lisp/eshell/esh-util.el (eshell-split-path): Rename to... (eshell-split-path): ... this, and account for remote file names. * test/lisp/eshell/em-glob-tests.el (em-glob-test/convert/current-start-directory) (em-glob-test/convert/relative-start-directory) (em-glob-test/convert/absolute-start-directory) (em-glob-test/convert/remote-start-directory): New tests (bug#69592). --- lisp/eshell/em-glob.el | 36 +++++++++++++++++---------- lisp/eshell/esh-util.el | 51 +++++++++++++++++++++------------------ test/lisp/eshell/em-glob-tests.el | 30 +++++++++++++++++++++++ 3 files changed, 81 insertions(+), 36 deletions(-) (limited to 'lisp') diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index b0c3e6e7a11..7fc6958a00f 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -190,6 +190,12 @@ interpretation." '(("**/" . recurse) ("***/" . recurse-symlink))) +(defsubst eshell-glob-chars-regexp () + "Return the lazily-created value for `eshell-glob-chars-regexp'." + (or eshell-glob-chars-regexp + (setq-local eshell-glob-chars-regexp + (format "[%s]+" (apply 'string eshell-glob-chars-list))))) + (defun eshell-glob-regexp (pattern) "Convert glob-pattern PATTERN to a regular expression. The basic syntax is: @@ -210,11 +216,8 @@ set to true, then these characters will match themselves in the resulting regular expression." (let ((matched-in-pattern 0) ; How much of PATTERN handled regexp) - (while (string-match - (or eshell-glob-chars-regexp - (setq-local eshell-glob-chars-regexp - (format "[%s]+" (apply 'string eshell-glob-chars-list)))) - pattern matched-in-pattern) + (while (string-match (eshell-glob-chars-regexp) + pattern matched-in-pattern) (let* ((op-begin (match-beginning 0)) (op-char (aref pattern op-begin))) (setq regexp @@ -239,6 +242,10 @@ resulting regular expression." (regexp-quote (substring pattern matched-in-pattern)) "\\'"))) +(defun eshell-glob-p (pattern) + "Return non-nil if PATTERN has any special glob characters." + (string-match (eshell-glob-chars-regexp) pattern)) + (defun eshell-glob-convert-1 (glob &optional last) "Convert a GLOB matching a single element of a file name to regexps. If LAST is non-nil, this glob is the last element of a file name. @@ -291,14 +298,13 @@ The result is a list of three elements: symlinks. 3. A boolean indicating whether to match directories only." - (let ((globs (eshell-split-path glob)) - (isdir (eq (aref glob (1- (length glob))) ?/)) + (let ((globs (eshell-split-filename glob)) + (isdir (string-suffix-p "/" glob)) start-dir result last-saw-recursion) (if (and (cdr globs) (file-name-absolute-p (car globs))) - (setq start-dir (car globs) - globs (cdr globs)) - (setq start-dir ".")) + (setq start-dir (pop globs)) + (setq start-dir (file-name-as-directory "."))) (while globs (if-let ((recurse (cdr (assoc (car globs) eshell-glob-recursive-alist)))) @@ -306,11 +312,15 @@ The result is a list of three elements: (setcar result recurse) (push recurse result) (setq last-saw-recursion t)) - (push (eshell-glob-convert-1 (car globs) (null (cdr globs))) - result) + (if (or result (eshell-glob-p (car globs))) + (push (eshell-glob-convert-1 (car globs) (null (cdr globs))) + result) + ;; We haven't seen a glob yet, so instead append to the start + ;; directory. + (setq start-dir (file-name-concat start-dir (car globs)))) (setq last-saw-recursion nil)) (setq globs (cdr globs))) - (list (file-name-as-directory start-dir) + (list start-dir (nreverse result) isdir))) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index f0acfecb701..129134814e3 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -447,29 +447,34 @@ Prepend remote identification of `default-directory', if any." (parse-colon-path path-env)) (parse-colon-path path-env)))) -(defun eshell-split-path (path) - "Split a path into multiple subparts." - (let ((len (length path)) - (i 0) (li 0) - parts) - (if (and (eshell-under-windows-p) - (> len 2) - (eq (aref path 0) ?/) - (eq (aref path 1) ?/)) - (setq i 2)) - (while (< i len) - (if (and (eq (aref path i) ?/) - (not (get-text-property i 'escaped path))) - (setq parts (cons (if (= li i) "/" - (substring path li (1+ i))) parts) - li (1+ i))) - (setq i (1+ i))) - (if (< li i) - (setq parts (cons (substring path li i) parts))) - (if (and (eshell-under-windows-p) - (string-match "\\`[A-Za-z]:\\'" (car (last parts)))) - (setcar (last parts) (concat (car (last parts)) "/"))) - (nreverse parts))) +(defun eshell-split-filename (filename) + "Split a FILENAME into a list of file/directory components." + (let* ((remote (file-remote-p filename)) + (filename (file-local-name filename)) + (len (length filename)) + (index 0) (curr-start 0) + parts) + (when (and (eshell-under-windows-p) + (string-prefix-p "//" filename)) + (setq index 2)) + (while (< index len) + (when (and (eq (aref filename index) ?/) + (not (get-text-property index 'escaped filename))) + (push (if (= curr-start index) "/" + (substring filename curr-start (1+ index))) + parts) + (setq curr-start (1+ index))) + (setq index (1+ index))) + (when (< curr-start len) + (push (substring filename curr-start) parts)) + (setq parts (nreverse parts)) + (when (and (eshell-under-windows-p) + (string-match "\\`[A-Za-z]:\\'" (car parts))) + (setcar parts (concat (car parts) "/"))) + (if remote (cons remote parts) parts))) + +(define-obsolete-function-alias 'eshell-split-path + 'eshell-split-filename "30.1") (defun eshell-to-flat-string (value) "Make value a string. If separated by newlines change them to spaces." diff --git a/test/lisp/eshell/em-glob-tests.el b/test/lisp/eshell/em-glob-tests.el index 6d922666ea3..fc460a59eed 100644 --- a/test/lisp/eshell/em-glob-tests.el +++ b/test/lisp/eshell/em-glob-tests.el @@ -61,6 +61,9 @@ component ending in \"symlink\" is treated as a symbolic link." ;;; Tests: + +;; Glob expansion + (ert-deftest em-glob-test/expand/splice-results () "Test that globs are spliced into the argument list when `eshell-glob-splice-results' is non-nil." @@ -115,6 +118,33 @@ value of `eshell-glob-splice-results'." (eshell-command-result-equal "list ${listify *.no}" '(("*.no")))))))) + +;; Glob conversion + +(ert-deftest em-glob-test/convert/current-start-directory () + "Test converting a glob starting in the current directory." + (should (equal (eshell-glob-convert "*.el") + '("./" (("\\`.*\\.el\\'" . "\\`\\.")) nil)))) + +(ert-deftest em-glob-test/convert/relative-start-directory () + "Test converting a glob starting in a relative directory." + (should (equal (eshell-glob-convert "some/where/*.el") + '("./some/where/" (("\\`.*\\.el\\'" . "\\`\\.")) nil)))) + +(ert-deftest em-glob-test/convert/absolute-start-directory () + "Test converting a glob starting in an absolute directory." + (should (equal (eshell-glob-convert "/some/where/*.el") + '("/some/where/" (("\\`.*\\.el\\'" . "\\`\\.")) nil)))) + +(ert-deftest em-glob-test/convert/remote-start-directory () + "Test converting a glob starting in a remote directory." + (should (equal (eshell-glob-convert "/ssh:nowhere.invalid:some/where/*.el") + '("/ssh:nowhere.invalid:/some/where/" + (("\\`.*\\.el\\'" . "\\`\\.")) nil)))) + + +;; Glob matching + (ert-deftest em-glob-test/match-any-string () "Test that \"*\" pattern matches any string." (with-fake-files '("a.el" "b.el" "c.txt" "dir/a.el") -- cgit v1.2.3 From 00f86833ac5423d57825213ef8b611978be0a3eb Mon Sep 17 00:00:00 2001 From: Harald Jörg Date: Fri, 8 Mar 2024 00:37:36 +0100 Subject: ; perl-mode, cperl-mode: Fix $\" in strings (Bug#69604) * lisp/progmodes/perl-mode.el (perl-syntax-propertize-function): Add to syntax-propertize-rules that $ is punctuation in strings. * lisp/progmodes/cperl-mode.el (cperl-find-pods-heres): capture $\ to catch the edge case of "$\"". Make $ a punctuation char in strings and comments. * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-bug-69604): New testcases with various combinations of $ " \ --- lisp/progmodes/cperl-mode.el | 12 ++++++++++-- lisp/progmodes/perl-mode.el | 11 ++++++++++- test/lisp/progmodes/cperl-mode-tests.el | 19 +++++++++++++++++++ 3 files changed, 39 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 113eed64917..10ac80dffd5 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -4014,7 +4014,10 @@ recursive calls in starting lines of here-documents." ;; 1+6+2+1+1+6+1+1+1=20 extra () before this: "\\|" ;; -------- backslash-escaped stuff, don't interpret it - "\\\\\\(['`\"($]\\)") ; BACKWACKED something-hairy + "\\\\\\(['`\"($]\\)" ; BACKWACKED something-hairy + "\\|" + ;; -------- $\ is a variable in code, but not in a string + "\\(\\$\\\\\\)") ""))) warning-message) (unwind-protect @@ -4068,7 +4071,12 @@ recursive calls in starting lines of here-documents." (cperl-modify-syntax-type bb cperl-st-punct))) ;; No processing in strings/comments beyond this point: ((or (nth 3 state) (nth 4 state)) - t) ; Do nothing in comment/string + ;; Edge case: In a double-quoted string, $\ is not the + ;; punctuation variable, $ must not quote \ here. We + ;; generally make $ a punctuation character in strings + ;; and comments (Bug#69604). + (when (match-beginning 22) + (cperl-modify-syntax-type (match-beginning 22) cperl-st-punct))) ((match-beginning 1) ; POD section ;; "\\(\\`\n?\\|^\n\\)=" (setq b (match-beginning 0) diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index f74390841fe..f6c4dbed1e2 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -251,7 +251,16 @@ ;; correctly the \() construct (Bug#11996) as well as references ;; to string values. ("\\(\\\\\\)['`\"($]" (1 (unless (nth 3 (syntax-ppss)) - (string-to-syntax ".")))) + (string-to-syntax ".")))) + ;; A "$" in Perl code must escape the next char to protect against + ;; misinterpreting Perl's punctuation variables as unbalanced + ;; quotes or parens. This is not needed in strings and broken in + ;; the special case of "$\"" (Bug#69604). Make "$" a punctuation + ;; char in strings. + ("\\$" (0 (if (save-excursion + (nth 3 (syntax-ppss (match-beginning 0)))) + (string-to-syntax ".") + (string-to-syntax "/")))) ;; Handle funny names like $DB'stop. ("\\$ ?{?\\^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_")) ;; format statements diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 62b7fdab7f7..9d9718f719c 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -1431,6 +1431,25 @@ cperl-mode fontifies text after the delimiter as Perl code." (should (equal (get-text-property (point) 'face) font-lock-comment-face)))) +(ert-deftest cperl-test-bug-69604 () + "Verify that $\" in a double-quoted string does not end the string. +Both `perl-mode' and `cperl-mode' treat ?$ as a quoting/escaping char to +avoid issues with punctuation variables. In a string, however, this is +not appropriate." + (let ((strings + '("\"$\\\" in string ---\"; # \"" ; $ must not quote \ + "$\" . \" in string ---\"; # \"" ; $ must quote \ + "\"\\$\" . \" in string ---\"; # \""))) ; \$ must not quote + (dolist (string strings) + (with-temp-buffer + (insert string) + (funcall cperl-test-mode) + (font-lock-ensure) + (goto-char (point-min)) + (search-forward "in string") + (should (equal (get-text-property (point) 'face) + font-lock-string-face)))))) + (ert-deftest test-indentation () (ert-test-erts-file (ert-resource-file "cperl-indents.erts"))) -- cgit v1.2.3 From 9830421e964cfb39077b69efd38d122e3bacf5d4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 7 Mar 2024 16:56:42 -0500 Subject: comp-cstr.el: Fix a minor error and prepare for upcoming changes * lisp/emacs-lisp/comp-cstr.el (comp--cl-class-hierarchy): Add `atom` and `t` only to those types whose "allparents" is clearly not complete. (comp--compute--pred-type-h): Store the cstr rather than the type in the hash-table, as expected by `comp--pred-to-cstr`. --- lisp/emacs-lisp/comp-cstr.el | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 55d92841cd5..1c6acaa6385 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -89,12 +89,15 @@ Integer values are handled in the `range' slot.") (defun comp--cl-class-hierarchy (x) "Given a class name `x' return its hierarchy." - `(,@(cl--class-allparents (cl--struct-get-class x)) - ;; FIXME: AFAICT, `comp--all-classes' will also find those struct types - ;; which use :type and can thus be either `vector' or `cons' (the latter - ;; isn't `atom'). - atom - t)) + (let ((parents (cl--class-allparents (cl--struct-get-class x)))) + (if (memq t parents) + parents + `(,@parents + ;; FIXME: AFAICT, `comp--all-classes' will also find those struct types + ;; which use :type and can thus be either `vector' or `cons' (the latter + ;; isn't `atom'). + atom + t)))) (defun comp--all-classes () "Return all non built-in type names currently defined." @@ -114,7 +117,7 @@ Integer values are handled in the `range' slot.") for class-name in (comp--all-classes) for pred = (get class-name 'cl-deftype-satisfies) when pred - do (puthash pred class-name h) + do (puthash pred (comp--type-to-cstr class-name) h) finally return h)) (cl-defstruct comp-cstr-ctxt -- cgit v1.2.3 From 4fdcbd09af29e72456c9ca4cfbc9f6e97a88f8b8 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 6 Mar 2024 16:32:35 -0500 Subject: cl-preloaded.el (built-in-class): New type Add classes describing the built-in types. * lisp/emacs-lisp/cl-preloaded.el (built-in-class): New type. (cl--define-built-in-type): New aux macro. (all built-in types): "Define" them with it. (cl--builtin-type-p): New aux function. (cl--struct-name-p): Use it. (cl--direct-supertypes-of-type, cl--typeof-types, cl--all-builtin-types): Move the definitions to after the built-in classes are defined, and rewrite to make use of those classes. * lisp/emacs-lisp/cl-extra.el (cl-describe-type): Accept two (unused) optional args, for use with `describe-symbol-backends`. (describe-symbol-backends): Simplify accordingly and add ourselves at the end. (cl--class-children): New function. (cl--describe-class): Use it. Also don't show a silly empty list of slots for the built-in types. --- etc/NEWS | 5 + lisp/emacs-lisp/cl-extra.el | 56 ++++++---- lisp/emacs-lisp/cl-preloaded.el | 241 +++++++++++++++++++++++++++------------- 3 files changed, 200 insertions(+), 102 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index 3a57084688d..2aa669be344 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1612,6 +1612,11 @@ values. * Lisp Changes in Emacs 30.1 +** Built-in types have now corresponding classes. +At the Lisp level, this means that things like (cl-find-class 'integer) +will now return a class object, and at the UI level it means that +things like 'C-h o integer RET' will show some information about that type. + ** New var 'major-mode-remap-defaults' and function 'major-mode-remap'. The first is like Emacs-29's 'major-mode-remap-alist' but to be set by packages (instead of users). The second looks up those two variables. diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 9281cd9821e..c8eaca9a77c 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -714,7 +714,9 @@ PROPLIST is a list of the sort returned by `symbol-plist'. ;; FIXME: We could go crazy and add another entry so describe-symbol can be ;; used with the slot names of CL structs (and/or EIEIO objects). (add-to-list 'describe-symbol-backends - `(nil ,#'cl-find-class ,(lambda (s _b _f) (cl-describe-type s)))) + `(nil ,#'cl-find-class ,#'cl-describe-type) + ;; Document the `cons` function before the `cons` type. + t) (defconst cl--typedef-regexp (concat "(" (regexp-opt '("defclass" "defstruct" "cl-defstruct" @@ -744,7 +746,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'" (cl--find-class type)) ;;;###autoload -(defun cl-describe-type (type) +(defun cl-describe-type (type &optional _buf _frame) "Display the documentation for type TYPE (a symbol)." (interactive (let ((str (completing-read "Describe type: " obarray #'cl-find-class t))) @@ -766,6 +768,15 @@ Call `cl--find-class' to get TYPE's propname `cl--class'" ;; Return the text we displayed. (buffer-string))))) +(defun cl--class-children (class) + (let ((children '())) + (mapatoms + (lambda (sym) + (let ((sym-class (cl--find-class sym))) + (and sym-class (memq class (cl--class-parents sym-class)) + (push sym children))))) + children)) + (defun cl--describe-class (type &optional class) (unless class (setq class (cl--find-class type))) (let ((location (find-lisp-object-file-name type 'define-type)) @@ -796,10 +807,8 @@ Call `cl--find-class' to get TYPE's propname `cl--class'" (insert (substitute-command-keys (if pl "', " "'")))) (insert ".\n"))) - ;; Children, if available. ¡For EIEIO! - (let ((ch (condition-case nil - (cl-struct-slot-value metatype 'children class) - (cl-struct-unknown-slot nil))) + ;; Children. + (let ((ch (cl--class-children class)) cur) (when ch (insert " Children ") @@ -903,22 +912,25 @@ Outputs to the current buffer." (cslots (condition-case nil (cl-struct-slot-value metatype 'class-slots class) (cl-struct-unknown-slot nil)))) - (insert (propertize "Instance Allocated Slots:\n\n" - 'face 'bold)) - (let* ((has-doc nil) - (slots-strings - (mapcar - (lambda (slot) - (list (cl-prin1-to-string (cl--slot-descriptor-name slot)) - (cl-prin1-to-string (cl--slot-descriptor-type slot)) - (cl-prin1-to-string (cl--slot-descriptor-initform slot)) - (let ((doc (alist-get :documentation - (cl--slot-descriptor-props slot)))) - (if (not doc) "" - (setq has-doc t) - (substitute-command-keys doc))))) - slots))) - (cl--print-table `("Name" "Type" "Default") slots-strings has-doc)) + (if (and (null slots) (eq metatype 'built-in-class)) + (insert "This is a built-in type.\n") + + (insert (propertize "Instance Allocated Slots:\n\n" + 'face 'bold)) + (let* ((has-doc nil) + (slots-strings + (mapcar + (lambda (slot) + (list (cl-prin1-to-string (cl--slot-descriptor-name slot)) + (cl-prin1-to-string (cl--slot-descriptor-type slot)) + (cl-prin1-to-string (cl--slot-descriptor-initform slot)) + (let ((doc (alist-get :documentation + (cl--slot-descriptor-props slot)))) + (if (not doc) "" + (setq has-doc t) + (substitute-command-keys doc))))) + slots))) + (cl--print-table `("Name" "Type" "Default") slots-strings has-doc))) (insert "\n") (when (> (length cslots) 0) (insert (propertize "\nClass Allocated Slots:\n\n" 'face 'bold)) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index ea08d35ecec..882b4b5939b 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -50,90 +50,16 @@ (apply #'error string (append sargs args)) (signal 'cl-assertion-failed `(,form ,@sargs))))) -(defconst cl--direct-supertypes-of-type - ;; Please run `sycdoc-update-type-hierarchy' in - ;; `admin/syncdoc-type-hierarchy.el' each time this is modified to - ;; reflect the change in the documentation. - (let ((table (make-hash-table :test #'eq))) - ;; FIXME: Our type DAG has various quirks: - ;; - `subr' says it's a `compiled-function' but that's not true - ;; for those subrs that are special forms! - ;; - Some `keyword's are also `symbol-with-pos' but that's not reflected - ;; in the DAG. - ;; - An OClosure can be an interpreted function or a `byte-code-function', - ;; so the DAG of OClosure types is "orthogonal" to the distinction - ;; between interpreted and compiled functions. - (dolist (x '((sequence t) - (atom t) - (list sequence) - (array sequence atom) - (float number) - (integer number integer-or-marker) - (marker integer-or-marker) - (integer-or-marker number-or-marker) - (number number-or-marker) - (bignum integer) - (fixnum integer) - (keyword symbol) - (boolean symbol) - (symbol-with-pos symbol) - (vector array) - (bool-vector array) - (char-table array) - (string array) - ;; FIXME: This results in `atom' coming before `list' :-( - (null boolean list) - (cons list) - (function atom) - (byte-code-function compiled-function) - (subr compiled-function) - (module-function function) - (compiled-function function) - (subr-native-elisp subr) - (subr-primitive subr))) - (puthash (car x) (cdr x) table)) - ;; And here's the flat part of the hierarchy. - (dolist (atom '( tree-sitter-compiled-query tree-sitter-node - tree-sitter-parser user-ptr - font-object font-entity font-spec - condvar mutex thread terminal hash-table frame - ;; function ;; FIXME: can be a list as well. - buffer window process window-configuration - overlay number-or-marker - symbol obarray native-comp-unit)) - (cl-assert (null (gethash atom table))) - (puthash atom '(atom) table)) - table) - "Hash table TYPE -> SUPERTYPES.") - -(defconst cl--typeof-types - (letrec ((alist nil) - (allparents - (lambda (type) - ;; FIXME: copy&pasted from `cl--class-allparents'. - (let ((parents (gethash type cl--direct-supertypes-of-type))) - (unless parents - (message "Warning: Type without parent: %S!" type)) - (cons type - (merge-ordered-lists - ;; FIXME: Can't remember why `t' is excluded. - (mapcar allparents (remq t parents)))))))) - (maphash (lambda (type _) - (push (funcall allparents type) alist)) - cl--direct-supertypes-of-type) - alist) - "Alist of supertypes. -Each element has the form (TYPE . SUPERTYPES) where TYPE is one of -the symbols returned by `type-of', and SUPERTYPES is the list of its -supertypes from the most specific to least specific.") - -(defconst cl--all-builtin-types - (delete-dups (copy-sequence (apply #'append cl--typeof-types)))) +(defun cl--builtin-type-p (name) + (if (not (fboundp 'built-in-class-p)) ;; Early bootstrap + nil + (let ((class (and (symbolp name) (get name 'cl--class)))) + (and class (built-in-class-p class))))) (defun cl--struct-name-p (name) "Return t if NAME is a valid structure name for `cl-defstruct'." (and name (symbolp name) (not (keywordp name)) - (not (memq name cl--all-builtin-types)))) + (not (cl--builtin-type-p name)))) ;; When we load this (compiled) file during pre-loading, the cl--struct-class ;; code below will need to access the `cl-struct' info, since it's considered @@ -366,6 +292,161 @@ supertypes from the most specific to least specific.") (merge-ordered-lists (mapcar #'cl--class-allparents (cl--class-parents class))))) +(cl-defstruct (built-in-class + (:include cl--class) + (:constructor nil) + (:constructor built-in-class--make (name docstring parents)) + (:copier nil)) + ) + +(defmacro cl--define-built-in-type (name parents &optional docstring &rest _slots) + ;; `slots' is currently unused, but we could make it take + ;; a list of "slot like properties" together with the corresponding + ;; accessor, and then we could maybe even make `slot-value' work + ;; on some built-in types :-) + (declare (indent 2) (doc-string 3)) + (unless (listp parents) (setq parents (list parents))) + (unless (or parents (eq name t)) + (error "Missing parents for %S: %S" name parents)) + `(progn + (put ',name 'cl--class + (built-in-class--make ',name ,docstring + (mapcar (lambda (type) + (let ((class (get type 'cl--class))) + (unless class + (error "Unknown type: %S" type)) + class)) + ',parents))))) + +;; FIXME: Our type DAG has various quirks: +;; - `subr' says it's a `compiled-function' but that's not true +;; for those subrs that are special forms! +;; - Some `keyword's are also `symbol-with-pos' but that's not reflected +;; in the DAG. +;; - An OClosure can be an interpreted function or a `byte-code-function', +;; so the DAG of OClosure types is "orthogonal" to the distinction +;; between interpreted and compiled functions. + +(cl--define-built-in-type t nil "The type of everything.") +(cl--define-built-in-type atom t "The type of anything but cons cells.") + +(cl--define-built-in-type tree-sitter-compiled-query atom) +(cl--define-built-in-type tree-sitter-node atom) +(cl--define-built-in-type tree-sitter-parser atom) +(cl--define-built-in-type user-ptr atom) +(cl--define-built-in-type font-object atom) +(cl--define-built-in-type font-entity atom) +(cl--define-built-in-type font-spec atom) +(cl--define-built-in-type condvar atom) +(cl--define-built-in-type mutex atom) +(cl--define-built-in-type thread atom) +(cl--define-built-in-type terminal atom) +(cl--define-built-in-type hash-table atom) +(cl--define-built-in-type frame atom) +(cl--define-built-in-type buffer atom) +(cl--define-built-in-type window atom) +(cl--define-built-in-type process atom) +(cl--define-built-in-type window-configuration atom) +(cl--define-built-in-type overlay atom) +(cl--define-built-in-type number-or-marker atom + "Abstract super type of both `number's and `marker's.") +(cl--define-built-in-type symbol atom + "Type of symbols." + ;; Example of slots we could document. It would be desirable to + ;; have some way to extract this from the C code, or somehow keep it + ;; in sync (probably not for `cons' and `symbol' but for things like + ;; `font-entity'). + (name symbol-name) + (value symbol-value) + (function symbol-function) + (plist symbol-plist)) + +(cl--define-built-in-type obarray atom) +(cl--define-built-in-type native-comp-unit atom) + +(cl--define-built-in-type sequence t "Abstract super type of sequences.") +(cl--define-built-in-type list sequence) +(cl--define-built-in-type array (sequence atom) "Abstract super type of arrays.") +(cl--define-built-in-type number (number-or-marker) + "Abstract super type of numbers.") +(cl--define-built-in-type float (number)) +(cl--define-built-in-type integer-or-marker (number-or-marker) + "Abstract super type of both `integer's and `marker's.") +(cl--define-built-in-type integer (number integer-or-marker)) +(cl--define-built-in-type marker (integer-or-marker)) +(cl--define-built-in-type bignum (integer) + "Type of those integers too large to fit in a `fixnum'.") +(cl--define-built-in-type fixnum (integer) + (format "Type of small (fixed-size) integers. +The size depends on the Emacs version and compilation options. +For this build of Emacs it's %dbit." + (1+ (logb (1+ most-positive-fixnum))))) +(cl--define-built-in-type keyword (symbol) + "Type of those symbols whose first char is `:'.") +(cl--define-built-in-type boolean (symbol) + "Type of the canonical boolean values, i.e. either nil or t.") +(cl--define-built-in-type symbol-with-pos (symbol) + "Type of symbols augmented with source-position information.") +(cl--define-built-in-type vector (array)) +(cl--define-built-in-type record (atom) + "Abstract type of objects with slots.") +(cl--define-built-in-type bool-vector (array) "Type of bitvectors.") +(cl--define-built-in-type char-table (array) + "Type of special arrays that are indexed by characters.") +(cl--define-built-in-type string (array)) +(cl--define-built-in-type null (boolean list) ;FIXME: `atom' comes before `list'? + "Type of the nil value.") +(cl--define-built-in-type cons (list) + "Type of cons cells." + ;; Example of slots we could document. + (car car) (cdr cdr)) +(cl--define-built-in-type function (atom) + "Abstract super type of function values.") +(cl--define-built-in-type compiled-function (function) + "Abstract type of functions that have been compiled.") +(cl--define-built-in-type byte-code-function (compiled-function) + "Type of functions that have been byte-compiled.") +(cl--define-built-in-type subr (compiled-function) + "Abstract type of functions compiled to machine code.") +(cl--define-built-in-type module-function (function) + "Type of functions provided via the module API.") +(cl--define-built-in-type interpreted-function (function) + "Type of functions that have not been compiled.") +(cl--define-built-in-type subr-native-elisp (subr) + "Type of function that have been compiled by the native compiler.") +(cl--define-built-in-type subr-primitive (subr) + "Type of functions hand written in C.") + +(defconst cl--direct-supertypes-of-type + ;; Please run `sycdoc-update-type-hierarchy' in + ;; `admin/syncdoc-type-hierarchy.el' each time this is modified to + ;; reflect the change in the documentation. + (let ((table (make-hash-table :test #'eq))) + (mapatoms + (lambda (type) + (let ((class (get type 'cl--class))) + (when (built-in-class-p class) + (puthash type (mapcar #'cl--class-name (cl--class-parents class)) + table))))) + table) + "Hash table TYPE -> SUPERTYPES.") + +(defconst cl--typeof-types + (letrec ((alist nil)) + (maphash (lambda (type _) + (let ((class (get type 'cl--class))) + ;; FIXME: Can't remember why `t' is excluded. + (push (remq t (cl--class-allparents class)) alist))) + cl--direct-supertypes-of-type) + alist) + "Alist of supertypes. +Each element has the form (TYPE . SUPERTYPES) where TYPE is one of +the symbols returned by `type-of', and SUPERTYPES is the list of its +supertypes from the most specific to least specific.") + +(defconst cl--all-builtin-types + (delete-dups (copy-sequence (apply #'append cl--typeof-types)))) + (eval-and-compile (cl-assert (null (cl--class-parents (cl--find-class 'cl-structure-object))))) -- cgit v1.2.3 From 76e9c761a45e0157a8ca43eaaf928385d8e0c228 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 7 Mar 2024 15:26:12 -0500 Subject: * lisp/emacs-lisp/oclosure.el (oclosure): Make it a subtype of `function` --- lisp/emacs-lisp/oclosure.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index 26cd8594dfc..977d5735171 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -139,12 +139,15 @@ (:include cl--class) (:copier nil)) "Metaclass for OClosure classes." + ;; The `allparents' slot is used for the predicate that checks if a given + ;; object is an OClosure of a particular type. (allparents nil :read-only t :type (list-of symbol))) (setf (cl--find-class 'oclosure) (oclosure--class-make 'oclosure - "The root parent of all OClosure classes" - nil nil '(oclosure))) + "The root parent of all OClosure types" + nil (list (cl--find-class 'function)) + '(oclosure))) (defun oclosure--p (oclosure) (not (not (oclosure-type oclosure)))) -- cgit v1.2.3 From 7c127fc965fbe781141a6bccbe0b620dc7862b1d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 7 Mar 2024 16:58:15 -0500 Subject: Make "parentless" structs inherit from their builtin type * lisp/emacs-lisp/cl-preloaded.el (cl--struct-register-child): Register child only in struct parents. (cl-struct-define): Put the "type" as parent of parentless :type structs. Copy slots only from struct parent classes. (cl-structure-object): Set (manually) its parent to `record` and remove assertion that it has no parents. --- lisp/emacs-lisp/cl-preloaded.el | 31 ++++++++++++++++++++++--------- 1 file changed, 22 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 882b4b5939b..1b330e7f761 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -112,7 +112,7 @@ (defun cl--struct-register-child (parent tag) ;; Can't use (cl-typep parent 'cl-structure-class) at this stage ;; because `cl-structure-class' is defined later. - (while (recordp parent) + (while (cl--struct-class-p parent) (add-to-list (cl--struct-class-children-sym parent) tag) ;; Only register ourselves as a child of the leftmost parent since structs ;; can only have one parent. @@ -127,9 +127,14 @@ (with-suppressed-warnings ((obsolete cl-old-struct-compat-mode)) (message "cl-old-struct-compat-mode is obsolete!") (cl-old-struct-compat-mode 1))) - (if (eq type 'record) - ;; Defstruct using record objects. - (setq type nil)) + (when (eq type 'record) + ;; Defstruct using record objects. + (setq type nil) + ;; `cl-structure-class' and `cl-structure-object' are allowed to be + ;; defined without specifying the parent, because their parent + ;; doesn't exist yet when they're defined. + (cl-assert (or parent (memq name '(cl-structure-class + cl-structure-object))))) (cl-assert (or type (not named))) (if (boundp children-sym) (add-to-list children-sym tag) @@ -137,7 +142,9 @@ (and (null type) (eq (caar slots) 'cl-tag-slot) ;; Hide the tag slot from "standard" (i.e. non-`type'd) structs. (setq slots (cdr slots))) - (let* ((parent-class (when parent (cl--struct-get-class parent))) + (let* ((parent-class (if parent (cl--struct-get-class parent) + (cl--find-class (if (eq type 'list) 'cons + (or type 'record))))) (n (length slots)) (index-table (make-hash-table :test 'eq :size n)) (vslots (let ((v (make-vector n nil)) @@ -160,7 +167,9 @@ name docstring (unless (symbolp parent-class) (list parent-class)) type named vslots index-table children-sym tag print))) - (unless (symbolp parent-class) + (cl-assert (or (not (symbolp parent-class)) + (memq name '(cl-structure-class cl-structure-object)))) + (when (cl--struct-class-p parent-class) (let ((pslots (cl--struct-class-slots parent-class))) (or (>= n (length pslots)) (let ((ok t)) @@ -417,6 +426,13 @@ For this build of Emacs it's %dbit." (cl--define-built-in-type subr-primitive (subr) "Type of functions hand written in C.") +(unless (cl--class-parents (cl--find-class 'cl-structure-object)) + ;; When `cl-structure-object' is created, built-in classes didn't exist + ;; yet, so we couldn't put `record' as the parent. + ;; Fix it now to close the recursion. + (setf (cl--class-parents (cl--find-class 'cl-structure-object)) + (list (cl--find-class 'record)))) + (defconst cl--direct-supertypes-of-type ;; Please run `sycdoc-update-type-hierarchy' in ;; `admin/syncdoc-type-hierarchy.el' each time this is modified to @@ -447,9 +463,6 @@ supertypes from the most specific to least specific.") (defconst cl--all-builtin-types (delete-dups (copy-sequence (apply #'append cl--typeof-types)))) -(eval-and-compile - (cl-assert (null (cl--class-parents (cl--find-class 'cl-structure-object))))) - ;; Make sure functions defined with cl-defsubst can be inlined even in ;; packages which do not require CL. We don't put an autoload cookie ;; directly on that function, since those cookies only go to cl-loaddefs. -- cgit v1.2.3 From 945af4d9d11192d262f4fabbc66ee83f5beefc86 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 7 Mar 2024 17:45:41 -0500 Subject: eieio-core.el: Always put a parent in the parents of a class * lisp/emacs-lisp/eieio-core.el (eieio-defclass-internal): Always put a parent in the `parents` slot of the class. * lisp/emacs-lisp/eieio.el (eieio-class-parents): Remove the `eieio-default-superclass` if it's the only parent. (child-of-class-p): Handle all classes in the parents. (eieio-default-superclass): Adjust docstring. --- lisp/emacs-lisp/eieio-core.el | 31 +++++++++++-------------------- lisp/emacs-lisp/eieio.el | 12 ++++++++---- 2 files changed, 19 insertions(+), 24 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 9c526f67204..9945e19c65c 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -293,8 +293,7 @@ See `defclass' for more information." ;; reloading the file that does the `defclass', we don't ;; want to create a new class object. (eieio--class-make cname))) - (groups nil) ;; list of groups id'd from slots - (clearparent nil)) + (groups nil)) ;; list of groups id'd from slots ;; If this class already existed, and we are updating its structure, ;; make sure we keep the old child list. This can cause bugs, but @@ -317,6 +316,9 @@ See `defclass' for more information." (setf (eieio--class-children newc) children) (remhash cname eieio-defclass-autoload-map)))) + (unless (or superclasses (eq cname 'eieio-default-superclass)) + (setq superclasses '(eieio-default-superclass))) + (if superclasses (progn (dolist (p superclasses) @@ -336,16 +338,13 @@ See `defclass' for more information." (push c (eieio--class-parents newc)))))) ;; Reverse the list of our parents so that they are prioritized in ;; the same order as specified in the code. - (cl-callf nreverse (eieio--class-parents newc))) - ;; If there is nothing to loop over, then inherit from the - ;; default superclass. - (unless (eq cname 'eieio-default-superclass) - ;; adopt the default parent here, but clear it later... - (setq clearparent t) - ;; save new child in parent - (cl-pushnew cname (eieio--class-children eieio-default-superclass)) - ;; save parent in child - (setf (eieio--class-parents newc) (list eieio-default-superclass)))) + (cl-callf nreverse (eieio--class-parents newc)) + ;; Before adding new slots, let's add all the methods and classes + ;; in from the parent class. + (eieio-copy-parents-into-subclass newc)) + + (cl-assert (eq cname 'eieio-default-superclass)) + (setf (eieio--class-parents newc) (list (cl--find-class 'record)))) ;; turn this into a usable self-pointing symbol; FIXME: Why? (when eieio-backward-compatibility @@ -376,10 +375,6 @@ See `defclass' for more information." cname) "25.1"))) - ;; Before adding new slots, let's add all the methods and classes - ;; in from the parent class. - (eieio-copy-parents-into-subclass newc) - ;; Store the new class vector definition into the symbol. We need to ;; do this first so that we can call defmethod for the accessor. ;; The vector will be updated by the following while loop and will not @@ -512,10 +507,6 @@ See `defclass' for more information." ;; Set up the options we have collected. (setf (eieio--class-options newc) options) - ;; if this is a superclass, clear out parent (which was set to the - ;; default superclass eieio-default-superclass) - (if clearparent (setf (eieio--class-parents newc) nil)) - ;; Create the cached default object. (let ((cache (make-record newc (+ (length (eieio--class-slots newc)) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index fba69a36a97..74f5e21db7d 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -449,7 +449,12 @@ If EXTRA, include that in the string returned to represent the symbol." (defun eieio-class-parents (class) ;; FIXME: What does "(overload of variable)" mean here? "Return parent classes to CLASS. (overload of variable)." - (eieio--class-parents (eieio--full-class-object class))) + ;; (declare (obsolete cl--class-parents "30.1")) + (let ((parents (eieio--class-parents (eieio--full-class-object class)))) + (if (and (null (cdr parents)) + (eq (car parents) (cl--find-class 'eieio-default-superclass))) + nil + parents))) (define-obsolete-function-alias 'class-parents #'eieio-class-parents "24.4") @@ -497,7 +502,7 @@ If EXTRA, include that in the string returned to represent the symbol." (setq class (eieio--class-object class)) (cl-check-type class eieio--class) (while (and child (not (eq child class))) - (setq p (append p (eieio--class-parents child)) + (setq p (append p (cl--class-parents child)) child (pop p))) (if child t)))) @@ -680,8 +685,7 @@ If SLOT is unbound, do nothing." (defclass eieio-default-superclass nil nil "Default parent class for classes with no specified parent class. -Its slots are automatically adopted by classes with no specified parents. -This class is not stored in the `parent' slot of a class vector." +Its slots are automatically adopted by classes with no specified parents." :abstract t) (setq eieio-default-superclass (cl--find-class 'eieio-default-superclass)) -- cgit v1.2.3 From bd017175d4571e24ef1fdf84676136af1d36002d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 8 Mar 2024 01:48:59 -0500 Subject: Simplify type hierarchy operations Now that built-in types have classes that describe their relationships exactly like struct/eieio/oclosure classes, we can the code that navigates that DAG. * lisp/emacs-lisp/cl-generic.el (cl--generic-struct-tag): Move to `eieio-core.el`. (cl--generic-type-specializers): Rename from `cl--generic-struct-specializers`. Make it work for any class. (cl--generic-typeof-generalizer, cl--generic-oclosure-generalizer): Use it. (cl--generic-struct-generalizer): Delete generalizer. (cl-generic-generalizers :extra "cl-struct"): Delete method. (prefill 0 cl--generic-generalizer): Move to after the typeof. (cl-generic-generalizers :extra "typeof"): Rewrite to use classes rather than `cl--all-builtin-types`. (cl-generic--oclosure-specializers): Delete function. * lisp/emacs-lisp/cl-preloaded.el (cl--direct-supertypes-of-type) (cl--typeof-types, cl--all-builtin-types): Delete constants. * lisp/emacs-lisp/comp-cstr.el (comp--typeof-builtin-types): Delete constant. (comp--cl-class-hierarchy): Simplify. (comp--compute-typeof-types): Simplify now that `comp--cl-class-hierarchy` and `comp--all-classes` work for built-in types as well. (comp--direct-supertypes): Just use `cl--class-parents`. (comp-supertypes): Simplify since typeof-types should now be complete. * lisp/emacs-lisp/eieio-core.el (eieio-defclass-autoload): Use `superclasses` argument, so we can find parents before it's loaded. (eieio--class-precedence-c3, eieio--class-precedence-dfs): Don't add a `eieio-default-superclass` parent any more. (eieio--class/struct-parents): Delete function. (eieio--class-precedence-bfs): Use `eieio--class-parents` instead. Don't stop when reaching `eieio-default-superclass`. (cl--generic-struct-tag): Move from `cl-generic.el`. --- lisp/emacs-lisp/cl-generic.el | 67 ++++++++++------------------------------- lisp/emacs-lisp/cl-preloaded.el | 30 ------------------ lisp/emacs-lisp/comp-cstr.el | 55 +++++---------------------------- lisp/emacs-lisp/eieio-core.el | 51 +++++++++++++++---------------- 4 files changed, 49 insertions(+), 154 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index f439a97f88c..84eb800ec24 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1330,62 +1330,31 @@ These match if the argument is `eql' to VAL." (cl--generic-prefill-dispatchers (terminal-parameter nil 'xterm--set-selection) (eql nil)) -;;; Support for cl-defstructs specializers. +;;; Dispatch on "normal types". -(defun cl--generic-struct-tag (name &rest _) - ;; Use exactly the same code as for `typeof'. - `(if ,name (type-of ,name) 'null)) - -(defun cl--generic-struct-specializers (tag &rest _) +(defun cl--generic-type-specializers (tag &rest _) (and (symbolp tag) - (let ((class (get tag 'cl--class))) - (when (cl-typep class 'cl-structure-class) + (let ((class (cl--find-class tag))) + (when class (cl--class-allparents class))))) -(cl-generic-define-generalizer cl--generic-struct-generalizer - 50 #'cl--generic-struct-tag - #'cl--generic-struct-specializers) - -(cl-defmethod cl-generic-generalizers :extra "cl-struct" (type) - "Support for dispatch on types defined by `cl-defstruct'." - (or - (when (symbolp type) - ;; Use the "cl--struct-class*" (inlinable) functions/macros rather than - ;; the "cl-struct-*" variants which aren't inlined, so that dispatch can - ;; take place without requiring cl-lib. - (let ((class (cl--find-class type))) - (and (cl-typep class 'cl-structure-class) - (or (null (cl--struct-class-type class)) - (error "Can't dispatch on cl-struct %S: type is %S" - type (cl--struct-class-type class))) - (progn (cl-assert (null (cl--struct-class-named class))) t) - (list cl--generic-struct-generalizer)))) - (cl-call-next-method))) - -(cl--generic-prefill-dispatchers 0 cl--generic-generalizer) - -;;; Dispatch on "system types". - (cl-generic-define-generalizer cl--generic-typeof-generalizer ;; FIXME: We could also change `type-of' to return `null' for nil. 10 (lambda (name &rest _) `(if ,name (type-of ,name) 'null)) - (lambda (tag &rest _) - (and (symbolp tag) (assq tag cl--typeof-types)))) + #'cl--generic-type-specializers) (cl-defmethod cl-generic-generalizers :extra "typeof" (type) - "Support for dispatch on builtin types. -See the full list and their hierarchy in `cl--typeof-types'." + "Support for dispatch on types. +This currently works for built-in types and types built on top of records." ;; FIXME: Add support for other types accepted by `cl-typep' such ;; as `character', `face', `function', ... (or - (and (memq type cl--all-builtin-types) - (progn - ;; FIXME: While this wrinkle in the semantics can be occasionally - ;; problematic, this warning is more often annoying than helpful. - ;;(if (memq type '(vector array sequence)) - ;; (message "`%S' also matches CL structs and EIEIO classes" - ;; type)) - (list cl--generic-typeof-generalizer))) + (and (symbolp type) + (not (eq type t)) ;; Handled by the `t-generalizer'. + (let ((class (cl--find-class type))) + (memq (type-of class) + '(built-in-class cl-structure-class eieio--class))) + (list cl--generic-typeof-generalizer)) (cl-call-next-method))) (cl--generic-prefill-dispatchers 0 integer) @@ -1393,6 +1362,8 @@ See the full list and their hierarchy in `cl--typeof-types'." (cl--generic-prefill-dispatchers 0 cl--generic-generalizer integer) (cl--generic-prefill-dispatchers 0 (eql 'x) integer) +(cl--generic-prefill-dispatchers 0 cl--generic-generalizer) + ;;; Dispatch on major mode. ;; Two parts: @@ -1430,19 +1401,13 @@ Used internally for the (major-mode MODE) context specializers." (defun cl--generic-oclosure-tag (name &rest _) `(oclosure-type ,name)) -(defun cl-generic--oclosure-specializers (tag &rest _) - (and (symbolp tag) - (let ((class (cl--find-class tag))) - (when (cl-typep class 'oclosure--class) - (oclosure--class-allparents class))))) - (cl-generic-define-generalizer cl--generic-oclosure-generalizer ;; Give slightly higher priority than the struct specializer, so that ;; for a generic function with methods dispatching structs and on OClosures, ;; we first try `oclosure-type' before `type-of' since `type-of' will return ;; non-nil for an OClosure as well. 51 #'cl--generic-oclosure-tag - #'cl-generic--oclosure-specializers) + #'cl--generic-type-specializers) (cl-defmethod cl-generic-generalizers :extra "oclosure-struct" (type) "Support for dispatch on types defined by `oclosure-define'." diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 1b330e7f761..5743684fa89 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -433,36 +433,6 @@ For this build of Emacs it's %dbit." (setf (cl--class-parents (cl--find-class 'cl-structure-object)) (list (cl--find-class 'record)))) -(defconst cl--direct-supertypes-of-type - ;; Please run `sycdoc-update-type-hierarchy' in - ;; `admin/syncdoc-type-hierarchy.el' each time this is modified to - ;; reflect the change in the documentation. - (let ((table (make-hash-table :test #'eq))) - (mapatoms - (lambda (type) - (let ((class (get type 'cl--class))) - (when (built-in-class-p class) - (puthash type (mapcar #'cl--class-name (cl--class-parents class)) - table))))) - table) - "Hash table TYPE -> SUPERTYPES.") - -(defconst cl--typeof-types - (letrec ((alist nil)) - (maphash (lambda (type _) - (let ((class (get type 'cl--class))) - ;; FIXME: Can't remember why `t' is excluded. - (push (remq t (cl--class-allparents class)) alist))) - cl--direct-supertypes-of-type) - alist) - "Alist of supertypes. -Each element has the form (TYPE . SUPERTYPES) where TYPE is one of -the symbols returned by `type-of', and SUPERTYPES is the list of its -supertypes from the most specific to least specific.") - -(defconst cl--all-builtin-types - (delete-dups (copy-sequence (apply #'append cl--typeof-types)))) - ;; Make sure functions defined with cl-defsubst can be inlined even in ;; packages which do not require CL. We don't put an autoload cookie ;; directly on that function, since those cookies only go to cl-loaddefs. diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 1c6acaa6385..5922a8caf12 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -38,12 +38,6 @@ (require 'cl-lib) (require 'cl-extra) ;HACK: For `cl-find-class' when `cl-loaddefs' is missing. -(defconst comp--typeof-builtin-types (mapcar (lambda (x) - (append x '(t))) - cl--typeof-types) - ;; TODO can we just add t in `cl--typeof-types'? - "Like `cl--typeof-types' but with t as common supertype.") - (cl-defstruct (comp-cstr (:constructor comp--type-to-cstr (type &aux (null (eq type 'null)) @@ -89,15 +83,7 @@ Integer values are handled in the `range' slot.") (defun comp--cl-class-hierarchy (x) "Given a class name `x' return its hierarchy." - (let ((parents (cl--class-allparents (cl--struct-get-class x)))) - (if (memq t parents) - parents - `(,@parents - ;; FIXME: AFAICT, `comp--all-classes' will also find those struct types - ;; which use :type and can thus be either `vector' or `cons' (the latter - ;; isn't `atom'). - atom - t)))) + (cl--class-allparents (cl--find-class x))) (defun comp--all-classes () "Return all non built-in type names currently defined." @@ -109,8 +95,7 @@ Integer values are handled in the `range' slot.") res)) (defun comp--compute-typeof-types () - (append comp--typeof-builtin-types - (mapcar #'comp--cl-class-hierarchy (comp--all-classes)))) + (mapcar #'comp--cl-class-hierarchy (comp--all-classes))) (defun comp--compute--pred-type-h () (cl-loop with h = (make-hash-table :test #'eq) @@ -275,19 +260,10 @@ Return them as multiple value." (symbol-name y))) (defun comp--direct-supertypes (type) - (or - (gethash type cl--direct-supertypes-of-type) - (let ((supers (comp-supertypes type))) - (cl-assert (eq type (car supers))) - (cl-loop - with notdirect = nil - with direct = nil - for parent in (cdr supers) - unless (memq parent notdirect) - do (progn - (push parent direct) - (setq notdirect (append notdirect (comp-supertypes parent)))) - finally return direct)))) + (when (symbolp type) ;; FIXME: Can this test ever fail? + (let* ((class (cl--find-class type)) + (parents (if class (cl--class-parents class)))) + (mapcar #'cl--class-name parents)))) (defsubst comp-subtype-p (type1 type2) "Return t if TYPE1 is a subtype of TYPE2 or nil otherwise." @@ -359,23 +335,8 @@ Return them as multiple value." (defun comp-supertypes (type) "Return the ordered list of supertypes of TYPE." - ;; FIXME: We should probably keep the results in - ;; `comp-cstr-ctxt-typeof-types' (or maybe even precompute them - ;; and maybe turn `comp-cstr-ctxt-typeof-types' into a hash-table). - ;; Or maybe we shouldn't keep structs and defclasses in it, - ;; and just use `cl--class-allparents' when needed (and refuse to - ;; compute their direct subtypes since we can't know them). - (cl-loop - named loop - with above - for lane in (comp-cstr-ctxt-typeof-types comp-ctxt) - do (let ((x (memq type lane))) - (cond - ((null x) nil) - ((eq x lane) (cl-return-from loop x)) ;A base type: easy case. - (t (setq above - (if above (comp--intersection x above) x))))) - finally return above)) + (or (assq type (comp-cstr-ctxt-typeof-types comp-ctxt)) + (error "Type %S missing from typeof-types!" type))) (defun comp-union-typesets (&rest typesets) "Union types present into TYPESETS." diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 9945e19c65c..5418f53be35 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -191,7 +191,7 @@ Abstract classes cannot be instantiated." ;; We autoload this because it's used in `make-autoload'. ;;;###autoload -(defun eieio-defclass-autoload (cname _superclasses filename doc) +(defun eieio-defclass-autoload (cname superclasses filename doc) "Create autoload symbols for the EIEIO class CNAME. SUPERCLASSES are the superclasses that CNAME inherits from. DOC is the docstring for CNAME. @@ -199,15 +199,9 @@ This function creates a mock-class for CNAME and adds it into SUPERCLASSES as children. It creates an autoload function for CNAME's constructor." ;; Assume we've already debugged inputs. - - ;; We used to store the list of superclasses in the `parent' slot (as a list - ;; of class names). But now this slot holds a list of class objects, and - ;; those parents may not exist yet, so the corresponding class objects may - ;; simply not exist yet. So instead we just don't store the list of parents - ;; here in eieio-defclass-autoload at all, since it seems that they're just - ;; not needed before the class is actually loaded. (let* ((oldc (cl--find-class cname)) - (newc (eieio--class-make cname))) + (newc (eieio--class-make cname)) + (parents (mapcar #'cl-find-class superclasses))) (if (eieio--class-p oldc) nil ;; Do nothing if we already have this class. @@ -218,6 +212,12 @@ It creates an autoload function for CNAME's constructor." use '%s or turn off `eieio-backward-compatibility' instead" cname) "25.1")) + (when (memq nil parents) + ;; If some parents aren't yet fully defined, just ignore them for now. + (setq parents (delq nil parents))) + (unless parents + (setq parents (list (cl--find-class 'eieio-default-superclass)))) + (setf (cl--class-parents newc) parents) (setf (cl--find-class cname) newc) ;; Create an autoload on top of our constructor function. @@ -958,19 +958,13 @@ need be... May remove that later...)" (cdr tuple) nil))) -(defsubst eieio--class/struct-parents (class) - (or (eieio--class-parents class) - `(,eieio-default-superclass))) - (defun eieio--class-precedence-c3 (class) "Return all parents of CLASS in c3 order." (let ((parents (eieio--class-parents class))) (cons class (merge-ordered-lists (append - (or - (mapcar #'eieio--class-precedence-c3 parents) - `((,eieio-default-superclass))) + (mapcar #'eieio--class-precedence-c3 parents) (list parents)) (lambda (remaining-inputs) (signal 'inconsistent-class-hierarchy @@ -984,13 +978,11 @@ need be... May remove that later...)" (classes (copy-sequence (apply #'append (list class) - (or - (mapcar - (lambda (parent) - (cons parent - (eieio--class-precedence-dfs parent))) - parents) - `((,eieio-default-superclass)))))) + (mapcar + (lambda (parent) + (cons parent + (eieio--class-precedence-dfs parent))) + parents)))) (tail classes)) ;; Remove duplicates. (while tail @@ -1003,13 +995,12 @@ need be... May remove that later...)" (defun eieio--class-precedence-bfs (class) "Return all parents of CLASS in breadth-first order." (let* ((result) - (queue (eieio--class/struct-parents class))) + (queue (eieio--class-parents class))) (while queue (let ((head (pop queue))) (unless (member head result) (push head result) - (unless (eq head eieio-default-superclass) - (setq queue (append queue (eieio--class/struct-parents head))))))) + (setq queue (append queue (eieio--class-parents head)))))) (cons class (nreverse result))) ) @@ -1049,6 +1040,14 @@ method invocation orders of the involved classes." ;;;; General support to dispatch based on the type of the argument. +;; FIXME: We could almost use the typeof-generalizer (i.e. the same as +;; used for cl-structs), except that that generalizer doesn't support +;; `:method-invocation-order' :-( + +(defun cl--generic-struct-tag (name &rest _) + ;; Use exactly the same code as for `typeof'. + `(if ,name (type-of ,name) 'null)) + (cl-generic-define-generalizer eieio--generic-generalizer ;; Use the exact same tagcode as for cl-struct, so that methods ;; that dispatch on both kinds of objects get to share this -- cgit v1.2.3 From 966d0a62a1a13a3df5155476d36eafe17999497e Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 8 Mar 2024 14:26:14 +0100 Subject: * Fix `capitalize` entry in `comp-known-type-specifiers` (bug#69631) * lisp/emacs-lisp/comp-common.el (comp-known-type-specifiers): Fix 'capitalize' entry. --- lisp/emacs-lisp/comp-common.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index 221f819e474..4edfe811586 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -119,7 +119,7 @@ Used to modify the compiler environment." (function ((or integer marker) (or integer marker)) string)) (bufferp (function (t) boolean)) (byte-code-function-p (function (t) boolean)) - (capitalize (function (or integer string) (or integer string))) + (capitalize (function ((or integer string)) (or integer string))) (car (function (list) t)) (car-less-than-car (function (list list) boolean)) (car-safe (function (t) t)) -- cgit v1.2.3 From 055e31f1d021ef2c8ac5cca505b5f73118736cff Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 8 Mar 2024 10:47:01 -0500 Subject: eieio-core.el: Try and fix bug#69631 * lisp/emacs-lisp/eieio-core.el (eieio--class-precedence-c3) (eieio--class-precedence-dfs, eieio--class-precedence-bfs): Use `cl--class-parents` since some of the parents aren't EIEIO classes. --- lisp/emacs-lisp/eieio-core.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 5418f53be35..7af6e9ff1bb 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -960,7 +960,7 @@ need be... May remove that later...)" (defun eieio--class-precedence-c3 (class) "Return all parents of CLASS in c3 order." - (let ((parents (eieio--class-parents class))) + (let ((parents (cl--class-parents class))) (cons class (merge-ordered-lists (append @@ -974,7 +974,7 @@ need be... May remove that later...)" (defun eieio--class-precedence-dfs (class) "Return all parents of CLASS in depth-first order." - (let* ((parents (eieio--class-parents class)) + (let* ((parents (cl--class-parents class)) (classes (copy-sequence (apply #'append (list class) @@ -995,12 +995,12 @@ need be... May remove that later...)" (defun eieio--class-precedence-bfs (class) "Return all parents of CLASS in breadth-first order." (let* ((result) - (queue (eieio--class-parents class))) + (queue (cl--class-parents class))) (while queue (let ((head (pop queue))) (unless (member head result) (push head result) - (setq queue (append queue (eieio--class-parents head)))))) + (setq queue (append queue (cl--class-parents head)))))) (cons class (nreverse result))) ) -- cgit v1.2.3 From 5beb56fb53b2d6ee9d5ad621b7fc2c9d1d0ec9c5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 8 Mar 2024 11:24:18 -0500 Subject: EIEIO: Fix regession (bug#69631) Not sure why earlier tests did not catch it, but there are more places where we bump into problems because `eieio--class-precedence-list` now returns also non-EIEIO classes. * lisp/obsolete/eieio-compat.el (eieio--generic-static-object-generalizer): * lisp/emacs-lisp/eieio-core.el (eieio--generic-generalizer) (eieio--generic-subclass-specializers): Handle non-EIEIO parents. * test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el (eieio-test-method-order-list-7): Adjust test. --- lisp/emacs-lisp/eieio-core.el | 10 ++++------ lisp/obsolete/eieio-compat.el | 5 ++--- test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el | 2 +- 3 files changed, 7 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 7af6e9ff1bb..9a73e7c7441 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -1056,8 +1056,7 @@ method invocation orders of the involved classes." (lambda (tag &rest _) (let ((class (cl--find-class tag))) (and (eieio--class-p class) - (mapcar #'eieio--class-name - (eieio--class-precedence-list class)))))) + (cl--class-allparents class))))) (cl-defmethod cl-generic-generalizers :extra "class" (specializer) "Support for dispatch on types defined by EIEIO's `defclass'." @@ -1079,10 +1078,9 @@ method invocation orders of the involved classes." ;; Instead, we add a new "subclass" specializer. (defun eieio--generic-subclass-specializers (tag &rest _) - (when (eieio--class-p tag) - (mapcar (lambda (class) - `(subclass ,(eieio--class-name class))) - (eieio--class-precedence-list tag)))) + (when (cl--class-p tag) + (mapcar (lambda (class) `(subclass ,class)) + (cl--class-allparents tag)))) (cl-generic-define-generalizer eieio--generic-subclass-generalizer 60 (lambda (name &rest _) `(and (symbolp ,name) (cl--find-class ,name))) diff --git a/lisp/obsolete/eieio-compat.el b/lisp/obsolete/eieio-compat.el index 26648a4d7bb..8fdcebbd1c4 100644 --- a/lisp/obsolete/eieio-compat.el +++ b/lisp/obsolete/eieio-compat.el @@ -150,10 +150,9 @@ Summary: (lambda (tag &rest _) (and (symbolp tag) (setq tag (cl--find-class tag)) (eieio--class-p tag) - (let ((superclasses (eieio--class-precedence-list tag)) + (let ((superclasses (cl--class-allparents tag)) (specializers ())) (dolist (superclass superclasses) - (setq superclass (eieio--class-name superclass)) (push superclass specializers) (push `(eieio--static ,superclass) specializers)) (nreverse specializers))))) @@ -240,7 +239,7 @@ Summary: (declare (obsolete cl-no-applicable-method "25.1")) (apply #'cl-no-applicable-method method object args)) -(define-obsolete-function-alias 'call-next-method 'cl-call-next-method "25.1") +(define-obsolete-function-alias 'call-next-method #'cl-call-next-method "25.1") (defun next-method-p () (declare (obsolete cl-next-method-p "25.1")) ;; EIEIO's `next-method-p' just returned nil when called in an diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el index b244a56779a..fb2c6ea3b68 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el @@ -259,7 +259,7 @@ (ans '( (:PRIMARY D) (:PRIMARY D-base1) - ;; (:PRIMARY D-base2) + (:PRIMARY D-base2) (:PRIMARY D-base0) ))) (eitest-F (D nil)) -- cgit v1.2.3 From 345cdd7a70558cd47c2ab3e124e2352debaa57cb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 8 Mar 2024 11:57:22 -0500 Subject: (eieio--generic-subclass-specializers): Autoload class * lisp/emacs-lisp/eieio-core.el (eieio--generic-subclass-specializers): Don't forget to handle autoloaded classes. --- lisp/emacs-lisp/eieio-core.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 9a73e7c7441..a2f7c4172a3 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -1079,6 +1079,8 @@ method invocation orders of the involved classes." (defun eieio--generic-subclass-specializers (tag &rest _) (when (cl--class-p tag) + (when (eieio--class-p tag) + (setq tag (eieio--full-class-object tag))) ;Autoload, if applicable. (mapcar (lambda (class) `(subclass ,class)) (cl--class-allparents tag)))) -- cgit v1.2.3 From 966e1be5b337cf71f404a509cae4057b73f3f381 Mon Sep 17 00:00:00 2001 From: Charalampos Mitrodimas Date: Thu, 7 Mar 2024 18:38:15 +0000 Subject: Do interactive mode tagging for locate.el * lisp/locate.el (locate-tags, locate-find-directory) (locate-find-directory-other-window): Do interactive mode tagging. (Bug#69619) Copyright-paperwork-exempt: yes --- lisp/locate.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/locate.el b/lisp/locate.el index d86e7fa678f..70328d5184e 100644 --- a/lisp/locate.el +++ b/lisp/locate.el @@ -559,7 +559,7 @@ do not work in subdirectories. (defun locate-tags () "Visit a tags table in `*Locate*' mode." - (interactive) + (interactive nil locate-mode) (if (locate-main-listing-line-p) (let ((tags-table (locate-get-filename))) (and (y-or-n-p (format "Visit tags table %s? " tags-table)) @@ -589,7 +589,7 @@ locate database using the shell command in `locate-update-command'." (defun locate-find-directory () "Visit the directory of the file mentioned on this line." - (interactive) + (interactive nil locate-mode) (if (locate-main-listing-line-p) (let ((directory-name (locate-get-dirname))) (if (file-directory-p directory-name) @@ -601,7 +601,7 @@ locate database using the shell command in `locate-update-command'." (defun locate-find-directory-other-window () "Visit the directory of the file named on this line in other window." - (interactive) + (interactive nil locate-mode) (if (locate-main-listing-line-p) (find-file-other-window (locate-get-dirname)) (message "This command only works inside main listing."))) -- cgit v1.2.3 From a4473afefe1a0f171ac6e811853836dd675f93d2 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 9 Mar 2024 10:09:36 +0200 Subject: Fix case-sensitivity in 'complete-tag' * lisp/progmodes/etags.el (complete-tag): Bind 'completion-ignore-case', so that 'completion-in-region' is affected by it. This fixes a bug made in 30 Apr 2010, when this function was refactored to use 'tags-completion-at-point-function'. Reported by Morgan Willcock . --- lisp/progmodes/etags.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 476037eb8bd..597612196fd 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -2065,7 +2065,8 @@ for \\[find-tag] (which see)." (user-error "%s" (substitute-command-keys "No tags table loaded; try \\[visit-tags-table]"))) - (let ((comp-data (tags-completion-at-point-function))) + (let ((comp-data (tags-completion-at-point-function)) + (completion-ignore-case (find-tag--completion-ignore-case))) (if (null comp-data) (user-error "Nothing to complete") (completion-in-region (car comp-data) (cadr comp-data) -- cgit v1.2.3 From 1ea3b369021c90701c634c512426f75ce1291d77 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 9 Mar 2024 04:24:30 -0500 Subject: Auto-commit of loaddefs files. --- lisp/ldefs-boot.el | 2466 +++++++++++++++++++++++++++------------------------- 1 file changed, 1275 insertions(+), 1191 deletions(-) (limited to 'lisp') diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index ef672d6c2e5..b434ee0e37f 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -729,19 +729,19 @@ CONCEALED: CLOSED: A TOPIC whose immediate OFFSPRING and body-text is CONCEALED. OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be. -This is a minor mode. If called interactively, toggle the -`Allout mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Allout mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `allout-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (define-obsolete-function-alias 'outlinify-sticky #'allout-outlinify-sticky "29.1") @@ -803,18 +803,18 @@ bindings for easy outline navigation and exposure control, extending outline hot-spot navigation (see `allout-mode'). This is a minor mode. If called interactively, toggle the -`Allout-Widgets mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Allout-Widgets mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `allout-widgets-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "allout-widgets" '("allout-")) @@ -1389,19 +1389,19 @@ Keymap summary \\{artist-mode-map} -This is a minor mode. If called interactively, toggle the -`Artist mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Artist mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `artist-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "artist" '("artist-")) @@ -1534,18 +1534,18 @@ When Auto-insert mode is enabled, when new files are created you can insert a template for the file depending on the mode of the buffer. This is a global minor mode. If called interactively, toggle the -`Auto-Insert mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Auto-Insert mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='auto-insert-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "autoinsert" '("auto-insert")) @@ -1571,19 +1571,19 @@ Use `global-auto-revert-mode' to automatically revert all buffers. Use `auto-revert-tail-mode' if you know that the file will only grow without being changed in the part that is already in the buffer. -This is a minor mode. If called interactively, toggle the -`Auto-Revert mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Auto-Revert +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `auto-revert-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'turn-on-auto-revert-mode "autorevert" "\ @@ -1610,19 +1610,18 @@ suppressed by setting `auto-revert-verbose' to nil. Use `auto-revert-mode' for changes other than appends! This is a minor mode. If called interactively, toggle the -`Auto-Revert-Tail mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Auto-Revert-Tail mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `auto-revert-tail-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'turn-on-auto-revert-tail-mode "autorevert" "\ @@ -1659,19 +1658,18 @@ It displays the text that `global-auto-revert-mode-text' specifies in the mode line. This is a global minor mode. If called interactively, toggle the -`Global Auto-Revert mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Global Auto-Revert mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='global-auto-revert-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "autorevert" '("auto-revert-" "global-auto-revert-")) @@ -1774,18 +1772,18 @@ functions in `battery-update-functions', which can be used to trigger actions based on battery-related events. This is a global minor mode. If called interactively, toggle the -`Display-Battery mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Display-Battery mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='display-battery-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "battery" '("battery-")) @@ -1949,6 +1947,10 @@ Major mode for editing BibTeX style files. ;;; Generated autoloads from bind-key.el (push (purecopy '(bind-key 2 4 1)) package--builtin-versions) +(defvar personal-keybindings nil "\ +List of bindings performed by `bind-key'. + +Elements have the form ((KEY . [MAP]) CMD ORIGINAL-CMD)") (autoload 'bind-key "bind-key" "\ Bind KEY-NAME to COMMAND in KEYMAP (`global-map' if not passed). @@ -2022,7 +2024,7 @@ other modes. See `override-global-mode'. (fn &rest ARGS)" nil t) (autoload 'describe-personal-keybindings "bind-key" "\ Display all the personal keybindings defined by `bind-key'." t) -(register-definition-prefixes "bind-key" '("bind-key" "override-global-m" "personal-keybindings")) +(register-definition-prefixes "bind-key" '("bind-key" "override-global-m")) ;;; Generated autoloads from emacs-lisp/bindat.el @@ -2755,37 +2757,36 @@ columns on its right towards the left. Toggle hyperlinking bug references in the buffer (Bug Reference mode). This is a minor mode. If called interactively, toggle the -`Bug-Reference mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Bug-Reference mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `bug-reference-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'bug-reference-prog-mode "bug-reference" "\ Like `bug-reference-mode', but only buttonize in comments and strings. This is a minor mode. If called interactively, toggle the -`Bug-Reference-Prog mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Bug-Reference-Prog mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `bug-reference-prog-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "bug-reference" '("bug-reference-")) @@ -2939,12 +2940,6 @@ and corresponding effects. ;;; Generated autoloads from progmodes/c-ts-mode.el -(autoload 'c-ts-base-mode "c-ts-mode" "\ -Major mode for editing C, powered by tree-sitter. - -\\{c-ts-base-mode-map} - -(fn)" t) (autoload 'c-ts-mode "c-ts-mode" "\ Major mode for editing C, powered by tree-sitter. @@ -2994,6 +2989,7 @@ should be used. This function attempts to use file contents to determine whether the code is C or C++ and based on that chooses whether to enable `c-ts-mode' or `c++-ts-mode'." t) +(make-obsolete 'c-or-c++-ts-mode 'c-or-c++-mode "30.1") (register-definition-prefixes "c-ts-mode" '("c-ts-")) @@ -4380,19 +4376,19 @@ checking of documentation strings. \\{checkdoc-minor-mode-map} -This is a minor mode. If called interactively, toggle the -`Checkdoc minor mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Checkdoc +minor mode' mode. If the prefix argument is positive, enable the mode, +and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `checkdoc-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'checkdoc-package-keywords "checkdoc" "\ @@ -4478,19 +4474,18 @@ or call the function `cl-font-lock-built-in-mode'.") Highlight built-in functions, variables, and types in `lisp-mode'. This is a global minor mode. If called interactively, toggle the -`Cl-Font-Lock-Built-In mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Cl-Font-Lock-Built-In mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='cl-font-lock-built-in-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "cl-font-lock" '("cl-font-lock-")) @@ -4620,19 +4615,18 @@ macro-expansion of `cl-defstruct' that used vectors objects instead of record objects. This is a global minor mode. If called interactively, toggle the -`Cl-Old-Struct-Compat mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Cl-Old-Struct-Compat mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='cl-old-struct-compat-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "cl-lib" '("cl-")) @@ -5031,6 +5025,16 @@ on third call it again advances points to the next difference and so on. (fn IGNORE-WHITESPACE)" t) (register-definition-prefixes "compare-w" '("compare-")) + +;;; Generated autoloads from emacs-lisp/compat.el + + (push (list 'compat + emacs-major-version + emacs-minor-version + 9999) + package--builtin-versions) +(register-definition-prefixes "compat" '("compat-")) + ;;; Generated autoloads from image/compface.el @@ -5180,18 +5184,18 @@ See `compilation-mode'. This is a minor mode. If called interactively, toggle the `Compilation-Shell minor mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +positive, enable the mode, and if it is zero or negative, disable the +mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `compilation-shell-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'compilation-minor-mode "compile" "\ @@ -5201,20 +5205,19 @@ When Compilation minor mode is enabled, all the error-parsing commands of Compilation major mode are available. See `compilation-mode'. -This is a minor mode. If called interactively, toggle the -`Compilation minor mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Compilation +minor mode' mode. If the prefix argument is positive, enable the mode, +and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `compilation-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'compilation-next-error-function "compile" "\ @@ -5272,19 +5275,18 @@ this mode: `enable-completion', `save-completions-flag', and options can be found in the `completion' group. This is a global minor mode. If called interactively, toggle the -`Dynamic-Completion mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Dynamic-Completion mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='dynamic-completion-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "completion" '("*c-def-regexp*" "*lisp-def-regexp*" "accept-completion" "add-" "cdabbrev-" "check-completion-length" "clear-all-completions" "cmpl-" "complet" "current-completion-source" "delete-completion" "enable-completion" "find-" "inside-locate-completion-entry" "interactive-completion-string-reader" "kill-" "list-all-completions" "load-completions-from-file" "make-c" "next-cdabbrev" "num-cmpl-sources" "reset-cdabbrev" "save" "set-c" "symbol-" "use-completion-")) @@ -5304,19 +5306,18 @@ completion suggestion, and \\[completion-preview-prev-candidate] cycles backward. This is a minor mode. If called interactively, toggle the -`Completion-Preview mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Completion-Preview mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `completion-preview-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "completion-preview" '("completion-preview-")) @@ -5543,6 +5544,7 @@ If FIX is non-nil, run `copyright-fix-years' instead. ;;; Generated autoloads from progmodes/cperl-mode.el +(put 'cperl-file-style 'safe-local-variable 'stringp) (put 'cperl-indent-level 'safe-local-variable 'integerp) (put 'cperl-brace-offset 'safe-local-variable 'integerp) (put 'cperl-continued-brace-offset 'safe-local-variable 'integerp) @@ -5550,7 +5552,6 @@ If FIX is non-nil, run `copyright-fix-years' instead. (put 'cperl-continued-statement-offset 'safe-local-variable 'integerp) (put 'cperl-extra-newline-before-brace 'safe-local-variable 'booleanp) (put 'cperl-merge-trailing-else 'safe-local-variable 'booleanp) -(put 'cperl-file-style 'safe-local-variable 'stringp) (autoload 'cperl-mode "cperl-mode" "\ Major mode for editing Perl code. Expression and list commands understand all C brackets. @@ -5903,19 +5904,19 @@ You can customize `cua-enable-cua-keys' to completely disable the CUA bindings, or `cua-prefix-override-inhibit-delay' to change the prefix fallback behavior. -This is a global minor mode. If called interactively, toggle the -`Cua mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. +This is a global minor mode. If called interactively, toggle the `Cua +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='cua-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'cua-selection-mode "cua-base" "\ @@ -5938,19 +5939,18 @@ Toggle the region as rectangular. Activates the region if needed. Only lasts until the region is deactivated. This is a minor mode. If called interactively, toggle the -`Cua-Rectangle-Mark mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Cua-Rectangle-Mark mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `cua-rectangle-mark-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "cua-rect" '("cua-")) @@ -5966,19 +5966,18 @@ By convention, this is a list of symbols where each symbol stands for the Keep cursor outside of any `cursor-intangible' text property. This is a minor mode. If called interactively, toggle the -`Cursor-Intangible mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Cursor-Intangible mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `cursor-intangible-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'cursor-sensor-mode "cursor-sensor" "\ @@ -5991,18 +5990,18 @@ the cursor and DIR can be `entered' or `left' depending on whether the cursor is entering the area covered by the text-property property or leaving it. This is a minor mode. If called interactively, toggle the -`Cursor-Sensor mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Cursor-Sensor mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `cursor-sensor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "cursor-sensor" '("cursor-sensor-")) @@ -6115,6 +6114,11 @@ Customize GROUP, which must be a customization group, in another window. Customize SYMBOL, which must be a user option. (fn SYMBOL)" t) +(autoload 'customize-toggle-option "cus-edit" "\ +Toggle the value of boolean option SYMBOL for this session. + +(fn SYMBOL)" t) +(defalias 'toggle-option #'customize-toggle-option) (defalias 'customize-variable-other-window 'customize-option-other-window) (autoload 'customize-option-other-window "cus-edit" "\ Customize SYMBOL, which must be a user option. @@ -6368,19 +6372,19 @@ Note, in addition to enabling this minor mode, the major mode must be included in the variable `cwarn-configuration'. By default C and C++ modes are included. -This is a minor mode. If called interactively, toggle the `Cwarn -mode' mode. If the prefix argument is positive, enable the mode, -and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Cwarn mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `cwarn-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (put 'global-cwarn-mode 'globalized-minor-mode t) @@ -6871,19 +6875,18 @@ See `delete-selection-helper' and `delete-selection-pre-hook' for information on adapting behavior of commands in Delete Selection mode. This is a global minor mode. If called interactively, toggle the -`Delete-Selection mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Delete-Selection mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='delete-selection-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'delete-active-region "delsel" "\ @@ -6964,13 +6967,6 @@ See Info node `(elisp)Derived Modes' for more details. (fn CHILD PARENT NAME [DOCSTRING] [KEYWORD-ARGS...] &rest BODY)" nil t) (function-put 'define-derived-mode 'doc-string-elt 4) (function-put 'define-derived-mode 'lisp-indent-function 'defun) -(autoload 'derived-mode-init-mode-variables "derived" "\ -Initialize variables for a new MODE. -Right now, if they don't already exist, set up a blank keymap, an -empty syntax table, and an empty abbrev table -- these will be merged -the first time the mode is used. - -(fn MODE)") (register-definition-prefixes "derived" '("derived-mode-")) @@ -7042,13 +7038,22 @@ or call the function `desktop-save-mode'.") (autoload 'desktop-save-mode "desktop" "\ Toggle desktop saving (Desktop Save mode). -When Desktop Save mode is enabled, the state of Emacs is saved from -one session to another. In particular, Emacs will save the desktop when -it exits (this may prompt you; see the option `desktop-save'). The next -time Emacs starts, if this mode is active it will restore the desktop. +When Desktop Save mode is enabled, the state of Emacs is saved from one +session to another. The saved Emacs \"desktop configuration\" includes the +buffers, their file names, major modes, buffer positions, window and frame +configuration, and some important global variables. + +To enable this feature for future sessions, customize `desktop-save-mode' +to t, or add this line in your init file: -To manually save the desktop at any time, use the command `\\[desktop-save]'. -To load it, use `\\[desktop-read]'. + (desktop-save-mode 1) + +When this mode is enabled, Emacs will save the desktop when it exits +(this may prompt you, see the option `desktop-save'). The next time +Emacs starts, if this mode is active it will restore the desktop. + +To manually save the desktop at any time, use the command \\[desktop-save]. +To load it, use \\[desktop-read]. Once a desktop file exists, Emacs will auto-save it according to the option `desktop-auto-save-timeout'. @@ -7058,18 +7063,18 @@ To see all the options you can set, browse the `desktop' customization group. For further details, see info node `(emacs)Saving Emacs Sessions'. This is a global minor mode. If called interactively, toggle the -`Desktop-Save mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Desktop-Save mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='desktop-save-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (defvar desktop-locals-to-save '(desktop-locals-to-save truncate-lines case-fold-search case-replace fill-column overwrite-mode change-log-default-name line-number-mode column-number-mode size-indication-mode buffer-file-coding-system buffer-display-time indent-tabs-mode tab-width indicate-buffer-boundaries indicate-empty-lines show-trailing-whitespace) "\ @@ -7503,19 +7508,19 @@ Toggle Diff minor mode. \\{diff-minor-mode-map} -This is a minor mode. If called interactively, toggle the `Diff -minor mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Diff minor +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `diff-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (defvar diff-add-log-use-relative-names nil "\ @@ -7719,19 +7724,19 @@ This is an alternative to `shell-dirtrack-mode', which works by tracking `cd' and similar commands which change the shell working directory. -This is a minor mode. If called interactively, toggle the -`Dirtrack mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Dirtrack +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `dirtrack-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'dirtrack "dirtrack" "\ @@ -7750,7 +7755,7 @@ from `default-directory'. (autoload 'disassemble "disass" "\ Print disassembled code for OBJECT in (optional) BUFFER. OBJECT can be a symbol defined as a function, or a function itself -(a lambda expression or a compiled-function object). +(a lambda expression or a byte-code-function object). If OBJECT is not already compiled, we compile it, but do not redefine OBJECT if it is a symbol. @@ -7905,19 +7910,19 @@ not appear aligned. See Info node `Displaying Boundaries' for details. This is a minor mode. If called interactively, toggle the -`Display-Fill-Column-Indicator mode' mode. If the prefix -argument is positive, enable the mode, and if it is zero or -negative, disable the mode. +`Display-Fill-Column-Indicator mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable the +mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `display-fill-column-indicator-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (put 'global-display-fill-column-indicator-mode 'globalized-minor-mode t) @@ -7977,19 +7982,18 @@ customize `display-line-numbers-type'. To change the type while the mode is on, set `display-line-numbers' directly. This is a minor mode. If called interactively, toggle the -`Display-Line-Numbers mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Display-Line-Numbers mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `display-line-numbers-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (put 'global-display-line-numbers-mode 'globalized-minor-mode t) @@ -8066,19 +8070,18 @@ of `header-line-format', like this: See also `line-number-display-width'. This is a minor mode. If called interactively, toggle the -`Header-Line-Indent mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Header-Line-Indent mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `header-line-indent-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "display-line-numbers" '("display-line-numbers-" "header-line-indent--")) @@ -8179,19 +8182,19 @@ Toggle displaying buffer via Doc View (Doc View minor mode). See the command `doc-view-mode' for more information on this mode. -This is a minor mode. If called interactively, toggle the -`Doc-View minor mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Doc-View +minor mode' mode. If the prefix argument is positive, enable the mode, +and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `doc-view-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'doc-view-bookmark-jump "doc-view" "\ @@ -8250,19 +8253,19 @@ Toggle special insertion on double keypresses (Double mode). When Double mode is enabled, some keys will insert different strings when pressed twice. See `double-map' for details. -This is a minor mode. If called interactively, toggle the -`Double mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Double mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `double-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "double" '("double-")) @@ -8870,18 +8873,18 @@ This global minor mode enables `ede-minor-mode' in all buffers in an EDE controlled project. This is a global minor mode. If called interactively, toggle the -`Global Ede mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Global Ede mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='global-ede-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "ede" '("ede" "global-ede-mode-map" "project-try-ede")) @@ -8919,7 +8922,7 @@ An extant spec symbol is a symbol that is not a function and has a `edebug-form-spec' property. (fn SPEC)") -(defalias 'edebug-defun 'edebug-eval-top-level-form) +(defalias 'edebug-defun #'edebug-eval-top-level-form) (autoload 'edebug-eval-top-level-form "edebug" "\ Evaluate the top level form point is in, stepping through with Edebug. This is like `eval-defun' except that it steps the code for Edebug @@ -9285,9 +9288,9 @@ To change the default, set the variable `ediff-use-toolbar-p', which see." t) (autoload 'edit-kbd-macro "edmacro" "\ Edit a keyboard macro. At the prompt, type any key sequence which is bound to a keyboard macro. -Or, type `\\[kmacro-end-and-call-macro]' or \\`RET' to edit the last -keyboard macro, `\\[view-lossage]' to edit the last 300 -keystrokes as a keyboard macro, or `\\[execute-extended-command]' +Or, type \\[kmacro-end-and-call-macro] or \\`RET' to edit the last +keyboard macro, \\[view-lossage] to edit the last 300 +keystrokes as a keyboard macro, or \\[execute-extended-command] to edit a macro by its command name. With a prefix argument, format the macro in a more concise way. @@ -9359,7 +9362,7 @@ Turn on EDT Emulation." t) ;;; Generated autoloads from progmodes/eglot.el -(push (purecopy '(eglot 1 16)) package--builtin-versions) +(push (purecopy '(eglot 1 17)) package--builtin-versions) (define-obsolete-function-alias 'eglot-update #'eglot-upgrade-eglot "29.1") (autoload 'eglot "eglot" "\ Start LSP server for PROJECT's buffers under MANAGED-MAJOR-MODES. @@ -9494,7 +9497,7 @@ SUPERCLASSES as children. It creates an autoload function for CNAME's constructor. (fn CNAME SUPERCLASSES FILENAME DOC)") -(register-definition-prefixes "eieio-core" '("class-" "eieio-" "inconsistent-class-hierarchy" "invalid-slot-" "unbound-slot")) +(register-definition-prefixes "eieio-core" '("cl--generic-struct-tag" "class-" "eieio-" "inconsistent-class-hierarchy" "invalid-slot-" "unbound-slot")) ;;; Generated autoloads from emacs-lisp/eieio-custom.el @@ -9571,37 +9574,36 @@ inserted around the region instead. To toggle the mode in a single buffer, use `electric-pair-local-mode'. This is a global minor mode. If called interactively, toggle the -`Electric-Pair mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Electric-Pair mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='electric-pair-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'electric-pair-local-mode "elec-pair" "\ Toggle `electric-pair-mode' only in this buffer. This is a minor mode. If called interactively, toggle the -`Electric-Pair-Local mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Electric-Pair-Local mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `electric-pair-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "elec-pair" '("electric-pair-")) @@ -9618,19 +9620,19 @@ to `elide-head-headers-to-hide'. This is suitable as an entry on `find-file-hook' or appropriate mode hooks. -This is a minor mode. If called interactively, toggle the -`Elide-Head mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Elide-Head +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `elide-head-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'elide-head "elide-head" "\ @@ -9998,19 +10000,19 @@ Commands: \\{enriched-mode-map} -This is a minor mode. If called interactively, toggle the -`Enriched mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Enriched +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `enriched-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'enriched-encode "enriched" "\ @@ -10231,19 +10233,19 @@ enough, since keyservers have strict timeout settings. (autoload 'epa-mail-mode "epa-mail" "\ A minor-mode for composing encrypted/clearsigned mails. -This is a minor mode. If called interactively, toggle the -`epa-mail mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `epa-mail +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `epa-mail-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'epa-mail-decrypt "epa-mail" "\ @@ -10293,18 +10295,18 @@ or call the function `epa-global-mail-mode'.") Minor mode to hook EasyPG into Mail mode. This is a global minor mode. If called interactively, toggle the -`Epa-Global-Mail mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Epa-Global-Mail mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='epa-global-mail-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "epa-mail" '("epa-mail-")) @@ -10356,84 +10358,77 @@ Look at CONFIG and try to expand GROUP. ;;; Generated autoloads from erc/erc.el (push (purecopy '(erc 5 6 -4)) package--builtin-versions) +(dolist (symbol '( erc-sasl erc-spelling ; 29 + erc-imenu erc-nicks)) ; 30 + (custom-add-load symbol symbol)) +(custom-autoload 'erc-modules "erc") (autoload 'erc-select-read-args "erc" "\ -Prompt the user for values of nick, server, port, and password. -With prefix arg, also prompt for user and full name.") +Prompt for connection parameters and return them in a plist. +By default, collect `:server', `:port', `:nickname', and +`:password'. With a non-nil prefix argument, also prompt for +`:user' and `:full-name'. Also return various environmental +properties needed by entry-point commands, like `erc-tls'.") (autoload 'erc-server-select "erc" "\ Interactively connect to a server from `erc-server-alist'." t) (make-obsolete 'erc-server-select 'erc-tls "30.1") (autoload 'erc "erc" "\ -ERC is a powerful, modular, and extensible IRC client. -This function is the main entry point for ERC. - -It allows selecting connection parameters, and then starts ERC. - -Non-interactively, it takes the keyword arguments - (server (erc-compute-server)) - (port (erc-compute-port)) - (nick (erc-compute-nick)) - (user (erc-compute-user)) - password - (full-name (erc-compute-full-name)) - id - -That is, if called with +Connect to an Internet Relay Chat SERVER on a non-TLS PORT. +Use NICK and USER, when non-nil, to inform the IRC commands of +the same name, possibly factoring in a non-nil FULL-NAME as well. +When PASSWORD is non-nil, also send an opening server password +via the \"PASS\" command. Interactively, prompt for SERVER, +PORT, NICK, and PASSWORD, along with USER and FULL-NAME when +given a prefix argument. Non-interactively, expect the rarely +needed ID parameter, when non-nil, to be a symbol or a string for +naming the server buffer and identifying the connection +unequivocally. Once connected, return the server buffer. (See +Info node `(erc) Connecting' for details about all mentioned +parameters.) + +Together with `erc-tls', this command serves as the main entry +point for ERC, the powerful, modular, and extensible IRC client. +Non-interactively, both commands accept the following keyword +arguments, with their defaults supplied by the indicated +\"compute\" functions: + + :server `erc-compute-server' + :port `erc-compute-port' + :nick `erc-compute-nick' + :user `erc-compute-user' + :password N/A + :full-name `erc-compute-full-name' + :id' N/A + +For example, when called in the following manner (erc :server \"irc.libera.chat\" :full-name \"J. Random Hacker\") -then the server and full-name will be set to those values, -whereas `erc-compute-port' and `erc-compute-nick' will be invoked -for the values of the other parameters. - -See `erc-tls' for the meaning of ID. +ERC assigns SERVER and FULL-NAME the associated keyword values +and defers to `erc-compute-port', `erc-compute-user', and +`erc-compute-nick' for those respective parameters. (fn &key SERVER PORT NICK USER PASSWORD FULL-NAME ID)" '((let ((erc--display-context `((erc-interactive-display . erc) ,@erc--display-context))) (erc-select-read-args)))) (defalias 'erc-select #'erc) (autoload 'erc-tls "erc" "\ -ERC is a powerful, modular, and extensible IRC client. -This function is the main entry point for ERC over TLS. - -It allows selecting connection parameters, and then starts ERC -over TLS. - -Non-interactively, it takes the keyword arguments - (server (erc-compute-server)) - (port (erc-compute-port)) - (nick (erc-compute-nick)) - (user (erc-compute-user)) - password - (full-name (erc-compute-full-name)) - client-certificate - id +Connect to an IRC server over a TLS-encrypted connection. +Interactively, prompt for SERVER, PORT, NICK, and PASSWORD, along +with USER and FULL-NAME when given a prefix argument. +Non-interactively, also accept a CLIENT-CERTIFICATE, which should +be a list containing the file name of the certificate's key +followed by that of the certificate itself. Alternatively, +accept a value of t instead of a list, to tell ERC to query +`auth-source' for the certificate's details. -That is, if called with - - (erc-tls :server \"irc.libera.chat\" :full-name \"J. Random Hacker\") - -then the server and full-name will be set to those values, -whereas `erc-compute-port' and `erc-compute-nick' will be invoked -for the values of their respective parameters. - -CLIENT-CERTIFICATE, if non-nil, should either be a list where the -first element is the certificate key file name, and the second -element is the certificate file name itself, or t, which means -that `auth-source' will be queried for the key and the -certificate. Authenticating using a TLS client certificate is -also referred to as \"CertFP\" (Certificate Fingerprint) -authentication by various IRC networks. - -Example usage: +Example client certificate (CertFP) usage: (erc-tls :server \"irc.libera.chat\" :port 6697 :client-certificate \\='(\"/home/bandali/my-cert.key\" \"/home/bandali/my-cert.crt\")) -When present, ID should be a symbol or a string to use for naming -the server buffer and identifying the connection unequivocally. -See Info node `(erc) Network Identifier' for details. Like -CLIENT-CERTIFICATE, this parameter cannot be specified -interactively. +See the alternative entry-point command `erc' as well as Info +node `(erc) Connecting' for a fuller description of the various +parameters, like ID. (fn &key SERVER PORT NICK USER PASSWORD FULL-NAME CLIENT-CERTIFICATE ID)" '((let ((erc-default-port erc-default-port-tls) (erc--display-context `((erc-interactive-display . erc-tls) ,@erc--display-context))) (erc-select-read-args)))) (autoload 'erc-handle-irc-url "erc" "\ @@ -10701,6 +10696,46 @@ Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test). (fn TEST-OR-TEST-NAME)" t) (register-definition-prefixes "ert" '("ert-")) + +;;; Generated autoloads from emacs-lisp/ert-font-lock.el + +(autoload 'ert-font-lock-deftest "ert-font-lock" "\ +Define test NAME (a symbol) using assertions from TEST-STR. + +Other than MAJOR-MODE and TEST-STR parameters, this macro accepts +the same parameters and keywords as `ert-deftest' and is intended +to be used through `ert'. + +(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)] MAJOR-MODE TEST-STR)" nil t) +(function-put 'ert-font-lock-deftest 'doc-string-elt 3) +(function-put 'ert-font-lock-deftest 'lisp-indent-function 2) +(autoload 'ert-font-lock-deftest-file "ert-font-lock" "\ +Define test NAME (a symbol) using assertions from FILE. + +FILE - path to a file with assertions in ERT resource director as +return by `ert-resource-directory'. + +Other than MAJOR-MODE and FILE parameters, this macro accepts the +same parameters and keywords as `ert-deftest' and is intended to +be used through `ert'. + +(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)] MAJOR-MODE FILE)" nil t) +(function-put 'ert-font-lock-deftest-file 'doc-string-elt 3) +(function-put 'ert-font-lock-deftest-file 'lisp-indent-function 2) +(autoload 'ert-font-lock-test-string "ert-font-lock" "\ +Check font faces in TEST-STRING set by MODE. + +The function is meant to be run from within an ERT test. + +(fn TEST-STRING MODE)") +(autoload 'ert-font-lock-test-file "ert-font-lock" "\ +Check font faces in FILENAME set by MODE. + +The function is meant to be run from within an ERT test. + +(fn FILENAME MODE)") +(register-definition-prefixes "ert-font-lock" '("ert-font-lock--")) + ;;; Generated autoloads from emacs-lisp/ert-x.el @@ -11086,6 +11121,49 @@ for \\[find-tag] (which see)." t) (autoload 'etags--xref-backend "etags") (register-definition-prefixes "etags" '("default-tags-table-function" "etags-" "file-of-tag" "find-tag-" "goto-tag-location-function" "initialize-new-tags-table" "last-tag" "list-tags-function" "select-tags-table-" "snarf-tag-function" "tag" "verify-tags-table-function")) + +;;; Generated autoloads from progmodes/etags-regen.el + +(put 'etags-regen-regexp-alist 'safe-local-variable (lambda (value) (and (listp value) (seq-every-p (lambda (group) (and (consp group) (listp (car group)) (listp (cdr group)) (seq-every-p #'stringp (car group)) (seq-every-p #'stringp (cdr group)))) value)))) +(put 'etags-regen-file-extensions 'safe-local-variable (lambda (value) (and (listp value) (seq-every-p #'stringp value)))) +(put 'etags-regen-ignores 'safe-local-variable (lambda (value) (and (listp value) (seq-every-p #'stringp value)))) +(defvar etags-regen-mode nil "\ +Non-nil if Etags-Regen mode is enabled. +See the `etags-regen-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `etags-regen-mode'.") +(custom-autoload 'etags-regen-mode "etags-regen" nil) +(autoload 'etags-regen-mode "etags-regen" "\ +Minor mode to automatically generate and update tags tables. + +This minor mode generates the tags table automatically based on +the current project configuration, and later updates it as you +edit the files and save the changes. + +If you select a tags table manually (for example, using +\\[visit-tags-table]), then this mode will be effectively +disabled for the entire session. Use \\[tags-reset-tags-tables] +to countermand the effect of a previous \\[visit-tags-table]. + +This is a global minor mode. If called interactively, toggle the +`Etags-Regen mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='etags-regen-mode)'. + +The mode's hook is called both when the mode is enabled and when it is +disabled. + +(fn &optional ARG)" t) +(register-definition-prefixes "etags-regen" '("etags-regen-")) + ;;; Generated autoloads from language/ethio-util.el @@ -11892,19 +11970,19 @@ Minor mode for a buffer-specific default face. When enabled, the face specified by the variable `buffer-face-mode-face' is used to display the buffer text. -This is a minor mode. If called interactively, toggle the -`Buffer-Face mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Buffer-Face +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `buffer-face-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'buffer-face-set "face-remap" "\ @@ -12377,12 +12455,14 @@ earlier in the `setq-connection-local'. The return value of the (fn [VARIABLE VALUE]...)" nil t) (autoload 'connection-local-p "files-x" "\ Non-nil if VARIABLE has a connection-local binding in `default-directory'. +`default-directory' must be a remote file name. If APPLICATION is nil, the value of `connection-local-default-application' is used. (fn VARIABLE &optional APPLICATION)" nil t) (autoload 'connection-local-value "files-x" "\ Return connection-local VARIABLE for APPLICATION in `default-directory'. +`default-directory' must be a remote file name. If APPLICATION is nil, the value of `connection-local-default-application' is used. If VARIABLE does not have a connection-local binding, the return @@ -12900,19 +12980,19 @@ suitable for the current buffer. The commands `flymake-reporting-backends' summarize the situation, as does the special *Flymake log* buffer. -This is a minor mode. If called interactively, toggle the -`Flymake mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Flymake +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `flymake-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'flymake-mode-on "flymake" "\ @@ -12977,19 +13057,19 @@ in your init file. \\[flyspell-region] checks all words inside a region. \\[flyspell-buffer] checks the whole buffer. -This is a minor mode. If called interactively, toggle the -`Flyspell mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Flyspell +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `flyspell-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'turn-on-flyspell "flyspell" "\ @@ -13045,7 +13125,7 @@ being able to use 144 or 216 lines instead of the normal 72... (your mileage may vary). To split one large window into two side-by-side windows, the commands -`\\[split-window-right]' or `\\[follow-delete-other-windows-and-split]' can be used. +\\[split-window-right] or \\[follow-delete-other-windows-and-split] can be used. Only windows displayed in the same frame follow each other. @@ -13054,19 +13134,19 @@ This command runs the normal hook `follow-mode-hook'. Keys specific to Follow mode: \\{follow-mode-map} -This is a minor mode. If called interactively, toggle the -`Follow mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Follow mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `follow-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'follow-scroll-up-window "follow" "\ @@ -13152,19 +13232,19 @@ provides footnote support for `message-mode'. To get started, play around with the following keys: \\{footnote-minor-mode-map} -This is a minor mode. If called interactively, toggle the -`Footnote mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Footnote +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `footnote-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "footnote" '("footnote-")) @@ -13618,19 +13698,18 @@ being transferred. This list may grow up to a size of the list) is deleted every time a new one is added (at the front). This is a global minor mode. If called interactively, toggle the -`Gdb-Enable-Debug mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Gdb-Enable-Debug mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='gdb-enable-debug)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'gdb "gdb-mi" "\ @@ -13794,19 +13873,19 @@ Minor mode for making identifiers likeThis readable. When this mode is active, it tries to add virtual separators (like underscores) at places they belong to. -This is a minor mode. If called interactively, toggle the -`Glasses mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Glasses +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `glasses-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "glasses" '("glasses-")) @@ -13826,19 +13905,18 @@ If enabled, all glyphless characters will be displayed as boxes that display their acronyms. This is a minor mode. If called interactively, toggle the -`Glyphless-Display mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Glyphless-Display mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `glyphless-display-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "glyphless-mode" '("glyphless-mode-")) @@ -14319,19 +14397,18 @@ Minor mode for providing mailing-list commands. \\{gnus-mailing-list-mode-map} This is a minor mode. If called interactively, toggle the -`Gnus-Mailing-List mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Gnus-Mailing-List mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `gnus-mailing-list-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "gnus-ml" '("gnus-mailing-list-")) @@ -14718,19 +14795,19 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and (autoload 'goto-address-mode "goto-addr" "\ Minor mode to buttonize URLs and e-mail addresses in the current buffer. -This is a minor mode. If called interactively, toggle the -`Goto-Address mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Goto-Address +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `goto-address-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (put 'global-goto-address-mode 'globalized-minor-mode t) @@ -14761,19 +14838,18 @@ See `goto-address-mode' for more information on Goto-Address mode. Like `goto-address-mode', but only for comments and strings. This is a minor mode. If called interactively, toggle the -`Goto-Address-Prog mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Goto-Address-Prog mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `goto-address-prog-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "goto-addr" '("goto-addr")) @@ -15129,18 +15205,18 @@ or call the function `gud-tooltip-mode'.") Toggle the display of GUD tooltips. This is a global minor mode. If called interactively, toggle the -`Gud-Tooltip mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Gud-Tooltip mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='gud-tooltip-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'lldb "gud" "\ @@ -15582,6 +15658,9 @@ whose documentation describes the minor mode. If called from Lisp with a non-nil BUFFER argument, display documentation for the major and minor modes of that buffer. +When `describe-mode-outline' is non-nil, Outline minor mode +is enabled in the Help buffer. + (fn &optional BUFFER)" t) (autoload 'describe-widget "help-fns" "\ Display a buffer with information about a widget. @@ -15907,19 +15986,19 @@ position (number of characters into buffer) Hi-lock: end is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'. -This is a minor mode. If called interactively, toggle the -`Hi-Lock mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Hi-Lock +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `hi-lock-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (put 'global-hi-lock-mode 'globalized-minor-mode t) @@ -16083,22 +16162,22 @@ Several variables affect how the hiding is done: \\{hide-ifdef-mode-map} -This is a minor mode. If called interactively, toggle the -`Hide-Ifdef mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Hide-Ifdef +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `hide-ifdef-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) -(register-definition-prefixes "hideif" '("backward-ifdef" "down-ifdef" "forward-ifdef" "hide-ifdef" "hif-" "intern-safe" "next-ifdef" "previous-ifdef" "show-ifdef" "up-ifdef")) +(register-definition-prefixes "hideif" '("backward-ifdef" "down-ifdef" "forward-ifdef" "hide-ifdef" "hif-" "next-ifdef" "previous-ifdef" "show-ifdef" "up-ifdef")) ;;; Generated autoloads from progmodes/hideshow.el @@ -16160,19 +16239,19 @@ Lastly, the normal hook `hs-minor-mode-hook' is run using `run-hooks'. Key bindings: \\{hs-minor-mode-map} -This is a minor mode. If called interactively, toggle the `hs -minor mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `hs minor +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `hs-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'turn-off-hideshow "hideshow" "\ @@ -16206,19 +16285,18 @@ buffer with the contents of a file \\[highlight-compare-buffers] highlights differences between two buffers. This is a minor mode. If called interactively, toggle the -`Highlight-Changes mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Highlight-Changes mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `highlight-changes-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'highlight-changes-visible-mode "hilit-chg" "\ @@ -16235,18 +16313,18 @@ This command does not itself set Highlight Changes mode. This is a minor mode. If called interactively, toggle the `Highlight-Changes-Visible mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +positive, enable the mode, and if it is zero or negative, disable the +mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `highlight-changes-visible-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'highlight-changes-remove-highlight "hilit-chg" "\ @@ -16372,19 +16450,19 @@ non-selected window. Hl-Line mode uses the function When `hl-line-sticky-flag' is nil, Hl-Line mode highlights the line about point in the selected window only. -This is a minor mode. If called interactively, toggle the -`Hl-Line mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Hl-Line +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `hl-line-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (defvar global-hl-line-mode nil "\ @@ -16406,18 +16484,18 @@ Global-Hl-Line mode uses the function `global-hl-line-highlight' on `post-command-hook'. This is a global minor mode. If called interactively, toggle the -`Global Hl-Line mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Global Hl-Line mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='global-hl-line-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "hl-line" '("global-hl-line-" "hl-line-")) @@ -16777,19 +16855,19 @@ An enhanced `icomplete-mode' that emulates `ido-mode'. This global minor mode makes minibuffer completion behave more like `ido-mode' than regular `icomplete-mode'. -This is a global minor mode. If called interactively, toggle the -`Fido mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. +This is a global minor mode. If called interactively, toggle the `Fido +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='fido-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (defvar icomplete-mode nil "\ @@ -16817,18 +16895,18 @@ completions: \\{icomplete-minibuffer-map} This is a global minor mode. If called interactively, toggle the -`Icomplete mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Icomplete mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='icomplete-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (defvar icomplete-vertical-mode nil "\ @@ -16849,19 +16927,18 @@ the value of `max-mini-window-height', and the way the mini-window is resized depends on `resize-mini-windows'. This is a global minor mode. If called interactively, toggle the -`Icomplete-Vertical mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Icomplete-Vertical mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='icomplete-vertical-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (defvar fido-vertical-mode nil "\ @@ -16879,18 +16956,18 @@ When turning on, if non-vertical `fido-mode' is off, turn it on. If it's on, just add the vertical display. This is a global minor mode. If called interactively, toggle the -`Fido-Vertical mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Fido-Vertical mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='fido-vertical-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (when (locate-library "obsolete/iswitchb") @@ -17380,19 +17457,19 @@ See `inferior-emacs-lisp-mode' for details. (autoload 'iimage-mode "iimage" "\ Toggle Iimage mode on or off. -This is a minor mode. If called interactively, toggle the -`Iimage mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Iimage mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `iimage-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "iimage" '("iimage-" "turn-off-iimage-mode")) @@ -17464,9 +17541,13 @@ use its file extension as image type. Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data. Optional PROPS are additional image attributes to assign to the image, -like, e.g. `:mask MASK'. If the property `:scale' is not given and the -display has a high resolution (more exactly, when the average width of a -character in the default font is more than 10 pixels), the image is +like, e.g. `:mask MASK'. See Info node `(elisp)Image Descriptors' for +the list of supported properties; see the nodes following that node +for properties specific to certain image types. + +If the property `:scale' is not given and the display has a high +resolution (more exactly, when the average width of a character +in the default font is more than 10 pixels), the image is automatically scaled up in proportion to the default font. Value is the image created, or nil if images of type TYPE are not supported. @@ -17531,21 +17612,25 @@ BUFFER nil or omitted means use the current buffer. (fn START END &optional BUFFER)") (autoload 'find-image "image" "\ -Find an image, choosing one of a list of image specifications. +Find an image that satisfies one of a list of image specifications. SPECS is a list of image specifications. -Each image specification in SPECS is a property list. The contents of -a specification are image type dependent. All specifications must at -least contain either the property `:file FILE' or `:data DATA', -where FILE is the file to load the image from, and DATA is a string -containing the actual image data. If the property `:type TYPE' is -omitted or nil, try to determine the image type from its first few +Each image specification in SPECS is a property list. The +contents of a specification are image type dependent; see the +info node `(elisp)Image Descriptors' for details. All specifications +must at least contain either the property `:file FILE' or `:data DATA', +where FILE is the file from which to load the image, and DATA is a +string containing the actual image data. If the property `:type TYPE' +is omitted or nil, try to determine the image type from its first few bytes of image data. If that doesn't work, and the property `:file -FILE' provide a file name, use its file extension as image type. -If `:type TYPE' is provided, it must match the actual type -determined for FILE or DATA by `create-image'. Return nil if no -specification is satisfied. +FILE' provide a file name, use its file extension as idication of the +image type. If `:type TYPE' is provided, it must match the actual type +determined for FILE or DATA by `create-image'. + +The function returns the image specification for the first specification +in the list whose TYPE is supported and FILE, if specified, exists. It +returns nil if no specification in the list can be satisfied. If CACHE is non-nil, results are cached and returned on subsequent calls. @@ -17762,20 +17847,19 @@ are always available in Dired: \\[image-dired-dired-toggle-marked-thumbs] Toggle thumbnails in front of file names. \\[image-dired-dired-edit-comment-and-tags] Edit comment and tags of marked images. -This is a minor mode. If called interactively, toggle the -`Image-Dired minor mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +This is a minor mode. If called interactively, toggle the `Image-Dired +minor mode' mode. If the prefix argument is positive, enable the mode, +and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `image-dired-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'image-dired-display-thumbs-append "image-dired-dired" "\ @@ -17881,18 +17965,18 @@ An image file is one whose name has an extension in `image-file-name-regexps'. This is a global minor mode. If called interactively, toggle the -`Auto-Image-File mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Auto-Image-File mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='auto-image-file-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "image-file" '("image-file-")) @@ -17913,19 +17997,19 @@ Toggle Image minor mode in this buffer. Image minor mode provides the key \\\\[image-toggle-display], to switch back to `image-mode' and display an image file as the actual image. -This is a minor mode. If called interactively, toggle the `Image -minor mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Image minor +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `image-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'image-mode-to-text "image-mode" "\ @@ -18126,19 +18210,18 @@ indented towards the left by the column number at the start of that text. This is a global minor mode. If called interactively, toggle the -`Kill-Ring-Deindent mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Kill-Ring-Deindent mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='kill-ring-deindent-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "indent-aux" '("kill-ring-deindent-buffer-substring-function")) @@ -18831,19 +18914,19 @@ SPC. For spell-checking \"on the fly\", not just after typing SPC or RET, use `flyspell-mode'. -This is a minor mode. If called interactively, toggle the -`ISpell minor mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `ISpell minor +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `ispell-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'ispell-message "ispell" "\ @@ -19049,7 +19132,7 @@ Major mode for editing JSON, powered by tree-sitter. ;;; Generated autoloads from jsonrpc.el -(push (purecopy '(jsonrpc 1 0 23)) package--builtin-versions) +(push (purecopy '(jsonrpc 1 0 24)) package--builtin-versions) (register-definition-prefixes "jsonrpc" '("jsonrpc-")) @@ -19849,7 +19932,7 @@ For example, in Usenet articles, sections of text quoted from another author are indented, or have each line start with `>'. To quote a section of text, define a keyboard macro which inserts `>', put point and mark at opposite ends of the quoted section, and use -`\\[apply-macro-to-region-lines]' to mark the entire section. +\\[apply-macro-to-region-lines] to mark the entire section. Suppose you wanted to build a keyword table in C where each entry looked like this: @@ -19871,7 +19954,7 @@ and write a macro to massage a word into a table entry: \\C-x ) and then select the region of un-tablified names and use -`\\[apply-macro-to-region-lines]' to build the table from the names. +\\[apply-macro-to-region-lines] to build the table from the names. (fn TOP BOTTOM &optional MACRO)" t) (define-key ctl-x-map "q" 'kbd-macro-query) @@ -20033,18 +20116,18 @@ headers (those specified by `mail-abbrev-mode-regexp'), based on the entries in your `mail-personal-alias-file'. This is a global minor mode. If called interactively, toggle the -`Mail-Abbrevs mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Mail-Abbrevs mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='mail-abbrevs-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'mail-abbrevs-setup "mailabbrev" "\ @@ -20360,19 +20443,19 @@ The slave buffer is stored in the buffer-local variable `master-of'. You can set this variable using `master-set-slave'. You can show yourself the value of `master-of' by calling `master-show-slave'. -This is a minor mode. If called interactively, toggle the -`Master mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Master mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `master-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "master" '("master-")) @@ -20398,18 +20481,18 @@ recursion depth in the minibuffer prompt. This is only useful if This is a global minor mode. If called interactively, toggle the `Minibuffer-Depth-Indicate mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +positive, enable the mode, and if it is zero or negative, disable the +mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='minibuffer-depth-indicate-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "mb-depth" '("minibuffer-depth-")) @@ -20565,7 +20648,7 @@ Major mode for editing MetaPost sources. ;;; Generated autoloads from mh-e/mh-acros.el -(register-definition-prefixes "mh-acros" '("defmacro-mh" "defun-mh" "mh-" "with-mh-folder-updating")) +(register-definition-prefixes "mh-acros" '("mh-" "with-mh-folder-updating")) ;;; Generated autoloads from mh-e/mh-alias.el @@ -20855,18 +20938,18 @@ or call the function `midnight-mode'.") Non-nil means run `midnight-hook' at midnight. This is a global minor mode. If called interactively, toggle the -`Midnight mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Midnight mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='midnight-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'clean-buffer-list "midnight" "\ @@ -20910,19 +20993,19 @@ such that hitting RET would enter a non-default value, the prompt is modified to remove the default indication. This is a global minor mode. If called interactively, toggle the -`Minibuffer-Electric-Default mode' mode. If the prefix argument -is positive, enable the mode, and if it is zero or negative, -disable the mode. +`Minibuffer-Electric-Default mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable the +mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='minibuffer-electric-default-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "minibuf-eldef" '("minibuf")) @@ -21440,19 +21523,19 @@ Toggle Msb mode. This mode overrides the binding(s) of `mouse-buffer-menu' to provide a different buffer menu using the function `msb'. -This is a global minor mode. If called interactively, toggle the -`Msb mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. +This is a global minor mode. If called interactively, toggle the `Msb +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='msb-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "msb" '("mouse-select-buffer" "msb")) @@ -21741,18 +21824,18 @@ or call the function `mouse-wheel-mode'.") Toggle mouse wheel support (Mouse Wheel mode). This is a global minor mode. If called interactively, toggle the -`Mouse-Wheel mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Mouse-Wheel mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='mouse-wheel-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "mwheel" '("mouse-wheel-" "mwheel-")) @@ -22763,7 +22846,7 @@ Coloring: ;;; Generated autoloads from org/org.el -(push (purecopy '(org 9 6 13)) package--builtin-versions) +(push (purecopy '(org 9 6 15)) package--builtin-versions) (autoload 'org-babel-do-load-languages "org" "\ Load the languages defined in `org-babel-load-languages'. @@ -23495,19 +23578,19 @@ Toggle Outline minor mode. See the command `outline-mode' for more information on this mode. -This is a minor mode. If called interactively, toggle the -`Outline minor mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Outline +minor mode' mode. If the prefix argument is positive, enable the mode, +and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `outline-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'outline-search-level "outline" "\ @@ -24118,6 +24201,8 @@ FUN in `pred' and `app' can take one of the forms: call it with one argument (F ARG1 .. ARGn) call F with ARG1..ARGn and EXPVAL as n+1'th argument + (F ARG1 .. _ .. ARGn) + call F, passing EXPVAL at the _ position. FUN, BOOLEXP, and subsequent PAT can refer to variables bound earlier in the pattern by a SYMBOL pattern. @@ -24156,8 +24241,8 @@ As with `pcase-let', BINDINGS are of the form (PATTERN EXP), but the EXP in each binding in BINDINGS can use the results of the destructuring bindings that precede it in BINDINGS' order. -Each EXP should match (i.e. be of compatible structure) to its -respective PATTERN; a mismatch may signal an error or may go +Each EXP should match its respective PATTERN (i.e. be of structure +compatible to PATTERN); a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil. (fn BINDINGS &rest BODY)" nil t) @@ -24170,8 +24255,8 @@ All EXPs are evaluated first, and then used to perform destructuring bindings by matching each EXP against its respective PATTERN. Then BODY is evaluated with those bindings in effect. -Each EXP should match (i.e. be of compatible structure) to its -respective PATTERN; a mismatch may signal an error or may go +Each EXP should match its respective PATTERN (i.e. be of structure +compatible to PATTERN); a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil. (fn BINDINGS &rest BODY)" nil t) @@ -24772,11 +24857,6 @@ they are not by default assigned to keys." t) (defalias 'edit-picture 'picture-mode) (register-definition-prefixes "picture" '("picture-")) - -;;; Generated autoloads from language/pinyin.el - -(register-definition-prefixes "pinyin" '("pinyin-character-map")) - ;;; Generated autoloads from textmodes/pixel-fill.el @@ -24797,18 +24877,18 @@ or call the function `pixel-scroll-mode'.") A minor mode to scroll text pixel-by-pixel. This is a global minor mode. If called interactively, toggle the -`Pixel-Scroll mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Pixel-Scroll mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='pixel-scroll-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'pixel-scroll-precision-scroll-down-page "pixel-scroll" "\ @@ -24838,19 +24918,18 @@ When enabled, this minor mode allows you to scroll the display precisely, according to the turning of the mouse wheel. This is a global minor mode. If called interactively, toggle the -`Pixel-Scroll-Precision mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Pixel-Scroll-Precision mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='pixel-scroll-precision-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "pixel-scroll" '("pixel-")) @@ -25614,8 +25693,6 @@ requires quoting, e.g. `\\[quoted-insert]'. (fn REGEXP)" t) (autoload 'project-or-external-find-regexp "project" "\ Find all matches for REGEXP in the project roots or external roots. -With \\[universal-argument] prefix, you can specify the file name -pattern to search for. (fn REGEXP)" t) (autoload 'project-find-file "project" "\ @@ -25771,8 +25848,8 @@ Otherwise, `default-directory' is temporarily set to the current project's root. If OVERRIDING-MAP is non-nil, it will be used as -`overriding-local-map' to provide shorter bindings from that map -which will take priority over the global ones. +`overriding-terminal-local-map' to provide shorter bindings +from that map which will take priority over the global ones. (fn &optional OVERRIDING-MAP PROMPT-FORMAT)" t) (autoload 'project-prefix-or-any-command "project" "\ @@ -25822,7 +25899,7 @@ line and comments can also be enclosed in /* ... */. If an optional argument SYSTEM is non-nil, set up mode for the given system. To find out what version of Prolog mode you are running, enter -`\\[prolog-mode-version]'. +\\[prolog-mode-version]. Commands: \\{prolog-mode-map} @@ -26452,19 +26529,18 @@ or call the function `rcirc-track-minor-mode'.") Global minor mode for tracking activity in rcirc buffers. This is a global minor mode. If called interactively, toggle the -`Rcirc-Track minor mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Rcirc-Track minor mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='rcirc-track-minor-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "rcirc" '("rcirc-" "with-rcirc-")) @@ -26527,18 +26603,18 @@ buffers you switch to a lot, you can say something like the following: (add-hook \\='buffer-list-update-hook #\\='recentf-track-opened-file) This is a global minor mode. If called interactively, toggle the -`Recentf mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Recentf mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='recentf-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "recentf" '("recentf-")) @@ -26669,18 +26745,18 @@ Activates the region if it's inactive and Transient Mark mode is on. Only lasts until the region is next deactivated. This is a minor mode. If called interactively, toggle the -`Rectangle-Mark mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Rectangle-Mark mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `rectangle-mark-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "rect" '("apply-on-rectangle" "clear-rectangle-line" "delete-" "extract-rectangle-" "killed-rectangle" "ope" "rectangle-" "spaces-string" "string-rectangle-")) @@ -26708,19 +26784,19 @@ auto-filling. For true \"word wrap\" behavior, use `visual-line-mode' instead. -This is a minor mode. If called interactively, toggle the -`Refill mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Refill mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `refill-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "refill" '("refill-")) @@ -26770,19 +26846,19 @@ on the menu bar. ------------------------------------------------------------------------------ -This is a minor mode. If called interactively, toggle the -`Reftex mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Reftex mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `reftex-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'reftex-reset-scanning-information "reftex" "\ @@ -27004,18 +27080,18 @@ keys for repeating. See `describe-repeat-maps' for a list of all repeatable commands. This is a global minor mode. If called interactively, toggle the -`Repeat mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Repeat mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='repeat-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'repeat-exit "repeat" "\ @@ -27091,19 +27167,19 @@ reveals invisible text around point. Also see the `reveal-auto-hide' variable. -This is a minor mode. If called interactively, toggle the -`Reveal mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Reveal mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `reveal-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (defvar global-reveal-mode nil "\ @@ -27120,18 +27196,18 @@ Toggle Reveal mode in all buffers (Global Reveal mode). Reveal mode renders invisible text around point visible again. This is a global minor mode. If called interactively, toggle the -`Global Reveal mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Global Reveal mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='global-reveal-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "reveal" '("reveal-")) @@ -27674,19 +27750,19 @@ conventionally have a suffix of `.rnc'). The variable `rng-schema-locating-files' specifies files containing rules to use for finding the schema. -This is a minor mode. If called interactively, toggle the -`Rng-Validate mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Rng-Validate +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `rng-validate-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "rng-valid" '("rng-")) @@ -27800,19 +27876,19 @@ When ReST minor mode is enabled, the ReST mode keybindings are installed on top of the major mode bindings. Use this for modes derived from Text mode, like Mail mode. -This is a minor mode. If called interactively, toggle the `Rst -minor mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Rst minor +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `rst-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "rst" '("rst-")) @@ -27860,19 +27936,19 @@ Use the command `ruler-mode' to change this variable.") (autoload 'ruler-mode "ruler-mode" "\ Toggle display of ruler in header line (Ruler mode). -This is a minor mode. If called interactively, toggle the `Ruler -mode' mode. If the prefix argument is positive, enable the mode, -and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Ruler mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `ruler-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "ruler-mode" '("ruler-")) @@ -28070,7 +28146,8 @@ For more details, see Info node `(elisp) Extending Rx'. (fn NAME [(ARGS...)] RX)" nil t) (function-put 'rx-define 'lisp-indent-function 'defun) -(eval-and-compile (defun rx--pcase-macroexpander (&rest regexps) "A pattern that matches strings against `rx' REGEXPS in sexp form. +(autoload 'rx--pcase-macroexpander "rx" "\ +A pattern that matches strings against `rx' REGEXPS in sexp form. REGEXPS are interpreted as in `rx'. The pattern matches any string that is a match for REGEXPS, as if by `string-match'. @@ -28084,7 +28161,9 @@ following constructs: (backref REF) matches whatever the submatch REF matched. REF can be a number, as usual, or a name introduced by a previous (let REF ...) - construct." (rx--pcase-expand regexps))) + construct. + +(fn &rest REGEXPS)") (define-symbol-prop 'rx--pcase-macroexpander 'edebug-form-spec 'nil) (define-symbol-prop 'rx 'pcase-macroexpander #'rx--pcase-macroexpander) (autoload 'rx--pcase-expand "rx" "\ @@ -28164,18 +28243,18 @@ Calling it at any other time replaces your current minibuffer histories, which is probably undesirable. This is a global minor mode. If called interactively, toggle the -`Savehist mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Savehist mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='savehist-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "savehist" '("savehist-")) @@ -28198,18 +28277,18 @@ This means when you visit a file, point goes to the last place where it was when you previously visited the same file. This is a global minor mode. If called interactively, toggle the -`Save-Place mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Save-Place mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='save-place-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'save-place-local-mode "saveplace" "\ @@ -28225,19 +28304,18 @@ file: (save-place-mode 1) This is a minor mode. If called interactively, toggle the -`Save-Place-Local mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Save-Place-Local mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `save-place-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "saveplace" '("save-place")) @@ -28324,18 +28402,18 @@ When Scroll-All mode is enabled, scrolling commands invoked in one window apply to all visible windows in the same frame. This is a global minor mode. If called interactively, toggle the -`Scroll-All mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Scroll-All mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='scroll-all-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "scroll-all" '("scroll-all-")) @@ -28359,19 +28437,19 @@ boundaries during scrolling. Note that the default key binding to `scroll' will not work on MS-Windows systems if `w32-scroll-lock-modifier' is non-nil. -This is a minor mode. If called interactively, toggle the -`Scroll-Lock mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Scroll-Lock +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `scroll-lock-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "scroll-lock" '("scroll-lock-")) @@ -28435,18 +28513,18 @@ Semantic mode. \\{semantic-mode-map} This is a global minor mode. If called interactively, toggle the -`Semantic mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Semantic mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='semantic-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "semantic" '("bovinate" "semantic-")) @@ -28755,18 +28833,18 @@ Server mode runs a process that accepts commands from the `server-start' for details. This is a global minor mode. If called interactively, toggle the -`Server mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Server mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='server-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'server-save-buffers-kill-terminal "server" "\ @@ -29107,6 +29185,10 @@ Make the shell buffer the current buffer, and return it. ;;; Generated autoloads from emacs-lisp/shortdoc.el +(autoload 'shortdoc--check "shortdoc" "\ + + +(fn GROUP FUNCTIONS)") (defvar shortdoc--groups nil) (defmacro define-short-documentation-group (group &rest functions) "\ Add GROUP to the list of defined documentation groups. @@ -29170,7 +29252,7 @@ execution of the documented form depends on some conditions. A FUNC form can have any number of `:no-eval' (or `:no-value'), `:no-eval*', `:result', `:result-string', `:eg-result' and -`:eg-result-string' properties." (declare (indent defun)) `(progn (setq shortdoc--groups (delq (assq ',group shortdoc--groups) shortdoc--groups)) (push (cons ',group ',functions) shortdoc--groups))) +`:eg-result-string' properties." (declare (indent defun)) (shortdoc--check group functions) `(progn (setq shortdoc--groups (delq (assq ',group shortdoc--groups) shortdoc--groups)) (push (cons ',group ',functions) shortdoc--groups))) (autoload 'shortdoc-display-group "shortdoc" "\ Pop to a buffer with short documentation summary for functions in GROUP. If FUNCTION is non-nil, place point on the entry for FUNCTION (if any). @@ -29435,19 +29517,19 @@ Minor mode to simplify editing output from the diff3 program. \\{smerge-mode-map} -This is a minor mode. If called interactively, toggle the -`SMerge mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `SMerge mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `smerge-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'smerge-start-session "smerge-mode" "\ @@ -29550,19 +29632,19 @@ with `so-long-variable-overrides'. This minor mode is a standard `so-long-action' option. -This is a minor mode. If called interactively, toggle the -`So-Long minor mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `So-Long +minor mode' mode. If the prefix argument is positive, enable the mode, +and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `so-long-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'so-long-mode "so-long" "\ @@ -29640,18 +29722,18 @@ Use \\[so-long-customize] to open the customization group `so-long' to configure the behavior. This is a global minor mode. If called interactively, toggle the -`Global So-Long mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Global So-Long mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='global-so-long-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "so-long" '("so-long-" "turn-o")) @@ -29888,6 +29970,24 @@ For example: to sort lines in the region by the first word on each line RECORD-REGEXP would be \"^.*$\" and KEY would be \"\\\\=\\\" (fn REVERSE RECORD-REGEXP KEY-REGEXP BEG END)" t) +(autoload 'sort-on "sort" "\ +Sort SEQUENCE by calling PREDICATE on sort keys produced by ACCESSOR. +SEQUENCE should be the input sequence to sort. +Elements of SEQUENCE are sorted by keys which are obtained by +calling ACCESSOR on each element. ACCESSOR should be a function of +one argument, an element of SEQUENCE, and should return the key +value to be compared by PREDICATE for sorting the element. +PREDICATE is the function for comparing keys; it is called with two +arguments, the keys to compare, and should return non-nil if the +first key should sort before the second key. +The return value is always a new list. +This function has the performance advantage of evaluating +ACCESSOR only once for each element in the input SEQUENCE, and is +therefore appropriate when computing the key by ACCESSOR is an +expensive operation. This is known as the \"decorate-sort-undecorate\" +paradigm, or the Schwartzian transform. + +(fn SEQUENCE PREDICATE ACCESSOR)") (autoload 'sort-columns "sort" "\ Sort lines in region alphabetically by a certain range of columns. For the purpose of this command, the region BEG...END includes @@ -30667,18 +30767,18 @@ Encode/decode your strokes with \\[strokes-encode-buffer], \\{strokes-mode-map} This is a global minor mode. If called interactively, toggle the -`Strokes mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Strokes mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='strokes-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'strokes-decode-buffer "strokes" "\ @@ -30798,19 +30898,19 @@ called a `subword'. Here are some examples: This mode changes the definition of a word so that word commands treat nomenclature boundaries as word boundaries. -This is a minor mode. If called interactively, toggle the -`Subword mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Subword +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `subword-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (put 'global-subword-mode 'globalized-minor-mode t) @@ -30847,19 +30947,19 @@ syntax are treated as parts of words: e.g., in `superword-mode', \\{superword-mode-map} -This is a minor mode. If called interactively, toggle the -`Superword mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Superword +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `superword-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (put 'global-superword-mode 'globalized-minor-mode t) @@ -30951,18 +31051,18 @@ mouse to transfer text between Emacs and other programs which use GPM. This is due to limitations in GPM and the Linux kernel. This is a global minor mode. If called interactively, toggle the -`Gpm-Mouse mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Gpm-Mouse mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='gpm-mouse-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "t-mouse" '("gpm-mouse-")) @@ -30973,19 +31073,19 @@ it is disabled. (autoload 'tab-line-mode "tab-line" "\ Toggle display of tab line in the windows displaying the current buffer. -This is a minor mode. If called interactively, toggle the -`Tab-Line mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Tab-Line +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `tab-line-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (defvar-local tab-line-exclude nil) @@ -31057,19 +31157,18 @@ variable's value can be toggled by \\[table-fixed-width-mode] at run-time. This is a minor mode. If called interactively, toggle the -`Table-Fixed-Width mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Table-Fixed-Width mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `table-fixed-width-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'table-insert "table" "\ @@ -31926,6 +32025,9 @@ such as if there are no commands in the file, the value of `tex-default-mode' says which mode to use. (fn)" t) + (add-to-list 'major-mode-remap-defaults '(TeX-mode . tex-mode)) + (add-to-list 'major-mode-remap-defaults '(plain-TeX-mode . plain-tex-mode)) + (add-to-list 'major-mode-remap-defaults '(LaTeX-mode . latex-mode)) (defalias 'TeX-mode #'tex-mode) (defalias 'plain-TeX-mode #'plain-tex-mode) (defalias 'LaTeX-mode #'latex-mode) @@ -32475,19 +32577,19 @@ When `tildify-mode' is enabled, if `tildify-string-alist' specifies a hard space representation for current major mode, the `tildify-space-string' buffer-local variable will be set to the representation. -This is a minor mode. If called interactively, toggle the -`Tildify mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Tildify +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `tildify-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "tildify" '("tildify-")) @@ -32523,25 +32625,25 @@ non-nil, the current day and date are displayed as well. This runs the normal hook `display-time-hook' after each update. This is a global minor mode. If called interactively, toggle the -`Display-Time mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Display-Time mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='display-time-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (define-obsolete-function-alias 'display-time-world #'world-clock "28.1") (autoload 'world-clock "time" "\ Display a world clock buffer with times in various time zones. The variable `world-clock-list' specifies which time zones to use. -To turn off the world time display, go to the window and type `\\[quit-window]'." t) +To turn off the world time display, go to the window and type \\[quit-window]." t) (autoload 'emacs-uptime "time" "\ Return a string giving the uptime of this instance of Emacs. FORMAT is a string to format the result, using `format-seconds'. @@ -32822,21 +32924,16 @@ List all timers in a buffer. ;;; Generated autoloads from international/titdic-cnv.el (autoload 'titdic-convert "titdic-cnv" "\ -Convert a TIT dictionary of FILENAME into a Quail package. -Optional argument DIRNAME if specified is the directory name under which -the generated Quail package is saved. -(fn FILENAME &optional DIRNAME)" t) + +(fn FILENAME &optional DIRNAME)") +(make-obsolete 'titdic-convert 'tit-dic-convert "30.1") (autoload 'batch-titdic-convert "titdic-cnv" "\ -Run `titdic-convert' on the files remaining on the command line. -Use this from the command line, with `-batch'; -it won't work in an interactive Emacs. -For example, invoke \"emacs -batch -f batch-titdic-convert XXX.tit\" to - generate Quail package file \"xxx.el\" from TIT dictionary file \"XXX.tit\". -To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\". + (fn &optional FORCE)") -(register-definition-prefixes "titdic-cnv" '("batch-miscdic-convert" "ctlau-" "miscdic-convert" "pinyin-convert" "py-converter" "quail-" "quick-" "tit-" "tsang-" "ziranma-converter")) +(make-obsolete 'batch-titdic-convert 'batch-tit-dic-convert "30.1") +(register-definition-prefixes "titdic-cnv" '("batch-tit-" "tit-")) ;;; Generated autoloads from tmm.el @@ -32914,7 +33011,7 @@ current (i.e., last displayed) category. In Todo mode just the category's unfinished todo items are shown by default. The done items are hidden, but typing -`\\[todo-toggle-view-done-items]' displays them below the todo +\\[todo-toggle-view-done-items] displays them below the todo items. With non-nil user option `todo-show-with-done' both todo and done items are always shown on visiting a category. @@ -33012,6 +33109,61 @@ holds a keymap. (register-definition-prefixes "tooltip" '("tooltip-")) + +;;; Generated autoloads from touch-screen.el + +(autoload 'touch-screen-hold "touch-screen" "\ +Handle a long press EVENT. +Ding and select the window at EVENT, then activate the mark. If +`touch-screen-word-select' is enabled, try to select the whole +word around EVENT; otherwise, set point to the location of EVENT. + +(fn EVENT)" t) +(autoload 'touch-screen-track-tap "touch-screen" "\ +Track a single tap starting from EVENT. +EVENT should be a `touchscreen-begin' event. + +Read touch screen events until a `touchscreen-end' event is +received with the same ID as in EVENT. If UPDATE is non-nil and +a `touchscreen-update' event is received in the mean time and +contains a touch point with the same ID as in EVENT, call UPDATE +with that event and DATA. + +If THRESHOLD is non-nil, enforce a threshold of movement that is +either itself or 10 pixels when it is not a number. If the +aforementioned touch point moves beyond that threshold on any +axis, return nil immediately, and further resume mouse event +translation for the touch point at hand. + +Return nil immediately if any other kind of event is received; +otherwise, return t once the `touchscreen-end' event arrives. + +(fn EVENT &optional UPDATE DATA THRESHOLD)") +(autoload 'touch-screen-track-drag "touch-screen" "\ +Track a single drag starting from EVENT. +EVENT should be a `touchscreen-begin' event. + +Read touch screen events until a `touchscreen-end' event is +received with the same ID as in EVENT. For each +`touchscreen-update' event received in the mean time containing a +touch point with the same ID as in EVENT, call UPDATE with the +touch point in event and DATA, once the touch point has moved +significantly by at least 5 pixels from where it was in EVENT. + +Return nil immediately if any other kind of event is received; +otherwise, return either t or `no-drag' once the +`touchscreen-end' event arrives; return `no-drag' returned if the +touch point in EVENT did not move significantly, and t otherwise. + +(fn EVENT UPDATE &optional DATA)") +(autoload 'touch-screen-inhibit-drag "touch-screen" "\ +Inhibit subsequent `touchscreen-drag' events from being sent. +Prevent `touchscreen-drag' and translated mouse events from being +sent until the touch sequence currently being translated ends. +Must be called from a command bound to a `touchscreen-hold' or +`touchscreen-drag' event.") +(register-definition-prefixes "touch-screen" '("touch-screen-")) + ;;; Generated autoloads from emacs-lisp/tq.el @@ -33224,55 +33376,13 @@ Add archive file name handler to `file-name-handler-alist'." (when (and tramp-ar ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 7 0 -1)) package--builtin-versions) +(push (purecopy '(tramp 2 7 1 -1)) package--builtin-versions) (register-definition-prefixes "trampver" '("tramp-")) ;;; Generated autoloads from transient.el (push (purecopy '(transient 0 5 2)) package--builtin-versions) -(autoload 'transient-define-prefix "transient" "\ -Define NAME as a transient prefix command. - -ARGLIST are the arguments that command takes. -DOCSTRING is the documentation string and is optional. - -These arguments can optionally be followed by key-value pairs. -Each key has to be a keyword symbol, either `:class' or a keyword -argument supported by the constructor of that class. The -`transient-prefix' class is used if the class is not specified -explicitly. - -GROUPs add key bindings for infix and suffix commands and specify -how these bindings are presented in the popup buffer. At least -one GROUP has to be specified. See info node `(transient)Binding -Suffix and Infix Commands'. - -The BODY is optional. If it is omitted, then ARGLIST is also -ignored and the function definition becomes: - - (lambda () - (interactive) - (transient-setup \\='NAME)) - -If BODY is specified, then it must begin with an `interactive' -form that matches ARGLIST, and it must call `transient-setup'. -It may however call that function only when some condition is -satisfied; that is one of the reason why you might want to use -an explicit BODY. - -All transients have a (possibly nil) value, which is exported -when suffix commands are called, so that they can consume that -value. For some transients it might be necessary to have a sort -of secondary value, called a scope. Such a scope would usually -be set in the commands `interactive' form and has to be passed -to the setup function: - - (transient-setup \\='NAME nil nil :scope SCOPE) - -(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... GROUP... [BODY...])" nil t) -(function-put 'transient-define-prefix 'lisp-indent-function 'defun) -(function-put 'transient-define-prefix 'doc-string-elt 3) (autoload 'transient-insert-suffix "transient" "\ Insert a SUFFIX into PREFIX before LOC. PREFIX is a prefix command, a symbol. @@ -33517,18 +33627,18 @@ sessions and after a crash. Manual changes to the file may result in problems. This is a global minor mode. If called interactively, toggle the -`Type-Break mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Type-Break mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='type-break-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'type-break "type-break" "\ @@ -33914,18 +34024,18 @@ and `C-x C-f https://www.gnu.org/ RET' will give you the HTML at that URL in a buffer. This is a global minor mode. If called interactively, toggle the -`Url-Handler mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Url-Handler mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='url-handler-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'url-file-handler "url-handlers" "\ @@ -34012,10 +34122,7 @@ URL can be a URL string, or a URL record of the type returned by ;;; Generated autoloads from url/url-mailto.el -(autoload 'url-mail "url-mailto" "\ - - -(fn &rest ARGS)" t) +(defalias 'url-mail #'message-mail) (autoload 'url-mailto "url-mailto" "\ Handle the mailto: URL syntax. @@ -34478,7 +34585,6 @@ Normalize arguments to delight. ;;; Generated autoloads from use-package/use-package-ensure-system-package.el -(push (purecopy '(use-package-ensure-system-package 0 2)) package--builtin-versions) (autoload 'use-package-normalize/:ensure-system-package "use-package-ensure-system-package" "\ Turn ARGS into a list of conses of the form (PACKAGE-NAME . INSTALL-COMMAND). @@ -35192,6 +35298,25 @@ case, and the process object in the asynchronous case. (progn (load "vc-git" nil t) (vc-git-registered file)))) +(autoload 'vc-git-grep "vc-git" "\ +Run git grep, searching for REGEXP in FILES in directory DIR. +The search is limited to file names matching shell pattern FILES. +FILES may use abbreviations defined in `grep-files-aliases', e.g. +entering `ch' is equivalent to `*.[ch]'. As whitespace triggers +completion when entering a pattern, including it requires +quoting, e.g. `\\[quoted-insert]'. + +With \\[universal-argument] prefix, you can edit the constructed shell command line +before it is executed. +With two \\[universal-argument] prefixes, directly edit and run `grep-command'. + +Collect output in a buffer. While git grep runs asynchronously, you +can use \\[next-error] (`next-error'), or \\\\[compile-goto-error] in the grep output buffer, +to go to the lines where grep found matches. + +This command shares argument histories with \\[rgrep] and \\[grep]. + +(fn REGEXP &optional FILES DIR)" t) (register-definition-prefixes "vc-git" '("vc-")) @@ -35317,7 +35442,7 @@ Key bindings: ;;; Generated autoloads from progmodes/verilog-mode.el -(push (purecopy '(verilog-mode 2023 6 6 141322628)) package--builtin-versions) +(push (purecopy '(verilog-mode 2024 3 1 121933719)) package--builtin-versions) (autoload 'verilog-mode "verilog-mode" "\ Major mode for editing Verilog code. \\ @@ -35592,7 +35717,7 @@ Usage: according to option `vhdl-argument-list-indent'. If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of - tabs. `\\[tabify]' and `\\[untabify]' allow the conversion of spaces to + tabs. \\[tabify] and \\[untabify] allow the conversion of spaces to tabs and vice versa. Syntax-based indentation can be very slow in large files. Option @@ -35903,7 +36028,7 @@ Usage: `vhdl-highlight-translate-off' is non-nil. For documentation and customization of the used colors see - customization group `vhdl-highlight-faces' (`\\[customize-group]'). For + customization group `vhdl-highlight-faces' (\\[customize-group]). For highlighting of matching parenthesis, see customization group `paren-showing'. Automatic buffer highlighting is turned on/off by option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs). @@ -35963,14 +36088,14 @@ Usage: sessions using the \"Save Options\" menu entry. Options and their detailed descriptions can also be accessed by using - the \"Customize\" menu entry or the command `\\[customize-option]' - (`\\[customize-group]' for groups). Some customizations only take effect + the \"Customize\" menu entry or the command \\[customize-option] + (\\[customize-group] for groups). Some customizations only take effect after some action (read the NOTE in the option documentation). Customization can also be done globally (i.e. site-wide, read the INSTALL file). Not all options are described in this documentation, so go and see - what other useful user options there are (`\\[vhdl-customize]' or menu)! + what other useful user options there are (\\[vhdl-customize] or menu)! FILE EXTENSIONS: @@ -35999,7 +36124,7 @@ Usage: Maintenance: ------------ -To submit a bug report, enter `\\[vhdl-submit-bug-report]' within VHDL Mode. +To submit a bug report, enter \\[vhdl-submit-bug-report] within VHDL Mode. Add a description of the problem and include a reproducible test case. Questions and enhancement requests can be sent to . @@ -36264,19 +36389,19 @@ then \\[View-leave], \\[View-quit] and \\[View-kill-and-leave] will return to th Entry to view-mode runs the normal hook `view-mode-hook'. -This is a minor mode. If called interactively, toggle the `View -mode' mode. If the prefix argument is positive, enable the mode, -and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `View mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `view-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'view-mode-enter "view" "\ @@ -36350,6 +36475,57 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t) (register-definition-prefixes "quail/viqr" '("viet-quail-define-rules")) + +;;; Generated autoloads from visual-wrap.el + +(autoload 'visual-wrap-prefix-mode "visual-wrap" "\ +Display continuation lines with prefixes from surrounding context. + +To enable this minor mode across all buffers, enable +`global-visual-wrap-prefix-mode'. + +This is a minor mode. If called interactively, toggle the +`Visual-Wrap-Prefix mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `visual-wrap-prefix-mode'. + +The mode's hook is called both when the mode is enabled and when it is +disabled. + +(fn &optional ARG)" t) +(put 'global-visual-wrap-prefix-mode 'globalized-minor-mode t) +(defvar global-visual-wrap-prefix-mode nil "\ +Non-nil if Global Visual-Wrap-Prefix mode is enabled. +See the `global-visual-wrap-prefix-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `global-visual-wrap-prefix-mode'.") +(custom-autoload 'global-visual-wrap-prefix-mode "visual-wrap" nil) +(autoload 'global-visual-wrap-prefix-mode "visual-wrap" "\ +Toggle Visual-Wrap-Prefix mode in all buffers. +With prefix ARG, enable Global Visual-Wrap-Prefix mode if ARG is +positive; otherwise, disable it. + +If called from Lisp, toggle the mode if ARG is `toggle'. +Enable the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +Visual-Wrap-Prefix mode is enabled in all buffers where +`visual-wrap-prefix-mode' would do it. + +See `visual-wrap-prefix-mode' for more information on +Visual-Wrap-Prefix mode. + +(fn &optional ARG)" t) +(register-definition-prefixes "visual-wrap" '("visual-wrap-")) + ;;; Generated autoloads from emacs-lisp/vtable.el @@ -36532,18 +36708,18 @@ current function name is continuously displayed in the mode line, in certain major modes. This is a global minor mode. If called interactively, toggle the -`Which-Function mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Which-Function mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='which-function-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "which-func" '("which-func")) @@ -36561,19 +36737,19 @@ See also `whitespace-style', `whitespace-newline' and This mode uses a number of faces to visualize the whitespace; see the customization group `whitespace' for details. -This is a minor mode. If called interactively, toggle the -`Whitespace mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Whitespace +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `whitespace-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'whitespace-newline-mode "whitespace" "\ @@ -36587,19 +36763,18 @@ use `whitespace-mode'. See also `whitespace-newline' and `whitespace-display-mappings'. This is a minor mode. If called interactively, toggle the -`Whitespace-Newline mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Whitespace-Newline mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `whitespace-newline-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (put 'global-whitespace-mode 'globalized-minor-mode t) @@ -36646,18 +36821,18 @@ See also `whitespace-newline' and `whitespace-display-mappings'. This is a global minor mode. If called interactively, toggle the `Global Whitespace-Newline mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +positive, enable the mode, and if it is zero or negative, disable the +mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='global-whitespace-newline-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'whitespace-toggle-options "whitespace" "\ @@ -36961,19 +37136,19 @@ Show widget browser for WIDGET in other window. (autoload 'widget-minor-mode "wid-browse" "\ Minor mode for traversing widgets. -This is a minor mode. If called interactively, toggle the -`Widget minor mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the `Widget minor +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `widget-minor-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "wid-browse" '("widget-")) @@ -37068,18 +37243,18 @@ for a description of this minor mode.") Global minor mode for default windmove commands. This is a global minor mode. If called interactively, toggle the -`Windmove mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Windmove mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='windmove-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (autoload 'windmove-default-keybindings "windmove" "\ @@ -37215,18 +37390,18 @@ sequence \\`C-c '. If you change your mind (while undoing), you can press \\`C-c ' (calling `winner-redo'). This is a global minor mode. If called interactively, toggle the -`Winner mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Winner mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='winner-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "winner" '("winner-")) @@ -37294,19 +37469,18 @@ Allow `word-wrap' to fold on all breaking whitespace characters. The characters to break on are defined by `word-wrap-whitespace-characters'. This is a minor mode. If called interactively, toggle the -`Word-Wrap-Whitespace mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable -the mode. +`Word-Wrap-Whitespace mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `word-wrap-whitespace-mode'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (put 'global-word-wrap-whitespace-mode 'globalized-minor-mode t) @@ -37557,18 +37731,18 @@ mouse functionality for such clicks is still available by holding down the SHIFT key while pressing the mouse button. This is a global minor mode. If called interactively, toggle the -`Xterm-Mouse mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Xterm-Mouse mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='xterm-mouse-mode)'. -The mode's hook is called both when the mode is enabled and when -it is disabled. +The mode's hook is called both when the mode is enabled and when it is +disabled. (fn &optional ARG)" t) (register-definition-prefixes "xt-mouse" '("turn-o" "xt-mouse-epoch" "xterm-mouse-")) @@ -37652,99 +37826,9 @@ run a specific program. The program must be a member of (register-definition-prefixes "zone" '("zone-")) -;;; Generated autoloads from emacs-lisp/ert-font-lock.el - -(autoload 'ert-font-lock-deftest "ert-font-lock" "\ -Define test NAME (a symbol) using assertions from TEST-STR. - -Other than MAJOR-MODE and TEST-STR parameters, this macro accepts -the same parameters and keywords as `ert-deftest' and is intended -to be used through `ert'. - -(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)] MAJOR-MODE TEST-STR)" nil t) -(function-put 'ert-font-lock-deftest 'doc-string-elt 3) -(function-put 'ert-font-lock-deftest 'lisp-indent-function 2) -(autoload 'ert-font-lock-deftest-file "ert-font-lock" "\ -Define test NAME (a symbol) using assertions from FILE. - -FILE - path to a file with assertions in ERT resource director as -return by `ert-resource-directory'. - -Other than MAJOR-MODE and FILE parameters, this macro accepts the -same parameters and keywords as `ert-deftest' and is intended to -be used through `ert'. - -(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)] MAJOR-MODE FILE)" nil t) -(function-put 'ert-font-lock-deftest-file 'doc-string-elt 3) -(function-put 'ert-font-lock-deftest-file 'lisp-indent-function 2) -(autoload 'ert-font-lock-test-string "ert-font-lock" "\ -Check font faces in TEST-STRING set by MODE. - -The function is meant to be run from within an ERT test. - -(fn TEST-STRING MODE)") -(autoload 'ert-font-lock-test-file "ert-font-lock" "\ -Check font faces in FILENAME set by MODE. - -The function is meant to be run from within an ERT test. - -(fn FILENAME MODE)") -(register-definition-prefixes "ert-font-lock" '("ert-font-lock--")) - - -;;; Generated autoloads from touch-screen.el - -(autoload 'touch-screen-hold "touch-screen" "\ -Handle a long press EVENT. -Ding and select the window at EVENT, then activate the mark. If -`touch-screen-word-select' is enabled, try to select the whole -word around EVENT; otherwise, set point to the location of EVENT. - -(fn EVENT)" t) -(autoload 'touch-screen-track-tap "touch-screen" "\ -Track a single tap starting from EVENT. -EVENT should be a `touchscreen-begin' event. - -Read touch screen events until a `touchscreen-end' event is -received with the same ID as in EVENT. If UPDATE is non-nil and -a `touchscreen-update' event is received in the mean time and -contains a touch point with the same ID as in EVENT, call UPDATE -with that event and DATA. - -If THRESHOLD is non-nil, enforce a threshold of movement that is -either itself or 10 pixels when it is not a number. If the -aforementioned touch point moves beyond that threshold on any -axis, return nil immediately, and further resume mouse event -translation for the touch point at hand. - -Return nil immediately if any other kind of event is received; -otherwise, return t once the `touchscreen-end' event arrives. - -(fn EVENT &optional UPDATE DATA THRESHOLD)") -(autoload 'touch-screen-track-drag "touch-screen" "\ -Track a single drag starting from EVENT. -EVENT should be a `touchscreen-begin' event. - -Read touch screen events until a `touchscreen-end' event is -received with the same ID as in EVENT. For each -`touchscreen-update' event received in the mean time containing a -touch point with the same ID as in EVENT, call UPDATE with the -touch point in event and DATA, once the touch point has moved -significantly by at least 5 pixels from where it was in EVENT. - -Return nil immediately if any other kind of event is received; -otherwise, return either t or `no-drag' once the -`touchscreen-end' event arrives; return `no-drag' returned if the -touch point in EVENT did not move significantly, and t otherwise. +;;; Generated autoloads from net/tramp-androidsu.el -(fn EVENT UPDATE &optional DATA)") -(autoload 'touch-screen-inhibit-drag "touch-screen" "\ -Inhibit subsequent `touchscreen-drag' events from being sent. -Prevent `touchscreen-drag' and translated mouse events from being -sent until the touch sequence currently being translated ends. -Must be called from a command bound to a `touchscreen-hold' or -`touchscreen-drag' event.") -(register-definition-prefixes "touch-screen" '("touch-screen-")) +(register-definition-prefixes "tramp-androidsu" '("tramp-androidsu-")) ;;; End of scraped data @@ -37754,8 +37838,8 @@ Must be called from a command bound to a `touchscreen-hold' or ;; Local Variables: ;; version-control: never ;; no-update-autoloads: t -;; no-byte-compile: t ;; no-native-compile: t +;; no-byte-compile: t ;; coding: utf-8-emacs-unix ;; End: -- cgit v1.2.3 From 454a55dbd963d4b07c0dc0f6d540cc5fd4b4faa7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 8 Mar 2024 12:44:38 -0500 Subject: (dir-locals-collect-variables): Avoid spurious safety warnings * lisp/files.el (dir-locals-collect-variables): Silence warnings for extra parents' variables. --- lisp/files.el | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'lisp') diff --git a/lisp/files.el b/lisp/files.el index dd7580b6580..3ca4f047144 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4446,6 +4446,12 @@ to see whether it should be considered." (funcall predicate key) (or (not key) (derived-mode-p key))) + ;; If KEY is an extra parent it may remain not loaded + ;; (hence with some of its mode-specific vars missing their + ;; `safe-local-variable' property), leading to spurious + ;; prompts about unsafe vars (bug#68246). + (if (and (symbolp key) (autoloadp (indirect-function key))) + (ignore-errors (autoload-do-load (indirect-function key)))) (let* ((alist (cdr entry)) (subdirs (assq 'subdirs alist))) (if (or (not subdirs) -- cgit v1.2.3 From c79a509384d33dab6a964ef9a97cbc9a1f1b5bf7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 8 Mar 2024 12:58:11 -0500 Subject: Add non-TS modes as extra parent of TS modes (bug#68246) Record the fact that TS modes are alternatives to the non-TS modes using the new `derived-mode-add-parents` functionality. Do the same for long standing similar issues with CPerl-mode. * lisp/textmodes/yaml-ts-mode.el (yaml-ts-mode): * lisp/textmodes/toml-ts-mode.el (toml-ts-mode): * lisp/textmodes/html-ts-mode.el (html-ts-mode): * lisp/textmodes/css-mode.el (css-ts-mode): * lisp/progmodes/typescript-ts-mode.el (typescript-ts-mode, tsx-ts-mode): * lisp/progmodes/sh-script.el (bash-ts-mode): * lisp/progmodes/rust-ts-mode.el (rust-ts-mode): * lisp/progmodes/ruby-ts-mode.el (ruby-ts-mode): * lisp/progmodes/python.el (python-ts-mode): * lisp/progmodes/lua-ts-mode.el (lua-ts-mode): * lisp/progmodes/json-ts-mode.el (json-ts-mode): * lisp/progmodes/js.el (js-ts-mode): * lisp/progmodes/java-ts-mode.el (java-ts-mode): * lisp/progmodes/heex-ts-mode.el (heex-ts-mode): * lisp/progmodes/go-ts-mode.el (go-ts-mode, go-mod-ts-mode): * lisp/progmodes/elixir-ts-mode.el (elixir-ts-mode): * lisp/progmodes/dockerfile-ts-mode.el (dockerfile-ts-mode): * lisp/progmodes/csharp-mode.el (csharp-ts-mode): * lisp/progmodes/cmake-ts-mode.el (cmake-ts-mode): * lisp/progmodes/c-ts-mode.el (c-ts-mode, c++-ts-mode): Add non-TS mode as extra parent. * lisp/progmodes/cperl-mode.el (cperl-mode): Add `perl-mode` as extra parent. --- etc/NEWS | 10 ++++++++++ lisp/progmodes/c-ts-mode.el | 4 ++++ lisp/progmodes/cmake-ts-mode.el | 2 ++ lisp/progmodes/cperl-mode.el | 2 ++ lisp/progmodes/csharp-mode.el | 2 ++ lisp/progmodes/dockerfile-ts-mode.el | 2 ++ lisp/progmodes/elixir-ts-mode.el | 2 ++ lisp/progmodes/go-ts-mode.el | 4 ++++ lisp/progmodes/heex-ts-mode.el | 2 ++ lisp/progmodes/java-ts-mode.el | 2 ++ lisp/progmodes/js.el | 2 ++ lisp/progmodes/json-ts-mode.el | 2 ++ lisp/progmodes/lua-ts-mode.el | 2 ++ lisp/progmodes/python.el | 2 ++ lisp/progmodes/ruby-ts-mode.el | 2 ++ lisp/progmodes/rust-ts-mode.el | 2 ++ lisp/progmodes/sh-script.el | 2 ++ lisp/progmodes/typescript-ts-mode.el | 4 ++++ lisp/textmodes/css-mode.el | 2 ++ lisp/textmodes/html-ts-mode.el | 2 ++ lisp/textmodes/toml-ts-mode.el | 2 ++ lisp/textmodes/yaml-ts-mode.el | 2 ++ 22 files changed, 58 insertions(+) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index 2aa669be344..2e51c0490fe 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -62,6 +62,16 @@ more details. * Incompatible Changes in Emacs 30.1 +** Tree-Sitter modes are now declared as submodes of the non-TS modes. +In order to help the use of those Tree-Sitter modes, they are now +declared to have the corresponding non-Tree-Sitter mode as an +additional parent. +This way, things like `.dir-locals.el` settings, and YASnippet +collections of snippets automatically apply to the new Tree-Sitter modes. + +Note that those modes still do not inherit from the non-TS mode, so +configuration settings installed via mode hooks are not affected. + +++ ** URL now never sends user email addresses in HTTP requests. Emacs never sent email addresses by default, but it used to be diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 38b72e59388..a2e7f6fba2e 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -1328,6 +1328,8 @@ in your configuration." (lambda (_pos) 'c)) (treesit-font-lock-recompute-features '(emacs-devel))))) +(derived-mode-add-parents 'c-ts-mode '(c-mode)) + ;;;###autoload (define-derived-mode c++-ts-mode c-ts-base-mode "C++" "Major mode for editing C++, powered by tree-sitter. @@ -1371,6 +1373,8 @@ recommended to enable `electric-pair-mode' with this mode." (setq-local add-log-current-defun-function #'c-ts-mode--emacs-current-defun-name)))) +(derived-mode-add-parents 'c++-ts-mode '(c++-mode)) + (easy-menu-define c-ts-mode-menu (list c-ts-mode-map c++-ts-mode-map) "Menu for `c-ts-mode' and `c++-ts-mode'." '("C/C++" diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el index 45c4882d873..b70806f4c30 100644 --- a/lisp/progmodes/cmake-ts-mode.el +++ b/lisp/progmodes/cmake-ts-mode.el @@ -243,6 +243,8 @@ Return nil if there is no name or if NODE is not a defun node." (treesit-major-mode-setup))) +(derived-mode-add-parents 'cmake-ts-mode '(cmake-mode)) + (if (treesit-ready-p 'cmake) (add-to-list 'auto-mode-alist '("\\(?:CMakeLists\\.txt\\|\\.cmake\\)\\'" . cmake-ts-mode))) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 10ac80dffd5..11709bfe00b 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1934,6 +1934,8 @@ or as help on variables `cperl-tips', `cperl-problems', ;; Setup Flymake (add-hook 'flymake-diagnostic-functions #'perl-flymake nil t)) +(derived-mode-add-parents 'cperl-mode '(perl-mode)) + (defun cperl--set-file-style () (when cperl-file-style (cperl-file-style cperl-file-style))) diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 7bf57bcbe21..18114d08528 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -998,6 +998,8 @@ Key bindings: (add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-ts-mode))) +(derived-mode-add-parents 'csharp-ts-mode '(csharp-mode)) + (provide 'csharp-mode) ;;; csharp-mode.el ends here diff --git a/lisp/progmodes/dockerfile-ts-mode.el b/lisp/progmodes/dockerfile-ts-mode.el index f6587018513..e31fd86bbdf 100644 --- a/lisp/progmodes/dockerfile-ts-mode.el +++ b/lisp/progmodes/dockerfile-ts-mode.el @@ -165,6 +165,8 @@ Return nil if there is no name or if NODE is not a stage node." (treesit-major-mode-setup))) +(derived-mode-add-parents 'dockerfile-ts-mode '(dockerfile-mode)) + (if (treesit-ready-p 'dockerfile) (add-to-list 'auto-mode-alist ;; NOTE: We can't use `rx' here, as it breaks bootstrap. diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el index f26c3a49203..9804152d9ab 100644 --- a/lisp/progmodes/elixir-ts-mode.el +++ b/lisp/progmodes/elixir-ts-mode.el @@ -753,6 +753,8 @@ Return nil if NODE is not a defun node or doesn't have a name." (treesit-major-mode-setup) (setq-local syntax-propertize-function #'elixir-ts--syntax-propertize))) +(derived-mode-add-parents 'elixir-ts-mode '(elixir-mode)) + (if (treesit-ready-p 'elixir) (progn (add-to-list 'auto-mode-alist '("\\.elixir\\'" . elixir-ts-mode)) diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index 296e4d0037d..cc330688dc3 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -261,6 +261,8 @@ (treesit-major-mode-setup))) +(derived-mode-add-parents 'go-ts-mode '(go-mode)) + (if (treesit-ready-p 'go) ;; FIXME: Should we instead put `go-mode' in `auto-mode-alist' ;; and then use `major-mode-remap-defaults' to map it to `go-ts-mode'? @@ -439,6 +441,8 @@ what the parent of the node would be if it were a node." (treesit-major-mode-setup))) +(derived-mode-add-parents 'go-mod-ts-mode '(go-mod-mode)) + (if (treesit-ready-p 'gomod) (add-to-list 'auto-mode-alist '("/go\\.mod\\'" . go-mod-ts-mode))) diff --git a/lisp/progmodes/heex-ts-mode.el b/lisp/progmodes/heex-ts-mode.el index 22e8956661d..07b8bfdc74f 100644 --- a/lisp/progmodes/heex-ts-mode.el +++ b/lisp/progmodes/heex-ts-mode.el @@ -187,6 +187,8 @@ With ARG, do it many times. Negative ARG means move backward." (treesit-major-mode-setup))) +(derived-mode-add-parents 'heex-ts-mode '(heex-mode)) + (if (treesit-ready-p 'heex) ;; Both .heex and the deprecated .leex files should work ;; with the tree-sitter-heex grammar. diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 00d7d0d75a1..bb4a7df3340 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -406,6 +406,8 @@ Return nil if there is no name or if NODE is not a defun node." ("Method" "\\`method_declaration\\'" nil nil))) (treesit-major-mode-setup)) +(derived-mode-add-parents 'java-ts-mode '(java-mode)) + (if (treesit-ready-p 'java) (add-to-list 'auto-mode-alist '("\\.java\\'" . java-ts-mode))) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index ebc098e6a75..6cb84592896 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3916,6 +3916,8 @@ See `treesit-thing-settings' for more information.") (add-to-list 'auto-mode-alist '("\\(\\.js[mx]\\|\\.har\\)\\'" . js-ts-mode)))) +(derived-mode-add-parents 'js-ts-mode '(js-mode)) + (defvar js-ts--s-p-query (when (treesit-available-p) (treesit-query-compile 'javascript diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el index 32bc10bbda9..1fb96555010 100644 --- a/lisp/progmodes/json-ts-mode.el +++ b/lisp/progmodes/json-ts-mode.el @@ -164,6 +164,8 @@ Return nil if there is no name or if NODE is not a defun node." (treesit-major-mode-setup)) +(derived-mode-add-parents 'json-ts-mode '(json-mode)) + (if (treesit-ready-p 'json) (add-to-list 'auto-mode-alist '("\\.json\\'" . json-ts-mode))) diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 8bd3db2b75f..25fd7792f42 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -798,6 +798,8 @@ Calls REPORT-FN directly." (add-hook 'flymake-diagnostic-functions #'lua-ts-flymake-luacheck nil 'local)) +(derived-mode-add-parents 'lua-ts-mode '(lua-mode)) + (when (treesit-ready-p 'lua) (add-to-list 'auto-mode-alist '("\\.lua\\'" . lua-ts-mode))) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index bedc61408ef..1016655cb62 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -7128,6 +7128,8 @@ implementations: `python-mode' and `python-ts-mode'." (add-to-list 'auto-mode-alist '("\\.py[iw]?\\'" . python-ts-mode)) (add-to-list 'interpreter-mode-alist '("python[0-9.]*" . python-ts-mode)))) +(derived-mode-add-parents 'python-ts-mode '(python-mode)) + ;;; Completion predicates for M-x ;; Commands that only make sense when editing Python code. (dolist (sym '(python-add-import diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index cdfa3dca498..7133cb0b5b0 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -1210,6 +1210,8 @@ leading double colon is not added." (setq-local syntax-propertize-function #'ruby-ts--syntax-propertize)) +(derived-mode-add-parents 'ruby-ts-mode '(ruby-mode)) + (if (treesit-ready-p 'ruby) (add-to-list 'major-mode-remap-defaults '(ruby-mode . ruby-ts-mode))) diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index c5fc57cc374..c67ac43e4d0 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -474,6 +474,8 @@ See `prettify-symbols-compose-predicate'." (treesit-major-mode-setup))) +(derived-mode-add-parents 'rust-ts-mode '(rust-mode)) + (if (treesit-ready-p 'rust) (add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-ts-mode))) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 43fb8a723bd..ab95dc9f924 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1639,6 +1639,8 @@ not written in Bash or sh." (setq-local treesit-defun-type-regexp "function_definition") (treesit-major-mode-setup))) +(derived-mode-add-parents 'bash-ts-mode '(sh-mode)) + (advice-add 'bash-ts-mode :around #'sh--redirect-bash-ts-mode ;; Give it lower precedence than normal advice, so other ;; advices take precedence over it. diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 9ee9432e4ee..ea4f6417c5a 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -505,6 +505,8 @@ This mode is intended to be inherited by concrete major modes." (treesit-major-mode-setup))) +(derived-mode-add-parents 'typescript-ts-mode '(typescript-mode)) + (if (treesit-ready-p 'typescript) (add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-ts-mode))) @@ -562,6 +564,8 @@ at least 3 (which is the default value)." (treesit-major-mode-setup))) +(derived-mode-add-parents 'tsx-ts-mode '(tsx-mode)) + (defvar typescript-ts--s-p-query (when (treesit-available-p) (treesit-query-compile 'typescript diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 425f3ec8a30..f5a20e0ca0e 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1830,6 +1830,8 @@ can also be used to fill comments. (add-to-list 'auto-mode-alist '("\\.css\\'" . css-ts-mode)))) +(derived-mode-add-parents 'css-ts-mode '(css-mode)) + ;;;###autoload (define-derived-mode css-mode css-base-mode "CSS" "Major mode to edit Cascading Style Sheets (CSS). diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el index 9af2aa6748f..235e1055fa9 100644 --- a/lisp/textmodes/html-ts-mode.el +++ b/lisp/textmodes/html-ts-mode.el @@ -134,6 +134,8 @@ Return nil if there is no name or if NODE is not a defun node." (treesit-major-mode-setup)) +(derived-mode-add-parents 'html-ts-mode '(html-mode)) + (if (treesit-ready-p 'html) (add-to-list 'auto-mode-alist '("\\.html\\'" . html-ts-mode))) diff --git a/lisp/textmodes/toml-ts-mode.el b/lisp/textmodes/toml-ts-mode.el index 1ba410045f5..1b621032f8a 100644 --- a/lisp/textmodes/toml-ts-mode.el +++ b/lisp/textmodes/toml-ts-mode.el @@ -153,6 +153,8 @@ Return nil if there is no name or if NODE is not a defun node." (treesit-major-mode-setup))) +(derived-mode-add-parents 'toml-ts-mode '(toml-mode)) + (if (treesit-ready-p 'toml) (add-to-list 'auto-mode-alist '("\\.toml\\'" . toml-ts-mode))) diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el index a8cb504ef03..210835585fe 100644 --- a/lisp/textmodes/yaml-ts-mode.el +++ b/lisp/textmodes/yaml-ts-mode.el @@ -169,6 +169,8 @@ boundaries. JUSTIFY is passed to `fill-paragraph'." (treesit-major-mode-setup))) +(derived-mode-add-parents 'yaml-ts-mode '(yaml-mode)) + (if (treesit-ready-p 'yaml) (add-to-list 'auto-mode-alist '("\\.ya?ml\\'" . yaml-ts-mode))) -- cgit v1.2.3 From 41de53d4a1c49ef6c6e8ac4ecb0c10cb1b6e07ce Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 8 Mar 2024 12:50:33 -0500 Subject: Simplify mode-indexed tables in packages Now that we use extra-parents to group alternative major modes, some tables can be simplified to mention only the group's leader. * lisp/align.el (align-c++-modes, align-rules-list): Don't bother listing TS alternatives. (align-perl-modes): Don't bother listing CPerl alternative. * lisp/info-look.el (perl-mode): Simplify. * lisp/cedet/semantic/symref/grep.el (semantic-symref-filepattern-alist): Don't bother listing TS alternatives. * lisp/emulation/viper.el (viper-vi-state-mode-list): Don't bother listing CPerl alternative. * lisp/progmodes/gud.el (gud-tooltip-activate-mouse-motions-if-enabled): Take into account the modes hierarchy. (gud-tooltip-modes): Don't bother listing TS alternatives. * .dir-locals.el (c-ts-mode): Simplify. --- .dir-locals.el | 4 +--- lisp/align.el | 9 ++++----- lisp/cedet/semantic/symref/grep.el | 6 ------ lisp/emulation/viper.el | 1 - lisp/htmlfontify.el | 1 + lisp/info-look.el | 5 ++--- lisp/progmodes/gud.el | 10 ++++------ lisp/progmodes/hideshow.el | 3 +++ 8 files changed, 15 insertions(+), 24 deletions(-) (limited to 'lisp') diff --git a/.dir-locals.el b/.dir-locals.el index 1a6acecc206..b34949ae961 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -32,9 +32,7 @@ (electric-quote-comment . nil) (electric-quote-string . nil) (mode . bug-reference-prog))) - (c-ts-mode . ((c-ts-mode-indent-style . gnu) - (indent-tabs-mode . t) - (mode . bug-reference-prog))) + (c-ts-mode . ((c-ts-mode-indent-style . gnu))) ;Inherits `c-mode' settings. (log-edit-mode . ((log-edit-font-lock-gnu-style . t) (log-edit-setup-add-author . t) (vc-git-log-edit-summary-target-len . 50) diff --git a/lisp/align.el b/lisp/align.el index fa95f24fa02..81ccc4b5e2d 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -181,13 +181,12 @@ If nil, then no messages will ever be printed to the minibuffer." :type '(choice (const :tag "Align a large region silently" nil) integer) :group 'align) -(defcustom align-c++-modes '( c++-mode c-mode java-mode - c-ts-mode c++-ts-mode) +(defcustom align-c++-modes '( c++-mode c-mode java-mode) "A list of modes whose syntax resembles C/C++." :type '(repeat symbol) :group 'align) -(defcustom align-perl-modes '(perl-mode cperl-mode) +(defcustom align-perl-modes '(perl-mode) "A list of modes where Perl syntax is to be seen." :type '(repeat symbol) :group 'align) @@ -576,13 +575,13 @@ The possible settings for `align-region-separate' are: "=" (group (zero-or-more (syntax whitespace))))) (group . (1 2)) - (modes . '(conf-toml-mode toml-ts-mode lua-mode lua-ts-mode))) + (modes . '(conf-toml-mode lua-mode))) (double-dash-comment (regexp . ,(rx (group (zero-or-more (syntax whitespace))) "--" (zero-or-more nonl))) - (modes . '(lua-mode lua-ts-mode)) + (modes . '(lua-mode)) (column . comment-column) (valid . ,(lambda () (save-excursion diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el index 83e3bc36073..cc4d1546c85 100644 --- a/lisp/cedet/semantic/symref/grep.el +++ b/lisp/cedet/semantic/symref/grep.el @@ -44,9 +44,7 @@ those hits returned.") (defvar semantic-symref-filepattern-alist '((c-mode "*.[ch]") - (c-ts-mode "*.[ch]") (c++-mode "*.[chCH]" "*.[ch]pp" "*.cc" "*.hh") - (c++-ts-mode "*.[chCH]" "*.[ch]pp" "*.cc" "*.hh") (html-mode "*.html" "*.shtml" "*.php") (mhtml-mode "*.html" "*.shtml" "*.php") ; FIXME: remove ; duplication of @@ -55,12 +53,8 @@ those hits returned.") ; major mode definition? (ruby-mode "*.r[bu]" "*.rake" "*.gemspec" "*.erb" "*.haml" "Rakefile" "Thorfile" "Capfile" "Guardfile" "Vagrantfile") - (ruby-ts-mode "*.r[bu]" "*.rake" "*.gemspec" "*.erb" "*.haml" - "Rakefile" "Thorfile" "Capfile" "Guardfile" "Vagrantfile") (python-mode "*.py" "*.pyi" "*.pyw") - (python-ts-mode "*.py" "*.pyi" "*.pyw") (perl-mode "*.pl" "*.PL") - (cperl-mode "*.pl" "*.PL") (lisp-interaction-mode "*.el" "*.ede" ".emacs" "_emacs") ) "List of major modes and file extension pattern. diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 83fcdf89375..287292a24dc 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -388,7 +388,6 @@ widget." idl-mode perl-mode - cperl-mode javascript-mode tcl-mode python-mode diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index 6b9c623f31f..89c2bee2204 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -586,6 +586,7 @@ If a window system is unavailable, calls `hfy-fallback-color-values'." (defvar hfy-cperl-mode-kludged-p nil) (defun hfy-kludge-cperl-mode () + ;; FIXME: Still? "CPerl mode does its damnedest not to do some of its fontification when not in a windowing system - try to trick it..." (declare (obsolete nil "28.1")) diff --git a/lisp/info-look.el b/lisp/info-look.el index da7beafe500..cd59fdf17d7 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -985,9 +985,8 @@ Return nil if there is nothing appropriate in the buffer near point." finally return "(python)Index"))))) (info-lookup-maybe-add-help - :mode 'cperl-mode - :regexp "[$@%][^a-zA-Z]\\|\\$\\^[A-Z]\\|[$@%]?[a-zA-Z][_a-zA-Z0-9]*" - :other-modes '(perl-mode)) + :mode 'perl-mode + :regexp "[$@%][^a-zA-Z]\\|\\$\\^[A-Z]\\|[$@%]?[a-zA-Z][_a-zA-Z0-9]*") (info-lookup-maybe-add-help :mode 'latex-mode diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index b7c85fe7f43..f10b047cc74 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3671,8 +3671,7 @@ Treats actions as defuns." (remove-hook 'after-save-hook #'gdb-create-define-alist t)))) (defcustom gud-tooltip-modes '( gud-mode c-mode c++-mode fortran-mode - python-mode c-ts-mode c++-ts-mode - python-ts-mode) + python-mode) "List of modes for which to enable GUD tooltips." :type '(repeat (symbol :tag "Major mode")) :group 'tooltip) @@ -3708,10 +3707,9 @@ only tooltips in the buffer containing the overlay arrow." #'gud-tooltip-activate-mouse-motions-if-enabled) (dolist (buffer (buffer-list)) (with-current-buffer buffer - (if (and gud-tooltip-mode - (memq major-mode gud-tooltip-modes)) - (gud-tooltip-activate-mouse-motions t) - (gud-tooltip-activate-mouse-motions nil))))) + (gud-tooltip-activate-mouse-motions + (and gud-tooltip-mode + (derived-mode-p gud-tooltip-modes)))))) (defvar gud-tooltip-mouse-motions-active nil "Locally t in a buffer if tooltip processing of mouse motion is enabled.") diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index b181b21118f..07616960565 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -254,6 +254,9 @@ This has effect only if `search-invisible' is set to `open'." ;;;###autoload (defvar hs-special-modes-alist + ;; FIXME: Currently the check is made via + ;; (assoc major-mode hs-special-modes-alist) so it doesn't pay attention + ;; to the mode hierarchy. (mapcar #'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c-ts-mode "{" "}" "/[*/]" nil nil) -- cgit v1.2.3 From 357eb52e094ee751b2ee2f736f7a5e8cc1cdc99c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 8 Mar 2024 12:39:59 -0500 Subject: (eglot-server-programs): Comment and whitespace only change * lisp/progmodes/eglot.el (eglot-server-programs): Add comment. Make the definition fit into 80 columns. --- lisp/progmodes/eglot.el | 187 +++++++++++++++++++++++++----------------------- 1 file changed, 99 insertions(+), 88 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index f341428cac3..afe3281361d 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -226,94 +226,105 @@ automatically)." when probe return (cons probe args) finally (funcall err))))))) -(defvar eglot-server-programs `(((rust-ts-mode rust-mode) . ("rust-analyzer")) - ((cmake-mode cmake-ts-mode) . ("cmake-language-server")) - (vimrc-mode . ("vim-language-server" "--stdio")) - ((python-mode python-ts-mode) - . ,(eglot-alternatives - '("pylsp" "pyls" ("pyright-langserver" "--stdio") "jedi-language-server" "ruff-lsp"))) - ((js-json-mode json-mode json-ts-mode) - . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") - ("vscode-json-languageserver" "--stdio") - ("json-languageserver" "--stdio")))) - (((js-mode :language-id "javascript") - (js-ts-mode :language-id "javascript") - (tsx-ts-mode :language-id "typescriptreact") - (typescript-ts-mode :language-id "typescript") - (typescript-mode :language-id "typescript")) - . ("typescript-language-server" "--stdio")) - ((bash-ts-mode sh-mode) . ("bash-language-server" "start")) - ((php-mode phps-mode php-ts-mode) - . ,(eglot-alternatives - '(("phpactor" "language-server") - ("php" "vendor/felixfbecker/language-server/bin/php-language-server.php")))) - ((c-mode c-ts-mode c++-mode c++-ts-mode objc-mode) - . ,(eglot-alternatives - '("clangd" "ccls"))) - (((caml-mode :language-id "ocaml") - (tuareg-mode :language-id "ocaml") reason-mode) - . ("ocamllsp")) - ((ruby-mode ruby-ts-mode) - . ("solargraph" "socket" "--port" :autoport)) - (haskell-mode - . ("haskell-language-server-wrapper" "--lsp")) - (elm-mode . ("elm-language-server")) - (mint-mode . ("mint" "ls")) - ((kotlin-mode kotlin-ts-mode) . ("kotlin-language-server")) - ((go-mode go-dot-mod-mode go-dot-work-mode go-ts-mode go-mod-ts-mode) - . ("gopls")) - ((R-mode ess-r-mode) . ("R" "--slave" "-e" - "languageserver::run()")) - ((java-mode java-ts-mode) . ("jdtls")) - ((dart-mode dart-ts-mode) - . ("dart" "language-server" - "--client-id" "emacs.eglot-dart")) - ((elixir-mode elixir-ts-mode heex-ts-mode) - . ,(if (and (fboundp 'w32-shell-dos-semantics) - (w32-shell-dos-semantics)) - '("language_server.bat") - (eglot-alternatives - '("language_server.sh" "start_lexical.sh")))) - (ada-mode . ("ada_language_server")) - (scala-mode . ,(eglot-alternatives - '("metals" "metals-emacs"))) - (racket-mode . ("racket" "-l" "racket-langserver")) - ((tex-mode context-mode texinfo-mode bibtex-mode) - . ,(eglot-alternatives '("digestif" "texlab"))) - (erlang-mode . ("erlang_ls" "--transport" "stdio")) - ((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio")) - (nix-mode . ,(eglot-alternatives '("nil" "rnix-lsp" "nixd"))) - (nickel-mode . ("nls")) - ((nushell-mode nushell-ts-mode) . ("nu" "--lsp")) - (gdscript-mode . ("localhost" 6008)) - ((fortran-mode f90-mode) . ("fortls")) - (futhark-mode . ("futhark" "lsp")) - ((lua-mode lua-ts-mode) . ,(eglot-alternatives - '("lua-language-server" "lua-lsp"))) - (zig-mode . ("zls")) - ((css-mode css-ts-mode) - . ,(eglot-alternatives '(("vscode-css-language-server" "--stdio") - ("css-languageserver" "--stdio")))) - (html-mode . ,(eglot-alternatives '(("vscode-html-language-server" "--stdio") ("html-languageserver" "--stdio")))) - ((dockerfile-mode dockerfile-ts-mode) . ("docker-langserver" "--stdio")) - ((clojure-mode clojurescript-mode clojurec-mode clojure-ts-mode) - . ("clojure-lsp")) - ((csharp-mode csharp-ts-mode) - . ,(eglot-alternatives - '(("omnisharp" "-lsp") - ("csharp-ls")))) - (purescript-mode . ("purescript-language-server" "--stdio")) - ((perl-mode cperl-mode) . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run")) - (markdown-mode - . ,(eglot-alternatives - '(("marksman" "server") - ("vscode-markdown-language-server" "--stdio")))) - (graphviz-dot-mode . ("dot-language-server" "--stdio")) - (terraform-mode . ("terraform-ls" "serve")) - ((uiua-ts-mode uiua-mode) . ("uiua" "lsp")) - (sml-mode - . ,(lambda (_interactive project) - (list "millet-ls" (project-root project))))) +(defvar eglot-server-programs + ;; FIXME: Maybe this info should be distributed into the major modes + ;; themselves where they could set a buffer-local `eglot-server-program' + ;; instead of keeping this database centralized. + ;; FIXME: With `derived-mode-add-parents' in Emacs≥30, some of + ;; those entries can be simplified, but we keep them for when + ;; `eglot.el' is installed via GNU ELPA in an older Emacs. + `(((rust-ts-mode rust-mode) . ("rust-analyzer")) + ((cmake-mode cmake-ts-mode) . ("cmake-language-server")) + (vimrc-mode . ("vim-language-server" "--stdio")) + ((python-mode python-ts-mode) + . ,(eglot-alternatives + '("pylsp" "pyls" ("pyright-langserver" "--stdio") + "jedi-language-server" "ruff-lsp"))) + ((js-json-mode json-mode json-ts-mode) + . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") + ("vscode-json-languageserver" "--stdio") + ("json-languageserver" "--stdio")))) + (((js-mode :language-id "javascript") + (js-ts-mode :language-id "javascript") + (tsx-ts-mode :language-id "typescriptreact") + (typescript-ts-mode :language-id "typescript") + (typescript-mode :language-id "typescript")) + . ("typescript-language-server" "--stdio")) + ((bash-ts-mode sh-mode) . ("bash-language-server" "start")) + ((php-mode phps-mode php-ts-mode) + . ,(eglot-alternatives + '(("phpactor" "language-server") + ("php" "vendor/felixfbecker/language-server/bin/php-language-server.php")))) + ((c-mode c-ts-mode c++-mode c++-ts-mode objc-mode) + . ,(eglot-alternatives + '("clangd" "ccls"))) + (((caml-mode :language-id "ocaml") + (tuareg-mode :language-id "ocaml") reason-mode) + . ("ocamllsp")) + ((ruby-mode ruby-ts-mode) + . ("solargraph" "socket" "--port" :autoport)) + (haskell-mode + . ("haskell-language-server-wrapper" "--lsp")) + (elm-mode . ("elm-language-server")) + (mint-mode . ("mint" "ls")) + ((kotlin-mode kotlin-ts-mode) . ("kotlin-language-server")) + ((go-mode go-dot-mod-mode go-dot-work-mode go-ts-mode go-mod-ts-mode) + . ("gopls")) + ((R-mode ess-r-mode) . ("R" "--slave" "-e" + "languageserver::run()")) + ((java-mode java-ts-mode) . ("jdtls")) + ((dart-mode dart-ts-mode) + . ("dart" "language-server" + "--client-id" "emacs.eglot-dart")) + ((elixir-mode elixir-ts-mode heex-ts-mode) + . ,(if (and (fboundp 'w32-shell-dos-semantics) + (w32-shell-dos-semantics)) + '("language_server.bat") + (eglot-alternatives + '("language_server.sh" "start_lexical.sh")))) + (ada-mode . ("ada_language_server")) + (scala-mode . ,(eglot-alternatives + '("metals" "metals-emacs"))) + (racket-mode . ("racket" "-l" "racket-langserver")) + ((tex-mode context-mode texinfo-mode bibtex-mode) + . ,(eglot-alternatives '("digestif" "texlab"))) + (erlang-mode . ("erlang_ls" "--transport" "stdio")) + ((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio")) + (nix-mode . ,(eglot-alternatives '("nil" "rnix-lsp" "nixd"))) + (nickel-mode . ("nls")) + ((nushell-mode nushell-ts-mode) . ("nu" "--lsp")) + (gdscript-mode . ("localhost" 6008)) + ((fortran-mode f90-mode) . ("fortls")) + (futhark-mode . ("futhark" "lsp")) + ((lua-mode lua-ts-mode) . ,(eglot-alternatives + '("lua-language-server" "lua-lsp"))) + (zig-mode . ("zls")) + ((css-mode css-ts-mode) + . ,(eglot-alternatives '(("vscode-css-language-server" "--stdio") + ("css-languageserver" "--stdio")))) + (html-mode . ,(eglot-alternatives + '(("vscode-html-language-server" "--stdio") + ("html-languageserver" "--stdio")))) + ((dockerfile-mode dockerfile-ts-mode) . ("docker-langserver" "--stdio")) + ((clojure-mode clojurescript-mode clojurec-mode clojure-ts-mode) + . ("clojure-lsp")) + ((csharp-mode csharp-ts-mode) + . ,(eglot-alternatives + '(("omnisharp" "-lsp") + ("csharp-ls")))) + (purescript-mode . ("purescript-language-server" "--stdio")) + ((perl-mode cperl-mode) + . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run")) + (markdown-mode + . ,(eglot-alternatives + '(("marksman" "server") + ("vscode-markdown-language-server" "--stdio")))) + (graphviz-dot-mode . ("dot-language-server" "--stdio")) + (terraform-mode . ("terraform-ls" "serve")) + ((uiua-ts-mode uiua-mode) . ("uiua" "lsp")) + (sml-mode + . ,(lambda (_interactive project) + (list "millet-ls" (project-root project))))) "How the command `eglot' guesses the server to start. An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE identifies the buffers that are to be managed by a specific -- cgit v1.2.3 From 7b4ca9e609e2eadc824313053e70d7272d360b9d Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 7 Mar 2024 21:53:11 -0800 Subject: Leverage inverse-video for erc-inverse-face MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/erc/erc-goodies.el (erc-inverse-face): Specify face attribute `:inverse-video' (née :reverse-video) to swap foreground and background colors over affected intervals, as per https://modern.ircdocs.horse/formatting#reverse-color. (erc-control-default-fg erc-control-default-bg): New faces for IRC color-code number 99. Ignore the ERC convention of prefixing control-code-derived faces with "fg:" and "bg:" because it doesn't comport with modern sensibilities, which demand identifiers normally be namespaced. (erc-get-bg-color-face, erc-get-fg-color-face): Return new, dedicated faces instead of `default', and don't nest them in a list. * test/lisp/erc/erc-goodies-tests.el (erc-controls-highlight--inverse): Redo completely, asserting behavior described in the spec linked to above. (erc-controls-highlight--spoilers): New test based on the body of the old `erc-controls-highlight--inverse', except without shadowing `erc-insert-modify-hook' with an unrealistic, idealized value. Adjust expected buffer state to reflect the new role of `erc-spoiler-face'. (Bug#69597) --- lisp/erc/erc-goodies.el | 16 +++- test/lisp/erc/erc-goodies-tests.el | 153 ++++++++++++++++++++++++++----------- 2 files changed, 122 insertions(+), 47 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 7e30b1060fd..f19fb5ed727 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -661,7 +661,7 @@ The value `erc-interpret-controls-p' must also be t for this to work." :group 'erc-faces) (defface erc-inverse-face - '((t :foreground "White" :background "Black")) + '((t :inverse-video t)) "ERC inverse face." :group 'erc-faces) @@ -675,6 +675,16 @@ The value `erc-interpret-controls-p' must also be t for this to work." "ERC underline face." :group 'erc-faces) +(defface erc-control-default-fg '((t :inherit default)) + "ERC foreground face for the \"default\" color code." + :group 'erc-faces) + +(defface erc-control-default-bg '((t :inherit default)) + "ERC background face for the \"default\" color code." + :group 'erc-faces) + +;; FIXME rename these to something like `erc-control-color-N-fg', +;; and deprecate the old names via `define-obsolete-face-alias'. (defface fg:erc-color-face0 '((t :foreground "White")) "ERC face." :group 'erc-faces) @@ -804,7 +814,7 @@ The value `erc-interpret-controls-p' must also be t for this to work." (intern (concat "bg:erc-color-face" (number-to-string n)))) ((< 15 n 99) (list :background (aref erc--controls-additional-colors (- n 16)))) - (t (erc-log (format " Wrong color: %s" n)) '(default))))) + (t (erc-log (format " Wrong color: %s" n)) 'erc-control-default-fg)))) (defun erc-get-fg-color-face (n) "Fetches the right face for foreground color N (0-15)." @@ -820,7 +830,7 @@ The value `erc-interpret-controls-p' must also be t for this to work." (intern (concat "fg:erc-color-face" (number-to-string n)))) ((< 15 n 99) (list :foreground (aref erc--controls-additional-colors (- n 16)))) - (t (erc-log (format " Wrong color: %s" n)) '(default))))) + (t (erc-log (format " Wrong color: %s" n)) 'erc-control-default-bg)))) ;;;###autoload(autoload 'erc-irccontrols-mode "erc-goodies" nil t) (define-erc-module irccontrols nil diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index 7013ce0c8fc..c8fb0544a72 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -29,19 +29,23 @@ (defun erc-goodies-tests--assert-face (beg end-str present &optional absent) (setq beg (+ beg (point-min))) (let ((end (+ beg (1- (length end-str))))) - (while (and beg (< beg end)) - (let* ((val (get-text-property beg 'font-lock-face)) - (ft (flatten-tree (ensure-list val)))) - (dolist (p (ensure-list present)) - (if (consp p) - (should (member p val)) - (should (memq p ft)))) - (dolist (a (ensure-list absent)) - (if (consp a) - (should-not (member a val)) - (should-not (memq a ft)))) - (setq beg (text-property-not-all beg (point-max) - 'font-lock-face val)))))) + (ert-info ((format "beg: %S, end-str: %S" beg end-str)) + (while (and beg (< beg end)) + (let* ((val (get-text-property beg 'font-lock-face)) + (ft (flatten-tree (ensure-list val)))) + (ert-info ((format "looking-at: %S, val: %S" + (buffer-substring-no-properties beg end) + val)) + (dolist (p (ensure-list present)) + (if (consp p) + (should (member p val)) + (should (memq p ft)))) + (dolist (a (ensure-list absent)) + (if (consp a) + (should-not (member a val)) + (should-not (memq a ft))))) + (setq beg (text-property-not-all beg (point-max) + 'font-lock-face val))))))) ;; These are from the "Examples" section of ;; https://modern.ircdocs.horse/formatting.html @@ -129,39 +133,100 @@ ;; Hovering over the redacted area should reveal its underlying text ;; in a high-contrast face. -(ert-deftest erc-controls-highlight--inverse () +(ert-deftest erc-controls-highlight--spoilers () (should (eq t erc-interpret-controls-p)) - (let ((erc-insert-modify-hook '(erc-controls-highlight)) - erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) - (with-current-buffer (get-buffer-create "#chan") - (erc-mode) - (setq-local erc-interpret-mirc-color t) - (erc--initialize-markers (point) nil) + (erc-tests-common-make-server-buf) + (with-current-buffer (erc--open-target "#chan") + (setq-local erc-interpret-mirc-color t) + (let* ((raw (concat "BEGIN " + "\C-c0,0 WhiteOnWhite " + "\C-c1,1 BlackOnBlack " + "\C-c99,99 Default " + "\C-o END")) + (msg (erc-format-privmessage "bob" raw nil t))) + (erc-display-message nil nil (current-buffer) msg)) + (forward-line -1) + (should (search-forward " " nil t)) + (save-restriction + ;; Narrow to EOL or start of right-side stamp. + (narrow-to-region (point) (line-end-position)) + (save-excursion + (search-forward "WhiteOn") + (should (eq (get-text-property (point) 'mouse-face) + 'erc-spoiler-face)) + (search-forward "BlackOn") + (should (eq (get-text-property (point) 'mouse-face) + 'erc-spoiler-face))) + ;; Start wtih ERC default face. + (erc-goodies-tests--assert-face + 0 "BEGIN " 'erc-default-face + '(fg:erc-color-face0 bg:erc-color-face0)) + ;; Masked in all white. + (erc-goodies-tests--assert-face + 6 "WhiteOnWhite" '(fg:erc-color-face0 bg:erc-color-face0) + '(fg:erc-color-face1 bg:erc-color-face1)) + ;; Masked in all black. + (erc-goodies-tests--assert-face + 20 "BlackOnBlack" '(fg:erc-color-face1 bg:erc-color-face1) + '(erc-control-default-fg erc-control-default-bg)) + ;; Explicit "default" code ignoerd. + (erc-goodies-tests--assert-face + 34 "Default" '(erc-control-default-fg erc-control-default-bg) + '(fg:erc-color-face1 bg:erc-color-face1)) + (erc-goodies-tests--assert-face + 43 "END" 'erc-default-face + '(erc-control-default-bg erc-control-default-fg)))) + (when noninteractive + (erc-tests-common-kill-buffers))) - (let* ((m "Spoiler: \C-c0,0Hello\C-c1,1World!") - (msg (erc-format-privmessage "bob" m nil t))) - (erc-display-message nil nil (current-buffer) msg)) - (forward-line -1) - (should (search-forward " " nil t)) - (save-restriction - (narrow-to-region (point) (pos-eol)) - (should (eq (get-text-property (+ 9 (point)) 'mouse-face) - 'erc-inverse-face)) - (should (eq (get-text-property (1- (pos-eol)) 'mouse-face) - 'erc-inverse-face)) - (erc-goodies-tests--assert-face - 0 "Spoiler: " 'erc-default-face - '(fg:erc-color-face0 bg:erc-color-face0)) - (erc-goodies-tests--assert-face - 9 "Hello" '(erc-spoiler-face) - '( fg:erc-color-face0 bg:erc-color-face0 - fg:erc-color-face1 bg:erc-color-face1)) - (erc-goodies-tests--assert-face - 18 " World" '(erc-spoiler-face) - '( fg:erc-color-face0 bg:erc-color-face0 - fg:erc-color-face1 bg:erc-color-face1 ))) - (when noninteractive - (kill-buffer))))) +(ert-deftest erc-controls-highlight--inverse () + (should (eq t erc-interpret-controls-p)) + (erc-tests-common-make-server-buf) + (with-current-buffer (erc--open-target "#chan") + (setq-local erc-interpret-mirc-color t) + (defvar erc-fill-column) + (let* ((erc-fill-column 90) + (raw (concat "BEGIN " + "\C-c3,13 GreenOnPink " + "\C-v PinkOnGreen " + "\C-c99,99 ReversedDefault " + "\C-v NormalDefault " + "\C-o END")) + (msg (erc-format-privmessage "bob" raw nil t))) + (erc-display-message nil nil (current-buffer) msg)) + (forward-line -1) + (should (search-forward " " nil t)) + (save-restriction + ;; Narrow to EOL or start of right-side stamp. + (narrow-to-region (point) (line-end-position)) + ;; Baseline. + (erc-goodies-tests--assert-face + 0 "BEGIN " 'erc-default-face + '(fg:erc-color-face0 bg:erc-color-face0)) + ;; Normal fg/bg combo. + (erc-goodies-tests--assert-face + 6 "GreenOnPink" '(fg:erc-color-face3 bg:erc-color-face13) + '(erc-inverse-face)) + ;; Reverse of previous, so former-bg on former-fg. + (erc-goodies-tests--assert-face + 19 "PinkOnGreen" + '(erc-inverse-face fg:erc-color-face3 bg:erc-color-face13) + nil) + ;; The inverse of `default' because reverse still in effect. + (erc-goodies-tests--assert-face + 32 "ReversedDefault" '(erc-inverse-face erc-control-default-fg + erc-control-default-bg) + '(fg:erc-color-face3 bg:erc-color-face13)) + (erc-goodies-tests--assert-face + 49 "NormalDefault" '(erc-control-default-fg + erc-control-default-bg) + '(erc-inverse-face fg:erc-color-face1 bg:erc-color-face1)) + (erc-goodies-tests--assert-face + 64 "END" 'erc-default-face + '( erc-control-default-fg erc-control-default-bg + fg:erc-color-face0 bg:erc-color-face0)))) + (when noninteractive + (erc-tests-common-kill-buffers))) (defvar erc-goodies-tests--motd ;; This is from ergo's MOTD -- cgit v1.2.3 From e2620fd73441af19d478f7a9262de8c08a47ee2f Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 7 Mar 2024 21:53:23 -0800 Subject: Make important text props more resilient in ERC * lisp/erc/erc-button.el (erc-button-remove-old-buttons): Restore original `mouse-face' values in areas marked as important after clobbering. * lisp/erc/erc.el (erc--reserve-important-text-props): New function. (erc--restore-important-text-props): New function. * test/lisp/erc/erc-tests.el (erc--restore-important-text-props): New test. (Bug#69597) --- lisp/erc/erc-button.el | 3 ++- lisp/erc/erc.el | 34 ++++++++++++++++++++++++++++++ test/lisp/erc/erc-tests.el | 52 ++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 88 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 6b78e451b54..4b4930e5bff 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -528,7 +528,8 @@ that `erc-button-add-button' adds, except for the face." '(erc-callback nil erc-data nil mouse-face nil - keymap nil))) + keymap nil)) + (erc--restore-important-text-props '(mouse-face))) (defun erc-button-add-button (from to fun nick-p &optional data regexp) "Create a button between FROM and TO with callback FUN and data DATA. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index cce3b2508fb..3cc9bd54228 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3532,6 +3532,40 @@ repeatedly with VAL set to each of VAL's members." old (get-text-property pos prop object) end (next-single-property-change pos prop object to))))) +(defun erc--reserve-important-text-props (beg end plist &optional object) + "Record text-property pairs in PLIST as important between BEG and END. +Also mark the message being inserted as containing these important props +so modules performing destructive modifications can later restore them. +Expect to run in a narrowed buffer at message-insertion time." + (when erc--msg-props + (let ((existing (erc--check-msg-prop 'erc--important-prop-names))) + (puthash 'erc--important-prop-names (cl-union existing (map-keys plist)) + erc--msg-props))) + (erc--merge-prop beg end 'erc--important-props plist object)) + +(defun erc--restore-important-text-props (props &optional beg end) + "Restore PROPS where recorded in the accessible portion of the buffer. +Expect to run in a narrowed buffer at message-insertion time. Limit the +effect to the region between buffer positions BEG and END, when non-nil. + +Callers should be aware that this function fails if the property +`erc--important-props' has an empty value almost anywhere along the +affected region. Use the function `erc--remove-from-prop-value-list' to +ensure that props with empty values are excised completely." + (when-let ((registered (erc--check-msg-prop 'erc--important-prop-names)) + (present (seq-intersection props registered)) + (b (or beg (point-min))) + (e (or end (point-max)))) + (while-let + (((setq b (text-property-not-all b e 'erc--important-props nil))) + (val (get-text-property b 'erc--important-props)) + (q (next-single-property-change b 'erc--important-props nil e))) + (while-let ((k (pop val)) + (v (pop val))) + (when (memq k present) + (put-text-property b q k v))) + (setq b q)))) + (defvar erc-legacy-invisible-bounds-p nil "Whether to hide trailing rather than preceding newlines. Beginning in ERC 5.6, invisibility extends from a message's diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 085b063bdb2..6809d9db41d 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -2232,6 +2232,58 @@ (when noninteractive (kill-buffer)))) +(ert-deftest erc--restore-important-text-props () + (erc-mode) + (let ((erc--msg-props (map-into '((erc--important-prop-names a)) + 'hash-table))) + (insert (propertize "foo" 'a 'A 'b 'B 'erc--important-props '(a A)) + " " + (propertize "bar" 'c 'C 'a 'A 'b 'B + 'erc--important-props '(a A c C))) + + ;; Attempt to restore a and c when only a is registered. + (remove-list-of-text-properties (point-min) (point-max) '(a c)) + (erc--restore-important-text-props '(a c)) + (should (erc-tests-common-equal-with-props + (buffer-string) + #("foo bar" + 0 3 (a A b B erc--important-props (a A)) + 4 7 (a A b B erc--important-props (a A c C))))) + + ;; Add d between 3 and 6. + (erc--reserve-important-text-props 3 6 '(d D)) + (put-text-property 3 6 'd 'D) + (should (erc-tests-common-equal-with-props + (buffer-string) + #("foo bar" ; #1 + 0 2 (a A b B erc--important-props (a A)) + 2 3 (d D a A b B erc--important-props (d D a A)) + 3 4 (d D erc--important-props (d D)) + 4 5 (d D a A b B erc--important-props (d D a A c C)) + 5 7 (a A b B erc--important-props (a A c C))))) + ;; Remove a and d, and attempt to restore d. + (remove-list-of-text-properties (point-min) (point-max) '(a d)) + (erc--restore-important-text-props '(d)) + (should (erc-tests-common-equal-with-props + (buffer-string) + #("foo bar" + 0 2 (b B erc--important-props (a A)) + 2 3 (d D b B erc--important-props (d D a A)) + 3 4 (d D erc--important-props (d D)) + 4 5 (d D b B erc--important-props (d D a A c C)) + 5 7 (b B erc--important-props (a A c C))))) + + ;; Restore a only. + (erc--restore-important-text-props '(a)) + (should (erc-tests-common-equal-with-props + (buffer-string) + #("foo bar" ; same as #1 above + 0 2 (a A b B erc--important-props (a A)) + 2 3 (d D a A b B erc--important-props (d D a A)) + 3 4 (d D erc--important-props (d D)) + 4 5 (d D a A b B erc--important-props (d D a A c C)) + 5 7 (a A b B erc--important-props (a A c C))))))) + (ert-deftest erc--split-string-shell-cmd () ;; Leading and trailing space -- cgit v1.2.3 From 166c8a989491c21ea3baf96e4730a4ad9b78308f Mon Sep 17 00:00:00 2001 From: "F. Moukayed" Date: Fri, 8 Mar 2024 08:39:03 +0000 Subject: Redefine erc-spoiler-face to indicate revealed text * lisp/erc/erc-goodies.el (erc-spoiler-face): Redefine role and redo definition to inherit from `erc-control-default-face'. (erc-controls-propertize): Include `cursor-face' in the applied hover properties for spoiler text, and ensure they aren't clobbered by other built-in modules, like `button'. (Bug#69597) Copyright-paperwork-exempt: yes --- lisp/erc/erc-goodies.el | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index f19fb5ed727..da14f5bd728 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -665,9 +665,7 @@ The value `erc-interpret-controls-p' must also be t for this to work." "ERC inverse face." :group 'erc-faces) -(defface erc-spoiler-face - '((((background light)) :foreground "DimGray" :background "DimGray") - (((background dark)) :foreground "LightGray" :background "LightGray")) +(defface erc-spoiler-face '((t :inherit default)) "ERC spoiler face." :group 'erc-faces) @@ -978,13 +976,16 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'." "Prepend properties from IRC control characters between FROM and TO. If optional argument STR is provided, apply to STR, otherwise prepend properties to a region in the current buffer." - (if (and fg bg (equal fg bg)) - (progn - (setq fg 'erc-spoiler-face - bg nil) - (put-text-property from to 'mouse-face 'erc-inverse-face str)) - (when fg (setq fg (erc-get-fg-color-face fg))) - (when bg (setq bg (erc-get-bg-color-face bg)))) + (when (and fg bg (equal fg bg) (not (equal fg "99"))) + (add-text-properties from to '( mouse-face erc-spoiler-face + cursor-face erc-spoiler-face) + str) + (erc--reserve-important-text-props from to + '( mouse-face erc-spoiler-face + cursor-face erc-spoiler-face) + str)) + (when fg (setq fg (erc-get-fg-color-face fg))) + (when bg (setq bg (erc-get-bg-color-face bg))) (font-lock-prepend-text-property from to -- cgit v1.2.3 From f3da3d1c68bef60ef28d67c6d8fa5d0cba8c9f08 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 10 Mar 2024 06:08:30 -0700 Subject: Fix faulty decoded-time adjustment in erc-stamp * lisp/erc/erc-stamp.el (erc-stamp--lr-date-on-pre-modify): Remove disruptive assertion for now. (erc-stamp--time-as-day): Attempt to fix date being rewound by a whole day when daylight saving time is in effect. Do this by forcing the `dst' slot of the `decoded-time' object to -1 and the `zone' to nil. --- lisp/erc/erc-stamp.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index a8190a2c94a..44f92c5a7e2 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -723,9 +723,6 @@ inserted is a date stamp." 'hash-table)) (erc-timestamp-last-inserted-left rendered) erc-timestamp-format erc-away-timestamp-format) - ;; FIXME delete once convinced adjustment correct. - (cl-assert (string= rendered - (erc-stamp--format-date-stamp aligned))) (erc-add-timestamp)) (setq erc-timestamp-last-inserted-left rendered))))) @@ -833,7 +830,11 @@ left-sided stamps and date stamps inserted by this function." (decoded (decode-time current-time erc-stamp--tz))) (setf (decoded-time-second decoded) 0 (decoded-time-minute decoded) 0 - (decoded-time-hour decoded) 0) + (decoded-time-hour decoded) 0 + (decoded-time-dst decoded) -1 + (decoded-time-weekday decoded) nil + (decoded-time-zone decoded) + (and erc-stamp--tz (car (current-time-zone nil erc-stamp--tz)))) (encode-time decoded))) ; may return an integer (defun erc-format-timestamp (time format) -- cgit v1.2.3 From d444390ec569afee35628e112a8d96d11f40175c Mon Sep 17 00:00:00 2001 From: Tim Ruffing Date: Wed, 27 Dec 2023 14:32:09 +0100 Subject: Remove workarounds for solved 'read-event' bug * lisp/subr.el (read-char-choice-with-read-key): * lisp/net/dbus.el (dbus-call-method): Remove workarounds for the bug fixed in the previous commit ac82baea1c41ec974ad49f2861ae6c06bda2b4ed, where 'read-event', 'read-char' and 'read-char-exclusively' could return wrongly -1. In the case of lisp/dbus.el, this reverts commit 7177393826c73c87ffe9b428f0e5edae244d7a98. --- lisp/net/dbus.el | 6 +----- lisp/subr.el | 5 ----- 2 files changed, 1 insertion(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 77b334e704e..46f85daba24 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -371,11 +371,7 @@ object is returned instead of a list containing this single Lisp object. (apply #'dbus-message-internal dbus-message-type-method-call bus service path interface method #'dbus-call-method-handler args)) - (result (unless executing-kbd-macro (cons :pending nil)))) - - ;; While executing a keyboard macro, we run into an infinite loop, - ;; receiving the event -1. So we don't try to get the result. - ;; (Bug#62018) + (result (cons :pending nil))) ;; Wait until `dbus-call-method-handler' has put the result into ;; `dbus-return-values-table'. If no timeout is given, use the diff --git a/lisp/subr.el b/lisp/subr.el index d58f8ba3b27..ce933e3bfdc 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3554,11 +3554,6 @@ causes it to evaluate `help-form' and display the result." (help-form-show))) ((memq char chars) (setq done t)) - ((and executing-kbd-macro (= char -1)) - ;; read-event returns -1 if we are in a kbd macro and - ;; there are no more events in the macro. Attempt to - ;; get an event interactively. - (setq executing-kbd-macro nil)) ((not inhibit-keyboard-quit) (cond ((and (null esc-flag) (eq char ?\e)) -- cgit v1.2.3 From df3e0bcbdbcfe907d7572b5561dd2bf9c3715a4a Mon Sep 17 00:00:00 2001 From: Tim Ruffing Date: Sat, 9 Mar 2024 12:29:39 +0100 Subject: * lisp/calc/calc-prog.el: Switch to new method of detecting end of kbd macro 'read-char' will no longer return -1 as of ac82baea1c41ec974ad49f2861ae6c06bda2b4ed. This switches to a cleaner method of detecting whether the end of a keyboard macro has been reached. * lisp/calc/calc-prog.el (calc--at-end-of-kmacro-p): New function. (calc-kbd-skip-to-else-if): Use the function. Co-authored-by: Stefan Monnier --- lisp/calc/calc-prog.el | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index 03210995eb3..8dff7f1f264 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -1225,13 +1225,17 @@ Redefine the corresponding command." (interactive) (calc-kbd-if)) +(defun calc--at-end-of-kmacro-p () + (and (arrayp executing-kbd-macro) + (>= executing-kbd-macro-index (length executing-kbd-macro)))) + (defun calc-kbd-skip-to-else-if (else-okay) (let ((count 0) ch) (while (>= count 0) - (setq ch (read-char)) - (if (= ch -1) + (if (calc--at-end-of-kmacro-p) (error "Unterminated Z[ in keyboard macro")) + (setq ch (read-char)) (if (= ch ?Z) (progn (setq ch (read-char)) @@ -1299,9 +1303,9 @@ Redefine the corresponding command." (or executing-kbd-macro (message "Reading loop body...")) (while (>= count 0) - (setq ch (read-event)) - (if (eq ch -1) + (if (calc--at-end-of-kmacro-p) (error "Unterminated Z%c in keyboard macro" open)) + (setq ch (read-event)) (if (eq ch ?Z) (progn (setq ch (read-event) @@ -1427,9 +1431,9 @@ Redefine the corresponding command." (if defining-kbd-macro (message "Reading body...")) (while (>= count 0) - (setq ch (read-char)) - (if (= ch -1) + (if (calc--at-end-of-kmacro-p) (error "Unterminated Z` in keyboard macro")) + (setq ch (read-char)) (if (= ch ?Z) (progn (setq ch (read-char) -- cgit v1.2.3 From 46afc91c9f7e6ee6a7917537c83052e0877fa4f2 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Thu, 7 Mar 2024 21:55:45 -0800 Subject: Let 'browse-url-interactive-arg' return more values for NEW-WINDOW-FLAG Previously it always returned t or nil for NEW-WINDOW-FLAG, but now it can return the actual prefix arg when appropriate. This lets functions for 'browse-url-browser-function' consult it and do more things than just open a new window or not (for example, you could use "C--" as the prefix arg to do something special in a custom function). * lisp/net/browse-url.el (browse-url-interactive-arg): Use 'xor' to adjust the value of 'current-prefix-arg'. (browse-url): Update docstring. --- lisp/net/browse-url.el | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index ddc57724343..f22aa19f5e3 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -704,8 +704,10 @@ it defaults to the current region, else to the URL at or before point. If invoked with a mouse button, it moves point to the position clicked before acting. -This function returns a list (URL NEW-WINDOW-FLAG) -for use in `interactive'." +This function returns a list (URL NEW-WINDOW-FLAG) for use in +`interactive'. NEW-WINDOW-FLAG is the prefix arg; if +`browse-url-new-window-flag' is non-nil, invert the prefix arg +instead." (let ((event (elt (this-command-keys) 0))) (mouse-set-point event)) (list (read-string prompt (or (and transient-mark-mode mark-active @@ -715,8 +717,7 @@ for use in `interactive'." (buffer-substring-no-properties (region-beginning) (region-end)))) (browse-url-url-at-point))) - (not (eq (null browse-url-new-window-flag) - (null current-prefix-arg))))) + (xor browse-url-new-window-flag current-prefix-arg))) ;; called-interactive-p needs to be called at a function's top-level, hence ;; this macro. We use that rather than interactive-p because @@ -879,8 +880,8 @@ The variables `browse-url-browser-function', `browse-url-handlers', and `browse-url-default-handlers' determine which browser function to use. -This command prompts for a URL, defaulting to the URL at or -before point. +Interactively, this command prompts for a URL, defaulting to the +URL at or before point. The additional ARGS are passed to the browser function. See the doc strings of the actual functions, starting with @@ -888,7 +889,9 @@ doc strings of the actual functions, starting with significance of ARGS (most of the functions ignore it). If ARGS are omitted, the default is to pass -`browse-url-new-window-flag' as ARGS." +`browse-url-new-window-flag' as ARGS. Interactively, pass the +prefix arg as ARGS; if `browse-url-new-window-flag' is non-nil, +invert the prefix arg instead." (interactive (browse-url-interactive-arg "URL: ")) (unless (called-interactively-p 'interactive) (setq args (or args (list browse-url-new-window-flag)))) -- cgit v1.2.3 From ed43ad5b5652aed075348357121d9193256721c0 Mon Sep 17 00:00:00 2001 From: Petteri Hintsanen Date: Sun, 10 Mar 2024 23:30:11 -0400 Subject: (bindat--unpack-item): Sanitize vector length Copyright-paperwork-exempt: yes * lisp/emacs-lisp/bindat.el (bindat--unpack-item): Sanitize vector length --- lisp/emacs-lisp/bindat.el | 3 +++ 1 file changed, 3 insertions(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index 73745e8c7ac..a2161022a89 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -204,6 +204,9 @@ ('str (bindat--unpack-str len)) ('strz (bindat--unpack-strz len)) ('vec + (when (> len (length bindat-raw)) + (error "Vector length %d is greater than raw data length %d." + len (length bindat-raw))) (let ((v (make-vector len 0)) (vlen 1)) (if (consp vectype) (setq vlen (nth 1 vectype) -- cgit v1.2.3 From 9a2ce74c3783c4be8ba70642da374d8e77c6f9ac Mon Sep 17 00:00:00 2001 From: Michael Heerdegen Date: Sun, 18 Feb 2024 02:48:15 +0100 Subject: Fix pp-emacs-lisp-code printing of symbols * lisp/emacs-lisp/pp.el (pp--insert-lisp): Print symbols readably (bug#69168). --- lisp/emacs-lisp/pp.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 1d722051406..944dd750839 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -458,6 +458,8 @@ the bounds of a region containing Lisp code to pretty-print." (string (let ((print-escape-newlines t)) (prin1 sexp (current-buffer)))) + (symbol + (prin1 sexp (current-buffer))) (otherwise (princ sexp (current-buffer))))) (defun pp--format-vector (sexp) -- cgit v1.2.3 From bbc53e0bcf3fe18e7c1cd51fb8719cf62b9f6c71 Mon Sep 17 00:00:00 2001 From: Michael Heerdegen Date: Sun, 18 Feb 2024 01:55:54 +0100 Subject: Improve pp-emacs-lisp-code backquote form printing * lisp/emacs-lisp/pp.el (pp--quoted-or-unquoted-form-p): New helper function. (pp--insert-lisp): Take care of quoted, backquoted and unquoted expressions; print using an recursive call. (pp--format-list): Exclude more cases from printing as a function call by default. Print lists whose second-last element is an (un)quoting symbol using dotted list syntax; e.g. (a b . ,c) instead of (a b \, c). --- lisp/emacs-lisp/pp.el | 56 ++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 40 insertions(+), 16 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 944dd750839..569f70ca604 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -430,23 +430,33 @@ the bounds of a region containing Lisp code to pretty-print." (replace-match "")) (insert-into-buffer obuf))))) +(defvar pp--quoting-syntaxes + `((quote . "'") + (function . "#'") + (,backquote-backquote-symbol . "`") + (,backquote-unquote-symbol . ",") + (,backquote-splice-symbol . ",@"))) + +(defun pp--quoted-or-unquoted-form-p (cons) + ;; Return non-nil when CONS has one of the forms 'X, `X, ,X or ,@X + (let ((head (car cons))) + (and (symbolp head) + (assq head pp--quoting-syntaxes) + (let ((rest (cdr cons))) + (and (consp rest) (null (cdr rest))))))) + (defun pp--insert-lisp (sexp) (cl-case (type-of sexp) (vector (pp--format-vector sexp)) (cons (cond ((consp (cdr sexp)) - (if (and (length= sexp 2) - (memq (car sexp) '(quote function))) - (cond - ((symbolp (cadr sexp)) - (let ((print-quoted t)) - (prin1 sexp (current-buffer)))) - ((consp (cadr sexp)) - (insert (if (eq (car sexp) 'quote) - "'" "#'")) - (pp--format-list (cadr sexp) - (set-marker (make-marker) (1- (point)))))) - (pp--format-list sexp))) + (let ((head (car sexp))) + (if-let (((null (cddr sexp))) + (syntax-entry (assq head pp--quoting-syntaxes))) + (progn + (insert (cdr syntax-entry)) + (pp--insert-lisp (cadr sexp))) + (pp--format-list sexp)))) (t (prin1 sexp (current-buffer))))) ;; Print some of the smaller integers as characters, perhaps? @@ -470,15 +480,29 @@ the bounds of a region containing Lisp code to pretty-print." (insert "]")) (defun pp--format-list (sexp &optional start) - (if (and (symbolp (car sexp)) - (not pp--inhibit-function-formatting) - (not (keywordp (car sexp)))) + (if (not (let ((head (car sexp))) + (or pp--inhibit-function-formatting + (not (symbolp head)) + (keywordp head) + (let ((l sexp)) + (catch 'not-funcall + (while l + (when (or + (atom l) ; SEXP is a dotted list + ;; Does SEXP have a form like (ELT... . ,X) ? + (pp--quoted-or-unquoted-form-p l)) + (throw 'not-funcall t)) + (setq l (cdr l))) + nil))))) (pp--format-function sexp) (insert "(") (pp--insert start (pop sexp)) (while sexp (if (consp sexp) - (pp--insert " " (pop sexp)) + (if (not (pp--quoted-or-unquoted-form-p sexp)) + (pp--insert " " (pop sexp)) + (pp--insert " . " sexp) + (setq sexp nil)) (pp--insert " . " sexp) (setq sexp nil))) (insert ")"))) -- cgit v1.2.3 From 75cfc6c73faa1561018b1212156964a7919c69fe Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Mon, 11 Mar 2024 11:16:20 +0100 Subject: ; Fix error message in last change to bindat.el Remove trailing period as per "(elisp) Error Symbols". Relates to the following discussion: https://lists.gnu.org/r/emacs-devel/2023-10/msg00473.html https://lists.gnu.org/r/emacs-devel/2024-03/msg00340.html --- lisp/emacs-lisp/bindat.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index a2161022a89..ef0ec688dbd 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -205,7 +205,7 @@ ('strz (bindat--unpack-strz len)) ('vec (when (> len (length bindat-raw)) - (error "Vector length %d is greater than raw data length %d." + (error "Vector length %d is greater than raw data length %d" len (length bindat-raw))) (let ((v (make-vector len 0)) (vlen 1)) (if (consp vectype) -- cgit v1.2.3 From db5915f30ba063b72b007d243fbd832e8a4e8961 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 10 Mar 2024 20:13:42 -0700 Subject: Fix 'with-sqlite-transaction' * lisp/sqlite.el (with-sqlite-transaction): Tuck misplaced body of else form back into feature-test control structure whence it escaped. (Bug#67142) * test/lisp/sqlite-tests.el: New file to accompany test/src/sqlite-tests.el. --- lisp/sqlite.el | 7 ++++--- test/lisp/sqlite-tests.el | 51 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 55 insertions(+), 3 deletions(-) create mode 100644 test/lisp/sqlite-tests.el (limited to 'lisp') diff --git a/lisp/sqlite.el b/lisp/sqlite.el index 46e35ac18d8..efc5997fb5c 100644 --- a/lisp/sqlite.el +++ b/lisp/sqlite.el @@ -32,7 +32,8 @@ If BODY completes normally, commit the changes and return the value of BODY. If BODY signals an error, or transaction commit fails, roll -back the transaction changes." +back the transaction changes before allowing the signal to +propagate." (declare (indent 1) (debug (form body))) (let ((db-var (gensym)) (func-var (gensym)) @@ -48,8 +49,8 @@ back the transaction changes." (setq ,res-var (funcall ,func-var)) (setq ,commit-var (sqlite-commit ,db-var)) ,res-var) - (or ,commit-var (sqlite-rollback ,db-var)))) - (funcall ,func-var)))) + (or ,commit-var (sqlite-rollback ,db-var))) + (funcall ,func-var))))) (provide 'sqlite) diff --git a/test/lisp/sqlite-tests.el b/test/lisp/sqlite-tests.el new file mode 100644 index 00000000000..d4892a27efc --- /dev/null +++ b/test/lisp/sqlite-tests.el @@ -0,0 +1,51 @@ +;;; sqlite-tests.el --- Tests for sqlite.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: +(require 'sqlite) + +(ert-deftest with-sqlite-transaction () + (skip-unless (sqlite-available-p)) + (let ((db (sqlite-open))) + (sqlite-execute db "create table test (a)") + (should + (eql 42 (with-sqlite-transaction db + (sqlite-execute db "insert into test values (1)") + (should (equal '((1)) (sqlite-select db "select * from test"))) + 42))) + ;; Body runs exactly once. + (should (equal '((1)) (sqlite-select db "select * from test"))))) + +(ert-deftest with-sqlite-transaction/rollback () + (skip-unless (sqlite-available-p)) + (let ((db (sqlite-open))) + (sqlite-execute db "create table test (a)") + (should (equal '(sqlite-error + ("SQL logic error" "no such function: fake" 1 1)) + (should-error + (with-sqlite-transaction db + (sqlite-execute db "insert into test values (1)") + (sqlite-execute db "insert into test values (fake(2))") + 42)))) + ;; First insertion (a=1) rolled back. + (should-not (sqlite-select db "select * from test")))) + +;;; sqlite-tests.el ends here -- cgit v1.2.3 From 2704ec54fd3e33a0914b06ad762be42c4956110d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 11 Mar 2024 21:51:29 -0400 Subject: (gnus-convert-old-newsrc): Remove ancient converters * lisp/gnus/gnus-start.el (gnus-convert-old-newsrc): Remove converters from 2004 and before. * lisp/gnus/legacy-gnus-agent.el: Delete file. --- lisp/gnus/gnus-start.el | 18 +-- lisp/gnus/legacy-gnus-agent.el | 260 ----------------------------------------- 2 files changed, 10 insertions(+), 268 deletions(-) delete mode 100644 lisp/gnus/legacy-gnus-agent.el (limited to 'lisp') diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index f337278994c..05ad4303b5c 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -2285,14 +2285,16 @@ If FORCE is non-nil, the .newsrc file is read." ;; doesn't change with each release) and the ;; function that must be applied to convert the ;; previous version into the current version. - '(("September Gnus v0.1" nil - gnus-convert-old-ticks) - ("Oort Gnus v0.08" "legacy-gnus-agent" - gnus-agent-convert-to-compressed-agentview) - ("Gnus v5.10.7" "legacy-gnus-agent" - gnus-agent-unlist-expire-days) - ("Gnus v5.10.7" "legacy-gnus-agent" - gnus-agent-unhook-expire-days))) + '(;;These all date back to 2004 or earlier! + ;; ("September Gnus v0.1" nil + ;; gnus-convert-old-ticks) + ;; ("Oort Gnus v0.08" "legacy-gnus-agent" + ;; gnus-agent-convert-to-compressed-agentview) + ;; ("Gnus v5.10.7" "legacy-gnus-agent" + ;; gnus-agent-unlist-expire-days) + ;; ("Gnus v5.10.7" "legacy-gnus-agent" + ;; gnus-agent-unhook-expire-days) + )) #'car-less-than-car))) ;; Skip converters older than the file version (while (and converters (>= fcv (caar converters))) diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el deleted file mode 100644 index d4f08c72de8..00000000000 --- a/lisp/gnus/legacy-gnus-agent.el +++ /dev/null @@ -1,260 +0,0 @@ -;;; legacy-gnus-agent.el --- Legacy unplugged support for Gnus -*- lexical-binding: t; -*- - -;; Copyright (C) 2004-2024 Free Software Foundation, Inc. - -;; Author: Kevin Greiner -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; Conversion functions for the Agent. - -;;; Code: -(require 'gnus-start) -(require 'gnus-util) -(require 'gnus-range) -(require 'gnus-agent) - -;; Oort Gnus v0.08 - This release updated agent to no longer use -;; history file and to support a compressed alist. - -(defvar gnus-agent-compressed-agentview-search-only nil) - -(defun gnus-agent-convert-to-compressed-agentview (converting-to) - "Iterates over all agentview files to ensure that they have been -converted to the compressed format." - - (let ((search-in (list gnus-agent-directory)) - here - members - member - converted-something) - (while (setq here (pop search-in)) - (setq members (directory-files here t)) - (while (setq member (pop members)) - (cond ((string-match "/\\.\\.?$" member) - nil) - ((file-directory-p member) - (push member search-in)) - ((equal (file-name-nondirectory member) ".agentview") - (setq converted-something - (or (gnus-agent-convert-agentview member) - converted-something)))))) - - (if converted-something - (gnus-message 4 "Successfully converted Gnus %s offline (agent) files to %s" gnus-newsrc-file-version converting-to)))) - -(defun gnus-agent-convert-to-compressed-agentview-prompt () - (catch 'found-file-to-convert - (let ((gnus-agent-compressed-agentview-search-only t)) - (gnus-agent-convert-to-compressed-agentview nil)))) - -(gnus-convert-mark-converter-prompt 'gnus-agent-convert-to-compressed-agentview 'gnus-agent-convert-to-compressed-agentview-prompt) - -(defun gnus-agent-convert-agentview (file) - "Load FILE and do a `read' there." - (with-temp-buffer - (nnheader-insert-file-contents file) - (goto-char (point-min)) - (let ((inhibit-quit t) - (alist (read (current-buffer))) - (version (condition-case nil (read (current-buffer)) - (end-of-file 0))) - changed-version - history-file) - - (cond - ((= version 0) - (let (entry - (gnus-command-method nil)) - (mm-disable-multibyte) ;; everything is binary - (erase-buffer) - (insert "\n") - (let ((file (concat (file-name-directory file) "/history"))) - (when (file-exists-p file) - (nnheader-insert-file-contents file) - (setq history-file file))) - - (goto-char (point-min)) - (while (not (eobp)) - (if (and (looking-at - "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)") - (string= (gnus-agent-article-name ".agentview" (match-string 2)) - file) - (setq entry (assoc (string-to-number (match-string 3)) alist))) - (setcdr entry (string-to-number (match-string 1)))) - (forward-line 1)) - (setq changed-version t))) - ((= version 1) - (setq changed-version t))) - - (when changed-version - (when gnus-agent-compressed-agentview-search-only - (throw 'found-file-to-convert t)) - - (erase-buffer) - (let (article-id day-of-download comp-list compressed) - (while alist - (setq article-id (caar alist) - day-of-download (cdar alist) - comp-list (assq day-of-download compressed) - alist (cdr alist)) - (if comp-list - (setcdr comp-list (cons article-id (cdr comp-list))) - (push (list day-of-download article-id) compressed))) - (setq alist compressed) - (while alist - (setq comp-list (pop alist)) - (setcdr comp-list - (gnus-compress-sequence (nreverse (cdr comp-list))))) - (princ compressed (current-buffer))) - (insert "\n2\n") - (write-file file) - (when history-file - (delete-file history-file)) - t)))) - -;; End of Oort Gnus v0.08 updates - -;; No Gnus v0.3 - This release provides a mechanism for upgrading gnus -;; from previous versions. Therefore, the previous -;; hacks to handle a gnus-agent-expire-days that -;; specifies a list of values can be removed. - -(defun gnus-agent-unlist-expire-days (converting-to) - (when (listp gnus-agent-expire-days) - (let (buffer) - (unwind-protect - (save-window-excursion - (setq buffer (gnus-get-buffer-create " *Gnus agent upgrade*")) - (set-buffer buffer) - (erase-buffer) - (insert "The definition of gnus-agent-expire-days has been changed.\nYou currently have it set to the list:\n ") - (gnus-pp gnus-agent-expire-days) - - (insert - (format-message - "\nIn order to use version `%s' of gnus, you will need to set\n" - converting-to)) - (insert "gnus-agent-expire-days to an integer. If you still wish to set different\n") - (insert "expiration days to individual groups, you must instead set the\n") - (insert (format-message - "`agent-days-until-old' group and/or topic parameter.\n")) - (insert "\n") - (insert "If you would like, gnus can iterate over every group comparing its name to the\n") - (insert "regular expressions that you currently have in gnus-agent-expire-days. When\n") - (insert (format-message - "gnus finds a match, it will update that group's `agent-days-until-old' group\n")) - (insert "parameter to the value associated with the regular expression.\n") - (insert "\n") - (insert "Whether gnus assigns group parameters, or not, gnus will terminate with an\n") - (insert "ERROR as soon as this function completes. The reason is that you must\n") - (insert "manually edit your configuration to either not set gnus-agent-expire-days or\n") - (insert "to set it to an integer before gnus can be used.\n") - (insert "\n") - (insert "Once you have successfully edited gnus-agent-expire-days, gnus will be able to\n") - (insert "execute past this function.\n") - (insert "\n") - (insert "Should gnus use gnus-agent-expire-days to assign\n") - (insert "agent-days-until-old parameters to individual groups? (Y/N)") - - (switch-to-buffer buffer) - (beep) - (beep) - - (let ((echo-keystrokes 0) - c) - (while (progn (setq c (read-char-exclusive)) - (cond ((or (eq c ?y) (eq c ?Y)) - (save-excursion - (let ((groups (gnus-group-listed-groups))) - (while groups - (let* ((group (pop groups)) - (days gnus-agent-expire-days) - (day (catch 'found - (while days - (when (eq 0 (string-match - (caar days) - group)) - (throw 'found (cadr (car days)))) - (setq days (cdr days))) - nil))) - (when day - (gnus-group-set-parameter group 'agent-days-until-old - day)))))) - nil - ) - ((or (eq c ?n) (eq c ?N)) - nil) - (t - t)))))) - (kill-buffer buffer)) - (error "Change gnus-agent-expire-days to an integer for gnus to start")))) - -;; The gnus-agent-unlist-expire-days has its own conversion prompt. -;; Therefore, hide the default prompt. -(gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t) - -(defun gnus-agent-unhook-expire-days (_converting-to) - "Remove every lambda from `gnus-group-prepare-hook' that mention the -symbol `gnus-agent-do-once' in their definition. This should NOT be -necessary as gnus-agent.el no longer adds them. However, it is -possible that the hook was persistently saved." - (let ((h t)) ; Iterate from bgn of hook. - (while h - (let ((func (progn (when (eq h t) - ;; Init h to list of functions. - (setq h (cond ((listp gnus-group-prepare-hook) - gnus-group-prepare-hook) - ((boundp 'gnus-group-prepare-hook) - (list gnus-group-prepare-hook))))) - (pop h)))) - - (when (cond ((byte-code-function-p func) - ;; Search def. of compiled function for - ;; gnus-agent-do-once string. - (let* (definition - print-level - print-length - (standard-output - (lambda (char) - (setq definition (cons char definition))))) - (princ func) ; Populates definition with reversed list - ; of characters. - (let* ((i (length definition)) - (s (make-string i 0))) - (while definition - (aset s (setq i (1- i)) (pop definition))) - - (string-match "\\bgnus-agent-do-once\\b" s)))) - ((listp func) - (eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; Handles eval'd lambda. - )) - - (remove-hook 'gnus-group-prepare-hook func) - ;; I don't what remove-hook is going to actually do to the - ;; hook list so start over from the beginning. - (setq h t)))))) - -;; gnus-agent-unhook-expire-days is safe in that it does not modify -;; the .newsrc.eld file. -(gnus-convert-mark-converter-prompt 'gnus-agent-unhook-expire-days t) - -(provide 'legacy-gnus-agent) - -;;; legacy-gnus-agent.el ends here -- cgit v1.2.3 From d5773276fb1671da619eeee2c316098d6b1c25c4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 12 Mar 2024 08:48:09 -0400 Subject: (comp-known-predicates): Fix overly optimistic `functionp` * lisp/emacs-lisp/comp.el (comp-known-predicates): `functionp` can also be true for `cons` objects. --- lisp/emacs-lisp/comp.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 21e2bb01ed0..9c2182092cb 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -202,7 +202,7 @@ Useful to hook into pass checkers.") (consp . cons) (floatp . float) (framep . frame) - (functionp . (or function symbol)) + (functionp . (or function symbol cons)) (hash-table-p . hash-table) (integer-or-marker-p . integer-or-marker) (integerp . integer) @@ -244,6 +244,7 @@ Useful to hook into pass checkers.") (defun comp--pred-to-cstr (predicate) "Given PREDICATE, return the corresponding constraint." + ;; FIXME: Unify those two hash tables? (or (gethash predicate comp-known-predicates-h) (gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt)))) -- cgit v1.2.3 From 7c552b22e64fa9173557e3511aa4e37ac1d5ea59 Mon Sep 17 00:00:00 2001 From: Daniel Pettersson Date: Wed, 28 Feb 2024 13:03:56 +0100 Subject: Jsonrpc: improve performance of process filter function `run-at-time' keeps `timer-list' list sorted by inserting each timer based on the timer value. This means that `timer--time-less-p' needs is executed ~N*N/2 times for each N pending messages. This means that jsonrpc becomes unusable for connections that generate a lot messages at the same time. * lisp/jsonrpc.el (Version): Bump to 1.0.25. (jsonrpc--process-filter): Improve performance by activating timers in a different order. (Bug#69241) --- lisp/jsonrpc.el | 28 +++++++++++++++++++--------- 1 file changed, 19 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 14fe0447008..5037d8c5b2b 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -4,7 +4,7 @@ ;; Author: João Távora ;; Keywords: processes, languages, extensions -;; Version: 1.0.24 +;; Version: 1.0.25 ;; Package-Requires: ((emacs "25.2")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -760,10 +760,11 @@ With optional CLEANUP, kill any associated buffers." (setq message (plist-put message :jsonrpc-json (buffer-string))) - (process-put proc 'jsonrpc-mqueue - (nconc (process-get proc - 'jsonrpc-mqueue) - (list message))))) + ;; Put new messages at the front of the queue, + ;; this is correct as the order is reversed + ;; before putting the timers on `timer-list'. + (push message + (process-get proc 'jsonrpc-mqueue)))) (goto-char message-end) (let ((inhibit-read-only t)) (delete-region (point-min) (point))) @@ -782,11 +783,20 @@ With optional CLEANUP, kill any associated buffers." ;; non-locally (typically the reply to a request), so do ;; this all this processing in top-level loops timer. (cl-loop + ;; `timer-activate' orders timers by time, which is an + ;; very expensive operation when jsonrpc-mqueue is large, + ;; therefore the time object is reused for each timer + ;; created. + with time = (current-time) for msg = (pop (process-get proc 'jsonrpc-mqueue)) while msg - do (run-at-time 0 nil - (lambda (m) (with-temp-buffer - (jsonrpc-connection-receive conn m))) - msg))))))) + do (let ((timer (timer-create))) + (timer-set-time timer time) + (timer-set-function timer + (lambda (conn msg) + (with-temp-buffer + (jsonrpc-connection-receive conn msg))) + (list conn msg)) + (timer-activate timer)))))))) (defun jsonrpc--remove (conn id &optional deferred-spec) "Cancel CONN's continuations for ID, including its timer, if it exists. -- cgit v1.2.3 From 3e96dd4f8851a45c66ebc9b8666ae449cc4c2725 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 12 Mar 2024 12:00:17 -0400 Subject: cl-generic: Signal an error when a type specializer won't work * lisp/emacs-lisp/cl-generic.el (cl--generic--unreachable-types): New var. (cl-generic-generalizers :extra "typeof"): Use it to signal an error for those types we can't handle. --- lisp/emacs-lisp/cl-generic.el | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 84eb800ec24..613ecf82a92 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1332,6 +1332,12 @@ These match if the argument is `eql' to VAL." ;;; Dispatch on "normal types". +(defconst cl--generic--unreachable-types + ;; FIXME: Try to make that list empty? + '(fixnum bignum boolean keyword + special-form subr-primitive subr-native-elisp) + "Built-in classes on which we cannot dispatch for technical reasons.") + (defun cl--generic-type-specializers (tag &rest _) (and (symbolp tag) (let ((class (cl--find-class tag))) @@ -1352,6 +1358,8 @@ This currently works for built-in types and types built on top of records." (and (symbolp type) (not (eq type t)) ;; Handled by the `t-generalizer'. (let ((class (cl--find-class type))) + (when (memq type cl--generic--unreachable-types) + (error "Dispatch on %S is currently not supported" type)) (memq (type-of class) '(built-in-class cl-structure-class eieio--class))) (list cl--generic-typeof-generalizer)) -- cgit v1.2.3 From 8df673907781bce8b080b91b056cb9987587387c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 12 Mar 2024 15:43:43 -0400 Subject: Cleanup some type predicates Use the new `cl--define-built-in-type` to reduce the manually maintained list of built-in type predicates. Also tweak docstrings to use "supertype" rather than "super type", since it seems to be what we use elsewhere. * lisp/subr.el (special-form-p): Remove redundant `fboundp` test. (compiled-function-p): Don'Return nil for subrs that aren't functions. * lisp/emacs-lisp/cl-macs.el (type predicates): Trim down the list. * lisp/emacs-lisp/cl-preloaded.el (cl--define-built-in-type): Register the corresponding predicate if applicable. (atom, null): Specify the predicate name explicitly. --- lisp/emacs-lisp/cl-macs.el | 45 +++++------------------------------- lisp/emacs-lisp/cl-preloaded.el | 51 ++++++++++++++++++++++++++--------------- lisp/emacs-lisp/oclosure.el | 2 +- lisp/subr.el | 6 ++--- 4 files changed, 42 insertions(+), 62 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index be477b7a6df..129b83c61b9 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3463,45 +3463,12 @@ Of course, we really can't know that for sure, so it's just a heuristic." ;; Please keep it in sync with `comp-known-predicates'. (pcase-dolist (`(,type . ,pred) ;; Mostly kept in alphabetical order. - '((array . arrayp) - (atom . atom) - (base-char . characterp) - (bignum . bignump) - (boolean . booleanp) - (bool-vector . bool-vector-p) - (buffer . bufferp) - (byte-code-function . byte-code-function-p) - (character . natnump) - (char-table . char-table-p) - (command . commandp) - (compiled-function . compiled-function-p) - (hash-table . hash-table-p) - (cons . consp) - (fixnum . fixnump) - (float . floatp) - (frame . framep) - (function . functionp) - (integer . integerp) - (keyword . keywordp) - (list . listp) - (marker . markerp) - (natnum . natnump) - (number . numberp) - (null . null) - (obarray . obarrayp) - (overlay . overlayp) - (process . processp) - (real . numberp) - (sequence . sequencep) - (subr . subrp) - (string . stringp) - (symbol . symbolp) - (symbol-with-pos . symbol-with-pos-p) - (vector . vectorp) - (window . windowp) - ;; FIXME: Do we really want to consider these types? - (number-or-marker . number-or-marker-p) - (integer-or-marker . integer-or-marker-p) + ;; These aren't defined via `cl--define-built-in-type'. + '((base-char . characterp) ;Could be subtype of `fixnum'. + (character . natnump) ;Could be subtype of `fixnum'. + (command . commandp) ;Subtype of closure & subr. + (natnum . natnump) ;Subtype of fixnum & bignum. + (real . numberp) ;Not clear where it would fit. )) (put type 'cl-deftype-satisfies pred)) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 5743684fa89..515aa99549d 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -308,7 +308,7 @@ (:copier nil)) ) -(defmacro cl--define-built-in-type (name parents &optional docstring &rest _slots) +(defmacro cl--define-built-in-type (name parents &optional docstring &rest slots) ;; `slots' is currently unused, but we could make it take ;; a list of "slot like properties" together with the corresponding ;; accessor, and then we could maybe even make `slot-value' work @@ -317,15 +317,26 @@ (unless (listp parents) (setq parents (list parents))) (unless (or parents (eq name t)) (error "Missing parents for %S: %S" name parents)) - `(progn - (put ',name 'cl--class - (built-in-class--make ',name ,docstring - (mapcar (lambda (type) - (let ((class (get type 'cl--class))) - (unless class - (error "Unknown type: %S" type)) - class)) - ',parents))))) + (let ((predicate (intern-soft (format + (if (string-match "-" (symbol-name name)) + "%s-p" "%sp") + name)))) + (unless (fboundp predicate) (setq predicate nil)) + (while (keywordp (car slots)) + (let ((kw (pop slots)) (val (pop slots))) + (pcase kw + (:predicate (setq predicate val)) + (_ (error "Unknown keyword arg: %S" kw))))) + `(progn + ,(if predicate `(put ',name 'cl-deftype-satisfies #',predicate)) + (put ',name 'cl--class + (built-in-class--make ',name ,docstring + (mapcar (lambda (type) + (let ((class (get type 'cl--class))) + (unless class + (error "Unknown type: %S" type)) + class)) + ',parents)))))) ;; FIXME: Our type DAG has various quirks: ;; - `subr' says it's a `compiled-function' but that's not true @@ -336,8 +347,9 @@ ;; so the DAG of OClosure types is "orthogonal" to the distinction ;; between interpreted and compiled functions. -(cl--define-built-in-type t nil "The type of everything.") -(cl--define-built-in-type atom t "The type of anything but cons cells.") +(cl--define-built-in-type t nil "Abstract supertype of everything.") +(cl--define-built-in-type atom t "Abstract supertype of anything but cons cells." + :predicate atom) (cl--define-built-in-type tree-sitter-compiled-query atom) (cl--define-built-in-type tree-sitter-node atom) @@ -358,7 +370,7 @@ (cl--define-built-in-type window-configuration atom) (cl--define-built-in-type overlay atom) (cl--define-built-in-type number-or-marker atom - "Abstract super type of both `number's and `marker's.") + "Abstract supertype of both `number's and `marker's.") (cl--define-built-in-type symbol atom "Type of symbols." ;; Example of slots we could document. It would be desirable to @@ -373,14 +385,14 @@ (cl--define-built-in-type obarray atom) (cl--define-built-in-type native-comp-unit atom) -(cl--define-built-in-type sequence t "Abstract super type of sequences.") +(cl--define-built-in-type sequence t "Abstract supertype of sequences.") (cl--define-built-in-type list sequence) -(cl--define-built-in-type array (sequence atom) "Abstract super type of arrays.") +(cl--define-built-in-type array (sequence atom) "Abstract supertype of arrays.") (cl--define-built-in-type number (number-or-marker) - "Abstract super type of numbers.") + "Abstract supertype of numbers.") (cl--define-built-in-type float (number)) (cl--define-built-in-type integer-or-marker (number-or-marker) - "Abstract super type of both `integer's and `marker's.") + "Abstract supertype of both `integer's and `marker's.") (cl--define-built-in-type integer (number integer-or-marker)) (cl--define-built-in-type marker (integer-or-marker)) (cl--define-built-in-type bignum (integer) @@ -404,13 +416,14 @@ For this build of Emacs it's %dbit." "Type of special arrays that are indexed by characters.") (cl--define-built-in-type string (array)) (cl--define-built-in-type null (boolean list) ;FIXME: `atom' comes before `list'? - "Type of the nil value.") + "Type of the nil value." + :predicate null) (cl--define-built-in-type cons (list) "Type of cons cells." ;; Example of slots we could document. (car car) (cdr cdr)) (cl--define-built-in-type function (atom) - "Abstract super type of function values.") + "Abstract supertype of function values.") (cl--define-built-in-type compiled-function (function) "Abstract type of functions that have been compiled.") (cl--define-built-in-type byte-code-function (compiled-function) diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index 977d5735171..4da8e61aaa7 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -437,7 +437,7 @@ This has 2 uses: - For compiled code, this is used as a marker which cconv uses to check that immutable fields are indeed not mutated." (if (byte-code-function-p oclosure) - ;; Actually, this should never happen since the `cconv.el' should have + ;; Actually, this should never happen since `cconv.el' should have ;; optimized away the call to this function. oclosure ;; For byte-coded functions, we store the type as a symbol in the docstring diff --git a/lisp/subr.el b/lisp/subr.el index ce933e3bfdc..38a3f6edb34 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4494,8 +4494,7 @@ Otherwise, return nil." (defun special-form-p (object) "Non-nil if and only if OBJECT is a special form." (declare (side-effect-free error-free)) - (if (and (symbolp object) (fboundp object)) - (setq object (indirect-function object))) + (if (symbolp object) (setq object (indirect-function object))) (and (subrp object) (eq (cdr (subr-arity object)) 'unevalled))) (defun plistp (object) @@ -4517,7 +4516,8 @@ Otherwise, return nil." Does not distinguish between functions implemented in machine code or byte-code." (declare (side-effect-free error-free)) - (or (subrp object) (byte-code-function-p object))) + (or (and (subrp object) (not (eq 'unevalled (cdr (subr-arity object))))) + (byte-code-function-p object))) (defun field-at-pos (pos) "Return the field at position POS, taking stickiness etc into account." -- cgit v1.2.3 From 4afafa03704aab0c21e4cb4f028256ecead5f795 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 12 Mar 2024 16:09:23 -0400 Subject: Try and avoid hardcoding lists of function types * lisp/bind-key.el (bind-key--get-binding-description): Show docstrings for compiled functions also. Don't hardcode knowledge about various particular kinds of functions. * lisp/emacs-lisp/bytecomp.el (display-call-tree): Remove special support for functions with a `byte-code` body since we never generate that nowadays. Don't hardcode knowledge about various particular kinds of functions. --- lisp/bind-key.el | 42 +++++++++++++++++++----------------------- lisp/emacs-lisp/bytecomp.el | 15 +++------------ 2 files changed, 22 insertions(+), 35 deletions(-) (limited to 'lisp') diff --git a/lisp/bind-key.el b/lisp/bind-key.el index 378ad69b2bc..1e59c75566a 100644 --- a/lisp/bind-key.el +++ b/lisp/bind-key.el @@ -453,31 +453,27 @@ other modes. See `override-global-mode'." (macroexp-progn (bind-keys-form args 'override-global-map))) (defun bind-key--get-binding-description (elem) - (cond - ((listp elem) + (let (doc) (cond - ((memq (car elem) '(lambda function)) - (if (and bind-key-describe-special-forms - (stringp (nth 2 elem))) - (nth 2 elem) - "#")) - ((eq 'closure (car elem)) - (if (and bind-key-describe-special-forms - (stringp (nth 3 elem))) - (nth 3 elem) - "#")) - ((eq 'keymap (car elem)) - "#") + ((symbolp elem) + (cond + ((and bind-key-describe-special-forms (keymapp elem) + ;; FIXME: Is this really ever better than the symbol-name? + ;; FIXME: `variable-documentation' describe what's in + ;; elem's `symbol-value', whereas `elem' here stands for + ;; its `symbol-function'. + (stringp (setq doc (get elem 'variable-documentation)))) + doc) + (t elem))) + ((and bind-key-describe-special-forms (functionp elem) + (stringp (setq doc (documentation elem)))) + doc) ;;FIXME: Keep only the first line? + ((consp elem) + (if (symbolp (car elem)) + (format "#<%s>" (car elem)) + elem)) (t - elem))) - ;; must be a symbol, non-symbol keymap case covered above - ((and bind-key-describe-special-forms (keymapp elem)) - (let ((doc (get elem 'variable-documentation))) - (if (stringp doc) doc elem))) - ((symbolp elem) - elem) - (t - "#"))) + (format "#<%s>" (type-of elem)))))) (defun bind-key--compare-keybindings (l r) (let* ((regex bind-key-segregation-regexp) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index cf0e6d600dd..7af568cfe34 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5536,23 +5536,14 @@ invoked interactively." (if (null f) " ";; shouldn't insert nil then, actually -sk " ")) - ((subrp (setq f (symbol-function f))) - " ") - ((symbolp f) + ((symbolp (setq f (symbol-function f))) ;; An alias. (format " ==> %s" f)) - ((byte-code-function-p f) - "") ((not (consp f)) - "") + (format " <%s>" (type-of f))) ((eq 'macro (car f)) - (if (or (compiled-function-p (cdr f)) - ;; FIXME: Can this still happen? - (assq 'byte-code (cdr (cdr (cdr f))))) + (if (compiled-function-p (cdr f)) " " " ")) - ((assq 'byte-code (cdr (cdr f))) - ;; FIXME: Can this still happen? - "") ((eq 'lambda (car f)) "") (t "???")) -- cgit v1.2.3 From db027a06976ee1bcbe6294e281bd5954dd1052ef Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Tue, 12 Mar 2024 22:47:45 +0100 Subject: ; Fix bibtex-biblatex-field-alist docstring typo. --- lisp/textmodes/bibtex.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 3d155ac87b5..d78dac53516 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -1012,7 +1012,7 @@ if `bibtex-BibTeX-entry-alist' does not define a comment for FIELD." ("volumes" "Total number of volumes of a multi-volume work") ("year" "Year of publication")) "Alist of biblatex fields. -It has the same format as `bibtex-BibTeX-entry-alist'." +It has the same format as `bibtex-BibTeX-field-alist'." :group 'bibtex :version "28.1" :type 'bibtex-field-alist) -- cgit v1.2.3 From 6b40d557c4a9a4152565c1a1b0da49a1aaaec84f Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 13 Mar 2024 10:59:39 +0800 Subject: Port more notification senders to non-XDG systems * doc/lispref/os.texi (Desktop Notifications): Document that `:timeout' is now implemented. * java/org/gnu/emacs/EmacsDesktopNotification.java (EmacsDesktopNotification): New field delay. (display1): Set delay on Android 8.0 and up. * lisp/erc/erc-desktop-notifications.el (erc-notifications-notify): Call Android or Haiku notification functions on those systems. * lisp/gnus/gnus-notifications.el (gnus-notifications-action) (gnus-notification-close): Remove dismissed notifications from the notification to message map. (gnus-notifications-notify): Call android-notifications-notify if possible. * src/androidselect.c (android_init_emacs_desktop_notification): Update accordingly. (android_notifications_notify_1): New argument TIMEOUT. (Fandroid_notifications_notify): New argument QCtimeout. (syms_of_androidselect) : New symbol. --- doc/lispref/os.texi | 1 + java/org/gnu/emacs/EmacsDesktopNotification.java | 10 ++- lisp/erc/erc-desktop-notifications.el | 24 ++++--- lisp/gnus/gnus-notifications.el | 41 ++++++++--- src/androidselect.c | 86 ++++++++++++++++-------- 5 files changed, 115 insertions(+), 47 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 435886320fd..3ba3da459bf 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -3244,6 +3244,7 @@ of parameters analogous to its namesake in @item :on-action @var{on-action} @item :on-cancel @var{on-close} @item :actions @var{actions} +@item :timeout @var{timeout} @item :resident @var{resident} These have the same meaning as they do when used in calls to @code{notifications-notify}, except that no more than three non-default diff --git a/java/org/gnu/emacs/EmacsDesktopNotification.java b/java/org/gnu/emacs/EmacsDesktopNotification.java index d05ed2e6203..d00b9f2ea22 100644 --- a/java/org/gnu/emacs/EmacsDesktopNotification.java +++ b/java/org/gnu/emacs/EmacsDesktopNotification.java @@ -83,11 +83,16 @@ public final class EmacsDesktopNotification notification. */ public final String[] actions, titles; + /* Delay in miliseconds after which this notification should be + automatically dismissed. */ + public final long delay; + public EmacsDesktopNotification (String title, String content, String group, String tag, int icon, int importance, - String[] actions, String[] titles) + String[] actions, String[] titles, + long delay) { this.content = content; this.title = title; @@ -97,6 +102,7 @@ public final class EmacsDesktopNotification this.importance = importance; this.actions = actions; this.titles = titles; + this.delay = delay; } @@ -191,6 +197,8 @@ public final class EmacsDesktopNotification builder.setContentTitle (title); builder.setContentText (content); builder.setSmallIcon (icon); + builder.setTimeoutAfter (delay); + insertActions (context, builder); notification = builder.build (); } diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el index 2e905097f97..9bb89fbfc81 100644 --- a/lisp/erc/erc-desktop-notifications.el +++ b/lisp/erc/erc-desktop-notifications.el @@ -54,6 +54,9 @@ (defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors +(declare-function haiku-notifications-notify "haikuselect.c") +(declare-function android-notifications-notify "androidselect.c") + (defun erc-notifications-notify (nick msg &optional privp) "Notify that NICK send some MSG, where PRIVP should be non-nil for PRIVMSGs. This will replace the last notification sent with this function." @@ -64,14 +67,19 @@ This will replace the last notification sent with this function." (let* ((channel (if privp (erc-get-buffer nick) (current-buffer))) (title (format "%s in %s" (xml-escape-string nick t) channel)) (body (xml-escape-string (erc-controls-strip msg) t))) - (notifications-notify :bus erc-notifications-bus - :title title - :body body - :replaces-id erc-notifications-last-notification - :app-icon erc-notifications-icon - :actions '("default" "Switch to buffer") - :on-action (lambda (&rest _) - (pop-to-buffer channel))))))) + (funcall (cond ((featurep 'android) + #'android-notifications-notify) + ((featurep 'haiku) + #'haiku-notifications-notify) + (t #'notifications-notify)) + :bus erc-notifications-bus + :title title + :body body + :replaces-id erc-notifications-last-notification + :app-icon erc-notifications-icon + :actions '("default" "Switch to buffer") + :on-action (lambda (&rest _) + (pop-to-buffer channel))))))) (defun erc-notifications-PRIVMSG (_proc parsed) (let ((nick (car (erc-parse-user (erc-response.sender parsed)))) diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el index f34f5ea0e26..9ef21c91627 100644 --- a/lisp/gnus/gnus-notifications.el +++ b/lisp/gnus/gnus-notifications.el @@ -83,27 +83,46 @@ not get notifications." group (delq article (gnus-list-of-unread-articles group))) ;; gnus-group-refresh-group - (gnus-group-update-group group))))))) + (gnus-group-update-group group)))))) + ;; Notifications are removed unless otherwise specified once they (or + ;; an action of theirs) are selected + (assoc-delete-all id gnus-notifications-id-to-msg)) + +(defun gnus-notification-close (id reason) + "Remove ID from the alist of notification identifiers to messages. +REASON is ignored." + (assoc-delete-all id gnus-notifications-id-to-msg)) (defun gnus-notifications-notify (from subject photo-file) "Send a notification about a new mail. Return a notification id if any, or t on success." - (if (fboundp 'notifications-notify) + (if (featurep 'android) (gnus-funcall-no-warning - 'notifications-notify + 'android-notifications-notify :title from :body subject :actions '("read" "Read" "mark-read" "Mark As Read") :on-action 'gnus-notifications-action - :app-icon (gnus-funcall-no-warning - 'image-search-load-path "gnus/gnus.png") - :image-path photo-file - :app-name "Gnus" - :category "email.arrived" + :on-close 'gnus-notifications-close + :group "Email arrivals" :timeout gnus-notifications-timeout) - (message "New message from %s: %s" from subject) - ;; Don't return an id - t)) + (if (fboundp 'notifications-notify) + (gnus-funcall-no-warning + 'notifications-notify + :title from + :body subject + :actions '("read" "Read" "mark-read" "Mark As Read") + :on-action 'gnus-notifications-action + :on-close 'gnus-notifications-close + :app-icon (gnus-funcall-no-warning + 'image-search-load-path "gnus/gnus.png") + :image-path photo-file + :app-name "Gnus" + :category "email.arrived" + :timeout gnus-notifications-timeout) + (message "New message from %s: %s" from subject) + ;; Don't return an id + t))) (declare-function gravatar-retrieve-synchronously "gravatar.el" (mail-address)) diff --git a/src/androidselect.c b/src/androidselect.c index 521133976a7..87dd2c3d079 100644 --- a/src/androidselect.c +++ b/src/androidselect.c @@ -526,7 +526,7 @@ android_init_emacs_desktop_notification (void) FIND_METHOD (init, "", "(Ljava/lang/String;" "Ljava/lang/String;Ljava/lang/String;" "Ljava/lang/String;II[Ljava/lang/String;" - "[Ljava/lang/String;)V"); + "[Ljava/lang/String;J)V"); FIND_METHOD (display, "display", "()V"); #undef FIND_METHOD } @@ -567,16 +567,17 @@ android_locate_icon (const char *name) } /* Display a desktop notification with the provided TITLE, BODY, - REPLACES_ID, GROUP, ICON, URGENCY, ACTIONS, RESIDENT, ACTION_CB and - CLOSE_CB. Return an identifier for the resulting notification. */ + REPLACES_ID, GROUP, ICON, URGENCY, ACTIONS, TIMEOUT, RESIDENT, + ACTION_CB and CLOSE_CB. Return an identifier for the resulting + notification. */ static intmax_t android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, Lisp_Object replaces_id, Lisp_Object group, Lisp_Object icon, Lisp_Object urgency, Lisp_Object actions, - Lisp_Object resident, Lisp_Object action_cb, - Lisp_Object close_cb) + Lisp_Object timeout, Lisp_Object resident, + Lisp_Object action_cb, Lisp_Object close_cb) { static intmax_t counter; intmax_t id; @@ -593,6 +594,7 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, jint nitems, i; jstring item; Lisp_Object length; + jlong timeout_val; if (EQ (urgency, Qlow)) type = 2; /* IMPORTANCE_LOW */ @@ -603,6 +605,23 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, else signal_error ("Invalid notification importance given", urgency); + /* Decode the timeout. */ + + timeout_val = 0; + + if (!NILP (timeout)) + { + CHECK_INTEGER (timeout); + + if (!integer_to_intmax (timeout, &id) + || id > TYPE_MAXIMUM (jlong) + || id < TYPE_MINIMUM (jlong)) + signal_error ("Invalid timeout", timeout); + + if (id > 0) + timeout_val = id; + } + nitems = 0; /* If ACTIONS is provided, split it into two arrays of Java strings @@ -714,7 +733,8 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, notification_class.init, title1, body1, group1, identifier1, icon1, type, - action_keys, action_titles); + action_keys, action_titles, + timeout_val); android_exception_check_6 (title1, body1, group1, identifier1, action_titles, action_keys); @@ -723,12 +743,8 @@ android_notifications_notify_1 (Lisp_Object title, Lisp_Object body, ANDROID_DELETE_LOCAL_REF (body1); ANDROID_DELETE_LOCAL_REF (group1); ANDROID_DELETE_LOCAL_REF (identifier1); - - if (action_keys) - ANDROID_DELETE_LOCAL_REF (action_keys); - - if (action_titles) - ANDROID_DELETE_LOCAL_REF (action_titles); + ANDROID_DELETE_LOCAL_REF (action_keys); + ANDROID_DELETE_LOCAL_REF (action_titles); /* Display the notification. */ (*android_java_env)->CallNonvirtualVoidMethod (android_java_env, @@ -769,8 +785,14 @@ keywords is understood: The action for which CALLBACK is called when the notification itself is selected is named "default", its existence is implied, and its TITLE is ignored. - No more than three actions can be defined, not - counting any action with "default" as its key. + No more than three actions defined here will be + displayed, not counting any with "default" as its + key. + :timeout Number of miliseconds from the display of the + notification at which it will be automatically + dismissed, or a value of zero or smaller if it + is to remain until user action is taken to dismiss + it. :resident When set the notification will not be automatically dismissed when it or an action is selected. :on-action Function to call when an action is invoked. @@ -780,12 +802,15 @@ keywords is understood: with the notification id and the symbol `undefined' for arguments. -The notification group is ignored on Android 7.1 and earlier versions -of Android. Outside such older systems, it identifies a category that -will be displayed in the system Settings menu, and the urgency -provided always extends to affect all notifications displayed within -that category. If the group is not provided, it defaults to the -string "Desktop Notifications". +The notification group and timeout are ignored on Android 7.1 and +earlier versions of Android. On more recent versions, the urgency +identifies a category that will be displayed in the system Settings +menu, and the urgency provided always extends to affect all +notifications displayed within that category, though it may be ignored +if higher than any previously-specified urgency or if the user have +already configured a different urgency for this category from Settings. +If the group is not provided, it defaults to the string "Desktop +Notifications" with the urgency suffixed. Each caller should strive to provide one unchanging combination of notification group and urgency for each kind of notification it sends, @@ -795,8 +820,8 @@ first notification sent to its notification group. The provided icon should be the name of a "drawable resource" present within the "android.R.drawable" class designating an icon with a -transparent background. If no icon is provided (or the icon is absent -from this system), it defaults to "ic_dialog_alert". +transparent background. Should no icon be provided (or the icon is +absent from this system), it defaults to "ic_dialog_alert". Actions specified with :actions cannot be displayed on Android 4.0 and earlier versions of the system. @@ -814,17 +839,18 @@ this function. usage: (android-notifications-notify &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { - Lisp_Object title, body, replaces_id, group, urgency, resident; + Lisp_Object title, body, replaces_id, group, urgency, timeout, resident; Lisp_Object icon; Lisp_Object key, value, actions, action_cb, close_cb; ptrdiff_t i; + AUTO_STRING (default_icon, "ic_dialog_alert"); if (!android_init_gui) error ("No Android display connection!"); /* Clear each variable above. */ title = body = replaces_id = group = icon = urgency = actions = Qnil; - resident = action_cb = close_cb = Qnil; + timeout = resident = action_cb = close_cb = Qnil; /* If NARGS is odd, error. */ @@ -852,6 +878,8 @@ usage: (android-notifications-notify &rest ARGS) */) icon = value; else if (EQ (key, QCactions)) actions = value; + else if (EQ (key, QCtimeout)) + timeout = value; else if (EQ (key, QCresident)) resident = value; else if (EQ (key, QCon_action)) @@ -874,16 +902,19 @@ usage: (android-notifications-notify &rest ARGS) */) urgency = Qlow; if (NILP (group)) - group = build_string ("Desktop Notifications"); + { + AUTO_STRING (format, "Desktop Notifications (%s importance)"); + group = CALLN (Fformat, format, urgency); + } if (NILP (icon)) - icon = build_string ("ic_dialog_alert"); + icon = default_icon; else CHECK_STRING (icon); return make_int (android_notifications_notify_1 (title, body, replaces_id, group, icon, urgency, - actions, resident, + actions, timeout, resident, action_cb, close_cb)); } @@ -1001,6 +1032,7 @@ syms_of_androidselect (void) DEFSYM (QCurgency, ":urgency"); DEFSYM (QCicon, ":icon"); DEFSYM (QCactions, ":actions"); + DEFSYM (QCtimeout, ":timeout"); DEFSYM (QCresident, ":resident"); DEFSYM (QCon_action, ":on-action"); DEFSYM (QCon_close, ":on-close"); -- cgit v1.2.3 From c5945e0f9eaf01e653d5afbce72837a05e3e347a Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Wed, 13 Mar 2024 07:38:49 -0700 Subject: Fix name of gnus-notification(s)-close; ignore argument * lisp/gnus/gnus-notifications.el (gnus-notifications-close): Original name was probably a typo. --- lisp/gnus/gnus-notifications.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el index 9ef21c91627..35f90ebfe40 100644 --- a/lisp/gnus/gnus-notifications.el +++ b/lisp/gnus/gnus-notifications.el @@ -88,7 +88,7 @@ not get notifications." ;; an action of theirs) are selected (assoc-delete-all id gnus-notifications-id-to-msg)) -(defun gnus-notification-close (id reason) +(defun gnus-notifications-close (id _reason) "Remove ID from the alist of notification identifiers to messages. REASON is ignored." (assoc-delete-all id gnus-notifications-id-to-msg)) -- cgit v1.2.3 From 013114664ef4923872ffad26a97f4d314c9a84bf Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 8 Mar 2024 22:28:52 -0600 Subject: * lisp/emacs-lisp/vtable.el (vtable-update-object): Fix. The order of the arguments to 'seq-position' was wrong, and it did not compare the correct values. (Bug#69664) --- lisp/emacs-lisp/vtable.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 02020552e7f..5cf8d8854bb 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -300,7 +300,9 @@ If it can't be found, return nil and don't move point." (error "Can't find the old object")) (setcar (cdr objects) object)) ;; Then update the cache... - (let* ((line-number (seq-position old-object (car (vtable--cache table)))) + (let* ((line-number (seq-position (car (vtable--cache table)) old-object + (lambda (a b) + (equal (car a) b)))) (line (elt (car (vtable--cache table)) line-number))) (unless line (error "Can't find cached object")) -- cgit v1.2.3 From f6a27bc32d19727dfcbee65fb9894b53aec46c65 Mon Sep 17 00:00:00 2001 From: Noé Lopez Date: Fri, 19 Jan 2024 23:40:53 +0100 Subject: Add user option to disable JavaScript in xwidget webview * src/xwidget.c: Add the 'xwidget-webkit-disable-javascript' variable to disable JavaScript in WebKit sessions. (Bug#68604) * etc/NEWS: * doc/emacs/misc.texi (Embedded Webkit Widgets): Document the change. --- doc/emacs/misc.texi | 8 ++++++++ etc/NEWS | 6 ++++++ lisp/xwidget.el | 7 +++++++ src/xwidget.c | 8 +++++++- 4 files changed, 28 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 7eb28f56826..bfc86e3c9d4 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -3009,6 +3009,14 @@ buffer, and lets you navigate to those pages by hitting @kbd{RET}. It is bound to @kbd{H}. +@vindex xwidget-webkit-disable-javascript +@cindex disabling javascript in webkit buffers + JavaScript is enabled by default inside WebKit buffers, this can be +undesirable as websites often use it to track your online activity. It +can be disabled by setting the variable @code{xwidget-webkit-disable-javascript} to @code{t}. +You must kill all WebKit buffers for this setting to take effect after +it is changed. + @node Browse-URL @subsection Following URLs @cindex World Wide Web diff --git a/etc/NEWS b/etc/NEWS index 19cd170e5c7..2985169ea91 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1437,6 +1437,12 @@ This allows the user to customize the key selection method, which can be either by using a pop-up buffer or from the minibuffer. The pop-up buffer method is the default, which preserves previous behavior. +** Xwidget Webkit + ++++ +*** New user option 'xwidget-webkit-disable-javascript'. +This allows disabling JavaScript in xwidget Webkit sessions. + * New Modes and Packages in Emacs 30.1 diff --git a/lisp/xwidget.el b/lisp/xwidget.el index cca01c8cb3a..2fb79bb7b1d 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -116,6 +116,13 @@ buffers for this setting to take effect after setting it to nil." :type '(choice (const :tag "Do not store cookies" nil) file) :version "29.1") +(defcustom xwidget-webkit-disable-javascript nil + "If non-nil, disables the execution of JavaScript in xwidget webkit sessions. +You must kill all xwidget-webkit buffers for this setting to take +effect after changing it." + :type '(boolean) + :version "30.0") + ;;;###autoload (defun xwidget-webkit-browse-url (url &optional new-session) "Ask xwidget-webkit to browse URL. diff --git a/src/xwidget.c b/src/xwidget.c index 58910459142..5b82ef6e840 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -22,7 +22,6 @@ along with GNU Emacs. If not, see . */ #include "buffer.h" #include "coding.h" #include "xwidget.h" - #include "lisp.h" #include "blockinput.h" #include "dispextern.h" @@ -379,6 +378,7 @@ fails. */) /* Enable the developer extras. */ settings = webkit_web_view_get_settings (WEBKIT_WEB_VIEW (xw->widget_osr)); g_object_set (G_OBJECT (settings), "enable-developer-extras", TRUE, NULL); + g_object_set (G_OBJECT (settings), "enable-javascript", !xwidget_webkit_disable_javascript, NULL); } gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width, @@ -3972,6 +3972,12 @@ syms_of_xwidget (void) doc: /* List of all xwidget views. */); Vxwidget_view_list = Qnil; + DEFVAR_BOOL("xwidget-webkit-disable-javascript", xwidget_webkit_disable_javascript, + doc: /* If non-nil, disables the execution of JavaScript in xwidget webkit sessions. +You must kill all xwidget-webkit buffers for this setting to take +effect after changing it. */); + xwidget_webkit_disable_javascript = false; + Fprovide (intern ("xwidget-internal"), Qnil); id_to_xwidget_map = CALLN (Fmake_hash_table, QCtest, Qeq, -- cgit v1.2.3 From a60804ab954e0de73a80a217f677142176678465 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 14 Mar 2024 11:32:00 +0200 Subject: ; Fix last change (bug#68604) * lisp/xwidget.el (xwidget-webkit-disable-javascript): Move from here... * lisp/cus-start.el (standard): ...to here. * src/xwidget.c (syms_of_xwidget) : Doc fix. * doc/emacs/misc.texi (Embedded WebKit Widgets): Fix wording. --- doc/emacs/misc.texi | 9 +++++---- lisp/cus-start.el | 4 ++++ lisp/xwidget.el | 7 ------- src/xwidget.c | 6 +++--- 4 files changed, 12 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index bfc86e3c9d4..8f9ee317080 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -3011,10 +3011,11 @@ It is bound to @kbd{H}. @vindex xwidget-webkit-disable-javascript @cindex disabling javascript in webkit buffers - JavaScript is enabled by default inside WebKit buffers, this can be -undesirable as websites often use it to track your online activity. It -can be disabled by setting the variable @code{xwidget-webkit-disable-javascript} to @code{t}. -You must kill all WebKit buffers for this setting to take effect after + JavaScript is enabled by default inside WebKit buffers, which could be +undesirable, as Web sites often use it to track your online activity. +You can disable JavaScript in WebKit buffers by customizing the variable +@code{xwidget-webkit-disable-javascript} to a non-@code{nil} value. +You must kill all WebKit buffers for this setting to take effect, after it is changed. @node Browse-URL diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 3fe62c8d0da..165296d2242 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -846,6 +846,8 @@ since it could result in memory overflow and make Emacs crash." (x-select-enable-clipboard-manager killing boolean "24.1") ;; xsettings.c (font-use-system-font font-selection boolean "23.2") + ;; xwidget.c + (xwidget-webkit-disable-javascript xwidget boolean "30.1") ;; haikuterm.c (haiku-debug-on-fatal-error debug boolean "29.1") ;; haikufns.c @@ -906,6 +908,8 @@ since it could result in memory overflow and make Emacs crash." (symbol-name symbol)) ;; Any function from fontset.c will do. (fboundp 'new-fontset)) + ((string-match "xwidget-" (symbol-name symbol)) + (boundp 'xwidget-internal)) (t t)))) (if (not (boundp symbol)) ;; If variables are removed from C code, give an error here! diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 2fb79bb7b1d..cca01c8cb3a 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -116,13 +116,6 @@ buffers for this setting to take effect after setting it to nil." :type '(choice (const :tag "Do not store cookies" nil) file) :version "29.1") -(defcustom xwidget-webkit-disable-javascript nil - "If non-nil, disables the execution of JavaScript in xwidget webkit sessions. -You must kill all xwidget-webkit buffers for this setting to take -effect after changing it." - :type '(boolean) - :version "30.0") - ;;;###autoload (defun xwidget-webkit-browse-url (url &optional new-session) "Ask xwidget-webkit to browse URL. diff --git a/src/xwidget.c b/src/xwidget.c index 5b82ef6e840..557b1e60409 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -3973,9 +3973,9 @@ syms_of_xwidget (void) Vxwidget_view_list = Qnil; DEFVAR_BOOL("xwidget-webkit-disable-javascript", xwidget_webkit_disable_javascript, - doc: /* If non-nil, disables the execution of JavaScript in xwidget webkit sessions. -You must kill all xwidget-webkit buffers for this setting to take -effect after changing it. */); + doc: /* If non-nil, disable execution of JavaScript in xwidget webkit sessions. +You must kill all xwidget-webkit buffers for this setting to take effect +after changing it. */); xwidget_webkit_disable_javascript = false; Fprovide (intern ("xwidget-internal"), Qnil); -- cgit v1.2.3 From cb9ee24ea69be4a70f68cb2d564b23a55cb84216 Mon Sep 17 00:00:00 2001 From: Visuwesh Date: Sat, 9 Mar 2024 15:17:26 +0530 Subject: Add bounds-of-thing-at-point property for 'number' * lisp/thingatpt.el (thing-at-point-decimal-regexp) (thing-at-point-hexadecimal-regexp): Extract regexps from... (number-at-point): ...here. Use them in 'number-at-point'. (number): Add 'bounds-of-thing-at-point' property as `forward-word' does not always return the right boundary, e.g., in latex-mode buffers. (Bug#69239) --- lisp/thingatpt.el | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 83ddc640d35..7896ad984df 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -735,20 +735,33 @@ Signal an error if the entire string was not used." (let ((thing (thing-at-point 'symbol))) (if thing (intern thing)))) +(defvar thing-at-point-decimal-regexp + "-?[0-9]+\\.?[0-9]*" + "A regexp matching a decimal number.") + +(defvar thing-at-point-hexadecimal-regexp + "\\(0x\\|#x\\)\\([a-fA-F0-9]+\\)" + "A regexp matchin a hexadecimal number.") + ;;;###autoload (defun number-at-point () "Return the number at point, or nil if none is found. Decimal numbers like \"14\" or \"-14.5\", as well as hex numbers like \"0xBEEF09\" or \"#xBEEF09\", are recognized." (cond - ((thing-at-point-looking-at "\\(0x\\|#x\\)\\([a-fA-F0-9]+\\)" 500) + ((thing-at-point-looking-at thing-at-point-hexadecimal-regexp 500) (string-to-number (buffer-substring (match-beginning 2) (match-end 2)) 16)) - ((thing-at-point-looking-at "-?[0-9]+\\.?[0-9]*" 500) + ((thing-at-point-looking-at thing-at-point-decimal-regexp 500) (string-to-number (buffer-substring (match-beginning 0) (match-end 0)))))) +(put 'number 'bounds-of-thing-at-point + (lambda () + (and (or (thing-at-point-looking-at thing-at-point-hexadecimal-regexp 500) + (thing-at-point-looking-at thing-at-point-decimal-regexp 500)) + (cons (match-beginning 0) (match-end 0))))) (put 'number 'forward-op 'forward-word) (put 'number 'thing-at-point 'number-at-point) -- cgit v1.2.3 From fd0a6cb172dbae8779dae768fa8c475eb0af50ee Mon Sep 17 00:00:00 2001 From: StrawberryTea Date: Sat, 9 Mar 2024 15:37:44 -0600 Subject: ffap.el: Exclude angle brackets from file names in XML * lisp/ffap.el (ffap-string-at-point-mode-alist): Add elements for XML, to better recognize file names in XML buffers. Copyright-paperwork-exempt: yes --- lisp/ffap.el | 3 +++ 1 file changed, 3 insertions(+) (limited to 'lisp') diff --git a/lisp/ffap.el b/lisp/ffap.el index 5383f743878..b2b681b7c44 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1065,6 +1065,9 @@ If a given RFC isn't in these then `ffap-rfc-path' is offered." ;; (La)TeX: don't allow braces (latex-mode "--:\\\\$+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:") (tex-mode "--:\\\\$+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:") + ;; XML: don't allow angle brackets + (xml-mode "--:\\\\${}+@-Z_[:alpha:]~*?#" "{<@" "@>;.,!:}") + (nxml-mode "--:\\\\${}+@-Z_[:alpha:]~*?#" "{<@" "@>;.,!:}") ) "Alist of (MODE CHARS BEG END), where MODE is a symbol. This is possibly a major-mode name, or one of the symbols -- cgit v1.2.3 From 3807f380b3334205bfcbba88003ff96507c86fc4 Mon Sep 17 00:00:00 2001 From: Phil Hagelberg Date: Sat, 9 Mar 2024 15:36:11 -0800 Subject: bug#69685: Add language server for Fennel to eglot * lisp/progmodes/eglot.el (eglot-server-programs): Add fennel-ls language server. Copyright-paperwork-exempt: yes --- lisp/progmodes/eglot.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index afe3281361d..4ffaf5f8a0e 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -294,6 +294,7 @@ automatically)." (nickel-mode . ("nls")) ((nushell-mode nushell-ts-mode) . ("nu" "--lsp")) (gdscript-mode . ("localhost" 6008)) + (fennel-mode . ("fennel-ls")) ((fortran-mode f90-mode) . ("fortls")) (futhark-mode . ("futhark" "lsp")) ((lua-mode lua-ts-mode) . ,(eglot-alternatives -- cgit v1.2.3 From 6d1c1fca0aa7c5a1ff0254af3f89a34d5309ea0d Mon Sep 17 00:00:00 2001 From: Tim Landscheidt Date: Tue, 12 Mar 2024 00:21:06 +0000 Subject: ; Simplify (with-current-buffer (get-buffer ...) ...) There's no need to call 'get-buffer', since 'with-current-buffer' does that internally. * lisp/calendar/todo-mode.el (todo-merge-category): * lisp/comint.el (comint-dynamic-list-completions): * lisp/emacs-lisp/checkdoc.el (checkdoc-error): * lisp/emacs-lisp/debug.el (debug, debugger-record-expression): * lisp/emacs-lisp/eieio-opt.el (eieio-browse): * lisp/emacs-lisp/re-builder.el (reb-restart-font-lock): * lisp/erc/erc-dcc.el (erc-dcc-do-LIST-command): * lisp/eshell/em-unix.el (eshell-poor-mans-grep): * lisp/gnus/gnus-group.el (gnus-add-mark): * lisp/net/eww.el (eww-next-bookmark, eww-previous-bookmark): * lisp/net/sieve.el (sieve-upload): * lisp/net/tramp-cmds.el (tramp-cleanup-some-buffers): * lisp/obsolete/quickurl.el (quickurl-list-populate-buffer): * lisp/org/ob-calc.el: (org-babel-execute:calc): * lisp/org/org-agenda.el (org-agenda-use-sticky-p): * lisp/pcomplete.el (pcomplete-show-completions): * lisp/progmodes/bug-reference.el (bug-reference--try-setup-gnus-article): * lisp/progmodes/idlw-help.el (idlwave-highlight-linked-completions): * lisp/progmodes/verilog-mode.el (verilog-preprocess): * lisp/replace.el (occur-1): * lisp/term.el (term-dynamic-list-completions): * lisp/time.el (world-clock-update): * lisp/url/url-cache.el (url-store-in-cache): * lisp/vc/vc-cvs.el (vc-cvs-merge, vc-cvs-merge-news): * lisp/vc/vc-rcs.el (vc-rcs-system-release): * lisp/vc/vc-svn.el (vc-svn-merge, vc-svn-merge-news): * test/lisp/calendar/icalendar-tests.el (icalendar-tests--get-error-string-for-export): * test/lisp/erc/erc-dcc-tests.el (pcomplete/erc-mode/DCC--get-1flag) (pcomplete/erc-mode/DCC--get-2flags) (pcomplete/erc-mode/DCC--get-2flags-reverse): * test/lisp/erc/erc-networks-tests.el (erc-networks--rename-server-buffer--existing--noreuse): * test/lisp/erc/erc-scenarios-services-misc.el (erc-scenarios-services-misc--reconnect-retry-nick): * test/lisp/erc/erc-tests.el (erc--refresh-prompt): Replace (with-current-buffer (get-buffer ...) ...) with (with-current-buffer ...). --- lisp/calendar/todo-mode.el | 8 ++++---- lisp/comint.el | 2 +- lisp/emacs-lisp/checkdoc.el | 2 +- lisp/emacs-lisp/debug.el | 4 ++-- lisp/emacs-lisp/eieio-opt.el | 2 +- lisp/emacs-lisp/re-builder.el | 2 +- lisp/erc/erc-dcc.el | 2 +- lisp/eshell/em-unix.el | 2 +- lisp/gnus/gnus-group.el | 2 +- lisp/net/eww.el | 4 ++-- lisp/net/sieve.el | 2 +- lisp/net/tramp-cmds.el | 2 +- lisp/obsolete/quickurl.el | 2 +- lisp/org/ob-calc.el | 2 +- lisp/org/org-agenda.el | 2 +- lisp/pcomplete.el | 2 +- lisp/progmodes/bug-reference.el | 2 +- lisp/progmodes/idlw-help.el | 2 +- lisp/progmodes/verilog-mode.el | 2 +- lisp/replace.el | 2 +- lisp/term.el | 2 +- lisp/time.el | 2 +- lisp/url/url-cache.el | 2 +- lisp/vc/vc-cvs.el | 4 ++-- lisp/vc/vc-rcs.el | 2 +- lisp/vc/vc-svn.el | 4 ++-- test/lisp/calendar/icalendar-tests.el | 2 +- test/lisp/erc/erc-dcc-tests.el | 6 +++--- test/lisp/erc/erc-networks-tests.el | 2 +- test/lisp/erc/erc-scenarios-services-misc.el | 2 +- test/lisp/erc/erc-tests.el | 2 +- 31 files changed, 40 insertions(+), 40 deletions(-) (limited to 'lisp') diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index f2ee94ec8f7..12287299a7f 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -1612,7 +1612,7 @@ archive file and the source category is deleted." (garchive (concat (file-name-sans-extension gfile) ".toda")) (archived-count (todo-get-count 'archived)) here) - (with-current-buffer (get-buffer (find-file-noselect tfile)) + (with-current-buffer (find-file-noselect tfile) (widen) (let* ((inhibit-read-only t) (cbeg (progn @@ -1638,7 +1638,7 @@ archive file and the source category is deleted." (todo-count (todo-get-count 'todo cat)) (done-count (todo-get-count 'done cat))) ;; Merge into goal todo category. - (with-current-buffer (get-buffer (find-file-noselect gfile)) + (with-current-buffer (find-file-noselect gfile) (unless (derived-mode-p 'todo-mode) (todo-mode)) (widen) (goto-char (point-min)) @@ -1677,7 +1677,7 @@ archive file and the source category is deleted." (mapc (lambda (m) (set-marker m nil)) (list cbeg tbeg dbeg tend cend)))) (when (> archived-count 0) - (with-current-buffer (get-buffer (find-file-noselect tarchive)) + (with-current-buffer (find-file-noselect tarchive) (widen) (goto-char (point-min)) (let* ((inhibit-read-only t) @@ -1697,7 +1697,7 @@ archive file and the source category is deleted." (forward-line) (buffer-substring-no-properties (point) cend)))) ;; Merge into goal archive category, if it exists, else create it. - (with-current-buffer (get-buffer (find-file-noselect garchive)) + (with-current-buffer (find-file-noselect garchive) (let ((gbeg (when (re-search-forward (concat "^" (regexp-quote (concat todo-category-beg goal)) diff --git a/lisp/comint.el b/lisp/comint.el index 655ff30469c..a8fe095e99c 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3510,7 +3510,7 @@ the completions." ;; Read the next key, to process SPC. (let (key first) - (if (with-current-buffer (get-buffer "*Completions*") + (if (with-current-buffer "*Completions*" (setq-local comint-displayed-dynamic-completions completions) (setq key (read-key-sequence nil) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 02c11cae573..c22dfb2eb26 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -2794,7 +2794,7 @@ function called to create the messages." ": " msg))) (if (string= checkdoc-diagnostic-buffer "*warn*") (warn (apply #'concat text)) - (with-current-buffer (get-buffer checkdoc-diagnostic-buffer) + (with-current-buffer checkdoc-diagnostic-buffer (let ((inhibit-read-only t) (pt (point-max))) (goto-char pt) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 506b73f6fa2..60d14d11970 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -200,7 +200,7 @@ the debugger will not be entered." (let (debugger-value (debugger-previous-state (if (get-buffer "*Backtrace*") - (with-current-buffer (get-buffer "*Backtrace*") + (with-current-buffer "*Backtrace*" (debugger--save-buffer-state)))) (debugger-args args) (debugger-buffer (get-buffer-create "*Backtrace*")) @@ -651,7 +651,7 @@ Complete list of commands: (princ (debugger-eval-expression exp)) (terpri)) - (with-current-buffer (get-buffer debugger-record-buffer) + (with-current-buffer debugger-record-buffer (message "%s" (buffer-substring (line-beginning-position 0) (line-end-position 0))))) diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index 893f8cd7e7f..bf6be1690e4 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -50,7 +50,7 @@ variable `eieio-default-superclass'." (if (not root-class) (setq root-class 'eieio-default-superclass)) (cl-check-type root-class class) (display-buffer (get-buffer-create "*EIEIO OBJECT BROWSE*") t) - (with-current-buffer (get-buffer "*EIEIO OBJECT BROWSE*") + (with-current-buffer "*EIEIO OBJECT BROWSE*" (erase-buffer) (goto-char 0) (eieio-browse-tree root-class "" "") diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index 0a47cca0231..c5307f70d08 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -825,7 +825,7 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions." (defun reb-restart-font-lock () "Restart `font-lock-mode' to fit current regexp format." - (with-current-buffer (get-buffer reb-buffer) + (with-current-buffer reb-buffer (let ((font-lock-is-on font-lock-mode)) (font-lock-mode -1) (kill-local-variable 'font-lock-set-defaults) diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 522973a0156..b8e16df755b 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -619,7 +619,7 @@ It lists the current state of `erc-dcc-list' in an easy to read manner." (buffer-live-p (get-buffer (plist-get elt :file))) (plist-member elt :size)) (let ((byte-count (with-current-buffer - (get-buffer (plist-get elt :file)) + (plist-get elt :file) (+ (buffer-size) 0.0 erc-dcc-byte-count)))) (format " (%d%%)" diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 23028576f45..751f13cc715 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -789,7 +789,7 @@ available..." (ignore-errors (occur (car args)))) (if (get-buffer "*Occur*") - (with-current-buffer (get-buffer "*Occur*") + (with-current-buffer "*Occur*" (setq string (buffer-string)) (kill-buffer (current-buffer))))) (if string (insert string)) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index d562d052d82..71bfaa639fa 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -4638,7 +4638,7 @@ and the second element is the address." "Mark ARTICLE in GROUP with MARK, whether the group is displayed or not." (let ((buffer (gnus-summary-buffer-name group))) (if (gnus-buffer-live-p buffer) - (with-current-buffer (get-buffer buffer) + (with-current-buffer buffer (gnus-summary-add-mark article mark)) (gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists)) (list article))))) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 2936bc8f099..54847bdf396 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -2267,7 +2267,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks." (setq first t) (eww-read-bookmarks t) (eww-bookmark-prepare)) - (with-current-buffer (get-buffer "*eww bookmarks*") + (with-current-buffer "*eww bookmarks*" (when (and (not first) (not (eobp))) (forward-line 1)) @@ -2286,7 +2286,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks." (setq first t) (eww-read-bookmarks t) (eww-bookmark-prepare)) - (with-current-buffer (get-buffer "*eww bookmarks*") + (with-current-buffer "*eww bookmarks*" (if first (goto-char (point-max)) (beginning-of-line)) diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el index fddc6e21bcc..a6ba556e7ae 100644 --- a/lisp/net/sieve.el +++ b/lisp/net/sieve.el @@ -354,7 +354,7 @@ Used to bracket operations which move point in the sieve-buffer." (let ((script (buffer-string)) (script-name (file-name-sans-extension (buffer-name))) err) - (with-current-buffer (get-buffer sieve-buffer) + (with-current-buffer sieve-buffer (setq err (sieve-manage-putscript (or name sieve-buffer-script-name script-name) script sieve-manage-buffer)) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index a545a8e7273..d3af7a009ec 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -281,7 +281,7 @@ non-nil." ;; Remove all buffers with a remote default-directory which fit the hook. (dolist (name (tramp-list-remote-buffers)) (and (buffer-live-p (get-buffer name)) - (with-current-buffer (get-buffer name) + (with-current-buffer name (run-hook-with-args-until-success 'tramp-cleanup-some-buffers-hook)) (kill-buffer name)))) diff --git a/lisp/obsolete/quickurl.el b/lisp/obsolete/quickurl.el index 7393bebdce1..7da51a8a4a8 100644 --- a/lisp/obsolete/quickurl.el +++ b/lisp/obsolete/quickurl.el @@ -447,7 +447,7 @@ The key bindings for `quickurl-list-mode' are: (defun quickurl-list-populate-buffer () "Populate the `quickurl-list' buffer." - (with-current-buffer (get-buffer quickurl-list-buffer-name) + (with-current-buffer quickurl-list-buffer-name (let* ((sizes (or (cl-loop for url in quickurl-urls collect (length (quickurl-url-description url))) (list 20))) diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el index d335aab7499..f834f05cb6d 100644 --- a/lisp/org/ob-calc.el +++ b/lisp/org/ob-calc.el @@ -93,7 +93,7 @@ (mapcar #'org-trim (split-string (org-babel-expand-body:calc body params) "[\n\r]")))) (save-excursion - (with-current-buffer (get-buffer "*Calculator*") + (with-current-buffer "*Calculator*" (prog1 (calc-eval (calc-top 1)) (calc-pop 1))))) diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index f8195a053bc..06249ed48fa 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -3883,7 +3883,7 @@ generating a new one." ;; buffer found (get-buffer org-agenda-buffer-name) ;; C-u parameter is same as last call - (with-current-buffer (get-buffer org-agenda-buffer-name) + (with-current-buffer org-agenda-buffer-name (and (equal current-prefix-arg org-agenda-last-prefix-arg) diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 196c5f159cd..0b34712a50c 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -1140,7 +1140,7 @@ Typing SPC flushes the help buffer." (let (event) (prog1 (catch 'done - (while (with-current-buffer (get-buffer "*Completions*") + (while (with-current-buffer "*Completions*" (setq event (read-event))) (cond ((eq event ?\s) diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 29ff521253b..977a3d72cb7 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -493,7 +493,7 @@ and set it if applicable." ;; the values of the From, To, and Cc headers. (let (header-values) (with-current-buffer - (get-buffer gnus-original-article-buffer) + gnus-original-article-buffer (save-excursion (goto-char (point-min)) ;; The Newsgroup is omitted because we already matched diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index 217b2ab6691..7bed69a738b 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -631,7 +631,7 @@ Needs additional info stored in global `idlwave-completion-help-info'." Those words in `idlwave-completion-help-links' have links. The `idlwave-help-link' face is used for this." (if idlwave-highlight-help-links-in-completion - (with-current-buffer (get-buffer "*Completions*") + (with-current-buffer "*Completions*" (save-excursion (let* ((case-fold-search t) (props (list 'face 'idlwave-help-link)) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 7af78f2229a..a83bad0e8ed 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -5803,7 +5803,7 @@ FILENAME to find directory to run in, or defaults to `buffer-file-name'." (dir (file-name-directory (or filename buffer-file-name))) (cmd (concat "cd " dir "; " command))) (with-output-to-temp-buffer "*Verilog-Preprocessed*" - (with-current-buffer (get-buffer "*Verilog-Preprocessed*") + (with-current-buffer "*Verilog-Preprocessed*" (insert (concat "// " cmd "\n")) (call-process shell-file-name nil t nil shell-command-switch cmd) (verilog-mode) diff --git a/lisp/replace.el b/lisp/replace.el index 49e7c85c487..01a892bbba7 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1931,7 +1931,7 @@ See also `multi-occur'." (lambda (boo) (buffer-name (if (overlayp boo) (overlay-buffer boo) boo))) active-bufs)) - (with-current-buffer (get-buffer buf-name) + (with-current-buffer buf-name (rename-uniquely))) ;; Now find or create the output buffer. diff --git a/lisp/term.el b/lisp/term.el index 2ce0c2b5e79..3a0ecc041ca 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -4342,7 +4342,7 @@ Typing SPC flushes the help buffer." (display-completion-list (sort completions 'string-lessp))) (message "Hit space to flush") (let (key first) - (if (with-current-buffer (get-buffer "*Completions*") + (if (with-current-buffer "*Completions*" (setq key (read-key-sequence nil) first (aref key 0)) (and (consp first) diff --git a/lisp/time.el b/lisp/time.el index 9b932e945ba..a8d3ab9c813 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -611,7 +611,7 @@ To turn off the world time display, go to the window and type \\[quit-window]." (defun world-clock-update (&optional _arg _noconfirm) "Update the `world-clock' buffer." (if (get-buffer world-clock-buffer-name) - (with-current-buffer (get-buffer world-clock-buffer-name) + (with-current-buffer world-clock-buffer-name (let ((op (point))) (world-clock-display (time--display-world-list)) (goto-char op))) diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el index 0d27321cc47..ce6de2b3ee4 100644 --- a/lisp/url/url-cache.el +++ b/lisp/url/url-cache.el @@ -70,7 +70,7 @@ FILE can be created or overwritten." ;;;###autoload (defun url-store-in-cache (&optional buff) "Store buffer BUFF in the cache." - (with-current-buffer (get-buffer (or buff (current-buffer))) + (with-current-buffer (or buff (current-buffer)) (let ((fname (url-cache-create-filename (url-view-url t)))) (if (url-cache-prepare fname) (let ((coding-system-for-write 'binary)) diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 52039f8da74..63b566b0afe 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -476,7 +476,7 @@ The changes are between FIRST-REVISION and SECOND-REVISION." (concat "-j" first-revision) (concat "-j" second-revision)) (vc-file-setprop file 'vc-state 'edited) - (with-current-buffer (get-buffer "*vc*") + (with-current-buffer "*vc*" (goto-char (point-min)) (if (re-search-forward "conflicts during merge" nil t) (progn @@ -495,7 +495,7 @@ The changes are between FIRST-REVISION and SECOND-REVISION." (vc-cvs-command nil nil file "update") ;; Analyze the merge result reported by CVS, and set ;; file properties accordingly. - (with-current-buffer (get-buffer "*vc*") + (with-current-buffer "*vc*" (goto-char (point-min)) ;; get new working revision (if (re-search-forward diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index 1a43b440d18..33377ce1cc8 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -1177,7 +1177,7 @@ variable `vc-rcs-release' is set to the returned value." (or vc-rcs-release (setq vc-rcs-release (or (and (zerop (vc-do-command "*vc*" nil "rcs" nil "-V")) - (with-current-buffer (get-buffer "*vc*") + (with-current-buffer "*vc*" (vc-parse-buffer "^RCS version \\([0-9.]+ *.*\\)" 1))) 'unknown)))) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 96baa642b44..ae281e54519 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -436,7 +436,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION." (concat first-version ":" second-version) first-version)) (vc-file-setprop file 'vc-state 'edited) - (with-current-buffer (get-buffer "*vc*") + (with-current-buffer "*vc*" (goto-char (point-min)) (if (looking-at "C ") 1 ; signal conflict @@ -450,7 +450,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION." (vc-svn-command nil 0 file "update") ;; Analyze the merge result reported by SVN, and set ;; file properties accordingly. - (with-current-buffer (get-buffer "*vc*") + (with-current-buffer "*vc*" (goto-char (point-min)) ;; get new working revision (if (re-search-forward diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el index 7d3af25ea49..39ad735a789 100644 --- a/test/lisp/calendar/icalendar-tests.el +++ b/test/lisp/calendar/icalendar-tests.el @@ -68,7 +68,7 @@ (with-temp-buffer (insert diary-string) (icalendar-export-region (point-min) (point-max) file)) - (with-current-buffer (get-buffer "*icalendar-errors*") + (with-current-buffer "*icalendar-errors*" (buffer-string)))) ;; ====================================================================== diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el index a2fb0392727..d4b5919a1cc 100644 --- a/test/lisp/erc/erc-dcc-tests.el +++ b/test/lisp/erc/erc-dcc-tests.el @@ -243,7 +243,7 @@ (delete-region (point) (point-max)) (insert "/dcc get -") (call-interactively #'completion-at-point) - (with-current-buffer (get-buffer "*Completions*") + (with-current-buffer "*Completions*" (goto-char (point-min)) (search-forward "-s") (search-forward "-t")) @@ -264,7 +264,7 @@ (delete-region (point) (point-max)) (insert "/dcc get -") (call-interactively #'completion-at-point) - (with-current-buffer (get-buffer "*Completions*") + (with-current-buffer "*Completions*" (goto-char (point-min)) (search-forward "-s") (search-forward "-t")) @@ -289,7 +289,7 @@ (delete-region (point) (point-max)) (insert "/dcc get -") (call-interactively #'completion-at-point) - (with-current-buffer (get-buffer "*Completions*") + (with-current-buffer "*Completions*" (goto-char (point-min)) (search-forward "-s") (search-forward "-t")) diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index 90b8aa99741..0d8861f2167 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el @@ -1349,7 +1349,7 @@ (should-not (erc-server-process-alive (should (get-buffer "#chan/irc.foonet.org")))) - (with-current-buffer (get-buffer "#chan/irc.foonet.org") + (with-current-buffer "#chan/irc.foonet.org" (should-not erc-server-connected) (should (eq erc-server-process old-proc)) (erc-with-server-buffer diff --git a/test/lisp/erc/erc-scenarios-services-misc.el b/test/lisp/erc/erc-scenarios-services-misc.el index ab4a97c5724..47d0bcff41a 100644 --- a/test/lisp/erc/erc-scenarios-services-misc.el +++ b/test/lisp/erc/erc-scenarios-services-misc.el @@ -186,7 +186,7 @@ (funcall expect 10 "Last login from") (funcall expect 10 "Your new nickname is tester"))) - (with-current-buffer (get-buffer "#test") + (with-current-buffer "#test" (funcall expect 10 "tester ") (funcall expect 10 "was created on")))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 6809d9db41d..3e8ddef3731 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -382,7 +382,7 @@ (should-not (search-forward (rx (or "9" "10") ">") nil t))))) (ert-info ("Query buffer") - (with-current-buffer (get-buffer "bob") + (with-current-buffer "bob" (goto-char erc-insert-marker) (should (looking-at-p "bob@ServNet 14>")) (goto-char erc-input-marker) -- cgit v1.2.3 From c94d680f6eb46a47549633c7076fe32660b3cd42 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 12 Mar 2024 16:01:57 -0500 Subject: Handle the case where 'vtable-update-object' doesn't find old object * lisp/emacs-lisp/vtable.el (vtable-update-object): If OLD-OBJECT is not found, don't call ELT, since SEQ-POSITION may return nil. (Bug#69664) --- lisp/emacs-lisp/vtable.el | 44 ++++++++++++++++++++++---------------------- 1 file changed, 22 insertions(+), 22 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 5cf8d8854bb..15a430f5c26 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -300,28 +300,28 @@ If it can't be found, return nil and don't move point." (error "Can't find the old object")) (setcar (cdr objects) object)) ;; Then update the cache... - (let* ((line-number (seq-position (car (vtable--cache table)) old-object - (lambda (a b) - (equal (car a) b)))) - (line (elt (car (vtable--cache table)) line-number))) - (unless line - (error "Can't find cached object")) - (setcar line object) - (setcdr line (vtable--compute-cached-line table object)) - ;; ... and redisplay the line in question. - (save-excursion - (vtable-goto-object old-object) - (let ((keymap (get-text-property (point) 'keymap)) - (start (point))) - (delete-line) - (vtable--insert-line table line line-number - (nth 1 (vtable--cache table)) - (vtable--spacer table)) - (add-text-properties start (point) (list 'keymap keymap - 'vtable table)))) - ;; We may have inserted a non-numerical value into a previously - ;; all-numerical table, so recompute. - (vtable--recompute-numerical table (cdr line))))) + (if-let ((line-number (seq-position (car (vtable--cache table)) old-object + (lambda (a b) + (equal (car a) b)))) + (line (elt (car (vtable--cache table)) line-number))) + (progn + (setcar line object) + (setcdr line (vtable--compute-cached-line table object)) + ;; ... and redisplay the line in question. + (save-excursion + (vtable-goto-object old-object) + (let ((keymap (get-text-property (point) 'keymap)) + (start (point))) + (delete-line) + (vtable--insert-line table line line-number + (nth 1 (vtable--cache table)) + (vtable--spacer table)) + (add-text-properties start (point) (list 'keymap keymap + 'vtable table)))) + ;; We may have inserted a non-numerical value into a previously + ;; all-numerical table, so recompute. + (vtable--recompute-numerical table (cdr line))) + (error "Can't find cached object in vtable")))) (defun vtable-remove-object (table object) "Remove OBJECT from TABLE. -- cgit v1.2.3 From a7057745f5ef903a2655c6d9e7813168e361baf7 Mon Sep 17 00:00:00 2001 From: Liu Hui Date: Mon, 26 Feb 2024 18:46:36 +0800 Subject: Detect the readline support for Python shell completion * lisp/progmodes/python.el (python-shell-comint-watch-for-first-prompt-output-filter): Detect the readline support. (python-shell-readline-completer-delims): Update docstring. (python-shell-completion-native-setup): Move the readline detection code to ... (python-shell-readline-detect): ... new function. (python-shell-completion-native-turn-on-maybe): Skip if Python has no readline support. (python-shell-completion-at-point): Respect the delimiter of readline completer in non-native completion. * test/lisp/progmodes/python-tests.el (python-shell-completion-at-point-1) (python-shell-completion-at-point-native-1) (python-completion-at-point-1, python-completion-at-point-2) (python-completion-at-point-pdb-1) (python-completion-at-point-while-running-1) (python-completion-at-point-native-1) (python-completion-at-point-native-2) (python-completion-at-point-native-with-ffap-1) (python-completion-at-point-native-with-eldoc-1): Skip tests if Python has no readline support. (python-shell-completion-at-point-jedi-completer): Add test for non-native Python shell completion. (bug#68559) --- lisp/progmodes/python.el | 29 ++++++++++++++++++++++------- test/lisp/progmodes/python-tests.el | 31 ++++++++++++++++++++++++++----- 2 files changed, 48 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 1016655cb62..8279617b6e7 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -3601,6 +3601,7 @@ The coding cookie regexp is specified in PEP 263.") (python-shell-send-string-no-output python-shell-eval-file-setup-code)) (with-current-buffer (current-buffer) (let ((inhibit-quit nil)) + (python-shell-readline-detect) (run-hooks 'python-shell-first-prompt-hook)))))) output) @@ -4361,7 +4362,23 @@ When a match is found, native completion is disabled." (defvar python-shell-readline-completer-delims nil "Word delimiters used by the readline completer. -It is automatically set by Python shell.") +It is automatically set by Python shell. An empty string means no +characters are considered delimiters and the readline completion +considers the entire line of input. A value of nil means the Python +shell has no readline support.") + +(defun python-shell-readline-detect () + "Detect the readline support for Python shell completion." + (let* ((process (python-shell-get-process)) + (output (python-shell-send-string-no-output " +try: + import readline + print(readline.get_completer_delims()) +except: + print('No readline support')" process))) + (setq-local python-shell-readline-completer-delims + (unless (string-search "No readline support" output) + (string-trim-right output))))) (defvar python-shell-completion-native-redirect-buffer " *Python completions redirect*" @@ -4501,10 +4518,6 @@ def __PYTHON_EL_native_completion_setup(): __PYTHON_EL_native_completion_setup()" process))) (when (string-match-p "python\\.el: native completion setup loaded" output) - (setq-local python-shell-readline-completer-delims - (string-trim-right - (python-shell-send-string-no-output - "import readline; print(readline.get_completer_delims())"))) (python-shell-completion-native-try)))) (defun python-shell-completion-native-turn-off (&optional msg) @@ -4533,7 +4546,8 @@ With argument MSG show activation/deactivation message." (cond ((python-shell-completion-native-interpreter-disabled-p) (python-shell-completion-native-turn-off msg)) - ((python-shell-completion-native-setup) + ((and python-shell-readline-completer-delims + (python-shell-completion-native-setup)) (when msg (message "Shell native completion is enabled."))) (t @@ -4705,7 +4719,8 @@ using that one instead of current buffer's process." (with-current-buffer (process-buffer process) (if python-shell-completion-native-enable (string= python-shell-readline-completer-delims "") - (string-match-p "ipython[23]?\\'" python-shell-interpreter))))) + (or (string-match-p "ipython[23]?\\'" python-shell-interpreter) + (equal python-shell-readline-completer-delims "")))))) (start (if (< (point) line-start) (point) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 1ceee690cfb..e11440cdb5b 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -4783,6 +4783,7 @@ def foo(): (python-tests-with-temp-buffer-with-shell "" (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims) (insert "import abc") (comint-send-input) (python-tests-shell-wait-for-prompt) @@ -4797,6 +4798,7 @@ def foo(): "" (python-shell-completion-native-turn-on) (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims) (insert "import abc") (comint-send-input) (python-tests-shell-wait-for-prompt) @@ -4883,11 +4885,14 @@ def foo(): (python-tests-with-temp-buffer-with-shell "" (python-shell-with-shell-buffer - (python-shell-completion-native-turn-on) - (skip-unless (string= python-shell-readline-completer-delims "")) - (python-tests--completion-module) - (python-tests--completion-parameters) - (python-tests--completion-extra-context))))) + (skip-unless (string= python-shell-readline-completer-delims "")) + (python-shell-completion-native-turn-off) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-shell-completion-native-turn-on) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-tests--completion-extra-context))))) (ert-deftest python-shell-completion-at-point-ipython () "Check if Python shell completion works for IPython." @@ -4924,6 +4929,8 @@ def foo(): import abc " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) (goto-char (point-max)) @@ -4940,6 +4947,8 @@ import abc import abc " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) (python-shell-with-shell-buffer @@ -4959,6 +4968,8 @@ pdb.set_trace() print('Hello') " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) (goto-char (point-max)) @@ -4975,6 +4986,8 @@ import time time.sleep(3) " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-send-buffer) (goto-char (point-max)) (insert "time.") @@ -4987,6 +5000,8 @@ time.sleep(3) import abc " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-completion-native-turn-on) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) @@ -5004,6 +5019,8 @@ import abc import abc " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-completion-native-turn-on) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) @@ -5020,6 +5037,8 @@ import abc import abc " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-completion-native-turn-on) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) @@ -5036,6 +5055,8 @@ import abc import abc " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-completion-native-turn-on) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) -- cgit v1.2.3 From eae2c73edb3f09a06a31a38edd28e9751626e761 Mon Sep 17 00:00:00 2001 From: Pankaj Jangid Date: Thu, 14 Mar 2024 17:11:43 +0530 Subject: Add language server for Move to eglot * lisp/progmodes/eglot.el (eglot-server-programs): Added 'move-analyzer' language server. (Bug#69796) --- lisp/progmodes/eglot.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 4ffaf5f8a0e..b3fd104a227 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -295,6 +295,7 @@ automatically)." ((nushell-mode nushell-ts-mode) . ("nu" "--lsp")) (gdscript-mode . ("localhost" 6008)) (fennel-mode . ("fennel-ls")) + (move-mode . ("move-analyzer")) ((fortran-mode f90-mode) . ("fortls")) (futhark-mode . ("futhark" "lsp")) ((lua-mode lua-ts-mode) . ,(eglot-alternatives -- cgit v1.2.3 From f3deaa117acfc975be3edbe8461b18fc29b4adf0 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 14 Mar 2024 19:29:16 +0200 Subject: Context menu for project (bug#69566) * lisp/menu-bar.el (menu-bar-project-item): New variable from 'project-menu-entry'. (menu-bar-tools-menu): Use 'menu-bar-project-item'. * lisp/mouse.el (context-menu-functions): Add 'context-menu-project' to choice. (context-menu-project): New function. * lisp/progmodes/project.el (project-menu-entry): Remove variable. (project-mode-line-map): Use 'menu-bar-project-item' instead of 'project-menu-entry'. --- lisp/menu-bar.el | 5 ++++- lisp/mouse.el | 7 +++++++ lisp/progmodes/project.el | 6 ++---- 3 files changed, 13 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 5b290899ff5..320fabb54cf 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1838,6 +1838,9 @@ mail status in mode line")) (bindings--define-key menu [project-open-file] '(menu-item "Open File..." project-find-file :help "Open an existing file that belongs to current project")) menu)) +(defvar menu-bar-project-item + `(menu-item "Project" ,menu-bar-project-menu)) + (defun menu-bar-read-mail () "Read mail using `read-mail-command'." (interactive) @@ -1925,7 +1928,7 @@ mail status in mode line")) :help "Start language server suitable for this buffer's major-mode")) (bindings--define-key menu [project] - `(menu-item "Project" ,menu-bar-project-menu)) + menu-bar-project-item) (bindings--define-key menu [ede] '(menu-item "Project Support (EDE)" diff --git a/lisp/mouse.el b/lisp/mouse.el index 26835437c08..cef88dede8a 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -393,6 +393,7 @@ and should return the same menu with changes such as added new menu items." (function-item context-menu-local) (function-item context-menu-minor) (function-item context-menu-buffers) + (function-item context-menu-project) (function-item context-menu-vc) (function-item context-menu-ffap) (function-item hi-lock-context-menu) @@ -533,6 +534,12 @@ Some context functions add menu items below the separator." (mouse-buffer-menu-keymap)) menu) +(defun context-menu-project (menu _click) + "Populate MENU with project commands." + (define-key-after menu [separator-project] menu-bar-separator) + (define-key-after menu [project-menu] menu-bar-project-item) + menu) + (defun context-menu-vc (menu _click) "Populate MENU with Version Control commands." (define-key-after menu [separator-vc] menu-bar-separator) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 9622b1b6768..4284ea6edc6 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -2140,12 +2140,10 @@ is part of the default mode line beginning with Emacs 30." :group 'project :version "30.1") -(defvar project-menu-entry - `(menu-item "Project" ,(bound-and-true-p menu-bar-project-menu))) - (defvar project-mode-line-map (let ((map (make-sparse-keymap))) - (define-key map [mode-line down-mouse-1] project-menu-entry) + (define-key map [mode-line down-mouse-1] + (bound-and-true-p menu-bar-project-item)) map)) (defvar project-mode-line-face nil -- cgit v1.2.3 From bd6b64e0a8856a735b484f0482af0e937eb585d3 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 14 Mar 2024 19:37:44 +0200 Subject: * lisp/progmodes/project.el: Don't run modes from .dir-locals.el. (project--value-in-dir): Use 'alist-get' on 'file-local-variables-alist' to avoid calling 'hack-local-variables-apply' via 'hack-dir-local-variables-non-file-buffer' because it might enable undesirable modes such as flyspell-mode in a temporary buffer (bug#69740). --- lisp/progmodes/project.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 4284ea6edc6..a7c164f5857 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -808,8 +808,9 @@ DIRS must contain directory names." (with-temp-buffer (setq default-directory dir) (let ((enable-local-variables :all)) - (hack-dir-local-variables-non-file-buffer)) - (symbol-value var))) + (hack-dir-local-variables)) + ;; Don't use `hack-local-variables-apply' to avoid setting modes. + (alist-get var file-local-variables-alist))) (cl-defmethod project-buffers ((project (head vc))) (let* ((root (expand-file-name (file-name-as-directory (project-root project)))) -- cgit v1.2.3 From f03f14165ed51148b72b431ac99c4a4829bb1a7f Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 14 Mar 2024 20:11:33 +0200 Subject: * lisp/textmodes/flyspell.el (flyspell-check-changes): New user option. (flyspell--mode-on): Add flyspell-check-changes to post-command-hook when flyspell-check-changes is non-nil. (flyspell--mode-off): Remove flyspell-check-changes from post-command-hook. (flyspell-check-changes): New function (bug#61874). --- etc/NEWS | 5 +++++ lisp/textmodes/flyspell.el | 27 ++++++++++++++++++++++++++- 2 files changed, 31 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index 2985169ea91..327042f9d20 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1129,6 +1129,11 @@ distracting and easily confused with actual code, or a significant early aid that relieves you from moving the buffer or reaching for the mouse to consult an error message. +** Flyspell + +*** New user option 'flyspell-check-changes'. +It checks only edited text. + ** JS mode. The binding 'M-.' has been removed from the major mode keymaps in 'js-mode' and 'js-ts-mode', having it default to the global binding diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index de59294e9f0..d64e4d601f7 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -288,6 +288,12 @@ If this variable is nil, all regions are treated as small." "The key binding for flyspell auto correction." :type 'key-sequence) +(defcustom flyspell-check-changes nil + "Check only on moving point from the edited word. +Unlike the default behavior, don't check when moving point without editing." + :type 'boolean + :version "30.1") + ;;*---------------------------------------------------------------------*/ ;;* Mode specific options */ ;;* ------------------------------------------------------------- */ @@ -610,7 +616,9 @@ are both non-nil." (flyspell-accept-buffer-local-defs 'force) (flyspell-delay-commands) (flyspell-deplacement-commands) - (add-hook 'post-command-hook (function flyspell-post-command-hook) t t) + (if flyspell-check-changes + (add-hook 'post-command-hook (function flyspell-check-changes) t t) + (add-hook 'post-command-hook (function flyspell-post-command-hook) t t)) (add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t) (add-hook 'after-change-functions 'flyspell-after-change-function nil t) (add-hook 'hack-local-variables-hook @@ -709,6 +717,7 @@ has been used, the current word is not checked." ;;;###autoload (defun flyspell--mode-off () "Turn Flyspell mode off." + (remove-hook 'post-command-hook (function flyspell-check-changes) t) (remove-hook 'post-command-hook (function flyspell-post-command-hook) t) (remove-hook 'pre-command-hook (function flyspell-pre-command-hook) t) (remove-hook 'after-change-functions 'flyspell-after-change-function t) @@ -990,6 +999,22 @@ Mostly we check word delimiters." (setq flyspell-changes (cdr flyspell-changes)))) (setq flyspell-previous-command command))))) +(defun flyspell-check-changes () + "The `post-command-hook' used by flyspell to check only edits. +It checks only on moving point from the edited word, +not when moving point without editing." + (when flyspell-mode + (with-local-quit + (when (consp flyspell-changes) + (let ((start (car (car flyspell-changes))) + (stop (cdr (car flyspell-changes))) + (word (save-excursion (flyspell-get-word)))) + (unless (and word (<= (nth 1 word) start) (>= (nth 2 word) stop)) + (save-excursion + (goto-char start) + (flyspell-word)) + (setq flyspell-changes nil))))))) + ;;*---------------------------------------------------------------------*/ ;;* flyspell-notify-misspell ... */ ;;*---------------------------------------------------------------------*/ -- cgit v1.2.3 From c8c0d0a9550620adb111bf5d9e0155332498a6bf Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 14 Mar 2024 22:00:14 -0400 Subject: (customize-mode): Fix bug#69501 * lisp/cus-edit.el (customize-mode): Use the predicate arg of `completing-read` instead of binding `completion-regexp-list`. --- lisp/cus-edit.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 8fad51dc116..f004002333b 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1159,14 +1159,15 @@ argument or if the current major mode has no known group, prompt for the MODE to customize." (interactive (list - (let ((completion-regexp-list '("-mode\\'")) - (group (custom-group-of-mode major-mode))) + (let ((group (custom-group-of-mode major-mode))) (if (and group (not current-prefix-arg)) major-mode (intern (completing-read (format-prompt "Mode" (and group major-mode)) obarray - 'custom-group-of-mode + (lambda (s) + (and (string-match "-mode\\'" (symbol-name s)) + (custom-group-of-mode s))) t nil nil (if group (symbol-name major-mode)))))))) (customize-group (custom-group-of-mode mode))) -- cgit v1.2.3 From 9422a6737447b186ca017929da79985cef7898a8 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 14 Mar 2024 22:15:41 -0400 Subject: (set-auto-mode): Streamline to fix bug#67795 The old code tested if the mode function is `fboundp` but in an inconsistent way and without paying attention to `major-mode-remap`. * lisp/files.el (set-auto-mode-0): Return `:keep` rather than nil if the mode was already set. And emit a warning when the mode function doesn't exist. (set-auto-mode): Remove checks that the mode function exists now that `set-auto-mode-0` does it for us. Adjust to the new return values of that function, and simplify the code using a big `or` instead of a sequence of steps each setting&testing `done`. (hack-local-variables--find-variables): Use `major-mode-remap` when skipping the "mode:" entries that specify modes we don't have. Also, when (eq handle-mode t), don't bother building a list of results only to return a single element in the end. --- lisp/files.el | 231 ++++++++++++++++++++++++++++++---------------------------- 1 file changed, 118 insertions(+), 113 deletions(-) (limited to 'lisp') diff --git a/lisp/files.el b/lisp/files.el index 3ca4f047144..766ed573392 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3425,7 +3425,7 @@ set the major mode only if that would change it. In other words we don't actually set it to the same mode the buffer already has." ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*- (let ((try-locals (not (inhibit-local-variables-p))) - end done mode modes) + end modes) ;; Once we drop the deprecated feature where mode: is also allowed to ;; specify minor-modes (ie, there can be more than one "mode:"), we can ;; remove this section and just let (hack-local-variables t) handle it. @@ -3456,100 +3456,96 @@ we don't actually set it to the same mode the buffer already has." (push (intern (concat (downcase (buffer-substring (point) end)) "-mode")) modes)))) - ;; If we found modes to use, invoke them now, outside the save-excursion. - (if modes - (catch 'nop - (dolist (mode (nreverse modes)) - (if (not (functionp mode)) - (message "Ignoring unknown mode `%s'" mode) - (setq done t) - (or (set-auto-mode-0 mode keep-mode-if-same) - ;; continuing would call minor modes again, toggling them off - (throw 'nop nil)))))) - ;; Check for auto-mode-alist entry in dir-locals. - (unless done - (with-demoted-errors "Directory-local variables error: %s" - ;; Note this is a no-op if enable-local-variables is nil. - (let* ((mode-alist (cdr (hack-dir-local--get-variables - (lambda (key) (eq key 'auto-mode-alist)))))) - (setq done (set-auto-mode--apply-alist mode-alist - keep-mode-if-same t))))) - (and (not done) - (setq mode (hack-local-variables t (not try-locals))) - (not (memq mode modes)) ; already tried and failed - (if (not (functionp mode)) - (message "Ignoring unknown mode `%s'" mode) - (setq done t) - (set-auto-mode-0 mode keep-mode-if-same))) - ;; If we didn't, look for an interpreter specified in the first line. - ;; As a special case, allow for things like "#!/bin/env perl", which - ;; finds the interpreter anywhere in $PATH. - (and (not done) - (setq mode (save-excursion - (goto-char (point-min)) - (if (looking-at auto-mode-interpreter-regexp) - (match-string 2)))) - ;; Map interpreter name to a mode, signaling we're done at the - ;; same time. - (setq done (assoc-default - (file-name-nondirectory mode) - (mapcar (lambda (e) - (cons - (format "\\`%s\\'" (car e)) - (cdr e))) - interpreter-mode-alist) - #'string-match-p)) - ;; If we found an interpreter mode to use, invoke it now. - (set-auto-mode-0 done keep-mode-if-same)) - ;; Next try matching the buffer beginning against magic-mode-alist. - (unless done - (if (setq done (save-excursion - (goto-char (point-min)) - (save-restriction - (narrow-to-region (point-min) - (min (point-max) - (+ (point-min) magic-mode-regexp-match-limit))) - (assoc-default - nil magic-mode-alist - (lambda (re _dummy) - (cond - ((functionp re) - (funcall re)) - ((stringp re) - (let ((case-fold-search nil)) - (looking-at re))) - (t - (error - "Problem in magic-mode-alist with element %s" - re)))))))) - (set-auto-mode-0 done keep-mode-if-same))) - ;; Next compare the filename against the entries in auto-mode-alist. - (unless done - (setq done (set-auto-mode--apply-alist auto-mode-alist - keep-mode-if-same nil))) - ;; Next try matching the buffer beginning against magic-fallback-mode-alist. - (unless done - (if (setq done (save-excursion - (goto-char (point-min)) - (save-restriction - (narrow-to-region (point-min) - (min (point-max) - (+ (point-min) magic-mode-regexp-match-limit))) - (assoc-default nil magic-fallback-mode-alist - (lambda (re _dummy) - (cond - ((functionp re) - (funcall re)) - ((stringp re) - (let ((case-fold-search nil)) - (looking-at re))) - (t - (error - "Problem with magic-fallback-mode-alist element: %s" - re)))))))) - (set-auto-mode-0 done keep-mode-if-same))) - (unless done - (set-buffer-major-mode (current-buffer))))) + (or + ;; If we found modes to use, invoke them now, outside the save-excursion. + ;; Presume `modes' holds a major mode followed by minor modes. + (let ((done ())) + (dolist (mode (nreverse modes)) + (if (eq done :keep) + ;; `keep-mode-if-same' is set and the (major) mode + ;; was already set. Refrain from calling the following + ;; minor modes since they have already been set. + ;; It was especially important in the past when calling + ;; minor modes without an arg would toggle them, but it's + ;; still preferable to avoid re-enabling them, + nil + (let ((res (set-auto-mode-0 mode keep-mode-if-same))) + (setq done (or res done))))) + done) + ;; Check for auto-mode-alist entry in dir-locals. + (with-demoted-errors "Directory-local variables error: %s" + ;; Note this is a no-op if enable-local-variables is nil. + (let* ((mode-alist (cdr (hack-dir-local--get-variables + (lambda (key) (eq key 'auto-mode-alist)))))) + (set-auto-mode--apply-alist mode-alist keep-mode-if-same t))) + (let ((mode (hack-local-variables t (not try-locals)))) + (unless (memq mode modes) ; already tried and failed + (set-auto-mode-0 mode keep-mode-if-same))) + ;; If we didn't, look for an interpreter specified in the first line. + ;; As a special case, allow for things like "#!/bin/env perl", which + ;; finds the interpreter anywhere in $PATH. + (when-let + ((interp (save-excursion + (goto-char (point-min)) + (if (looking-at auto-mode-interpreter-regexp) + (match-string 2)))) + ;; Map interpreter name to a mode, signaling we're done at the + ;; same time. + (mode (assoc-default + (file-name-nondirectory interp) + (mapcar (lambda (e) + (cons + (format "\\`%s\\'" (car e)) + (cdr e))) + interpreter-mode-alist) + #'string-match-p))) + ;; If we found an interpreter mode to use, invoke it now. + (set-auto-mode-0 mode keep-mode-if-same)) + ;; Next try matching the buffer beginning against magic-mode-alist. + (let ((mode (save-excursion + (goto-char (point-min)) + (save-restriction + (narrow-to-region (point-min) + (min (point-max) + (+ (point-min) magic-mode-regexp-match-limit))) + (assoc-default + nil magic-mode-alist + (lambda (re _dummy) + (cond + ((functionp re) + (funcall re)) + ((stringp re) + (let ((case-fold-search nil)) + (looking-at re))) + (t + (error + "Problem in magic-mode-alist with element %s" + re))))))))) + (set-auto-mode-0 mode keep-mode-if-same)) + ;; Next compare the filename against the entries in auto-mode-alist. + (set-auto-mode--apply-alist auto-mode-alist + keep-mode-if-same nil) + ;; Next try matching the buffer beginning against magic-fallback-mode-alist. + (let ((mode (save-excursion + (goto-char (point-min)) + (save-restriction + (narrow-to-region (point-min) + (min (point-max) + (+ (point-min) magic-mode-regexp-match-limit))) + (assoc-default nil magic-fallback-mode-alist + (lambda (re _dummy) + (cond + ((functionp re) + (funcall re)) + ((stringp re) + (let ((case-fold-search nil)) + (looking-at re))) + (t + (error + "Problem with magic-fallback-mode-alist element: %s" + re))))))))) + (set-auto-mode-0 mode keep-mode-if-same)) + (set-buffer-major-mode (current-buffer))))) (defvar-local set-auto-mode--last nil "Remember the mode we have set via `set-auto-mode-0'.") @@ -3583,18 +3579,29 @@ and it is meant to be modified by packages rather than users.") "Apply MODE and return it. If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is chased of any aliases and compared to current major mode. If they are the -same, do nothing and return nil." - (unless (and keep-mode-if-same - (or (eq (indirect-function mode) - (indirect-function major-mode)) - (and set-auto-mode--last - (eq mode (car set-auto-mode--last)) - (eq major-mode (cdr set-auto-mode--last))))) - (when mode - (funcall (major-mode-remap mode)) - (unless (eq mode major-mode) - (setq set-auto-mode--last (cons mode major-mode))) - mode))) +same, do nothing and return `:keep'. +Return nil if MODE could not be applied." + (when mode + (if (and keep-mode-if-same + (or (eq (indirect-function mode) + (indirect-function major-mode)) + (and set-auto-mode--last + (eq mode (car set-auto-mode--last)) + (eq major-mode (cdr set-auto-mode--last))))) + :keep + (let ((modefun (major-mode-remap mode))) + (if (not (functionp modefun)) + (progn + (message "Ignoring unknown mode `%s'%s" mode + (if (eq mode modefun) "" + (format " (remapped to `%S')" modefun))) + nil) + (funcall modefun) + (unless (or (eq mode major-mode) ;`set-auto-mode--last' is overkill. + ;; `modefun' is something like a minor mode. + (local-variable-p 'set-auto-mode--last)) + (setq set-auto-mode--last (cons mode major-mode))) + mode))))) (defvar file-auto-mode-skip "^\\(#!\\|'\\\\\"\\)" "Regexp of lines to skip when looking for file-local settings. @@ -4201,8 +4208,9 @@ major-mode." (not (string-match "-minor\\'" (setq val2 (downcase (symbol-name val))))) - ;; Allow several mode: elements. - (push (intern (concat val2 "-mode")) result)) + (let ((mode (intern (concat val2 "-mode")))) + (when (fboundp (major-mode-remap mode)) + (setq result mode)))) (cond ((eq var 'coding)) ((eq var 'lexical-binding) (unless hack-local-variables--warned-lexical @@ -4233,10 +4241,7 @@ major-mode." val) result)))))) (forward-line 1))))))) - (if (eq handle-mode t) - ;; Return the final mode: setting that's defined. - (car (seq-filter #'fboundp result)) - result))) + result)) (defun hack-local-variables-apply () "Apply the elements of `file-local-variables-alist'. -- cgit v1.2.3 From 5037b9eed711dec0ef73dd6fca1e60e0b521c13b Mon Sep 17 00:00:00 2001 From: Patrick Bader Date: Mon, 4 Mar 2024 16:14:25 +0100 Subject: fix: project submodule detection does not work for worktrees --- lisp/progmodes/project.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index a7c164f5857..7103b36a892 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -602,7 +602,7 @@ See `project-vc-extra-root-markers' for the marker value format.") (goto-char (point-min)) ;; Kind of a hack to distinguish a submodule from ;; other cases of .git files pointing elsewhere. - (looking-at "gitdir: [./]+/\\.git/modules/")) + (looking-at "gitdir: .+/\\.git/\\(worktrees/.*\\)?modules/")) t) (t nil)))) -- cgit v1.2.3 From 77a86d738eebc7a80b7d4a6357a5fa675df9de8c Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Fri, 15 Mar 2024 04:28:45 +0200 Subject: (project--value-in-dir): Ensure that the global value is still honored * lisp/progmodes/project.el (project--value-in-dir): Ensure that the global value of the variable is still honored, when the variable is not in dir-locals. --- lisp/progmodes/project.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 7103b36a892..ac18aceadcf 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -810,7 +810,8 @@ DIRS must contain directory names." (let ((enable-local-variables :all)) (hack-dir-local-variables)) ;; Don't use `hack-local-variables-apply' to avoid setting modes. - (alist-get var file-local-variables-alist))) + (alist-get var file-local-variables-alist + (symbol-value var)))) (cl-defmethod project-buffers ((project (head vc))) (let* ((root (expand-file-name (file-name-as-directory (project-root project)))) -- cgit v1.2.3 From 09ab66935154ea0cc4a351b8320bc0e9276b7780 Mon Sep 17 00:00:00 2001 From: Kévin Le Gouguec Date: Sun, 3 Mar 2024 17:20:56 +0100 Subject: Keep indenting text when 'shr-fill-text' is nil (bug#69555) The 'shr-fill-...' functions handle both hard-filling (adding newlines to break long lines) and indentation. Setting 'shr-fill-text' to nil currently causes these functions to be short-circuited completely, so e.g. blockquotes are no longer indented, whereas the intent of this user option is only to prevent hard-filling to let visual-line-mode reflow text. * lisp/net/shr.el (shr-fill-lines): Document that the function handles more than just filling; move the 'shr-fill-text' check... (shr-fill-line): ... here, after indentation has been taken care of. * test/lisp/net/shr-resources/blockquote.html: * test/lisp/net/shr-resources/blockquote.txt: New test resources. * test/lisp/net/shr-tests.el (shr-test--rendering-check): Rename from 'shr-test', to make the relationship with the 'rendering' testcase clearer; prefer 'file-name-concat' to 'format'; raise ERT failure if need be, calling (ert-fail ...) directly instead of (should (not (list ...))). (shr-test--rendering-extra-configs): New variable to easily check that user customizations do not degrade rendering. (rendering): Consult that new variable; delegate failure-raising to reduce duplication. --- lisp/net/shr.el | 15 ++++-- test/lisp/net/shr-resources/blockquote.html | 2 + test/lisp/net/shr-resources/blockquote.txt | 3 ++ test/lisp/net/shr-tests.el | 72 +++++++++++++++++++++-------- 4 files changed, 67 insertions(+), 25 deletions(-) create mode 100644 test/lisp/net/shr-resources/blockquote.html create mode 100644 test/lisp/net/shr-resources/blockquote.txt (limited to 'lisp') diff --git a/lisp/net/shr.el b/lisp/net/shr.el index e23fc6104d2..09df5f5a9bb 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -784,8 +784,9 @@ size, and full-buffer size." (or shr-current-font 'shr-text))))))))) (defun shr-fill-lines (start end) - (if (or (not shr-fill-text) (<= shr-internal-width 0)) - nil + "Indent and fill text from START to END. +When `shr-fill-text' is nil, only indent." + (unless (<= shr-internal-width 0) (save-restriction (narrow-to-region start end) (goto-char start) @@ -807,6 +808,8 @@ size, and full-buffer size." (forward-char 1)))) (defun shr-fill-line () + "Indent and fill the current line. +When `shr-fill-text' is nil, only indent." (let ((shr-indentation (or (get-text-property (point) 'shr-indentation) shr-indentation)) (continuation (get-text-property @@ -821,9 +824,11 @@ size, and full-buffer size." `,(shr-face-background face)))) (setq start (point)) (setq shr-indentation (or continuation shr-indentation)) - ;; If we have an indentation that's wider than the width we're - ;; trying to fill to, then just give up and don't do any filling. - (when (< shr-indentation shr-internal-width) + ;; Fill the current line, unless `shr-fill-text' is unset, or we + ;; have an indentation that's wider than the width we're trying to + ;; fill to. + (when (and shr-fill-text + (< shr-indentation shr-internal-width)) (shr-vertical-motion shr-internal-width) (when (looking-at " $") (delete-region (point) (line-end-position))) diff --git a/test/lisp/net/shr-resources/blockquote.html b/test/lisp/net/shr-resources/blockquote.html new file mode 100644 index 00000000000..412caf8bae6 --- /dev/null +++ b/test/lisp/net/shr-resources/blockquote.html @@ -0,0 +1,2 @@ +
Citation.
+
Reply.
diff --git a/test/lisp/net/shr-resources/blockquote.txt b/test/lisp/net/shr-resources/blockquote.txt new file mode 100644 index 00000000000..8ed610b8ea2 --- /dev/null +++ b/test/lisp/net/shr-resources/blockquote.txt @@ -0,0 +1,3 @@ + Citation. + +Reply. diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el index 0c6e2c091bf..17138053450 100644 --- a/test/lisp/net/shr-tests.el +++ b/test/lisp/net/shr-tests.el @@ -29,30 +29,62 @@ (declare-function libxml-parse-html-region "xml.c") -(defun shr-test (name) - (with-temp-buffer - (insert-file-contents (format (concat (ert-resource-directory) "/%s.html") name)) - (let ((dom (libxml-parse-html-region (point-min) (point-max))) - (shr-width 80) - (shr-use-fonts nil)) - (erase-buffer) - (shr-insert-document dom) - (cons (buffer-substring-no-properties (point-min) (point-max)) - (with-temp-buffer - (insert-file-contents - (format (concat (ert-resource-directory) "/%s.txt") name)) - (while (re-search-forward "%\\([0-9A-F][0-9A-F]\\)" nil t) - (replace-match (string (string-to-number (match-string 1) 16)) - t t)) - (buffer-string)))))) +(defun shr-test--rendering-check (name &optional context) + "Render NAME.html and compare it to NAME.txt. +Raise a test failure if the rendered buffer does not match NAME.txt. +Append CONTEXT to the failure data, if non-nil." + (let ((text-file (file-name-concat (ert-resource-directory) (concat name ".txt"))) + (html-file (file-name-concat (ert-resource-directory) (concat name ".html"))) + (description (if context (format "%s (%s)" name context) name))) + (with-temp-buffer + (insert-file-contents html-file) + (let ((dom (libxml-parse-html-region (point-min) (point-max))) + (shr-width 80) + (shr-use-fonts nil)) + (erase-buffer) + (shr-insert-document dom) + (let ((result (buffer-substring-no-properties (point-min) (point-max))) + (expected + (with-temp-buffer + (insert-file-contents text-file) + (while (re-search-forward "%\\([0-9A-F][0-9A-F]\\)" nil t) + (replace-match (string (string-to-number (match-string 1) 16)) + t t)) + (buffer-string)))) + (unless (equal result expected) + (ert-fail (list description result expected)))))))) + +(defconst shr-test--rendering-extra-configs + '(("blockquote" + ;; Make sure blockquotes remain indented even when filling is + ;; disabled (bug#69555). + . ((shr-fill-text . nil)))) + "Extra customizations which can impact rendering. +This is a list of (NAME . SETTINGS) pairs. NAME is the basename of a +set of txt/html files under shr-resources/, as passed to `shr-test'. +SETTINGS is a list of (OPTION . VALUE) pairs that are interesting to +validate for the NAME testcase. + +The `rendering' testcase will test NAME once without altering any +settings, then once more for each (OPTION . VALUE) pair.") (ert-deftest rendering () (skip-unless (fboundp 'libxml-parse-html-region)) (dolist (file (directory-files (ert-resource-directory) nil "\\.html\\'")) - (let* ((name (replace-regexp-in-string "\\.html\\'" "" file)) - (result (shr-test name))) - (unless (equal (car result) (cdr result)) - (should (not (list name (car result) (cdr result)))))))) + (let* ((name (string-remove-suffix ".html" file)) + (extra-options (alist-get name shr-test--rendering-extra-configs + nil nil 'string=))) + ;; Test once with default settings. + (shr-test--rendering-check name) + ;; Test once more for every extra option for this specific NAME. + (pcase-dolist (`(,option-sym ,option-val) + extra-options) + (let ((option-old (symbol-value option-sym))) + (set option-sym option-val) + (unwind-protect + (shr-test--rendering-check + name (format "with %s %s" option-sym option-val)) + (set option-sym option-old))))))) (ert-deftest use-cookies () (let ((shr-cookie-policy 'same-origin)) -- cgit v1.2.3 From 9dcb28d6014f72e5f52ad46d6141e9be4e11bfa5 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Tue, 27 Feb 2024 15:42:38 -0500 Subject: With visible-completions, only bind RET when completion is selected Previously, if minibuffer-visible-completions was non-nil, we bound RET whenever the *Completions* buffer was visible. This meant that RET in completion-in-region would not enter a newline, which is a somewhat annoying behavior change from minibuffer-visible-completions=nil. Now, we only bind RET when a completion is selected. This means RET will newline in completion-in-region. So that completion help continues to suggest the correct keys, we also add minibuffer-visible-completions--always-bind. When let-bound to a non-nil value, it makes the minibuffer-visible-completions binds always active. We let-bind it around substitute-command-keys. * lisp/minibuffer.el (minibuffer-visible-completions--always-bind) (minibuffer-visible-completions--filter): Add. (minibuffer-visible-completions-bind): Use minibuffer-visible-completions--filter. (bug#68801) * lisp/simple.el (minibuffer-visible-completions--always-bind) (completion-setup-function): Let-bind minibuffer-visible-completions--always-bind so the completion help is correct. --- lisp/minibuffer.el | 24 ++++++++++++++++++------ lisp/simple.el | 19 +++++++++++-------- 2 files changed, 29 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 099fa1599d5..0a844c538b4 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3163,18 +3163,30 @@ and `RET' accepts the input typed into the minibuffer." :type 'boolean :version "30.1") +(defvar minibuffer-visible-completions--always-bind nil + "If non-nil, force the `minibuffer-visible-completions' bindings on.") + +(defun minibuffer-visible-completions--filter (cmd) + "Return CMD if `minibuffer-visible-completions' bindings should be active." + (if minibuffer-visible-completions--always-bind + cmd + (when-let ((window (get-buffer-window "*Completions*" 0))) + (when (and (eq (buffer-local-value 'completion-reference-buffer + (window-buffer window)) + (window-buffer (active-minibuffer-window))) + (if (eq cmd #'minibuffer-choose-completion-or-exit) + (with-current-buffer (window-buffer window) + (get-text-property (point) 'completion--string)) + t)) + cmd)))) + (defun minibuffer-visible-completions-bind (binding) "Use BINDING when completions are visible. Return an item that is enabled only when a window displaying the *Completions* buffer exists." `(menu-item "" ,binding - :filter ,(lambda (cmd) - (when-let ((window (get-buffer-window "*Completions*" 0))) - (when (eq (buffer-local-value 'completion-reference-buffer - (window-buffer window)) - (window-buffer (active-minibuffer-window))) - cmd))))) + :filter ,#'minibuffer-visible-completions--filter)) (defvar-keymap minibuffer-visible-completions-map :doc "Local keymap for minibuffer input with visible completions." diff --git a/lisp/simple.el b/lisp/simple.el index f127290231b..0645f18cc78 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10298,6 +10298,8 @@ Called from `temp-buffer-show-hook'." :version "22.1" :group 'completion) +(defvar minibuffer-visible-completions--always-bind) + ;; This function goes in completion-setup-hook, so that it is called ;; after the text of the completion list buffer is written. (defun completion-setup-function () @@ -10338,15 +10340,16 @@ Called from `temp-buffer-show-hook'." (if minibuffer-visible-completions (let ((helps (with-current-buffer (window-buffer (active-minibuffer-window)) - (list - (substitute-command-keys - (if (display-mouse-p) - "Click or type \\[minibuffer-choose-completion-or-exit] on a completion to select it.\n" - "Type \\[minibuffer-choose-completion-or-exit] on a completion to select it.\n")) - (substitute-command-keys - "Type \\[minibuffer-next-completion], \\[minibuffer-previous-completion], \ + (let ((minibuffer-visible-completions--always-bind t)) + (list + (substitute-command-keys + (if (display-mouse-p) + "Click or type \\[minibuffer-choose-completion-or-exit] on a completion to select it.\n" + "Type \\[minibuffer-choose-completion-or-exit] on a completion to select it.\n")) + (substitute-command-keys + "Type \\[minibuffer-next-completion], \\[minibuffer-previous-completion], \ \\[minibuffer-next-line-completion], \\[minibuffer-previous-line-completion] \ -to move point between completions.\n\n"))))) +to move point between completions.\n\n")))))) (dolist (help helps) (insert help))) (insert (substitute-command-keys -- cgit v1.2.3 From ffbf876a93c7b34c84806e43659efbac519279fa Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 15 Mar 2024 09:45:48 +0200 Subject: * lisp/vc/diff-mode.el (diff-mode-menu): Add menu item "Apply all hunks". It's bound to the recently added command 'diff-apply-buffer'. --- lisp/vc/diff-mode.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp') diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index ac7d55c8a46..0f393ba86a2 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -240,6 +240,8 @@ The default \"-b\" means to ignore whitespace-only changes, :help "Apply the current hunk to the source file and go to the next"] ["Test applying hunk" diff-test-hunk :help "See whether it's possible to apply the current hunk"] + ["Apply all hunks" diff-apply-buffer + :help "Apply all hunks in the current diff buffer"] ["Apply diff with Ediff" diff-ediff-patch :help "Call `ediff-patch-file' on the current buffer"] ["Create Change Log entries" diff-add-change-log-entries-other-window -- cgit v1.2.3 From 1c4233b9a391ba5d5746acf6b6fd4b352b8c3a58 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 15 Mar 2024 10:44:23 +0200 Subject: ; Fix documentation of 'flyspell-check-changes' * lisp/textmodes/flyspell.el (flyspell-check-changes): Doc fixes. * etc/NEWS: Improve wording of entry for 'flyspell-check-changes'. --- etc/NEWS | 3 ++- lisp/textmodes/flyspell.el | 14 +++++++++----- 2 files changed, 11 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index 327042f9d20..da9a2fd90fa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1132,7 +1132,8 @@ mouse to consult an error message. ** Flyspell *** New user option 'flyspell-check-changes'. -It checks only edited text. +When non-nil, Flyspell mode spell-checks only words that you edited; it +does not check unedited words just because you move point across them. ** JS mode. The binding 'M-.' has been removed from the major mode keymaps in diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index d64e4d601f7..09d4e8a8d1a 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -289,8 +289,11 @@ If this variable is nil, all regions are treated as small." :type 'key-sequence) (defcustom flyspell-check-changes nil - "Check only on moving point from the edited word. -Unlike the default behavior, don't check when moving point without editing." + "If non-nil, spell-check only words that were edited. +By default, this is nil, and Flyspell checks every word across which +you move point, even if you haven't edited the word. Customizing this +option to a non-nil value will not flag mis-spelled words across which +you move point without editing them." :type 'boolean :version "30.1") @@ -1000,9 +1003,10 @@ Mostly we check word delimiters." (setq flyspell-previous-command command))))) (defun flyspell-check-changes () - "The `post-command-hook' used by flyspell to check only edits. -It checks only on moving point from the edited word, -not when moving point without editing." + "Function to spell-check only edited words when point moves off the word. +This is installed by flyspell as `post-command-hook' when the user +option `flyspell-check-changes' is non-nil. It spell-checks a word +on moving point from the word only if the word was edited before the move." (when flyspell-mode (with-local-quit (when (consp flyspell-changes) -- cgit v1.2.3 From 5bba1b95b8088048808b306bf8b00eb9b342ce92 Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Fri, 15 Mar 2024 10:35:27 +0100 Subject: Further adjustments for restoring killed buffer windows (Bug#68235) * etc/NEWS: Announce 'window-restore-killed-buffer-windows'. * src/buffer.h (struct buffer) : New field last_name_. * src/buffer.c (Fbuffer_last_name): New function to return last name of buffer before it was killed or renamed. (bset_last_name, Fget_buffer_create, Fmake_indirect_buffer) (Frename_buffer, Fkill_buffer, init_buffer_once): Set buffer's last_name_ field accordingly. * src/window.c (window_restore_killed_buffer_windows): New variable replacing Vwindow_kept_windows_functions. (Fset_window_configuration): Use window_restore_killed_buffer_windows instead of Vwindow_kept_windows_functions. * lisp/window.el (window--state-put-2, window-state-put): Use 'window-restore-killed-buffer-windows' instead of 'window-kept-windows-functions'. * doc/lispref/windows.texi (Window Configurations): Describe 'window-restore-killed-buffer-windows' which replaces 'window-kept-windows-functions'. --- doc/lispref/windows.texi | 114 ++++++++++++++++++++++------------ etc/NEWS | 6 ++ lisp/window.el | 49 ++++++++------- src/buffer.c | 26 +++++++- src/buffer.h | 3 + src/window.c | 155 ++++++++++++++++++++++++++++------------------- 6 files changed, 225 insertions(+), 128 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index fe3dc573df5..45d67ba4946 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -6264,15 +6264,10 @@ this function does is to restore the value of the variable @code{minibuffer-selected-window}. In this case, the function returns @code{nil}. Otherwise, it returns @code{t}. -If the buffer of a window of @var{configuration} has been killed since -@var{configuration} was made, that window is, as a rule, removed from -the restored configuration. However, if that window is the last window -remaining in the restored configuration, another live buffer is shown in -it. Also, if the variable @var{window-kept-windows-functions} is -non-@code{nil}, any window whose buffer is now dead is not deleted. -Rather, this function will show another live buffer in that window and -include an entry for that window when calling any function in -@var{window-kept-windows-functions} (@pxref{Window Hooks}). +This function consults the variable +@code{window-restore-killed-buffer-windows} (see below) when it tries to +restore a window whose buffer was killed after @var{configuration} was +recorded. Here is a way of using this function to get the same effect as @code{save-window-excursion}: @@ -6361,14 +6356,9 @@ a live window, it is replaced by a new live window created on the same frame before putting @var{state} into it. If @var{window} is @code{nil}, it puts the window state into a new window. -If the buffer of any window recorded in @var{state} has been killed -since @var{state} was made, that window is, as a rule, not restored. -However, if that window is the only window in @var{state}, another live -buffer will be shown in it. Also, if the variable -@var{window-kept-windows-functions} is non-@code{nil}, any window whose -buffer is now dead is restored. This function will show another live -buffer in it and include an entry for that window when calling a -function in @var{window-kept-windows-functions} (@pxref{Window Hooks}). +This function consults the variable +@code{window-restore-killed-buffer-windows} (see below) when it tries to +restore a window whose buffer was killed after @var{state} was recorded. If the optional argument @var{ignore} is non-@code{nil}, it means to ignore minimum window sizes and fixed-size restrictions. If @var{ignore} @@ -6376,6 +6366,75 @@ is @code{safe}, this means windows can get as small as one line and/or two columns. @end defun +By default, @code{set-window-configuration} and @code{window-state-put} +may delete a window from the restored configuration when they find out +that its buffer was killed since the corresponding configuration or +state has been recorded. The variable described next can be used to +fine-tune that behavior. + +@cindex restoring windows whose buffers have been killed +@defvar window-restore-killed-buffer-windows +This variable specifies how @code{set-window-configuration} and +@code{window-state-put} shall handle a window whose buffer has been +killed since the corresponding configuration or state was made. Any +such window may be live - in which case it shows some other buffer - or +dead at the time one of these functions is called. Usually, +@code{set-window-configuration} leaves the window alone if it is live +while @code{window-state-put} deletes it. + +The following values can be used to override the default behavior for +dead windows in the case of @code{set-window-configuration} and for dead +and live windows in the case of @code{window-state-put}. + +@table @asis +@item @code{t} +This value means to unconditionally restore the window and show some +other buffer in it. + +@item @code{delete} +This means to unconditionally try to delete the window. + +@item @code{dedicated} +This means to try to delete the window if and only if it is dedicated to +its buffer. + +@item @code{nil} +This is the default and means that @code{set-window-configuration} will +try to delete the window if and only if it is dedicated to its buffer +and @code{window-state-put} will unconditionally try to delete it. + +@item a function +This means to restore the window, show some other buffer in it and add +an entry for that window to a list that will be later passed as argument +to that function. +@end table + +If a window cannot be deleted (typically, because it is the last window +on its frame), @code{set-window-configuration} and +@code{window-state-put} will show another buffer in it. + +If the value of this variable is a function, that function should take +three arguments. The first argument specifies the frame whose windows +have been restored. The third argument is either the constant +@code{configuration} if the windows are restored by +@code{set-window-configuration} or the constant @code{state} if the +windows are restored by @code{window-state-put}. + +The second argument specifies a list of entries for @emph{any} window +whose previous buffer has been encountered dead at the time +@code{set-window-configuration} or @code{window-state-put} tried to +restore it in that window (minibuffer windows are excluded). This means +that the function specified by this variable may also delete windows +encountered live by @code{set-window-configuration}. + +Each entry is a list of six values - the window whose buffer was found +dead, the dead buffer or its name, the positions of start and point of +the buffer in that window, the dedicated status of the window as +previously reported by @code{window-dedicated-p} and a flag that is +@code{t} if the window has been encountered live by +@code{set-window-configuration} and @code{nil} otherwise. +@end defvar + The functions @code{window-state-get} and @code{window-state-put} also allow exchanging the contents of two live windows. The following function does precisely that: @@ -6636,27 +6695,6 @@ Lock fontification function, which will be called whenever parts of a buffer are (re)fontified because a window was scrolled or its size changed. @xref{Other Font Lock Variables}. -@cindex window kept windows functions -@defvar window-kept-windows-functions - This variable holds a list of functions that Emacs will call after -restoring a window configuration via @code{set-window-configuration} or -state via @code{window-state-put} (@pxref{Window Configurations}). When -the value of this variable is non-@code{nil}, these functions will not -delete any window whose buffer has been killed since the corresponding -configuration or state was saved, but show some live buffer in it. - -The value should be a list of functions that take two arguments. The -first argument specifies the frame whose windows have been restored. -The second argument specifies a list of entries for each window whose -buffer has been found dead at the time @code{set-window-configuration} -or @code{window-state-put} tried to restore it. Each entry is a list of -four values - the window whose buffer was found dead, the dead buffer, -and the last known positions of start and point of the buffer in that -window. Any function run by this hook should check that the window is -live since another function run by this hook may have deleted it in the -meantime. -@end defvar - @cindex window change functions The remainder of this section covers six hooks that are called during redisplay provided a significant, non-scrolling change of a diff --git a/etc/NEWS b/etc/NEWS index da9a2fd90fa..dfbf6edb098 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -283,6 +283,12 @@ right-aligned to is controlled by the new user option It specifies whether the window of the displayed buffer should be selected or deselected at the end of executing the current command. ++++ +*** New variable 'window-restore-killed-buffer-windows'. +It specifies how 'set-window-configuration' and 'window-state-put' +should proceed with windows whose buffer was killed after the +corresponding configuration or state was made. + ** Tab Bars and Tab Lines --- diff --git a/lisp/window.el b/lisp/window.el index 29336f573f8..246708dbd56 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -6286,7 +6286,8 @@ value can be also stored on disk and read back in a new session." (when state (let* ((old-buffer-or-name (car state)) (buffer (get-buffer old-buffer-or-name)) - (state (cdr state))) + (state (cdr state)) + (dedicated (cdr (assq 'dedicated state)))) (if (buffer-live-p buffer) (with-current-buffer buffer (set-window-buffer window buffer) @@ -6345,7 +6346,7 @@ value can be also stored on disk and read back in a new session." window delta t ignore nil nil nil pixelwise)) (window-resize window delta t ignore pixelwise)))) ;; Set dedicated status. - (set-window-dedicated-p window (cdr (assq 'dedicated state))) + (set-window-dedicated-p window dedicated) ;; Install positions (maybe we should do this after all ;; windows have been created and sized). (ignore-errors @@ -6388,12 +6389,12 @@ value can be also stored on disk and read back in a new session." (set-marker (make-marker) m2 buffer)))))) prev-buffers)))) - ;; We don't want to raise an error in case the buffer does - ;; not exist anymore, so we switch to a previous one and - ;; save the window with the intention of deleting it later - ;; if possible. - (switch-to-prev-buffer window) - (if window-kept-windows-functions + (unless (window-minibuffer-p window) + ;; Preferably show a buffer previously shown in this + ;; window. + (switch-to-prev-buffer window) + (cond + ((functionp window-restore-killed-buffer-windows) (let* ((start (cdr (assq 'start state))) ;; Handle both - marker positions from writable ;; states and markers from non-writable states. @@ -6404,9 +6405,15 @@ value can be also stored on disk and read back in a new session." (point-pos (if (markerp point) (marker-last-position point) point))) - (push (list window old-buffer-or-name start-pos point-pos) - window-state-put-kept-windows)) - (push window window-state-put-stale-windows)))))))) + (push (list window old-buffer-or-name + start-pos point-pos dedicated nil) + window-state-put-kept-windows))) + ((or (and dedicated + (eq window-restore-killed-buffer-windows 'dedicated)) + (memq window-restore-killed-buffer-windows '(nil delete))) + ;; Try to delete the window. + (push window window-state-put-stale-windows))) + (set-window-dedicated-p window nil)))))))) (defun window-state-put (state &optional window ignore) "Put window state STATE into WINDOW. @@ -6421,16 +6428,9 @@ sizes and fixed size restrictions. IGNORE equal `safe' means windows can get as small as `window-safe-min-height' and `window-safe-min-width'. -If the abnormal hook `window-kept-windows-functions' is non-nil, -do not delete any windows saved by STATE whose buffers were -deleted since STATE was saved. Rather, show some live buffer in -them and call the functions in `window-kept-windows-functions' -with a list of two arguments: the frame where STATE was put and a -list of entries for each such window. Each entry contains four -elements - the window, its old buffer and the last positions of -`window-start' and `window-point' for the buffer in that window. -Always check the window for liveness because another function run -by this hook may have deleted it." +If this function tries to restore a non-minibuffer window whose buffer +was killed since STATE was made, it will consult the variable +`window-restore-killed-buffer-windows' on how to proceed." (setq window-state-put-stale-windows nil) (setq window-state-put-kept-windows nil) @@ -6544,10 +6544,9 @@ by this hook may have deleted it." (when (and (window-valid-p window) (eq (window-deletable-p window) t)) (delete-window window)))) - (when window-kept-windows-functions - (run-hook-with-args - 'window-kept-windows-functions - frame window-state-put-kept-windows) + (when (functionp window-restore-killed-buffer-windows) + (funcall window-restore-killed-buffer-windows + frame window-state-put-kept-windows 'state) (setq window-state-put-kept-windows nil)) (window--check frame)))) diff --git a/src/buffer.c b/src/buffer.c index 43a9249528c..07d19dfc078 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -327,6 +327,11 @@ bset_name (struct buffer *b, Lisp_Object val) b->name_ = val; } static void +bset_last_name (struct buffer *b, Lisp_Object val) +{ + b->last_name_ = val; +} +static void bset_overwrite_mode (struct buffer *b, Lisp_Object val) { b->overwrite_mode_ = val; @@ -647,6 +652,7 @@ even if it is dead. The return value is never nil. */) name = Fcopy_sequence (buffer_or_name); set_string_intervals (name, NULL); bset_name (b, name); + bset_last_name (b, name); b->inhibit_buffer_hooks = !NILP (inhibit_buffer_hooks); bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt); @@ -866,6 +872,7 @@ Interactively, CLONE and INHIBIT-BUFFER-HOOKS are nil. */) name = Fcopy_sequence (name); set_string_intervals (name, NULL); bset_name (b, name); + bset_last_name (b, name); /* An indirect buffer shares undo list of its base (Bug#18180). */ bset_undo_list (b, BVAR (b->base_buffer, undo_list)); @@ -1282,6 +1289,17 @@ Return nil if BUFFER has been killed. */) return BVAR (decode_buffer (buffer), name); } +DEFUN ("buffer-last-name", Fbuffer_last_name, Sbuffer_last_name, 0, 1, 0, + doc: /* Return last name of BUFFER, as a string. +BUFFER defaults to the current buffer. + +This is the name BUFFER had before the last time it was renamed or +immediately before it was killed. */) + (Lisp_Object buffer) +{ + return BVAR (decode_buffer (buffer), last_name); +} + DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0, doc: /* Return name of file BUFFER is visiting, or nil if none. No argument or nil as argument means use the current buffer. */) @@ -1652,6 +1670,7 @@ This does not change the name of the visited file (if any). */) (register Lisp_Object newname, Lisp_Object unique) { register Lisp_Object tem, buf; + Lisp_Object oldname = BVAR (current_buffer, name); Lisp_Object requestedname = newname; CHECK_STRING (newname); @@ -1669,12 +1688,12 @@ This does not change the name of the visited file (if any). */) if (NILP (unique) && XBUFFER (tem) == current_buffer) return BVAR (current_buffer, name); if (!NILP (unique)) - newname = Fgenerate_new_buffer_name (newname, - BVAR (current_buffer, name)); + newname = Fgenerate_new_buffer_name (newname, oldname); else error ("Buffer name `%s' is in use", SDATA (newname)); } + bset_last_name (current_buffer, oldname); bset_name (current_buffer, newname); /* Catch redisplay's attention. Unless we do this, the mode lines for @@ -2095,6 +2114,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) This gets rid of them for certain. */ reset_buffer_local_variables (b, 1); + bset_last_name (b, BVAR (b, name)); bset_name (b, Qnil); block_input (); @@ -4666,6 +4686,7 @@ init_buffer_once (void) /* These used to be stuck at 0 by default, but now that the all-zero value means Qnil, we have to initialize them explicitly. */ bset_name (&buffer_local_flags, make_fixnum (0)); + bset_last_name (&buffer_local_flags, make_fixnum (0)); bset_mark (&buffer_local_flags, make_fixnum (0)); bset_local_var_alist (&buffer_local_flags, make_fixnum (0)); bset_keymap (&buffer_local_flags, make_fixnum (0)); @@ -6026,6 +6047,7 @@ There is no reason to change that value except for debugging purposes. */); defsubr (&Smake_indirect_buffer); defsubr (&Sgenerate_new_buffer_name); defsubr (&Sbuffer_name); + defsubr (&Sbuffer_last_name); defsubr (&Sbuffer_file_name); defsubr (&Sbuffer_base_buffer); defsubr (&Sbuffer_local_value); diff --git a/src/buffer.h b/src/buffer.h index 87ba2802b39..bbe1aeff668 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -309,6 +309,9 @@ struct buffer /* The name of this buffer. */ Lisp_Object name_; + /* The last name of this buffer before it was renamed or killed. */ + Lisp_Object last_name_; + /* The name of the file visited in this buffer, or nil. */ Lisp_Object filename_; diff --git a/src/window.c b/src/window.c index ea761fad8bc..928c4ae02a8 100644 --- a/src/window.c +++ b/src/window.c @@ -7109,23 +7109,9 @@ current at the start of the function. If DONT-SET-MINIWINDOW is non-nil, the mini-window of the frame doesn't get set to the corresponding element of CONFIGURATION. -Normally, this function will try to delete any dead window in -CONFIGURATION whose buffer has been deleted since CONFIGURATION was -made. However, if the abnormal hook `window-kept-windows-functions' is -non-nil, it will preserve such a window in the restored layout and show -another buffer in it. - -After restoring the frame layout, this function runs the abnormal hook -`window-kept-windows-functions' with two arguments - the frame whose -layout it has restored and a list of entries for each window whose -buffer has been found dead when it tried to restore CONFIGURATION: Each -entry is a list of four elements where -`window' denotes the window whose buffer was found dead, `buffer' -denotes the dead buffer, and `start' and `point' denote the last known -positions of `window-start' and `window-point' of the buffer in that -window. Any function run by this hook should check such a window for -liveness because another function run by this hook may have deleted it -in the meantime." +This function consults the variable `window-restore-killed-buffer-windows' +when restoring a window whose buffer was killed after CONFIGURATION was +recorded. If CONFIGURATION was made from a frame that is now deleted, only frame-independent values can be restored. In this case, @@ -7378,10 +7364,12 @@ the return value is nil. Otherwise the value is t. */) BUF_PT (XBUFFER (w->contents)), BUF_PT_BYTE (XBUFFER (w->contents))); w->start_at_line_beg = true; - if (!NILP (Vwindow_kept_windows_functions)) - kept_windows = Fcons (list4 (window, p->buffer, + if (FUNCTIONP (window_restore_killed_buffer_windows) + && !MINI_WINDOW_P (w)) + kept_windows = Fcons (listn (6, window, p->buffer, Fmarker_last_position (p->start), - Fmarker_last_position (p->pointm)), + Fmarker_last_position (p->pointm), + p->dedicated, Qt), kept_windows); } else if (!NILP (w->start)) @@ -7398,16 +7386,25 @@ the return value is nil. Otherwise the value is t. */) set_marker_restricted_both (w->pointm, w->contents, 0, 0); set_marker_restricted_both (w->old_pointm, w->contents, 0, 0); w->start_at_line_beg = true; - if (!NILP (w->dedicated)) - /* Record this window as dead. */ - dead_windows = Fcons (window, dead_windows); - /* Make sure window is no more dedicated. */ - wset_dedicated (w, Qnil); - if (!NILP (Vwindow_kept_windows_functions)) - kept_windows = Fcons (list4 (window, p->buffer, - Fmarker_last_position (p->start), - Fmarker_last_position (p->pointm)), - kept_windows); + if (!MINI_WINDOW_P (w)) + { + if (FUNCTIONP (window_restore_killed_buffer_windows)) + kept_windows + = Fcons (listn (6, window, p->buffer, + Fmarker_last_position (p->start), + Fmarker_last_position (p->pointm), + p->dedicated, Qnil), + kept_windows); + else if (EQ (window_restore_killed_buffer_windows, Qdelete) + || (!NILP (p->dedicated) + && (NILP (window_restore_killed_buffer_windows) + || EQ (window_restore_killed_buffer_windows, + Qdedicated)))) + /* Try to delete this window later. */ + dead_windows = Fcons (window, dead_windows); + /* Make sure window is no more dedicated. */ + wset_dedicated (w, Qnil); + } } } @@ -7459,13 +7456,12 @@ the return value is nil. Otherwise the value is t. */) unblock_input (); /* Scan dead buffer windows. */ - if (!NILP (Vwindow_kept_windows_functions)) - for (; CONSP (dead_windows); dead_windows = XCDR (dead_windows)) - { - window = XCAR (dead_windows); - if (WINDOW_LIVE_P (window) && !EQ (window, FRAME_ROOT_WINDOW (f))) - delete_deletable_window (window); - } + for (; CONSP (dead_windows); dead_windows = XCDR (dead_windows)) + { + window = XCAR (dead_windows); + if (WINDOW_LIVE_P (window) && !EQ (window, FRAME_ROOT_WINDOW (f))) + delete_deletable_window (window); + } /* Record the selected window's buffer here. The window should already be the selected one from the call above. */ @@ -7513,9 +7509,9 @@ the return value is nil. Otherwise the value is t. */) SAFE_FREE (); - if (!NILP (Vrun_hooks) && !NILP (Vwindow_kept_windows_functions)) - run_hook_with_args_2 (Qwindow_kept_windows_functions, frame, - kept_windows); + if (!NILP (Vrun_hooks) && FUNCTIONP (window_restore_killed_buffer_windows)) + safe_calln (window_restore_killed_buffer_windows, + frame, kept_windows, Qconfiguration); return FRAME_LIVE_P (f) ? Qt : Qnil; } @@ -8514,8 +8510,9 @@ syms_of_window (void) DEFSYM (Qheader_line_format, "header-line-format"); DEFSYM (Qtab_line_format, "tab-line-format"); DEFSYM (Qno_other_window, "no-other-window"); - DEFSYM (Qwindow_kept_windows_functions, - "window-kept-windows-functions"); + DEFSYM (Qconfiguration, "configuration"); + DEFSYM (Qdelete, "delete"); + DEFSYM (Qdedicated, "dedicated"); DEFVAR_LISP ("temp-buffer-show-function", Vtemp_buffer_show_function, doc: /* Non-nil means call as function to display a help buffer. @@ -8673,27 +8670,59 @@ its buffer or its total or body size since the last redisplay. Each call is performed with the frame temporarily selected. */); Vwindow_configuration_change_hook = Qnil; - DEFVAR_LISP ("window-kept-windows-functions", - Vwindow_kept_windows_functions, - doc: /* Functions run after restoring a window configuration or state. -These functions are called by `set-window-configuration' and -`window-state-put'. When the value of this variable is non-nil, these -functions restore any window whose buffer has been deleted since the -corresponding configuration or state was saved. Rather than deleting -such a window, `set-window-configuration' and `window-state-put' show -some live buffer in it. - -The value should be a list of functions that take two arguments. The -first argument specifies the frame whose configuration has been -restored. The second argument, if non-nil, specifies a list of entries -for each window whose buffer has been found dead at the time -'set-window-configuration' or `window-state-put' tried to restore it in -that window. Each entry is a list of four values - the window whose -buffer was found dead, the dead buffer, and the positions of start and -point of the buffer in that window. Note that the window may be already -dead since another function on this list may have deleted it in the -meantime. */); - Vwindow_kept_windows_functions = Qnil; + DEFVAR_LISP ("window-restore-killed-buffer-windows", + window_restore_killed_buffer_windows, + doc: /* Control restoring windows whose buffer was killed. +This variable specifies how the functions `set-window-configuration' and +`window-state-put' shall handle a window whose buffer has been killed +since the corresponding configuration or state was made. Any such +window may be live - in which case it shows some other buffer - or dead +at the time one of these functions is called. + +As a rule, `set-window-configuration' leaves the window alone if it is +live while `window-state-put' deletes it. The following values can be +used to override the default behavior for dead windows in the case of +`set-window-configuration' and for dead and live windows in the case of +`window-state-put'. + +- t means to restore the window and show some other buffer in it. + +- `delete' means to try to delete the window. + +- `dedicated' means to try to delete the window if and only if it is + dedicated to its buffer. + +- nil, the default, means that `set-window-configuration' will try to + delete the window if and only if it is dedicated to its buffer while + `window-state-put' will unconditionally try to delete it. + +- a function means to restore the window, show some other buffer in it + and add an entry for that window to a list that will be later passed + as argument to that function. + +If a window cannot be deleted (typically, because it is the last window +on its frame), show another buffer in it. + +If the value is a function, it should take three arguments. The first +argument specifies the frame whose windows have been restored. The +third argument is the constant `configuration' if the windows are +restored by `set-window-configuration' and the constant `state' if the +windows are restored by `window-state-put'. + +The second argument specifies a list of entries for @emph{any} window +whose previous buffer has been encountered dead at the time +`set-window-configuration' or `window-state-put' tried to restore it in +that window (minibuffer windows are excluded). This means that the +function specified by this variable may also delete windows encountered +live by `set-window-configuration'. + +Each entry is a list of six values - the window whose buffer was found +dead, the dead buffer or its name, the positions of start and point of +the buffer in that window, the dedicated status of the window as +reported by `window-dedicated-p' and a boolean - t if the window was +live when `set-window-configuration' tried to restore it and nil +otherwise. */); + window_restore_killed_buffer_windows = Qnil; DEFVAR_LISP ("recenter-redisplay", Vrecenter_redisplay, doc: /* Non-nil means `recenter' redraws entire frame. -- cgit v1.2.3 From c393c0467972cba9dc7ed256acd72b553204c33a Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 15 Mar 2024 12:32:06 +0100 Subject: * lisp/emacs-lisp/advice.el (comp-subr-trampoline-install): Don't declare. --- lisp/emacs-lisp/advice.el | 2 -- 1 file changed, 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 9489a9fd1b3..752660156b9 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2042,8 +2042,6 @@ in that CLASS." function class name))) (error "ad-remove-advice: `%s' is not advised" function))) -(declare-function comp-subr-trampoline-install "comp-run") - ;;;###autoload (defun ad-add-advice (function advice class position) "Add a piece of ADVICE to FUNCTION's list of advices in CLASS. -- cgit v1.2.3 From 005536285585bcdf5a67a01cdfd8e1242742f953 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 15 Mar 2024 14:18:51 +0100 Subject: * Don't install unnecessary trampolines (bug#69573) * lisp/emacs-lisp/comp-run.el (comp-subr-trampoline-install): Check that subr-name actually matches the target subr. --- lisp/emacs-lisp/comp-run.el | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index 057760322ab..afb46e3cd19 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -364,13 +364,15 @@ Return the trampoline if found or nil otherwise." (when (memq subr-name comp-warn-primitives) (warn "Redefining `%s' might break native compilation of trampolines." subr-name)) - (unless (or (null native-comp-enable-subr-trampolines) - (memq subr-name native-comp-never-optimize-functions) - (gethash subr-name comp-installed-trampolines-h)) - (cl-assert (subr-primitive-p (symbol-function subr-name))) - (when-let ((trampoline (or (comp-trampoline-search subr-name) - (comp-trampoline-compile subr-name)))) - (comp--install-trampoline subr-name trampoline)))) + (let ((subr (symbol-function subr-name))) + (unless (or (not (string= subr-name (subr-name subr))) ;; (bug#69573) + (null native-comp-enable-subr-trampolines) + (memq subr-name native-comp-never-optimize-functions) + (gethash subr-name comp-installed-trampolines-h)) + (cl-assert (subr-primitive-p subr)) + (when-let ((trampoline (or (comp-trampoline-search subr-name) + (comp-trampoline-compile subr-name)))) + (comp--install-trampoline subr-name trampoline))))) ;;;###autoload (defun native--compile-async (files &optional recursively load selector) -- cgit v1.2.3 From 7231a89524f280c51278c3c74c6ae2215a307f0f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 15 Mar 2024 12:45:09 -0400 Subject: * lisp/emacs-lisp/bindat.el (sint): Burp in dynbind (bug#69749) --- lisp/emacs-lisp/bindat.el | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index ef0ec688dbd..42ba89ba2c1 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -944,9 +944,13 @@ a bindat type expression." (bindat-defmacro sint (bitlen le) "Signed integer of size BITLEN. Big-endian if LE is nil and little-endian if not." + (unless lexical-binding + (error "The `sint' type requires 'lexical-binding'")) (let ((bl (make-symbol "bitlen")) (max (make-symbol "max")) (wrap (make-symbol "wrap"))) + ;; FIXME: This `let*' around the `struct' results in code which the + ;; byte-compiler does not handle efficiently. 🙁 `(let* ((,bl ,bitlen) (,max (ash 1 (1- ,bl))) (,wrap (+ ,max ,max))) -- cgit v1.2.3 From 28e481bf7af873cdaf016e25855a8e0ebc424fe7 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 16 Mar 2024 15:15:10 +0800 Subject: Respond to default action from Gnus notifications * lisp/gnus/gnus-notifications.el (gnus-notifications-action): Consider default equivalent to read. --- lisp/gnus/gnus-notifications.el | 5 +++-- src/androidterm.c | 20 ++++++++++---------- 2 files changed, 13 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el index 35f90ebfe40..e4c3d2c0381 100644 --- a/lisp/gnus/gnus-notifications.el +++ b/lisp/gnus/gnus-notifications.el @@ -75,10 +75,11 @@ not get notifications." (when group-article (let ((group (cadr group-article)) (article (nth 2 group-article))) - (cond ((string= key "read") + (cond ((or (equal key "read") + (equal key "default")) (gnus-fetch-group group (list article)) (select-frame-set-input-focus (selected-frame))) - ((string= key "mark-read") + ((equal key "mark-read") (gnus-update-read-articles group (delq article (gnus-list-of-unread-articles group))) diff --git a/src/androidterm.c b/src/androidterm.c index 9948a2919d8..ba9b6d3b8a9 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -376,11 +376,11 @@ android_android_to_emacs_modifiers (struct android_display_info *dpyinfo, tem = Fget (Vx_super_keysym, Qmodifier_value); if (FIXNUMP (tem)) mod_super = XFIXNUM (tem) & INT_MAX; - return (((state & ANDROID_CONTROL_MASK) ? mod_ctrl : 0) - | ((state & ANDROID_SHIFT_MASK) ? mod_shift : 0) - | ((state & ANDROID_ALT_MASK) ? mod_meta : 0) - | ((state & ANDROID_SUPER_MASK) ? mod_super : 0) - | ((state & ANDROID_META_MASK) ? mod_alt : 0)); + return (((state & ANDROID_CONTROL_MASK) ? mod_ctrl : 0) + | ((state & ANDROID_SHIFT_MASK) ? shift_modifier : 0) + | ((state & ANDROID_ALT_MASK) ? mod_meta : 0) + | ((state & ANDROID_SUPER_MASK) ? mod_super : 0) + | ((state & ANDROID_META_MASK) ? mod_alt : 0)); } static int @@ -402,11 +402,11 @@ android_emacs_to_android_modifiers (struct android_display_info *dpyinfo, tem = Fget (Vx_super_keysym, Qmodifier_value); if (FIXNUMP (tem)) mod_super = XFIXNUM (tem); - return (((state & mod_ctrl) ? ANDROID_CONTROL_MASK : 0) - | ((state & mod_shift) ? ANDROID_SHIFT_MASK : 0) - | ((state & mod_meta) ? ANDROID_ALT_MASK : 0) - | ((state & mod_super) ? ANDROID_SUPER_MASK : 0) - | ((state & mod_alt) ? ANDROID_META_MASK : 0)); + return (((state & mod_ctrl) ? ANDROID_CONTROL_MASK : 0) + | ((state & shift_modifier) ? ANDROID_SHIFT_MASK : 0) + | ((state & mod_meta) ? ANDROID_ALT_MASK : 0) + | ((state & mod_super) ? ANDROID_SUPER_MASK : 0) + | ((state & mod_alt) ? ANDROID_META_MASK : 0)); } static void android_frame_rehighlight (struct android_display_info *); -- cgit v1.2.3 From 899ea79310d1b8ed78c3fd8ac1784043dd732dbf Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Sat, 16 Mar 2024 10:10:29 +0100 Subject: In window-related documentation write 'symbol' instead of 'constant' Suggested by Michael Heerdegen . * src/window.c (window_restore_killed_buffer_windows): In doc-string write 'symbol' instead of 'constant'. * lisp/window.el (display-buffer--lru-window) (display-buffer-use-least-recent-window): In doc-strings write 'symbol' instead of 'constant'. * doc/lispref/windows.texi (Window Configurations): Write 'symbol' instead of 'constant'. --- doc/lispref/windows.texi | 4 ++-- lisp/window.el | 8 ++++---- src/window.c | 4 ++-- 3 files changed, 8 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 8fa4e57b153..2e2fdee422b 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -6416,9 +6416,9 @@ on its frame), @code{set-window-configuration} and If the value of this variable is a function, that function should take three arguments. The first argument specifies the frame whose windows -have been restored. The third argument is either the constant +have been restored. The third argument is either the symbol @code{configuration} if the windows are restored by -@code{set-window-configuration}, or the constant @code{state} if the +@code{set-window-configuration}, or the symbol @code{state} if the windows are restored by @code{window-state-put}. The second argument specifies a list of entries for @emph{all} windows diff --git a/lisp/window.el b/lisp/window.el index 246708dbd56..df55a7ca673 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -8668,11 +8668,11 @@ buffer. ALIST is a buffer display action alist as compiled by use time is higher than this. - `window-min-width' specifies a preferred minimum width in - canonical frame columns. If it is the constant `full-width', + canonical frame columns. If it is the symbol `full-width', prefer a full-width window. - `window-min-height' specifies a preferred minimum height in - canonical frame lines. If it is the constant `full-height', + canonical frame lines. If it is the symbol `full-height', prefer a full-height window. If ALIST contains a non-nil `inhibit-same-window' entry, do not @@ -8799,11 +8799,11 @@ Distinctive features are: call. `window-min-width' specifies a preferred minimum width in - canonical frame columns. If it is the constant `full-width', + canonical frame columns. If it is the symbol `full-width', prefer a full-width window. `window-min-height' specifies a preferred minimum height in - canonical frame lines. If it is the constant `full-height', + canonical frame lines. If it is the symbol `full-height', prefer a full-height window. - If the preceding steps fail, try to pop up a new window on the diff --git a/src/window.c b/src/window.c index 2c002418605..b69f4719d93 100644 --- a/src/window.c +++ b/src/window.c @@ -8707,8 +8707,8 @@ on its frame), show another buffer in it. If the value is a function, it should take three arguments. The first argument specifies the frame whose windows have been restored. The -third argument is the constant `configuration' if the windows are -restored by `set-window-configuration' and the constant `state' if the +third argument is the symbol `configuration' if the windows are +restored by `set-window-configuration' and the symbol `state' if the windows are restored by `window-state-put'. The second argument specifies a list of entries for all windows -- cgit v1.2.3 From d5901f3f05e0aec9bf4b6b4b6ebf27c66c7cee14 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 16 Mar 2024 12:42:16 +0200 Subject: Improve documentation of 'edebug-print-*' variables * lisp/emacs-lisp/edebug.el (edebug-print-length) (edebug-print-level): Fix doc strings and customization labels. Suggested by Matt Trzcinski . (Bug#69745) --- lisp/emacs-lisp/edebug.el | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 9656bdf03d8..623b1c6a8c9 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -193,11 +193,15 @@ Use this with caution since it is not debugged." (defcustom edebug-print-length 50 - "If non-nil, default value of `print-length' for printing results in Edebug." - :type '(choice integer (const nil))) + "Maximum length of list to print before abbreviating, when in Edebug. +If this is nil, use the value of `print-length' instead." + :type '(choice (integer :tag "A number") + (const :tag "Use `print-length'" nil))) (defcustom edebug-print-level 50 - "If non-nil, default value of `print-level' for printing results in Edebug." - :type '(choice integer (const nil))) + "Maximum depth of list nesting to print before abbreviating, when in Edebug. +If nil, use the value of `print-level' instead." + :type '(choice (integer :tag "A number") + (const :tag "Use `print-level'" nil))) (defcustom edebug-print-circle t "If non-nil, default value of `print-circle' for printing results in Edebug." :type 'boolean) -- cgit v1.2.3 From 685f4295f9810b4aab8ec3ba7146b17904a1c37f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 16 Mar 2024 12:58:33 +0200 Subject: ; Document more DND functions with limited support * lisp/dnd.el (dnd-begin-text-drag, dnd-begin-file-drag) (dnd-begin-drag-files): Document platforms that support these functions. (Bug#69662) --- lisp/dnd.el | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/dnd.el b/lisp/dnd.el index 22cb18359a3..1fc1ab45b84 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -453,7 +453,10 @@ on FRAME itself. This function might return immediately if no mouse buttons are currently being held down. It should only be called upon a -`down-mouse-1' (or similar) event." +`down-mouse-1' (or similar) event. + +This function is only supported on X Windows, macOS/GNUstep, and Haiku; +on all other platforms it will signal an error." (unless (fboundp 'x-begin-drag) (error "Dragging text from Emacs is not supported by this window system")) (gui-set-selection 'XdndSelection text) @@ -513,7 +516,10 @@ nil, any drops on FRAME itself will be ignored. This function might return immediately if no mouse buttons are currently being held down. It should only be called upon a -`down-mouse-1' (or similar) event." +`down-mouse-1' (or similar) event. + +This function is only supported on X Windows, macOS/GNUstep, and Haiku; +on all other platforms it will signal an error." (unless (fboundp 'x-begin-drag) (error "Dragging files from Emacs is not supported by this window system")) (dnd-remove-last-dragged-remote-file) @@ -580,7 +586,10 @@ FRAME, ACTION and ALLOW-SAME-FRAME mean the same as in FILES is a list of files that will be dragged. If the drop target doesn't support dropping multiple files, the first file in -FILES will be dragged." +FILES will be dragged. + +This function is only supported on X Windows, macOS/GNUstep, and Haiku; +on all other platforms it will signal an error." (unless (fboundp 'x-begin-drag) (error "Dragging files from Emacs is not supported by this window system")) (dnd-remove-last-dragged-remote-file) -- cgit v1.2.3 From 8cf05d9be12e8b5f8893cfd8a67c92e904a2aa05 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 16 Mar 2024 13:07:52 +0200 Subject: Fix 'shortdoc-copy-function-as-kill' * lisp/emacs-lisp/shortdoc.el (shortdoc-copy-function-as-kill): Fix handling of functions with no arguments. (Bug#69720) --- lisp/emacs-lisp/shortdoc.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 75ac7b3d52c..fdba6d32418 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1675,7 +1675,7 @@ With prefix numeric argument ARG, do it that many times." (interactive) (save-excursion (goto-char (pos-bol)) - (when-let* ((re (rx bol "(" (group (+ (not (in " ")))))) + (when-let* ((re (rx bol "(" (group (+ (not (in " )")))))) (string (and (or (looking-at re) (re-search-backward re nil t)) -- cgit v1.2.3 From f48babb1120343f211367a1b5854dc7740c3091d Mon Sep 17 00:00:00 2001 From: Konstantin Kharlamov Date: Sat, 16 Mar 2024 13:24:34 +0300 Subject: `term-mode': mention the keymap to add keybindings to A user typically expects a keymap for mode `foo' to be called `foo-mode-map'. term-mode has `term-mode-map' too, but for user-defined bindings to have effect they have to be put to `term-raw-map' instead. So let's mention that. * lisp/term.el (term-mode) (term-mode-map) (term-raw-map): Mention the keymaps to add keybindings to for `term-mode'. (Bug#69786) --- lisp/term.el | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/term.el b/lisp/term.el index 647938c3b86..e769577b4f2 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -658,7 +658,8 @@ executed once, when the buffer is created." ["Forward Output Group" term-next-prompt t] ["Kill Current Output Group" term-kill-output t])) map) - "Keymap for Term mode.") + "Keymap for \"line mode\" in Term mode. For custom keybindings purposes +please note there is also `term-raw-map'") (defvar term-escape-char nil "Escape character for char sub-mode of term mode. @@ -958,7 +959,9 @@ underlying shell." (dotimes (key 21) (keymap-set map (format "" key) #'term-send-function-key))) map) - "Keyboard map for sending characters directly to the inferior process.") + "Keyboard map for sending characters directly to the inferior process. +For custom keybindings purposes please note there is also +`term-mode-map'") (easy-menu-define term-terminal-menu (list term-mode-map term-raw-map term-pager-break-map) @@ -1122,6 +1125,10 @@ particular subprocesses. This can be done by setting the hooks and the variable `term-prompt-regexp' to the appropriate regular expression. +If you define custom keybindings, make sure to assign them to the +correct keymap (or to both): use `term-raw-map' in raw mode and +`term-mode-map' in line mode. + Commands in raw mode: \\{term-raw-map} -- cgit v1.2.3 From c890622e1a9ae6f2ab5d083ca8b668c9228c52fa Mon Sep 17 00:00:00 2001 From: Theodor Thornhill Date: Sat, 16 Mar 2024 20:28:10 +0100 Subject: Tweak regexp for object initializers in csharp-mode (bug#69571) * lisp/progmodes/csharp-mode.el (csharp-guess-basic-syntax): Add handling to not consider ended statements as object init openers. * test/lisp/progmodes/csharp-mode-resources/indent.erts: New test resources. * test/lisp/progmodes/csharp-mode-tests.el: Add test for this particular issue. --- lisp/progmodes/csharp-mode.el | 7 +++-- .../progmodes/csharp-mode-resources/indent.erts | 19 ++++++++++++++ test/lisp/progmodes/csharp-mode-tests.el | 30 ++++++++++++++++++++++ 3 files changed, 54 insertions(+), 2 deletions(-) create mode 100644 test/lisp/progmodes/csharp-mode-resources/indent.erts create mode 100644 test/lisp/progmodes/csharp-mode-tests.el (limited to 'lisp') diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 3cd64ae435f..2740d34e3b2 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -495,9 +495,12 @@ compilation and evaluation time conflicts." (unless (eq (char-after) ?{) (ignore-errors (backward-up-list 1 t t))) (save-excursion - ;; 'new' should be part of the line + ;; 'new' should be part of the line, but should not trigger if + ;; statement has already ended, like for 'var x = new X();'. + ;; Also, deal with the possible end of line obscured by a + ;; trailing comment. (goto-char (c-point 'iopl)) - (looking-at ".*new.*"))) + (looking-at "^[^//]*new[^//]*;$"))) ;; Line should not already be terminated (save-excursion (goto-char (c-point 'eopl)) diff --git a/test/lisp/progmodes/csharp-mode-resources/indent.erts b/test/lisp/progmodes/csharp-mode-resources/indent.erts new file mode 100644 index 00000000000..a676ecc9728 --- /dev/null +++ b/test/lisp/progmodes/csharp-mode-resources/indent.erts @@ -0,0 +1,19 @@ +Code: + (lambda () + (csharp-mode) + (indent-region (point-min) (point-max))) + +Point-Char: | + +Name: Don't consider closed statements as object initializers. (bug#69571) + +=-= +public class Foo { + void Bar () { + var x = new X(); // [1] + for (;;) { + x(); + } // [2] + } +} +=-=-= diff --git a/test/lisp/progmodes/csharp-mode-tests.el b/test/lisp/progmodes/csharp-mode-tests.el new file mode 100644 index 00000000000..f50fabf5836 --- /dev/null +++ b/test/lisp/progmodes/csharp-mode-tests.el @@ -0,0 +1,30 @@ +;;; csharp-mode-tests.el --- Tests for CC Mode C# mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'csharp-mode) + +(ert-deftest csharp-mode-test-indentation () + (ert-test-erts-file (ert-resource-file "indent.erts"))) + +(provide 'csharp-mode-tests) +;;; csharp-mode-tests.el ends here -- cgit v1.2.3 From 445e2499baa1b8ef21e8edcc13692b5d78912922 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 16 Mar 2024 23:10:48 -0400 Subject: debug.el: Prevent re-entering the debugger for the same error We can have several active `handler-bind`s that all want to invoke the debugger, in which case we can have the following sequence: - The more deeply nested handler calls the debugger. - After a while the user invokes `debugger-continue`. - `signal_or_quit` propagates the error up the stack to the second handler, which calls the debugger again. - The user thus ends up right back at the same place, as if `debugger-continue` had not be processed. Fix this by remembering the last processed error and skipping the debugger if we bump into it again. * lisp/emacs-lisp/debug.el (debugger--last-error): New var. (debugger--duplicate-p): New function. (debug): Use them. --- lisp/emacs-lisp/debug.el | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 60d14d11970..ec947c1215d 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -153,6 +153,12 @@ where CAUSE can be: (insert (debugger--buffer-state-content state))) (goto-char (debugger--buffer-state-pos state))) +(defvar debugger--last-error nil) + +(defun debugger--duplicate-p (args) + (pcase args + (`(error ,err . ,_) (and (consp err) (eq err debugger--last-error))))) + ;;;###autoload (setq debugger 'debug) ;;;###autoload @@ -175,9 +181,14 @@ first will be printed into the backtrace buffer. If `inhibit-redisplay' is non-nil when this function is called, the debugger will not be entered." (interactive) - (if inhibit-redisplay - ;; Don't really try to enter debugger within an eval from redisplay. + (if (or inhibit-redisplay + (debugger--duplicate-p args)) + ;; Don't really try to enter debugger within an eval from redisplay + ;; or if we already popper into the debugger for this error, + ;; which can happen when we have several nested `handler-bind's that + ;; want to invoke the debugger. debugger-value + (setq debugger--last-error nil) (let ((non-interactive-frame (or noninteractive ;FIXME: Presumably redundant. ;; If we're in the initial-frame (where `message' just @@ -318,6 +329,12 @@ the debugger will not be entered." (backtrace-mode)))) (with-timeout-unsuspend debugger-with-timeout-suspend) (set-match-data debugger-outer-match-data))) + (when (eq 'error (car-safe debugger-args)) + ;; Remember the error we just debugged, to avoid re-entering + ;; the debugger if some higher-up `handler-bind' invokes us + ;; again, oblivious that the error was already debugged from + ;; a more deeply nested `handler-bind'. + (setq debugger--last-error (nth 1 debugger-args))) (setq debug-on-next-call debugger-step-after-exit) debugger-value)))) -- cgit v1.2.3 From 21828f288ef57422d12860d71e3d4cd8b8cc97b4 Mon Sep 17 00:00:00 2001 From: Kévin Le Gouguec Date: Mon, 12 Feb 2024 08:29:19 +0100 Subject: Fix vc-dir when "remote" Git branch is local While in there, add that "tracking" branch to the vc-dir buffer. For bug#68183. * lisp/vc/vc-git.el (vc-git-dir-extra-headers): Reduce boilerplate with new function 'vc-git--out-ok'; stop calling vc-git-repository-url when REMOTE is "." to avoid throwing an error; display tracking branch; prefer "none ()" to "not ()" since that reads more grammatically correct. (vc-git--out-ok): Add documentation. (vc-git--out-str): New function to easily get the output from a Git command. * test/lisp/vc/vc-git-tests.el (vc-git-test--with-repo) (vc-git-test--run): New helpers, defined to steer clear of vc-git-- internal functions. (vc-git-test-dir-track-local-branch): Check that vc-dir does not crash. --- lisp/vc/vc-git.el | 46 ++++++++++++++++++++++++++++++-------------- test/lisp/vc/vc-git-tests.el | 40 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 72 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 18b4a8691e9..0d54e234659 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -817,27 +817,31 @@ or an empty string if none." cmds)) (defun vc-git-dir-extra-headers (dir) - (let ((str (with-output-to-string - (with-current-buffer standard-output - (vc-git--out-ok "symbolic-ref" "HEAD")))) + (let ((str (vc-git--out-str "symbolic-ref" "HEAD")) (stash-list (vc-git-stash-list)) (default-directory dir) (in-progress (vc-git--cmds-in-progress)) - branch remote remote-url stash-button stash-string) + branch remote-url stash-button stash-string tracking-branch) (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) (progn (setq branch (match-string 2 str)) - (setq remote - (with-output-to-string - (with-current-buffer standard-output - (vc-git--out-ok "config" - (concat "branch." branch ".remote"))))) - (when (string-match "\\([^\n]+\\)" remote) - (setq remote (match-string 1 remote))) - (when (> (length remote) 0) - (setq remote-url (vc-git-repository-url dir remote)))) - (setq branch "not (detached HEAD)")) + (let ((remote (vc-git--out-str + "config" (concat "branch." branch ".remote"))) + (merge (vc-git--out-str + "config" (concat "branch." branch ".merge")))) + (when (string-match "\\([^\n]+\\)" remote) + (setq remote (match-string 1 remote))) + (when (string-match "^\\(refs/heads/\\)?\\(.+\\)$" merge) + (setq tracking-branch (match-string 2 merge))) + (pcase remote + ("." + (setq remote-url "none (tracking local branch)")) + ((pred (not string-empty-p)) + (setq + remote-url (vc-git-repository-url dir remote) + tracking-branch (concat remote "/" tracking-branch)))))) + (setq branch "none (detached HEAD)")) (when stash-list (let* ((len (length stash-list)) (limit @@ -890,6 +894,11 @@ or an empty string if none." (propertize "Branch : " 'face 'vc-dir-header) (propertize branch 'face 'vc-dir-header-value) + (when tracking-branch + (concat + "\n" + (propertize "Tracking : " 'face 'vc-dir-header) + (propertize tracking-branch 'face 'vc-dir-header-value))) (when remote-url (concat "\n" @@ -2226,8 +2235,17 @@ The difference to vc-do-command is that this function always invokes (apply #'process-file vc-git-program nil buffer nil "--no-pager" command args))) (defun vc-git--out-ok (command &rest args) + "Run `git COMMAND ARGS...' and insert standard output in current buffer. +Return whether the process exited with status zero." (zerop (apply #'vc-git--call '(t nil) command args))) +(defun vc-git--out-str (command &rest args) + "Run `git COMMAND ARGS...' and return standard output. +The exit status is ignored." + (with-output-to-string + (with-current-buffer standard-output + (apply #'vc-git--out-ok command args)))) + (defun vc-git--run-command-string (file &rest args) "Run a git command on FILE and return its output as string. FILE can be nil." diff --git a/test/lisp/vc/vc-git-tests.el b/test/lisp/vc/vc-git-tests.el index c52cd9c5875..fd3e8ccd602 100644 --- a/test/lisp/vc/vc-git-tests.el +++ b/test/lisp/vc/vc-git-tests.el @@ -24,6 +24,8 @@ ;;; Code: +(require 'ert-x) +(require 'vc) (require 'vc-git) (ert-deftest vc-git-test-program-version-general () @@ -81,4 +83,42 @@ (should-not (vc-git-annotate-time)) (should-not (vc-git-annotate-time)))) +(defmacro vc-git-test--with-repo (name &rest body) + "Initialize a repository in a temporary directory and evaluate BODY. + +The current directory will be set to the top of that repository; NAME +will be bound to that directory's file name. Once BODY exits, the +directory will be deleted." + (declare (indent 1)) + `(ert-with-temp-directory ,name + (let ((default-directory ,name)) + (vc-create-repo 'Git) + ,@body))) + +(defun vc-git-test--run (&rest args) + "Run git ARGS…, check for non-zero status, and return output." + (with-temp-buffer + (apply 'vc-git-command t 0 nil args) + (buffer-string))) + +(ert-deftest vc-git-test-dir-track-local-branch () + "Test that `vc-dir' works when tracking local branches. Bug#68183." + (skip-unless (executable-find vc-git-program)) + (vc-git-test--with-repo repo + ;; Create an initial commit to get a branch started. + (write-region "hello" nil "README") + (vc-git-test--run "add" "README") + (vc-git-test--run "commit" "-mFirst") + ;; Get current branch name lazily, to remain agnostic of + ;; init.defaultbranch. + (let ((upstream-branch + (string-trim (vc-git-test--run "branch" "--show-current")))) + (vc-git-test--run "checkout" "--track" "-b" "hack" upstream-branch) + (vc-dir default-directory) + (pcase-dolist (`(,header ,value) + `(("Branch" "hack") + ("Tracking" ,upstream-branch))) + (goto-char (point-min)) + (re-search-forward (format "^%s *: %s$" header value)))))) + ;;; vc-git-tests.el ends here -- cgit v1.2.3 From 67b0c1c09eab65c302eb02b20d87900be6367565 Mon Sep 17 00:00:00 2001 From: Protesilaos Stavrou Date: Sun, 17 Mar 2024 18:46:15 +0200 Subject: Update modus-themes to their 4.4.0 version * doc/misc/modus-themes.org: Update the manual to better document existing functionality and cover the new features. * etc/themes/modus-operandi-deuteranopia-theme.el: * etc/themes/modus-operandi-theme.el: * etc/themes/modus-operandi-tinted-theme.el: * etc/themes/modus-operandi-tritanopia-theme.el: * etc/themes/modus-vivendi-deuteranopia-theme.el: * etc/themes/modus-vivendi-theme.el: * etc/themes/modus-vivendi-tinted-theme.el: * etc/themes/modus-vivendi-tritanopia-theme.el: Update the palette of each theme. * etc/themes/modus-themes.el (require): Remove call to cl-lib and do not use relevant functions. (modus-themes-operandi-colors, modus-themes-vivendi-colors) (modus-themes-version, modus-themes-report-bug): Remove old calls to 'make-obsolete' and related. (modus-themes--annotate-theme): Tweak the completion annotation function. (modus-themes--org-block): Deprecate the user option 'modus-themes-org-blocks'. (modus-themes-faces): Update faces. (modus-themes-custom-variables): Update the list of custom variables. Detailed release notes are available here: . --- doc/misc/modus-themes.org | 1435 ++++++++++++----------- etc/themes/modus-operandi-deuteranopia-theme.el | 77 +- etc/themes/modus-operandi-theme.el | 75 +- etc/themes/modus-operandi-tinted-theme.el | 84 +- etc/themes/modus-operandi-tritanopia-theme.el | 77 +- etc/themes/modus-themes.el | 545 ++++----- etc/themes/modus-vivendi-deuteranopia-theme.el | 78 +- etc/themes/modus-vivendi-theme.el | 77 +- etc/themes/modus-vivendi-tinted-theme.el | 96 +- etc/themes/modus-vivendi-tritanopia-theme.el | 77 +- lisp/vc/vc-git.el | 46 +- test/lisp/vc/vc-git-tests.el | 40 - 12 files changed, 1428 insertions(+), 1279 deletions(-) (limited to 'lisp') diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org index 45f96778203..c3de15c35ad 100644 --- a/doc/misc/modus-themes.org +++ b/doc/misc/modus-themes.org @@ -4,9 +4,9 @@ #+language: en #+options: ':t toc:nil author:t email:t num:t #+startup: content -#+macro: stable-version 4.3.0 -#+macro: release-date 2023-09-19 -#+macro: development-version 4.4.0-dev +#+macro: stable-version 4.4.0 +#+macro: release-date 2024-03-17 +#+macro: development-version 4.5.0-dev #+macro: file @@texinfo:@file{@@$1@@texinfo:}@@ #+macro: space @@texinfo:@: @@ #+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@ @@ -37,12 +37,10 @@ Current development target is {{{development-version}}}. + Change log: + Color palette: + Sample pictures: -+ Git repo on SourceHut: - - Mirrors: - + GitHub: - + GitLab: -+ Mailing list: -+ Backronym: My Old Display Unexpectedly Sharpened ... themes ++ Git repositories: + + GitHub: + + GitLab: ++ Backronym: My Old Display Unexpectedly Sharpened ... themes. #+toc: headlines 8 insert TOC here, with eight headline levels @@ -90,7 +88,7 @@ The Modus themes consist of eight themes, divided into four subgroups. are variants of the two main themes. They slightly tone down the intensity of the background and provide a bit more color variety. ~modus-operandi-tinted~ has a set of base tones that are shades of - light ocher (earthly colors), while ~modus-vivendi-tinted~ gives a + light ochre (earthly colors), while ~modus-vivendi-tinted~ gives a night sky impression. - Deuteranopia themes :: ~modus-operandi-deuteranopia~ and its @@ -265,9 +263,6 @@ wrong. :properties: :custom_id: h:3f3c3728-1b34-437d-9d0c-b110f5b161a9 :end: -#+findex: modus-themes-toggle -#+findex: modus-themes-load-theme -#+vindex: modus-themes-after-load-theme-hook #+cindex: Essential configuration NOTE that Emacs can load multiple themes, which typically produces @@ -285,7 +280,7 @@ theme of their preference by adding either form to their init file: (load-theme 'modus-vivendi) ; Dark theme #+end_src -Remember that the Modus themes are six themes ([[#h:f0f3dbcb-602d-40cf-b918-8f929c441baf][Overview]]). Adapt the +Remember that there are multiple Modus themes ([[#h:f0f3dbcb-602d-40cf-b918-8f929c441baf][Overview]]). Adapt the above snippet accordingly. Users of packaged variants of the themes must add a few more lines to @@ -342,6 +337,38 @@ This is how a basic setup could look like ([[#h:b66b128d-54a4-4265-b59f-4d1ea2fe [[#h:e979734c-a9e1-4373-9365-0f2cd36107b8][Sample configuration with and without use-package]]. +To disable other themes before loading a Modus theme, use something +like this: + +#+begin_src emacs-lisp +(mapc #'disable-theme custom-enabled-themes) +(load-theme 'modus-operandi :no-confirm) +#+end_src + +#+findex: modus-themes-load-theme +Instead of using the basic ~load-theme~ function, users can rely on +the ~modus-themes-load-theme~. It accepts a single argument, which is +a symbol representing the Modus theme of choice, such as: + +#+begin_src emacs-lisp +(modus-themes-load-theme 'modus-operandi) +#+end_src + +#+vindex: modus-themes-after-load-theme-hook +#+vindex: modus-themes-post-load-hook +The ~modus-themes-load-theme~ takes care to disable other themes, if +the user opts in ([[#h:adb0c49a-f1f9-4690-868b-013a080eed68][Option for disabling other themes while loading Modus]]). +After loading the theme of choice, this function calls the +hook ~modus-themes-after-load-theme-hook~ (alias ~modus-themes-post-load-hook~). +Users can add their own functions to this hook to make further +customizations ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]). + +#+findex: modus-themes-toggle +#+findex: modus-themes-select +The commands ~modus-themes-toggle~ and ~modus-themes-select~ use +~modus-themes-load-theme~ internally ([[#h:4fbfed66-5a89-447a-a07d-a03f6819c5bd][Option for which themes to toggle]]). +The aforementioned hold true for them as well. + ** The ~require-theme~ for built-in Emacs themes :PROPERTIES: :CUSTOM_ID: h:b66b128d-54a4-4265-b59f-4d1ea2feb073 @@ -449,8 +476,6 @@ will lead to failures in loading the files. If either or both of those variables need to be changed, their values should be defined before the package declaration of the themes. -[[#h:aabcada6-810d-4eee-b34a-d2a9c301824d][Make the themes look like what the maintainer uses]] - ** Differences between loading and enabling :properties: :custom_id: h:e68560b3-7fb0-42bc-a151-e015948f8a35 @@ -608,9 +633,9 @@ Possible values: When the value is non-~nil~, the commands ~modus-themes-toggle~ and ~modus-themes-select~, as well as the ~modus-themes-load-theme~ function, will disable all other themes while loading the specified -Modus theme. This is done to ensure that Emacs does not blend two or -more themes: such blends lead to awkward results that undermine the -work of the designer. +Modus theme ([[#h:4fbfed66-5a89-447a-a07d-a03f6819c5bd][Option for which themes to toggle]]). This is done to +ensure that Emacs does not blend two or more themes: such blends lead +to awkward results that undermine the work of the designer. When the value is ~nil~, the aforementioned commands and function will only disable other themes within the Modus collection. @@ -678,6 +703,32 @@ Advanced users may also want to configure the exact attributes of the [[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]. +** Option for which themes to toggle +:PROPERTIES: +:CUSTOM_ID: h:4fbfed66-5a89-447a-a07d-a03f6819c5bd +:END: +#+vindex: modus-themes-to-toggle + +Brief: Choose to Modus themes to toggle between + +Symbol: ~modus-themes-to-toggle~ (=list= type) + +Default value: ='(modus-operandi modus-vivendi)= + +Possible values: + +- ~modus-operandi~ +- ~modus-vivendi~ +- ~modus-operandi-tinted~ +- ~modus-vivendi-tinted~ +- ~modus-operandi-deuteranopia~ +- ~modus-vivendi-deuteranopia~ +- ~modus-operandi-tritanopia~ +- ~modus-vivendi-tritanopia~ + +Specify two themes to toggle between using the command +~modus-themes-toggle~. + ** Option for font mixing :properties: :alt_title: Mixed fonts @@ -851,43 +902,13 @@ Is the same as: :end: #+vindex: modus-themes-org-blocks -Brief: Set the overall style of Org code blocks, quotes, and the like. - -Symbol: ~modus-themes-org-blocks~ (=choice= type) - -Possible values: +As part of version =4.4.0=, the ~modus-themes-org-blocks~ is no more. +Users can apply palette overrides to set a style that fits their +preference (purple, blue, yellow, green, etc.). It is more flexible +and more powerful ([[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][DIY Make Org block colors more or less colorful]]) -1. ~nil~ (default) -2. ~gray-background~ -3. ~tinted-background~ - -Option ~nil~ (the default) means that the block has no background of -its own: it uses the one that applies to the rest of the buffer. -In this case, the delimiter lines have a gray color for their text, -making them look exactly like all other Org properties. - -Option ~gray-background~ applies a subtle gray background to the -block's contents. It also affects the begin and end lines of the -block as they get another shade of gray as their background, which -differentiates them from the contents of the block. All background -colors extend to the edge of the window, giving the area a -rectangular, "blocky" presentation. If the begin/end lines do not -extend in this way, check the value of the Org user option -~org-fontify-whole-block-delimiter-line~. - -Option ~tinted-background~ uses a colored background for the contents -of the block. The exact color value will depend on the programming -language and is controlled by the variable ~org-src-block-faces~ -(refer to the theme's source code for the current association list). -For this to take effect, the Org buffer needs to be restarted with -~org-mode-restart~. - -Code blocks use their major mode's fontification (syntax highlighting) -only when the variable ~org-src-fontify-natively~ is non-~nil~. While -quote/verse blocks require setting -~org-fontify-quote-and-verse-blocks~ to a non-~nil~ value. - -[[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][Update Org block delimiter fontification]]. +For the option to change the background of Org source blocks, we +provide the relevant setup ([[#h:8c842804-43b7-4287-b4e9-8c07d04d1f89][DIY Use colored Org source blocks per language]]). ** Option for the headings' overall style :properties: @@ -1169,22 +1190,175 @@ Named colors can be previewed, such as with the command For a video tutorial that users of all skill levels can approach, watch: https://protesilaos.com/codelog/2022-12-17-modus-themes-v4-demo/. +* Preview theme colors +:properties: +:custom_id: h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d +:end: +#+cindex: Preview named colors or semantic color mappings + +#+findex: modus-themes-list-colors +The command ~modus-themes-list-colors~ uses minibuffer completion to +select an item from the Modus themes and then produces a buffer with +previews of its color palette entries. The buffer has a naming scheme +that reflects the given choice, like =modus-operandi-list-colors= for +the ~modus-operandi~ theme. + +#+findex: modus-themes-list-colors-current +The command ~modus-themes-list-colors-current~ skips the minibuffer +selection process and just produces a preview for the current Modus +theme. + +When called with a prefix argument (=C-u= with the default key +bindings), these commands will show a preview of the palette's +semantic color mappings instead of the named colors. In this context, +"named colors" are entries that associate a symbol to a string color +value, such as =(blue-warmer "#354fcf")=. Whereas "semantic color +mappings" associate a named color to a symbol, like =(string +blue-warmer)=, thus making the theme render all string constructs in +the =blue-warmer= color value ([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]). + +#+findex: modus-themes-preview-colors +#+findex: modus-themes-preview-colors-current +Aliases for those commands are ~modus-themes-preview-colors~ and +~modus-themes-preview-colors-current~. + +Each row shows a foreground and background coloration using the +underlying value it references. For example a line with =#a60000= (a +shade of red) will show red text followed by a stripe with that same +color as a backdrop. + +The name of the buffer describes the given Modus theme and what the +contents are, such as =*modus-operandi-list-colors*= for named colors +and ==*modus-operandi-list-mappings*= for the semantic color mappings. + +* Use colors from the Modus themes palette +:PROPERTIES: +:CUSTOM_ID: h:33460ae8-984b-40fd-8baa-383cc5fc2698 +:END: + +The Modus themes provide the means to access the palette of (i) the +active theme or (ii) any theme in the Modus collection. These are +useful for Do-It-Yourself customizations ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]), +though it can also be helpful in other cases, such as to reuse a color +value in some other application. + +- Function :: [[#h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e][Get a single color from the palette with ~modus-themes-get-color-value~]] +- Macro :: [[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with ~modus-themes-with-colors~]]. + +** Get a single color from the palette with ~modus-themes-get-color-value~ +:PROPERTIES: +:CUSTOM_ID: h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e +:END: + +#+findex: modus-themes-get-color-value +The fuction ~modus-themes-get-color-value~ can be called from Lisp to +return the value of a color from the active Modus theme palette. It +takea a =COLOR= argument and an optional =OVERRIDES=. It also accepts +a third =THEME= argument, to get the color from the given theme. + +=COLOR= is a symbol that represents a named color entry in the +palette ([[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]]). + +If the value is the name of another color entry in the palette (so a +mapping), this function recurs until it finds the underlying color +value. + +With an optional =OVERRIDES= argument as a non-~nil~ value, it +accounts for palette overrides. Else it reads only the default palette +([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]) + +With an optional =THEME= as a symbol among the ~modus-themes-items~ +(alias ~modus-themes-collection~), it uses the palette of that theme. +Else it uses the current Modus theme. + +If =COLOR= is not present in the palette, this function returns the +~unspecified~ symbol, which is safe when used as a face attribute's +value. + +An example with ~modus-operandi~ to show how this function behaves +with/without overrides and when recursive mappings are introduced. + +#+begin_src emacs-lisp +;; Here we show the recursion of palette mappings. In general, it is +;; better for the user to specify named colors to avoid possible +;; confusion with their configuration, though those still work as +;; expected. +(setq modus-themes-common-palette-overrides + '((cursor red) + (fg-mode-line-active cursor) + (border-mode-line-active fg-mode-line-active))) + +;; Ignore the overrides and get the original value. +(modus-themes-get-color-value 'border-mode-line-active) +;; => "#5a5a5a" + +;; Read from the overrides and deal with any recursion to find the +;; underlying value. +(modus-themes-get-color-value 'border-mode-line-active :overrides) +;; => "#a60000" +#+end_src + +** Use theme colors in code with ~modus-themes-with-colors~ +:properties: +:custom_id: h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae +:end: +#+cindex: Use colors from the palette anywhere + +[ Note that for common cases the following is not not needed. Just rely on + the comprehensive overrides we provide ([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]). ] + +#+findex: modus-themes-with-colors +Advanced users may want to apply many colors from the palette of the +active Modus theme in their custom code. In such a case, retrieving +each value with the function ~modus-themes-get-color-value~ is +inefficient ([[#h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e][Get a single color from the palette]]). The Lisp macro +~modus-themes-with-colors~ provides the requisite functionality. It +supplies the current theme's palette to the code called from inside of +it. For example: + +#+begin_src emacs-lisp +(modus-themes-with-colors + (list blue-warmer magenta-cooler fg-added warning variable fg-heading-4)) +;; => ("#354fcf" "#531ab6" "#005000" "#884900" "#005e8b" "#721045") +#+end_src + +The above return value is for ~modus-operandi~ when that is the active +theme. Switching to another theme and evaluating this code anew will +return the relevant results for that theme (remember that since +version 4, the Modus themes consist of many items ([[#h:f0f3dbcb-602d-40cf-b918-8f929c441baf][Overview]])). The +same with ~modus-vivendi~ as the active theme: + +#+begin_src emacs-lisp +(modus-themes-with-colors + (list blue-warmer magenta-cooler fg-added warning variable fg-heading-4)) +;; => ("#79a8ff" "#b6a0ff" "#a0e0a0" "#fec43f" "#00d3d0" "#feacd0") +#+end_src + +The ~modus-themes-with-colors~ has access to the whole palette of the +active theme, meaning that it can instantiate both (i) named colors +like =blue-warmer= and (ii) semantic color mappings like =warning=. +We provide commands to inspect those ([[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]]). + +Others sections in this manual show how to use the aforementioned +macro ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]). In practice, the use of a hook will +also be needed ([[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][DIY Use a hook at the post-load-theme phase]]). + * Advanced customization :properties: :custom_id: h:f4651d55-8c07-46aa-b52b-bed1e53463bb :end: -Unlike the predefined customization options which follow a clear pattern -of allowing the user to quickly specify their preference, the themes -also provide a more flexible, albeit difficult, mechanism to control -things with precision ([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization Options]]). +Unlike the predefined customization options which follow a clear +pattern of allowing the user to quickly specify their preference, the +themes also provide a more flexible, albeit a bit more difficult, +mechanism to control things with precision ([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization Options]]). This section is of interest only to users who are prepared to maintain their own local tweaks and who are willing to deal with any possible -incompatibilities between versioned releases of the themes. As such, +incompatibilities between versioned releases of the themes. As such, they are labeled as "do-it-yourself" or "DIY". -** Palette override presets +** DIY Palette override presets :PROPERTIES: :CUSTOM_ID: h:b0bc811c-227e-42ec-bf67-15e1f41eb7bc :END: @@ -1257,7 +1431,7 @@ the general idea (extra space for didactic purposes): ,@modus-themes-preset-overrides-intense)) #+end_src -** Stylistic variants using palette overrides +** DIY Stylistic variants using palette overrides :PROPERTIES: :CUSTOM_ID: h:df1199d8-eaba-47db-805d-6b568a577bf3 :END: @@ -1269,7 +1443,7 @@ to take effect. To apply overrides at startup simply define them before the call that loads the theme. Remember that we also provide presets that are easier to apply ([[#h:b0bc811c-227e-42ec-bf67-15e1f41eb7bc][Palette override presets]]). -*** Make the mode line borderless +*** DIY Make the mode line borderless :PROPERTIES: :CUSTOM_ID: h:80ddba52-e188-411f-8cc0-480ebd75befe :END: @@ -1284,14 +1458,6 @@ set their color to that of the underlying background. [[#h:5a0c58cc-f97f-429c-be08-927b9fbb0a9c][Add padding to mode line]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - ;; Remove the border (setq modus-themes-common-palette-overrides '((border-mode-line-active unspecified) @@ -1306,7 +1472,9 @@ set their color to that of the underlying background. (border-mode-line-inactive bg-mode-line-inactive))) #+end_src -*** Make the active mode line colorful +Reload the theme for changes to take effect. + +*** DIY Make the active mode line colorful :PROPERTIES: :CUSTOM_ID: h:e8d781be-eefc-4a81-ac4e-5ed156190df7 :END: @@ -1323,14 +1491,6 @@ have a blue mode line for ~modus-operandi~ and a red one for [[#h:5a0c58cc-f97f-429c-be08-927b9fbb0a9c][Add padding to mode line]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - ;; Blue background, neutral foreground, intense blue border (setq modus-themes-common-palette-overrides '((bg-mode-line-active bg-blue-intense) @@ -1343,14 +1503,28 @@ have a blue mode line for ~modus-operandi~ and a red one for (fg-mode-line-active fg-main) (border-mode-line-active blue-intense))) -;; Subtle red background, red foreground, invisible border +;; Sage (green/cyan) background, neutral foreground, slightly distinct green border +(setq modus-themes-common-palette-overrides + '((bg-mode-line-active bg-sage) + (fg-mode-line-active fg-main) + (border-mode-line-active bg-green-intense))) + +;; As above, but with a purple style (setq modus-themes-common-palette-overrides - '((bg-mode-line-active bg-red-subtle) - (fg-mode-line-active red-warmer) - (border-mode-line-active bg-red-subtle))) + '((bg-mode-line-active bg-lavender) + (fg-mode-line-active fg-main) + (border-mode-line-active bg-magenta-intense))) + +;; As above, but with an earthly style +(setq modus-themes-common-palette-overrides + '((bg-mode-line-active bg-ochre) + (fg-mode-line-active fg-main) + (border-mode-line-active bg-yellow-intense))) #+end_src -*** Make the tab bar more or less colorful +Reload the theme for changes to take effect. + +*** DIY Make the tab bar more or less colorful :PROPERTIES: :CUSTOM_ID: h:096658d7-a0bd-4a99-b6dc-9b20a20cda37 :END: @@ -1365,15 +1539,6 @@ fringes, and line numbers. These are shown in other sections of this manual. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - - ;; Make the `tab-bar-mode' mode subtle while keepings its original ;; gray aesthetic. (setq modus-themes-common-palette-overrides @@ -1402,7 +1567,9 @@ manual. (bg-tab-other bg-cyan-subtle))) #+end_src -*** Make the fringe invisible or another color +Reload the theme for changes to take effect. + +*** DIY Make the fringe invisible or another color :PROPERTIES: :CUSTOM_ID: h:c312dcac-36b6-4a1f-b1f5-ab1c9abe27b0 :END: @@ -1415,14 +1582,6 @@ side of the Emacs window which shows indicators such as for truncation or continuation lines. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - ;; Make the fringe invisible (setq modus-themes-common-palette-overrides '((fringe unspecified))) @@ -1436,7 +1595,9 @@ or continuation lines. '((fringe bg-blue-nuanced))) #+end_src -*** Make links use subtle or no underlines +Reload the theme for changes to take effect. + +*** DIY Make links use subtle or no underlines :PROPERTIES: :CUSTOM_ID: h:6c1d1dea-5cbf-4d92-b7bb-570a7a23ffe9 :END: @@ -1460,7 +1621,9 @@ that underline mappings can read correctly. (underline-link-symbolic unspecified))) #+end_src -*** Make prompts more or less colorful +Reload the theme for changes to take effect. + +*** DIY Make prompts more or less colorful :PROPERTIES: :CUSTOM_ID: h:bd75b43a-0bf1-45e7-b8b4-20944ca8b7f8 :END: @@ -1472,14 +1635,6 @@ block we show how to add or remove color from prompts. [[#h:db5a9a7c-2928-4a28-b0f0-6f2b9bd52ba1][Option for command prompt styles]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - ;; Keep the background unspecified (like the default), but use a faint ;; foreground color. (setq modus-themes-common-palette-overrides @@ -1497,7 +1652,9 @@ block we show how to add or remove color from prompts. (bg-prompt bg-yellow-subtle))) ; try to replace "subtle" with "intense" #+end_src -*** Make completion matches more or less colorful +Reload the theme for changes to take effect. + +*** DIY Make completion matches more or less colorful :PROPERTIES: :CUSTOM_ID: h:d959f789-0517-4636-8780-18123f936f91 :END: @@ -1510,14 +1667,6 @@ three different degrees of intensity. [[#h:f1c20c02-7b34-4c35-9c65-99170efb2882][Option for completion framework aesthetics]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - ;; Add a nuanced background color to completion matches, while keeping ;; their foreground intact (foregrounds do not need to be specified in ;; this case, but we do it for didactic purposes). @@ -1584,7 +1733,9 @@ colors to two: The user can mix and match to their liking. -*** Make comments yellow and strings green +Reload the theme for changes to take effect. + +*** DIY Make comments yellow and strings green :PROPERTIES: :CUSTOM_ID: h:26f53daa-0065-48dc-88ab-6a718d16cd95 :END: @@ -1601,14 +1752,6 @@ reproduce the effect, but also how to tweak it to one's liking. [[#h:943063da-7b27-4ba4-9afe-f8fe77652fd1][Make use of alternative styles for code syntax]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - ;; Yellow comments and green strings like older versions of the Modus ;; themes (setq modus-themes-common-palette-overrides @@ -1627,7 +1770,9 @@ reproduce the effect, but also how to tweak it to one's liking. (string yellow-cooler))) #+end_src -*** Make code syntax use the old alt-syntax style +Reload the theme for changes to take effect. + +*** DIY Make code syntax use the old alt-syntax style :PROPERTIES: :CUSTOM_ID: h:c8767172-bf11-4c96-81dc-e736c464fc9c :END: @@ -1640,16 +1785,7 @@ upside of using overrides for this purpose is that we can tweak the style to our liking, but first let's start with its recreation: #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - - -;; The old "alt-syntax" +;; The old "alt-syntax" (before version 4.0.0 of the Modus themes) (setq modus-themes-common-palette-overrides '((builtin magenta) (comment fg-dim) @@ -1712,7 +1848,9 @@ The user can always mix and match styles to their liking. [[#h:943063da-7b27-4ba4-9afe-f8fe77652fd1][Make use of alternative styles for code syntax]]. -*** Make use of alternative styles for code syntax +Reload the theme for changes to take effect. + +*** DIY Make use of alternative styles for code syntax :PROPERTIES: :CUSTOM_ID: h:943063da-7b27-4ba4-9afe-f8fe77652fd1 :END: @@ -1730,18 +1868,9 @@ theme palette. [[#h:26f53daa-0065-48dc-88ab-6a718d16cd95][Make comments yellow and strings green]]. -[[*Make code syntax use the old alt-syntax style][Make code syntax use the old alt-syntax style]]. +[[#h:c8767172-bf11-4c96-81dc-e736c464fc9c][Make code syntax use the old alt-syntax style]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - - ;; Mimic `ef-night' theme (from my `ef-themes') for code syntax ;; highlighting, while still using the Modus colors (and other ;; mappings). @@ -1803,7 +1932,9 @@ theme palette. (variable cyan-warmer))) #+end_src -*** Make matching parenthesis more or less intense +Reload the theme for changes to take effect. + +*** DIY Make matching parenthesis more or less intense :PROPERTIES: :CUSTOM_ID: h:259cf8f5-48ec-4b13-8a69-5d6387094468 :END: @@ -1815,14 +1946,6 @@ delimiters when ~show-paren-mode~ is enabled. We also demonstrate how to enable underlines for those highlights. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - ;; Change the background to a shade of magenta (setq modus-themes-common-palette-overrides '((bg-paren-match bg-magenta-intense))) @@ -1831,9 +1954,17 @@ to enable underlines for those highlights. (setq modus-themes-common-palette-overrides '((bg-paren-match bg-magenta-intense) (underline-paren-match fg-main))) + +;; Do not use any background color and instead apply an intense red +;; foreground. +(setq modus-themes-common-palette-overrides + '((bg-paren-match unspecified) + (fg-paren-match red-intense))) #+end_src -*** Make box buttons more or less gray +Reload the theme for changes to take effect. + +*** DIY Make box buttons more or less gray :PROPERTIES: :CUSTOM_ID: h:4f6b6ca3-f5bb-4830-8312-baa232305360 :END: @@ -1846,14 +1977,6 @@ removes the gray from the active buttons and amplifies it for the inactive ones. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - (setq modus-themes-common-palette-overrides '((bg-button-active bg-main) (fg-button-active fg-main) @@ -1861,7 +1984,9 @@ inactive ones. (fg-button-inactive "gray50"))) #+end_src -*** Make TODO and DONE more or less intense +Reload the theme for changes to take effect. + +*** DIY Make TODO and DONE more or less intense :PROPERTIES: :CUSTOM_ID: h:b57bb50b-a863-4ea8-bb38-6de2275fa868 :END: @@ -1877,14 +2002,6 @@ to subdue them. [[#h:bb5b396f-5532-4d52-ab13-149ca24854f1][Make inline code in prose use alternative styles]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - ;; Increase intensity (setq modus-themes-common-palette-overrides '((prose-done green-intense) @@ -1901,7 +2018,9 @@ to subdue them. '((prose-done fg-dim))) #+end_src -*** Make headings more or less colorful +Reload the theme for changes to take effect. + +*** DIY Make headings more or less colorful :PROPERTIES: :CUSTOM_ID: h:11297984-85ea-4678-abe9-a73aeab4676a :END: @@ -1916,15 +2035,6 @@ match styles at will. [[#h:b57bb50b-a863-4ea8-bb38-6de2275fa868][Make TODO and DONE more intense]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - - ;; Apply more colorful foreground to some headings (headings 0-8). ;; Level 0 is for Org #+title and related. (setq modus-themes-common-palette-overrides @@ -1958,7 +2068,107 @@ match styles at will. (overline-heading-1 border))) #+end_src -*** Make Org agenda more or less colorful +Reload the theme for changes to take effect. + +*** DIY Make Org block colors more or less colorful +:properties: +:custom_id: h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50 +:end: + +This is one of our practical examples to override the semantic colors +of the Modus themes ([[#h:df1199d8-eaba-47db-805d-6b568a577bf3][Stylistic variants using palette overrides]]). Here +we show how to change the presentation of Org blocks (and other such +blocks like Markdown fenced code sections, though the exact +presentation depends on each major mode). + +The default style of Org blocks is a subtle gray background for the +contents and for the delimiter lines (the =#+begin_= and =#+end_= +parts). The text of the delimiter lines is a subtle gray foreground +color. + +[[#h:bb5b396f-5532-4d52-ab13-149ca24854f1][Make inline code in prose use alternative styles]]. + +#+begin_src emacs-lisp +;; Make code blocks (in Org, for example) use a more colorful style +;; for their delimiter lines as well as their contents. Give this a +;; purple feel. Make the delimiter lines distinct from the contents. +(setq modus-themes-common-palette-overrides + '((bg-prose-block-contents bg-magenta-nuanced) + (bg-prose-block-delimiter bg-lavender) + (fg-prose-block-delimiter fg-main))) + +;; As above, but with a more blue feel. +(setq modus-themes-common-palette-overrides + '((bg-prose-block-contents bg-blue-nuanced) + (bg-prose-block-delimiter bg-lavender) + (fg-prose-block-delimiter fg-main))) + +;; As above, but with a green feel. +(setq modus-themes-common-palette-overrides + '((bg-prose-block-contents bg-green-nuanced) + (bg-prose-block-delimiter bg-sage) + (fg-prose-block-delimiter fg-main))) + +;; As above, but with a yellow/gold feel. +(setq modus-themes-common-palette-overrides + '((bg-prose-block-contents bg-yellow-nuanced) + (bg-prose-block-delimiter bg-ochre) + (fg-prose-block-delimiter fg-main))) + +;; As above, but with a slightly more red feel. +(setq modus-themes-common-palette-overrides + '((bg-prose-block-contents bg-red-nuanced) + (bg-prose-block-delimiter bg-ochre) + (fg-prose-block-delimiter fg-main))) +#+end_src + +The previous examples differentiate the delimiter lines from the +block's contents. Though we can mimic the default aesthetic of a +uniform background, while changing the applicable colors. Here are +some nice combinations: + +#+begin_src emacs-lisp +;; Solid green style. +(setq modus-themes-common-palette-overrides + '((bg-prose-block-contents bg-green-nuanced) + (bg-prose-block-delimiter bg-green-nuanced) + (fg-prose-block-delimiter green-warmer))) + +;; Solid yellow style. +(setq modus-themes-common-palette-overrides + '((bg-prose-block-contents bg-yellow-nuanced) + (bg-prose-block-delimiter bg-yellow-nuanced) + (fg-prose-block-delimiter yellow-cooler))) + +;; Solid cyan style. +(setq modus-themes-common-palette-overrides + '((bg-prose-block-contents bg-cyan-nuanced) + (bg-prose-block-delimiter bg-cyan-nuanced) + (fg-prose-block-delimiter cyan-cooler))) +#+end_src + +[ Combine the above with a suitable mode line style for maximum effect + ([[#h:e8d781be-eefc-4a81-ac4e-5ed156190df7][DIY Make the active mode line colorful]]). ] + +Finally, the following makes code blocks have no distinct background. +The minimal styles are applied to the delimiter lines, which only use +a subtle gray foreground. This was the default for the Modus themes up +until version 4.3.0. + +#+begin_src emacs-lisp +;; Make code blocks more minimal, so that (i) the delimiter lines have +;; no background, (ii) the delimiter foreground is a subtle gray, and +;; (iii) the block contents have no distinct background either. This +;; was the default in versions of the Modus themes before 4.4.0 +(setq modus-themes-common-palette-overrides + '((bg-prose-block-contents unspecified) + (bg-prose-block-delimiter unspeficied) + (fg-prose-block-delimiter fg-dim))) +#+end_src + +[[#h:8c842804-43b7-4287-b4e9-8c07d04d1f89][DIY Use colored Org source blocks per language]]. + +*** DIY Make Org agenda more or less colorful :PROPERTIES: :CUSTOM_ID: h:a5af0452-a50f-481d-bf60-d8143f98105f :END: @@ -1973,14 +2183,6 @@ these styles with what we show in the other chapters with practical stylistic variants. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - ;; Make the Org agenda use alternative and varied colors. (setq modus-themes-common-palette-overrides '((date-common cyan) ; default value (for timestamps and more) @@ -2004,7 +2206,7 @@ An example with faint coloration: (date-holiday magenta) ; default (for M-x calendar) (date-now fg-main) ; default (date-scheduled yellow-faint) - (date-weekday fg-dim) + (date-weekday fg-alt) (date-weekend fg-dim))) #+end_src @@ -2041,7 +2243,9 @@ Yet another example that also affects =DONE= and =TODO= keywords: (prose-todo yellow))) #+end_src -*** Make inline code in prose use alternative styles +Reload the theme for changes to take effect. + +*** DIY Make inline code in prose use alternative styles :PROPERTIES: :CUSTOM_ID: h:bb5b396f-5532-4d52-ab13-149ca24854f1 :END: @@ -2053,54 +2257,47 @@ Org's verbatim, code, and macro entries. We also provide mappings for tables, property drawers, tags, and code block delimiters, though we do not show every possible permutation. -[[#h:b57bb50b-a863-4ea8-bb38-6de2275fa868][Make TODO and DONE more or less intense]]. +- [[#h:b57bb50b-a863-4ea8-bb38-6de2275fa868][Make TODO and DONE more or less intense]]. +- [[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][DIY Make Org block colors more or less colorful]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. +;; A nuanced accented background, combined with a suitable foreground. +(setq modus-themes-common-palette-overrides + '((bg-prose-code bg-green-nuanced) + (fg-prose-code green-cooler) + (bg-prose-verbatim bg-magenta-nuanced) + (fg-prose-verbatim magenta-warmer) -;; These are all the mappings at their default values for didactic -;; purposes -(setq modus-themes-common-palette-overrides - '((prose-block fg-dim) - (prose-code green-cooler) - (prose-done green) - (prose-macro magenta-cooler) - (prose-metadata fg-dim) - (prose-metadata-value fg-alt) - (prose-table fg-alt) - (prose-tag magenta-faint) - (prose-todo red) - (prose-verbatim magenta-warmer))) - -;; Make code block delimiters use a shade of red, tone down verbatim, -;; code, and macro, and amplify the style of property drawers + (bg-prose-macro bg-blue-nuanced) + (fg-prose-macro magenta-cooler))) + +;; A more noticeable accented background, combined with a suitable foreground. (setq modus-themes-common-palette-overrides - '((prose-block red-faint) - (prose-code fg-dim) - (prose-macro magenta-faint) - (prose-metadata cyan) - (prose-metadata-value green-warmer) - (prose-verbatim fg-dim))) - -;; Like the above but with more color variety for the inline code -;; elements + '((bg-prose-code bg-sage) + (fg-prose-code green-faint) + + (bg-prose-verbatim bg-ochre) + (fg-prose-verbatim red-faint) + + (bg-prose-macro bg-lavender) + (fg-prose-macro blue-faint))) + +;; Leave the backgrounds without a color and simply make the foregrounds more intense. (setq modus-themes-common-palette-overrides - '((prose-block red-faint) - (prose-code blue-cooler) - (prose-macro yellow-warmer) - (prose-metadata cyan) - (prose-metadata-value green-warmer) - (prose-verbatim red-warmer))) + '((bg-prose-code unspecified) + (fg-prose-code green-intense) + + (bg-prose-verbatim unspecified) + (fg-prose-verbatim magenta-intense) + + (bg-prose-macro unspecified) + (fg-prose-macro cyan-intense))) #+end_src -*** Make mail citations and headers more or less colorful +Reload the theme for changes to take effect. + +*** DIY Make mail citations and headers more or less colorful :PROPERTIES: :CUSTOM_ID: h:7da7a4ad-5d3a-4f11-9796-5a1abed0f0c4 :END: @@ -2125,15 +2322,6 @@ This is some sample text We thus have the following: #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - - ;; Reduce the intensity of mail citations and headers (setq modus-themes-common-palette-overrides '((mail-cite-0 cyan-faint) @@ -2169,7 +2357,9 @@ We thus have the following: (mail-other green))) #+end_src -*** Make the region preserve text colors, plus other styles +Reload the theme for changes to take effect. + +*** DIY Make the region preserve text colors, plus other styles :PROPERTIES: :CUSTOM_ID: h:c8605d37-66e1-42aa-986e-d7514c3af6fe :END: @@ -2183,15 +2373,6 @@ with an appropriate foreground value. [[#h:a5140c9c-18b2-45db-8021-38d0b5074116][Do not extend the region background]]. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - - ;; A background with no specific foreground (use foreground of ;; underlying text) (setq modus-themes-common-palette-overrides @@ -2209,7 +2390,9 @@ with an appropriate foreground value. (fg-region fg-main))) #+end_src -*** Make mouse highlights more or less colorful +Reload the theme for changes to take effect. + +*** DIY Make mouse highlights more or less colorful :PROPERTIES: :CUSTOM_ID: h:b5cab69d-d7cb-451c-8ff9-1f545ceb6caf :END: @@ -2220,15 +2403,6 @@ the following code block we show how to affect the semantic color mapping that covers mouse hover effects and related highlights: #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - - ;; Make the background an intense yellow (setq modus-themes-common-palette-overrides '((bg-hover bg-yellow-intense))) @@ -2238,7 +2412,9 @@ mapping that covers mouse hover effects and related highlights: '((bg-hover bg-green-subtle))) #+end_src -*** Make language underlines less colorful +Reload the theme for changes to take effect. + +*** DIY Make language underlines less colorful :PROPERTIES: :CUSTOM_ID: h:03dbd5af-6bae-475e-85a2-cec189f69598 :END: @@ -2249,15 +2425,6 @@ Here we show how to affect the color of the underlines that are used by code linters and prose spell checkers. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - - ;; Make the underlines less intense (setq modus-themes-common-palette-overrides '((underline-err red-faint) @@ -2271,7 +2438,9 @@ by code linters and prose spell checkers. (underline-note green-intense))) #+end_src -*** Make line numbers use alternative styles +Reload the theme for changes to take effect. + +*** DIY Make line numbers use alternative styles :PROPERTIES: :CUSTOM_ID: h:b6466f51-cb58-4007-9ebe-53a27af655c7 :END: @@ -2281,15 +2450,6 @@ of the Modus themes ([[#h:df1199d8-eaba-47db-805d-6b568a577bf3][Stylistic varian this section we show how to affect the ~display-line-numbers-mode~. #+begin_src emacs-lisp -;; These overrides are common to all Modus themes. We also provide -;; theme-specific options, such as `modus-operandi-palette-overrides'. -;; -;; In general, the theme-specific overrides are better for overriding -;; color values, such as redefining what `blue-faint' looks like. The -;; common overrides are best used for changes to semantic color -;; mappings, as we show below. - - ;; Make line numbers less intense (setq modus-themes-common-palette-overrides '((fg-line-number-inactive "gray50") @@ -2313,7 +2473,9 @@ this section we show how to affect the ~display-line-numbers-mode~. (bg-line-number-active bg-cyan-intense))) #+end_src -*** Make diffs use only a foreground +Reload the theme for changes to take effect. + +*** DIY Make diffs use only a foreground :PROPERTIES: :CUSTOM_ID: h:b3761482-bcbf-4990-a41e-4866fb9dad15 :END: @@ -2377,7 +2539,9 @@ just using the "common" overrides. (fg-removed-intense yellow-intense))) #+end_src -*** Make deuteranopia diffs red and blue instead of yellow and blue +Reload the theme for changes to take effect. + +*** DIY Make deuteranopia diffs red and blue instead of yellow and blue :PROPERTIES: :CUSTOM_ID: h:16389ea1-4cb6-4b18-9409-384324113541 :END: @@ -2428,112 +2592,9 @@ respectively. This is achieved by overriding the "changed" and (fg-removed-intense "#ff9095"))) #+end_src -*** Make the themes look like what the maintainer uses -:PROPERTIES: -:CUSTOM_ID: h:aabcada6-810d-4eee-b34a-d2a9c301824d -:END: - -Based on what we have learnt from the previous sections of this -manual, here is what Protesilaos uses: - -#+begin_src emacs-lisp -;; Always reload the theme for changes to take effect! - -(setq modus-themes-custom-auto-reload nil - modus-themes-to-toggle '(modus-operandi modus-vivendi) - modus-themes-mixed-fonts t - modus-themes-variable-pitch-ui nil - modus-themes-italic-constructs t - modus-themes-bold-constructs nil - modus-themes-org-blocks nil - modus-themes-completions '((t . (extrabold))) - modus-themes-prompts nil - modus-themes-headings - '((agenda-structure . (variable-pitch light 2.2)) - (agenda-date . (variable-pitch regular 1.3)) - (t . (regular 1.15)))) - -(setq modus-themes-common-palette-overrides - '((cursor magenta-cooler) - ;; Make the fringe invisible. - (fringe unspecified) - ;; Make line numbers less intense and add a shade of cyan - ;; for the current line number. - (fg-line-number-inactive "gray50") - (fg-line-number-active cyan-cooler) - (bg-line-number-inactive unspecified) - (bg-line-number-active unspecified) - ;; Make the current line of `hl-line-mode' a fine shade of - ;; gray (though also see my `lin' package). - (bg-hl-line bg-dim) - ;; Make the region have a cyan-green background with no - ;; specific foreground (use foreground of underlying text). - ;; "bg-sage" refers to Salvia officinalis, else the common - ;; sage. - (bg-region bg-sage) - (fg-region unspecified) - ;; Make matching parentheses a shade of magenta. It - ;; complements the region nicely. - (bg-paren-match bg-magenta-intense) - ;; Make email citations faint and neutral, reducing the - ;; default four colors to two; make mail headers cyan-blue. - (mail-cite-0 fg-dim) - (mail-cite-1 blue-faint) - (mail-cite-2 fg-dim) - (mail-cite-3 blue-faint) - (mail-part cyan-warmer) - (mail-recipient blue-warmer) - (mail-subject magenta-cooler) - (mail-other cyan-warmer) - ;; Change dates to a set of more subtle combinations. - (date-deadline magenta-cooler) - (date-scheduled magenta) - (date-weekday fg-main) - (date-event fg-dim) - (date-now blue-faint) - ;; Make tags (Org) less colorful and tables look the same as - ;; the default foreground. - (prose-done cyan-cooler) - (prose-tag fg-dim) - (prose-table fg-main) - ;; Make headings less colorful (though I never use deeply - ;; nested headings). - (fg-heading-2 blue-faint) - (fg-heading-3 magenta-faint) - (fg-heading-4 blue-faint) - (fg-heading-5 magenta-faint) - (fg-heading-6 blue-faint) - (fg-heading-7 magenta-faint) - (fg-heading-8 blue-faint) - ;; Make the active mode line a fine shade of lavender - ;; (purple) and tone down the gray of the inactive mode - ;; lines. - (bg-mode-line-active bg-lavender) - (border-mode-line-active bg-lavender) - - (bg-mode-line-inactive bg-dim) - (border-mode-line-inactive bg-inactive) - ;; Make the prompts a shade of magenta, to fit in nicely with - ;; the overall blue-cyan-purple style of the other overrides. - ;; Add a nuanced background as well. - (bg-prompt bg-magenta-nuanced) - (fg-prompt magenta-cooler) - ;; Tweak some more constructs for stylistic consistency. - (name blue-warmer) - (identifier magenta-faint) - (keybind magenta-cooler) - (accent-0 magenta-cooler) - (accent-1 cyan-cooler) - (accent-2 blue-warmer) - (accent-3 red-cooler))) - -;; Make the active mode line have a pseudo 3D effect (this assumes -;; you are using the default mode line and not an extra package). -(custom-set-faces - '(mode-line ((t :box (:style released-button))))) -#+end_src +Reload the theme for changes to take effect. -** More accurate colors in terminal emulators +** DIY More accurate colors in terminal emulators :PROPERTIES: :CUSTOM_ID: h:fbb5e254-afd6-4313-bb05-93b3b4f67358 :END: @@ -2562,7 +2623,7 @@ Another example that can be bound to a key: : TERM=xterm-direct uxterm -e emacsclient -nw -** Range of color with terminal emulators +** DIY Range of color with terminal emulators :PROPERTIES: :CUSTOM_ID: h:6b8211b0-d11b-4c00-9543-4685ec3b742f :END: @@ -2633,48 +2694,7 @@ xterm*color14: #6ae4b9 xterm*color15: #ffffff #+end_src -** Preview theme colors -:properties: -:custom_id: h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d -:end: -#+cindex: Preview named colors or semantic color mappings - -#+findex: modus-themes-list-colors -The command ~modus-themes-list-colors~ uses minibuffer completion to -select an item from the Modus themes and then produces a buffer with -previews of its color palette entries. The buffer has a naming scheme -that reflects the given choice, like =modus-operandi-list-colors= for -the ~modus-operandi~ theme. - -#+findex: modus-themes-list-colors-current -The command ~modus-themes-list-colors-current~ skips the minibuffer -selection process and just produces a preview for the current Modus -theme. - -When called with a prefix argument (=C-u= with the default key -bindings), these commands will show a preview of the palette's -semantic color mappings instead of the named colors. In this context, -"named colors" are entries that associate a symbol to a string color -value, such as =(blue-warmer "#354fcf")=. Whereas "semantic color -mappings" associate a named color to a symbol, like =(string -blue-warmer)=, thus making the theme render all string constructs in -the =blue-warmer= color value ([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]). - -#+findex: modus-themes-preview-colors -#+findex: modus-themes-preview-colors-current -Aliases for those commands are ~modus-themes-preview-colors~ and -~modus-themes-preview-colors-current~. - -Each row shows a foreground and background coloration using the -underlying value it references. For example a line with =#a60000= (a -shade of red) will show red text followed by a stripe with that same -color as a backdrop. - -The name of the buffer describes the given Modus theme and what the -contents are, such as =*modus-operandi-list-colors*= for named colors -and ==*modus-operandi-list-mappings*= for the semantic color mappings. - -** Per-theme customization settings +** DIY Per-theme customization settings :properties: :custom_id: h:a897b302-8e10-4a26-beab-3caaee1e1193 :end: @@ -2709,114 +2729,9 @@ equivalent the themes provide. For a more elaborate design, it is better to inspect the source code of ~modus-themes-toggle~ and relevant functions. -** Get a single color from the palette -:PROPERTIES: -:CUSTOM_ID: h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e -:END: - -[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. - -#+findex: modus-themes-get-color-value -The function ~modus-themes-get-color-value~ can be called from Lisp to -return the value of a color from the active Modus theme palette. It -takea a =COLOR= argument and an optional =OVERRIDES=. - -=COLOR= is a symbol that represents a named color entry in the -palette. +Reload the theme for changes to take effect. -[[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]]. - -If the value is the name of another color entry in the palette (so a -mapping), this function recurs until it finds the underlying color -value. - -With an optional =OVERRIDES= argument as a non-~nil~ value, it accounts -for palette overrides. Else it reads only the default palette. - -[[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]. - -With optional =THEME= as a symbol among ~modus-themes-items~ (alias -~modus-themes-collection~), use the palette of that item. Else use -the current Modus theme. - -If =COLOR= is not present in the palette, this function returns the -~unspecified~ symbol, which is safe when used as a face attribute's -value. - -An example with ~modus-operandi~ to show how this function behaves -with/without overrides and when recursive mappings are introduced. - -#+begin_src emacs-lisp -;; Here we show the recursion of palette mappings. In general, it is -;; better for the user to specify named colors to avoid possible -;; confusion with their configuration, though those still work as -;; expected. -(setq modus-themes-common-palette-overrides - '((cursor red) - (fg-mode-line-active cursor) - (border-mode-line-active fg-mode-line-active))) - -;; Ignore the overrides and get the original value. -(modus-themes-get-color-value 'border-mode-line-active) -;; => "#5a5a5a" - -;; Read from the overrides and deal with any recursion to find the -;; underlying value. -(modus-themes-get-color-value 'border-mode-line-active :overrides) -;; => "#a60000" -#+end_src - -** Use theme colors in code with modus-themes-with-colors -:properties: -:custom_id: h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae -:end: -#+cindex: Use colors from the palette anywhere - -[[#h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e][Get a single color from the palette]]. - -Note that users most probably do not need the following. Just rely on -the comprehensive overrides we provide ([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]). - -#+findex: modus-themes-with-colors -Advanced users may want to apply colors from the palette of the active -Modus theme in their custom code. The ~modus-themes-with-colors~ -macro supplies those to any form called inside of it. For example: - -#+begin_src emacs-lisp -(modus-themes-with-colors - (list blue-warmer magenta-cooler fg-added warning variable fg-heading-4)) -;; => ("#354fcf" "#531ab6" "#005000" "#884900" "#005e8b" "#721045") -#+end_src - -The above return value is for ~modus-operandi~ when that is the active -theme. Switching to another theme and evaluating this code anew will -give us the relevant results for that theme (remember that since -version 4, the Modus themes consist of six items ([[#h:f0f3dbcb-602d-40cf-b918-8f929c441baf][Overview]])). The -same with ~modus-vivendi~ as the active theme: - -#+begin_src emacs-lisp -(modus-themes-with-colors - (list blue-warmer magenta-cooler fg-added warning variable fg-heading-4)) -;; => ("#79a8ff" "#b6a0ff" "#a0e0a0" "#fec43f" "#00d3d0" "#feacd0") -#+end_src - -The ~modus-themes-with-colors~ has access to the whole palette of the -active theme, meaning that it can instantiate both (i) named colors -like =blue-warmer= and (ii) semantic color mappings like =warning=. -We provide commands to inspect those ([[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]]). - -Others sections in this manual show how to use the aforementioned -macro ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]). - -Because the ~modus-themes-with-colors~ will most likely be used to -customize faces, note that any function that calls it must be run at -startup after the theme loads. The same function must also be -assigned to the ~modus-themes-after-load-theme-hook~ for its effects -to persist and be updated when switching between Modus themes (e.g. to -update the exact value of =blue-warmer= when toggling between -~modus-operandi~ to ~modus-vivendi~. - -** Do not extend the region background +** DIY Do not extend the region background :PROPERTIES: :CUSTOM_ID: h:a5140c9c-18b2-45db-8021-38d0b5074116 :END: @@ -2834,11 +2749,14 @@ this to the Emacs configuration file will suffice: [[#h:c8605d37-66e1-42aa-986e-d7514c3af6fe][Make the region preserve text colors, plus other styles]]. -** Add padding to mode line +** DIY Add padding to the mode line :PROPERTIES: :CUSTOM_ID: h:5a0c58cc-f97f-429c-be08-927b9fbb0a9c :END: +[ Consider using the ~spacious-padding~ package from GNU ELPA (by + Protesilaos) for more than just the mode line. ] + Emacs faces do not have a concept of "padding" for the space between the text and its box boundaries. We can approximate the effect by adding a =:box= attribute, making its border several pixels thick, and @@ -2849,7 +2767,7 @@ mode line. [[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. #+begin_src emacs-lisp -(defun my-modus-themes-custom-faces () +(defun my-modus-themes-custom-faces (&rest _) (modus-themes-with-colors (custom-set-faces ;; Add "padding" to the mode lines @@ -2859,6 +2777,8 @@ mode line. (add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) #+end_src +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + The above has the effect of removing the border around the mode lines. In older versions of the themes, we provided the option for a padded mode line which could also have borders around it. Those were not @@ -2866,7 +2786,7 @@ real border, however, but an underline and an overline. Adjusting the above: #+begin_src emacs-lisp -(defun my-modus-themes-custom-faces () +(defun my-modus-themes-custom-faces (&rest _) (modus-themes-with-colors (custom-set-faces ;; Add "padding" to the mode lines @@ -2886,13 +2806,15 @@ above: The reason we no longer provide this option is because it depends on a non-~nil~ value for ~x-underline-at-descent-line~. That variable affects ALL underlines, including those of links. The effect is -intrusive and looks awkward in prose. +intrusive and looks awkard in prose. As such, the Modus themes no longer provide that option but instead offer this piece of documentation to make the user fully aware of the state of affairs. -** Remap face with local value +Reload the theme for changes to take effect. + +** DIY Remap face with local value :properties: :custom_id: h:7a93cb6f-4eca-4d56-a85c-9dcd813d6b0f :end: @@ -2954,12 +2876,17 @@ Perhaps you may wish to generalize those findings in to a set of functions that also accept an arbitrary face. We shall leave the experimentation up to you. -** Font configurations for Org and others +Reload the theme for changes to take effect. + +** DIY Font configurations for Org and others :properties: :custom_id: h:defcf4fc-8fa8-4c29-b12e-7119582cc929 :end: #+cindex: Font configurations +[ Consider using the ~fontaine~ package from GNU ELPA (by Protesilaos) + for all font-related configurations. ] + The themes are designed to optionally cope well with mixed font configurations. This mostly concerns ~org-mode~ and ~markdown-mode~, though expect to find it elsewhere like in ~Info-mode~. @@ -2979,9 +2906,6 @@ the ~variable-pitch~ (proportional spacing) and ~fixed-pitch~ (monospaced) faces respectively. It may also be convenient to set your main typeface by configuring the ~default~ face the same way. -[ The ~fontaine~ package on GNU ELPA (by Protesilaos) is designed to - handle this case. ] - Put something like this in your initialization file (also consider reading the doc string of ~set-face-attribute~): @@ -3023,12 +2947,15 @@ absolute height). [[#h:e6c5451f-6763-4be7-8fdb-b4706a422a4c][Note for EWW and Elfeed fonts]]. -** Configure bold and italic faces +** DIY Configure bold and italic faces :properties: :custom_id: h:2793a224-2109-4f61-a106-721c57c01375 :end: #+cindex: Bold and italic fonts +[ Consider using the ~fontaine~ package from GNU ELPA (by Protesilaos) + for all font-related configurations. ] + The Modus themes do not hardcode a ~:weight~ or ~:slant~ attribute in the thousands of faces they cover. Instead, they configure the generic faces called ~bold~ and ~italic~ to use the appropriate styles and then @@ -3082,12 +3009,12 @@ To reset the font family, one can use this: #+end_src To ensure that the effects persist after switching between the Modus -themes (such as with {{{kbd(M-x modus-themes-toggle)}}}), the user needs to -write their configurations to a function and pass it to the -~modus-themes-after-load-theme-hook~. This is necessary because themes -set the styles of faces upon activation, overriding prior values where -conflicts occur between the previous and the current states (otherwise -changing themes would not be possible). +themes (such as with {{{kbd(M-x modus-themes-toggle)}}}), the user +needs to write their configurations to a function and pass it to the +~modus-themes-after-load-theme-hook~ ([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]). This is +necessary because themes set the styles of faces upon activation, +overriding prior values where conflicts occur between the previous and +the current states (otherwise changing themes would not be possible). [[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A theme-agnostic hook for theme loading]]. @@ -3100,14 +3027,14 @@ of the themes, which can make it easier to redefine faces in bulk). #+begin_src emacs-lisp ;; our generic function -(defun my-modes-themes-bold-italic-faces () +(defun my-modes-themes-bold-italic-faces (&rest _) (set-face-attribute 'default nil :family "Source Code Pro" :height 110) (set-face-attribute 'bold nil :weight 'semibold)) ;; or use this if you configure a lot of face and attributes and ;; especially if you plan to use `modus-themes-with-colors', as shown ;; elsewhere in the manual -(defun my-modes-themes-bold-italic-faces () +(defun my-modes-themes-bold-italic-faces (&rest _) (custom-set-faces '(default ((t :family "Source Code Pro" :height 110))) '(bold ((t :weight semibold))))) @@ -3118,7 +3045,11 @@ of the themes, which can make it easier to redefine faces in bulk). [[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. -** Custom Org todo keyword and priority faces +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + +Reload the theme for changes to take effect. + +** DIY Custom Org todo keyword and priority faces :properties: :custom_id: h:89f0678d-c5c3-4a57-a526-668b2bb2d7ad :end: @@ -3207,7 +3138,7 @@ it if you plan to control face attributes. [[#h:02e25930-e71a-493d-828a-8907fc80f874][Check color combinations]]. -** Custom Org emphasis faces +** DIY Custom Org emphasis faces :properties: :custom_id: h:26026302-47f4-4471-9004-9665470e7029 :end: @@ -3229,7 +3160,7 @@ specification of that variable looks like this: With the exception of ~org-verbatim~ and ~org-code~ faces, everything else uses the corresponding type of emphasis: a bold typographic weight, or -italicized, underlined, and struck through text. +italicised, underlined, and struck through text. The best way for users to add some extra attributes, such as a foreground color, is to define their own faces and assign them to the @@ -3340,49 +3271,97 @@ styled by the themes, it probably is best not to edit them: That's it! For changes to take effect in already visited Org files, invoke {{{kbd(M-x org-mode-restart)}}}. -** Update Org block delimiter fontification -:properties: -:custom_id: h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50 -:end: +** DIY Use colored Org source blocks per language +:PROPERTIES: +:CUSTOM_ID: h:8c842804-43b7-4287-b4e9-8c07d04d1f89 +:END: -As noted in the section about ~modus-themes-org-blocks~, Org contains a -variable that determines whether the block's begin and end lines are -extended to the edge of the window ([[#h:b7e328c0-3034-4db7-9cdf-d5ba12081ca2][Option for org-mode block styles]]). -The variable is ~org-fontify-whole-block-delimiter-line~. +[[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][DIY Make Org block colors more or less colorful]]. -Users who change the style of Org blocks from time to time may prefer to -automatically update delimiter line fontification, such as with the -following setup: +In versions of the Modus themes before =4.4.0= there was an option to +change the coloration of Org source blocks so that certain languages +would have a distinctly colored background. This was not flexible +enough, because (i) we cannot cover all languages effectively and (ii) +the user had no choice over the =language --> color= mapping. -#+begin_src emacs-lisp -(defun my-modus-themes-org-fontify-block-delimiter-lines () - "Match `org-fontify-whole-block-delimiter-line' to theme style. -Run this function at the post theme load phase, such as with the -`modus-themes-after-load-theme-hook'." - (if (eq modus-themes-org-blocks 'gray-background) - (setq org-fontify-whole-block-delimiter-line t) - (setq org-fontify-whole-block-delimiter-line nil))) +As such, the old user option is no more. Users can use the following +to achieve what they want: -(add-hook 'modus-themes-after-load-theme-hook - #'my-modus-themes-org-fontify-block-delimiter-lines) +[ All this is done by setting the Org user option ~org-src-block-faces~, + so it is not related to the palette overrides mechanism provided by + the Modus themes. ] + +#+begin_src emacs-lisp +(defun my-modus-themes-org-block-faces (&rest _) + (modus-themes-with-colors + ;; The `org-src-block-faces' does not get re-applied in existing + ;; Org buffers. Do M-x org-mode-restart for changes to take + ;; effect. + (setq org-src-block-faces + `(("emacs-lisp" modus-themes-nuanced-magenta) + ("elisp" modus-themes-nuanced-magenta) + ("clojure" modus-themes-nuanced-magenta) + ("clojurescript" modus-themes-nuanced-magenta) + ("c" modus-themes-nuanced-blue) + ("c++" modus-themes-nuanced-blue) + ("sh" modus-themes-nuanced-yellow) + ("shell" modus-themes-nuanced-yellow) + ("python" modus-themes-nuanced-yellow) + ("ipython" modus-themes-nuanced-yellow) + ("r" modus-themes-nuanced-yellow) + ("html" modus-themes-nuanced-green) + ("xml" modus-themes-nuanced-green) + ("css" modus-themes-nuanced-red) + ("scss" modus-themes-nuanced-red) + ("yaml" modus-themes-nuanced-cyan) + ("conf" modus-themes-nuanced-cyan) + ("docker" modus-themes-nuanced-cyan))))) + +(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-org-block-faces) #+end_src -Then {{{kbd(M-x org-mode-restart)}}} for changes to take effect, though manual -intervention can be circumvented by tweaking the function thus: +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][DIY Use a hook at the post-load-theme phase]]. + +Note that the ~org-src-block-faces~ accepts a named face, as shown +above, as well as a list of face attributes. The latter approach is +not good enough because it hardcodes values in such a way that an +~org-mode-restart~ is necessary. Whereas the indirection of the named +face lets the theme change the values while Org buffers continue to +show the right colors. + +Still, if a user prefers to hardcode face attributes, here is the +idea: #+begin_src emacs-lisp -(defun my-modus-themes-org-fontify-block-delimiter-lines () - "Match `org-fontify-whole-block-delimiter-line' to theme style. -Run this function at the post theme load phase, such as with the -`modus-themes-after-load-theme-hook'." - (if (eq modus-themes-org-blocks 'gray-background) - (setq org-fontify-whole-block-delimiter-line t) - (setq org-fontify-whole-block-delimiter-line nil)) - (when (derived-mode-p 'org-mode) - (font-lock-flush))) +;; This is for the sake of completeness. I DO NOT RECOMMEND THIS +;; method because it hardcodes values and thus requires +;; `org-mode-restart' every time you change a theme. +(defun my-modus-themes-org-block-faces (&rest _) + (modus-themes-with-colors + (setq org-src-block-faces + `(("emacs-lisp" (:inherit org-block :background ,bg-magenta-nuanced)) + ("elisp" (:inherit org-block :background ,bg-magenta-nuanced)) + ("clojure" (:inherit org-block :background ,bg-magenta-nuanced)) + ("clojurescript" (:inherit org-block :background ,bg-magenta-nuanced)) + ("c" (:inherit org-block :background ,bg-blue-nuanced)) + ("c++" (:inherit org-block :background ,bg-blue-nuanced)) + ("sh" (:inherit org-block :background ,bg-yellow-nuanced)) + ("shell" (:inherit org-block :background ,bg-yellow-nuanced)) + ("python" (:inherit org-block :background ,bg-yellow-nuanced)) + ("ipython" (:inherit org-block :background ,bg-yellow-nuanced)) + ("r" (:inherit org-block :background ,bg-yellow-nuanced)) + ("html" (:inherit org-block :background ,bg-green-nuanced)) + ("xml" (:inherit org-block :background ,bg-green-nuanced)) + ("css" (:inherit org-block :background ,bg-red-nuanced)) + ("scss" (:inherit org-block :background ,bg-red-nuanced)) + ("yaml" (:inherit org-block :background ,bg-cyan-nuanced)) + ("conf" (:inherit org-block :background ,bg-cyan-nuanced)) + ("docker" (:inherit org-block :background ,bg-cyan-nuanced)))))) + +(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-org-block-faces) #+end_src -** Measure color contrast +** DIY Measure color contrast :properties: :custom_id: h:02e25930-e71a-493d-828a-8907fc80f874 :end: @@ -3455,7 +3434,7 @@ minutia and relevant commentary. Such knowledge may prove valuable while attempting to customize the theme's color palette. -** Load theme depending on time of day +** DIY Load theme depending on time of day :properties: :custom_id: h:1d1ef4b4-8600-4a09-993c-6de3af0ddd26 :end: @@ -3483,7 +3462,7 @@ the ~circadian~ package: (circadian-setup)) #+end_src -** Backdrop for pdf-tools +** DIY Backdrop for pdf-tools :properties: :custom_id: h:ff69dfe1-29c0-447a-915c-b5ff7c5509cd :end: @@ -3504,7 +3483,7 @@ buffer-local value of the ~default~ face. To remap the buffer's backdrop, we start with a function like this one: #+begin_src emacs-lisp -(defun my-pdf-tools-backdrop () +(defun my-pdf-tools-backdrop (&rest _) (modus-themes-with-colors (face-remap-add-relative 'default @@ -3518,7 +3497,8 @@ The idea is to assign that function to a hook that gets called when when you only use one theme. However it has the downside of setting the background color value only at render time. In other words, the face remapping function does not get evaluated anew whenever the theme -changes, such as upon invoking {{{kbd(M-x modus-themes-toggle)}}}. +changes, such as upon invoking {{{kbd(M-x modus-themes-toggle)}}} +([[#h:4fbfed66-5a89-447a-a07d-a03f6819c5bd][Option for which themes to toggle]]). To have our face remapping adapt gracefully while switching between the Modus themes, we need to also account for the current theme and control @@ -3526,20 +3506,20 @@ the activation of ~pdf-view-midnight-minor-mode~. To which end we arrive at something like the following, which builds on the above example: #+begin_src emacs-lisp -(defun my-pdf-tools-backdrop () +(defun my-pdf-tools-backdrop (&rest _) (modus-themes-with-colors (face-remap-add-relative 'default `(:background ,bg-dim)))) -(defun my-pdf-tools-midnight-mode-toggle () +(defun my-pdf-tools-midnight-mode-toggle (&rest _) (when (derived-mode-p 'pdf-view-mode) (if (eq (car custom-enabled-themes) 'modus-vivendi) (pdf-view-midnight-minor-mode 1) (pdf-view-midnight-minor-mode -1)) (my-pdf-tools-backdrop))) -(defun my-pdf-tools-themes-toggle () +(defun my-pdf-tools-themes-toggle (&rest _) (mapc (lambda (buf) (with-current-buffer buf @@ -3550,11 +3530,15 @@ at something like the following, which builds on the above example: (add-hook 'modus-themes-after-load-theme-hook #'my-pdf-tools-themes-toggle) #+end_src +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + With those in place, PDFs have a distinct backdrop for their page, while buffers with major-mode as ~pdf-view-mode~ automatically switches to dark mode when ~modus-themes-toggle~ is called. -** Toggle themes without reloading them +Reload the theme for changes to take effect. + +** DIY Toggle themes without reloading them :properties: :custom_id: h:b40aca50-a3b2-4c43-be58-2c26fcd14237 :end: @@ -3583,58 +3567,7 @@ manual." Recall that ~modus-themes-toggle~ uses ~load-theme~. -** A theme-agnostic hook for theme loading -:properties: -:custom_id: h:86f6906b-f090-46cc-9816-1fe8aeb38776 -:end: - -The themes are designed with the intent to be useful to Emacs users of -varying skill levels, from beginners to experts. This means that we try -to make things easier by not expecting anyone reading this document to -be proficient in Emacs Lisp or programming in general. - -Such a case is with the use of ~modus-themes-after-load-theme-hook~, -which runs after the ~modus-themes-load-theme~ function (used by the -command ~modus-themes-toggle~). We recommend using that hook for -advanced customizations, because (1) we know for sure that it is -available once the themes are loaded, and (2) anyone consulting this -manual, especially the sections on enabling and loading the themes, -will be in a good position to benefit from that hook. - -Advanced users who have a need to switch between the Modus themes and -other items will find that such a hook does not meet their requirements: -it only works with the Modus themes and only with the aforementioned -functions. - -A theme-agnostic setup can be configured thus: - -#+begin_src emacs-lisp -(defvar after-enable-theme-hook nil - "Normal hook run after enabling a theme.") - -(defun run-after-enable-theme-hook (&rest _args) - "Run `after-enable-theme-hook'." - (run-hooks 'after-enable-theme-hook)) - -(advice-add 'enable-theme :after #'run-after-enable-theme-hook) -#+end_src - -This creates the ~after-enable-theme-hook~ and makes it run after each -call to ~enable-theme~, which means that it will work for all themes and -also has the benefit that it does not depend on functions such as -~modus-themes-toggle~ and the others mentioned above. ~enable-theme~ is -called internally by ~load-theme~, so the hook works everywhere. - -The downside of the theme-agnostic hook is that any functions added to -it will likely not be able to benefit from macro calls that read the -active theme, such as ~modus-themes-with-colors~. Not all Emacs -themes have the same capabilities. - -In this document, we cover ~modus-themes-after-load-theme-hook~ though -the user can replace it with ~after-enable-theme-hook~ should they -need to (provided they understand the implications). - -** Use more spacious margins or padding in Emacs frames +** DIY Use more spacious margins or padding in Emacs frames :PROPERTIES: :CUSTOM_ID: h:43bcb5d0-e25f-470f-828c-662cee9e21f1 :END: @@ -3687,7 +3620,7 @@ The reason we do this with a function is so we can hook it to the faces will no longer be invisible). #+begin_src emacs-lisp -(defun my-modus-themes-invisible-dividers () +(defun my-modus-themes-invisible-dividers (&rest _) "Make window dividers invisible. Add this to the `modus-themes-post-load-hook'." (let ((bg (face-background 'default))) @@ -3700,6 +3633,8 @@ Add this to the `modus-themes-post-load-hook'." (add-hook 'modus-themes-post-load-hook #'my-modus-themes-invisible-dividers) #+end_src +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + The above will work only for themes that belong to the Modus family. For users of Emacs version 29 or higher, there exists a theme-agnostic hook that takes a function with one argument---that of the theme---and @@ -3707,7 +3642,7 @@ calls in the the "post enable" phase of theme loading. Here is the above snippet, with the necessary tweaks: #+begin_src emacs-lisp -(defun my-modus-themes-invisible-dividers (_theme) +(defun my-modus-themes-invisible-dividers (&rest _) "Make window dividers for THEME invisible." (let ((bg (face-background 'default))) (custom-set-faces @@ -3722,7 +3657,7 @@ above snippet, with the necessary tweaks: Users of older versions of Emacs can read the entry herein about defining their own theme-agnostic hook ([[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A theme-agnostic hook for theme loading]]). -** Custom hl-todo colors +** DIY Custom hl-todo colors :PROPERTIES: :CUSTOM_ID: h:2ef83a21-2f0a-441e-9634-473feb940743 :END: @@ -3735,7 +3670,7 @@ may still prefer to apply their custom values, in which case the following approach is necessary: #+begin_src emacs-lisp -(defun my-modus-themes-hl-todo-faces () +(defun my-modus-themes-hl-todo-faces (&rest _) (setq hl-todo-keyword-faces '(("TODO" . "#ff0000") ("HACK" . "#ffff00") ("XXX" . "#00ffff") @@ -3744,10 +3679,12 @@ following approach is necessary: (add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-hl-todo-faces) #+end_src +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + Or include a ~let~ form, if needed: #+begin_src emacs-lisp -(defun my-modus-themes-hl-todo-faces () +(defun my-modus-themes-hl-todo-faces (&rest _) (let ((red "#ff0000") (blue "#0000ff")) (setq hl-todo-keyword-faces `(("TODO" . ,blue) @@ -3758,10 +3695,14 @@ Or include a ~let~ form, if needed: (add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-hl-todo-faces) #+end_src +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + Normally, we do not touch user options, though this is an exception: otherwise the defaults are not always legible. -** Add support for solaire-mode +Reload the theme for changes to take effect. + +** DIY Add support for solaire-mode :PROPERTIES: :CUSTOM_ID: h:439c9e46-52e2-46be-b1dc-85841dd99671 :END: @@ -3806,7 +3747,7 @@ on what we cover at length elsewhere in this manual: [[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. #+begin_src emacs-lisp -(defun my-modus-themes-custom-faces () +(defun my-modus-themes-custom-faces (&rest _) (modus-themes-with-colors (custom-set-faces `(solaire-default-face ((,c :inherit default :background ,bg-dim :foreground ,fg-dim))) @@ -3817,7 +3758,106 @@ on what we cover at length elsewhere in this manual: (add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) #+end_src -As always, re-load the theme for changes to take effect. +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + +Reload the theme for changes to take effect. + +** DIY Use a hook at the post-load-theme phase +:PROPERTIES: +:CUSTOM_ID: h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24 +:END: + +Many of the Do-It-Yourself (DIY) snippets provided herein make use of +a hook to apply the desired changes. In most examples, this hook is +the ~modus-themes-after-load-theme-hook~ (alias ~modus-themes-post-load-hook~). +This hook is provided by the Modus themes and is called at the end of +one the following: + +- Command ~modus-themes-toggle~ :: [[#h:4fbfed66-5a89-447a-a07d-a03f6819c5bd][Option for which themes to toggle]]. + +- Command ~modus-themes-select~ :: Select a Modus theme using minibuffer + completion and then load it. + +- Function ~modus-themes-load-theme~ :: Called only from Lisp, such as + in the user's init file, with the quoted symbol of a Modus theme as + an argument ([[#h:adb0c49a-f1f9-4690-868b-013a080eed68][Option for disabling other themes while loading Modus]]). + This function is used internally by ~modus-themes-toggle~ and + ~modus-themes-select~. + +Users who switch between themes that are not limited to the Modus +collection cannot benefit from the aforementioned hook: it only works +with the Modus themes. A theme-agnostic hook is needed in such a case. +Before Emacs 29, this had to be set up manually ([[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][DIY A theme-agnostic hook for theme loading]]). +Starting with Emacs 29, the special hook ~enable-theme-functions~ +works with anything that uses the basic ~enable-theme~ function. + +To use the ~enable-theme-functions~ just add the given function to it +the way it is done with every hook: + +#+begin_src emacs-lisp +(add-hook 'enable-theme-functions 'MY-FUNCTION-HERE) +#+end_src + +Functions added to ~enable-theme-functions~ accept a single =THEME= +argument. The examples shown in this manual use the pattern =(&rest +_)=, which is how a function accepts one or more arguments but +declares it will not use them (in plain terms, the code works with or +without ~enable-theme-functions~). + +*** DIY A theme-agnostic hook for theme loading +:properties: +:custom_id: h:86f6906b-f090-46cc-9816-1fe8aeb38776 +:end: + +[ NOTE: The following is for versions of Emacs before 29. For Emacs 29 + or higher, users can rely on the built-in ~enable-theme-functions~ + ([[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]). ] + +The themes are designed with the intent to be useful to Emacs users of +varying skill levels, from beginners to experts. This means that we try +to make things easier by not expecting anyone reading this document to +be proficient in Emacs Lisp or programming in general. + +Such a case is with the use of ~modus-themes-after-load-theme-hook~, +which runs after the ~modus-themes-load-theme~ function (used by the +command ~modus-themes-toggle~). We recommend using that hook for +advanced customizations, because (1) we know for sure that it is +available once the themes are loaded, and (2) anyone consulting this +manual, especially the sections on enabling and loading the themes, +will be in a good position to benefit from that hook. + +Advanced users who have a need to switch between the Modus themes and +other items will find that such a hook does not meet their requirements: +it only works with the Modus themes and only with the aforementioned +functions. + +A theme-agnostic setup can be configured thus: + +#+begin_src emacs-lisp +(defvar after-enable-theme-hook nil + "Normal hook run after enabling a theme.") + +(defun run-after-enable-theme-hook (&rest _args) + "Run `after-enable-theme-hook'." + (run-hooks 'after-enable-theme-hook)) + +(advice-add 'enable-theme :after #'run-after-enable-theme-hook) +#+end_src + +This creates the ~after-enable-theme-hook~ and makes it run after each +call to ~enable-theme~, which means that it will work for all themes and +also has the benefit that it does not depend on functions such as +~modus-themes-toggle~ and the others mentioned above. ~enable-theme~ is +called internally by ~load-theme~, so the hook works everywhere. + +The downside of the theme-agnostic hook is that any functions added to +it will likely not be able to benefit from macro calls that read the +active theme, such as ~modus-themes-with-colors~. Not all Emacs +themes have the same capabilities. + +In this document, we cover ~modus-themes-after-load-theme-hook~ though +the user can replace it with ~after-enable-theme-hook~ should they +need to (provided they understand the implications). * Face coverage :properties: @@ -3882,7 +3922,9 @@ have lots of extensions, so the "full support" may not be 100% true… + custom (what you get with {{{kbd(M-x customize)}}}) + dashboard + deadgrep ++ debbugs + deft ++ denote + devdocs + dictionary + diff-hl @@ -3978,6 +4020,7 @@ have lots of extensions, so the "full support" may not be 100% true… + marginalia + markdown-mode + markup-faces (~adoc-mode~) ++ mct + messages + minimap + mode-line @@ -4089,6 +4132,7 @@ have lots of extensions, so the "full support" may not be 100% true… + xterm-color (and ansi-colors) + yaml-mode + yasnippet ++ ztree Plus many other miscellaneous faces that are provided by Emacs. @@ -4213,7 +4257,7 @@ length elsewhere in this manual: [[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with modus-themes-with-colors]]. #+begin_src emacs-lisp -(defun my-modus-themes-custom-faces () +(defun my-modus-themes-custom-faces (&rest _) (modus-themes-with-colors (custom-set-faces ;; Make foreground the same as background for a uniform bar on @@ -4229,6 +4273,8 @@ length elsewhere in this manual: (add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) #+end_src +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + As always, re-load the theme for changes to take effect. If the above does not work, try this instead: @@ -4260,7 +4306,7 @@ multiline comments in PHP with the ~php-mode~ package use the This seems to make all comments use the appropriate face: #+begin_src emacs-lisp -(defun my-multine-comments () +(defun my-multine-comments (&rest _) (setq-local c-doc-face-name 'font-lock-comment-face)) (add-hook 'php-mode-hook #'my-multine-comments) @@ -4396,7 +4442,7 @@ advanced customization options of the themes. [[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]. In the following example, we are assuming that the user wants to (i) -reuse color variables provided by the themes, (ii) be able to retain +re-use color variables provided by the themes, (ii) be able to retain their tweaks while switching between ~modus-operandi~ and ~modus-vivendi~, and (iii) have the option to highlight either the foreground of the parentheses or the background as well. @@ -4416,7 +4462,7 @@ Then we can update our preference with this: (setq my-highlight-parentheses-use-background nil) #+end_src -To reuse colors from the themes, we must wrap our code in the +To re-use colors from the themes, we must wrap our code in the ~modus-themes-with-colors~ macro. Our implementation must interface with the variables ~highlight-parentheses-background-colors~ and/or ~highlight-parentheses-colors~. @@ -4472,7 +4518,7 @@ implementation: (setq my-highlight-parentheses-use-background nil) ; Set to nil to disable backgrounds -(defun my-modus-themes-highlight-parentheses () +(defun my-modus-themes-highlight-parentheses (&rest _) (modus-themes-with-colors ;; Our preference for setting either background or foreground ;; styles, depending on `my-highlight-parentheses-use-background'. @@ -4507,6 +4553,8 @@ implementation: (add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-highlight-parentheses) #+end_src +[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme phase]]. + As always, re-load the theme for changes to take effect. ** Note on mmm-mode.el background colors @@ -5026,7 +5074,7 @@ more effective than trying to do the same with either red or blue (the latter is the least effective in that regard). When we need to work with several colors, it is always better to have -sufficient maneuvering space, especially since we cannot pick arbitrary +sufficient manoeuvring space, especially since we cannot pick arbitrary colors but only those that satisfy the accessibility objectives of the themes. @@ -5080,7 +5128,7 @@ each of the three channels of light (red, green, blue). For example: : xrandr --output LVDS1 --brightness 1.0 --gamma 0.76:0.75:0.68 Typography is another variable. Some font families are blurry at small -point sizes. Others may have a regular weight that is lighter (thinner) +point sizes. Others may have a regular weight that is lighter (thiner) than that of their peers which may, under certain circumstances, cause a halo effect around each glyph. @@ -5132,7 +5180,7 @@ it is already understood that one must follow the indicator or headline to view its contents and (ii) underlining everything would make the interface virtually unusable. -Again, one must exercise judgment in order to avoid discrimination, +Again, one must exercise judgement in order to avoid discrimination, where "discrimination" refers to: + The treatment of substantially different magnitudes as if they were of @@ -5206,7 +5254,7 @@ the themes, which is partially fleshed out in this manual. With regard to the artistic aspect (where "art" qua skill may amount to an imprecise science), there is no hard-and-fast rule in effect as it -requires one to exercise discretion and make decisions based on +requires one to exercize discretion and make decisions based on context-dependent information or constraints. As is true with most things in life, when in doubt, do not cling on to the letter of the law but try to understand its spirit. @@ -5356,12 +5404,12 @@ The Modus themes are a collective effort. Every bit of work matters. Daniel Mendler, David Edmondson, Eli Zaretskii, Fritz Grabo, Gautier Ponsinet, Illia Ostapyshyn, Kévin Le Gouguec, Koen van Greevenbroek, Kostadin Ninev, Madhavan Krishnan, Manuel Giraud, Markus Beppler, - Matthew Stevenson, Mauro Aranda, Nacho Barrientos, Nicolas De - Jaeghere, Paul David, Philip Kaludercic, Pierre Téchoueyres, Rudolf - Adamkovič, Sergey Nichiporchik, Shreyas Ragavan, Stefan Kangas, - Stephen Berman, Stephen Gildea, Steve Downey, Tomasz Hołubowicz, - Utkarsh Singh, Vincent Murphy, Xinglu Chen, Yuanchen Xie, fluentpwn, - okamsn. + Matthew Stevenson, Mauro Aranda, Nacho Barrientos, Niall Dooley, + Nicolas De Jaeghere, Paul David, Philip Kaludercic, Pierre + Téchoueyres, Rudolf Adamkovič, Sergey Nichiporchik, Shreyas Ragavan, + Stefan Kangas, Stephen Berman, Stephen Gildea, Steve Downey, Tomasz + Hołubowicz, Utkarsh Singh, Vincent Murphy, Xinglu Chen, Yuanchen + Xie, fluentpwn, okamsn. + Ideas and user feedback :: Aaron Jensen, Adam Porter, Adam Spiers, Adrian Manea, Aleksei Pirogov, Alex Griffin, Alex Koen, Alex @@ -5376,13 +5424,13 @@ The Modus themes are a collective effort. Every bit of work matters. Gonçalo Marrafa, Guilherme Semente, Gustavo Barros, Hörmetjan Yiltiz, Ilja Kocken, Imran Khan, Iris Garcia, Ivan Popovych, James Ferguson, Jeremy Friesen, Jerry Zhang, Johannes Grødem, John Haman, - Jonas Collberg, Jorge Morais, Joshua O'Connor, Julio C. Villasante, - Kenta Usami, Kevin Fleming, Kévin Le Gouguec, Kevin Kainan Li, - Kostadin Ninev, Laith Bahodi, Lasse Lindner, Len Trigg, Lennart - C. Karssen, Luis Miguel Castañeda, Magne Hov, Manuel Giraud, Manuel - Uberti, Mark Bestley, Mark Burton, Mark Simpson, Marko Kocic, Markus - Beppler, Matt Armstrong, Matthias Fuchs, Mattias Engdegård, Mauro - Aranda, Maxime Tréca, Michael Goldenberg, Morgan Smith, Morgan + John Wick, Jonas Collberg, Jorge Morais, Joshua O'Connor, Julio C. + Villasante, Kenta Usami, Kevin Fleming, Kévin Le Gouguec, Kevin + Kainan Li, Kostadin Ninev, Laith Bahodi, Lasse Lindner, Len Trigg, + Lennart C.{{{space()}}} Karssen, Luis Miguel Castañeda, Magne Hov, Manuel Giraud, + Manuel Uberti, Mark Bestley, Mark Burton, Mark Simpson, Marko Kocic, + Markus Beppler, Matt Armstrong, Matthias Fuchs, Mattias Engdegård, + Mauro Aranda, Maxime Tréca, Michael Goldenberg, Morgan Smith, Morgan Willcock, Murilo Pereira, Nicky van Foreest, Nicolas De Jaeghere, Nicolas Semrau, Olaf Meeuwissen, Oliver Epper, Pablo Stafforini, Paul Poloskov, Pengji Zhang, Pete Kazmier, Peter Wu, Philip @@ -5392,11 +5440,12 @@ The Modus themes are a collective effort. Every bit of work matters. Ragavan, Simon Pugnet, Steve Downey, Tassilo Horn, Thanos Apollo, Thibaut Verron, Thomas Heartman, Togan Muftuoglu, Tony Zorman, Trey Merkley, Tomasz Hołubowicz, Toon Claes, Uri Sharf, Utkarsh Singh, - Vincent Foley, Zoltan Kiraly. As well as users: Ben, CsBigDataHub1, + Vincent Foley, Zoltan Kiraly. As well as users: Ben, CsBigDataHub1, Emacs Contrib, Eugene, Fourchaux, Fredrik, Moesasji, Nick, Summer Emacs, TheBlob42, TitusMu, Trey, bepolymathe, bit9tream, bangedorrunt, derek-upham, doolio, fleimgruber, gitrj95, iSeeU, - jixiuf, okamsn, pRot0ta1p, soaringbird, tumashu, wakamenod. + jixiuf, ltmsyvag, okamsn, pRot0ta1p, soaringbird, tumashu, + wakamenod. + Packaging :: Basil L.{{{space()}}} Contovounesios, Eli Zaretskii, Glenn Morris, Mauro Aranda, Richard Stallman, Stefan Kangas (core diff --git a/etc/themes/modus-operandi-deuteranopia-theme.el b/etc/themes/modus-operandi-deuteranopia-theme.el index 4d210b977eb..42479965300 100644 --- a/etc/themes/modus-operandi-deuteranopia-theme.el +++ b/etc/themes/modus-operandi-deuteranopia-theme.el @@ -1,11 +1,10 @@ ;;; modus-operandi-deuteranopia-theme.el --- Deuteranopia-optimized theme with a white background -*- lexical-binding:t -*- -;; Copyright (C) 2019-2024 Free Software Foundation, Inc. +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> -;; URL: https://git.sr.ht/~protesilaos/modus-themes -;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes +;; Maintainer: Protesilaos Stavrou +;; URL: https://github.com/protesilaos/modus-themes ;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. @@ -128,12 +127,12 @@ standard)." (bg-magenta-subtle "#ffddff") (bg-cyan-subtle "#bfefff") - (bg-red-nuanced "#fff1f0") - (bg-green-nuanced "#ecf7ed") - (bg-yellow-nuanced "#fff3da") - (bg-blue-nuanced "#f3f3ff") - (bg-magenta-nuanced "#fdf0ff") - (bg-cyan-nuanced "#ebf6fa") + (bg-red-nuanced "#ffe8e8") + (bg-green-nuanced "#e0f6e0") + (bg-yellow-nuanced "#f8f0d0") + (bg-blue-nuanced "#ecedff") + (bg-magenta-nuanced "#f8e6f5") + (bg-cyan-nuanced "#e0f2fa") ;;; Uncommon accent backgrounds @@ -212,6 +211,7 @@ standard)." ;;; Paren match (bg-paren-match "#5fcfff") + (fg-paren-match fg-main) (bg-paren-expression "#efd3f5") (underline-paren-match unspecified) @@ -241,6 +241,11 @@ standard)." (bg-prominent-note bg-cyan-intense) (fg-prominent-note fg-main) + (bg-active-argument bg-yellow-nuanced) + (fg-active-argument yellow-warmer) + (bg-active-value bg-blue-nuanced) + (fg-active-value blue-warmer) + ;;;; Code mappings (builtin magenta-warmer) @@ -289,7 +294,7 @@ standard)." (date-event fg-alt) (date-holiday yellow-warmer) (date-holiday-other blue) - (date-now blue-faint) + (date-now fg-main) (date-range fg-alt) (date-scheduled yellow-cooler) (date-weekday cyan) @@ -343,16 +348,29 @@ standard)." ;;;; Prose mappings - (prose-block fg-dim) - (prose-code cyan-cooler) + (bg-prose-block-delimiter bg-dim) + (fg-prose-block-delimiter fg-dim) + (bg-prose-block-contents bg-dim) + + (bg-prose-code unspecified) + (fg-prose-code cyan-cooler) + + (bg-prose-macro unspecified) + (fg-prose-macro magenta-cooler) + + (bg-prose-verbatim unspecified) + (fg-prose-verbatim magenta-warmer) + (prose-done blue) - (prose-macro magenta-cooler) + (prose-todo yellow-warmer) + (prose-metadata fg-dim) (prose-metadata-value fg-alt) + (prose-table fg-alt) + (prose-table-formula yellow-warmer) + (prose-tag magenta-faint) - (prose-todo yellow-warmer) - (prose-verbatim magenta-warmer) ;;;; Rainbow mappings @@ -366,6 +384,17 @@ standard)." (rainbow-7 yellow-faint) (rainbow-8 cyan) +;;;; Search mappings + + (bg-search-current bg-yellow-intense) + (bg-search-lazy bg-blue-intense) + (bg-search-replace bg-magenta-intense) + + (bg-search-rx-group-0 bg-cyan-intense) + (bg-search-rx-group-1 bg-magenta-intense) + (bg-search-rx-group-2 bg-blue-subtle) + (bg-search-rx-group-3 bg-yellow-subtle) + ;;;; Space mappings (bg-space unspecified) @@ -374,10 +403,10 @@ standard)." ;;;; Terminal mappings - (bg-term-black "black") - (fg-term-black "black") - (bg-term-black-bright "gray35") - (fg-term-black-bright "gray35") + (bg-term-black "#000000") + (fg-term-black "#000000") + (bg-term-black-bright "#595959") + (fg-term-black-bright "#595959") (bg-term-red red) (fg-term-red red) @@ -409,10 +438,10 @@ standard)." (bg-term-cyan-bright cyan-cooler) (fg-term-cyan-bright cyan-cooler) - (bg-term-white "gray65") - (fg-term-white "gray65") - (bg-term-white-bright "white") - (fg-term-white-bright "white") + (bg-term-white "#a6a6a6") + (fg-term-white "#a6a6a6") + (bg-term-white-bright "#ffffff") + (fg-term-white-bright "#ffffff") ;;;; Heading mappings diff --git a/etc/themes/modus-operandi-theme.el b/etc/themes/modus-operandi-theme.el index b41d5491c2e..fb2ff99a74b 100644 --- a/etc/themes/modus-operandi-theme.el +++ b/etc/themes/modus-operandi-theme.el @@ -1,11 +1,10 @@ ;;; modus-operandi-theme.el --- Elegant, highly legible theme with a white background -*- lexical-binding:t -*- -;; Copyright (C) 2019-2024 Free Software Foundation, Inc. +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> -;; URL: https://git.sr.ht/~protesilaos/modus-themes -;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes +;; Maintainer: Protesilaos Stavrou +;; URL: https://github.com/protesilaos/modus-themes ;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. @@ -126,12 +125,12 @@ which corresponds to a minimum contrast in relative luminance of (bg-magenta-subtle "#ffddff") (bg-cyan-subtle "#bfefff") - (bg-red-nuanced "#fff1f0") - (bg-green-nuanced "#ecf7ed") - (bg-yellow-nuanced "#fff3da") - (bg-blue-nuanced "#f3f3ff") - (bg-magenta-nuanced "#fdf0ff") - (bg-cyan-nuanced "#ebf6fa") + (bg-red-nuanced "#ffe8e8") + (bg-green-nuanced "#e0f6e0") + (bg-yellow-nuanced "#f8f0d0") + (bg-blue-nuanced "#ecedff") + (bg-magenta-nuanced "#f8e6f5") + (bg-cyan-nuanced "#e0f2fa") ;;; Uncommon accent backgrounds @@ -210,6 +209,7 @@ which corresponds to a minimum contrast in relative luminance of ;;; Paren match (bg-paren-match "#5fcfff") + (fg-paren-match fg-main) (bg-paren-expression "#efd3f5") (underline-paren-match unspecified) @@ -239,6 +239,11 @@ which corresponds to a minimum contrast in relative luminance of (bg-prominent-note bg-cyan-intense) (fg-prominent-note fg-main) + (bg-active-argument bg-yellow-nuanced) + (fg-active-argument yellow-warmer) + (bg-active-value bg-cyan-nuanced) + (fg-active-value cyan-warmer) + ;;;; Code mappings (builtin magenta-warmer) @@ -341,16 +346,29 @@ which corresponds to a minimum contrast in relative luminance of ;;;; Prose mappings - (prose-block fg-dim) - (prose-code green-cooler) + (bg-prose-block-delimiter bg-dim) + (fg-prose-block-delimiter fg-dim) + (bg-prose-block-contents bg-dim) + + (bg-prose-code unspecified) + (fg-prose-code cyan-cooler) + + (bg-prose-macro unspecified) + (fg-prose-macro magenta-cooler) + + (bg-prose-verbatim unspecified) + (fg-prose-verbatim magenta-warmer) + (prose-done green) - (prose-macro magenta-cooler) + (prose-todo red) + (prose-metadata fg-dim) (prose-metadata-value fg-alt) + (prose-table fg-alt) + (prose-table-formula magenta-warmer) + (prose-tag magenta-faint) - (prose-todo red) - (prose-verbatim magenta-warmer) ;;;; Rainbow mappings @@ -364,6 +382,17 @@ which corresponds to a minimum contrast in relative luminance of (rainbow-7 blue-warmer) (rainbow-8 magenta-warmer) +;;;; Search mappings + + (bg-search-current bg-yellow-intense) + (bg-search-lazy bg-cyan-intense) + (bg-search-replace bg-red-intense) + + (bg-search-rx-group-0 bg-blue-intense) + (bg-search-rx-group-1 bg-green-intense) + (bg-search-rx-group-2 bg-red-subtle) + (bg-search-rx-group-3 bg-magenta-subtle) + ;;;; Space mappings (bg-space unspecified) @@ -372,10 +401,10 @@ which corresponds to a minimum contrast in relative luminance of ;;;; Terminal mappings - (bg-term-black "black") - (fg-term-black "black") - (bg-term-black-bright "gray35") - (fg-term-black-bright "gray35") + (bg-term-black "#000000") + (fg-term-black "#000000") + (bg-term-black-bright "#595959") + (fg-term-black-bright "#595959") (bg-term-red red) (fg-term-red red) @@ -407,10 +436,10 @@ which corresponds to a minimum contrast in relative luminance of (bg-term-cyan-bright cyan-cooler) (fg-term-cyan-bright cyan-cooler) - (bg-term-white "gray65") - (fg-term-white "gray65") - (bg-term-white-bright "white") - (fg-term-white-bright "white") + (bg-term-white "#a6a6a6") + (fg-term-white "#a6a6a6") + (bg-term-white-bright "#ffffff") + (fg-term-white-bright "#ffffff") ;;;; Heading mappings diff --git a/etc/themes/modus-operandi-tinted-theme.el b/etc/themes/modus-operandi-tinted-theme.el index 7e0ad3d7ea8..f112456034b 100644 --- a/etc/themes/modus-operandi-tinted-theme.el +++ b/etc/themes/modus-operandi-tinted-theme.el @@ -1,11 +1,11 @@ -;;; modus-operandi-tinted-theme.el --- Elegant, highly legible theme with a light ocher background -*- lexical-binding:t -*- +;;; modus-operandi-tinted-theme.el --- Elegant, highly legible theme with a light ochre background -*- lexical-binding:t -*- -;; Copyright (C) 2019-2024 Free Software Foundation, Inc. +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> -;; URL: https://git.sr.ht/~protesilaos/modus-themes -;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes +;; Maintainer: Protesilaos Stavrou +;; URL: https://github.com/protesilaos/modus-themes +;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. @@ -44,7 +44,7 @@ ;;;###theme-autoload (deftheme modus-operandi-tinted - "Elegant, highly legible theme with a light ocher background. + "Elegant, highly legible theme with a light ochre background. Conforms with the highest legibility standard for color contrast between background and foreground in any given piece of text, which corresponds to a minimum contrast in relative luminance of @@ -125,12 +125,12 @@ which corresponds to a minimum contrast in relative luminance of (bg-magenta-subtle "#ffddff") (bg-cyan-subtle "#bfefff") - (bg-red-nuanced "#ffe8f0") - (bg-green-nuanced "#e0f5e0") - (bg-yellow-nuanced "#f9ead0") - (bg-blue-nuanced "#ebebff") - (bg-magenta-nuanced "#f6e7ff") - (bg-cyan-nuanced "#e1f3fc") + (bg-red-nuanced "#ffe8e8") + (bg-green-nuanced "#e0f6e0") + (bg-yellow-nuanced "#f8f0d0") + (bg-blue-nuanced "#ecedff") + (bg-magenta-nuanced "#f8e6f5") + (bg-cyan-nuanced "#e0f2fa") ;;; Uncommon accent backgrounds @@ -209,6 +209,7 @@ which corresponds to a minimum contrast in relative luminance of ;;; Paren match (bg-paren-match "#7fdfcf") + (fg-paren-match fg-main) (bg-paren-expression "#efd3f5") (underline-paren-match unspecified) @@ -217,9 +218,9 @@ which corresponds to a minimum contrast in relative luminance of ;;;; General mappings (fringe bg-dim) - (cursor red) + (cursor red-intense) - (keybind blue-cooler) + (keybind red) (name magenta) (identifier yellow-cooler) @@ -238,6 +239,11 @@ which corresponds to a minimum contrast in relative luminance of (bg-prominent-note bg-cyan-intense) (fg-prominent-note fg-main) + (bg-active-argument bg-yellow-nuanced) + (fg-active-argument yellow-warmer) + (bg-active-value bg-cyan-nuanced) + (fg-active-value cyan-warmer) + ;;;; Code mappings (builtin magenta-warmer) @@ -340,16 +346,29 @@ which corresponds to a minimum contrast in relative luminance of ;;;; Prose mappings - (prose-block fg-dim) - (prose-code green-cooler) + (bg-prose-block-delimiter bg-dim) + (fg-prose-block-delimiter fg-dim) + (bg-prose-block-contents bg-dim) + + (bg-prose-code unspecified) + (fg-prose-code cyan-cooler) + + (bg-prose-macro unspecified) + (fg-prose-macro magenta-cooler) + + (bg-prose-verbatim unspecified) + (fg-prose-verbatim magenta-warmer) + (prose-done green) - (prose-macro magenta-cooler) + (prose-todo red) + (prose-metadata fg-dim) (prose-metadata-value fg-alt) + (prose-table fg-alt) + (prose-table-formula magenta-warmer) + (prose-tag magenta-faint) - (prose-todo red) - (prose-verbatim magenta-warmer) ;;;; Rainbow mappings @@ -363,6 +382,17 @@ which corresponds to a minimum contrast in relative luminance of (rainbow-7 blue-warmer) (rainbow-8 magenta-warmer) +;;;; Search mappings + + (bg-search-current bg-yellow-intense) + (bg-search-lazy bg-cyan-intense) + (bg-search-replace bg-red-intense) + + (bg-search-rx-group-0 bg-blue-intense) + (bg-search-rx-group-1 bg-green-intense) + (bg-search-rx-group-2 bg-red-subtle) + (bg-search-rx-group-3 bg-magenta-subtle) + ;;;; Space mappings (bg-space unspecified) @@ -371,10 +401,10 @@ which corresponds to a minimum contrast in relative luminance of ;;;; Terminal mappings - (bg-term-black "black") - (fg-term-black "black") - (bg-term-black-bright "gray35") - (fg-term-black-bright "gray35") + (bg-term-black "#000000") + (fg-term-black "#000000") + (bg-term-black-bright "#595959") + (fg-term-black-bright "#595959") (bg-term-red red) (fg-term-red red) @@ -406,10 +436,10 @@ which corresponds to a minimum contrast in relative luminance of (bg-term-cyan-bright cyan-cooler) (fg-term-cyan-bright cyan-cooler) - (bg-term-white "gray65") - (fg-term-white "gray65") - (bg-term-white-bright "white") - (fg-term-white-bright "white") + (bg-term-white "#a6a6a6") + (fg-term-white "#a6a6a6") + (bg-term-white-bright "#ffffff") + (fg-term-white-bright "#ffffff") ;;;; Heading mappings diff --git a/etc/themes/modus-operandi-tritanopia-theme.el b/etc/themes/modus-operandi-tritanopia-theme.el index 968a6526ca3..56be8329784 100644 --- a/etc/themes/modus-operandi-tritanopia-theme.el +++ b/etc/themes/modus-operandi-tritanopia-theme.el @@ -1,11 +1,10 @@ ;;; modus-operandi-tritanopia-theme.el --- Tritanopia-optimized theme with a white background -*- lexical-binding:t -*- -;; Copyright (C) 2019-2024 Free Software Foundation, Inc. +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> -;; URL: https://git.sr.ht/~protesilaos/modus-themes -;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes +;; Maintainer: Protesilaos Stavrou +;; URL: https://github.com/protesilaos/modus-themes ;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. @@ -128,12 +127,12 @@ standard)." (bg-magenta-subtle "#ffddff") (bg-cyan-subtle "#bfefff") - (bg-red-nuanced "#fff1f0") - (bg-green-nuanced "#ecf7ed") - (bg-yellow-nuanced "#fff3da") - (bg-blue-nuanced "#f3f3ff") - (bg-magenta-nuanced "#fdf0ff") - (bg-cyan-nuanced "#ebf6fa") + (bg-red-nuanced "#ffe8e8") + (bg-green-nuanced "#e0f6e0") + (bg-yellow-nuanced "#f8f0d0") + (bg-blue-nuanced "#ecedff") + (bg-magenta-nuanced "#f8e6f5") + (bg-cyan-nuanced "#e0f2fa") ;;; Uncommon accent backgrounds @@ -212,6 +211,7 @@ standard)." ;;; Paren match (bg-paren-match "#5fcfff") + (fg-paren-match fg-main) (bg-paren-expression "#efd3f5") (underline-paren-match unspecified) @@ -241,6 +241,11 @@ standard)." (bg-prominent-note bg-cyan-intense) (fg-prominent-note fg-main) + (bg-active-argument bg-red-nuanced) + (fg-active-argument red-warmer) + (bg-active-value bg-cyan-nuanced) + (fg-active-value cyan) + ;;;; Code mappings (builtin magenta) @@ -343,16 +348,29 @@ standard)." ;;;; Prose mappings - (prose-block fg-dim) - (prose-code cyan) + (bg-prose-block-delimiter bg-dim) + (fg-prose-block-delimiter fg-dim) + (bg-prose-block-contents bg-dim) + + (bg-prose-code unspecified) + (fg-prose-code cyan) + + (bg-prose-macro unspecified) + (fg-prose-macro red-warmer) + + (bg-prose-verbatim unspecified) + (fg-prose-verbatim magenta-warmer) + (prose-done cyan) - (prose-macro red-warmer) + (prose-todo red) + (prose-metadata fg-dim) (prose-metadata-value fg-alt) + (prose-table fg-alt) - (prose-tag fg-alt) - (prose-todo red) - (prose-verbatim magenta-warmer) + (prose-table-formula red-cooler) + + (prose-tag magenta-faint) ;;;; Rainbow mappings @@ -366,6 +384,17 @@ standard)." (rainbow-7 magenta-faint) (rainbow-8 red-faint) +;;;; Search mappings + + (bg-search-current bg-red-intense) + (bg-search-lazy bg-cyan-intense) + (bg-search-replace bg-magenta-intense) + + (bg-search-rx-group-0 bg-blue-intense) + (bg-search-rx-group-1 bg-magenta-intense) + (bg-search-rx-group-2 bg-cyan-subtle) + (bg-search-rx-group-3 bg-red-subtle) + ;;;; Space mappings (bg-space unspecified) @@ -374,10 +403,10 @@ standard)." ;;;; Terminal mappings - (bg-term-black "black") - (fg-term-black "black") - (bg-term-black-bright "gray35") - (fg-term-black-bright "gray35") + (bg-term-black "#000000") + (fg-term-black "#000000") + (bg-term-black-bright "#595959") + (fg-term-black-bright "#595959") (bg-term-red red) (fg-term-red red) @@ -409,10 +438,10 @@ standard)." (bg-term-cyan-bright cyan-cooler) (fg-term-cyan-bright cyan-cooler) - (bg-term-white "gray65") - (fg-term-white "gray65") - (bg-term-white-bright "white") - (fg-term-white-bright "white") + (bg-term-white "#a6a6a6") + (fg-term-white "#a6a6a6") + (bg-term-white-bright "#ffffff") + (fg-term-white-bright "#ffffff") ;;;; Heading mappings diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el index 44f25182a30..b776f12671e 100644 --- a/etc/themes/modus-themes.el +++ b/etc/themes/modus-themes.el @@ -1,12 +1,11 @@ ;;; modus-themes.el --- Elegant, highly legible and customizable themes -*- lexical-binding:t -*- -;; Copyright (C) 2019-2024 Free Software Foundation, Inc. +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> -;; URL: https://git.sr.ht/~protesilaos/modus-themes -;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes -;; Version: 4.3.0 +;; Maintainer: Protesilaos Stavrou +;; URL: https://github.com/protesilaos/modus-themes +;; Version: 4.4.0 ;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility @@ -37,9 +36,7 @@ -(eval-when-compile - (require 'cl-lib) - (require 'subr-x)) +(eval-when-compile (require 'subr-x)) (defgroup modus-themes () "User options for the Modus themes. @@ -66,11 +63,6 @@ deficiency (deuteranopia or tritanopia, respectively)." :prefix "modus-themes-" :tag "Modus Themes Faces") -(make-obsolete-variable 'modus-themes-operandi-colors nil "4.0.0") -(make-obsolete-variable 'modus-themes-vivendi-colors nil "4.0.0") -(make-obsolete-variable 'modus-themes-version nil "4.0.0") -(make-obsolete 'modus-themes-report-bug nil "4.0.0") - ;;;; Custom faces @@ -139,7 +131,7 @@ deficiency (deuteranopia or tritanopia, respectively)." :version "30.1" :group 'modus-themes-faces)) -(dolist (scope '(current lazy)) +(dolist (scope '(current lazy replace)) (custom-declare-face (intern (format "modus-themes-search-%s" scope)) nil (format "Search of type %s." scope) @@ -147,15 +139,13 @@ deficiency (deuteranopia or tritanopia, respectively)." :version "30.1" :group 'modus-themes-faces)) -(define-obsolete-variable-alias - 'modus-themes-search-success - 'modus-themes-search-current - "4.0.0") - -(define-obsolete-variable-alias - 'modus-themes-search-success-lazy - 'modus-themes-search-lazy - "4.0.0") +(dotimes (n 4) + (custom-declare-face + (intern (format "modus-themes-search-rx-group-%s" n)) + nil (format "Search regexp group number %s." n) + :package-version '(modus-themes . "4.4.0") + :version "30.1" + :group 'modus-themes-faces)) (dolist (scope '(code macro verbatim)) (custom-declare-face @@ -165,21 +155,6 @@ deficiency (deuteranopia or tritanopia, respectively)." :version "30.1" :group 'modus-themes-faces)) -(define-obsolete-variable-alias - 'modus-themes-markup-code - 'modus-themes-prose-code - "4.0.0") - -(define-obsolete-variable-alias - 'modus-themes-markup-macro - 'modus-themes-prose-macro - "4.0.0") - -(define-obsolete-variable-alias - 'modus-themes-markup-verbatim - 'modus-themes-prose-verbatim - "4.0.0") - (dotimes (n 9) (custom-declare-face (intern (format "modus-themes-heading-%d" n)) @@ -248,67 +223,6 @@ text should not be underlined as well) yet still blend in." :version "30.1" :group 'modus-themes-faces)) -(make-obsolete-variable 'modus-themes-reset-hard nil "4.0.0") -(make-obsolete-variable 'modus-themes-subtle-neutral nil "4.0.0") -(make-obsolete-variable 'modus-themes-intense-neutral nil "4.0.0") -(make-obsolete-variable 'modus-themes-refine-red nil "4.0.0") -(make-obsolete-variable 'modus-themes-refine-green nil "4.0.0") -(make-obsolete-variable 'modus-themes-refine-yellow nil "4.0.0") -(make-obsolete-variable 'modus-themes-refine-blue nil "4.0.0") -(make-obsolete-variable 'modus-themes-refine-magenta nil "4.0.0") -(make-obsolete-variable 'modus-themes-refine-cyan nil "4.0.0") -(make-obsolete-variable 'modus-themes-active-red nil "4.0.0") -(make-obsolete-variable 'modus-themes-active-green nil "4.0.0") -(make-obsolete-variable 'modus-themes-active-yellow nil "4.0.0") -(make-obsolete-variable 'modus-themes-active-blue nil "4.0.0") -(make-obsolete-variable 'modus-themes-active-magenta nil "4.0.0") -(make-obsolete-variable 'modus-themes-active-cyan nil "4.0.0") -(make-obsolete-variable 'modus-themes-fringe-red nil "4.0.0") -(make-obsolete-variable 'modus-themes-fringe-green nil "4.0.0") -(make-obsolete-variable 'modus-themes-fringe-yellow nil "4.0.0") -(make-obsolete-variable 'modus-themes-fringe-blue nil "4.0.0") -(make-obsolete-variable 'modus-themes-fringe-magenta nil "4.0.0") -(make-obsolete-variable 'modus-themes-fringe-cyan nil "4.0.0") -(make-obsolete-variable 'modus-themes-grue nil "4.0.0") -(make-obsolete-variable 'modus-themes-grue-nuanced nil "4.0.0") -(make-obsolete-variable 'modus-themes-red-nuanced nil "4.0.0") -(make-obsolete-variable 'modus-themes-green-nuanced nil "4.0.0") -(make-obsolete-variable 'modus-themes-yellow-nuanced nil "4.0.0") -(make-obsolete-variable 'modus-themes-blue-nuanced nil "4.0.0") -(make-obsolete-variable 'modus-themes-magenta-nuanced nil "4.0.0") -(make-obsolete-variable 'modus-themes-cyan-nuanced nil "4.0.0") -(make-obsolete-variable 'modus-themes-special-calm nil "4.0.0") -(make-obsolete-variable 'modus-themes-special-cold nil "4.0.0") -(make-obsolete-variable 'modus-themes-special-mild nil "4.0.0") -(make-obsolete-variable 'modus-themes-special-warm nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-added nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-changed nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-removed nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-refine-added nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-refine-changed nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-refine-removed nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-focus-added nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-focus-changed nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-focus-removed nil "4.0.0") -(make-obsolete-variable 'modus-themes-diff-heading nil "4.0.0") -(make-obsolete-variable 'modus-themes-pseudo-header nil "4.0.0") -(make-obsolete-variable 'modus-themes-mark-symbol nil "4.0.0") -(make-obsolete-variable 'modus-themes-hl-line nil "4.0.0") -(make-obsolete-variable 'modus-themes-search-success-modeline nil "4.0.0") -(make-obsolete-variable 'modus-themes-grue-active nil "4.0.0") -(make-obsolete-variable 'modus-themes-grue-background-active nil "4.0.0") -(make-obsolete-variable 'modus-themes-grue-background-intense nil "4.0.0") -(make-obsolete-variable 'modus-themes-grue-background-subtle nil "4.0.0") -(make-obsolete-variable 'modus-themes-grue-background-refine nil "4.0.0") -(make-obsolete-variable 'modus-themes-link-broken nil "4.0.0") -(make-obsolete-variable 'modus-themes-link-symlink nil "4.0.0") -(make-obsolete-variable 'modus-themes-tab-backdrop nil "4.0.0") -(make-obsolete-variable 'modus-themes-tab-active nil "4.0.0") -(make-obsolete-variable 'modus-themes-tab-inactive nil "4.0.0") -(make-obsolete-variable 'modus-themes-completion-selected-popup nil "4.0.0") -(make-obsolete-variable 'modus-themes-box-button nil "4.0.0") -(make-obsolete-variable 'modus-themes-box-button-pressed nil "4.0.0") - ;;;; Customization variables @@ -331,8 +245,6 @@ consequences. The user must manually reload the theme." :type 'boolean :link '(info-link "(modus-themes) Custom reload theme")) -(make-obsolete-variable 'modus-themes-inhibit-reload 'modus-themes-custom-auto-reload "4.0.0") - (defun modus-themes--set-option (sym val) "Custom setter for theme related user options. Will set SYM to VAL, and reload the current theme, unless @@ -422,9 +334,6 @@ This is used by the command `modus-themes-toggle'." :initialize #'custom-initialize-default :group 'modus-themes) -(make-obsolete-variable 'modus-themes-operandi-color-overrides nil "4.0.0") -(make-obsolete-variable 'modus-themes-vivendi-color-overrides nil "4.0.0") - (defvaralias 'modus-themes-slanted-constructs 'modus-themes-italic-constructs) (defcustom modus-themes-italic-constructs nil @@ -477,8 +386,6 @@ Protesilaos))." :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Mixed fonts")) -(make-obsolete-variable 'modus-themes-intense-mouseovers nil "4.0.0") - (defconst modus-themes--weight-widget '(choice :tag "Font weight (must be supported by the typeface)" (const :tag "Unspecified (use whatever the default is)" nil) @@ -611,51 +518,7 @@ and related user options." :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Heading styles")) -(make-obsolete-variable 'modus-themes-org-agenda nil "4.0.0") -(make-obsolete-variable 'modus-themes-fringes nil "4.0.0") -(make-obsolete-variable 'modus-themes-lang-checkers nil "4.0.0") - -(defcustom modus-themes-org-blocks nil - "Set the overall style of Org code blocks, quotes, and the like. - -Nil (the default) means that the block has no background of its -own: it uses the one that applies to the rest of the buffer. In -this case, the delimiter lines have a gray color for their text, -making them look exactly like all other Org properties. - -Option `gray-background' applies a subtle gray background to the -block's contents. It also affects the begin and end lines of the -block as they get another shade of gray as their background, -which differentiates them from the contents of the block. All -background colors extend to the edge of the window, giving the -area a rectangular, \"blocky\" presentation. If the begin/end -lines do not extend in this way, check the value of the Org user -option `org-fontify-whole-block-delimiter-line'. - -Option `tinted-background' uses a colored background for the -contents of the block. The exact color value will depend on the -programming language and is controlled by the variable -`org-src-block-faces' (refer to the theme's source code for the -current association list). For this to take effect, the Org -buffer needs to be restarted with `org-mode-restart'. - -Code blocks use their major mode's fontification (syntax -highlighting) only when the variable `org-src-fontify-natively' -is non-nil. While quote/verse blocks require setting -`org-fontify-quote-and-verse-blocks' to a non-nil value." - :group 'modus-themes - :package-version '(modus-themes . "4.0.0") - :version "30.1" - :type '(choice - (const :format "[%v] %t\n" :tag "No Org block background (default)" nil) - (const :format "[%v] %t\n" :tag "Subtle gray block background" gray-background) - (const :format "[%v] %t\n" :tag "Color-coded background per programming language" tinted-background)) - :set #'modus-themes--set-option - :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Org mode blocks")) - -(make-obsolete-variable 'modus-themes-mode-line nil "4.0.0") -(make-obsolete-variable 'modus-themes-diffs nil "4.0.0") +(make-obsolete-variable 'modus-themes-org-blocks nil "4.4.0: Use palette overrides") (defcustom modus-themes-completions nil "Control the style of completion user interfaces. @@ -778,17 +641,6 @@ In user configuration files the form may look like this: :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Command prompts")) -(make-obsolete-variable 'modus-themes-subtle-line-numbers nil "4.0.0") -(make-obsolete-variable 'modus-themes-markup nil "4.0.0") -(make-obsolete-variable 'modus-themes-paren-match nil "4.0.0") -(make-obsolete-variable 'modus-themes-syntax nil "4.0.0") -(make-obsolete-variable 'modus-themes-links nil "4.0.0") -(make-obsolete-variable 'modus-themes-region nil "4.0.0") -(make-obsolete-variable 'modus-themes-deuteranopia nil "4.0.0") -(make-obsolete-variable 'modus-themes-mail-citations nil "4.0.0") -(make-obsolete-variable 'modus-themes-tabs-accented nil "4.0.0") -(make-obsolete-variable 'modus-themes-box-buttons nil "4.0.0") - (defcustom modus-themes-common-palette-overrides nil "Set palette overrides for all the Modus themes. @@ -918,12 +770,13 @@ represents." (fg-prompt cyan-faint) - (prose-code olive) + (fg-prose-code olive) + (fg-prose-macro indigo) + (fg-prose-verbatim maroon) + (prose-done green-faint) - (prose-macro indigo) (prose-tag rust) (prose-todo red-faint) - (prose-verbatim maroon) (rainbow-0 fg-main) (rainbow-1 magenta) @@ -983,17 +836,18 @@ Info node `(modus-themes) Option for palette overrides'.") (keybind blue-intense) (mail-cite-0 blue) - (mail-cite-1 yellow) - (mail-cite-2 green) + (mail-cite-1 yellow-cooler) + (mail-cite-2 green-warmer) (mail-cite-3 magenta) - (mail-part magenta-cooler) - (mail-recipient cyan) + (mail-part cyan) + (mail-recipient magenta-cooler) (mail-subject red-warmer) (mail-other cyan-cooler) (fg-prompt blue-intense) - (prose-block red-faint) + (bg-prose-block-delimiter bg-dim) + (fg-prose-block-delimiter red-faint) (prose-done green-intense) (prose-metadata magenta-faint) (prose-metadata-value blue-cooler) @@ -1081,7 +935,7 @@ Info node `(modus-themes) Option for palette overrides'.") (mail-other blue) (prose-tag fg-dim) - (prose-verbatim blue-cooler)) + (fg-prose-verbatim blue-cooler)) "Preset of palette overrides with cooler colors. This changes parts of the palette to use more blue and @@ -1136,7 +990,7 @@ Info node `(modus-themes) Option for palette overrides'.") (mail-subject blue-warmer) (mail-other magenta-warmer) - (prose-macro red-cooler) + (fg-prose-macro red-cooler) (prose-tag fg-dim)) "Preset of palette overrides with warmer colors. @@ -1162,14 +1016,22 @@ Info node `(modus-themes) Option for palette overrides'.") ;;;; Helper functions for theme setup ;; This is the WCAG formula: https://www.w3.org/TR/WCAG20-TECHS/G18.html +(defun modus-themes--wcag-contribution (channel weight) + "Return the CHANNEL contribution to overall luminance given WEIGHT." + (* weight + (if (<= channel 0.03928) + (/ channel 12.92) + (expt (/ (+ channel 0.055) 1.055) 2.4)))) + (defun modus-themes-wcag-formula (hex) "Get WCAG value of color value HEX. The value is defined in hexadecimal RGB notation, such #123456." - (cl-loop for k in '(0.2126 0.7152 0.0722) - for x in (color-name-to-rgb hex) - sum (* k (if (<= x 0.03928) - (/ x 12.92) - (expt (/ (+ x 0.055) 1.055) 2.4))))) + (let ((channels (color-name-to-rgb hex)) + (weights '(0.2126 0.7152 0.0722)) + contribution) + (while channels + (push (modus-themes--wcag-contribution (pop channels) (pop weights)) contribution)) + (apply #'+ contribution))) ;;;###autoload (defun modus-themes-contrast (c1 c2) @@ -1179,32 +1041,27 @@ C1 and C2 are color values written in hexadecimal RGB." (+ (modus-themes-wcag-formula c2) 0.05)))) (max ct (/ ct)))) -(make-obsolete 'modus-themes-color nil "4.0.0") -(make-obsolete 'modus-themes-color-alts nil "4.0.0") - -(declare-function cl-remove-if-not "cl-seq" (cl-pred cl-list &rest cl-keys)) +(defun modus-themes--modus-p (theme) + "Return non-nil if THEME name has a modus- prefix." + (string-prefix-p "modus-" (symbol-name theme))) (defun modus-themes--list-enabled-themes () "Return list of `custom-enabled-themes' with modus- prefix." - (cl-remove-if-not - (lambda (theme) - (string-prefix-p "modus-" (symbol-name theme))) - custom-enabled-themes)) + (seq-filter #'modus-themes--modus-p custom-enabled-themes)) + +(defun modus-themes--load-no-enable (theme) + "Load but do not enable THEME if it belongs to `custom-known-themes'." + (unless (memq theme custom-known-themes) + (load-theme theme :no-confirm :no-enable))) (defun modus-themes--enable-themes () "Enable the Modus themes." - (mapc (lambda (theme) - (unless (memq theme custom-known-themes) - (load-theme theme :no-confirm :no-enable))) - modus-themes-items)) + (mapc #'modus-themes--load-no-enable modus-themes-items)) (defun modus-themes--list-known-themes () "Return list of `custom-known-themes' with modus- prefix." (modus-themes--enable-themes) - (cl-remove-if-not - (lambda (theme) - (string-prefix-p "modus-" (symbol-name theme))) - custom-known-themes)) + (seq-filter #'modus-themes--modus-p custom-known-themes)) (defun modus-themes--current-theme () "Return first enabled Modus theme." @@ -1311,10 +1168,6 @@ symbol, which is safe when used as a face attribute's value." ;;;; Commands -(make-obsolete 'modus-themes-load-themes nil "4.0.0") -(make-obsolete 'modus-themes-load-operandi nil "4.0.0; Check `modus-themes-load-theme'") -(make-obsolete 'modus-themes-load-vivendi nil "4.0.0; Check `modus-themes-load-theme'") - (defvar modus-themes--select-theme-history nil "Minibuffer history of `modus-themes--select-prompt'.") @@ -1322,7 +1175,9 @@ symbol, which is safe when used as a face attribute's value." "Return completion annotation for THEME." (when-let ((symbol (intern-soft theme)) (doc-string (get symbol 'theme-documentation))) - (format " -- %s" (car (split-string doc-string "\\."))))) + (format " -- %s" + (propertize (car (split-string doc-string "\\.")) + 'face 'completions-annotations)))) (defun modus-themes--completion-table (category candidates) "Pass appropriate metadata CATEGORY to completion CANDIDATES." @@ -1486,8 +1341,7 @@ Check PROPERTIES for an alist value that corresponds to ALIST-KEY. If no alist is present, search the PROPERTIES list given LIST-PRED, using DEFAULT as a fallback." (if-let* ((val (or (alist-get alist-key properties) - (cl-loop for x in properties - if (funcall list-pred x) return x) + (seq-filter (lambda (x) (funcall list-pred x)) properties) default)) ((listp val))) (car val) @@ -1535,7 +1389,7 @@ color that is combined with FG-FOR-BG." :foreground fg :weight ;; If we have `bold' specifically, we inherit the face of - ;; the same name. This allows the user to customize that + ;; the same name. This allows the user to customise that ;; face, such as to change its font family. (if (and weight (not (eq weight 'bold))) weight @@ -1581,16 +1435,6 @@ Optional OL is the color of an overline." 'unspecified) :weight (or weight 'unspecified)))) -(defun modus-themes--org-block (fg bg) - "Conditionally set the FG and BG of Org blocks." - (let ((gray (or (eq modus-themes-org-blocks 'gray-background) - (eq modus-themes-org-blocks 'grayscale) ; for backward compatibility - (eq modus-themes-org-blocks 'greyscale)))) - (list :inherit 'modus-themes-fixed-pitch - :background (if gray bg 'unspecified) - :foreground (if gray 'unspecified fg) - :extend (if gray t 'unspecified)))) - (defun modus-themes--completion-line (bg) "Styles for `modus-themes-completions' with BG as the background." (let* ((var (modus-themes--list-or-warn 'modus-themes-completions)) @@ -1723,12 +1567,18 @@ FG and BG are the main colors." `(modus-themes-prominent-note ((,c :background ,bg-prominent-note :foreground ,fg-prominent-note))) `(modus-themes-prominent-warning ((,c :background ,bg-prominent-warning :foreground ,fg-prominent-warning))) ;;;;; markup - `(modus-themes-prose-code ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-code))) - `(modus-themes-prose-macro ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-macro))) - `(modus-themes-prose-verbatim ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-verbatim))) + `(modus-themes-prose-code ((,c :inherit modus-themes-fixed-pitch :background ,bg-prose-code :foreground ,fg-prose-code))) + `(modus-themes-prose-macro ((,c :inherit modus-themes-fixed-pitch :background ,bg-prose-macro :foreground ,fg-prose-macro))) + `(modus-themes-prose-verbatim ((,c :inherit modus-themes-fixed-pitch :background ,bg-prose-verbatim :foreground ,fg-prose-verbatim))) ;;;;; search - `(modus-themes-search-current ((,c :background ,bg-yellow-intense :foreground ,fg-main))) - `(modus-themes-search-lazy ((,c :background ,bg-cyan-intense :foreground ,fg-main))) + `(modus-themes-search-current ((,c :background ,bg-search-current :foreground ,fg-main))) + `(modus-themes-search-lazy ((,c :background ,bg-search-lazy :foreground ,fg-main))) + `(modus-themes-search-replace ((,c :background ,bg-search-replace :foreground ,fg-main))) +;;;;; search regexp groups + `(modus-themes-search-rx-group-0 ((,c :background ,bg-search-rx-group-0 :foreground ,fg-main))) + `(modus-themes-search-rx-group-1 ((,c :background ,bg-search-rx-group-1 :foreground ,fg-main))) + `(modus-themes-search-rx-group-2 ((,c :background ,bg-search-rx-group-2 :foreground ,fg-main))) + `(modus-themes-search-rx-group-3 ((,c :background ,bg-search-rx-group-3 :foreground ,fg-main))) ;;;;; completion frameworks `(modus-themes-completion-match-0 ((,c ,@(modus-themes--completion-match fg-completion-match-0 bg-completion-match-0)))) `(modus-themes-completion-match-1 ((,c ,@(modus-themes--completion-match fg-completion-match-1 bg-completion-match-1)))) @@ -1756,12 +1606,12 @@ FG and BG are the main colors." `(cursor ((,c :background ,cursor))) `(fringe ((,c :background ,fringe :foreground ,fg-main))) `(menu ((,c :background ,bg-dim :foreground ,fg-main))) - `(scroll-bar ((,c :background ,bg-dim :foreground ,fg-dim))) + `(scroll-bar ((,c :background ,fringe :foreground ,border))) `(tool-bar ((,c :background ,bg-dim :foreground ,fg-main))) `(vertical-border ((,c :foreground ,border))) ;;;;; basic and/or ungrouped styles - `(appt-notification ((,c :inherit error))) - `(blink-matching-paren-highlight-offscreen ((,c :background ,bg-paren-match))) + `(appt-notification ((,c :inherit bold :foreground ,modeline-err))) + `(blink-matching-paren-offscreen ((,c :background ,bg-paren-match))) `(bold ((,c :weight bold))) `(bold-italic ((,c :inherit (bold italic)))) `(underline ((,c :underline ,fg-dim))) @@ -1776,7 +1626,7 @@ FG and BG are the main colors." `(escape-glyph ((,c :foreground ,err))) `(file-name-shadow ((,c :inherit shadow))) `(header-line ((,c :inherit modus-themes-ui-variable-pitch :background ,bg-dim))) - `(header-line-highlight ((,c :inherit highlight))) + `(header-line-highlight ((,c :background ,bg-hover :foreground ,fg-main :box ,fg-main))) `(help-argument-name ((,c :inherit modus-themes-slant :foreground ,variable))) `(help-key-binding ((,c :inherit modus-themes-key-binding))) `(highlight ((,c :background ,bg-hover :foreground ,fg-main))) @@ -1792,7 +1642,7 @@ FG and BG are the main colors." `(mm-uu-extract ((,c :foreground ,mail-part))) `(next-error ((,c :inherit modus-themes-prominent-error :extend t))) `(pgtk-im-0 ((,c :inherit modus-themes-prominent-note))) - `(read-multiple-choice-face ((,c :inherit (bold modus-themes-mark-alt)))) + `(read-multiple-choice-face ((,c :inherit modus-themes-mark-sel))) `(rectangle-preview ((,c :inherit secondary-selection))) `(region ((,c :background ,bg-region :foreground ,fg-region))) `(secondary-selection ((,c :background ,bg-hover-secondary :foreground ,fg-main))) @@ -1909,7 +1759,7 @@ FG and BG are the main colors." `(anzu-match-3 ((,c :inherit modus-themes-subtle-yellow))) `(anzu-mode-line ((,c :inherit bold))) `(anzu-mode-line-no-match ((,c :inherit error))) - `(anzu-replace-highlight ((,c :inherit modus-themes-prominent-error :underline t))) + `(anzu-replace-highlight ((,c :inherit modus-themes-search-replace))) `(anzu-replace-to ((,c :inherit modus-themes-search-current))) ;;;;; auctex and Tex `(font-latex-bold-face ((,c :inherit bold))) @@ -2097,6 +1947,7 @@ FG and BG are the main colors." `(completions-annotations ((,c :inherit modus-themes-slant :foreground ,docstring))) `(completions-common-part ((,c :inherit modus-themes-completion-match-0))) `(completions-first-difference ((,c :inherit modus-themes-completion-match-1))) + `(completions-highlight ((,c :inherit modus-themes-completion-selected))) ;;;;; consult `(consult-async-split ((,c :inherit error))) `(consult-file ((,c :inherit modus-themes-bold :foreground ,info))) @@ -2104,6 +1955,7 @@ FG and BG are the main colors." `(consult-imenu-prefix ((,c :inherit shadow))) `(consult-line-number ((,c :inherit shadow))) `(consult-line-number-prefix ((,c :inherit shadow))) + `(consult-preview-insertion ((,c :background ,bg-dim))) ;;;;; corfu `(corfu-current ((,c :inherit modus-themes-completion-selected))) `(corfu-bar ((,c :background ,fg-dim))) @@ -2164,6 +2016,22 @@ FG and BG are the main colors." `(deadgrep-meta-face ((,c :inherit shadow))) `(deadgrep-regexp-metachar-face ((,c :inherit font-lock-regexp-grouping-construct))) `(deadgrep-search-term-face ((,c :inherit success))) +;;;;; debbugs + `(debbugs-gnu-archived ((,c :background ,bg-inactive :foreground ,fg-dim))) + `(debbugs-gnu-done ((,c :inherit success))) + `(debbugs-gnu-forwarded ((,c :inherit modus-themes-slant :foreground ,info))) + `(debbugs-gnu-handled (( ))) + `(debbugs-gnu-marked ((,c :inherit modus-themes-mark-sel))) + `(debbugs-gnu-marked-stale ((,c :inherit modus-themes-mark-alt))) + `(debbugs-gnu-new ((,c :inherit error))) + `(debbugs-gnu-pending ((,c :inherit modus-themes-slant :foreground ,fg-alt))) + `(debbugs-gnu-stale-1 ((,c :foreground ,red-cooler))) + `(debbugs-gnu-stale-2 ((,c :foreground ,yellow-warmer))) + `(debbugs-gnu-stale-3 ((,c :foreground ,magenta-warmer))) + `(debbugs-gnu-stale-4 ((,c :foreground ,magenta-cooler))) + `(debbugs-gnu-stale-5 ((,c :foreground ,cyan-faint))) + `(debbugs-gnu-tagged ((,c :inherit modus-themes-mark-alt))) + `(debbugs-gnu-title ((,c :inherit bold))) ;;;;; deft `(deft-filter-string-face ((,c :inherit success))) `(deft-header-face ((,c :inherit shadow))) @@ -2171,6 +2039,20 @@ FG and BG are the main colors." `(deft-summary-face ((,c :inherit (shadow modus-themes-slant)))) `(deft-time-face ((,c :foreground ,date-common))) `(deft-title-face ((,c :inherit bold))) +;;;;; denote + `(denote-faces-date ((,c :foreground ,date-common))) + `(denote-faces-delimiter ((,c :inherit shadow))) + `(denote-faces-extension ((,c :inherit shadow))) + `(denote-faces-keywords ((,c :inherit modus-themes-bold :foreground ,keyword))) + `(denote-faces-link ((,c :inherit link))) + `(denote-faces-prompt-current-name ((,c :inherit modus-themes-slant :foreground ,fg-changed-intense))) + `(denote-faces-prompt-new-name ((,c :inherit modus-themes-slant :foreground ,fg-added-intense))) + `(denote-faces-prompt-old-name ((,c :inherit modus-themes-slant :foreground ,fg-removed-intense))) + `(denote-faces-signature ((,c :inherit modus-themes-bold :foreground ,string))) + `(denote-faces-subdirectory ((,c :inherit modus-themes-bold :foreground ,fg-alt))) + `(denote-faces-time ((,c :inherit denote-faces-date))) + `(denote-faces-time-delimiter ((,c :inherit shadow))) + `(denote-faces-title (( ))) ;;;;; devdocs `(devdocs-code-block ((,c :inherit modus-themes-fixed-pitch :background ,bg-dim :extend t))) ;;;;; dictionary @@ -2340,7 +2222,7 @@ FG and BG are the main colors." `(el-search-occur-match ((,c :inherit match))) ;;;;; eldoc ;; NOTE: see https://github.com/purcell/package-lint/issues/187 - (list 'eldoc-highlight-function-argument `((,c :inherit modus-themes-mark-alt))) + (list 'eldoc-highlight-function-argument `((,c :inherit bold :background ,bg-active-argument :foreground ,fg-active-argument))) ;;;;; eldoc-box `(eldoc-box-body ((,c :background ,bg-dim :foreground ,fg-main))) `(eldoc-box-border ((,c :background ,border))) @@ -2420,9 +2302,11 @@ FG and BG are the main colors." `(erc-dangerous-host-face ((,c :inherit error))) `(erc-direct-msg-face ((,c :inherit shadow))) `(erc-error-face ((,c :inherit error))) + `(erc-fill-wrap-merge-indicator-face ((,c :foreground ,fg-dim))) `(erc-fool-face ((,c :inherit shadow))) `(erc-input-face ((,c :foreground ,fnname))) `(erc-inverse-face ((,c :inherit erc-default-face :inverse-video t))) + `(erc-keep-place-indicator-arrow ((,c :foreground ,info))) `(erc-keyword-face ((,c :inherit bold :foreground ,keyword))) `(erc-my-nick-face ((,c :inherit bold :foreground ,name))) `(erc-my-nick-prefix-face ((,c :inherit erc-my-nick-face))) @@ -2463,7 +2347,7 @@ FG and BG are the main colors." `(evil-ex-info ((,c :inherit font-lock-type-face))) `(evil-ex-lazy-highlight ((,c :inherit modus-themes-search-lazy))) `(evil-ex-search ((,c :inherit modus-themes-search-current))) - `(evil-ex-substitute-matches ((,c :inherit modus-themes-prominent-error :underline t))) + `(evil-ex-substitute-matches ((,c :inherit modus-themes-search-replace))) `(evil-ex-substitute-replacement ((,c :inherit modus-themes-search-current))) ;;;;; eww `(eww-invalid-certificate ((,c :foreground ,err))) @@ -2533,7 +2417,7 @@ FG and BG are the main colors." `(font-lock-variable-name-face ((,c :foreground ,variable))) `(font-lock-warning-face ((,c :inherit modus-themes-bold :foreground ,warning))) ;;;;; geiser - `(geiser-font-lock-autodoc-current-arg ((,c :inherit modus-themes-mark-alt))) + `(geiser-font-lock-autodoc-current-arg ((,c :inherit bold :background ,bg-active-argument :foreground ,fg-active-argument))) `(geiser-font-lock-autodoc-identifier ((,c :foreground ,docstring))) `(geiser-font-lock-doc-button ((,c :inherit button))) `(geiser-font-lock-doc-link ((,c :inherit button))) @@ -2574,7 +2458,7 @@ FG and BG are the main colors." `(git-timemachine-minibuffer-author-face ((,c :foreground ,name))) `(git-timemachine-minibuffer-detail-face ((,c :foreground ,fg-main))) ;;;;; gnus - `(gnus-button ((,c :inherit button))) + `(gnus-button ((,c :inherit button :underline nil))) `(gnus-cite-1 ((,c :inherit message-cited-text-1))) `(gnus-cite-2 ((,c :inherit message-cited-text-2))) `(gnus-cite-3 ((,c :inherit message-cited-text-3))) @@ -2665,37 +2549,37 @@ FG and BG are the main colors." ;; entries in their palette for such an edge case. Defining those ;; entries is not appropriate. `(hi-aquamarine ((((class color) (min-colors 88) (background light)) - :background "white" :foreground "#227f9f" :inverse-video t) + :background "#ffffff" :foreground "#227f9f" :inverse-video t) (((class color) (min-colors 88) (background dark)) - :background "black" :foreground "#66cbdc" :inverse-video t))) + :background "#000000" :foreground "#66cbdc" :inverse-video t))) `(hi-black-b ((,c :inverse-video t))) `(hi-black-hb ((,c :background ,bg-main :foreground ,fg-dim :inverse-video t))) `(hi-blue ((((class color) (min-colors 88) (background light)) - :background "white" :foreground "#3366dd" :inverse-video t) + :background "#ffffff" :foreground "#3366dd" :inverse-video t) (((class color) (min-colors 88) (background dark)) - :background "black" :foreground "#aaccff" :inverse-video t))) + :background "#000000" :foreground "#aaccff" :inverse-video t))) `(hi-blue-b ((,c :inherit (bold hi-blue)))) `(hi-green ((((class color) (min-colors 88) (background light)) - :background "white" :foreground "#008a00" :inverse-video t) + :background "#ffffff" :foreground "#008a00" :inverse-video t) (((class color) (min-colors 88) (background dark)) - :background "black" :foreground "#66dd66" :inverse-video t))) + :background "#000000" :foreground "#66dd66" :inverse-video t))) `(hi-green-b ((,c :inherit (bold hi-green)))) `(hi-pink ((((class color) (min-colors 88) (background light)) - :background "white" :foreground "#bd30aa" :inverse-video t) + :background "#ffffff" :foreground "#bd30aa" :inverse-video t) (((class color) (min-colors 88) (background dark)) - :background "black" :foreground "#ff88ee" :inverse-video t))) + :background "#000000" :foreground "#ff88ee" :inverse-video t))) `(hi-red-b ((((class color) (min-colors 88) (background light)) - :background "white" :foreground "#dd0000" :inverse-video t) + :background "#ffffff" :foreground "#dd0000" :inverse-video t) (((class color) (min-colors 88) (background dark)) - :background "black" :foreground "#f06666" :inverse-video t))) + :background "#000000" :foreground "#f06666" :inverse-video t))) `(hi-salmon ((((class color) (min-colors 88) (background light)) - :background "white" :foreground "#bf555a" :inverse-video t) + :background "#ffffff" :foreground "#bf555a" :inverse-video t) (((class color) (min-colors 88) (background dark)) - :background "black" :foreground "#e08a50" :inverse-video t))) + :background "#000000" :foreground "#e08a50" :inverse-video t))) `(hi-yellow ((((class color) (min-colors 88) (background light)) - :background "white" :foreground "#af6400" :inverse-video t) + :background "#ffffff" :foreground "#af6400" :inverse-video t) (((class color) (min-colors 88) (background dark)) - :background "black" :foreground "#faea00" :inverse-video t))) + :background "#000000" :foreground "#faea00" :inverse-video t))) `(highlight-changes ((,c :foreground ,warning :underline nil))) `(highlight-changes-delete ((,c :foreground ,err :underline t))) `(hl-line ((,c :background ,bg-hl-line :extend t))) @@ -2735,14 +2619,14 @@ FG and BG are the main colors." `(image-dired-thumb-header-file-size ((,c :foreground ,constant))) `(image-dired-thumb-mark ((,c :inherit modus-themes-mark-sel :box (:line-width -3)))) ;;;;; imenu-list - `(imenu-list-entry-face-0 ((,c :foreground ,fg-heading-0))) - `(imenu-list-entry-face-1 ((,c :foreground ,fg-heading-1))) - `(imenu-list-entry-face-2 ((,c :foreground ,fg-heading-2))) - `(imenu-list-entry-face-3 ((,c :foreground ,fg-heading-3))) - `(imenu-list-entry-subalist-face-0 ((,c :inherit bold :foreground ,fg-heading-4 :underline t))) - `(imenu-list-entry-subalist-face-1 ((,c :inherit bold :foreground ,fg-heading-5 :underline t))) - `(imenu-list-entry-subalist-face-2 ((,c :inherit bold :foreground ,fg-heading-6 :underline t))) - `(imenu-list-entry-subalist-face-3 ((,c :inherit bold :foreground ,fg-heading-7 :underline t))) + `(imenu-list-entry-face-0 ((,c :foreground ,fg-heading-1))) + `(imenu-list-entry-face-1 ((,c :foreground ,fg-heading-2))) + `(imenu-list-entry-face-2 ((,c :foreground ,fg-heading-3))) + `(imenu-list-entry-face-3 ((,c :foreground ,fg-heading-4))) + `(imenu-list-entry-subalist-face-0 ((,c :inherit bold :foreground ,fg-heading-1 :underline t))) + `(imenu-list-entry-subalist-face-1 ((,c :inherit bold :foreground ,fg-heading-2 :underline t))) + `(imenu-list-entry-subalist-face-2 ((,c :inherit bold :foreground ,fg-heading-3 :underline t))) + `(imenu-list-entry-subalist-face-3 ((,c :inherit bold :foreground ,fg-heading-4 :underline t))) ;;;;; indium `(indium-breakpoint-face ((,c :foreground ,err))) `(indium-frame-url-face ((,c :inherit (shadow button)))) @@ -2807,11 +2691,11 @@ FG and BG are the main colors." ;;;;; isearch, occur, and the like `(isearch ((,c :inherit modus-themes-search-current))) `(isearch-fail ((,c :inherit modus-themes-prominent-error))) - `(isearch-group-1 ((,c :inherit modus-themes-intense-blue))) - `(isearch-group-2 ((,c :inherit modus-themes-intense-magenta))) + `(isearch-group-1 ((,c :inherit modus-themes-search-rx-group-0))) + `(isearch-group-2 ((,c :inherit modus-themes-search-rx-group-1))) `(lazy-highlight ((,c :inherit modus-themes-search-lazy))) `(match ((,c :background ,bg-magenta-subtle :foreground ,fg-main))) - `(query-replace ((,c :inherit modus-themes-prominent-error))) + `(query-replace ((,c :inherit modus-themes-search-replace))) ;;;;; ivy `(ivy-action ((,c :inherit modus-themes-key-binding))) `(ivy-confirm-face ((,c :inherit success))) @@ -2876,7 +2760,7 @@ FG and BG are the main colors." `(kaocha-runner-warning-face ((,c :inherit warning))) ;;;;; keycast `(keycast-command ((,c :inherit bold))) - `(keycast-key ((,c :background ,keybind :foreground ,bg-main))) + `(keycast-key ((,c :inherit modus-themes-bold :background ,keybind :foreground ,bg-main))) ;;;;; ledger-mode `(ledger-font-auto-xact-face ((,c :inherit font-lock-builtin-face))) `(ledger-font-account-name-face ((,c :foreground ,name))) @@ -3033,7 +2917,7 @@ FG and BG are the main colors." `(markdown-highlighting-face ((,c :inherit secondary-selection))) `(markdown-inline-code-face ((,c :inherit modus-themes-prose-code))) `(markdown-italic-face ((,c :inherit italic))) - `(markdown-language-keyword-face ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-block))) + `(markdown-language-keyword-face ((,c :inherit modus-themes-fixed-pitch :background ,bg-prose-block-delimiter :foreground ,fg-prose-block-delimiter))) `(markdown-line-break-face ((,c :inherit nobreak-space))) `(markdown-link-face ((,c :inherit link))) `(markdown-markup-face ((,c :inherit shadow))) @@ -3046,12 +2930,12 @@ FG and BG are the main colors." ;;;;; markup-faces (`adoc-mode') `(markup-attribute-face ((,c :inherit (modus-themes-slant markup-meta-face)))) `(markup-bold-face ((,c :inherit bold))) - `(markup-code-face ((,c :foreground ,prose-code))) + `(markup-code-face ((,c :inherit modus-themes-prose-code))) `(markup-comment-face ((,c :inherit font-lock-comment-face))) - `(markup-complex-replacement-face ((,c :foreground ,prose-macro))) + `(markup-complex-replacement-face ((,c :inherit modus-themes-prose-macro))) `(markup-emphasis-face ((,c :inherit markup-italic-face))) `(markup-error-face ((,c :inherit error))) - `(markup-gen-face ((,c :foreground ,prose-verbatim))) + `(markup-gen-face ((,c :inherit modus-themes-prose-verbatim))) `(markup-internal-reference-face ((,c :inherit (shadow modus-themes-slant)))) `(markup-italic-face ((,c :inherit italic))) `(markup-list-face ((,c :background ,bg-inactive))) @@ -3073,7 +2957,9 @@ FG and BG are the main colors." `(markup-title-3-face ((,c :inherit modus-themes-heading-4))) `(markup-title-4-face ((,c :inherit modus-themes-heading-5))) `(markup-title-5-face ((,c :inherit modus-themes-heading-6))) - `(markup-verbatim-face ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-verbatim))) + `(markup-verbatim-face ((,c :inherit modus-themes-prose-verbatim))) +;;;;; mct + `(mct-highlight-candidate ((,c :inherit modus-themes-completion-selected))) ;;;;; messages `(message-cited-text-1 ((,c :foreground ,mail-cite-0))) `(message-cited-text-2 ((,c :foreground ,mail-cite-1))) @@ -3087,7 +2973,7 @@ FG and BG are the main colors." `(message-header-xheader ((,c :inherit message-header-other))) `(message-header-other ((,c :foreground ,mail-other))) `(message-mml ((,c :foreground ,mail-part))) - `(message-separator ((,c :background ,bg-active))) + `(message-separator ((,c :background ,bg-inactive :foreground ,fg-main))) ;;;;; minimap `(minimap-active-region-background ((,c :background ,bg-active))) `(minimap-current-line-face ((,c :background ,bg-cyan-intense :foreground ,fg-main))) @@ -3129,7 +3015,7 @@ FG and BG are the main colors." `(mu4e-contact-face ((,c :inherit message-header-to))) `(mu4e-context-face ((,c :inherit bold))) `(mu4e-draft-face ((,c :foreground ,warning))) - `(mu4e-flagged-face ((,c :foreground ,err))) + `(mu4e-flagged-face ((,c :foreground ,keyword))) `(mu4e-footer-face ((,c :inherit italic :foreground ,fg-alt))) `(mu4e-forwarded-face ((,c :inherit italic :foreground ,info))) `(mu4e-header-face ((,c :inherit shadow))) @@ -3148,6 +3034,7 @@ FG and BG are the main colors." `(mu4e-replied-face ((,c :foreground ,info))) `(mu4e-special-header-value-face ((,c :inherit message-header-subject))) `(mu4e-system-face ((,c :inherit italic))) + `(mu4e-thread-fold-face ((,c :foreground ,border))) `(mu4e-title-face (( ))) `(mu4e-trashed-face ((,c :foreground ,err))) `(mu4e-unread-face ((,c :inherit bold))) @@ -3233,7 +3120,7 @@ FG and BG are the main colors." `(notmuch-message-summary-face ((,c :inherit bold :background ,bg-inactive))) `(notmuch-search-count ((,c :foreground ,fg-dim))) `(notmuch-search-date ((,c :foreground ,date-common))) - `(notmuch-search-flagged-face ((,c :foreground ,err))) + `(notmuch-search-flagged-face ((,c :foreground ,keyword))) `(notmuch-search-matching-authors ((,c :foreground ,mail-recipient))) `(notmuch-search-non-matching-authors ((,c :inherit shadow))) `(notmuch-search-subject ((,c :foreground ,fg-main))) @@ -3241,7 +3128,7 @@ FG and BG are the main colors." `(notmuch-tag-added ((,c :underline ,info))) `(notmuch-tag-deleted ((,c :strike-through ,err))) `(notmuch-tag-face ((,c :foreground ,accent-0))) - `(notmuch-tag-flagged ((,c :foreground ,err))) + `(notmuch-tag-flagged ((,c :foreground ,keyword))) `(notmuch-tag-unread ((,c :foreground ,accent-1))) `(notmuch-tree-match-author-face ((,c :inherit notmuch-search-matching-authors))) `(notmuch-tree-match-date-face ((,c :inherit notmuch-search-date))) @@ -3280,7 +3167,7 @@ FG and BG are the main colors." `(nxml-ref ((,c :inherit (shadow modus-themes-bold)))) `(rng-error ((,c :inherit error))) ;;;;; olivetti - `(olivetti-fringe ((,c :background ,bg-main))) + `(olivetti-fringe ((,c :background ,fringe))) ;;;;; orderless `(orderless-match-face-0 ((,c :inherit modus-themes-completion-match-0))) `(orderless-match-face-1 ((,c :inherit modus-themes-completion-match-1))) @@ -3290,7 +3177,7 @@ FG and BG are the main colors." `(org-agenda-calendar-daterange ((,c :foreground ,date-range))) `(org-agenda-calendar-event ((,c :foreground ,date-event))) `(org-agenda-calendar-sexp ((,c :inherit (modus-themes-slant org-agenda-calendar-event)))) - `(org-agenda-clocking ((,c :inherit modus-themes-mark-alt))) + `(org-agenda-clocking ((,c :inherit bold :background ,bg-active-argument :foreground ,fg-active-argument))) `(org-agenda-column-dateline ((,c :background ,bg-inactive))) `(org-agenda-current-time ((,c :foreground ,date-now))) `(org-agenda-date ((,c ,@(modus-themes--heading 'agenda-date date-weekday)))) @@ -3309,10 +3196,10 @@ FG and BG are the main colors." `(org-agenda-structure-filter ((,c :inherit org-agenda-structure :foreground ,warning))) `(org-agenda-structure-secondary ((,c :inherit font-lock-doc-face))) `(org-archived ((,c :background ,bg-inactive :foreground ,fg-main))) - `(org-block ((,c ,@(modus-themes--org-block fg-main bg-dim)))) - `(org-block-begin-line ((,c ,@(modus-themes--org-block prose-block bg-inactive)))) + `(org-block ((,c :inherit modus-themes-fixed-pitch :background ,bg-prose-block-contents :extend t))) + `(org-block-begin-line ((,c :inherit modus-themes-fixed-pitch :background ,bg-prose-block-delimiter :foreground ,fg-prose-block-delimiter :extend t))) `(org-block-end-line ((,c :inherit org-block-begin-line))) - `(org-checkbox ((,c :foreground ,warning))) + `(org-checkbox ((,c :inherit modus-themes-fixed-pitch :foreground ,warning))) `(org-checkbox-statistics-done ((,c :inherit org-done))) `(org-checkbox-statistics-todo ((,c :inherit org-todo))) `(org-clock-overlay ((,c :inherit secondary-selection))) @@ -3321,6 +3208,11 @@ FG and BG are the main colors." `(org-column-title ((,c :inherit (bold default) :underline t :background ,bg-dim))) `(org-date ((,c :inherit modus-themes-fixed-pitch :foreground ,date-common))) `(org-date-selected ((,c :foreground ,date-common :inverse-video t))) + ;; NOTE 2024-03-17: Normally we do not want to add this padding + ;; with the :box, but I do it here because the keys are otherwise + ;; very hard to read. The square brackets around them are not + ;; colored, which is what is causing the problem. + `(org-dispatcher-highlight ((,c :inherit modus-themes-bold :box (:line-width 2 :color ,bg-hover-secondary) :background ,bg-hover-secondary :foreground ,fg-main))) `(org-document-info ((,c :foreground ,prose-metadata-value))) `(org-document-info-keyword ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-metadata))) `(org-document-title ((,c :inherit modus-themes-heading-0))) @@ -3328,7 +3220,7 @@ FG and BG are the main colors." `(org-drawer ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-metadata))) `(org-ellipsis (( ))) ; inherits from the heading's color `(org-footnote ((,c :inherit link))) - `(org-formula ((,c :inherit modus-themes-fixed-pitch :foreground ,fnname))) + `(org-formula ((,c :inherit modus-themes-fixed-pitch :foreground ,prose-table-formula))) `(org-headline-done ((,c :inherit org-done))) `(org-headline-todo ((,c :inherit org-todo))) `(org-hide ((,c :foreground ,bg-main))) @@ -3370,13 +3262,13 @@ FG and BG are the main colors." `(org-verse ((,c :inherit org-block))) `(org-warning ((,c :inherit warning))) ;;;;; org-habit - `(org-habit-alert-face ((,c :background ,bg-graph-yellow-0 :foreground "black"))) ; fg is special case + `(org-habit-alert-face ((,c :background ,bg-graph-yellow-0 :foreground "#000000"))) ; fg is special case `(org-habit-alert-future-face ((,c :background ,bg-graph-yellow-1))) - `(org-habit-clear-face ((,c :background ,bg-graph-blue-0 :foreground "black"))) ; fg is special case + `(org-habit-clear-face ((,c :background ,bg-graph-blue-0 :foreground "#000000"))) ; fg is special case `(org-habit-clear-future-face ((,c :background ,bg-graph-blue-1))) `(org-habit-overdue-face ((,c :background ,bg-graph-red-0))) `(org-habit-overdue-future-face ((,c :background ,bg-graph-red-1))) - `(org-habit-ready-face ((,c :background ,bg-graph-green-0 :foreground "black"))) ; fg is special case + `(org-habit-ready-face ((,c :background ,bg-graph-green-0 :foreground "#000000"))) ; fg is special case `(org-habit-ready-future-face ((,c :background ,bg-graph-green-1))) ;;;;; org-journal `(org-journal-calendar-entry-face ((,c :inherit modus-themes-slant :foreground ,date-common))) @@ -3551,10 +3443,10 @@ FG and BG are the main colors." `(recursion-indicator-general ((,c :foreground ,modeline-err))) `(recursion-indicator-minibuffer ((,c :foreground ,modeline-info))) ;;;;; regexp-builder (re-builder) - `(reb-match-0 ((,c :inherit modus-themes-intense-cyan))) - `(reb-match-1 ((,c :inherit modus-themes-subtle-magenta))) - `(reb-match-2 ((,c :inherit modus-themes-subtle-green))) - `(reb-match-3 ((,c :inherit modus-themes-intense-yellow))) + `(reb-match-0 ((,c :inherit modus-themes-search-rx-group-0))) + `(reb-match-1 ((,c :inherit modus-themes-search-rx-group-1))) + `(reb-match-2 ((,c :inherit modus-themes-search-rx-group-2))) + `(reb-match-3 ((,c :inherit modus-themes-search-rx-group-3))) `(reb-regexp-grouping-backslash ((,c :inherit font-lock-regexp-grouping-backslash))) `(reb-regexp-grouping-construct ((,c :inherit font-lock-regexp-grouping-construct))) ;;;;; rg (rg.el) @@ -3609,7 +3501,7 @@ FG and BG are the main colors." `(shortdoc-heading ((,c :inherit bold))) `(shortdoc-section (())) ; remove the default's variable-pitch style ;;;;; show-paren-mode - `(show-paren-match ((,c :background ,bg-paren-match :foreground ,fg-main :underline ,underline-paren-match))) + `(show-paren-match ((,c :background ,bg-paren-match :foreground ,fg-paren-match :underline ,underline-paren-match))) `(show-paren-match-expression ((,c :background ,bg-paren-expression))) `(show-paren-mismatch ((,c :inherit modus-themes-prominent-error))) ;;;;; shr @@ -3621,6 +3513,7 @@ FG and BG are the main colors." `(shr-h4 ((,c :inherit modus-themes-heading-4))) `(shr-h5 ((,c :inherit modus-themes-heading-5))) `(shr-h6 ((,c :inherit modus-themes-heading-6))) + `(shr-mark ((,c :inherit match))) `(shr-selected-link ((,c :inherit modus-themes-mark-sel))) ;;;;; side-notes `(side-notes ((,c :background ,bg-dim :foreground ,fg-dim))) @@ -3803,14 +3696,25 @@ FG and BG are the main colors." `(transient-amaranth ((,c :inherit bold :foreground ,yellow-warmer))) ;; Placate the compiler for what is a spurious warning. We also ;; have to do this with `eldoc-highlight-function-argument'. - (list 'transient-argument `((,c :inherit (bold modus-themes-mark-alt)))) + (list 'transient-argument `((,c :inherit bold :background ,bg-active-argument :foreground ,fg-active-argument))) `(transient-blue ((,c :inherit bold :foreground ,blue))) `(transient-disabled-suffix ((,c :inherit modus-themes-mark-del))) `(transient-enabled-suffix ((,c :inherit modus-themes-subtle-cyan))) `(transient-heading ((,c :inherit bold :foreground ,fg-main))) `(transient-inactive-argument ((,c :inherit shadow))) `(transient-inactive-value ((,c :inherit shadow))) + ;; NOTE 2023-12-09 10:30:09 +0200: The new user option + ;; `transient-semantic-coloring' is enabled by default. This is + ;; not good for us, because we are making it harder for users who + ;; need accessible colors to use the transient interfaces. I + ;; could set that user option to nil, but I think it is less + ;; intrusive to enforce uniformity among the relevant faces. + ;; Those who want semantic coloring can modify these faces. `(transient-key ((,c :inherit modus-themes-key-binding))) + `(transient-key-exit ((,c :inherit modus-themes-key-binding))) + `(transient-key-noop ((,c :inherit (shadow modus-themes-key-binding)))) + `(transient-key-return ((,c :inherit modus-themes-key-binding))) + `(transient-key-stay ((,c :inherit modus-themes-key-binding))) `(transient-mismatched-key ((,c :underline t))) `(transient-nonstandard-key ((,c :underline t))) `(transient-pink ((,c :inherit bold :foreground ,magenta))) @@ -3819,7 +3723,7 @@ FG and BG are the main colors." `(transient-teal ((,c :inherit bold :foreground ,cyan-cooler))) `(transient-unreachable ((,c :inherit shadow))) `(transient-unreachable-key ((,c :inherit shadow))) - `(transient-value ((,c :inherit (bold modus-themes-mark-sel)))) + `(transient-value ((,c :inherit bold :background ,bg-active-value :foreground ,fg-active-value))) ;;;;; trashed `(trashed-deleted ((,c :inherit modus-themes-mark-del))) `(trashed-directory ((,c :foreground ,accent-0))) @@ -3918,11 +3822,11 @@ FG and BG are the main colors." `(visible-mark-forward-face1 ((,c :background ,bg-magenta-intense))) `(visible-mark-forward-face2 ((,c :background ,bg-green-intense))) ;;;;; visual-regexp - `(vr/group-0 ((,c :inherit modus-themes-intense-blue))) - `(vr/group-1 ((,c :inherit modus-themes-intense-magenta))) - `(vr/group-2 ((,c :inherit modus-themes-intense-green))) - `(vr/match-0 ((,c :inherit modus-themes-intense-yellow))) - `(vr/match-1 ((,c :inherit modus-themes-intense-yellow))) + `(vr/group-0 ((,c :inherit modus-themes-search-rx-group-0))) + `(vr/group-1 ((,c :inherit modus-themes-search-rx-group-1))) + `(vr/group-2 ((,c :inherit modus-themes-search-rx-group-2))) + `(vr/match-0 ((,c :inherit modus-themes-search-current))) + `(vr/match-1 ((,c :inherit modus-themes-search-lazy))) `(vr/match-separator-face ((,c :inherit bold :background ,bg-active))) ;;;;; vterm ;; NOTE 2023-08-10: `vterm-color-black' and `vterm-color-white' @@ -4025,7 +3929,7 @@ FG and BG are the main colors." `(which-func ((,c :inherit bold :foreground ,modeline-info))) ; same as `breadcrumb-imenu-leaf-face' ;;;;; which-key `(which-key-command-description-face ((,c :foreground ,fg-main))) - `(which-key-group-description-face ((,c :foreground ,keyword))) + `(which-key-group-description-face ((,c :foreground ,type))) `(which-key-highlighted-command-face ((,c :foreground ,warning :underline t))) `(which-key-key-face ((,c :inherit modus-themes-key-binding))) `(which-key-local-map-description-face ((,c :foreground ,fg-main))) @@ -4034,14 +3938,14 @@ FG and BG are the main colors." `(which-key-special-key-face ((,c :inherit error))) ;;;;; whitespace-mode `(whitespace-big-indent ((,c :background ,bg-space-err))) - `(whitespace-empty ((,c :inherit modus-themes-intense-magenta))) + `(whitespace-empty ((,c :background ,bg-space))) `(whitespace-hspace ((,c :background ,bg-space :foreground ,fg-space))) `(whitespace-indentation ((,c :background ,bg-space :foreground ,fg-space))) `(whitespace-line ((,c :background ,bg-space :foreground ,warning))) `(whitespace-newline ((,c :background ,bg-space :foreground ,fg-space))) `(whitespace-space ((,c :background ,bg-space :foreground ,fg-space))) - `(whitespace-space-after-tab ((,c :inherit modus-themes-subtle-magenta))) - `(whitespace-space-before-tab ((,c :inherit modus-themes-subtle-cyan))) + `(whitespace-space-after-tab ((,c :inherit warning :background ,bg-space))) + `(whitespace-space-before-tab ((,c :inherit warning :background ,bg-space))) `(whitespace-tab ((,c :background ,bg-space :foreground ,fg-space))) `(whitespace-trailing ((,c :background ,bg-space-err))) ;;;;; window-divider-mode @@ -4072,14 +3976,27 @@ FG and BG are the main colors." ;;;;; yaml-mode `(yaml-tab-face ((,c :background ,bg-space-err))) ;;;;; yasnippet - `(yas-field-highlight-face ((,c :inherit highlight)))) + `(yas-field-highlight-face ((,c :inherit highlight))) +;;;;; ztree + `(ztreep-arrow-face ((,c :inherit shadow))) + `(ztreep-diff-header-face ((,c :inherit modus-themes-heading-0))) + `(ztreep-diff-header-small-face ((,c :inherit font-lock-doc-face))) + `(ztreep-diff-model-add-face ((,c :foreground ,info))) + `(ztreep-diff-model-diff-face ((,c :foreground ,err))) + `(ztreep-diff-model-ignored-face ((,c :foreground ,fg-dim :strike-through t))) + `(ztreep-diff-model-normal-face (( ))) + `(ztreep-expand-sign-face ((,c :inherit shadow))) + `(ztreep-header-face ((,c :inherit modus-themes-heading-0))) + `(ztreep-leaf-face (( ))) + `(ztreep-node-count-children-face ((,c :inherit (shadow italic)))) + `(ztreep-node-face ((,c :foreground ,accent-0)))) "Face specs for use with `modus-themes-theme'.") (defconst modus-themes-custom-variables '( ;;;; ansi-colors `(ansi-color-faces-vector [default bold shadow italic underline success warning error]) - `(ansi-color-names-vector ["gray35" ,red ,green ,yellow ,blue ,magenta ,cyan "gray65"]) + `(ansi-color-names-vector ["#595959" ,red ,green ,yellow ,blue ,magenta ,cyan "#a6a6a6"]) ;;;; chart `(chart-face-color-list '( ,bg-graph-red-0 ,bg-graph-green-0 ,bg-graph-yellow-0 ,bg-graph-blue-0 ,bg-graph-magenta-0 ,bg-graph-cyan-0 @@ -4152,29 +4069,35 @@ FG and BG are the main colors." modus-themes-fg-yellow-intense modus-themes-fg-magenta-intense modus-themes-fg-cyan-intense)) -;;;; org-src-block-faces - (if (or (eq modus-themes-org-blocks 'tinted-background) - (eq modus-themes-org-blocks 'rainbow)) - `(org-src-block-faces - `(("emacs-lisp" modus-themes-nuanced-magenta) - ("elisp" modus-themes-nuanced-magenta) - ("clojure" modus-themes-nuanced-magenta) - ("clojurescript" modus-themes-nuanced-magenta) - ("c" modus-themes-nuanced-blue) - ("c++" modus-themes-nuanced-blue) - ("sh" modus-themes-nuanced-green) - ("shell" modus-themes-nuanced-green) - ("html" modus-themes-nuanced-yellow) - ("xml" modus-themes-nuanced-yellow) - ("css" modus-themes-nuanced-red) - ("scss" modus-themes-nuanced-red) - ("python" modus-themes-nuanced-green) - ("ipython" modus-themes-nuanced-magenta) - ("r" modus-themes-nuanced-cyan) - ("yaml" modus-themes-nuanced-cyan) - ("conf" modus-themes-nuanced-cyan) - ("docker" modus-themes-nuanced-cyan))) - `(org-src-block-faces '()))) +;;;; rustic-ansi-faces + `(rustic-ansi-faces + [,fg-term-black + ,fg-term-red + ,fg-term-green + ,fg-term-yellow + ,fg-term-blue + ,fg-term-magenta + ,fg-term-cyan + ,fg-term-white]) +;;;; xterm-color + `(xterm-color-names + [,fg-term-black + ,fg-term-red + ,fg-term-green + ,fg-term-yellow + ,fg-term-blue + ,fg-term-magenta + ,fg-term-cyan + ,fg-term-white]) + `(xterm-color-names-bright + [,fg-term-black-bright + ,fg-term-red-bright + ,fg-term-green-bright + ,fg-term-yellow-bright + ,fg-term-blue-bright + ,fg-term-magenta-bright + ,fg-term-cyan-bright + ,fg-term-white-bright])) "Custom variables for `modus-themes-theme'.") ;;; Theme macros diff --git a/etc/themes/modus-vivendi-deuteranopia-theme.el b/etc/themes/modus-vivendi-deuteranopia-theme.el index 62715e20e51..d721dba09a9 100644 --- a/etc/themes/modus-vivendi-deuteranopia-theme.el +++ b/etc/themes/modus-vivendi-deuteranopia-theme.el @@ -1,11 +1,11 @@ ;;; modus-vivendi-deuteranopia-theme.el --- Deuteranopia-optimized theme with a black background -*- lexical-binding:t -*- -;; Copyright (C) 2019-2024 Free Software Foundation, Inc. +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> -;; URL: https://git.sr.ht/~protesilaos/modus-themes -;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes +;; Maintainer: Protesilaos Stavrou +;; URL: https://github.com/protesilaos/modus-themes +;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. @@ -127,12 +127,12 @@ standard)." (bg-magenta-subtle "#552f5f") (bg-cyan-subtle "#004065") - (bg-red-nuanced "#2c0614") - (bg-green-nuanced "#001904") - (bg-yellow-nuanced "#221000") - (bg-blue-nuanced "#0f0e39") - (bg-magenta-nuanced "#230631") - (bg-cyan-nuanced "#041529") + (bg-red-nuanced "#3a0c14") + (bg-green-nuanced "#092f1f") + (bg-yellow-nuanced "#381d0f") + (bg-blue-nuanced "#12154a") + (bg-magenta-nuanced "#2f0c3f") + (bg-cyan-nuanced "#042837") ;;; Uncommon accent backgrounds @@ -211,6 +211,7 @@ standard)." ;;; Paren match (bg-paren-match "#2f7f9f") + (fg-paren-match fg-main) (bg-paren-expression "#453040") (underline-paren-match unspecified) @@ -240,6 +241,11 @@ standard)." (bg-prominent-note bg-cyan-intense) (fg-prominent-note fg-main) + (bg-active-argument bg-yellow-nuanced) + (fg-active-argument yellow-warmer) + (bg-active-value bg-blue-nuanced) + (fg-active-value blue-warmer) + ;;;; Code mappings (builtin magenta-warmer) @@ -288,7 +294,7 @@ standard)." (date-event fg-alt) (date-holiday yellow-warmer) (date-holiday-other blue) - (date-now blue-faint) + (date-now fg-main) (date-range fg-alt) (date-scheduled yellow-cooler) (date-weekday cyan) @@ -342,16 +348,29 @@ standard)." ;;;; Prose mappings - (prose-block fg-dim) - (prose-code cyan-cooler) + (bg-prose-block-delimiter bg-dim) + (fg-prose-block-delimiter fg-dim) + (bg-prose-block-contents bg-dim) + + (bg-prose-code unspecified) + (fg-prose-code cyan-cooler) + + (bg-prose-macro unspecified) + (fg-prose-macro magenta-cooler) + + (bg-prose-verbatim unspecified) + (fg-prose-verbatim magenta-warmer) + (prose-done blue) - (prose-macro magenta-cooler) + (prose-todo yellow-warmer) + (prose-metadata fg-dim) (prose-metadata-value fg-alt) + (prose-table fg-alt) + (prose-table-formula yellow-warmer) + (prose-tag magenta-faint) - (prose-todo yellow-warmer) - (prose-verbatim magenta-warmer) ;;;; Rainbow mappings @@ -365,6 +384,17 @@ standard)." (rainbow-7 blue-faint) (rainbow-8 magenta-faint) +;;;; Search mappings + + (bg-search-current bg-yellow-intense) + (bg-search-lazy bg-blue-intense) + (bg-search-replace bg-magenta-intense) + + (bg-search-rx-group-0 bg-cyan-intense) + (bg-search-rx-group-1 bg-magenta-intense) + (bg-search-rx-group-2 bg-blue-subtle) + (bg-search-rx-group-3 bg-yellow-subtle) + ;;;; Space mappings (bg-space unspecified) @@ -373,10 +403,10 @@ standard)." ;;;; Terminal mappings - (bg-term-black "black") - (fg-term-black "black") - (bg-term-black-bright "gray35") - (fg-term-black-bright "gray35") + (bg-term-black "#000000") + (fg-term-black "#000000") + (bg-term-black-bright "#595959") + (fg-term-black-bright "#595959") (bg-term-red red) (fg-term-red red) @@ -408,10 +438,10 @@ standard)." (bg-term-cyan-bright cyan-cooler) (fg-term-cyan-bright cyan-cooler) - (bg-term-white "gray65") - (fg-term-white "gray65") - (bg-term-white-bright "white") - (fg-term-white-bright "white") + (bg-term-white "#a6a6a6") + (fg-term-white "#a6a6a6") + (bg-term-white-bright "#ffffff") + (fg-term-white-bright "#ffffff") ;;;; Heading mappings diff --git a/etc/themes/modus-vivendi-theme.el b/etc/themes/modus-vivendi-theme.el index 238484206bb..8b822974c15 100644 --- a/etc/themes/modus-vivendi-theme.el +++ b/etc/themes/modus-vivendi-theme.el @@ -1,11 +1,11 @@ ;;; modus-vivendi-theme.el --- Elegant, highly legible theme with a black background -*- lexical-binding:t -*- -;; Copyright (C) 2019-2024 Free Software Foundation, Inc. +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> -;; URL: https://git.sr.ht/~protesilaos/modus-themes -;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes +;; Maintainer: Protesilaos Stavrou +;; URL: https://github.com/protesilaos/modus-themes +;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. @@ -125,12 +125,12 @@ which corresponds to a minimum contrast in relative luminance of (bg-magenta-subtle "#552f5f") (bg-cyan-subtle "#004065") - (bg-red-nuanced "#2c0614") - (bg-green-nuanced "#001904") - (bg-yellow-nuanced "#221000") - (bg-blue-nuanced "#0f0e39") - (bg-magenta-nuanced "#230631") - (bg-cyan-nuanced "#041529") + (bg-red-nuanced "#3a0c14") + (bg-green-nuanced "#092f1f") + (bg-yellow-nuanced "#381d0f") + (bg-blue-nuanced "#12154a") + (bg-magenta-nuanced "#2f0c3f") + (bg-cyan-nuanced "#042837") ;;; Uncommon accent backgrounds @@ -209,6 +209,7 @@ which corresponds to a minimum contrast in relative luminance of ;;; Paren match (bg-paren-match "#2f7f9f") + (fg-paren-match fg-main) (bg-paren-expression "#453040") (underline-paren-match unspecified) @@ -238,6 +239,11 @@ which corresponds to a minimum contrast in relative luminance of (bg-prominent-note bg-cyan-intense) (fg-prominent-note fg-main) + (bg-active-argument bg-yellow-nuanced) + (fg-active-argument yellow-cooler) + (bg-active-value bg-cyan-nuanced) + (fg-active-value cyan-cooler) + ;;;; Code mappings (builtin magenta-warmer) @@ -340,16 +346,29 @@ which corresponds to a minimum contrast in relative luminance of ;;;; Prose mappings - (prose-block fg-dim) - (prose-code cyan-cooler) + (bg-prose-block-delimiter bg-dim) + (fg-prose-block-delimiter fg-dim) + (bg-prose-block-contents bg-dim) + + (bg-prose-code unspecified) + (fg-prose-code cyan-cooler) + + (bg-prose-macro unspecified) + (fg-prose-macro magenta-cooler) + + (bg-prose-verbatim unspecified) + (fg-prose-verbatim magenta-warmer) + (prose-done green) - (prose-macro magenta-cooler) + (prose-todo red) + (prose-metadata fg-dim) (prose-metadata-value fg-alt) + (prose-table fg-alt) + (prose-table-formula magenta-warmer) + (prose-tag magenta-faint) - (prose-todo red) - (prose-verbatim magenta-warmer) ;;;; Rainbow mappings @@ -363,6 +382,17 @@ which corresponds to a minimum contrast in relative luminance of (rainbow-7 blue-warmer) (rainbow-8 magenta-warmer) +;;;; Search mappings + + (bg-search-current bg-yellow-intense) + (bg-search-lazy bg-cyan-intense) + (bg-search-replace bg-red-intense) + + (bg-search-rx-group-0 bg-blue-intense) + (bg-search-rx-group-1 bg-green-intense) + (bg-search-rx-group-2 bg-red-subtle) + (bg-search-rx-group-3 bg-magenta-subtle) + ;;;; Space mappings (bg-space unspecified) @@ -371,10 +401,10 @@ which corresponds to a minimum contrast in relative luminance of ;;;; Terminal mappings - (bg-term-black "black") - (fg-term-black "black") - (bg-term-black-bright "gray35") - (fg-term-black-bright "gray35") + (bg-term-black "#000000") + (fg-term-black "#000000") + (bg-term-black-bright "#595959") + (fg-term-black-bright "#595959") (bg-term-red red) (fg-term-red red) @@ -406,10 +436,10 @@ which corresponds to a minimum contrast in relative luminance of (bg-term-cyan-bright cyan-cooler) (fg-term-cyan-bright cyan-cooler) - (bg-term-white "gray65") - (fg-term-white "gray65") - (bg-term-white-bright "white") - (fg-term-white-bright "white") + (bg-term-white "#a6a6a6") + (fg-term-white "#a6a6a6") + (bg-term-white-bright "#ffffff") + (fg-term-white-bright "#ffffff") ;;;; Heading mappings @@ -451,7 +481,6 @@ Semantic color mappings have the form (MAPPING-NAME COLOR-NAME) with both as symbols. The latter is a named color that already exists in the palette and is associated with a HEX-VALUE.") - (defcustom modus-vivendi-palette-overrides nil "Overrides for `modus-vivendi-palette'. diff --git a/etc/themes/modus-vivendi-tinted-theme.el b/etc/themes/modus-vivendi-tinted-theme.el index 025257ef01c..5aa44304ee9 100644 --- a/etc/themes/modus-vivendi-tinted-theme.el +++ b/etc/themes/modus-vivendi-tinted-theme.el @@ -1,11 +1,11 @@ ;;; modus-vivendi-tinted-theme.el --- Elegant, highly legible theme with a night sky background -*- lexical-binding:t -*- -;; Copyright (C) 2019-2024 Free Software Foundation, Inc. +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> -;; URL: https://git.sr.ht/~protesilaos/modus-themes -;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes +;; Maintainer: Protesilaos Stavrou +;; URL: https://github.com/protesilaos/modus-themes +;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. @@ -125,12 +125,18 @@ which corresponds to a minimum contrast in relative luminance of (bg-magenta-subtle "#552f5f") (bg-cyan-subtle "#004065") - (bg-red-nuanced "#350f14") - (bg-green-nuanced "#002718") - (bg-yellow-nuanced "#2c1f00") - (bg-blue-nuanced "#131c4d") - (bg-magenta-nuanced "#2f133f") - (bg-cyan-nuanced "#04253f") + (bg-red-nuanced "#3a0c14") + (bg-green-nuanced "#092f1f") + (bg-yellow-nuanced "#381d0f") + (bg-blue-nuanced "#12154a") + (bg-magenta-nuanced "#2f0c3f") + (bg-cyan-nuanced "#042837") + +;;; Uncommon accent backgrounds + + (bg-ochre "#442c2f") + (bg-lavender "#38325c") + (bg-sage "#0f3d30") ;;; Graphs @@ -200,15 +206,10 @@ which corresponds to a minimum contrast in relative luminance of (bg-diff-context "#1a1f30") -;;; Uncommon accent backgrounds - - (bg-ochre "#442c2f") - (bg-lavender "#38325c") - (bg-sage "#0f3d30") - ;;; Paren match - (bg-paren-match "#2f7f9f") + (bg-paren-match "#5f789f") + (fg-paren-match fg-main) (bg-paren-expression "#453040") (underline-paren-match unspecified) @@ -217,9 +218,9 @@ which corresponds to a minimum contrast in relative luminance of ;;;; General mappings (fringe bg-dim) - (cursor magenta-warmer) + (cursor magenta-intense) - (keybind blue-cooler) + (keybind magenta-cooler) (name magenta) (identifier yellow-faint) @@ -238,6 +239,11 @@ which corresponds to a minimum contrast in relative luminance of (bg-prominent-note bg-cyan-intense) (fg-prominent-note fg-main) + (bg-active-argument bg-yellow-nuanced) + (fg-active-argument yellow-cooler) + (bg-active-value bg-cyan-nuanced) + (fg-active-value cyan-cooler) + ;;;; Code mappings (builtin magenta-warmer) @@ -337,20 +343,32 @@ which corresponds to a minimum contrast in relative luminance of (fg-prompt cyan-cooler) (bg-prompt unspecified) - (bg-space-err bg-red-intense) ;;;; Prose mappings - (prose-block fg-dim) - (prose-code cyan-cooler) + (bg-prose-block-delimiter bg-dim) + (fg-prose-block-delimiter fg-dim) + (bg-prose-block-contents bg-dim) + + (bg-prose-code unspecified) + (fg-prose-code cyan-cooler) + + (bg-prose-macro unspecified) + (fg-prose-macro magenta-cooler) + + (bg-prose-verbatim unspecified) + (fg-prose-verbatim magenta-warmer) + (prose-done green) - (prose-macro magenta-cooler) + (prose-todo red) + (prose-metadata fg-dim) (prose-metadata-value fg-alt) + (prose-table fg-alt) + (prose-table-formula magenta-warmer) + (prose-tag magenta-faint) - (prose-todo red) - (prose-verbatim magenta-warmer) ;;;; Rainbow mappings @@ -364,17 +382,29 @@ which corresponds to a minimum contrast in relative luminance of (rainbow-7 blue-warmer) (rainbow-8 magenta-warmer) +;;;; Search mappings + + (bg-search-current bg-yellow-intense) + (bg-search-lazy bg-cyan-intense) + (bg-search-replace bg-red-intense) + + (bg-search-rx-group-0 bg-blue-intense) + (bg-search-rx-group-1 bg-green-intense) + (bg-search-rx-group-2 bg-red-subtle) + (bg-search-rx-group-3 bg-magenta-subtle) + ;;;; Space mappings (bg-space unspecified) (fg-space border) + (bg-space-err bg-red-intense) ;;;; Terminal mappings - (bg-term-black "black") - (fg-term-black "black") - (bg-term-black-bright "gray35") - (fg-term-black-bright "gray35") + (bg-term-black "#000000") + (fg-term-black "#000000") + (bg-term-black-bright "#595959") + (fg-term-black-bright "#595959") (bg-term-red red) (fg-term-red red) @@ -406,10 +436,10 @@ which corresponds to a minimum contrast in relative luminance of (bg-term-cyan-bright cyan-cooler) (fg-term-cyan-bright cyan-cooler) - (bg-term-white "gray65") - (fg-term-white "gray65") - (bg-term-white-bright "white") - (fg-term-white-bright "white") + (bg-term-white "#a6a6a6") + (fg-term-white "#a6a6a6") + (bg-term-white-bright "#ffffff") + (fg-term-white-bright "#ffffff") ;;;; Heading mappings diff --git a/etc/themes/modus-vivendi-tritanopia-theme.el b/etc/themes/modus-vivendi-tritanopia-theme.el index bfd6d63b844..2327a1e9c97 100644 --- a/etc/themes/modus-vivendi-tritanopia-theme.el +++ b/etc/themes/modus-vivendi-tritanopia-theme.el @@ -1,11 +1,10 @@ ;;; modus-vivendi-tritanopia-theme.el --- Tritanopia-optimized theme with a black background -*- lexical-binding:t -*- -;; Copyright (C) 2019-2024 Free Software Foundation, Inc. +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou -;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> -;; URL: https://git.sr.ht/~protesilaos/modus-themes -;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes +;; Maintainer: Protesilaos Stavrou +;; URL: https://github.com/protesilaos/modus-themes ;; Keywords: faces, theme, accessibility ;; This file is part of GNU Emacs. @@ -128,12 +127,12 @@ standard)." (bg-magenta-subtle "#552f5f") (bg-cyan-subtle "#004065") - (bg-red-nuanced "#2c0614") - (bg-green-nuanced "#001904") - (bg-yellow-nuanced "#221000") - (bg-blue-nuanced "#0f0e39") - (bg-magenta-nuanced "#230631") - (bg-cyan-nuanced "#041529") + (bg-red-nuanced "#3a0c14") + (bg-green-nuanced "#092f1f") + (bg-yellow-nuanced "#381d0f") + (bg-blue-nuanced "#12154a") + (bg-magenta-nuanced "#2f0c3f") + (bg-cyan-nuanced "#042837") ;;; Uncommon accent backgrounds @@ -212,6 +211,7 @@ standard)." ;;; Paren match (bg-paren-match "#2f7f9f") + (fg-paren-match fg-main) (bg-paren-expression "#453040") (underline-paren-match unspecified) @@ -241,6 +241,11 @@ standard)." (bg-prominent-note bg-cyan-intense) (fg-prominent-note fg-main) + (bg-active-argument bg-red-nuanced) + (fg-active-argument red-warmer) + (bg-active-value bg-cyan-nuanced) + (fg-active-value cyan) + ;;;; Code mappings (builtin magenta) @@ -343,16 +348,29 @@ standard)." ;;;; Prose mappings - (prose-block fg-dim) - (prose-code cyan) + (bg-prose-block-delimiter bg-dim) + (fg-prose-block-delimiter fg-dim) + (bg-prose-block-contents bg-dim) + + (bg-prose-code unspecified) + (fg-prose-code cyan) + + (bg-prose-macro unspecified) + (fg-prose-macro red-warmer) + + (bg-prose-verbatim unspecified) + (fg-prose-verbatim magenta-warmer) + (prose-done cyan) - (prose-macro red-warmer) + (prose-todo red) + (prose-metadata fg-dim) (prose-metadata-value fg-alt) + (prose-table fg-alt) - (prose-tag fg-alt) - (prose-todo red) - (prose-verbatim magenta-warmer) + (prose-table-formula red-cooler) + + (prose-tag magenta-faint) ;;;; Rainbow mappings @@ -366,6 +384,17 @@ standard)." (rainbow-7 magenta-faint) (rainbow-8 red-faint) +;;;; Search mappings + + (bg-search-current bg-red-intense) + (bg-search-lazy bg-cyan-intense) + (bg-search-replace bg-magenta-intense) + + (bg-search-rx-group-0 bg-blue-intense) + (bg-search-rx-group-1 bg-magenta-intense) + (bg-search-rx-group-2 bg-cyan-subtle) + (bg-search-rx-group-3 bg-red-subtle) + ;;;; Space mappings (bg-space unspecified) @@ -374,10 +403,10 @@ standard)." ;;;; Terminal mappings - (bg-term-black "black") - (fg-term-black "black") - (bg-term-black-bright "gray35") - (fg-term-black-bright "gray35") + (bg-term-black "#000000") + (fg-term-black "#000000") + (bg-term-black-bright "#595959") + (fg-term-black-bright "#595959") (bg-term-red red) (fg-term-red red) @@ -409,10 +438,10 @@ standard)." (bg-term-cyan-bright cyan-cooler) (fg-term-cyan-bright cyan-cooler) - (bg-term-white "gray65") - (fg-term-white "gray65") - (bg-term-white-bright "white") - (fg-term-white-bright "white") + (bg-term-white "#a6a6a6") + (fg-term-white "#a6a6a6") + (bg-term-white-bright "#ffffff") + (fg-term-white-bright "#ffffff") ;;;; Heading mappings diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 0d54e234659..18b4a8691e9 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -817,31 +817,27 @@ or an empty string if none." cmds)) (defun vc-git-dir-extra-headers (dir) - (let ((str (vc-git--out-str "symbolic-ref" "HEAD")) + (let ((str (with-output-to-string + (with-current-buffer standard-output + (vc-git--out-ok "symbolic-ref" "HEAD")))) (stash-list (vc-git-stash-list)) (default-directory dir) (in-progress (vc-git--cmds-in-progress)) - branch remote-url stash-button stash-string tracking-branch) + branch remote remote-url stash-button stash-string) (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) (progn (setq branch (match-string 2 str)) - (let ((remote (vc-git--out-str - "config" (concat "branch." branch ".remote"))) - (merge (vc-git--out-str - "config" (concat "branch." branch ".merge")))) - (when (string-match "\\([^\n]+\\)" remote) - (setq remote (match-string 1 remote))) - (when (string-match "^\\(refs/heads/\\)?\\(.+\\)$" merge) - (setq tracking-branch (match-string 2 merge))) - (pcase remote - ("." - (setq remote-url "none (tracking local branch)")) - ((pred (not string-empty-p)) - (setq - remote-url (vc-git-repository-url dir remote) - tracking-branch (concat remote "/" tracking-branch)))))) - (setq branch "none (detached HEAD)")) + (setq remote + (with-output-to-string + (with-current-buffer standard-output + (vc-git--out-ok "config" + (concat "branch." branch ".remote"))))) + (when (string-match "\\([^\n]+\\)" remote) + (setq remote (match-string 1 remote))) + (when (> (length remote) 0) + (setq remote-url (vc-git-repository-url dir remote)))) + (setq branch "not (detached HEAD)")) (when stash-list (let* ((len (length stash-list)) (limit @@ -894,11 +890,6 @@ or an empty string if none." (propertize "Branch : " 'face 'vc-dir-header) (propertize branch 'face 'vc-dir-header-value) - (when tracking-branch - (concat - "\n" - (propertize "Tracking : " 'face 'vc-dir-header) - (propertize tracking-branch 'face 'vc-dir-header-value))) (when remote-url (concat "\n" @@ -2235,17 +2226,8 @@ The difference to vc-do-command is that this function always invokes (apply #'process-file vc-git-program nil buffer nil "--no-pager" command args))) (defun vc-git--out-ok (command &rest args) - "Run `git COMMAND ARGS...' and insert standard output in current buffer. -Return whether the process exited with status zero." (zerop (apply #'vc-git--call '(t nil) command args))) -(defun vc-git--out-str (command &rest args) - "Run `git COMMAND ARGS...' and return standard output. -The exit status is ignored." - (with-output-to-string - (with-current-buffer standard-output - (apply #'vc-git--out-ok command args)))) - (defun vc-git--run-command-string (file &rest args) "Run a git command on FILE and return its output as string. FILE can be nil." diff --git a/test/lisp/vc/vc-git-tests.el b/test/lisp/vc/vc-git-tests.el index fd3e8ccd602..c52cd9c5875 100644 --- a/test/lisp/vc/vc-git-tests.el +++ b/test/lisp/vc/vc-git-tests.el @@ -24,8 +24,6 @@ ;;; Code: -(require 'ert-x) -(require 'vc) (require 'vc-git) (ert-deftest vc-git-test-program-version-general () @@ -83,42 +81,4 @@ (should-not (vc-git-annotate-time)) (should-not (vc-git-annotate-time)))) -(defmacro vc-git-test--with-repo (name &rest body) - "Initialize a repository in a temporary directory and evaluate BODY. - -The current directory will be set to the top of that repository; NAME -will be bound to that directory's file name. Once BODY exits, the -directory will be deleted." - (declare (indent 1)) - `(ert-with-temp-directory ,name - (let ((default-directory ,name)) - (vc-create-repo 'Git) - ,@body))) - -(defun vc-git-test--run (&rest args) - "Run git ARGS…, check for non-zero status, and return output." - (with-temp-buffer - (apply 'vc-git-command t 0 nil args) - (buffer-string))) - -(ert-deftest vc-git-test-dir-track-local-branch () - "Test that `vc-dir' works when tracking local branches. Bug#68183." - (skip-unless (executable-find vc-git-program)) - (vc-git-test--with-repo repo - ;; Create an initial commit to get a branch started. - (write-region "hello" nil "README") - (vc-git-test--run "add" "README") - (vc-git-test--run "commit" "-mFirst") - ;; Get current branch name lazily, to remain agnostic of - ;; init.defaultbranch. - (let ((upstream-branch - (string-trim (vc-git-test--run "branch" "--show-current")))) - (vc-git-test--run "checkout" "--track" "-b" "hack" upstream-branch) - (vc-dir default-directory) - (pcase-dolist (`(,header ,value) - `(("Branch" "hack") - ("Tracking" ,upstream-branch))) - (goto-char (point-min)) - (re-search-forward (format "^%s *: %s$" header value)))))) - ;;; vc-git-tests.el ends here -- cgit v1.2.3 From c29b6df2273347946d5b8c88b5dee39d8d6fd202 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 17 Mar 2024 19:57:05 +0200 Subject: * lisp/tab-bar.el (tab-bar-select-restore-windows): New defcustom. (tab-bar-select-restore-windows): New function. (tab-bar-select-tab): Let-bind window-restore-killed-buffer-windows to tab-bar-select-restore-windows (bug#68235). --- etc/NEWS | 7 +++++++ lisp/tab-bar.el | 54 +++++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 60 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index 50f0ee4a1aa..b02712dd21c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -291,6 +291,13 @@ corresponding configuration or state was recorded. ** Tab Bars and Tab Lines +--- +*** New user option 'tab-bar-select-restore-windows'. +It defines what to do with windows whose buffer was killed +since the tab was last selected. By default it displays +a placeholder buffer that provides information about the name +of the killed buffer that was displayed in that window. + --- *** New user option 'tab-bar-tab-name-format-functions'. It can be used to add, remove and reorder functions that change diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 61efa332e0b..fa22500a04e 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1393,6 +1393,55 @@ and the newly selected tab." :group 'tab-bar :version "30.1") +(defcustom tab-bar-select-restore-windows #'tab-bar-select-restore-windows + "Function called when selecting a tab to handle windows whose buffer was killed. +When a tab-bar tab displays a window whose buffer was killed since +this tab was last selected, this function determines what to do with +that window. By default, either a random buffer is displayed instead of +the killed buffer, or the window gets deleted. However, with the help +of `window-restore-killed-buffer-windows' it's possible to handle such +situations better by displaying an information about the killed buffer." + :type '(choice (const :tag "No special handling" nil) + (const :tag "Show placeholder buffers" + tab-bar-select-restore-windows) + (function :tag "Function")) + :group 'tab-bar + :version "30.1") + +(defun tab-bar-select-restore-windows (_frame windows _type) + "Display a placeholder buffer in the window whose buffer was killed. +A button in the window allows to restore the killed buffer, +if it was visiting a file." + (dolist (quad windows) + (when (window-live-p (nth 0 quad)) + (let* ((window (nth 0 quad)) + (old-buffer (nth 1 quad)) + (file (when (bufferp old-buffer) + (buffer-file-name old-buffer))) + (name (or file + (and (bufferp old-buffer) + (fboundp 'buffer-last-name) + (buffer-last-name old-buffer)) + old-buffer)) + (new-buffer (generate-new-buffer + (format "*Old buffer %s*" name)))) + (with-current-buffer new-buffer + (set-auto-mode) + (insert (format-message "This window displayed the %s `%s'.\n" + (if file "file" "buffer") + name)) + (when file + (insert-button + "[Restore]" 'action + (lambda (_button) + (set-window-buffer window (find-file-noselect file)) + (set-window-start window (nth 2 quad) t) + (set-window-point window (nth 3 quad)))) + (insert "\n")) + (goto-char (point-min)) + (setq buffer-read-only t) + (set-window-buffer window new-buffer)))))) + (defvar tab-bar-minibuffer-restore-tab nil "Tab number for `tab-bar-minibuffer-restore-tab'.") @@ -1438,7 +1487,10 @@ Negative TAB-NUMBER counts tabs from the end of the tab bar." (let* ((from-tab (tab-bar--tab)) (to-tab (nth to-index tabs)) (wc (alist-get 'wc to-tab)) - (ws (alist-get 'ws to-tab))) + (ws (alist-get 'ws to-tab)) + (window-restore-killed-buffer-windows + (or tab-bar-select-restore-windows + window-restore-killed-buffer-windows))) ;; During the same session, use window-configuration to switch ;; tabs, because window-configurations are more reliable -- cgit v1.2.3 From 8d4a8b7dfd0905defac172cc58c2252dc1b39ad7 Mon Sep 17 00:00:00 2001 From: Kévin Le Gouguec Date: Mon, 12 Feb 2024 08:29:19 +0100 Subject: ; Re-apply accidentally reverted commit This re-applies: 2024-03-17 "Fix vc-dir when "remote" Git branch is local" (21828f288ef) reverted as part of the unrelated: 2024-03-17 "Update modus-themes to their 4.4.0 version" (67b0c1c09ea) The original commit message follows: Fix vc-dir when "remote" Git branch is local While in there, add that "tracking" branch to the vc-dir buffer. For bug#68183. * lisp/vc/vc-git.el (vc-git-dir-extra-headers): Reduce boilerplate with new function 'vc-git--out-ok'; stop calling vc-git-repository-url when REMOTE is "." to avoid throwing an error; display tracking branch; prefer "none ()" to "not ()" since that reads more grammatically correct. (vc-git--out-ok): Add documentation. (vc-git--out-str): New function to easily get the output from a Git command. * test/lisp/vc/vc-git-tests.el (vc-git-test--with-repo) (vc-git-test--run): New helpers, defined to steer clear of vc-git-- internal functions. (vc-git-test-dir-track-local-branch): Check that vc-dir does not crash. --- lisp/vc/vc-git.el | 46 ++++++++++++++++++++++++++++++-------------- test/lisp/vc/vc-git-tests.el | 40 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 72 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 18b4a8691e9..0d54e234659 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -817,27 +817,31 @@ or an empty string if none." cmds)) (defun vc-git-dir-extra-headers (dir) - (let ((str (with-output-to-string - (with-current-buffer standard-output - (vc-git--out-ok "symbolic-ref" "HEAD")))) + (let ((str (vc-git--out-str "symbolic-ref" "HEAD")) (stash-list (vc-git-stash-list)) (default-directory dir) (in-progress (vc-git--cmds-in-progress)) - branch remote remote-url stash-button stash-string) + branch remote-url stash-button stash-string tracking-branch) (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) (progn (setq branch (match-string 2 str)) - (setq remote - (with-output-to-string - (with-current-buffer standard-output - (vc-git--out-ok "config" - (concat "branch." branch ".remote"))))) - (when (string-match "\\([^\n]+\\)" remote) - (setq remote (match-string 1 remote))) - (when (> (length remote) 0) - (setq remote-url (vc-git-repository-url dir remote)))) - (setq branch "not (detached HEAD)")) + (let ((remote (vc-git--out-str + "config" (concat "branch." branch ".remote"))) + (merge (vc-git--out-str + "config" (concat "branch." branch ".merge")))) + (when (string-match "\\([^\n]+\\)" remote) + (setq remote (match-string 1 remote))) + (when (string-match "^\\(refs/heads/\\)?\\(.+\\)$" merge) + (setq tracking-branch (match-string 2 merge))) + (pcase remote + ("." + (setq remote-url "none (tracking local branch)")) + ((pred (not string-empty-p)) + (setq + remote-url (vc-git-repository-url dir remote) + tracking-branch (concat remote "/" tracking-branch)))))) + (setq branch "none (detached HEAD)")) (when stash-list (let* ((len (length stash-list)) (limit @@ -890,6 +894,11 @@ or an empty string if none." (propertize "Branch : " 'face 'vc-dir-header) (propertize branch 'face 'vc-dir-header-value) + (when tracking-branch + (concat + "\n" + (propertize "Tracking : " 'face 'vc-dir-header) + (propertize tracking-branch 'face 'vc-dir-header-value))) (when remote-url (concat "\n" @@ -2226,8 +2235,17 @@ The difference to vc-do-command is that this function always invokes (apply #'process-file vc-git-program nil buffer nil "--no-pager" command args))) (defun vc-git--out-ok (command &rest args) + "Run `git COMMAND ARGS...' and insert standard output in current buffer. +Return whether the process exited with status zero." (zerop (apply #'vc-git--call '(t nil) command args))) +(defun vc-git--out-str (command &rest args) + "Run `git COMMAND ARGS...' and return standard output. +The exit status is ignored." + (with-output-to-string + (with-current-buffer standard-output + (apply #'vc-git--out-ok command args)))) + (defun vc-git--run-command-string (file &rest args) "Run a git command on FILE and return its output as string. FILE can be nil." diff --git a/test/lisp/vc/vc-git-tests.el b/test/lisp/vc/vc-git-tests.el index c52cd9c5875..fd3e8ccd602 100644 --- a/test/lisp/vc/vc-git-tests.el +++ b/test/lisp/vc/vc-git-tests.el @@ -24,6 +24,8 @@ ;;; Code: +(require 'ert-x) +(require 'vc) (require 'vc-git) (ert-deftest vc-git-test-program-version-general () @@ -81,4 +83,42 @@ (should-not (vc-git-annotate-time)) (should-not (vc-git-annotate-time)))) +(defmacro vc-git-test--with-repo (name &rest body) + "Initialize a repository in a temporary directory and evaluate BODY. + +The current directory will be set to the top of that repository; NAME +will be bound to that directory's file name. Once BODY exits, the +directory will be deleted." + (declare (indent 1)) + `(ert-with-temp-directory ,name + (let ((default-directory ,name)) + (vc-create-repo 'Git) + ,@body))) + +(defun vc-git-test--run (&rest args) + "Run git ARGS…, check for non-zero status, and return output." + (with-temp-buffer + (apply 'vc-git-command t 0 nil args) + (buffer-string))) + +(ert-deftest vc-git-test-dir-track-local-branch () + "Test that `vc-dir' works when tracking local branches. Bug#68183." + (skip-unless (executable-find vc-git-program)) + (vc-git-test--with-repo repo + ;; Create an initial commit to get a branch started. + (write-region "hello" nil "README") + (vc-git-test--run "add" "README") + (vc-git-test--run "commit" "-mFirst") + ;; Get current branch name lazily, to remain agnostic of + ;; init.defaultbranch. + (let ((upstream-branch + (string-trim (vc-git-test--run "branch" "--show-current")))) + (vc-git-test--run "checkout" "--track" "-b" "hack" upstream-branch) + (vc-dir default-directory) + (pcase-dolist (`(,header ,value) + `(("Branch" "hack") + ("Tracking" ,upstream-branch))) + (goto-char (point-min)) + (re-search-forward (format "^%s *: %s$" header value)))))) + ;;; vc-git-tests.el ends here -- cgit v1.2.3 From 706403f2aa3a306369a0150022da0cba1802ca2b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 12 Mar 2024 09:26:24 -0400 Subject: (cl-type-of): New function to return more precise types (bug#69739) * src/data.c (Fcl_type_of): New function, extracted from `Ftype_of`. Make it return more precise types for symbols, integers, and subrs. (Ftype_of): Use it. (syms_of_data): Define the corresponding new symbols and defsubr the new function. * doc/lispref/objects.texi (Type Predicates): Document it. * src/comp.c (emit_limple_insn): Use `Fcl_type_of`. * lisp/emacs-lisp/cl-preloaded.el (subr): Demote it to `atom`. (subr-native-elisp, subr-primitive): Add `compiled-function` as parent instead. (special-form): New type. * lisp/obsolete/eieio-core.el (cl--generic-struct-tag): * lisp/emacs-lisp/cl-generic.el (cl--generic-typeof-generalizer): Use `cl-type-of`. cl--generic--unreachable-types): Update accordingly. test/src/data-tests.el (data-tests--cl-type-of): New test. --- doc/lispref/objects.texi | 21 +++++++++++++++++++++ etc/NEWS | 5 +++++ lisp/emacs-lisp/cl-generic.el | 6 ++---- lisp/emacs-lisp/cl-preloaded.el | 12 ++++++------ lisp/emacs-lisp/eieio-core.el | 2 +- src/comp.c | 2 +- src/data.c | 40 +++++++++++++++++++++++++++++++++++----- test/src/data-tests.el | 37 +++++++++++++++++++++++++++++++++++++ 8 files changed, 108 insertions(+), 17 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 279f449a994..1e448b64296 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -2207,6 +2207,27 @@ slot is returned; @ref{Records}. @end example @end defun +@defun cl-type-of object +This function returns a symbol naming @emph{the} type of +@var{object}. It usually behaves like @code{type-of}, except +that it guarantees to return the most precise type possible, which also +implies that the specific type it returns may change depending on the +Emacs version. For this reason, as a rule you should never compare its +return value against some fixed set of types. + +@example +(cl-type-of 1) + @result{} fixnum +@group +(cl-type-of 'nil) + @result{} null +(cl-type-of (record 'foo)) + @result{} foo +@end group +@end example +@end defun + + @node Equality Predicates @section Equality Predicates @cindex equality diff --git a/etc/NEWS b/etc/NEWS index b02712dd21c..b522fbd338b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1647,6 +1647,11 @@ values. * Lisp Changes in Emacs 30.1 +** New function 'cl-type-of'. +This function is like 'type-of' except that it sometimes returns +a more precise type. For example, for nil and t it returns 'null' +and 'boolean' respectively, instead of just 'symbol'. + ** Built-in types have now corresponding classes. At the Lisp level, this means that things like (cl-find-class 'integer) will now return a class object, and at the UI level it means that diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 613ecf82a92..62abe8d1589 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1334,8 +1334,7 @@ These match if the argument is `eql' to VAL." (defconst cl--generic--unreachable-types ;; FIXME: Try to make that list empty? - '(fixnum bignum boolean keyword - special-form subr-primitive subr-native-elisp) + '(keyword) "Built-in classes on which we cannot dispatch for technical reasons.") (defun cl--generic-type-specializers (tag &rest _) @@ -1345,8 +1344,7 @@ These match if the argument is `eql' to VAL." (cl--class-allparents class))))) (cl-generic-define-generalizer cl--generic-typeof-generalizer - ;; FIXME: We could also change `type-of' to return `null' for nil. - 10 (lambda (name &rest _) `(if ,name (type-of ,name) 'null)) + 10 (lambda (name &rest _) `(cl-type-of ,name)) #'cl--generic-type-specializers) (cl-defmethod cl-generic-generalizers :extra "typeof" (type) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 515aa99549d..3e89afea452 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -339,8 +339,6 @@ ',parents)))))) ;; FIXME: Our type DAG has various quirks: -;; - `subr' says it's a `compiled-function' but that's not true -;; for those subrs that are special forms! ;; - Some `keyword's are also `symbol-with-pos' but that's not reflected ;; in the DAG. ;; - An OClosure can be an interpreted function or a `byte-code-function', @@ -428,15 +426,17 @@ For this build of Emacs it's %dbit." "Abstract type of functions that have been compiled.") (cl--define-built-in-type byte-code-function (compiled-function) "Type of functions that have been byte-compiled.") -(cl--define-built-in-type subr (compiled-function) +(cl--define-built-in-type subr (atom) "Abstract type of functions compiled to machine code.") (cl--define-built-in-type module-function (function) "Type of functions provided via the module API.") (cl--define-built-in-type interpreted-function (function) "Type of functions that have not been compiled.") -(cl--define-built-in-type subr-native-elisp (subr) - "Type of function that have been compiled by the native compiler.") -(cl--define-built-in-type subr-primitive (subr) +(cl--define-built-in-type special-form (subr) + "Type of the core syntactic elements of the Emacs Lisp language.") +(cl--define-built-in-type subr-native-elisp (subr compiled-function) + "Type of functions that have been compiled by the native compiler.") +(cl--define-built-in-type subr-primitive (subr compiled-function) "Type of functions hand written in C.") (unless (cl--class-parents (cl--find-class 'cl-structure-object)) diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index a2f7c4172a3..cf8bd749f2a 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -1046,7 +1046,7 @@ method invocation orders of the involved classes." (defun cl--generic-struct-tag (name &rest _) ;; Use exactly the same code as for `typeof'. - `(if ,name (type-of ,name) 'null)) + `(cl-type-of ,name)) (cl-generic-define-generalizer eieio--generic-generalizer ;; Use the exact same tagcode as for cl-struct, so that methods diff --git a/src/comp.c b/src/comp.c index 3f989c722d4..76cf1f3ab6e 100644 --- a/src/comp.c +++ b/src/comp.c @@ -2442,7 +2442,7 @@ emit_limple_insn (Lisp_Object insn) { Lisp_Object arg1 = arg[1]; - if (EQ (Ftype_of (arg1), Qcomp_mvar)) + if (EQ (Fcl_type_of (arg1), Qcomp_mvar)) res = emit_mvar_rval (arg1); else if (EQ (FIRST (arg1), Qcall)) res = emit_limple_call (XCDR (arg1)); diff --git a/src/data.c b/src/data.c index 35f4c82c68f..5d6b6e0ba9d 100644 --- a/src/data.c +++ b/src/data.c @@ -193,16 +193,37 @@ DEFUN ("null", Fnull, Snull, 1, 1, 0, DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0, doc: /* Return a symbol representing the type of OBJECT. The symbol returned names the object's basic type; -for example, (type-of 1) returns `integer'. */) +for example, (type-of 1) returns `integer'. +Contrary to `cl-type-of', the returned type is not always the most +precise type possible, because instead this function tries to preserve +compatibility with the return value of previous Emacs versions. */) + (Lisp_Object object) +{ + return SYMBOLP (object) ? Qsymbol + : INTEGERP (object) ? Qinteger + : SUBRP (object) ? Qsubr + : Fcl_type_of (object); +} + +DEFUN ("cl-type-of", Fcl_type_of, Scl_type_of, 1, 1, 0, + doc: /* Return a symbol representing the type of OBJECT. +The returned symbol names the most specific possible type of the object. +for example, (cl-type-of nil) returns `null'. +The specific type returned may change depending on Emacs versions, +so we recommend you use `cl-typep', `cl-typecase', or other predicates +rather than compare the return value of this function against +a fixed set of types. */) (Lisp_Object object) { switch (XTYPE (object)) { case_Lisp_Int: - return Qinteger; + return Qfixnum; case Lisp_Symbol: - return Qsymbol; + return NILP (object) ? Qnull + : EQ (object, Qt) ? Qboolean + : Qsymbol; case Lisp_String: return Qstring; @@ -215,7 +236,7 @@ for example, (type-of 1) returns `integer'. */) switch (PSEUDOVECTOR_TYPE (XVECTOR (object))) { case PVEC_NORMAL_VECTOR: return Qvector; - case PVEC_BIGNUM: return Qinteger; + case PVEC_BIGNUM: return Qbignum; case PVEC_MARKER: return Qmarker; case PVEC_SYMBOL_WITH_POS: return Qsymbol_with_pos; case PVEC_OVERLAY: return Qoverlay; @@ -224,7 +245,10 @@ for example, (type-of 1) returns `integer'. */) case PVEC_WINDOW_CONFIGURATION: return Qwindow_configuration; case PVEC_PROCESS: return Qprocess; case PVEC_WINDOW: return Qwindow; - case PVEC_SUBR: return Qsubr; + case PVEC_SUBR: + return XSUBR (object)->max_args == UNEVALLED ? Qspecial_form + : SUBR_NATIVE_COMPILEDP (object) ? Qsubr_native_elisp + : Qsubr_primitive; case PVEC_COMPILED: return Qcompiled_function; case PVEC_BUFFER: return Qbuffer; case PVEC_CHAR_TABLE: return Qchar_table; @@ -4202,7 +4226,9 @@ syms_of_data (void) "Variable binding depth exceeds max-specpdl-size"); /* Types that type-of returns. */ + DEFSYM (Qboolean, "boolean"); DEFSYM (Qinteger, "integer"); + DEFSYM (Qbignum, "bignum"); DEFSYM (Qsymbol, "symbol"); DEFSYM (Qstring, "string"); DEFSYM (Qcons, "cons"); @@ -4218,6 +4244,9 @@ syms_of_data (void) DEFSYM (Qprocess, "process"); DEFSYM (Qwindow, "window"); DEFSYM (Qsubr, "subr"); + DEFSYM (Qspecial_form, "special-form"); + DEFSYM (Qsubr_primitive, "subr-primitive"); + DEFSYM (Qsubr_native_elisp, "subr-native-elisp"); DEFSYM (Qcompiled_function, "compiled-function"); DEFSYM (Qbuffer, "buffer"); DEFSYM (Qframe, "frame"); @@ -4255,6 +4284,7 @@ syms_of_data (void) defsubr (&Seq); defsubr (&Snull); defsubr (&Stype_of); + defsubr (&Scl_type_of); defsubr (&Slistp); defsubr (&Snlistp); defsubr (&Sconsp); diff --git a/test/src/data-tests.el b/test/src/data-tests.el index ad3b2071254..9d76c58224d 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -838,4 +838,41 @@ comparing the subr with a much slower Lisp implementation." (dolist (sym (list nil t 'xyzzy (make-symbol ""))) (should (eq sym (bare-symbol (position-symbol sym 0))))))) +(require 'cl-extra) ;For `cl--class-children'. + +(ert-deftest data-tests--cl-type-of () + ;; Make sure that `cl-type-of' returns the most precise type. + ;; Note: This doesn't work for list/vector structs since those types + ;; are too difficult/unreliable to detect (so `cl-type-of' only says + ;; it's a `cons' or a `vector'). + (dolist (val (list -2 10 (expt 2 128) nil t 'car + (symbol-function 'car) + (symbol-function 'progn) + (position-symbol 'car 7))) + (let* ((type (cl-type-of val)) + (class (cl-find-class type)) + (alltypes (cl--class-allparents class)) + ;; FIXME: Our type DAG is affected by `symbols-with-pos-enabled'. + ;; (e.g. `symbolp' returns nil on a sympos if that var is nil). + (symbols-with-pos-enabled t)) + (dolist (parent alltypes) + (should (cl-typep val parent)) + (dolist (subtype (cl--class-children (cl-find-class parent))) + (unless (memq subtype alltypes) + (unless (memq subtype + ;; FIXME: Some types don't have any associated + ;; predicate, + '( font-spec font-entity font-object + finalizer condvar terminal + native-comp-unit interpreted-function + tree-sitter-compiled-query + tree-sitter-node tree-sitter-parser + ;; `functionp' also matches things of type + ;; `symbol' and `cons'. + ;; FIXME: `subr-primitive-p' also matches + ;; special-forms. + function subr-primitive)) + (should-not (cl-typep val subtype))))))))) + + ;;; data-tests.el ends here -- cgit v1.2.3 From e624bc62752ceb2e60940c5fd9cb6e70611df71c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 17 Mar 2024 17:29:02 -0400 Subject: (primitive-function): New type The type hierarchy and `cl-type-of` code assumed that `subr-primitive` only applies to functions, but since it also accepts special-forms it makes it an unsuitable choice since it can't be a subtype of `compiled-function`. So, use a new type `primitive-function` instead. * lisp/subr.el (subr-primitive-p): Fix docstring (bug#69832). (primitive-function-p): New function. * lisp/emacs-lisp/cl-preloaded.el (primitive-function): Rename from `subr-primitive` since `subr-primitive-p` means something else. * src/data.c (Fcl_type_of): Return `primitive-function` instead of `subr-primitive` for C functions. (syms_of_data): Adjust accordingly. * test/src/data-tests.el (data-tests--cl-type-of): Remove workaround. --- etc/NEWS | 4 ++++ lisp/emacs-lisp/cl-preloaded.el | 2 +- lisp/subr.el | 11 ++++++++++- src/data.c | 4 ++-- test/src/data-tests.el | 4 +--- 5 files changed, 18 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index b522fbd338b..69e61d91b0e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1652,6 +1652,10 @@ This function is like 'type-of' except that it sometimes returns a more precise type. For example, for nil and t it returns 'null' and 'boolean' respectively, instead of just 'symbol'. +** New function `primitive-function-p`. +This is like `subr-primitive-p` except that it returns t only if the +argument is a function rather than a special-form. + ** Built-in types have now corresponding classes. At the Lisp level, this means that things like (cl-find-class 'integer) will now return a class object, and at the UI level it means that diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 3e89afea452..d11c97a3e3a 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -436,7 +436,7 @@ For this build of Emacs it's %dbit." "Type of the core syntactic elements of the Emacs Lisp language.") (cl--define-built-in-type subr-native-elisp (subr compiled-function) "Type of functions that have been compiled by the native compiler.") -(cl--define-built-in-type subr-primitive (subr compiled-function) +(cl--define-built-in-type primitive-function (subr compiled-function) "Type of functions hand written in C.") (unless (cl--class-parents (cl--find-class 'cl-structure-object)) diff --git a/lisp/subr.el b/lisp/subr.el index 38a3f6edb34..3de4412637f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -312,11 +312,20 @@ value of last one, or nil if there are none." cond '(empty-body unless) t))) (defsubst subr-primitive-p (object) - "Return t if OBJECT is a built-in primitive function." + "Return t if OBJECT is a built-in primitive written in C. +Such objects can be functions or special forms." (declare (side-effect-free error-free)) (and (subrp object) (not (subr-native-elisp-p object)))) +(defsubst primitive-function-p (object) + "Return t if OBJECT is a built-in primitive function. +This excludes special forms, since they are not functions." + (declare (side-effect-free error-free)) + (and (subrp object) + (not (or (subr-native-elisp-p object) + (eq (cdr (subr-arity object)) 'unevalled))))) + (defsubst xor (cond1 cond2) "Return the boolean exclusive-or of COND1 and COND2. If only one of the arguments is non-nil, return it; otherwise diff --git a/src/data.c b/src/data.c index 5d6b6e0ba9d..69b990bed76 100644 --- a/src/data.c +++ b/src/data.c @@ -248,7 +248,7 @@ a fixed set of types. */) case PVEC_SUBR: return XSUBR (object)->max_args == UNEVALLED ? Qspecial_form : SUBR_NATIVE_COMPILEDP (object) ? Qsubr_native_elisp - : Qsubr_primitive; + : Qprimitive_function; case PVEC_COMPILED: return Qcompiled_function; case PVEC_BUFFER: return Qbuffer; case PVEC_CHAR_TABLE: return Qchar_table; @@ -4245,7 +4245,7 @@ syms_of_data (void) DEFSYM (Qwindow, "window"); DEFSYM (Qsubr, "subr"); DEFSYM (Qspecial_form, "special-form"); - DEFSYM (Qsubr_primitive, "subr-primitive"); + DEFSYM (Qprimitive_function, "primitive-function"); DEFSYM (Qsubr_native_elisp, "subr-native-elisp"); DEFSYM (Qcompiled_function, "compiled-function"); DEFSYM (Qbuffer, "buffer"); diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 9d76c58224d..daa49e671b5 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -869,9 +869,7 @@ comparing the subr with a much slower Lisp implementation." tree-sitter-node tree-sitter-parser ;; `functionp' also matches things of type ;; `symbol' and `cons'. - ;; FIXME: `subr-primitive-p' also matches - ;; special-forms. - function subr-primitive)) + function)) (should-not (cl-typep val subtype))))))))) -- cgit v1.2.3 From 63e67916b01569da5bb24f6d9a354dc72897c468 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 14 Mar 2024 12:49:08 -0400 Subject: Followup changes to `cl-type-of` These changes came up while working on `cl-type-of` but are not directly related to the new `cl-type-of`. The BASE_PURESIZE bump was needed at some point on one of my machine, not sure why. * src/puresize.h (BASE_PURESIZE): Bump up. * src/sqlite.c (bind_value): Don't use `Ftype_of`. * lisp/emacs-lisp/seq.el (seq-remove-at-position): Simplify. * lisp/emacs-lisp/cl-preloaded.el (finalizer): New (previously missing) type. * doc/lispref/objects.texi (Type Predicates): Minor tweaks. --- doc/lispref/objects.texi | 6 +++--- lisp/emacs-lisp/cl-preloaded.el | 1 + lisp/emacs-lisp/seq.el | 3 +-- src/lisp.h | 6 ++---- src/puresize.h | 2 +- src/sqlite.c | 17 ++++++----------- 6 files changed, 14 insertions(+), 21 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 1e448b64296..aa1e073042f 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -1485,8 +1485,8 @@ types that are not built into Emacs. @subsection Type Descriptors A @dfn{type descriptor} is a @code{record} which holds information -about a type. Slot 1 in the record must be a symbol naming the type, and -@code{type-of} relies on this to return the type of @code{record} +about a type. The first slot in the record must be a symbol naming the type, +and @code{type-of} relies on this to return the type of @code{record} objects. No other type descriptor slot is used by Emacs; they are free for use by Lisp extensions. @@ -2175,7 +2175,7 @@ with references to further information. function @code{type-of}. Recall that each object belongs to one and only one primitive type; @code{type-of} tells you which one (@pxref{Lisp Data Types}). But @code{type-of} knows nothing about non-primitive -types. In most cases, it is more convenient to use type predicates than +types. In most cases, it is preferable to use type predicates than @code{type-of}. @defun type-of object diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index d11c97a3e3a..cba56e0bbd4 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -365,6 +365,7 @@ (cl--define-built-in-type buffer atom) (cl--define-built-in-type window atom) (cl--define-built-in-type process atom) +(cl--define-built-in-type finalizer atom) (cl--define-built-in-type window-configuration atom) (cl--define-built-in-type overlay atom) (cl--define-built-in-type number-or-marker atom diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 20077db9e60..a20cff16982 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -362,8 +362,7 @@ the result. The result is a sequence of the same type as SEQUENCE." (seq-concatenate - (let ((type (type-of sequence))) - (if (eq type 'cons) 'list type)) + (if (listp sequence) 'list (type-of sequence)) (seq-subseq sequence 0 n) (seq-subseq sequence (1+ n)))) diff --git a/src/lisp.h b/src/lisp.h index f353e4956eb..f86758c88fb 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -569,10 +569,8 @@ enum Lisp_Fwd_Type your object -- this way, the same object could be used to represent several disparate C structures. - In addition, you need to add switch branches in data.c for Ftype_of. - - You also need to add the new type to the constant - `cl--typeof-types' in lisp/emacs-lisp/cl-preloaded.el. */ + In addition, you need to add switch branches in data.c for Fcl_type_of + and `cl--define-builtin-type` in lisp/emacs-lisp/cl-preloaded.el. */ /* A Lisp_Object is a tagged pointer or integer. Ordinarily it is a diff --git a/src/puresize.h b/src/puresize.h index ac5d2da30dc..2a716872832 100644 --- a/src/puresize.h +++ b/src/puresize.h @@ -47,7 +47,7 @@ INLINE_HEADER_BEGIN #endif #ifndef BASE_PURESIZE -#define BASE_PURESIZE (2750000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) +#define BASE_PURESIZE (3000000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) #endif /* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */ diff --git a/src/sqlite.c b/src/sqlite.c index 7a018b28aa4..261080da673 100644 --- a/src/sqlite.c +++ b/src/sqlite.c @@ -349,9 +349,7 @@ bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object values) value = XCAR (values); values = XCDR (values); } - Lisp_Object type = Ftype_of (value); - - if (EQ (type, Qstring)) + if (STRINGP (value)) { Lisp_Object encoded; bool blob = false; @@ -385,14 +383,11 @@ bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object values) SSDATA (encoded), SBYTES (encoded), NULL); } - else if (EQ (type, Qinteger)) - { - if (BIGNUMP (value)) - ret = sqlite3_bind_int64 (stmt, i + 1, bignum_to_intmax (value)); - else - ret = sqlite3_bind_int64 (stmt, i + 1, XFIXNUM (value)); - } - else if (EQ (type, Qfloat)) + else if (FIXNUMP (value)) + ret = sqlite3_bind_int64 (stmt, i + 1, XFIXNUM (value)); + else if (BIGNUMP (value)) + ret = sqlite3_bind_int64 (stmt, i + 1, bignum_to_intmax (value)); + else if (FLOATP (value)) ret = sqlite3_bind_double (stmt, i + 1, XFLOAT_DATA (value)); else if (NILP (value)) ret = sqlite3_bind_null (stmt, i + 1); -- cgit v1.2.3 From 70ac815ece299007ff468c09632ef4d488e69be3 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 18 Mar 2024 09:38:23 -0400 Subject: * lisp/emacs-lisp/cl-preloaded.el (user-ptr): Add predicate --- lisp/emacs-lisp/cl-preloaded.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index cba56e0bbd4..f7757eae9c0 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -328,7 +328,9 @@ (:predicate (setq predicate val)) (_ (error "Unknown keyword arg: %S" kw))))) `(progn - ,(if predicate `(put ',name 'cl-deftype-satisfies #',predicate)) + ,(if predicate `(put ',name 'cl-deftype-satisfies #',predicate) + ;; (message "Missing predicate for: %S" name) + nil) (put ',name 'cl--class (built-in-class--make ',name ,docstring (mapcar (lambda (type) @@ -352,7 +354,8 @@ (cl--define-built-in-type tree-sitter-compiled-query atom) (cl--define-built-in-type tree-sitter-node atom) (cl--define-built-in-type tree-sitter-parser atom) -(cl--define-built-in-type user-ptr atom) +(cl--define-built-in-type user-ptr atom + nil :predicate user-ptrp) ;; FIXME: Shouldn't it be called `user-ptr-p'? (cl--define-built-in-type font-object atom) (cl--define-built-in-type font-entity atom) (cl--define-built-in-type font-spec atom) -- cgit v1.2.3 From ce29ae32d0b05cedbc9ba65c1a347ab7c34420ad Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 18 Mar 2024 15:59:54 +0200 Subject: ; * lisp/vc/vc-git.el (vc-git--out-str): Doc fix. --- lisp/emacs-lisp/shortdoc.el | 2 +- lisp/vc/vc-git.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index cbb5618ffce..a1e49b50510 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1781,7 +1781,7 @@ With prefix numeric argument ARG, do it that many times." (interactive) (save-excursion (goto-char (pos-bol)) - (when-let* ((re (rx bol "(" (group (+ (not (in " ")))))) + (when-let* ((re (rx bol "(" (group (+ (not (in " )")))))) (string (and (or (looking-at re) (re-search-backward re nil t)) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 0d54e234659..b23a5ca95a1 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -2240,7 +2240,7 @@ Return whether the process exited with status zero." (zerop (apply #'vc-git--call '(t nil) command args))) (defun vc-git--out-str (command &rest args) - "Run `git COMMAND ARGS...' and return standard output. + "Run `git COMMAND ARGS...' and return standard output as a string. The exit status is ignored." (with-output-to-string (with-current-buffer standard-output -- cgit v1.2.3 From f2e239c6a7d54ec3849a3bb783685953b6683752 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 19 Mar 2024 12:08:17 +0800 Subject: Respect display names of Android content URIs * java/org/gnu/emacs/EmacsNative.java (displayNameHash): New function. * java/org/gnu/emacs/EmacsService.java (buildContentName): New argument RESOLVER. Generate names holding URI's display name if available. All callers changed. * lisp/international/mule-cmds.el (set-default-coding-systems): Fix file name coding system as utf-8-unix on Android as on Mac OS. * src/androidvfs.c (enum android_vnode_type): New enum ANDROID_VNODE_CONTENT_AUTHORITY_NAMED. (android_content_name): Register root directories for this new type. (displayNameHash): New function. (android_get_content_name): New argument WITH_CHECKSUM. If present, treat the final two components as a pair of checksum and display name, and verify and exclude the two. (android_authority_name): Provide new argument as appropriate. (android_authority_initial_name): New function. --- java/org/gnu/emacs/EmacsNative.java | 10 +- java/org/gnu/emacs/EmacsOpenActivity.java | 9 +- java/org/gnu/emacs/EmacsService.java | 80 +++++++++++++++- lisp/international/mule-cmds.el | 7 +- src/androidvfs.c | 150 +++++++++++++++++++++++++++--- 5 files changed, 231 insertions(+), 25 deletions(-) (limited to 'lisp') diff --git a/java/org/gnu/emacs/EmacsNative.java b/java/org/gnu/emacs/EmacsNative.java index 898eaef41a7..654e94b1a7d 100644 --- a/java/org/gnu/emacs/EmacsNative.java +++ b/java/org/gnu/emacs/EmacsNative.java @@ -281,7 +281,7 @@ public final class EmacsNative public static native int[] getSelection (short window); - /* Graphics functions used as a replacement for potentially buggy + /* Graphics functions used as replacements for potentially buggy Android APIs. */ public static native void blitRect (Bitmap src, Bitmap dest, int x1, @@ -289,7 +289,6 @@ public final class EmacsNative /* Increment the generation ID of the specified BITMAP, forcing its texture to be re-uploaded to the GPU. */ - public static native void notifyPixelsChanged (Bitmap bitmap); @@ -313,6 +312,13 @@ public final class EmacsNative in the process. */ public static native boolean ftruncate (int fd); + + /* Functions that assist in generating content file names. */ + + /* Calculate an 8 digit checksum for the byte array DISPLAYNAME + suitable for inclusion in a content file name. */ + public static native String displayNameHash (byte[] displayName); + static { /* Older versions of Android cannot link correctly with shared diff --git a/java/org/gnu/emacs/EmacsOpenActivity.java b/java/org/gnu/emacs/EmacsOpenActivity.java index 9ae1bf353dd..2cdfa2ec776 100644 --- a/java/org/gnu/emacs/EmacsOpenActivity.java +++ b/java/org/gnu/emacs/EmacsOpenActivity.java @@ -252,7 +252,7 @@ public final class EmacsOpenActivity extends Activity if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.KITKAT) { - content = EmacsService.buildContentName (uri); + content = EmacsService.buildContentName (uri, getContentResolver ()); return content; } @@ -423,6 +423,7 @@ public final class EmacsOpenActivity extends Activity /* Obtain the intent that started Emacs. */ intent = getIntent (); action = intent.getAction (); + resolver = getContentResolver (); if (action == null) { @@ -536,7 +537,7 @@ public final class EmacsOpenActivity extends Activity if ((scheme = uri.getScheme ()) != null && scheme.equals ("content")) { - tem1 = EmacsService.buildContentName (uri); + tem1 = EmacsService.buildContentName (uri, resolver); attachmentString = ("'(\"" + (tem1.replace ("\\", "\\\\") .replace ("\"", "\\\"") .replace ("$", "\\$")) @@ -568,7 +569,8 @@ public final class EmacsOpenActivity extends Activity && (scheme = uri.getScheme ()) != null && scheme.equals ("content")) { - tem1 = EmacsService.buildContentName (uri); + tem1 + = EmacsService.buildContentName (uri, resolver); builder.append ("\""); builder.append (tem1.replace ("\\", "\\\\") .replace ("\"", "\\\"") @@ -609,7 +611,6 @@ public final class EmacsOpenActivity extends Activity underlying file, but it cannot be found without opening the file and doing readlink on its file descriptor in /proc/self/fd. */ - resolver = getContentResolver (); fd = null; try diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 9bc40d63311..19aa3dee456 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -79,6 +79,7 @@ import android.os.VibrationEffect; import android.provider.DocumentsContract; import android.provider.DocumentsContract.Document; +import android.provider.OpenableColumns; import android.provider.Settings; import android.util.Log; @@ -1033,22 +1034,87 @@ public final class EmacsService extends Service return false; } + /* Return a 8 character checksum for the string STRING, after encoding + as UTF-8 data. */ + + public static String + getDisplayNameHash (String string) + { + byte[] encoded; + + try + { + encoded = string.getBytes ("UTF-8"); + return EmacsNative.displayNameHash (encoded); + } + catch (UnsupportedEncodingException exception) + { + /* This should be impossible. */ + return "error"; + } + } + /* Build a content file name for URI. Return a file name within the /contents/by-authority pseudo-directory that `android_get_content_name' can then transform back into an encoded URI. + If a display name can be requested from URI (using the resolver + RESOLVER), append it to this file name. + A content name consists of any number of unencoded path segments separated by `/' characters, possibly followed by a question mark and an encoded query string. */ public static String - buildContentName (Uri uri) + buildContentName (Uri uri, ContentResolver resolver) { StringBuilder builder; + String displayName; + String[] projection; + Cursor cursor; + int column; + + displayName = null; + cursor = null; - builder = new StringBuilder ("/content/by-authority/"); + try + { + projection = new String[] { OpenableColumns.DISPLAY_NAME, }; + cursor = resolver.query (uri, projection, null, null, null); + + if (cursor != null) + { + cursor.moveToFirst (); + column + = cursor.getColumnIndexOrThrow (OpenableColumns.DISPLAY_NAME); + displayName + = cursor.getString (column); + + /* Verify that the display name is valid, i.e. it + contains no characters unsuitable for a file name and + is nonempty. */ + if (displayName.isEmpty () || displayName.contains ("/")) + displayName = null; + } + } + catch (Exception e) + { + /* Ignored. */ + } + finally + { + if (cursor != null) + cursor.close (); + } + + /* If a display name is available, at this point it should be the + value of displayName. */ + + builder = new StringBuilder (displayName != null + ? "/content/by-authority-named/" + : "/content/by-authority/"); builder.append (uri.getAuthority ()); /* First, append each path segment. */ @@ -1065,6 +1131,16 @@ public final class EmacsService extends Service if (uri.getEncodedQuery () != null) builder.append ('?').append (uri.getEncodedQuery ()); + /* Append the display name. */ + + if (displayName != null) + { + builder.append ('/'); + builder.append (getDisplayNameHash (displayName)); + builder.append ('/'); + builder.append (displayName); + } + return builder.toString (); } diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 6b4c83112e3..e80c42f523a 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -350,9 +350,10 @@ This also sets the following values: if CODING-SYSTEM is ASCII-compatible" (check-coding-system coding-system) (setq-default buffer-file-coding-system coding-system) - - (if (eq system-type 'darwin) - ;; The file-name coding system on Darwin systems is always utf-8. + (if (or (eq system-type 'darwin) + (eq system-type 'android)) + ;; The file-name coding system on Darwin and Android systems is + ;; always UTF-8. (setq default-file-name-coding-system 'utf-8-unix) (if (and (or (not coding-system) (coding-system-get coding-system 'ascii-compatible-p))) diff --git a/src/androidvfs.c b/src/androidvfs.c index 4bb652f3eb7..9e3d5cab8cf 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -33,6 +33,7 @@ along with GNU Emacs. If not, see . */ #include #include +#include #include @@ -255,6 +256,7 @@ enum android_vnode_type ANDROID_VNODE_AFS, ANDROID_VNODE_CONTENT, ANDROID_VNODE_CONTENT_AUTHORITY, + ANDROID_VNODE_CONTENT_AUTHORITY_NAMED, ANDROID_VNODE_SAF_ROOT, ANDROID_VNODE_SAF_TREE, ANDROID_VNODE_SAF_FILE, @@ -2435,6 +2437,7 @@ struct android_content_vdir }; static struct android_vnode *android_authority_initial (char *, size_t); +static struct android_vnode *android_authority_initial_name (char *, size_t); static struct android_vnode *android_saf_root_initial (char *, size_t); /* Content provider meta-interface. This implements a vnode at @@ -2445,9 +2448,9 @@ static struct android_vnode *android_saf_root_initial (char *, size_t); a list of each directory tree Emacs has been granted permanent access to through the Storage Access Framework. - /content/by-authority exists on Android 4.4 and later; it contains - no directories, but provides a `name' function that converts - children into content URIs. */ + /content/by-authority and /content/by-authority-named exists on + Android 4.4 and later; it contains no directories, but provides a + `name' function that converts children into content URIs. */ static struct android_vnode *android_content_name (struct android_vnode *, char *, size_t); @@ -2490,7 +2493,7 @@ static struct android_vops content_vfs_ops = static const char *content_directory_contents[] = { - "storage", "by-authority", + "storage", "by-authority", "by-authority-named", }; /* Chain consisting of all open content directory streams. */ @@ -2508,8 +2511,9 @@ android_content_name (struct android_vnode *vnode, char *name, int api; static struct android_special_vnode content_vnodes[] = { - { "storage", 7, android_saf_root_initial, }, - { "by-authority", 12, android_authority_initial, }, + { "storage", 7, android_saf_root_initial, }, + { "by-authority", 12, android_authority_initial, }, + { "by-authority-named", 18, android_authority_initial_name, }, }; /* Canonicalize NAME. */ @@ -2551,7 +2555,7 @@ android_content_name (struct android_vnode *vnode, char *name, call its root lookup function with the rest of NAME there. */ if (api < 19) - i = 2; + i = 3; else if (api < 21) i = 1; else @@ -2855,18 +2859,59 @@ android_content_initial (char *name, size_t length) +#ifdef __clang__ +#pragma clang diagnostic push +#pragma clang diagnostic ignored "-Wmissing-prototypes" +#else /* GNUC */ +#pragma GCC diagnostic push +#pragma GCC diagnostic ignored "-Wmissing-prototypes" +#endif /* __clang__ */ + /* Content URI management functions. */ +JNIEXPORT jstring JNICALL +NATIVE_NAME (displayNameHash) (JNIEnv *env, jobject object, + jbyteArray display_name) +{ + char checksum[9], block[MD5_DIGEST_SIZE]; + jbyte *data; + + data = (*env)->GetByteArrayElements (env, display_name, NULL); + if (!data) + return NULL; + + /* Hash the buffer. */ + md5_buffer ((char *) data, (*env)->GetArrayLength (env, display_name), + block); + (*env)->ReleaseByteArrayElements (env, display_name, data, JNI_ABORT); + + /* Generate the digest string. */ + hexbuf_digest (checksum, (char *) block, 4); + checksum[8] = '\0'; + return (*env)->NewStringUTF (env, checksum); +} + +#ifdef __clang__ +#pragma clang diagnostic pop +#else /* GNUC */ +#pragma GCC diagnostic pop +#endif /* __clang__ */ + /* Return the content URI corresponding to a `/content/by-authority' file name, or NULL if it is invalid for some reason. FILENAME should be relative to /content/by-authority, with no leading - directory separator character. */ + directory separator character. + + WITH_CHECKSUM should be true if FILENAME contains a display name and + a checksum for that display name. */ static char * -android_get_content_name (const char *filename) +android_get_content_name (const char *filename, bool with_checksum) { char *fill, *buffer; size_t length; + char checksum[9], new_checksum[9], block[MD5_DIGEST_SIZE]; + const char *p2, *p1; /* Make sure FILENAME isn't obviously invalid: it must contain an authority name and a file name component. */ @@ -2888,11 +2933,55 @@ android_get_content_name (const char *filename) return NULL; } + if (!with_checksum) + goto no_checksum; + + /* Content file names hold two components providing a display name and + a short checksum that protects against files being opened under + display names besides those provided in the content file name at + the time of generation. */ + + p1 = strrchr (filename, '/'); /* Display name. */ + p2 = memrchr (filename, '/', p1 - filename); /* Start of checksum. */ + + /* If the name be excessively short or the checksum of an invalid + length, return. */ + if (!p2 || (p1 - p2) != 9) + { + errno = ENOENT; + return NULL; + } + + /* Copy the checksum into CHECKSUM. */ + memcpy (checksum, p2 + 1, 8); + new_checksum[8] = checksum[8] = '\0'; + + /* Hash this string and store 8 bytes of the resulting digest into + new_checksum. */ + md5_buffer (p1 + 1, strlen (p1 + 1), block); + hexbuf_digest (new_checksum, (char *) block, 4); + + /* Compare both checksums. */ + if (strcmp (new_checksum, checksum)) + { + errno = ENOENT; + return NULL; + } + + /* Remove the checksum and file display name from the URI. */ + length = p2 - filename; + + no_checksum: + if (length > INT_MAX) + { + errno = ENOMEM; + return NULL; + } + /* Prefix FILENAME with content:// and return the buffer containing that URI. */ - - buffer = xmalloc (sizeof "content://" + length); - sprintf (buffer, "content://%s", filename); + buffer = xmalloc (sizeof "content://" + length + 1); + sprintf (buffer, "content://%.*s", (int) length, filename); return buffer; } @@ -2932,7 +3021,7 @@ android_check_content_access (const char *uri, int mode) /* Content authority-based vnode implementation. - /contents/by-authority is a simple vnode implementation that converts + /content/by-authority is a simple vnode implementation that converts components to content:// URIs. It does not canonicalize file names by removing parent directory @@ -3039,7 +3128,14 @@ android_authority_name (struct android_vnode *vnode, char *name, if (android_verify_jni_string (name)) goto no_entry; - uri_name = android_get_content_name (name); + if (vp->vnode.type == ANDROID_VNODE_CONTENT_AUTHORITY_NAMED) + /* This indicates that the two trailing components of NAME + provide a checksum and a file display name, to be verified, + then excluded from the content URI. */ + uri_name = android_get_content_name (name, true); + else + uri_name = android_get_content_name (name, false); + if (!uri_name) goto error; @@ -3333,6 +3429,32 @@ android_authority_initial (char *name, size_t length) return android_authority_name (&temp.vnode, name, length); } +/* Find the vnode designated by NAME relative to the root of the + by-authority-named directory. + + If NAME is empty or a single leading separator character, return + a vnode representing the by-authority directory itself. + + Otherwise, represent the remainder of NAME as a URI (without + normalizing it) and return a vnode corresponding to that. + + Value may also be NULL with errno set if the designated vnode is + not available, such as when Android windowing has not been + initialized. */ + +static struct android_vnode * +android_authority_initial_name (char *name, size_t length) +{ + struct android_authority_vnode temp; + + temp.vnode.ops = &authority_vfs_ops; + temp.vnode.type = ANDROID_VNODE_CONTENT_AUTHORITY_NAMED; + temp.vnode.flags = 0; + temp.uri = NULL; + + return android_authority_name (&temp.vnode, name, length); +} + /* SAF ``root'' vnode implementation. -- cgit v1.2.3 From 0f76baeac074a3d8f15b29b34b873b44d551979b Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 19 Mar 2024 10:41:52 +0100 Subject: * Use 'cl-type-of' in comp-cstr.el * lisp/emacs-lisp/comp-cstr.el (comp-cstr-union-homogeneous-no-range) (comp-cstr-union-1-no-mem, comp-cstr-intersection-no-hashcons): Make use of 'cl-type-of' in place of 'type-of'. --- lisp/emacs-lisp/comp-cstr.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 5922a8caf12..70456a70de1 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -575,7 +575,7 @@ All SRCS constraints must be homogeneously negated or non-negated." ;; We propagate only values those types are not already ;; into typeset. when (cl-notany (lambda (x) - (comp-subtype-p (type-of v) x)) + (comp-subtype-p (cl-type-of v) x)) (comp-cstr-typeset dst)) collect v))) @@ -664,7 +664,7 @@ DST is returned." ;; Verify disjoint condition between positive types and ;; negative types coming from values, in case give-up. - (let ((neg-value-types (nconc (mapcar #'type-of (valset neg)) + (let ((neg-value-types (nconc (mapcar #'cl-type-of (valset neg)) (when (range neg) '(integer))))) (when (cl-some (lambda (x) @@ -685,7 +685,7 @@ DST is returned." ((cl-some (lambda (x) (cl-some (lambda (y) (comp-subtype-p y x)) - (mapcar #'type-of (valset pos)))) + (mapcar #'cl-type-of (valset pos)))) (typeset neg)) (give-up)) (t @@ -1108,7 +1108,7 @@ DST is returned." (cl-loop for v in (valset dst) unless (symbolp v) do (push v strip-values) - (push (type-of v) strip-types)) + (push (cl-type-of v) strip-types)) (when strip-values (setf (typeset dst) (comp-union-typesets (typeset dst) strip-types) (valset dst) (cl-set-difference (valset dst) strip-values))) -- cgit v1.2.3 From e72f17e4622fae45c9814f6ed196e5a9ed06cdd2 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 20 Mar 2024 10:23:42 +0800 Subject: Respect file display names during Android drag-and-drop * java/org/gnu/emacs/EmacsService.java (buildContentName): Remove redundant projection argument to resolver.query. * java/org/gnu/emacs/EmacsWindow.java (onDragEvent): If a content resolver is available, attempt to convert content URIs into file names in advance. * lisp/term/android-win.el (android-handle-dnd-event): Adjust correspondingly. --- java/org/gnu/emacs/EmacsService.java | 4 +--- java/org/gnu/emacs/EmacsWindow.java | 18 +++++++++++++++++- lisp/term/android-win.el | 37 ++++++++++++++++++++---------------- 3 files changed, 39 insertions(+), 20 deletions(-) (limited to 'lisp') diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 19aa3dee456..785163c713c 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -1072,7 +1072,6 @@ public final class EmacsService extends Service { StringBuilder builder; String displayName; - String[] projection; Cursor cursor; int column; @@ -1081,8 +1080,7 @@ public final class EmacsService extends Service try { - projection = new String[] { OpenableColumns.DISPLAY_NAME, }; - cursor = resolver.query (uri, projection, null, null, null); + cursor = resolver.query (uri, null, null, null, null); if (cursor != null) { diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index 6e8bdaf7401..93a512cc7ef 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java @@ -31,6 +31,7 @@ import android.app.Activity; import android.content.ClipData; import android.content.ClipDescription; +import android.content.ContentResolver; import android.content.Context; import android.graphics.Rect; @@ -1699,10 +1700,11 @@ public final class EmacsWindow extends EmacsHandleObject ClipData data; ClipDescription description; int i, j, x, y, itemCount; - String type; + String type, uriString; Uri uri; EmacsActivity activity; StringBuilder builder; + ContentResolver resolver; x = (int) event.getX (); y = (int) event.getY (); @@ -1799,6 +1801,20 @@ public final class EmacsWindow extends EmacsHandleObject { if ((activity.requestDragAndDropPermissions (event) == null)) uri = null; + else + { + resolver = activity.getContentResolver (); + + /* Substitute a content file name for the URI, if + possible. */ + uriString = EmacsService.buildContentName (uri, resolver); + + if (uriString != null) + { + builder.append (uriString).append ("\n"); + continue; + } + } } if (uri != null) diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index 1d10402b15d..8d262e5da98 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -282,11 +282,12 @@ If it reflects the motion of an item above a frame, call `dnd-handle-movement' to move the cursor or scroll the window under the item pursuant to the pertinent user options. -If it reflects dropped text, insert such text within window at -the location of the drop. +If it holds dropped text, insert such text within window at the +location of the drop. -If it reflects a list of URIs, then open each URI, converting -content:// URIs into the special file names which represent them." +If it holds a list of URIs, or file names, then open each URI or +file name, converting content:// URIs into the special file +names which represent them." (interactive "e") (let ((message (caddr event)) (posn (event-start event))) @@ -304,18 +305,22 @@ content:// URIs into the special file names which represent them." (new-uri-list nil) (dnd-unescape-file-uris t)) (dolist (uri uri-list) - (ignore-errors - (let ((url (url-generic-parse-url uri))) - (when (equal (url-type url) "content") - ;; Replace URI with a matching /content file - ;; name. - (setq uri (format "file:/content/by-authority/%s%s" - (url-host url) - (url-filename url)) - ;; And guarantee that this file URI is not - ;; subject to URI decoding, for it must be - ;; transformed back into a content URI. - dnd-unescape-file-uris nil)))) + ;; If the URI is a preprepared file name, insert it directly. + (if (string-match-p "^/content/by-authority\\(-named\\)?/" uri) + (setq uri (concat "file:" uri) + dnd-unescape-file-uris nil) + (ignore-errors + (let ((url (url-generic-parse-url uri))) + (when (equal (url-type url) "content") + ;; Replace URI with a matching /content file + ;; name. + (setq uri (format "file:/content/by-authority/%s%s" + (url-host url) + (url-filename url)) + ;; And guarantee that this file URI is not + ;; subject to URI decoding, for it must be + ;; transformed back into a content URI. + dnd-unescape-file-uris nil))))) (push uri new-uri-list)) (dnd-handle-multiple-urls (posn-window posn) new-uri-list -- cgit v1.2.3 From 5bdc2436c649ccc897a548a8e553244f58168216 Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Wed, 20 Mar 2024 09:33:37 +0100 Subject: ; * lisp/emacs-lisp/cl-macs.el (cl-labels): Fix stray diff marker. --- lisp/emacs-lisp/cl-macs.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 949b3284782..732deda618d 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2203,7 +2203,7 @@ Like `cl-flet' but the definitions can refer to previous ones. ;;;###autoload (defmacro cl-labels (bindings &rest body) "Make local (recursive) function definitions. -+BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where +BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where FUNC is the function name, ARGLIST its arguments, and BODY the forms of the function body. FUNC is defined in any BODY, as well as FORM, so you can write recursive and mutually recursive -- cgit v1.2.3 From 0b0c7da8c80a1e4dc328459f3403f358736ae90d Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 22:31:45 +0100 Subject: Add native compiler sanitizer * src/comp.c (ABI_VERSION): Bump new version. (CALL0I): Uncomment. (helper_link_table, declare_runtime_imported_funcs): Add 'helper_sanitizer_assert'. (Fcomp__init_ctxt): Register emitter for 'helper_sanitizer_assert'. (helper_sanitizer_assert): New function. (syms_of_comp): 'helper_sanitizer_assert' defsym. (syms_of_comp): 'comp-sanitizer-error' define error. (syms_of_comp): 'comp-sanitizer-active' defvar. * lisp/emacs-lisp/comp.el (comp-passes): Add 'comp--sanitizer'. (comp-sanitizer-emit): Define var. (comp--sanitizer): Define function. * lisp/emacs-lisp/comp-run.el (comp-run-async-workers): Forward 'comp-sanitizer-emit'. --- lisp/emacs-lisp/comp-run.el | 1 + lisp/emacs-lisp/comp.el | 46 +++++++++++++++++++++++++++++++++++++++++++++ src/comp.c | 42 ++++++++++++++++++++++++++++++++++++++--- 3 files changed, 86 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index afb46e3cd19..480f048777c 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -256,6 +256,7 @@ display a message." load-path backtrace-line-length byte-compile-warnings + comp-sanitizer-emit ;; package-load-list ;; package-user-dir ;; package-directory-list diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 9c2182092cb..6afb357bef2 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -165,6 +165,7 @@ Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.") comp--tco comp--fwprop comp--remove-type-hints + comp--sanitizer comp--compute-function-types comp--final) "Passes to be executed in order.") @@ -3006,6 +3007,51 @@ These are substituted with a normal `set' op." (comp--log-func comp-func 3)))) (comp-ctxt-funcs-h comp-ctxt))) + +;;; Sanitizer pass specific code. + +;; This pass aims to verify compile time value type predictions during +;; execution. +;; The sanitizer pass injects a call to 'helper_sanitizer_assert' before +;; each conditional branch. 'helper_sanitizer_assert' will verify that +;; the variable tested by the conditional branch is of the predicted +;; value type and signal an error otherwise. + +(defvar comp-sanitizer-emit nil + "Gates the sanitizer pass. +In use for native compiler development and verification only.") + +(defun comp--sanitizer (_) + (when comp-sanitizer-emit + (cl-loop + for f being each hash-value of (comp-ctxt-funcs-h comp-ctxt) + for comp-func = f + unless (comp-func-has-non-local comp-func) + do + (cl-loop + for b being each hash-value of (comp-func-blocks f) + do + (cl-loop + named in-the-basic-block + for insns-seq on (comp-block-insns b) + do (pcase insns-seq + (`((cond-jump ,(and (pred comp-mvar-p) mvar-tested) + ,(pred comp-mvar-p) ,_bb1 ,_bb2)) + (let ((type (comp-cstr-to-type-spec mvar-tested)) + (insn (car insns-seq))) + ;; No need to check if type is t. + (unless (eq type t) + (comp--add-const-to-relocs type) + (setcar + insns-seq + (comp--call 'helper_sanitizer_assert + mvar-tested + (make--comp-mvar :constant type))) + (setcdr insns-seq (list insn))) + ;; (setf (comp-func-ssa-status comp-func) 'dirty) + (cl-return-from in-the-basic-block)))))) + do (comp--log-func comp-func 3)))) + ;;; Function types pass specific code. diff --git a/src/comp.c b/src/comp.c index 76cf1f3ab6e..5e4ca643072 100644 --- a/src/comp.c +++ b/src/comp.c @@ -469,7 +469,7 @@ load_gccjit_if_necessary (bool mandatory) /* Increase this number to force a new Vcomp_abi_hash to be generated. */ -#define ABI_VERSION "5" +#define ABI_VERSION "6" /* Length of the hashes used for eln file naming. */ #define HASH_LENGTH 8 @@ -502,11 +502,9 @@ load_gccjit_if_necessary (bool mandatory) #define THIRD(x) \ XCAR (XCDR (XCDR (x))) -#if 0 /* unused for now */ /* Like call0 but stringify and intern. */ #define CALL0I(fun) \ CALLN (Ffuncall, intern_c_string (STR (fun))) -#endif /* Like call1 but stringify and intern. */ #define CALL1I(fun, arg) \ @@ -702,6 +700,8 @@ static void helper_save_restriction (void); static bool helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object, enum pvec_type); static struct Lisp_Symbol_With_Pos * helper_GET_SYMBOL_WITH_POSITION (Lisp_Object); +static Lisp_Object +helper_sanitizer_assert (Lisp_Object, Lisp_Object); /* Note: helper_link_table must match the list created by `declare_runtime_imported_funcs'. */ @@ -714,6 +714,7 @@ static void *helper_link_table[] = helper_unbind_n, helper_save_restriction, helper_GET_SYMBOL_WITH_POSITION, + helper_sanitizer_assert, record_unwind_current_buffer, set_internal, helper_unwind_protect, @@ -2975,6 +2976,10 @@ declare_runtime_imported_funcs (void) ADD_IMPORTED (helper_GET_SYMBOL_WITH_POSITION, comp.lisp_symbol_with_position_ptr_type, 1, args); + args[0] = comp.lisp_obj_type; + args[1] = comp.lisp_obj_type; + ADD_IMPORTED (helper_sanitizer_assert, comp.lisp_obj_type, 2, args); + ADD_IMPORTED (record_unwind_current_buffer, comp.void_type, 0, NULL); args[0] = args[1] = args[2] = comp.lisp_obj_type; @@ -4619,6 +4624,8 @@ Return t on success. */) emit_simple_limple_call_void_ret); register_emitter (Qhelper_save_restriction, emit_simple_limple_call_void_ret); + register_emitter (Qhelper_sanitizer_assert, + emit_simple_limple_call_lisp_ret); /* Inliners. */ register_emitter (Qadd1, emit_add1); register_emitter (Qsub1, emit_sub1); @@ -5082,6 +5089,21 @@ helper_GET_SYMBOL_WITH_POSITION (Lisp_Object a) return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos); } +static Lisp_Object +helper_sanitizer_assert (Lisp_Object val, Lisp_Object type) +{ + if (!comp_sanitizer_active + || !NILP ((CALL2I (cl-typep, val, type)))) + return Qnil; + + AUTO_STRING (format, "Comp sanitizer FAIL for %s with type %s"); + CALLN (Fmessage, format, val, type); + CALL0I (backtrace); + xsignal2 (Qcomp_sanitizer_error, val, type); + + return Qnil; +} + /* `native-comp-eln-load-path' clean-up support code. */ @@ -5709,6 +5731,7 @@ natively-compiled one. */); DEFSYM (Qhelper_unbind_n, "helper_unbind_n"); DEFSYM (Qhelper_unwind_protect, "helper_unwind_protect"); DEFSYM (Qhelper_save_restriction, "helper_save_restriction"); + DEFSYM (Qhelper_sanitizer_assert, "helper_sanitizer_assert"); /* Inliners. */ DEFSYM (Qadd1, "1+"); DEFSYM (Qsub1, "1-"); @@ -5779,6 +5802,12 @@ natively-compiled one. */); build_pure_c_string ("eln file inconsistent with current runtime " "configuration, please recompile")); + DEFSYM (Qcomp_sanitizer_error, "comp-sanitizer-error"); + Fput (Qcomp_sanitizer_error, Qerror_conditions, + pure_list (Qcomp_sanitizer_error, Qerror)); + Fput (Qcomp_sanitizer_error, Qerror_message, + build_pure_c_string ("Native code sanitizer runtime error")); + DEFSYM (Qnative__compile_async, "native--compile-async"); defsubr (&Scomp__subr_signature); @@ -5901,6 +5930,13 @@ subr-name -> arity For internal use. */); Vcomp_subr_arities_h = CALLN (Fmake_hash_table, QCtest, Qequal); + DEFVAR_BOOL ("comp-sanitizer-active", comp_sanitizer_active, + doc: /* When non-nil enable sanitizer runtime execution. +To be effective Lisp Code must have been compiled with +`comp-sanitizer-emit' non-nil. +In use for native compiler development and verification only. */); + comp_sanitizer_active = false; + Fprovide (intern_c_string ("native-compile"), Qnil); #endif /* #ifdef HAVE_NATIVE_COMP */ -- cgit v1.2.3 From e8d2bc75314262d512d367c270c6d43201ef533f Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 20 Mar 2024 11:49:32 +0100 Subject: ; * lisp/emacs-lisp/comp-cstr.el (comp--normalize-typeset0): Fix comment. --- lisp/emacs-lisp/comp-cstr.el | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 70456a70de1..cbfb9540f03 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -288,13 +288,10 @@ Return them as multiple value." (apply #'append (mapcar #'comp--direct-supertypes typeset))) for subs = (comp--direct-subtypes sup) - when (and (length> subs 1) ;;FIXME: Why? - ;; Every subtype of `sup` is a subtype of - ;; some element of `typeset`? - ;; It's tempting to just check (member x typeset), - ;; but think of the typeset (marker number), - ;; where `sup' is `integer-or-marker' and `sub' - ;; is `integer'. + when (and (length> subs 1) ;; If there's only one sub do + ;; nothing as we want to + ;; return the most specific + ;; type. (cl-every (lambda (sub) (cl-some (lambda (type) (comp-subtype-p sub type)) -- cgit v1.2.3 From 1475e3c3b562f7604e538fccbb41f1d66b10663d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 20 Mar 2024 14:27:25 +0200 Subject: ; Fix doc strings of recent changes * src/comp.c (syms_of_comp) : * lisp/emacs-lisp/comp.el (comp-sanitizer-emit): Doc fixes. --- lisp/emacs-lisp/comp.el | 3 ++- src/comp.c | 9 +++++---- 2 files changed, 7 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 6afb357bef2..d7830597709 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3019,7 +3019,8 @@ These are substituted with a normal `set' op." (defvar comp-sanitizer-emit nil "Gates the sanitizer pass. -In use for native compiler development and verification only.") +This is intended to be used only for development and verification of +the native compiler.") (defun comp--sanitizer (_) (when comp-sanitizer-emit diff --git a/src/comp.c b/src/comp.c index 5e4ca643072..99f51e07048 100644 --- a/src/comp.c +++ b/src/comp.c @@ -5931,10 +5931,11 @@ For internal use. */); Vcomp_subr_arities_h = CALLN (Fmake_hash_table, QCtest, Qequal); DEFVAR_BOOL ("comp-sanitizer-active", comp_sanitizer_active, - doc: /* When non-nil enable sanitizer runtime execution. -To be effective Lisp Code must have been compiled with -`comp-sanitizer-emit' non-nil. -In use for native compiler development and verification only. */); + doc: /* If non-nil, enable runtime execution of native-compiler sanitizer. +For this to be effective, Lisp code must be compiled +with `comp-sanitizer-emit' non-nil. +This is intended to be used only for development and +verification of the native compiler. */); comp_sanitizer_active = false; Fprovide (intern_c_string ("native-compile"), Qnil); -- cgit v1.2.3 From e2fec514fd22e61c2a4e9343056aa744e93203a1 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 20 Mar 2024 14:49:28 +0100 Subject: ; * lisp/emacs-lisp/comp.el: Add a simple sanitizer usage example. --- lisp/emacs-lisp/comp.el | 12 ++++++++++++ 1 file changed, 12 insertions(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index d7830597709..7e8d4e15e0a 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3017,6 +3017,18 @@ These are substituted with a normal `set' op." ;; the variable tested by the conditional branch is of the predicted ;; value type and signal an error otherwise. +;;; Example: +;; Assuming we want to compile 'test.el' and test function `foo' defined +;; into it. + +;; Native compile 'test.el' instrumenting it for sanitizer usage. +;; (let ((comp-sanitizer-emit t)) +;; (load (native-compile "test.el"))) + +;; Run `foo' with the sanitizer active. +;; (let ((comp-sanitizer-active t)) +;; (foo)) + (defvar comp-sanitizer-emit nil "Gates the sanitizer pass. This is intended to be used only for development and verification of -- cgit v1.2.3 From ae9d8eedfdd6030a082010ac933b4aa4ddc05749 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 20 Mar 2024 16:08:15 +0200 Subject: ; Minor copyedits of last change. --- lisp/emacs-lisp/comp.el | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 7e8d4e15e0a..1df1e3b3ddb 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3010,24 +3010,25 @@ These are substituted with a normal `set' op." ;;; Sanitizer pass specific code. -;; This pass aims to verify compile time value type predictions during -;; execution. +;; This pass aims to verify compile-time value-type predictions during +;; execution of the code. ;; The sanitizer pass injects a call to 'helper_sanitizer_assert' before -;; each conditional branch. 'helper_sanitizer_assert' will verify that +;; each conditional branch. 'helper_sanitizer_assert' will verify that ;; the variable tested by the conditional branch is of the predicted -;; value type and signal an error otherwise. +;; value type, or signal an error otherwise. ;;; Example: -;; Assuming we want to compile 'test.el' and test function `foo' defined -;; into it. -;; Native compile 'test.el' instrumenting it for sanitizer usage. -;; (let ((comp-sanitizer-emit t)) -;; (load (native-compile "test.el"))) +;; Assume we want to compile 'test.el' and test the function `foo' +;; defined in it. Then: -;; Run `foo' with the sanitizer active. -;; (let ((comp-sanitizer-active t)) -;; (foo)) +;; - Native-compile 'test.el' instrumenting it for sanitizer usage: +;; (let ((comp-sanitizer-emit t)) +;; (load (native-compile "test.el"))) + +;; - Run `foo' with the sanitizer active: +;; (let ((comp-sanitizer-active t)) +;; (foo)) (defvar comp-sanitizer-emit nil "Gates the sanitizer pass. -- cgit v1.2.3 From 0df28dc00edd0db343619d02aa41999a7bfce5fb Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 20 Mar 2024 16:59:33 +0100 Subject: ; * lisp/emacs-lisp/comp-run.el (comp-run-async-workers): Fix indentation. --- lisp/emacs-lisp/comp-run.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index 480f048777c..5cc61579030 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -233,8 +233,8 @@ display a message." "`comp-files-queue' should be \".el\" files: %s" source-file) when (or native-comp-always-compile - load ; Always compile when the compilation is - ; commanded for late load. + load ; Always compile when the compilation is + ; commanded for late load. ;; Skip compilation if `comp-el-to-eln-filename' fails ;; to find a writable directory. (with-demoted-errors "Async compilation :%S" -- cgit v1.2.3 From b3f04eb68499f285e05b5b74e9cbd67f3140fb3c Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 21 Mar 2024 02:13:28 -0500 Subject: Avoid recomputing the whole table in 'vtable--recompute-numerical' Each element of LINE being tested is a list, the first element of which is the value actually being represented in the table. Previously, the 'numberp' test would always fail, because it was being compared with the list rather than the intended value in it; that could cause the whole table to be recomputed, sometimes unnecessarily. * lisp/emacs-lisp/vtable.el (vtable--recompute-numerical): Test the car of ELEM, not ELEM itself, which is a list. (Bug#69927) --- lisp/emacs-lisp/vtable.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 15a430f5c26..5f7d3ae5210 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -743,7 +743,7 @@ If NEXT, do the next column." (seq-do-indexed (lambda (elem index) (when (and (vtable-column--numerical (elt columns index)) - (not (numberp elem))) + (not (numberp (car elem)))) (setq recompute t))) line) (when recompute -- cgit v1.2.3 From fa79de7c6b8883de4433572b2f6dc5b941f6ac66 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 21 Mar 2024 09:49:34 +0200 Subject: ; * lisp/calendar/calendar.el: Remove extra space. --- lisp/calendar/calendar.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index a13c2b7ca6d..422a6ceaa7a 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1973,7 +1973,7 @@ Gregorian date Sunday, December 31, 1 BC. This function does not handle dates in years BC." ;; For an explanation, see the footnote on page 384 of "Calendrical ;; Calculations, Part II: Three Historical Calendars" by - ;; E. M. Reingold, N. Dershowitz, and S. M. Clamen, + ;; E. M. Reingold, N. Dershowitz, and S. M. Clamen, ;; Software--Practice and Experience, Volume 23, Number 4 (April, ;; 1993), pages 383-404 ;; . -- cgit v1.2.3 From 689f04a2ddfae856153bed762cc1461d66ec88de Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sun, 17 Mar 2024 13:04:32 +0100 Subject: Clarify description of format-spec truncation * doc/lispref/strings.texi (Custom Format Strings): Mention that precision specifier affects both '<' and '>' truncation (bug#69822). * lisp/format-spec.el (format-spec, format-spec--do-flags): Use same terminology as 'format', especially when referring to its behavior. --- doc/lispref/strings.texi | 2 +- lisp/format-spec.el | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index a364fef3aab..eca69002779 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -1369,7 +1369,7 @@ given width and precision, if specified. @item > This flag causes the substitution to be truncated on the right to the -given width, if specified. +given width and precision, if specified. @item ^ This flag converts the substituted text to upper case (@pxref{Case diff --git a/lisp/format-spec.el b/lisp/format-spec.el index cf34017b994..73f9fccd793 100644 --- a/lisp/format-spec.el +++ b/lisp/format-spec.el @@ -38,7 +38,7 @@ For instance: (?l . \"ls\"))) Each %-spec may contain optional flag, width, and precision -modifiers, as follows: +specifiers, as follows: %character @@ -51,7 +51,7 @@ The following flags are allowed: * ^: Convert to upper case. * _: Convert to lower case. -The width and truncation modifiers behave like the corresponding +The width and precision specifiers behave like the corresponding ones in `format' when applied to %s. For example, \"%<010b\" means \"substitute into the output the @@ -145,7 +145,7 @@ is returned, where each format spec is its own element." "Return STR formatted according to FLAGS, WIDTH, and TRUNC. FLAGS is a list of keywords as returned by `format-spec--parse-flags'. WIDTH and TRUNC are either nil or -string widths corresponding to `format-spec' modifiers." +string widths corresponding to `format-spec' specifiers." (let (diff str-width) ;; Truncate original string first, like `format' does. (when trunc -- cgit v1.2.3 From 393f58c85aeb78f814866ccaad9ae7efd3fa6766 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 8 Mar 2024 23:43:14 -0600 Subject: 'vtable-update-object' can now be called with one argument It's often necessary to update the representation of a single object in a table (e.g a struct, whose identity does not change when its slots' values are changed). To do so, now the function may be called like this: (vtable-update-object table object) Instead of like this: (vtable-update-object table object object) This also documents the behavior of the just-discovered limitation filed as bug#69837. * lisp/emacs-lisp/vtable.el (vtable-update-object): Make 'old-object' argument optional. (Bug#69666) * doc/misc/vtable.texi (Interface Functions): Update documentation. * etc/NEWS: Add news entry. --- doc/misc/vtable.texi | 13 ++++++++++--- etc/NEWS | 9 +++++++++ lisp/emacs-lisp/vtable.el | 15 +++++++++++++-- 3 files changed, 32 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi index a4f2ed29d93..dd5b70cf32f 100644 --- a/doc/misc/vtable.texi +++ b/doc/misc/vtable.texi @@ -554,12 +554,19 @@ the object after this object; otherwise append to @var{table}. This also updates the displayed table. @end defun -@defun vtable-update-object table object old-object -Change @var{old-object} into @var{object} in @var{table}. This also -updates the displayed table. +@defun vtable-update-object table object &optional old-object +Update @var{object}'s representation in @var{table}. Optional argument +@var{old-object}, if non-@code{nil}, means to replace @var{old-object} +with @var{object} and redisplay the associated row in the table. In +either case, if the existing object is not found in the table (being +compared with @code{equal}), signal an error. This has the same effect as calling @code{vtable-remove-object} and then @code{vtable-insert-object}, but is more efficient. + +Note a limitation: if the table's buffer is not in a visible window, or +if its window has changed width since it was updated, updating the table +is not possible, and an error is signaled. @end defun @defun vtable-column table index diff --git a/etc/NEWS b/etc/NEWS index 69e61d91b0e..ba0e4c80fa0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2197,6 +2197,15 @@ aforementioned functions: (and (arrayp executing-kbd-macro) (>= executing-kbd-macro-index (length executing-kbd-macro)))) ++++ +** 'vtable-update-object' updates an existing object with just two arguments. +It is now possible to update the representation of an object in a vtable +by calling 'vtable-update-object' with just the vtable and the object as +arguments. (Previously the 'old-object' argument was required which, in +this case, would mean repeating the object in the argument list.) When +replacing an object with a different one, passing both the new and old +objects is still necessary. + * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 5f7d3ae5210..d8e5136c666 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -283,8 +283,16 @@ If it can't be found, return nil and don't move point." (goto-char (prop-match-beginning match)) (end-of-line))) -(defun vtable-update-object (table object old-object) - "Replace OLD-OBJECT in TABLE with OBJECT." +(defun vtable-update-object (table object &optional old-object) + "Update OBJECT's representation in TABLE. +If OLD-OBJECT is non-nil, replace OLD-OBJECT with OBJECT and display it. +In either case, if the existing object is not found in the table (being +compared with `equal'), signal an error. Note a limitation: if TABLE's +buffer is not in a visible window, or if its window has changed width +since it was updated, updating the TABLE is not possible, and an error +is signaled." + (unless old-object + (setq old-object object)) (let* ((objects (vtable-objects table)) (inhibit-read-only t)) ;; First replace the object in the object storage. @@ -300,6 +308,9 @@ If it can't be found, return nil and don't move point." (error "Can't find the old object")) (setcar (cdr objects) object)) ;; Then update the cache... + ;; FIXME: If the table's buffer has no visible window, or if its + ;; width has changed since the table was updated, the cache key will + ;; not match and the object can't be updated. (Bug #69837). (if-let ((line-number (seq-position (car (vtable--cache table)) old-object (lambda (a b) (equal (car a) b)))) -- cgit v1.2.3 From 51848e4731f3e32e5d152990bf570b08ca544a92 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 17 May 2023 15:28:46 +0200 Subject: * Fix missing `comp-files-queue' update (bug#63415). * lisp/emacs-lisp/comp.el (native--compile-async): Update `comp-files-queue' for real. --- lisp/emacs-lisp/comp.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 614c62c35c6..6b65a375ea0 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -4229,8 +4229,9 @@ bytecode definition was not changed in the meantime)." ;; compilation, so update `comp-files-queue' to reflect that. (unless (or (null load) (eq load (cdr entry))) - (cl-substitute (cons file load) (car entry) comp-files-queue - :key #'car :test #'string=)) + (setf comp-files-queue + (cl-substitute (cons file load) (car entry) comp-files-queue + :key #'car :test #'string=))) (unless (native-compile-async-skip-p file load selector) (let* ((out-filename (comp-el-to-eln-filename file)) -- cgit v1.2.3 From 3a902db97a99525b6f54100dc45a8cffcd3c5c8e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 21 Mar 2024 11:38:12 -0400 Subject: (widget--allow-insertion): New macro * lisp/wid-edit.el (widget--allow-insertion): New macro. (widget-specify-insert, widget-insert, widget-setup) (widget-default-delete, widget-editable-list-insert-before) (widget-editable-list-delete-at): Use it. --- lisp/wid-edit.el | 156 +++++++++++++++++++++++++++---------------------------- 1 file changed, 78 insertions(+), 78 deletions(-) (limited to 'lisp') diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index cd06acd3f99..0645871f16d 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -510,14 +510,20 @@ With CHECK-AFTER non-nil, considers also the content after point, if needed." ;; indented it. (not (eq (following-char) ?\s)))))) -(defmacro widget-specify-insert (&rest form) - "Execute FORM without inheriting any text properties." - (declare (debug (body))) +(defmacro widget--allow-insertion (&rest forms) + "Run FORMS such that they can insert widgets in the current buffer." + (declare (debug t)) + `(let ((inhibit-read-only t) + (inhibit-modification-hooks t)) ;; FIXME: Why? This is risky! + ,@forms)) + +(defmacro widget-specify-insert (&rest forms) + "Execute FORMS without inheriting any text properties." + (declare (debug t)) `(save-restriction - (let ((inhibit-read-only t) - (inhibit-modification-hooks t)) + (widget--allow-insertion (narrow-to-region (point) (point)) - (prog1 (progn ,@form) + (prog1 (progn ,@forms) (goto-char (point-max)))))) (defface widget-inactive @@ -954,9 +960,8 @@ The optional ARGS are additional keyword arguments." ;;;###autoload (defun widget-insert (&rest args) "Call `insert' with ARGS even if surrounding text is read only." - (let ((inhibit-read-only t) - (inhibit-modification-hooks t)) - (apply 'insert args))) + (widget--allow-insertion + (apply #'insert args))) (defun widget-convert-text (type from to &optional button-from button-to @@ -1376,19 +1381,18 @@ When not inside a field, signal an error." ;;;###autoload (defun widget-setup () "Setup current buffer so editing string widgets works." - (let ((inhibit-read-only t) - (inhibit-modification-hooks t) - field) - (while widget-field-new - (setq field (car widget-field-new) - widget-field-new (cdr widget-field-new) - widget-field-list (cons field widget-field-list)) - (let ((from (car (widget-get field :field-overlay))) - (to (cdr (widget-get field :field-overlay)))) - (widget-specify-field field - (marker-position from) (marker-position to)) - (set-marker from nil) - (set-marker to nil)))) + (widget--allow-insertion + (let (field) + (while widget-field-new + (setq field (car widget-field-new) + widget-field-new (cdr widget-field-new) + widget-field-list (cons field widget-field-list)) + (let ((from (car (widget-get field :field-overlay))) + (to (cdr (widget-get field :field-overlay)))) + (widget-specify-field field + (marker-position from) (marker-position to)) + (set-marker from nil) + (set-marker to nil))))) (widget-clear-undo) (widget-add-change)) @@ -1773,24 +1777,23 @@ The value of the :type attribute should be an unconverted widget type." (inactive-overlay (widget-get widget :inactive)) (button-overlay (widget-get widget :button-overlay)) (sample-overlay (widget-get widget :sample-overlay)) - (doc-overlay (widget-get widget :doc-overlay)) - (inhibit-modification-hooks t) - (inhibit-read-only t)) - (widget-apply widget :value-delete) - (widget-children-value-delete widget) - (when inactive-overlay - (delete-overlay inactive-overlay)) - (when button-overlay - (delete-overlay button-overlay)) - (when sample-overlay - (delete-overlay sample-overlay)) - (when doc-overlay - (delete-overlay doc-overlay)) - (when (< from to) - ;; Kludge: this doesn't need to be true for empty formats. - (delete-region from to)) - (set-marker from nil) - (set-marker to nil)) + (doc-overlay (widget-get widget :doc-overlay))) + (widget--allow-insertion + (widget-apply widget :value-delete) + (widget-children-value-delete widget) + (when inactive-overlay + (delete-overlay inactive-overlay)) + (when button-overlay + (delete-overlay button-overlay)) + (when sample-overlay + (delete-overlay sample-overlay)) + (when doc-overlay + (delete-overlay doc-overlay)) + (when (< from to) + ;; Kludge: this doesn't need to be true for empty formats. + (delete-region from to)) + (set-marker from nil) + (set-marker to nil))) (widget-clear-undo)) (defun widget-default-value-set (widget value) @@ -2885,27 +2888,26 @@ The new widget gets inserted at the position of the BEFORE child." (last-deleted (when-let ((lst (widget-get widget :last-deleted))) (prog1 (pop lst) - (widget-put widget :last-deleted lst)))) - (inhibit-read-only t) - (inhibit-modification-hooks t)) - (cond (before - (goto-char (widget-get before :entry-from))) - (t - (goto-char (widget-get widget :value-pos)))) - (let ((child (widget-editable-list-entry-create - widget (and last-deleted - (widget-apply last-deleted - :value-to-external - (widget-get last-deleted :value))) - last-deleted))) - (when (< (widget-get child :entry-from) (widget-get widget :from)) - (set-marker (widget-get widget :from) - (widget-get child :entry-from))) - (if (eq (car children) before) - (widget-put widget :children (cons child children)) - (while (not (eq (car (cdr children)) before)) - (setq children (cdr children))) - (setcdr children (cons child (cdr children))))))) + (widget-put widget :last-deleted lst))))) + (widget--allow-insertion + (cond (before + (goto-char (widget-get before :entry-from))) + (t + (goto-char (widget-get widget :value-pos)))) + (let ((child (widget-editable-list-entry-create + widget (and last-deleted + (widget-apply last-deleted + :value-to-external + (widget-get last-deleted :value))) + last-deleted))) + (when (< (widget-get child :entry-from) (widget-get widget :from)) + (set-marker (widget-get widget :from) + (widget-get child :entry-from))) + (if (eq (car children) before) + (widget-put widget :children (cons child children)) + (while (not (eq (car (cdr children)) before)) + (setq children (cdr children))) + (setcdr children (cons child (cdr children)))))))) (widget-setup) (widget-apply widget :notify widget)) @@ -2922,24 +2924,22 @@ Save CHILD into the :last-deleted list, so it can be inserted later." ;; Delete child from list of children. (save-excursion (let ((buttons (copy-sequence (widget-get widget :buttons))) - button - (inhibit-read-only t) - (inhibit-modification-hooks t)) - (while buttons - (setq button (car buttons) - buttons (cdr buttons)) - (when (eq (widget-get button :widget) child) - (widget-put widget - :buttons (delq button (widget-get widget :buttons))) - (widget-delete button)))) + button) + (widget--allow-insertion + (while buttons + (setq button (car buttons) + buttons (cdr buttons)) + (when (eq (widget-get button :widget) child) + (widget-put widget + :buttons (delq button (widget-get widget :buttons))) + (widget-delete button))))) (let ((entry-from (widget-get child :entry-from)) - (entry-to (widget-get child :entry-to)) - (inhibit-read-only t) - (inhibit-modification-hooks t)) - (widget-delete child) - (delete-region entry-from entry-to) - (set-marker entry-from nil) - (set-marker entry-to nil)) + (entry-to (widget-get child :entry-to))) + (widget--allow-insertion + (widget-delete child) + (delete-region entry-from entry-to) + (set-marker entry-from nil) + (set-marker entry-to nil))) (widget-put widget :children (delq child (widget-get widget :children)))) (widget-setup) (widget-apply widget :notify widget)) -- cgit v1.2.3 From 129bc91a2c9b7a6e314b4a5a4c60c266ca1cac0f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 21 Mar 2024 12:08:02 -0400 Subject: wid-edit.el: Cosmetic changes * lisp/wid-edit.el: Use #' to quote function names. (widget--simplify-menu, widget-echo-help): Explicitly specify the lexenv to `eval`. (widget-choose, widget-get-sibling, widget-setup, widget-field-find) (widget-choice-action, widget-checklist-value-get) (widget-radio-value-create, widget-radio-value-set) (widget-radio-action, widget-editable-list-delete-at) (widget-group-value-create, widget-choice-prompt-value): Use `dolist`. (widget-convert): Hoist `(setq current` out of the ifs. (widget-convert): Hoist `(setq keys` out of the if. (widget-after-change): Hoist `(setq begin` out of the if. (widget-default-completions): Use `cond`. (widget-default-value-set): Hoist `goto-char` out of the if. (widget-choice-action): Hoist `nth` out of the if. (widget-checkbox-action): Hoist `widget-apply` out of the if. (widget-editable-list-value-create): Hoist `car` out of the if. (widget-editable-list-entry-create): Hoist `(setq child ...` out of the if. (widget-documentation-link-action): Fold `if` into `cond`. (widget-key-sequence-value-to-external): Use `key-parse`. (widget-plist-convert-option, widget-alist-convert-option): Hoist `(setq key-type` out of the if. --- lisp/wid-edit.el | 363 ++++++++++++++++++++++++------------------------------- 1 file changed, 159 insertions(+), 204 deletions(-) (limited to 'lisp') diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 0645871f16d..f69a3d3b05f 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1,4 +1,4 @@ -;;; wid-edit.el --- Functions for creating and using widgets -*- lexical-binding:t -*- +;; wid-edit.el --- Functions for creating and using widgets -*- lexical-binding:t -*- ;; ;; Copyright (C) 1996-1997, 1999-2024 Free Software Foundation, Inc. ;; @@ -247,10 +247,10 @@ to evaluate to nil for the menu item to be meaningful." (eq (car value) :radio)) (setq selected (cdr value)))) (setq plist (cddr plist))) - (when (and (eval visible) - (eval enable) + (when (and (eval visible t) + (eval enable t) (or (not selected) - (not (eval selected)))) + (not (eval selected t)))) (push (cons (nth 1 def) ev) simplified))))) extended) (reverse simplified))) @@ -317,7 +317,7 @@ in the key vector, as in the argument of `define-key'." (when (keymapp items) (setq items (widget--simplify-menu items))) ;; Read the choice of name from the minibuffer. - (setq items (cl-remove-if 'stringp items)) + (setq items (cl-remove-if #'stringp items)) (let ((val (completing-read (concat title ": ") items nil t))) (if (stringp val) (let ((try (try-completion val items))) @@ -330,12 +330,11 @@ in the key vector, as in the argument of `define-key'." ;; Construct a menu of the choices ;; and then use it for prompting for a single character. (let ((next-digit ?0) - alist choice some-choice-enabled value) + alist some-choice-enabled value) (with-current-buffer (get-buffer-create " widget-choose") (erase-buffer) (insert "Available choices:\n\n") - (while items - (setq choice (pop items)) + (dolist (choice items) (when (consp choice) (insert (format "%c = %s\n" next-digit (car choice))) (push (cons next-digit (cdr choice)) alist) @@ -665,12 +664,9 @@ The current value is assumed to be VALUE, unless UNBOUND is non-nil." (defun widget-get-sibling (widget) "Get the item WIDGET is assumed to toggle. This is only meaningful for radio buttons or checkboxes in a list." - (let* ((children (widget-get (widget-get widget :parent) :children)) - child) + (let* ((children (widget-get (widget-get widget :parent) :children))) (catch 'child - (while children - (setq child (car children) - children (cdr children)) + (dolist (child children) (when (eq (widget-get child :button) widget) (throw 'child child))) nil))) @@ -850,14 +846,14 @@ button is pressed or inactive, respectively. These are currently ignored." (defun widget-create (type &rest args) "Create widget of TYPE. The optional ARGS are additional keyword arguments." - (let ((widget (apply 'widget-convert type args))) + (let ((widget (apply #'widget-convert type args))) (widget-apply widget :create) widget)) (defun widget-create-child-and-convert (parent type &rest args) "As part of the widget PARENT, create a child widget TYPE. The child is converted, using the keyword arguments ARGS." - (let ((widget (apply 'widget-convert type args))) + (let ((widget (apply #'widget-convert type args))) (widget-put widget :parent parent) (unless (widget-get widget :indent) (widget-put widget :indent (+ (or (widget-get parent :indent) 0) @@ -911,18 +907,19 @@ The optional ARGS are additional keyword arguments." (keys args)) ;; First set the :args keyword. (while (cdr current) ;Look in the type. - (if (and (keywordp (cadr current)) - ;; If the last element is a keyword, - ;; it is still the :args element, - ;; even though it is a keyword. - (cddr current)) - (if (eq (cadr current) :args) - ;; If :args is explicitly specified, obey it. - (setq current nil) - ;; Some other irrelevant keyword. - (setq current (cdr (cdr current)))) - (setcdr current (list :args (cdr current))) - (setq current nil))) + (setq current + (if (and (keywordp (cadr current)) + ;; If the last element is a keyword, + ;; it is still the :args element, + ;; even though it is a keyword. + (cddr current)) + (if (eq (cadr current) :args) + ;; If :args is explicitly specified, obey it. + nil + ;; Some other irrelevant keyword. + (cdr (cdr current))) + (setcdr current (list :args (cdr current))) + nil))) (while (and args (not done)) ;Look in ARGS. (cond ((eq (car args) :args) ;; Handle explicit specification of :args. @@ -943,11 +940,9 @@ The optional ARGS are additional keyword arguments." ;; Finally set the keyword args. (while keys (let ((next (nth 0 keys))) - (if (keywordp next) - (progn - (widget-put widget next (nth 1 keys)) - (setq keys (nthcdr 2 keys))) - (setq keys nil)))) + (setq keys (when (keywordp next) + (widget-put widget next (nth 1 keys)) + (nthcdr 2 keys))))) ;; Convert the :value to internal format. (if (widget-member widget :value) (widget-put widget @@ -972,7 +967,7 @@ and TO will be used as the widgets end points. If optional arguments BUTTON-FROM and BUTTON-TO are given, these will be used as the widgets button end points. Optional ARGS are extra keyword arguments for TYPE." - (let ((widget (apply 'widget-convert type :delete 'widget-leave-text args)) + (let ((widget (apply #'widget-convert type :delete 'widget-leave-text args)) (from (copy-marker from)) (to (copy-marker to))) (set-marker-insertion-type from t) @@ -989,7 +984,7 @@ Optional ARGS are extra keyword arguments for TYPE. No text will be inserted to the buffer, instead the text between FROM and TO will be used as the widgets end points, as well as the widgets button end points." - (apply 'widget-convert-text type from to from to args)) + (apply #'widget-convert-text type from to from to args)) (defun widget-leave-text (widget) "Remove markers and overlays from WIDGET and its children." @@ -1007,7 +1002,7 @@ button end points." (delete-overlay doc)) (when field (delete-overlay field)) - (mapc 'widget-leave-text (widget-get widget :children)))) + (mapc #'widget-leave-text (widget-get widget :children)))) (defun widget-text (widget) "Get the text representation of the widget." @@ -1022,7 +1017,7 @@ button end points." ;; Custom-mode) which key-binding of widget-keymap one wants to refer to. ;; https://lists.gnu.org/r/emacs-devel/2008-11/msg00480.html (define-obsolete-function-alias 'advertised-widget-backward - 'widget-backward "23.2") + #'widget-backward "23.2") ;;;###autoload (defvar widget-keymap @@ -1048,13 +1043,13 @@ Note that such modes will need to require wid-edit.") (defvar widget-field-keymap (let ((map (copy-keymap widget-keymap))) - (define-key map "\C-k" 'widget-kill-line) - (define-key map "\M-\t" 'widget-complete) - (define-key map "\C-m" 'widget-field-activate) + (define-key map "\C-k" #'widget-kill-line) + (define-key map "\M-\t" #'widget-complete) + (define-key map "\C-m" #'widget-field-activate) ;; Since the widget code uses a `field' property to identify fields, ;; ordinary beginning-of-line does the right thing. - ;; (define-key map "\C-a" 'widget-beginning-of-line) - (define-key map "\C-e" 'widget-end-of-line) + ;; (define-key map "\C-a" #'widget-beginning-of-line) + (define-key map "\C-e" #'widget-end-of-line) map) "Keymap used inside an editable field.") @@ -1062,8 +1057,8 @@ Note that such modes will need to require wid-edit.") (let ((map (copy-keymap widget-keymap))) ;; Since the widget code uses a `field' property to identify fields, ;; ordinary beginning-of-line does the right thing. - ;; (define-key map "\C-a" 'widget-beginning-of-line) - (define-key map "\C-e" 'widget-end-of-line) + ;; (define-key map "\C-a" #'widget-beginning-of-line) + (define-key map "\C-e" #'widget-end-of-line) map) "Keymap used inside a text field.") @@ -1304,7 +1299,7 @@ With optional ARG, move across that many fields." ;; Since the widget code uses a `field' property to identify fields, ;; ordinary beginning-of-line does the right thing. -(defalias 'widget-beginning-of-line 'beginning-of-line) +(defalias 'widget-beginning-of-line #'beginning-of-line) (defun widget-end-of-line () "Go to end of field or end of line, whichever is first. @@ -1382,17 +1377,14 @@ When not inside a field, signal an error." (defun widget-setup () "Setup current buffer so editing string widgets works." (widget--allow-insertion - (let (field) - (while widget-field-new - (setq field (car widget-field-new) - widget-field-new (cdr widget-field-new) - widget-field-list (cons field widget-field-list)) - (let ((from (car (widget-get field :field-overlay))) - (to (cdr (widget-get field :field-overlay)))) - (widget-specify-field field - (marker-position from) (marker-position to)) - (set-marker from nil) - (set-marker to nil))))) + (dolist (field widget-field-new) + (push field widget-field-list) + (let ((from (car (widget-get field :field-overlay))) + (to (cdr (widget-get field :field-overlay)))) + (widget-specify-field field + (marker-position from) (marker-position to)) + (set-marker from nil) + (set-marker to nil)))) (widget-clear-undo) (widget-add-change)) @@ -1467,11 +1459,8 @@ When not inside a field, signal an error." (defun widget-field-find (pos) "Return the field at POS. Unlike (get-char-property POS \\='field), this works with empty fields too." - (let ((fields widget-field-list) - field found) - (while fields - (setq field (car fields) - fields (cdr fields)) + (let (found) + (dolist (field widget-field-list) (when (and (<= (widget-field-start field) pos) (<= pos (widget-field-end field))) (when found @@ -1486,11 +1475,11 @@ Unlike (get-char-property POS \\='field), this works with empty fields too." (let ((from-field (widget-field-find from)) (to-field (widget-field-find to))) (cond ((not (eq from-field to-field)) - (add-hook 'post-command-hook 'widget-add-change nil t) + (add-hook 'post-command-hook #'widget-add-change nil t) (signal 'text-read-only '("Change should be restricted to a single field"))) ((null from-field) - (add-hook 'post-command-hook 'widget-add-change nil t) + (add-hook 'post-command-hook #'widget-add-change nil t) (signal 'text-read-only '("Attempt to change text outside editable field"))) (widget-field-use-before-change @@ -1498,9 +1487,9 @@ Unlike (get-char-property POS \\='field), this works with empty fields too." from-field (list 'before-change from to))))))) (defun widget-add-change () - (remove-hook 'post-command-hook 'widget-add-change t) - (add-hook 'before-change-functions 'widget-before-change nil t) - (add-hook 'after-change-functions 'widget-after-change nil t)) + (remove-hook 'post-command-hook #'widget-add-change t) + (add-hook 'before-change-functions #'widget-before-change nil t) + (add-hook 'after-change-functions #'widget-after-change nil t)) (defun widget-after-change (from to _old) "Adjust field size and text properties." @@ -1520,12 +1509,12 @@ Unlike (get-char-property POS \\='field), this works with empty fields too." (insert-char ?\s (- (+ begin size) end)))) ((> (- end begin) size) ;; Field too large and - (if (or (< (point) (+ begin size)) - (> (point) end)) - ;; Point is outside extra space. - (setq begin (+ begin size)) - ;; Point is within the extra space. - (setq begin (point))) + (setq begin (if (or (< (point) (+ begin size)) + (> (point) end)) + ;; Point is outside extra space. + (+ begin size) + ;; Point is within the extra space. + (point))) (save-excursion (goto-char end) (while (and (eq (preceding-char) ?\s) @@ -1545,9 +1534,9 @@ Optional EVENT is the event that triggered the action." (defun widget-children-value-delete (widget) "Delete all :children and :buttons in WIDGET." - (mapc 'widget-delete (widget-get widget :children)) + (mapc #'widget-delete (widget-get widget :children)) (widget-put widget :children nil) - (mapc 'widget-delete (widget-get widget :buttons)) + (mapc #'widget-delete (widget-get widget :buttons)) (widget-put widget :buttons nil)) (defun widget-children-validate (widget) @@ -1598,13 +1587,13 @@ The value of the :type attribute should be an unconverted widget type." (defun widget-types-copy (widget) "Copy :args as widget types in WIDGET." - (widget-put widget :args (mapcar 'widget-copy (widget-get widget :args))) + (widget-put widget :args (mapcar #'widget-copy (widget-get widget :args))) widget) ;; Made defsubst to speed up face editor creation. (defsubst widget-types-convert-widget (widget) "Convert :args as widget types in WIDGET." - (widget-put widget :args (mapcar 'widget-convert (widget-get widget :args))) + (widget-put widget :args (mapcar #'widget-convert (widget-get widget :args))) widget) (defun widget-value-convert-widget (widget) @@ -1659,17 +1648,18 @@ The value of the :type attribute should be an unconverted widget type." (defun widget-default-completions (widget) "Return completion data, like `completion-at-point-functions' would." (let ((completions (widget-get widget :completions))) - (if completions - (list (widget-field-start widget) - (max (point) (widget-field-text-end widget)) - completions) - (if (widget-get widget :complete) - (lambda () (widget-apply widget :complete)) - (if (widget-get widget :complete-function) - (lambda () - (let ((widget--completing-widget widget)) - (call-interactively - (widget-get widget :complete-function))))))))) + (cond + (completions + (list (widget-field-start widget) + (max (point) (widget-field-text-end widget)) + completions)) + ((widget-get widget :complete) + (lambda () (widget-apply widget :complete))) + ((widget-get widget :complete-function) + (lambda () + (let ((widget--completing-widget widget)) + (call-interactively + (widget-get widget :complete-function)))))))) (defun widget-default-create (widget) "Create WIDGET at point in the current buffer." @@ -1814,9 +1804,9 @@ The value of the :type attribute should be an unconverted widget type." (widget-put widget :value value) (widget-apply widget :create)) (if offset - (if (< offset 0) - (goto-char (+ (widget-get widget :to) offset 1)) - (goto-char (min (+ from offset) (1- (widget-get widget :to)))))))) + (goto-char (if (< offset 0) + (+ (widget-get widget :to) offset 1) + (min (+ from offset) (1- (widget-get widget :to)))))))) (defun widget-default-value-inline (widget) "Wrap value in a list unless it is inline." @@ -1979,8 +1969,8 @@ as the argument to `documentation-property'." ;; Only bind mouse-2, since mouse-1 will be translated accordingly to ;; the customization of `mouse-1-click-follows-link'. (define-key map [down-mouse-1] (lookup-key widget-global-map [down-mouse-1])) - (define-key map [down-mouse-2] 'widget-button-click) - (define-key map [mouse-2] 'widget-button-click) + (define-key map [down-mouse-2] #'widget-button-click) + (define-key map [mouse-2] #'widget-button-click) map) "Keymap used inside a link widget.") @@ -2328,13 +2318,10 @@ when he invoked the menu." ((and widget-choice-toggle (= (length args) 2) (memq old args)) - (if (eq old (nth 0 args)) - (nth 1 args) - (nth 0 args))) + (nth (if (eq old (nth 0 args)) 1 0) + args)) (t - (while args - (setq current (car args) - args (cdr args)) + (dolist (current args) (setq choices (cons (cons (widget-apply current :menu-tag-get) current) @@ -2427,9 +2414,8 @@ when he invoked the menu." (widget-toggle-action widget event) (let ((sibling (widget-get-sibling widget))) (when sibling - (if (widget-value widget) - (widget-apply sibling :activate) - (widget-apply sibling :deactivate)) + (widget-apply sibling + (if (widget-value widget) :activate :deactivate)) (widget-clear-undo)))) ;;; The `checklist' Widget. @@ -2478,7 +2464,7 @@ If the item is checked, CHOSEN is a cons whose cdr is the value." (cond ((eq escape ?%) (insert ?%)) ((eq escape ?b) - (setq button (apply 'widget-create-child-and-convert + (setq button (apply #'widget-create-child-and-convert widget 'checkbox :value (not (null chosen)) button-args))) @@ -2558,11 +2544,8 @@ Return an alist of (TYPE MATCH)." (defun widget-checklist-value-get (widget) ;; The values of all selected items. - (let ((children (widget-get widget :children)) - child result) - (while children - (setq child (car children) - children (cdr children)) + (let (result) + (dolist (child (widget-get widget :children)) (if (widget-value (widget-get child :button)) (setq result (append result (widget-apply child :value-inline))))) result)) @@ -2630,12 +2613,8 @@ Return an alist of (TYPE MATCH)." (defun widget-radio-value-create (widget) ;; Insert all values - (let ((args (widget-get widget :args)) - arg) - (while args - (setq arg (car args) - args (cdr args)) - (widget-radio-add-item widget arg)))) + (dolist (arg (widget-get widget :args)) + (widget-radio-add-item widget arg))) (defun widget-radio-add-item (widget type) "Add to radio widget WIDGET a new radio button item of type TYPE." @@ -2662,7 +2641,7 @@ Return an alist of (TYPE MATCH)." (cond ((eq escape ?%) (insert ?%)) ((eq escape ?b) - (setq button (apply 'widget-create-child-and-convert + (setq button (apply #'widget-create-child-and-convert widget 'radio-button :value (not (null chosen)) button-args))) @@ -2718,11 +2697,8 @@ Return an alist of (TYPE MATCH)." ;; We can't just delete and recreate a radio widget, since children ;; can be added after the original creation and won't be recreated ;; by `:create'. - (let ((children (widget-get widget :children)) - current found) - (while children - (setq current (car children) - children (cdr children)) + (let (found) + (dolist (current (widget-get widget :children)) (let* ((button (widget-get current :button)) (match (and (not found) (widget-apply current :match value)))) @@ -2749,13 +2725,9 @@ Return an alist of (TYPE MATCH)." (defun widget-radio-action (widget child event) ;; Check if a radio button was pressed. - (let ((children (widget-get widget :children)) - (buttons (widget-get widget :buttons)) - current) + (let ((buttons (widget-get widget :buttons))) (when (memq child buttons) - (while children - (setq current (car children) - children (cdr children)) + (dolist (current (widget-get widget :children)) (let* ((button (widget-get current :button))) (cond ((eq child button) (widget-value-set button t) @@ -2825,7 +2797,7 @@ Return an alist of (TYPE MATCH)." (and (widget--should-indent-p) (widget-get widget :indent) (insert-char ?\s (widget-get widget :indent))) - (apply 'widget-create-child-and-convert + (apply #'widget-create-child-and-convert widget 'insert-button (widget-get widget :append-button-args))) (t @@ -2845,9 +2817,9 @@ Return an alist of (TYPE MATCH)." (if answer (setq children (cons (widget-editable-list-entry-create widget - (if (widget-inline-p type t) - (car answer) - (car (car answer))) + (car (if (widget-inline-p type t) + answer + (car answer))) t) children) value (cdr answer)) @@ -2856,8 +2828,8 @@ Return an alist of (TYPE MATCH)." (defun widget-editable-list-value-get (widget) ;; Get value of the child widget. - (apply 'append (mapcar (lambda (child) (widget-apply child :value-inline)) - (widget-get widget :children)))) + (apply #'append (mapcar (lambda (child) (widget-apply child :value-inline)) + (widget-get widget :children)))) (defun widget-editable-list-match (widget value) ;; Value must be a list and all the members must match the type. @@ -2923,16 +2895,12 @@ Save CHILD into the :last-deleted list, so it can be inserted later." (widget-put widget :last-deleted lst)) ;; Delete child from list of children. (save-excursion - (let ((buttons (copy-sequence (widget-get widget :buttons))) - button) - (widget--allow-insertion - (while buttons - (setq button (car buttons) - buttons (cdr buttons)) - (when (eq (widget-get button :widget) child) - (widget-put widget - :buttons (delq button (widget-get widget :buttons))) - (widget-delete button))))) + (widget--allow-insertion + (dolist (button (copy-sequence (widget-get widget :buttons))) + (when (eq (widget-get button :widget) child) + (widget-put widget + :buttons (delq button (widget-get widget :buttons))) + (widget-delete button)))) (let ((entry-from (widget-get child :entry-from)) (entry-to (widget-get child :entry-to))) (widget--allow-insertion @@ -2962,19 +2930,17 @@ Save CHILD into the :last-deleted list, so it can be inserted later." (cond ((eq escape ?%) (insert ?%)) ((eq escape ?i) - (setq insert (apply 'widget-create-child-and-convert + (setq insert (apply #'widget-create-child-and-convert widget 'insert-button (widget-get widget :insert-button-args)))) ((eq escape ?d) - (setq delete (apply 'widget-create-child-and-convert + (setq delete (apply #'widget-create-child-and-convert widget 'delete-button (widget-get widget :delete-button-args)))) ((eq escape ?v) - (if conv - (setq child (widget-create-child-value - widget type value)) - (setq child (widget-create-child-value - widget type (widget-default-get type))))) + (setq child (widget-create-child-value + widget type + (if conv value (widget-default-get type))))) (t (error "Unknown escape `%c'" escape))))) (let ((buttons (widget-get widget :buttons))) @@ -3014,13 +2980,10 @@ Save CHILD into the :last-deleted list, so it can be inserted later." (defun widget-group-value-create (widget) ;; Create each component. - (let ((args (widget-get widget :args)) - (value (widget-get widget :value)) - arg answer children) - (while args - (setq arg (car args) - args (cdr args) - answer (widget-match-inline arg value) + (let ((value (widget-get widget :value)) + answer children) + (dolist (arg (widget-get widget :args)) + (setq answer (widget-match-inline arg value) value (cdr answer)) (and (widget--should-indent-p) (widget-get widget :indent) @@ -3036,7 +2999,7 @@ Save CHILD into the :last-deleted list, so it can be inserted later." (defun widget-group-default-get (widget) ;; Get the default of the components. - (mapcar 'widget-default-get (widget-get widget :args))) + (mapcar #'widget-default-get (widget-get widget :args))) (defun widget-group-match (widget vals) ;; Match if the components match. @@ -3094,20 +3057,20 @@ The following properties have special meanings for this widget: "Display documentation for WIDGET's value. Ignore optional argument EVENT." (let* ((string (widget-get widget :value)) (symbol (intern string))) - (if (and (fboundp symbol) (boundp symbol)) - ;; If there are two doc strings, give the user a way to pick one. - (apropos (concat "\\`" (regexp-quote string) "\\'")) - (cond - ((fboundp symbol) - (describe-function symbol)) - ((facep symbol) - (describe-face symbol)) - ((featurep symbol) - (describe-package symbol)) - ((or (boundp symbol) (get symbol 'variable-documentation)) - (describe-variable symbol)) - (t - (message "No documentation available for %s" symbol)))))) + (cond + ((and (fboundp symbol) (boundp symbol)) + ;; If there are two doc strings, give the user a way to pick one. + (apropos (concat "\\`" (regexp-quote string) "\\'"))) + ((fboundp symbol) + (describe-function symbol)) + ((facep symbol) + (describe-face symbol)) + ((featurep symbol) + (describe-package symbol)) + ((or (boundp symbol) (get symbol 'variable-documentation)) + (describe-variable symbol)) + (t + (message "No documentation available for %s" symbol))))) (defcustom widget-documentation-links t "Add hyperlinks to documentation strings when non-nil." @@ -3240,7 +3203,7 @@ Optional ARGS specifies additional keyword arguments for the (unless (or (numberp doc-indent) (null doc-indent)) (setq doc-indent 0)) (widget-put widget :buttons - (cons (apply 'widget-create-child-and-convert + (cons (apply #'widget-create-child-and-convert widget 'documentation-string :indent doc-indent (nconc args (list doc))) @@ -3352,18 +3315,18 @@ It reads a file name from an editable text field." (must-match (widget-get widget :must-match))) (read-file-name (format-prompt prompt value) dir nil must-match file))))) -;;;(defun widget-file-action (widget &optional event) -;;; ;; Read a file name from the minibuffer. -;;; (let* ((value (widget-value widget)) -;;; (dir (file-name-directory value)) -;;; (file (file-name-nondirectory value)) -;;; (menu-tag (widget-apply widget :menu-tag-get)) -;;; (must-match (widget-get widget :must-match)) -;;; (answer (read-file-name (format-prompt menu-tag value) -;;; dir nil must-match file))) -;;; (widget-value-set widget (abbreviate-file-name answer)) -;;; (widget-setup) -;;; (widget-apply widget :notify widget event))) +;;(defun widget-file-action (widget &optional event) +;; ;; Read a file name from the minibuffer. +;; (let* ((value (widget-value widget)) +;; (dir (file-name-directory value)) +;; (file (file-name-nondirectory value)) +;; (menu-tag (widget-apply widget :menu-tag-get)) +;; (must-match (widget-get widget :must-match)) +;; (answer (read-file-name (format-prompt menu-tag value) +;; dir nil must-match file))) +;; (widget-value-set widget (abbreviate-file-name answer)) +;; (widget-setup) +;; (widget-apply widget :notify widget event))) ;; Fixme: use file-name-as-directory. (define-widget 'directory 'file @@ -3552,7 +3515,7 @@ It reads a directory name from an editable text field." (if (stringp value) (if (string-match "\\`[[:space:]]*\\'" value) widget-key-sequence-default-value - (read-kbd-macro value)) + (key-parse value)) value)) @@ -3825,7 +3788,7 @@ or a list with the default value of each component of the list WIDGET." :format "%{%t%}:\n%v" :match 'widget-vector-match :value-to-internal (lambda (_widget value) (append value nil)) - :value-to-external (lambda (_widget value) (apply 'vector value))) + :value-to-external (lambda (_widget value) (apply #'vector value))) (defun widget-vector-match (widget value) (and (vectorp value) @@ -3840,7 +3803,7 @@ or a list with the default value of each component of the list WIDGET." :value-to-internal (lambda (_widget value) (list (car value) (cdr value))) :value-to-external (lambda (_widget value) - (apply 'cons value))) + (apply #'cons value))) (defun widget-cons-match (widget value) (and (consp value) @@ -3927,7 +3890,7 @@ example: (args (if options (list `(checklist :inline t :greedy t - ,@(mapcar 'widget-plist-convert-option + ,@(mapcar #'widget-plist-convert-option options)) other) (list other)))) @@ -3940,9 +3903,7 @@ example: (if (listp option) (let ((key (nth 0 option))) (setq value-type (nth 1 option)) - (if (listp key) - (setq key-type key) - (setq key-type `(const ,key)))) + (setq key-type (if (listp key) key `(const ,key)))) (setq key-type `(const ,option) value-type widget-plist-value-type)) `(group :format "Key: %v" :inline t ,key-type ,value-type))) @@ -3972,7 +3933,7 @@ example: (args (if options (list `(checklist :inline t :greedy t - ,@(mapcar 'widget-alist-convert-option + ,@(mapcar #'widget-alist-convert-option options)) other) (list other)))) @@ -3985,9 +3946,7 @@ example: (if (listp option) (let ((key (nth 0 option))) (setq value-type (nth 1 option)) - (if (listp key) - (setq key-type key) - (setq key-type `(const ,key)))) + (setq key-type (if (listp key) key `(const ,key)))) (setq key-type `(const ,option) value-type widget-alist-value-type)) `(cons :format "Key: %v" ,key-type ,value-type))) @@ -4045,17 +4004,13 @@ current choice is inline." ((and widget-choice-toggle (= (length args) 2) (memq old args)) - (if (eq old (nth 0 args)) - (nth 1 args) - (nth 0 args))) + (nth (if (eq old (nth 0 args)) 1 0) + args)) (t - (while args - (setq current (car args) - args (cdr args)) - (setq choices - (cons (cons (widget-apply current :menu-tag-get) - current) - choices))) + (dolist (current args) + (push (cons (widget-apply current :menu-tag-get) + current) + choices)) (let ((val (completing-read prompt choices nil t))) (if (stringp val) (let ((try (try-completion val choices))) @@ -4206,7 +4161,7 @@ is inline." (help-echo (and widget (widget-get widget :help-echo)))) (if (functionp help-echo) (setq help-echo (funcall help-echo widget))) - (if help-echo (message "%s" (eval help-echo))))) + (if help-echo (message "%s" (eval help-echo t))))) (define-obsolete-function-alias 'widget-sublist #'seq-subseq "28.1") (define-obsolete-function-alias 'widget-visibility-value-create -- cgit v1.2.3 From e819413e24d81875abaf81c281115e695ad5cc28 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 21 Mar 2024 12:28:54 -0400 Subject: Speed up `describe-char` when a property has a large value Doing `C-u C-x =` on a buffer position where the overlay/text properties hold large values (e.g. inside the profiler report) can be surprisingly slow because it pretty prints all those properties. Change the code to do the pretty printing more lazily. While at it, share that duplicated code between `descr-text.el` and `wid-browse.el`. * lisp/emacs-lisp/pp.el (pp-insert-short-sexp): New function. * lisp/descr-text.el (describe-text-sexp): Delete function. (describe-property-list): Use `pp-insert-short-sexp` instead. * lisp/wid-browse.el (widget-browse-sexp): Use `pp-insert-short-sexp` and `widget--allow-insertion`. --- lisp/descr-text.el | 52 +++++++++++++++++---------------------------------- lisp/emacs-lisp/pp.el | 17 +++++++++++++++++ lisp/wid-browse.el | 34 ++++++++++----------------------- 3 files changed, 44 insertions(+), 59 deletions(-) (limited to 'lisp') diff --git a/lisp/descr-text.el b/lisp/descr-text.el index eeab995c37d..524a6474cd4 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -42,26 +42,6 @@ (insert-text-button "(widget)Top" 'type 'help-info 'help-args '("(widget)Top"))) -(defun describe-text-sexp (sexp) - "Insert a short description of SEXP in the current buffer." - (let ((pp (condition-case signal - (pp-to-string sexp) - (error (prin1-to-string signal))))) - (when (string-match-p "\n\\'" pp) - (setq pp (substring pp 0 (1- (length pp))))) - - (if (and (not (string-search "\n" pp)) - (<= (length pp) (- (window-width) (current-column)))) - (insert pp) - (insert-text-button - "[Show]" - 'follow-link t - 'action (lambda (&rest _ignore) - (with-output-to-temp-buffer - "*Pp Eval Output*" - (princ pp))) - 'help-echo "mouse-2, RET: pretty print value in another buffer")))) - (defun describe-property-list (properties) "Insert a description of PROPERTIES in the current buffer. PROPERTIES should be a list of overlay or text properties. @@ -92,7 +72,9 @@ into help buttons that call `describe-text-category' or (format "%S" value) 'type 'help-face 'help-args (list value))) (t - (describe-text-sexp value)))) + (require 'pp) + (declare-function pp-insert-short-sexp "pp" (sexp &optional width)) + (pp-insert-short-sexp value)))) (insert "\n"))) ;;; Describe-Text Commands. @@ -522,24 +504,24 @@ The character information includes: (setcar composition (concat " with the surrounding characters \"" - (mapconcat 'describe-char-padded-string - (buffer-substring from pos) "") + (mapconcat #'describe-char-padded-string + (buffer-substring from pos)) "\" and \"" - (mapconcat 'describe-char-padded-string - (buffer-substring (1+ pos) to) "") + (mapconcat #'describe-char-padded-string + (buffer-substring (1+ pos) to)) "\"")) (setcar composition (concat " with the preceding character(s) \"" - (mapconcat 'describe-char-padded-string - (buffer-substring from pos) "") + (mapconcat #'describe-char-padded-string + (buffer-substring from pos)) "\""))) (if (< (1+ pos) to) (setcar composition (concat " with the following character(s) \"" - (mapconcat 'describe-char-padded-string - (buffer-substring (1+ pos) to) "") + (mapconcat #'describe-char-padded-string + (buffer-substring (1+ pos) to)) "\"")) (setcar composition nil))) (setcar (cdr composition) @@ -568,7 +550,7 @@ The character information includes: ("character" ,(format "%s (displayed as %s) (codepoint %d, #o%o, #x%x)" char-description - (apply 'propertize char-description + (apply #'propertize char-description (text-properties-at pos)) char char char)) ("charset" @@ -620,7 +602,7 @@ The character information includes: (if (consp key-list) (list "type" (concat "\"" - (mapconcat 'identity + (mapconcat #'identity key-list "\" or \"") "\"") "with" @@ -721,7 +703,7 @@ The character information includes: (let ((unicodedata (describe-char-unicode-data char))) (if unicodedata (cons (list "Unicode data" "") unicodedata)))))) - (setq max-width (apply 'max (mapcar (lambda (x) + (setq max-width (apply #'max (mapcar (lambda (x) (if (cadr x) (length (car x)) 0)) item-list))) (set-buffer src-buf) @@ -736,7 +718,7 @@ The character information includes: (dolist (clm (cdr elt)) (cond ((eq (car-safe clm) 'insert-text-button) (insert " ") - (eval clm)) + (eval clm t)) ((not (zerop (length clm))) (insert " " clm)))) (insert "\n")))) @@ -855,7 +837,7 @@ The character information includes: (insert "\n") (dolist (elt (cond ((eq describe-char-unidata-list t) - (nreverse (mapcar 'car char-code-property-alist))) + (nreverse (mapcar #'car char-code-property-alist))) ((< char 32) ;; Temporary fix (2016-05-22): The ;; decomposition item for \n corrupts the @@ -898,7 +880,7 @@ characters." (setq width (- width (length (car last)) 1))) (let ((ellipsis (and (cdr last) "..."))) (setcdr last nil) - (concat (mapconcat 'identity words " ") ellipsis))) + (concat (mapconcat #'identity words " ") ellipsis))) ""))) (defun describe-char-eldoc--format (ch &optional width) diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 569f70ca604..de7468b3e38 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -346,6 +346,23 @@ after OUT-BUFFER-NAME." (setq buffer-read-only nil) (setq-local font-lock-verbose nil))))) +(defun pp-insert-short-sexp (sexp &optional width) + "Insert a short description of SEXP in the current buffer. +WIDTH is the maximum width to use for it and it defaults to the +space available between point and the window margin." + (let ((printed (format "%S" sexp))) + (if (and (not (string-search "\n" printed)) + (<= (string-width printed) + (or width (- (window-width) (current-column))))) + (insert printed) + (insert-text-button + "[Show]" + 'follow-link t + 'action (lambda (&rest _ignore) + ;; FIXME: Why "eval output"? + (pp-display-expression sexp "*Pp Eval Output*")) + 'help-echo "mouse-2, RET: pretty print value in another buffer")))) + ;;;###autoload (defun pp-eval-expression (expression) "Evaluate EXPRESSION and pretty-print its value. diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el index bb56f3f62fb..d4000187bd1 100644 --- a/lisp/wid-browse.el +++ b/lisp/wid-browse.el @@ -141,7 +141,7 @@ The following commands are available: (setq key (nth 0 items) value (nth 1 items) printer (or (get key 'widget-keyword-printer) - 'widget-browse-sexp) + #'widget-browse-sexp) items (cdr (cdr items))) (widget-insert "\n" (symbol-name key) "\n\t") (funcall printer widget key value) @@ -204,24 +204,10 @@ VALUE is assumed to be a list of widgets." (defun widget-browse-sexp (_widget _key value) "Insert description of WIDGET's KEY VALUE. Nothing is assumed about value." - (let ((pp (condition-case signal - (pp-to-string value) - (error (prin1-to-string signal))))) - (when (string-match "\n\\'" pp) - (setq pp (substring pp 0 (1- (length pp))))) - (if (cond ((string-search "\n" pp) - nil) - ((> (length pp) (- (window-width) (current-column))) - nil) - (t t)) - (widget-insert pp) - (widget-create 'push-button - :tag "show" - :action (lambda (widget &optional _event) - (with-output-to-temp-buffer - "*Pp Eval Output*" - (princ (widget-get widget :value)))) - pp)))) + (require 'pp) + (declare-function pp-insert-short-sexp "pp" (sexp &optional width)) + (widget--allow-insertion + (pp-insert-short-sexp value))) (defun widget-browse-sexps (widget key value) "Insert description of WIDGET's KEY VALUE. @@ -235,11 +221,11 @@ VALUE is assumed to be a list of widgets." ;;; Keyword Printers. -(put :parent 'widget-keyword-printer 'widget-browse-widget) -(put :children 'widget-keyword-printer 'widget-browse-widgets) -(put :buttons 'widget-keyword-printer 'widget-browse-widgets) -(put :button 'widget-keyword-printer 'widget-browse-widget) -(put :args 'widget-keyword-printer 'widget-browse-sexps) +(put :parent 'widget-keyword-printer #'widget-browse-widget) +(put :children 'widget-keyword-printer #'widget-browse-widgets) +(put :buttons 'widget-keyword-printer #'widget-browse-widgets) +(put :button 'widget-keyword-printer #'widget-browse-widget) +(put :args 'widget-keyword-printer #'widget-browse-sexps) ;;; Widget Minor Mode. -- cgit v1.2.3 From e95a8622263d8182e80777f87b7ca52cedbd1b28 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 21 Mar 2024 22:12:40 +0200 Subject: ; * lisp/keymap.el (key-parse): Fix processing of "[TAB]". (Bug#69893) --- lisp/keymap.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/keymap.el b/lisp/keymap.el index 065c59da74c..4bdf65d39fa 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -260,7 +260,7 @@ returned by \\[describe-key] (`describe-key')." (setq word (concat (match-string 1 word) (match-string 3 word))) (not (string-match - "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$" + "\\<\\(NUL\\|RET\\|LFD\\|TAB\\|ESC\\|SPC\\|DEL\\)$" word)))) (setq key (list (intern word)))) ((or (equal word "REM") (string-match "^;;" word)) -- cgit v1.2.3 From 05b8de54e30fdfccda78c5cfc2481828b897614b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 21 Mar 2024 18:16:41 -0400 Subject: byte-opt.el: Remove test that's not applicable any more * lisp/emacs-lisp/byte-opt.el: Remove left-over test for ancient byte-compiled representation. --- lisp/emacs-lisp/byte-opt.el | 1 - 1 file changed, 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index f75be3f71ad..f6df40a2d9b 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -3116,7 +3116,6 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; (eval-when-compile (or (compiled-function-p (symbol-function 'byte-optimize-form)) - (assq 'byte-code (symbol-function 'byte-optimize-form)) (let ((byte-optimize nil) (byte-compile-warnings nil)) (mapc (lambda (x) -- cgit v1.2.3 From 2000d6e0f27f9f34f343016f4aa93e09c29c8695 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 21 Mar 2024 18:27:03 -0400 Subject: (describe-symbol-backends): Fix addition of the "type" backend That backend was added from `cl-extra.el` with no autoload, so (describe-symbol `advice) failed to show the info about the `advice` type unless `cl-extra.el` had been loaded beforehand. `C-h o RET advice RET` worked by accident because the completion table uses `cl-some` which is autoloaded from `cl-extra.el`. * lisp/help-mode.el (describe-symbol-backends): Add the "type" backend. * lisp/emacs-lisp/cl-extra.el (describe-symbol-backends): Don't add the "type" backend here. --- lisp/emacs-lisp/cl-extra.el | 7 ------- lisp/help-mode.el | 3 +++ 2 files changed, 3 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index c8eaca9a77c..d43c21d3eb9 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -711,13 +711,6 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (eval-when-compile (require 'cl-macs)) ;Explicitly, for cl--find-class. (require 'help-mode) -;; FIXME: We could go crazy and add another entry so describe-symbol can be -;; used with the slot names of CL structs (and/or EIEIO objects). -(add-to-list 'describe-symbol-backends - `(nil ,#'cl-find-class ,#'cl-describe-type) - ;; Document the `cons` function before the `cons` type. - t) - (defconst cl--typedef-regexp (concat "(" (regexp-opt '("defclass" "defstruct" "cl-defstruct" "cl-deftype" "deftype")) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index f9ec8a5cc2b..dd78342ace7 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -545,6 +545,9 @@ it does not already exist." (or (and (boundp symbol) (not (keywordp symbol))) (get symbol 'variable-documentation))) ,#'describe-variable) + ;; FIXME: We could go crazy and add another entry so describe-symbol can be + ;; used with the slot names of CL structs (and/or EIEIO objects). + ("type" ,#'cl-find-class ,#'cl-describe-type) ("face" ,#'facep ,(lambda (s _b _f) (describe-face s)))) "List of providers of information about symbols. Each element has the form (NAME TESTFUN DESCFUN) where: -- cgit v1.2.3 From c214fc9626c8b37e4d155a6d3caebe2e09fd0ab2 Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Thu, 21 Mar 2024 23:55:38 +0100 Subject: Update to Transient v0.6.0-1-gcaef3347 --- doc/misc/transient.texi | 28 +++-- lisp/transient.el | 279 +++++++++++++++++++++++++++++++----------------- 2 files changed, 202 insertions(+), 105 deletions(-) (limited to 'lisp') diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi index f76edc6b1e4..3a6486903bf 100644 --- a/doc/misc/transient.texi +++ b/doc/misc/transient.texi @@ -31,7 +31,7 @@ General Public License for more details. @finalout @titlepage @title Transient User and Developer Manual -@subtitle for version 0.5.2 +@subtitle for version 0.6.0 @author Jonas Bernoulli @page @vskip 0pt plus 1filll @@ -53,7 +53,7 @@ resource to get over that hurdle is Psionic K's interactive tutorial, available at @uref{https://github.com/positron-solutions/transient-showcase}. @noindent -This manual is for Transient version 0.5.2. +This manual is for Transient version 0.6.0. @insertcopying @end ifnottex @@ -554,7 +554,7 @@ state, you have to make sure that that state is currently active. @item @kbd{C-x a} (@code{transient-toggle-level-limit}) @kindex C-x a @findex transient-toggle-level-limit -This command toggle whether suffixes that are on levels lower than +This command toggle whether suffixes that are on levels higher than the level specified by @code{transient-default-level} are temporarily available anyway. @end table @@ -1206,9 +1206,19 @@ The returned children must have the same form as stored in the prefix's @code{transient--layout} property, but it is often more convenient to use the same form as understood by @code{transient-define-prefix}, described below. If you use the latter approach, you can use the -@code{transient-parse-child} and @code{transient-parse-children} functions to +@code{transient-parse-suffixes} and @code{transient-parse-suffix} functions to transform them from the convenient to the expected form. +If you explicitly specify children and then transform them using +@code{:setup-chilren}, then the class of the group is determined as usual, +based on explicitly specified children. + +If you do not explicitly specify children and thus rely solely on +@code{:setup-children}, then you must specify the class using @code{:class}. +For backward compatibility, if you fail to do so, @code{transient-column} +is used and a warning is displayed. This warning will eventually +be replaced with an error. + @item The boolean @code{:pad-keys} argument controls whether keys of all suffixes contained in a group are right padded, effectively aligning the @@ -1220,11 +1230,11 @@ The @var{ELEMENT}s are either all subgroups, or all suffixes and strings. subgroups with commands at the same level, though in principle there is nothing that prevents that.) -If the @var{ELEMENT}s are not subgroups, then they can be a mixture of lists -that specify commands and strings. Strings are inserted verbatim into -the buffer. The empty string can be used to insert gaps between -suffixes, which is particularly useful if the suffixes are outlined as -a table. +If the @var{ELEMENT}s are not subgroups, then they can be a mixture of +lists, which specify commands, and strings. Strings are inserted +verbatim into the buffer. The empty string can be used to insert gaps +between suffixes, which is particularly useful if the suffixes are +outlined as a table. Inside group specifications, including inside contained suffix specifications, nothing has to be quoted and quoting anyway is diff --git a/lisp/transient.el b/lisp/transient.el index bb35746e186..2d8566a3ac4 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -5,7 +5,7 @@ ;; Author: Jonas Bernoulli ;; URL: https://github.com/magit/transient ;; Keywords: extensions -;; Version: 0.5.2 +;; Version: 0.6.0 ;; SPDX-License-Identifier: GPL-3.0-or-later @@ -93,17 +93,20 @@ enclosed in a `progn' form. ELSE-FORMS may be empty." then-form (cons 'progn else-forms))) -(defmacro transient--with-emergency-exit (&rest body) +(defmacro transient--with-emergency-exit (id &rest body) (declare (indent defun)) + (unless (keywordp id) + (setq body (cons id body)) + (setq id nil)) `(condition-case err (let ((debugger #'transient--exit-and-debug)) ,(macroexp-progn body)) ((debug error) - (transient--emergency-exit) + (transient--emergency-exit ,id) (signal (car err) (cdr err))))) (defun transient--exit-and-debug (&rest args) - (transient--emergency-exit) + (transient--emergency-exit :debugger) (apply #'debug args)) ;;; Options @@ -668,6 +671,7 @@ If `transient-save-history' is nil, then do nothing." (incompatible :initarg :incompatible :initform nil) (suffix-description :initarg :suffix-description) (variable-pitch :initarg :variable-pitch :initform nil) + (column-widths :initarg :column-widths :initform nil) (unwind-suffix :documentation "Internal use." :initform nil)) "Transient prefix command. @@ -725,7 +729,8 @@ slot is non-nil." :abstract t) (defclass transient-suffix (transient-child) - ((key :initarg :key) + ((definition :allocation :class :initform nil) + (key :initarg :key) (command :initarg :command) (transient :initarg :transient) (format :initarg :format :initform " %k %d") @@ -946,7 +951,10 @@ ARGLIST. The infix arguments are usually accessed by using (pcase-let ((`(,class ,slots ,_ ,docstr ,body) (transient--expand-define-args args arglist))) `(progn - (defalias ',name (lambda ,arglist ,@body)) + (defalias ',name + ,(if (and (not body) class (oref-default class definition)) + `(oref-default ',class definition) + `(lambda ,arglist ,@body))) (put ',name 'interactive-only t) (put ',name 'function-documentation ,docstr) (put ',name 'transient--suffix @@ -997,7 +1005,7 @@ keyword. `(progn (defalias ',name #'transient--default-infix-command) (put ',name 'interactive-only t) - (put ',name 'command-modes (list 'not-a-mode)) + (put ',name 'completion-predicate #'transient--suffix-only) (put ',name 'function-documentation ,docstr) (put ',name 'transient--suffix (,(or class 'transient-switch) :command ',name ,@slots))))) @@ -1013,21 +1021,39 @@ example, sets a variable, use `transient-define-infix' instead. (defun transient--default-infix-command () ;; Most infix commands are but an alias for this command. - "Cannot show any documentation for this anonymous infix command. + "Cannot show any documentation for this transient infix command. + +When you request help for an infix command using `transient-help', that +usually shows the respective man-page and tries to jump to the location +where the respective argument is being described. -This infix command was defined anonymously, i.e., it was define -inside a call to `transient-define-prefix'. +If no man-page is specified for the containing transient menu, then the +docstring is displayed instead, if any. -When you request help for such an infix command, then we usually -show the respective man-page and jump to the location where the -respective argument is being described. This isn't possible in -this case, because the `man-page' slot was not set in this case." +If the infix command doesn't have a docstring, as is the case here, then +this docstring is displayed instead, because technically infix commands +are aliases for `transient--default-infix-command'. + +`describe-function' also shows the docstring of the infix command, +falling back to that of the same aliased command." (interactive) (let ((obj (transient-suffix-object))) (transient-infix-set obj (transient-infix-read obj))) (transient--show)) (put 'transient--default-infix-command 'interactive-only t) -(put 'transient--default-infix-command 'command-modes (list 'not-a-mode)) +(put 'transient--default-infix-command 'completion-predicate + #'transient--suffix-only) + +(defun transient--find-function-advised-original (fn func) + "Return nil instead of `transient--default-infix-command'. +When using `find-function' to jump to the definition of a transient +infix command/argument, then we want to actually jump to that, not to +the definition of `transient--default-infix-command', which all infix +commands are aliases for." + (let ((val (funcall fn func))) + (and val (not (eq val 'transient--default-infix-command)) val))) +(advice-add 'find-function-advised-original :around + #'transient--find-function-advised-original) (eval-and-compile (defun transient--expand-define-args (args &optional arglist) @@ -1056,7 +1082,8 @@ this case, because the `man-page' slot was not set in this case." args)))) (defun transient--parse-child (prefix spec) - (cl-etypecase spec + (cl-typecase spec + (null (error "Invalid transient--parse-child spec: %s" spec)) (symbol (let ((value (symbol-value spec))) (if (and (listp value) (or (listp (car value)) @@ -1065,7 +1092,8 @@ this case, because the `man-page' slot was not set in this case." (transient--parse-child prefix value)))) (vector (and-let* ((c (transient--parse-group prefix spec))) (list c))) (list (and-let* ((c (transient--parse-suffix prefix spec))) (list c))) - (string (list spec)))) + (string (list spec)) + (t (error "Invalid transient--parse-child spec: %s" spec)))) (defun transient--parse-group (prefix spec) (setq spec (append spec nil)) @@ -1086,12 +1114,16 @@ this case, because the `man-page' slot was not set in this case." (and (listp val) (not (eq (car val) 'lambda)))) (setq args (plist-put args key (macroexp-quote val)))) ((setq args (plist-put args key val)))))) + (unless (or spec class (not (plist-get args :setup-children))) + (message "WARNING: %s: When %s is used, %s must also be specified" + 'transient-define-prefix :setup-children :class)) (list 'vector (or level transient--default-child-level) - (or class - (if (vectorp car) - (quote 'transient-columns) - (quote 'transient-column))) + (cond (class) + ((or (vectorp car) + (and car (symbolp car))) + (quote 'transient-columns)) + ((quote 'transient-column))) (and args (cons 'list args)) (cons 'list (cl-mapcan (lambda (s) (transient--parse-child prefix s)) @@ -1130,14 +1162,15 @@ this case, because the `man-page' slot was not set in this case." (format "transient:%s:%s" prefix (let ((desc (plist-get args :description))) - (if (and desc (or (stringp desc) (symbolp desc))) + (if (and (stringp desc) + (length< desc 16)) desc (plist-get args :key))))))) (setq args (plist-put args :command `(prog1 ',sym (put ',sym 'interactive-only t) - (put ',sym 'command-modes (list 'not-a-mode)) + (put ',sym 'completion-predicate #'transient--suffix-only) (defalias ',sym ,(if (eq (car-safe cmd) 'lambda) cmd @@ -1160,7 +1193,7 @@ this case, because the `man-page' slot was not set in this case." args :command `(prog1 ',sym (put ',sym 'interactive-only t) - (put ',sym 'command-modes (list 'not-a-mode)) + (put ',sym 'completion-predicate #'transient--suffix-only) (defalias ',sym #'transient--default-infix-command)))) (cond ((and car (not (keywordp car))) (setq class 'transient-option) @@ -1198,12 +1231,33 @@ this case, because the `man-page' slot was not set in this case." (and (string-match "\\`\\(-[a-zA-Z]\\)\\(\\'\\|=\\)" arg) (match-string 1 arg)))) +(defun transient-command-completion-not-suffix-only-p (symbol _buffer) + "Say whether SYMBOL should be offered as a completion. +If the value of SYMBOL's `completion-predicate' property is +`transient--suffix-only', then return nil, otherwise return t. +This is the case when a command should only ever be used as a +suffix of a transient prefix command (as opposed to bindings +in regular keymaps or by using `execute-extended-command')." + (not (eq (get symbol 'completion-predicate) 'transient--suffix-only))) + +(defalias 'transient--suffix-only #'ignore + "Ignore ARGUMENTS, do nothing, and return nil. +Also see `transient-command-completion-not-suffix-only-p'. +Only use this alias as the value of the `completion-predicate' +symbol property.") + +(when (and (boundp 'read-extended-command-predicate) ; since Emacs 28.1 + (not read-extended-command-predicate)) + (setq read-extended-command-predicate + 'transient-command-completion-not-suffix-only-p)) + (defun transient-parse-suffix (prefix suffix) "Parse SUFFIX, to be added to PREFIX. PREFIX is a prefix command, a symbol. SUFFIX is a suffix command or a group specification (of the same forms as expected by `transient-define-prefix'). Intended for use in a group's `:setup-children' function." + (cl-assert (and prefix (symbolp prefix))) (eval (car (transient--parse-child prefix suffix)))) (defun transient-parse-suffixes (prefix suffixes) @@ -1212,6 +1266,7 @@ PREFIX is a prefix command, a symbol. SUFFIXES is a list of suffix command or a group specification (of the same forms as expected by `transient-define-prefix'). Intended for use in a group's `:setup-children' function." + (cl-assert (and prefix (symbolp prefix))) (mapcar (apply-partially #'transient-parse-suffix prefix) suffixes)) ;;; Edit @@ -1472,7 +1527,8 @@ drawing in the transient buffer.") (defvar transient--pending-suffix nil "The suffix that is currently being processed. -This is bound while the suffix predicate is being evaluated.") +This is bound while the suffix predicate is being evaluated, +and while functions that return faces are being evaluated.") (defvar transient--pending-group nil "The group that is currently being processed. @@ -1555,33 +1611,35 @@ probably use this instead: (get COMMAND \\='transient--suffix)" (when command (cl-check-type command command)) - (if (or transient--prefix - transient-current-prefix) - (let ((suffixes - (cl-remove-if-not - (lambda (obj) - (eq (oref obj command) - (or command - (if (eq this-command 'transient-set-level) - ;; This is how it can look up for which - ;; command it is setting the level. - this-original-command - this-command)))) - (or transient--suffixes - transient-current-suffixes)))) - (or (and (cdr suffixes) - (cl-find-if - (lambda (obj) - (equal (listify-key-sequence (transient--kbd (oref obj key))) - (listify-key-sequence (this-command-keys)))) - suffixes)) - (car suffixes))) - (and-let* ((obj (transient--suffix-prototype (or command this-command))) + (cond + (transient--pending-suffix) + ((or transient--prefix + transient-current-prefix) + (let ((suffixes + (cl-remove-if-not + (lambda (obj) + (eq (oref obj command) + (or command + (if (eq this-command 'transient-set-level) + ;; This is how it can look up for which + ;; command it is setting the level. + this-original-command + this-command)))) + (or transient--suffixes + transient-current-suffixes)))) + (or (and (cdr suffixes) + (cl-find-if + (lambda (obj) + (equal (listify-key-sequence (transient--kbd (oref obj key))) + (listify-key-sequence (this-command-keys)))) + suffixes)) + (car suffixes)))) + ((and-let* ((obj (transient--suffix-prototype (or command this-command))) (obj (clone obj))) (progn ; work around debbugs#31840 (transient-init-scope obj) (transient-init-value obj) - obj)))) + obj))))) (defun transient--suffix-prototype (command) (or (get command 'transient--suffix) @@ -1762,7 +1820,10 @@ of the corresponding object." ;; an unbound key, then Emacs calls the `undefined' command ;; but does not set `this-command', `this-original-command' ;; or `real-this-command' accordingly. Instead they are nil. - "" #'transient--do-warn) + "" #'transient--do-warn + ;; Bound to the `mouse-movement' event, this command is similar + ;; to `ignore'. + "" #'transient--do-noop) (defvar transient--transient-map nil) (defvar transient--predicate-map nil) @@ -1821,7 +1882,7 @@ of the corresponding object." (defun transient--make-predicate-map () (let* ((default (transient--resolve-pre-command (oref transient--prefix transient-suffix))) - (return (and transient-current-prefix (eq default t))) + (return (and transient--stack (eq default t))) (map (make-sparse-keymap))) (set-keymap-parent map transient-predicate-map) (when (or (and (slot-boundp transient--prefix 'transient-switch-frame) @@ -1912,7 +1973,7 @@ the \"scope\" of the transient (see `transient-define-prefix'). This function is also called internally in which case LAYOUT and EDIT may be non-nil." (transient--debug 'setup) - (transient--with-emergency-exit + (transient--with-emergency-exit :setup (cond ((not name) ;; Switching between regular and edit mode. @@ -2166,7 +2227,7 @@ value. Otherwise return CHILDREN as is." (defun transient--pre-command () (transient--debug 'pre-command) - (transient--with-emergency-exit + (transient--with-emergency-exit :pre-command ;; The use of `overriding-terminal-local-map' does not prevent the ;; lookup of command remappings in the overridden maps, which can ;; lead to a suffix being remapped to a non-suffix. We have to undo @@ -2228,14 +2289,14 @@ value. Otherwise return CHILDREN as is." (when (window-live-p transient--window) (let ((remain-in-minibuffer-window (and (minibuffer-selected-window) - (selected-window))) - (buf (window-buffer transient--window))) + (selected-window)))) ;; Only delete the window if it has never shown another buffer. (unless (eq (car (window-parameter transient--window 'quit-restore)) 'other) (with-demoted-errors "Error while exiting transient: %S" (delete-window transient--window))) - (kill-buffer buf) + (when-let ((buffer (get-buffer transient--buffer-name))) + (kill-buffer buffer)) (when remain-in-minibuffer-window (select-window remain-in-minibuffer-window))))) @@ -2253,7 +2314,10 @@ value. Otherwise return CHILDREN as is." ((and transient--prefix transient--redisplay-key) (setq transient--redisplay-key nil) (when transient--showp - (transient--show)))) + (if-let ((win (minibuffer-selected-window))) + (with-selected-window win + (transient--show)) + (transient--show))))) (transient--pop-keymap 'transient--transient-map) (transient--pop-keymap 'transient--redisplay-map) (remove-hook 'pre-command-hook #'transient--pre-command) @@ -2308,7 +2372,7 @@ value. Otherwise return CHILDREN as is." (remove-hook 'minibuffer-exit-hook ,exit))) ,@body))) -(static-if (>= emacs-major-version 30) +(static-if (>= emacs-major-version 30) ;transient--wrap-command (defun transient--wrap-command () (cl-assert (>= emacs-major-version 30) nil @@ -2316,27 +2380,31 @@ value. Otherwise return CHILDREN as is." (letrec ((prefix transient--prefix) (suffix this-command) - (advice (lambda (fn &rest args) - (interactive - (lambda (spec) - (let ((abort t)) - (unwind-protect - (prog1 (advice-eval-interactive-spec spec) - (setq abort nil)) - (when abort - (when-let ((unwind (oref prefix unwind-suffix))) - (transient--debug 'unwind-interactive) - (funcall unwind suffix)) - (advice-remove suffix advice) - (oset prefix unwind-suffix nil)))))) - (unwind-protect - (apply fn args) + (advice + (lambda (fn &rest args) + (interactive + (lambda (spec) + (let ((abort t)) + (unwind-protect + (prog1 (let ((debugger #'transient--exit-and-debug)) + (advice-eval-interactive-spec spec)) + (setq abort nil)) + (when abort (when-let ((unwind (oref prefix unwind-suffix))) - (transient--debug 'unwind-command) + (transient--debug 'unwind-interactive) (funcall unwind suffix)) (advice-remove suffix advice) - (oset prefix unwind-suffix nil))))) - (advice-add suffix :around advice '((depth . -99))))) + (oset prefix unwind-suffix nil)))))) + (unwind-protect + (let ((debugger #'transient--exit-and-debug)) + (apply fn args)) + (when-let ((unwind (oref prefix unwind-suffix))) + (transient--debug 'unwind-command) + (funcall unwind suffix)) + (advice-remove suffix advice) + (oset prefix unwind-suffix nil))))) + (when (symbolp this-command) + (advice-add suffix :around advice '((depth . -99)))))) (defun transient--wrap-command () (let* ((prefix transient--prefix) @@ -2346,7 +2414,8 @@ value. Otherwise return CHILDREN as is." (lambda (spec) (let ((abort t)) (unwind-protect - (prog1 (advice-eval-interactive-spec spec) + (prog1 (let ((debugger #'transient--exit-and-debug)) + (advice-eval-interactive-spec spec)) (setq abort nil)) (when abort (when-let ((unwind (oref prefix unwind-suffix))) @@ -2357,7 +2426,8 @@ value. Otherwise return CHILDREN as is." (advice-body (lambda (fn &rest args) (unwind-protect - (apply fn args) + (let ((debugger #'transient--exit-and-debug)) + (apply fn args)) (when-let ((unwind (oref prefix unwind-suffix))) (transient--debug 'unwind-command) (funcall unwind suffix)) @@ -2366,7 +2436,8 @@ value. Otherwise return CHILDREN as is." (setq advice `(lambda (fn &rest args) (interactive ,advice-interactive) (apply ',advice-body fn args))) - (advice-add suffix :around advice '((depth . -99)))))) + (when (symbolp this-command) + (advice-add suffix :around advice '((depth . -99))))))) (defun transient--premature-post-command () (and (equal (this-command-keys-vector) []) @@ -2385,7 +2456,7 @@ value. Otherwise return CHILDREN as is." (defun transient--post-command () (unless (transient--premature-post-command) (transient--debug 'post-command) - (transient--with-emergency-exit + (transient--with-emergency-exit :post-command (cond (transient--exitp (transient--post-exit)) ;; If `this-command' is the current transient prefix, then we ;; have already taken care of updating the transient buffer... @@ -2509,18 +2580,22 @@ value. Otherwise return CHILDREN as is." this-command)) (key-description (this-command-keys-vector)) transient--exitp - (cond ((stringp (car args)) + (cond ((keywordp (car args)) + (format ", from: %s" + (substring (symbol-name (car args)) 1))) + ((stringp (car args)) (concat ", " (apply #'format args))) - (args + ((functionp (car args)) (concat ", " (apply (car args) (cdr args)))) (""))) (apply #'message arg args))))) -(defun transient--emergency-exit () +(defun transient--emergency-exit (&optional id) "Exit the current transient command after an error occurred. When no transient is active (i.e., when `transient--prefix' is -nil) then do nothing." - (transient--debug 'emergency-exit) +nil) then do nothing. Optional ID is a keyword identifying the +exit." + (transient--debug 'emergency-exit id) (when transient--prefix (setq transient--stack nil) (setq transient--exitp t) @@ -2544,6 +2619,7 @@ nil) then do nothing." (defun transient--get-pre-command (&optional cmd enforce-type) (or (and (not (eq enforce-type 'non-suffix)) + (symbolp cmd) (lookup-key transient--predicate-map (vector cmd))) (and (not (eq enforce-type 'suffix)) (transient--resolve-pre-command @@ -3087,14 +3163,14 @@ infix command determines what the new value should be, based on the previous value.") (cl-defmethod transient-infix-read :around ((obj transient-infix)) - "Refresh the transient buffer buffer calling the next method. + "Refresh the transient buffer and call the next method. Also wrap `cl-call-next-method' with two macros: - `transient--with-suspended-override' allows use of minibuffer. - `transient--with-emergency-exit' arranges for the transient to be exited in case of an error." (transient--show) - (transient--with-emergency-exit + (transient--with-emergency-exit :infix-read (transient--with-suspended-override (cl-call-next-method obj)))) @@ -3176,8 +3252,10 @@ The last value is \"don't use any of these switches\"." "Elsewhere use the reader of the infix command COMMAND. Use this if you want to share an infix's history with a regular stand-alone command." - (cl-letf (((symbol-function #'transient--show) #'ignore)) - (transient-infix-read (transient--suffix-prototype command)))) + (if-let ((obj (transient--suffix-prototype command))) + (cl-letf (((symbol-function #'transient--show) #'ignore)) + (transient-infix-read obj)) + (error "Not a suffix command: `%s'" command))) ;;;; Readers @@ -3354,7 +3432,7 @@ the set, saved or default value for PREFIX." (transient--init-suffixes prefix))))) (defun transient-get-value () - (transient--with-emergency-exit + (transient--with-emergency-exit :get-value (cl-mapcan (lambda (obj) (and (or (not (slot-exists-p obj 'unsavable)) (not (oref obj unsavable))) @@ -3565,7 +3643,7 @@ have a history of their own.") (propertize "\n" 'face face 'line-height t)))) (defmacro transient-with-shadowed-buffer (&rest body) - "While in the transient buffer, temporarily make the shadowed buffer current." + "While in the transient buffer, temporarly make the shadowed buffer current." (declare (indent 0) (debug t)) `(with-current-buffer (or transient--shadowed-buffer (current-buffer)) ,@body)) @@ -3620,7 +3698,8 @@ have a history of their own.") (lambda (column) (transient--maybe-pad-keys column group) (transient-with-shadowed-buffer - (let ((rows (mapcar #'transient-format (oref column suffixes)))) + (let* ((transient--pending-group column) + (rows (mapcar #'transient-format (oref column suffixes)))) (when-let ((desc (transient-format-description column))) (push desc rows)) (flatten-tree rows)))) @@ -3629,10 +3708,15 @@ have a history of their own.") transient-align-variable-pitch)) (rs (apply #'max (mapcar #'length columns))) (cs (length columns)) - (cw (mapcar (lambda (col) - (apply #'max - (mapcar (if vp #'transient--pixel-width #'length) - col))) + (cw (mapcar (let ((widths (oref transient--prefix column-widths))) + (lambda (col) + (apply + #'max + (if-let ((min (pop widths))) + (if vp (* min (transient--pixel-width " ")) min) + 0) + (mapcar (if vp #'transient--pixel-width #'length) + col)))) columns)) (cc (transient--seq-reductions-from (apply-partially #'+ (* 3 (if vp (transient--pixel-width " ") 1))) @@ -3908,7 +3992,10 @@ If the OBJ's `key' is currently unreachable, then apply the face (face (slot-value obj slot))) (if (and (not (facep face)) (functionp face)) - (funcall face) + (let ((transient--pending-suffix obj)) + (if (= (car (func-arity face)) 1) + (funcall face obj) + (funcall face))) face))) (defun transient--key-face (&optional cmd enforce-type) -- cgit v1.2.3 From 946280365d40104dffd5329eebefc02329f72041 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 21 Mar 2024 19:26:33 -0400 Subject: (make-help-screen): Move most of the code out to a function This avoids problems like variable-name capture and lets compiler messages point to the actual source code. * lisp/help-macro.el (help--help-screen): New function, extracted from `make-help-screen`. (make-help-screen): Use it. --- lisp/help-macro.el | 275 +++++++++++++++++++++++++++-------------------------- 1 file changed, 140 insertions(+), 135 deletions(-) (limited to 'lisp') diff --git a/lisp/help-macro.el b/lisp/help-macro.el index cea8b379ec0..8a16e85a329 100644 --- a/lisp/help-macro.el +++ b/lisp/help-macro.el @@ -92,141 +92,146 @@ and then returns." `(defun ,fname () "Help command." (interactive) - (let ((line-prompt - (substitute-command-keys ,help-line)) - (help-buffer-under-preparation t)) - (when three-step-help - (message "%s" line-prompt)) - (let* ((help-screen ,help-text) - ;; We bind overriding-local-map for very small - ;; sections, *excluding* where we switch buffers - ;; and where we execute the chosen help command. - (local-map (make-sparse-keymap)) - (new-minor-mode-map-alist minor-mode-map-alist) - (prev-frame (selected-frame)) - config new-frame key char) - (when (string-match "%THIS-KEY%" help-screen) - (setq help-screen - (replace-match (help--key-description-fontified - (substring (this-command-keys) 0 -1)) - t t help-screen))) - (unwind-protect - (let ((minor-mode-map-alist nil)) - (setcdr local-map ,helped-map) - (define-key local-map [t] 'undefined) - ;; Make the scroll bar keep working normally. - (define-key local-map [vertical-scroll-bar] - (lookup-key global-map [vertical-scroll-bar])) - (if three-step-help - (progn - (setq key (let ((overriding-local-map local-map)) - (read-key-sequence nil))) - ;; Make the HELP key translate to C-h. - (if (lookup-key function-key-map key) - (setq key (lookup-key function-key-map key))) - (setq char (aref key 0))) - (setq char ??)) - (when (or (eq char ??) (eq char help-char) - (memq char help-event-list)) - (setq config (current-window-configuration)) - (pop-to-buffer (or ,buffer-name " *Metahelp*") nil t) - (and (fboundp 'make-frame) - (not (eq (window-frame) - prev-frame)) - (setq new-frame (window-frame) - config nil)) - (setq buffer-read-only nil) - (let ((inhibit-read-only t)) - (erase-buffer) - (insert (substitute-command-keys help-screen))) - (let ((minor-mode-map-alist new-minor-mode-map-alist)) - (help-mode) - (variable-pitch-mode) - (setq new-minor-mode-map-alist minor-mode-map-alist)) - (goto-char (point-min)) - (while (or (memq char (append help-event-list - (cons help-char '( ?? ?\C-v ?\s ?\177 ?\M-v ?\S-\s - deletechar backspace vertical-scroll-bar - home end next prior up down)))) - (eq (car-safe char) 'switch-frame) - (equal key "\M-v")) - (condition-case nil - (cond - ((eq (car-safe char) 'switch-frame) - (handle-switch-frame char)) - ((memq char '(?\C-v ?\s next end)) - (scroll-up)) - ((or (memq char '(?\177 ?\M-v ?\S-\s deletechar backspace prior home)) - (equal key "\M-v")) - (scroll-down)) - ((memq char '(down)) - (scroll-up 1)) - ((memq char '(up)) - (scroll-down 1))) - (error nil)) - (let ((cursor-in-echo-area t) - (overriding-local-map local-map)) - (frame-toggle-on-screen-keyboard (selected-frame) nil) - (setq key (read-key-sequence - (format "Type one of listed options%s: " - (if (pos-visible-in-window-p - (point-max)) - "" - (concat ", or " - (help--key-description-fontified (kbd "")) - "/" - (help--key-description-fontified (kbd "")) - "/" - (help--key-description-fontified (kbd "SPC")) - "/" - (help--key-description-fontified (kbd "DEL")) - " to scroll"))) - nil nil nil nil - ;; Disable ``text conversion''. OS - ;; input methods might otherwise chose - ;; to insert user input directly into - ;; a buffer. - t) - char (aref key 0))) - - ;; If this is a scroll bar command, just run it. - (when (eq char 'vertical-scroll-bar) - (command-execute (lookup-key local-map key) nil key)))) - ;; We don't need the prompt any more. - (message "") - ;; Mouse clicks are not part of the help feature, - ;; so reexecute them in the standard environment. - (if (listp char) - (setq unread-command-events - (cons char unread-command-events) - config nil) - (let ((defn (lookup-key local-map key))) - (if defn - (progn - (when config - (set-window-configuration config) - (setq config nil)) - ;; Temporarily rebind `minor-mode-map-alist' - ;; to `new-minor-mode-map-alist' (Bug#10454). - (let ((minor-mode-map-alist new-minor-mode-map-alist)) - ;; `defn' must make sure that its frame is - ;; selected, so we won't iconify it below. - (call-interactively defn)) - (when new-frame - ;; Do not iconify the selected frame. - (unless (eq new-frame (selected-frame)) - (iconify-frame new-frame)) - (setq new-frame nil))) - (unless (equal (key-description key) "C-g") - (message (substitute-command-keys - (format "No help command is bound to `\\`%s''" - (key-description key)))) - (ding)))))) - (when config - (set-window-configuration config)) - (when new-frame - (iconify-frame new-frame)) - (setq minor-mode-map-alist new-minor-mode-map-alist)))))) + (help--help-screen ,help-line ,help-text ,helped-map ,buffer-name))) + + +;;;###autoload +(defun help--help-screen (help-line help-text helped-map buffer-name) + (let ((line-prompt + (substitute-command-keys help-line)) + (help-buffer-under-preparation t)) + (when three-step-help + (message "%s" line-prompt)) + (let* ((help-screen help-text) + ;; We bind overriding-local-map for very small + ;; sections, *excluding* where we switch buffers + ;; and where we execute the chosen help command. + (local-map (make-sparse-keymap)) + (new-minor-mode-map-alist minor-mode-map-alist) + (prev-frame (selected-frame)) + config new-frame key char) + (when (string-match "%THIS-KEY%" help-screen) + (setq help-screen + (replace-match (help--key-description-fontified + (substring (this-command-keys) 0 -1)) + t t help-screen))) + (unwind-protect + (let ((minor-mode-map-alist nil)) + (setcdr local-map helped-map) + (define-key local-map [t] #'undefined) + ;; Make the scroll bar keep working normally. + (define-key local-map [vertical-scroll-bar] + (lookup-key global-map [vertical-scroll-bar])) + (if three-step-help + (progn + (setq key (let ((overriding-local-map local-map)) + (read-key-sequence nil))) + ;; Make the HELP key translate to C-h. + (if (lookup-key function-key-map key) + (setq key (lookup-key function-key-map key))) + (setq char (aref key 0))) + (setq char ??)) + (when (or (eq char ??) (eq char help-char) + (memq char help-event-list)) + (setq config (current-window-configuration)) + (pop-to-buffer (or buffer-name " *Metahelp*") nil t) + (and (fboundp 'make-frame) + (not (eq (window-frame) + prev-frame)) + (setq new-frame (window-frame) + config nil)) + (setq buffer-read-only nil) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (substitute-command-keys help-screen))) + (let ((minor-mode-map-alist new-minor-mode-map-alist)) + (help-mode) + (variable-pitch-mode) + (setq new-minor-mode-map-alist minor-mode-map-alist)) + (goto-char (point-min)) + (while (or (memq char (append help-event-list + (cons help-char '( ?? ?\C-v ?\s ?\177 ?\M-v ?\S-\s + deletechar backspace vertical-scroll-bar + home end next prior up down)))) + (eq (car-safe char) 'switch-frame) + (equal key "\M-v")) + (condition-case nil + (cond + ((eq (car-safe char) 'switch-frame) + (handle-switch-frame char)) + ((memq char '(?\C-v ?\s next end)) + (scroll-up)) + ((or (memq char '(?\177 ?\M-v ?\S-\s deletechar backspace prior home)) + (equal key "\M-v")) + (scroll-down)) + ((memq char '(down)) + (scroll-up 1)) + ((memq char '(up)) + (scroll-down 1))) + (error nil)) + (let ((cursor-in-echo-area t) + (overriding-local-map local-map)) + (frame-toggle-on-screen-keyboard (selected-frame) nil) + (setq key (read-key-sequence + (format "Type one of listed options%s: " + (if (pos-visible-in-window-p + (point-max)) + "" + (concat ", or " + (help--key-description-fontified (kbd "")) + "/" + (help--key-description-fontified (kbd "")) + "/" + (help--key-description-fontified (kbd "SPC")) + "/" + (help--key-description-fontified (kbd "DEL")) + " to scroll"))) + nil nil nil nil + ;; Disable ``text conversion''. OS + ;; input methods might otherwise chose + ;; to insert user input directly into + ;; a buffer. + t) + char (aref key 0))) + + ;; If this is a scroll bar command, just run it. + (when (eq char 'vertical-scroll-bar) + (command-execute (lookup-key local-map key) nil key)))) + ;; We don't need the prompt any more. + (message "") + ;; Mouse clicks are not part of the help feature, + ;; so reexecute them in the standard environment. + (if (listp char) + (setq unread-command-events + (cons char unread-command-events) + config nil) + (let ((defn (lookup-key local-map key))) + (if defn + (progn + (when config + (set-window-configuration config) + (setq config nil)) + ;; Temporarily rebind `minor-mode-map-alist' + ;; to `new-minor-mode-map-alist' (Bug#10454). + (let ((minor-mode-map-alist new-minor-mode-map-alist)) + ;; `defn' must make sure that its frame is + ;; selected, so we won't iconify it below. + (call-interactively defn)) + (when new-frame + ;; Do not iconify the selected frame. + (unless (eq new-frame (selected-frame)) + (iconify-frame new-frame)) + (setq new-frame nil))) + (unless (equal (key-description key) "C-g") + (message (substitute-command-keys + (format "No help command is bound to `\\`%s''" + (key-description key)))) + (ding)))))) + (when config + (set-window-configuration config)) + (when new-frame + (iconify-frame new-frame)) + (setq minor-mode-map-alist new-minor-mode-map-alist))))) (provide 'help-macro) -- cgit v1.2.3 From a1f8702e8345254e6898d35e554bdc06ab09c3ca Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 21 Mar 2024 19:40:20 -0400 Subject: (help-fns-function-name): New function Consolidate code used in profiler and help--describe-command, and improve it while we're at it. Also use #' to quote a few function names along the way. * lisp/help-fns.el (help-fns--function-numbers, help-fns--function-names): New vars. (help-fns--display-function): New aux function. (help-fns-function-name): New function, inspired from `help--describe-command`. * lisp/help.el (help--describe-command): Use `help-fns-function-name`. (help--for-help-make-sections): Remove redundant "" arg to `mapconcat`. * lisp/profiler.el (profiler-format-entry, profiler-fixup-entry): Delete functions. (profiler-report-make-entry-part): Use `help-fns-function-name` instead. (profiler-report-find-entry): Use `push-button`. * lisp/transient.el (transient--debug): Use `help-fns-function-name` when available. --- etc/NEWS | 6 +++++ lisp/bind-key.el | 1 + lisp/help-fns.el | 68 ++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/help.el | 44 ++++++++++----------------------- lisp/profiler.el | 74 ++++++++++++++++++++----------------------------------- lisp/transient.el | 22 +++++++++-------- 6 files changed, 127 insertions(+), 88 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index ba0e4c80fa0..eda84d588a8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1647,6 +1647,12 @@ values. * Lisp Changes in Emacs 30.1 +** New function 'help-fns-function-name'. +For named functions, it just returns the name and otherwise +it returns a short "unique" string that identifies the function. +In either case, the string is propertized so clicking on it gives +further details. + ** New function 'cl-type-of'. This function is like 'type-of' except that it sometimes returns a more precise type. For example, for nil and t it returns 'null' diff --git a/lisp/bind-key.el b/lisp/bind-key.el index 1e59c75566a..780314fecbd 100644 --- a/lisp/bind-key.el +++ b/lisp/bind-key.el @@ -468,6 +468,7 @@ other modes. See `override-global-mode'." ((and bind-key-describe-special-forms (functionp elem) (stringp (setq doc (documentation elem)))) doc) ;;FIXME: Keep only the first line? + ;; FIXME: Use `help-fns-function-name'? ((consp elem) (if (symbolp (car elem)) (format "#<%s>" (car elem)) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 15d87f9925c..422f6e9dddf 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -2448,6 +2448,74 @@ one of them returns non-nil." (setq buffer-undo-list nil) (texinfo-mode))) +(defconst help-fns--function-numbers + (make-hash-table :test 'equal :weakness 'value)) +(defconst help-fns--function-names (make-hash-table :weakness 'key)) + +(defun help-fns--display-function (function) + (cond + ((subr-primitive-p function) + (describe-function function)) + ((and (compiled-function-p function) + (not (and (fboundp 'kmacro-p) (kmacro-p function)))) + (disassemble function)) + (t + ;; FIXME: Use cl-print! + (pp-display-expression function "*Help Source*" (consp function))))) + +;;;###autoload +(defun help-fns-function-name (function) + "Return a short string representing FUNCTION." + ;; FIXME: For kmacros, should we print the key-sequence? + (cond + ((symbolp function) + (let ((name (if (eq (intern-soft (symbol-name function)) function) + (symbol-name function) + (concat "#:" (symbol-name function))))) + (if (not (fboundp function)) + name + (make-text-button name nil + 'type 'help-function + 'help-args (list function))))) + ((gethash function help-fns--function-names)) + ((subrp function) + (let ((name (subr-name function))) + ;; FIXME: For native-elisp-functions, should we use `help-function' + ;; or `disassemble'? + (format "#<%s %s>" + (cl-type-of function) + (make-text-button name nil + 'type 'help-function + ;; Let's hope the subr hasn't been redefined! + 'help-args (list (intern name)))))) + (t + (let ((type (or (oclosure-type function) + (if (consp function) + (car function) (cl-type-of function)))) + (hash (sxhash-eq function)) + ;; Use 3 digits minimum. + (mask #xfff) + name) + (while + (let* ((hex (format (concat "%0" + (number-to-string (1+ (/ (logb mask) 4))) + "X") + (logand mask hash))) + ;; FIXME: For kmacros, we don't want to `disassemble'! + (button (buttonize + hex #'help-fns--display-function function + ;; FIXME: Shouldn't `buttonize' add + ;; the "mouse-2, RET:" prefix? + "mouse-2, RET: Display the function's body"))) + (setq name (format "#<%s %s>" type button)) + (and (< mask (abs hash)) ; We can add more digits. + (gethash name help-fns--function-numbers))) + ;; Add a digit. + (setq mask (+ (ash mask 4) #x0f))) + (puthash name function help-fns--function-numbers) + (puthash function name help-fns--function-names) + name)))) + (provide 'help-fns) ;;; help-fns.el ends here diff --git a/lisp/help.el b/lisp/help.el index c6a1e3c6bd9..4171d0c57c7 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -301,6 +301,8 @@ Do not call this in the scope of `with-help-window'." (let ((first-message (cond ((or pop-up-frames + ;; FIXME: `special-display-p' is obsolete since + ;; the vars on which it depends are obsolete! (special-display-p (buffer-name standard-output))) (setq help-return-method (cons (selected-window) t)) ;; If the help output buffer is a special display buffer, @@ -382,9 +384,9 @@ Do not call this in the scope of `with-help-window'." (propertize title 'face 'help-for-help-header) "\n\n" (help--for-help-make-commands commands)))) - sections "")) + sections)) -(defalias 'help 'help-for-help) +(defalias 'help #'help-for-help) (make-help-screen help-for-help (purecopy "Type a help option: [abcCdefFgiIkKlLmnprstvw.] C-[cdefmnoptw] or ?") (concat @@ -876,7 +878,7 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer." (format "%s (translated from %s)" string otherstring)))))) (defun help--binding-undefined-p (defn) - (or (null defn) (integerp defn) (equal defn 'undefined))) + (or (null defn) (integerp defn) (equal defn #'undefined))) (defun help--analyze-key (key untranslated &optional buffer) "Get information about KEY its corresponding UNTRANSLATED events. @@ -1221,7 +1223,7 @@ appeared on the mode-line." (defun describe-minor-mode-completion-table-for-symbol () ;; In order to list up all minor modes, minor-mode-list ;; is used here instead of minor-mode-alist. - (delq nil (mapcar 'symbol-name minor-mode-list))) + (delq nil (mapcar #'symbol-name minor-mode-list))) (defun describe-minor-mode-from-symbol (symbol) "Display documentation of a minor mode given as a symbol, SYMBOL." @@ -1644,34 +1646,14 @@ Return nil if the key sequence is too long." (t value)))) (defun help--describe-command (definition &optional translation) - (cond ((symbolp definition) - (if (and (fboundp definition) - help-buffer-under-preparation) - (insert-text-button (symbol-name definition) - 'type 'help-function - 'help-args (list definition)) - (insert (symbol-name definition))) - (insert "\n")) - ((or (stringp definition) (vectorp definition)) + (cond ((or (stringp definition) (vectorp definition)) (if translation (insert (key-description definition nil) "\n") + ;; These should be rare nowadays, replaced by `kmacro's. (insert "Keyboard Macro\n"))) ((keymapp definition) (insert "Prefix Command\n")) - ((byte-code-function-p definition) - (insert (format "[%s]\n" - (buttonize "byte-code" #'disassemble definition)))) - ((and (consp definition) - (memq (car definition) '(closure lambda))) - (insert (format "[%s]\n" - (buttonize - (symbol-name (car definition)) - (lambda (_) - (pp-display-expression - definition "*Help Source*" t)) - nil "View definition")))) - (t - (insert "??\n")))) + (t (insert (help-fns-function-name definition) "\n")))) (define-obsolete-function-alias 'help--describe-translation #'help--describe-command "29.1") @@ -2011,8 +1993,8 @@ and some others." (if temp-buffer-resize-mode ;; `help-make-xrefs' may add a `back' button and thus increase the ;; text size, so `resize-temp-buffer-window' must be run *after* it. - (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append) - (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window))) + (add-hook 'temp-buffer-show-hook #'resize-temp-buffer-window 'append) + (remove-hook 'temp-buffer-show-hook #'resize-temp-buffer-window))) (defvar resize-temp-buffer-window-inhibit nil "Non-nil means `resize-temp-buffer-window' should not resize.") @@ -2256,7 +2238,7 @@ The `temp-buffer-window-setup-hook' hook is called." ;; Don't print to *Help*; that would clobber Help history. (defun help-form-show () "Display the output of a non-nil `help-form'." - (let ((msg (eval help-form))) + (let ((msg (eval help-form t))) (if (stringp msg) (with-output-to-temp-buffer " *Char Help*" (princ msg))))) @@ -2421,7 +2403,7 @@ the same names as used in the original source code, when possible." (t arg))) arglist))) -(define-obsolete-function-alias 'help-make-usage 'help--make-usage "25.1") +(define-obsolete-function-alias 'help-make-usage #'help--make-usage "25.1") (defun help--make-usage-docstring (fn arglist) (let ((print-escape-newlines t)) diff --git a/lisp/profiler.el b/lisp/profiler.el index 80f84037a63..4e02cd1d890 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -38,8 +38,7 @@ (defcustom profiler-sampling-interval 1000000 "Default sampling interval in nanoseconds." - :type 'natnum - :group 'profiler) + :type 'natnum) ;;; Utilities @@ -68,7 +67,7 @@ collect c into s do (cl-decf i) finally return - (apply 'string (if (eq (car s) ?,) (cdr s) s))) + (apply #'string (if (eq (car s) ?,) (cdr s) s))) (profiler-ensure-string number))) (defun profiler-format (fmt &rest args) @@ -76,7 +75,7 @@ for arg in args for str = (cond ((consp subfmt) - (apply 'profiler-format subfmt arg)) + (apply #'profiler-format subfmt arg)) ((stringp subfmt) (format subfmt arg)) ((and (symbolp subfmt) @@ -91,7 +90,8 @@ if (< width len) collect (progn (put-text-property (max 0 (- width 2)) len 'invisible 'profiler str) - str) into frags + str) + into frags else collect (let ((padding (make-string (max 0 (- width len)) ?\s))) @@ -100,32 +100,11 @@ (right (concat padding str)))) into frags finally return (apply #'concat frags))) - - -;;; Entries - -(defun profiler-format-entry (entry) - "Format ENTRY in human readable string. -ENTRY would be a function name of a function itself." - (cond ((memq (car-safe entry) '(closure lambda)) - (format "#" (sxhash entry))) - ((byte-code-function-p entry) - (format "#" (sxhash entry))) - ((or (subrp entry) (symbolp entry) (stringp entry)) - (format "%s" entry)) - (t - (format "#" (sxhash entry))))) - -(defun profiler-fixup-entry (entry) - (if (symbolp entry) - entry - (profiler-format-entry entry))) - ;;; Backtraces (defun profiler-fixup-backtrace (backtrace) - (apply 'vector (mapcar 'profiler-fixup-entry backtrace))) + (apply #'vector (mapcar #'help-fns-function-name backtrace))) ;;; Logs @@ -434,18 +413,15 @@ Optional argument MODE means only check for the specified mode (cpu or mem)." (defcustom profiler-report-closed-mark "+" "An indicator of closed calltrees." - :type 'string - :group 'profiler) + :type 'string) (defcustom profiler-report-open-mark "-" "An indicator of open calltrees." - :type 'string - :group 'profiler) + :type 'string) (defcustom profiler-report-leaf-mark " " "An indicator of calltree leaves." - :type 'string - :group 'profiler) + :type 'string) (defvar profiler-report-cpu-line-format '((17 right ((12 right) @@ -474,17 +450,18 @@ Do not touch this variable directly.") (let ((string (cond ((eq entry t) "Others") - ((and (symbolp entry) - (fboundp entry)) - (propertize (symbol-name entry) - 'face 'link - 'follow-link "\r" - 'mouse-face 'highlight - 'help-echo "\ + (t (propertize (help-fns-function-name entry) + ;; Override the `button-map' which + ;; otherwise adds RET, mouse-1, and TAB + ;; bindings we don't want. :-( + 'keymap '(make-sparse-keymap) + 'follow-link "\r" + ;; FIXME: The help-echo code gets confused + ;; by the `follow-link' property and rewrites + ;; `mouse-2' to `mouse-1' :-( + 'help-echo "\ mouse-2: jump to definition\n\ -RET: expand or collapse")) - (t - (profiler-format-entry entry))))) +RET: expand or collapse"))))) (propertize string 'profiler-entry entry))) (defun profiler-report-make-name-part (tree) @@ -719,10 +696,13 @@ point." (current-buffer)) (and event (setq event (event-end event)) (posn-set-point event)) - (let ((tree (profiler-report-calltree-at-point))) - (when tree - (let ((entry (profiler-calltree-entry tree))) - (find-function entry)))))) + (save-excursion + (forward-line 0) + (let ((eol (pos-eol))) + (forward-button 1) + (if (> (point) eol) + (error "No entry found") + (push-button)))))) (defun profiler-report-describe-entry () "Describe entry at point." diff --git a/lisp/transient.el b/lisp/transient.el index 2d8566a3ac4..c3b9448e2c4 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -1249,7 +1249,7 @@ symbol property.") (when (and (boundp 'read-extended-command-predicate) ; since Emacs 28.1 (not read-extended-command-predicate)) (setq read-extended-command-predicate - 'transient-command-completion-not-suffix-only-p)) + #'transient-command-completion-not-suffix-only-p)) (defun transient-parse-suffix (prefix suffix) "Parse SUFFIX, to be added to PREFIX. @@ -1258,7 +1258,7 @@ SUFFIX is a suffix command or a group specification (of the same forms as expected by `transient-define-prefix'). Intended for use in a group's `:setup-children' function." (cl-assert (and prefix (symbolp prefix))) - (eval (car (transient--parse-child prefix suffix)))) + (eval (car (transient--parse-child prefix suffix)) t)) (defun transient-parse-suffixes (prefix suffixes) "Parse SUFFIXES, to be added to PREFIX. @@ -1278,7 +1278,7 @@ Intended for use in a group's `:setup-children' function." (string suffix))) (mem (transient--layout-member loc prefix)) (elt (car mem))) - (setq suf (eval suf)) + (setq suf (eval suf t)) (cond ((not mem) (message "Cannot insert %S into %s; %s not found" @@ -1736,7 +1736,8 @@ to `transient-predicate-map'. Also see `transient-base-map'." "Hide common commands" "Show common permanently"))) (list "C-x l" "Show/hide suffixes" #'transient-set-level) - (list "C-x a" #'transient-toggle-level-limit)))))))) + (list "C-x a" #'transient-toggle-level-limit))))) + t))) (defvar-keymap transient-popup-navigation-map :doc "One of the keymaps used when popup navigation is enabled. @@ -2574,10 +2575,11 @@ value. Otherwise return CHILDREN as is." (if (symbolp arg) (message "-- %-22s (cmd: %s, event: %S, exit: %s%s)" arg - (or (and (symbolp this-command) this-command) - (if (byte-code-function-p this-command) - "#[...]" - this-command)) + (if (fboundp 'help-fns-function-name) + (help-fns-function-name this-command) + (if (byte-code-function-p this-command) + "#[...]" + this-command)) (key-description (this-command-keys-vector)) transient--exitp (cond ((keywordp (car args)) @@ -2982,7 +2984,7 @@ transient is active." (interactive) (transient-set-value (transient-prefix-object))) -(defalias 'transient-set-and-exit 'transient-set +(defalias 'transient-set-and-exit #'transient-set "Set active transient's value for this Emacs session and exit.") (defun transient-save () @@ -2990,7 +2992,7 @@ transient is active." (interactive) (transient-save-value (transient-prefix-object))) -(defalias 'transient-save-and-exit 'transient-save +(defalias 'transient-save-and-exit #'transient-save "Save active transient's value for this and future Emacs sessions and exit.") (defun transient-reset () -- cgit v1.2.3 From 60c9702972f3cef9e6dbbce5eaad8cc90ea7f8e8 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 21 Mar 2024 21:43:38 -0400 Subject: * lisp/help.el (help--analyze-key): Use `help-fns-function-name` --- lisp/help.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/help.el b/lisp/help.el index 4171d0c57c7..bafe6032942 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -926,7 +926,9 @@ in the selected window." (let ((key-desc (help-key-description key untranslated))) (if (help--binding-undefined-p defn) (format "%s%s is undefined" key-desc mouse-msg) - (format "%s%s runs the command %S" key-desc mouse-msg defn))) + (format "%s%s runs the command %s" key-desc mouse-msg + (if (symbolp defn) (prin1-to-string defn) + (help-fns-function-name defn))))) defn event mouse-msg))) (defun help--filter-info-list (info-list i) -- cgit v1.2.3 From 0c321ddbd3afcc821567fcb584e18e9f0dd49790 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 22 Mar 2024 15:24:28 +0800 Subject: Fix display of custom menus after putative cosmetic change * lisp/wid-edit.el (widget-setup): Restore version from before the previous commit. --- lisp/wid-edit.el | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index f69a3d3b05f..172da3db1e0 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1377,14 +1377,17 @@ When not inside a field, signal an error." (defun widget-setup () "Setup current buffer so editing string widgets works." (widget--allow-insertion - (dolist (field widget-field-new) - (push field widget-field-list) - (let ((from (car (widget-get field :field-overlay))) - (to (cdr (widget-get field :field-overlay)))) - (widget-specify-field field - (marker-position from) (marker-position to)) - (set-marker from nil) - (set-marker to nil)))) + (let (field) + (while widget-field-new + (setq field (car widget-field-new) + widget-field-new (cdr widget-field-new) + widget-field-list (cons field widget-field-list)) + (let ((from (car (widget-get field :field-overlay))) + (to (cdr (widget-get field :field-overlay)))) + (widget-specify-field field + (marker-position from) (marker-position to)) + (set-marker from nil) + (set-marker to nil))))) (widget-clear-undo) (widget-add-change)) -- cgit v1.2.3 From c1530a2e4973005633ebe00d447f1f3aa1200301 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 22 Mar 2024 09:54:37 +0200 Subject: ; * lisp/help-fns.el (help-fns-function-name): Doc fix. --- lisp/help-fns.el | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 422f6e9dddf..638af81ded8 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -2465,7 +2465,14 @@ one of them returns non-nil." ;;;###autoload (defun help-fns-function-name (function) - "Return a short string representing FUNCTION." + "Return a short buttonized string representing FUNCTION. +The string is propertized with a button; clicking on that +provides further details about FUNCTION. +FUNCTION can be a function, a built-in, a keyboard macro, +or a compile function. +This function is intended to be used to display various +callable symbols in buffers in a way that allows the user +to find out more details about the symbols." ;; FIXME: For kmacros, should we print the key-sequence? (cond ((symbolp function) -- cgit v1.2.3 From accd79c93935b50dddfcd6fe7fb6912c80bcddb1 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 21 Mar 2024 21:08:58 -0400 Subject: (help-fns-function-description-header): Print functions' type Instead of choosing English words to describe the kind of function, use the actual type of the function object (from `cl-type-of`) directly, and make it a button to display info about that type. * lisp/help-fns.el (help-fns-function-description-header): Use the function's type name in the description instead of "prose". Use `insert` instead of `princ`, so as to preserve the text-properties of the button. * lisp/emacs-lisp/cl-extra.el (cl-help-type): Move to `help-mode.el` and rename to `help-type`. (cl--describe-class): Adjust accordingly. * lisp/help-mode.el (help-type): New type, moved and renamed from `cl-extra.el`. --- lisp/emacs-lisp/cl-extra.el | 11 +++-------- lisp/help-fns.el | 31 ++++++++++++++----------------- lisp/help-mode.el | 5 +++++ 3 files changed, 22 insertions(+), 25 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index d43c21d3eb9..437dea2d6a9 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -720,11 +720,6 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (add-to-list 'find-function-regexp-alist '(define-type . cl--typedef-regexp))) -(define-button-type 'cl-help-type - :supertype 'help-function-def - 'help-function #'cl-describe-type - 'help-echo (purecopy "mouse-2, RET: describe this type")) - (define-button-type 'cl-type-definition :supertype 'help-function-def 'help-echo (purecopy "mouse-2, RET: find type definition")) @@ -777,7 +772,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'" (insert (symbol-name type) (substitute-command-keys " is a type (of kind `")) (help-insert-xref-button (symbol-name metatype) - 'cl-help-type metatype) + 'help-type metatype) (insert (substitute-command-keys "')")) (when location (insert (substitute-command-keys " in `")) @@ -796,7 +791,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'" (setq cur (cl--class-name cur)) (insert (substitute-quotes "`")) (help-insert-xref-button (symbol-name cur) - 'cl-help-type cur) + 'help-type cur) (insert (substitute-command-keys (if pl "', " "'")))) (insert ".\n"))) @@ -808,7 +803,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'" (while (setq cur (pop ch)) (insert (substitute-quotes "`")) (help-insert-xref-button (symbol-name cur) - 'cl-help-type cur) + 'help-type cur) (insert (substitute-command-keys (if ch "', " "'")))) (insert ".\n"))) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 638af81ded8..a291893e9a2 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1061,10 +1061,10 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." (concat "an autoloaded " (if (commandp def) "interactive ")) - (if (commandp def) "an interactive " "a ")))) - - ;; Print what kind of function-like object FUNCTION is. - (princ (cond ((or (stringp def) (vectorp def)) + (if (commandp def) "an interactive " "a "))) + ;; Print what kind of function-like object FUNCTION is. + (description + (cond ((or (stringp def) (vectorp def)) "a keyboard macro") ((and (symbolp function) (get function 'reader-construct)) @@ -1073,12 +1073,6 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." ;; aliases before functions. (aliased (format-message "an alias for `%s'" real-def)) - ((subr-native-elisp-p def) - (concat beg "native-compiled Lisp function")) - ((subrp def) - (concat beg (if (eq 'unevalled (cdr (subr-arity def))) - "special form" - "built-in function"))) ((autoloadp def) (format "an autoloaded %s" (cond @@ -1092,12 +1086,13 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." ;; need to check macros before functions. (macrop function)) (concat beg "Lisp macro")) - ((byte-code-function-p def) - (concat beg "byte-compiled Lisp function")) - ((module-function-p def) - (concat beg "module function")) - ((memq (car-safe def) '(lambda closure)) - (concat beg "Lisp function")) + ((atom def) + (let ((type (or (oclosure-type def) (cl-type-of def)))) + (concat beg (format "%s" + (make-text-button + (symbol-name type) nil + 'type 'help-type + 'help-args (list type)))))) ((keymapp def) (let ((is-full nil) (elts (cdr-safe def))) @@ -1107,7 +1102,9 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." elts nil)) (setq elts (cdr-safe elts))) (concat beg (if is-full "keymap" "sparse keymap")))) - (t ""))) + (t "")))) + (with-current-buffer standard-output + (insert description)) (if (and aliased (not (fboundp real-def))) (princ ",\nwhich is not defined.") diff --git a/lisp/help-mode.el b/lisp/help-mode.el index dd78342ace7..48433d899ab 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -177,6 +177,11 @@ The format is (FUNCTION ARGS...).") 'help-function 'describe-variable 'help-echo (purecopy "mouse-2, RET: describe this variable")) +(define-button-type 'help-type + :supertype 'help-xref + 'help-function #'cl-describe-type + 'help-echo (purecopy "mouse-2, RET: describe this type")) + (define-button-type 'help-face :supertype 'help-xref 'help-function 'describe-face -- cgit v1.2.3 From 7269a2f1586733bd03b569608bd77112b2e6487f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 22 Mar 2024 16:46:28 -0400 Subject: (pp-fill): Cut before parens and dots The `pp-fill` code sometimes end up generating things like: (foo . bar) instead of (foo . bar) so make sure we cut before rather than after the dot (and open parens while we're at it). * lisp/emacs-lisp/pp.el (pp-fill): Cut before parens and dots. * test/lisp/emacs-lisp/pp-tests.el (pp-tests--dimensions): New function. (pp-tests--cut-before): New test. --- lisp/emacs-lisp/pp.el | 14 +++++++++----- test/lisp/emacs-lisp/pp-tests.el | 30 ++++++++++++++++++++++++++++++ 2 files changed, 39 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index de7468b3e38..b48f44545bf 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -193,11 +193,15 @@ it inserts and pretty-prints that arg at point." (and (save-excursion (goto-char beg) - (if (save-excursion (skip-chars-backward " \t({[',") - (bolp)) - ;; The sexp was already on its own line. - nil - (skip-chars-backward " \t") + ;; We skip backward over open parens because cutting + ;; the line right after an open paren does not help + ;; reduce the indentation depth. + ;; Similarly, we prefer to cut before a "." than after + ;; it because it reduces the indentation depth. + (skip-chars-backward " \t({[',.") + (if (bolp) + ;; The sexp already starts on its own line. + (progn (goto-char beg) nil) (setq beg (copy-marker beg t)) (if paired (setq paired (copy-marker paired t))) ;; We could try to undo this insertion if it diff --git a/test/lisp/emacs-lisp/pp-tests.el b/test/lisp/emacs-lisp/pp-tests.el index b663fb365a8..7f7c798cde8 100644 --- a/test/lisp/emacs-lisp/pp-tests.el +++ b/test/lisp/emacs-lisp/pp-tests.el @@ -36,4 +36,34 @@ (ert-deftest test-indentation () (ert-test-erts-file (ert-resource-file "code-formats.erts"))) +(defun pp-tests--dimensions () + (save-excursion + (let ((width 0) + (height 0)) + (goto-char (point-min)) + (while (not (eobp)) + (end-of-line) + (setq height (1+ height)) + (setq width (max width (current-column))) + (forward-char 1)) + (cons width height)))) + +(ert-deftest pp-tests--cut-before () + (with-temp-buffer + (lisp-data-mode) + (pp '(1 (quite-a-long-package-name + . [(0 10 0) ((avy (0 5 0))) "Quickly switch windows." tar + ((:url . "https://github.com/abo-abo/ace-window") + (:maintainer "Oleh Krehel" . "ohwoeowho@gmail.com") + (:authors ("Oleh Krehel" . "ohwoeowho@gmail.com")) + (:keywords "window" "location"))])) + (current-buffer)) + ;; (message "Filled:\n%s" (buffer-string)) + (let ((dimensions (pp-tests--dimensions))) + (should (< (car dimensions) 80)) + (should (< (cdr dimensions) 8))) + (goto-char (point-min)) + (while (search-forward "." nil t) + (should (not (eolp)))))) + ;;; pp-tests.el ends here. -- cgit v1.2.3 From 7e32e8392ab77f9df08a1f11831cbba2242d721f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 22 Mar 2024 18:44:54 -0400 Subject: Fix recent test regressions * lisp/emacs-lisp/pp.el (pp-fill): Don't cut between `#` and `(`. * test/lisp/help-fns-tests.el (help-fns-test-built-in) (help-fns-test-interactive-built-in, help-fns-test-lisp-defun) (help-fns-test-lisp-defsubst): * test/src/emacs-module-tests.el (module/describe-function-1): Adjust tests to new wording in `describe-function`. --- lisp/emacs-lisp/pp.el | 5 ++++- test/lisp/help-fns-tests.el | 10 +++++----- test/src/emacs-module-tests.el | 2 +- 3 files changed, 10 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index b48f44545bf..26c77d6b047 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -198,7 +198,10 @@ it inserts and pretty-prints that arg at point." ;; reduce the indentation depth. ;; Similarly, we prefer to cut before a "." than after ;; it because it reduces the indentation depth. - (skip-chars-backward " \t({[',.") + (while (not (zerop (skip-chars-backward " \t({[',."))) + (and (memq (char-before) '(?# ?s ?f)) + (looking-back "#[sf]?" (- (point) 2)) + (goto-char (match-beginning 0)))) (if (bolp) ;; The sexp already starts on its own line. (progn (goto-char beg) nil) diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el index 7035c8b7773..1beeb77640c 100644 --- a/test/lisp/help-fns-tests.el +++ b/test/lisp/help-fns-tests.el @@ -48,12 +48,12 @@ Return first line of the output of (describe-function-1 FUNC)." (should (string-match regexp result)))) (ert-deftest help-fns-test-built-in () - (let ((regexp "a built-in function in .C source code") + (let ((regexp "a primitive-function in .C source code") (result (help-fns-tests--describe-function 'mapcar))) (should (string-match regexp result)))) (ert-deftest help-fns-test-interactive-built-in () - (let ((regexp "an interactive built-in function in .C source code") + (let ((regexp "an interactive primitive-function in .C source code") (result (help-fns-tests--describe-function 're-search-forward))) (should (string-match regexp result)))) @@ -64,13 +64,13 @@ Return first line of the output of (describe-function-1 FUNC)." (ert-deftest help-fns-test-lisp-defun () (let ((regexp (if (featurep 'native-compile) - "a native-compiled Lisp function in .+subr\\.el" - "a byte-compiled Lisp function in .+subr\\.el")) + "a subr-native-elisp in .+subr\\.el" + "a compiled-function in .+subr\\.el")) (result (help-fns-tests--describe-function 'last))) (should (string-match regexp result)))) (ert-deftest help-fns-test-lisp-defsubst () - (let ((regexp "a byte-compiled Lisp function in .+subr\\.el") + (let ((regexp "a compiled-function in .+subr\\.el") (result (help-fns-tests--describe-function 'posn-window))) (should (string-match regexp result)))) diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index fd0647275a0..052fd83dc85 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -315,7 +315,7 @@ local reference." (replace-match "`src/emacs-module-resources/")) (should (equal (buffer-substring-no-properties 1 (point-max)) - (format "a module function in `src/emacs-module-resources/mod-test%s'. + (format "a module-function in `src/emacs-module-resources/mod-test%s'. (mod-test-sum a b) -- cgit v1.2.3 From d3ca7c68c7e4c4c86341427fc34dd1af74f1a593 Mon Sep 17 00:00:00 2001 From: john muhl Date: Tue, 19 Mar 2024 19:46:12 -0500 Subject: ; Open inferior Lua buffer in a window, not a frame * lisp/progmodes/lua-ts-mode.el (lua-ts-inferior-lua): Replace 'display-buffer-pop-up-window' with 'display-buffer-pop-up-frame'. (bug#69909) --- lisp/progmodes/lua-ts-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 25fd7792f42..b6d6e90680c 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -628,7 +628,7 @@ Calls REPORT-FN directly." nil t))) (select-window (display-buffer lua-ts-inferior-buffer '((display-buffer-reuse-window - display-buffer-pop-up-frame) + display-buffer-pop-up-window) (reusable-frames . t)))) (get-buffer-process (current-buffer))) -- cgit v1.2.3 From f412892b79dae531ace081f61ec6f3874f9270bc Mon Sep 17 00:00:00 2001 From: john muhl Date: Tue, 12 Mar 2024 11:17:15 -0500 Subject: ; Remove unneeded group in lua-ts-mode defcustoms * lisp/progmodes/lua-ts-mode.el (lua-ts-mode-hook): (lua-ts-indent-offset): (lua-ts-luacheck-program): (lua-ts-inferior-buffer): (lua-ts-inferior-program): (lua-ts-inferior-options): (lua-ts-inferior-startfile): (lua-ts-inferior-prompt): (lua-ts-inferior-prompt-continue): (lua-ts-inferior-history): (lua-ts-indent-continuation-lines): Remove :group. (bug#69910) --- lisp/progmodes/lua-ts-mode.el | 11 ----------- 1 file changed, 11 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index b6d6e90680c..407ef230c32 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -60,66 +60,56 @@ :options '(flymake-mode hs-minor-mode outline-minor-mode) - :group 'lua-ts :version "30.1") (defcustom lua-ts-indent-offset 4 "Number of spaces for each indentation step in `lua-ts-mode'." :type 'natnum :safe 'natnump - :group 'lua-ts :version "30.1") (defcustom lua-ts-luacheck-program "luacheck" "Location of the Luacheck program." :type '(choice (const :tag "None" nil) string) - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-buffer "*Lua*" "Name of the inferior Lua buffer." :type 'string :safe 'stringp - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-program "lua" "Program to run in the inferior Lua process." :type '(choice (const :tag "None" nil) string) - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-options '("-i") "Command line options for the inferior Lua process." :type '(repeat string) - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-startfile nil "File to load into the inferior Lua process at startup." :type '(choice (const :tag "None" nil) (file :must-match t)) - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-prompt ">" "Prompt used by the inferior Lua process." :type 'string :safe 'stringp - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-prompt-continue ">>" "Continuation prompt used by the inferior Lua process." :type 'string :safe 'stringp - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-history nil "File used to save command history of the inferior Lua process." :type '(choice (const :tag "None" nil) file) :safe 'string-or-null-p - :group 'lua-ts :version "30.1") (defcustom lua-ts-indent-continuation-lines t @@ -141,7 +131,6 @@ the statement: end" :type 'boolean :safe 'booleanp - :group 'lua-ts :version "30.1") (defvar lua-ts--builtins -- cgit v1.2.3 From e39cb515a108682b520e499c334a600ee634fbf6 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 23 Mar 2024 15:37:43 +0800 Subject: Correctly handle non-BMP characters in Android content file names * lisp/term/android-win.el (android-encode-jni) (android-decode-jni, android-jni): New coding system, for Android file names and runtime data. * src/androidterm.h (syms_of_androidvfs): New function. * src/androidvfs.c (struct android_special_vnode): New field special_coding_system. (android_saf_tree_readdir): Decode the file name using the android-jni coding system. (special_vnodes): : Specify a file name coding system. (android_vfs_convert_name): New function. (android_root_name): If a special coding system be specified for a special vnode, convert components to it before invoking its name function. (syms_of_androidvfs): New symbol Qandroid_jni. * src/emacs.c (android_emacs_init): Call syms_of_androidvfs. --- lisp/term/android-win.el | 89 ++++++++++++++++++++++++++++++ src/androidterm.h | 5 +- src/androidvfs.c | 137 +++++++++++++++++++++++++++++++++++++++++------ src/emacs.c | 1 + 4 files changed, 215 insertions(+), 17 deletions(-) (limited to 'lisp') diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index 8d262e5da98..6512ef81ff7 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -528,6 +528,95 @@ accessible to other programs." (setq url replacement-url)) (android-browse-url-internal url send)) + +;; Coding systems used by androidvfs.c. + +(define-ccl-program android-encode-jni + `(2 ((loop + (read r0) + (if (r0 < #x1) ; 0x0 is encoded specially in JNI environments. + ((write #xc0) + (write #x80)) + ((if (r0 < #x80) ; ASCII + ((write r0)) + (if (r0 < #x800) ; \u0080 - \u07ff + ((write ((r0 >> 6) | #xC0)) + (write ((r0 & #x3F) | #x80))) + ;; \u0800 - \uFFFF + (if (r0 < #x10000) + ((write ((r0 >> 12) | #xE0)) + (write (((r0 >> 6) & #x3F) | #x80)) + (write ((r0 & #x3F) | #x80))) + ;; Supplementary characters must be converted into + ;; surrogate pairs before encoding. + (;; High surrogate + (r1 = ((((r0 - #x10000) >> 10) & #x3ff) + #xD800)) + ;; Low surrogate. + (r2 = (((r0 - #x10000) & #x3ff) + #xDC00)) + ;; Write both surrogate characters. + (write ((r1 >> 12) | #xE0)) + (write (((r1 >> 6) & #x3F) | #x80)) + (write ((r1 & #x3F) | #x80)) + (write ((r2 >> 12) | #xE0)) + (write (((r2 >> 6) & #x3F) | #x80)) + (write ((r2 & #x3F) | #x80)))))))) + (repeat)))) + "Encode characters from the input buffer for Java virtual machines.") + +(define-ccl-program android-decode-jni + `(1 ((loop + ((read-if (r0 >= #x80) ; More than a one-byte sequence? + ((if (r0 < #xe0) + ;; Two-byte sequence; potentially a NULL + ;; character. + ((read r4) + (r4 &= #x3f) + (r0 = (((r0 & #x1f) << 6) | r4))) + (if (r0 < ?\xF0) + ;; Three-byte sequence, after which surrogate + ;; pairs should be processed. + ((read r4 r6) + (r4 = ((r4 & #x3f) << 6)) + (r6 &= #x3f) + (r0 = ((((r0 & #xf) << 12) | r4) | r6))) + ;; Four-byte sequences are not valid under the + ;; JVM specification, but Android produces them + ;; when encoding Emoji characters for being + ;; supposedly less of a surprise to applications. + ;; This is obviously not true of programs written + ;; to the letter of the documentation, but 50 + ;; million Frenchmen make a right (and this + ;; deviation from the norm is predictably absent + ;; from Android's documentation on the subject). + ((read r1 r4 r6) + (r1 = ((r1 & #x3f) << 12)) + (r4 = ((r4 & #x3f) << 6)) + (r6 &= #x3F) + (r0 = (((((r0 & #x07) << 18) | r1) | r4) | r6)))))))) + (if ((r0 & #xf800) == #xd800) + ;; High surrogate. + ((read-if (r2 >= #xe0) + ((r0 = ((r0 & #x3ff) << 10)) + (read r4 r6) + (r4 = ((r4 & #x3f) << 6)) + (r6 &= #x3f) + (r1 = ((((r2 & #xf) << 12) | r4) | r6)) + (r0 = (((r1 & #x3ff) | r0) + #xffff)))))) + (write r0) + (repeat)))) + "Decode JVM-encoded characters in the input buffer.") + +(define-coding-system 'android-jni + "CESU-8 based encoding for communication with the Android runtime." + :mnemonic ?J + :coding-type 'ccl + :eol-type 'unix + :ascii-compatible-p nil ; for \0 is encoded as a two-byte sequence. + :default-char ?\0 + :charset-list '(unicode) + :ccl-decoder 'android-decode-jni + :ccl-encoder 'android-encode-jni) + (provide 'android-win) ;; android-win.el ends here. diff --git a/src/androidterm.h b/src/androidterm.h index ca6929bef0e..fd4cc99f641 100644 --- a/src/androidterm.h +++ b/src/androidterm.h @@ -461,7 +461,7 @@ extern void sfntfont_android_shrink_scanline_buffer (void); extern void init_sfntfont_android (void); extern void syms_of_sfntfont_android (void); -/* Defined in androidselect.c */ +/* Defined in androidselect.c. */ #ifndef ANDROID_STUBIFY @@ -473,6 +473,9 @@ extern void android_notification_action (struct android_notification_event *, extern void init_androidselect (void); extern void syms_of_androidselect (void); +/* Defined in androidvfs.c. */ +extern void syms_of_androidvfs (void); + #endif diff --git a/src/androidvfs.c b/src/androidvfs.c index 9e3d5cab8cf..6a9ddb33c56 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -38,8 +38,10 @@ along with GNU Emacs. If not, see . */ #include #include "android.h" +#include "androidterm.h" #include "systime.h" #include "blockinput.h" +#include "coding.h" #if __ANDROID_API__ >= 9 #include @@ -248,8 +250,14 @@ struct android_special_vnode /* Function called to create the initial vnode from the rest of the component. */ struct android_vnode *(*initial) (char *, size_t); + + /* If non-nil, an encoding system into which file name buffers are to + be re-encoded before being handed to VFS functions. */ + Lisp_Object special_coding_system; }; +verify (NIL_IS_ZERO); /* special_coding_system above. */ + enum android_vnode_type { ANDROID_VNODE_UNIX, @@ -3867,7 +3875,8 @@ android_saf_root_readdir (struct android_vdir *vdir) NULL); android_exception_check_nonnull ((void *) chars, string); - /* Figure out how large it is, and then resize dirent to fit. */ + /* Figure out how large it is, and then resize dirent to fit--this + string is always ASCII. */ length = strlen (chars) + 1; size = offsetof (struct dirent, d_name) + length; dirent = xrealloc (dirent, size); @@ -5479,6 +5488,7 @@ android_saf_tree_readdir (struct android_vdir *vdir) jmethodID method; size_t length, size; const char *chars; + struct coding_system coding; dir = (struct android_saf_tree_vdir *) vdir; @@ -5526,9 +5536,25 @@ android_saf_tree_readdir (struct android_vdir *vdir) NULL); android_exception_check_nonnull ((void *) chars, d_name); - /* Figure out how large it is, and then resize dirent to fit. */ + /* Decode this JNI string into utf-8-emacs; see + android_vfs_convert_name for considerations regarding coding + systems. */ + length = strlen (chars); + setup_coding_system (Qandroid_jni, &coding); + coding.mode |= CODING_MODE_LAST_BLOCK; + coding.source = (const unsigned char *) chars; + coding.dst_bytes = 0; + coding.destination = NULL; + decode_coding_object (&coding, Qnil, 0, 0, length, length, Qnil); + + /* Release the string data and the local reference to STRING. */ + (*android_java_env)->ReleaseStringUTFChars (android_java_env, + (jstring) d_name, + chars); + + /* Resize dirent to accommodate the decoded text. */ length = strlen (chars) + 1; - size = offsetof (struct dirent, d_name) + length; + size = offsetof (struct dirent, d_name) + 1 + coding.produced; dirent = xrealloc (dirent, size); /* Clear dirent. */ @@ -5540,12 +5566,12 @@ android_saf_tree_readdir (struct android_vdir *vdir) dirent->d_off = 0; dirent->d_reclen = size; dirent->d_type = d_type ? DT_DIR : DT_UNKNOWN; - strcpy (dirent->d_name, chars); + memcpy (dirent->d_name, coding.destination, coding.produced); + dirent->d_name[coding.produced] = '\0'; + + /* Free the coding system destination buffer. */ + xfree (coding.destination); - /* Release the string data and the local reference to STRING. */ - (*android_java_env)->ReleaseStringUTFChars (android_java_env, - (jstring) d_name, - chars); ANDROID_DELETE_LOCAL_REF (d_name); return dirent; } @@ -6531,9 +6557,35 @@ static struct android_vops root_vfs_ops = static struct android_special_vnode special_vnodes[] = { { "assets", 6, android_afs_initial, }, - { "content", 7, android_content_initial, }, + { "content", 7, android_content_initial, + LISPSYM_INITIALLY (Qandroid_jni), }, }; +/* Convert the file name NAME from Emacs's internal character encoding + to CODING, and return a Lisp string with the data so produced. + + Calling this function creates an implicit assumption that + file-name-coding-system is compatible with utf-8-emacs, which is not + unacceptable as users with cause to modify file-name-coding-system + should be aware and prepared for consequences towards files stored on + different filesystems, including virtual ones. */ + +static Lisp_Object +android_vfs_convert_name (const char *name, Lisp_Object coding) +{ + Lisp_Object src_coding, name1; + + src_coding = Qutf_8_emacs; + + /* Convert the contents of the buffer after BUFFER_END + from the file name coding system to + special->special_coding_system. */ + AUTO_STRING (file_name, name); + name1 = code_convert_string_norecord (file_name, src_coding, false); + name1 = code_convert_string (name1, coding, Qt, true, true, true); + return name1; +} + static struct android_vnode * android_root_name (struct android_vnode *vnode, char *name, size_t length) @@ -6541,6 +6593,8 @@ android_root_name (struct android_vnode *vnode, char *name, char *component_end; struct android_special_vnode *special; size_t i; + Lisp_Object file_name; + struct android_vnode *vp; /* Skip any leading separator in NAME. */ @@ -6567,8 +6621,29 @@ android_root_name (struct android_vnode *vnode, char *name, if (component_end - name == special->length && !memcmp (special->name, name, special->length)) - return (*special->initial) (component_end, - length - special->length); + { + if (!NILP (special->special_coding_system)) + { + USE_SAFE_ALLOCA; + + file_name + = android_vfs_convert_name (component_end, + special->special_coding_system); + + /* Allocate a buffer and copy file_name into the same. */ + length = SBYTES (file_name) + 1; + name = SAFE_ALLOCA (length + 1); + + /* Copy the trailing NULL byte also. */ + memcpy (name, SDATA (file_name), length); + vp = (*special->initial) (name, length - 1); + SAFE_FREE (); + return vp; + } + + return (*special->initial) (component_end, + length - special->length); + } /* Detect the case where a special is named with a trailing directory separator. */ @@ -6576,9 +6651,30 @@ android_root_name (struct android_vnode *vnode, char *name, if (component_end - name == special->length + 1 && !memcmp (special->name, name, special->length) && name[special->length] == '/') - /* Make sure to include the directory separator. */ - return (*special->initial) (component_end - 1, - length - special->length); + { + if (!NILP (special->special_coding_system)) + { + USE_SAFE_ALLOCA; + + file_name + = android_vfs_convert_name (component_end - 1, + special->special_coding_system); + + /* Allocate a buffer and copy file_name into the same. */ + length = SBYTES (file_name) + 1; + name = SAFE_ALLOCA (length + 1); + + /* Copy the trailing NULL byte also. */ + memcpy (name, SDATA (file_name), length); + vp = (*special->initial) (name, length - 1); + SAFE_FREE (); + return vp; + } + + /* Make sure to include the directory separator. */ + return (*special->initial) (component_end - 1, + length - special->length); + } } /* Otherwise, continue searching for a vnode normally. */ @@ -6589,8 +6685,9 @@ android_root_name (struct android_vnode *vnode, char *name, /* File system lookup. */ -/* Look up the vnode that designates NAME, a file name that is at - least N bytes. +/* Look up the vnode that designates NAME, a file name that is at least + N bytes, converting between different file name coding systems as + necessary. NAME may be either an absolute file name or a name relative to the current working directory. It must not be longer than EMACS_PATH_MAX @@ -7605,3 +7702,11 @@ android_closedir (struct android_vdir *dirp) { return (*dirp->closedir) (dirp); } + + + +void +syms_of_androidvfs (void) +{ + DEFSYM (Qandroid_jni, "android-jni"); +} diff --git a/src/emacs.c b/src/emacs.c index f4bfb9a6bbd..87f12d3fa86 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2444,6 +2444,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #if !defined ANDROID_STUBIFY syms_of_androidfont (); syms_of_androidselect (); + syms_of_androidvfs (); syms_of_sfntfont (); syms_of_sfntfont_android (); #endif /* !ANDROID_STUBIFY */ -- cgit v1.2.3 From 6235212d736ca4f0b0a1900c42c30d82747d7798 Mon Sep 17 00:00:00 2001 From: Dionisio E Alonso Date: Wed, 20 Mar 2024 17:06:30 +0200 Subject: Add BasedPyright LSP server alternative for Eglot's 'python-mode' * lisp/progmodes/eglot.el (eglot-server-programs): Add BasedPyright, a new server for python, forked from the unmaintained 'pyright' LSP server. (Bug#69925) Copyright-paperwork-exempt: yes --- lisp/progmodes/eglot.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index b3fd104a227..7d2f1a55165 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -238,7 +238,8 @@ automatically)." (vimrc-mode . ("vim-language-server" "--stdio")) ((python-mode python-ts-mode) . ,(eglot-alternatives - '("pylsp" "pyls" ("pyright-langserver" "--stdio") + '("pylsp" "pyls" ("basedpyright-langserver" "--stdio") + ("pyright-langserver" "--stdio") "jedi-language-server" "ruff-lsp"))) ((js-json-mode json-mode json-ts-mode) . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") -- cgit v1.2.3 From e52bc9ef6f7942b15d876566aca52340210ac27c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Mar 2024 09:51:47 +0200 Subject: Avoid infinite recursion in 'image-mode--display' * lisp/image-mode.el (image-mode): Suspend major mode only if it is not already 'image-mode'. (Bug#69785) --- lisp/image-mode.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 355685e70fd..fa64f1ac03e 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -654,8 +654,9 @@ Key bindings: (unless (display-images-p) (error "Display does not support images")) - (major-mode-suspend) - (setq major-mode 'image-mode) + (unless (eq major-mode 'image-mode) + (major-mode-suspend) + (setq major-mode 'image-mode)) (setq image-transform-resize image-auto-resize) ;; Bail out early if we have no image data. -- cgit v1.2.3 From 2fb6f252bfe2cd06a49975bc97a794fb70392538 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Mar 2024 11:09:57 +0200 Subject: Improve support for preprocessor macros in 'c/c++-ts-mode' * lisp/progmodes/c-ts-mode.el (c-ts-mode--defun-name) (c-ts-base-mode): Support preprocessor macros as defuns. This fixes both navigation by defuns and add-log when cpp macros are at point. --- lisp/progmodes/c-ts-mode.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index a2e7f6fba2e..8383979a373 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -911,7 +911,8 @@ Return nil if NODE is not a defun node or doesn't have a name." t)) ((or "struct_specifier" "enum_specifier" "union_specifier" "class_specifier" - "namespace_definition") + "namespace_definition" + "preproc_def" "preproc_function_def") (treesit-node-child-by-field-name node "name")) ;; DEFUNs in Emacs sources. ("expression_statement" @@ -1205,7 +1206,9 @@ BEG and END are described in `treesit-range-rules'." "enum_specifier" "union_specifier" "class_specifier" - "namespace_definition") + "namespace_definition" + "preproc_def" + "preproc_function_def") (and c-ts-mode-emacs-sources-support '(;; DEFUN. "expression_statement" -- cgit v1.2.3 From 5769a1053087a278d48836e1f366e0bd87c95809 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Mar 2024 11:50:55 +0200 Subject: ; Fix doc strings of some treesit-related functions * lisp/treesit.el (treesit-defun-tactic) (treesit-defun-name-function, treesit-thing-at-point) (treesit-defun-at-point): * lisp/progmodes/c-ts-common.el (c-ts-common-statement-offset): * lisp/progmodes/c-ts-mode.el (c-ts-mode-toggle-comment-style) (c-ts-mode-indent-style, c-ts-mode-emacs-sources-support) (c-ts-mode--syntax-propertize, c-ts-mode--anchor-prev-sibling) (c-ts-mode--standalone-parent-skip-preproc) (c-ts-mode--standalone-grandparent, c-ts-mode--else-heuristic) (c-ts-mode--declarator-identifier) (c-ts-mode--fontify-declarator, c-ts-mode--fontify-variable) (c-ts-mode--defun-valid-p) (c-ts-mode--defun-for-class-in-imenu-p) (c-ts-mode--defun-skipper, c-ts-mode--emacs-defun-p) (c-ts-mode--emacs-defun-at-point) (c-ts-mode--emacs-current-defun-name, c-ts-mode--reverse-ranges) (c-ts-mode, c++-ts-mode, c-or-c++-ts-mode): Doc fixes. --- lisp/progmodes/c-ts-common.el | 2 +- lisp/progmodes/c-ts-mode.el | 64 ++++++++++++++++++++++--------------------- lisp/treesit.el | 21 +++++++------- 3 files changed, 44 insertions(+), 43 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index 0095d83e302..e48bcc64f14 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -332,7 +332,7 @@ Assumes the anchor is (point-min), i.e., the 0th column. This function basically counts the number of block nodes (i.e., brackets) (see `c-ts-common-indent-type-regexp-alist') between NODE and the root node (not counting NODE itself), and -multiply that by `c-ts-common-indent-offset'. +multiplies that by `c-ts-common-indent-offset'. To support GNU style, on each block level, this function also checks whether the opening bracket { is on its own line, if so, diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 8383979a373..3a89f0f494b 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -97,7 +97,7 @@ "Toggle the comment style between block and line comments. Optional numeric ARG, if supplied, switches to block comment style when positive, to line comment style when negative, and -just toggles it when zero or left out." +just toggles it when zero or omitted." (interactive "P") (let ((prevstate-line (string= comment-start "// "))) (when (or (not arg) @@ -147,9 +147,9 @@ symbol." "Style used for indentation. The selected style could be one of GNU, K&R, LINUX or BSD. If -one of the supplied styles doesn't suffice, a function could be -set instead. This function is expected to return a list that -follows the form of `treesit-simple-indent-rules'." +one of the supplied styles doesn't suffice, the value could be +a function instead. This function is expected to return a list +that follows the form of `treesit-simple-indent-rules'." :version "29.1" :type '(choice (symbol :tag "Gnu" gnu) (symbol :tag "K&R" k&r) @@ -202,8 +202,8 @@ To set the default indent style globally, use (if (derived-mode-p 'c-ts-mode) 'c 'cpp)))))) (defcustom c-ts-mode-emacs-sources-support t - "Whether to enable Emacs source-specific features. -This enables detection of definitions of Lisp function using + "Whether to enable Emacs source-specific C features. +This enables detection of definitions of Lisp functions via the DEFUN macro. This needs to be set before enabling `c-ts-mode'; if you change the value after enabling `c-ts-mode', toggle the mode off and on @@ -243,7 +243,7 @@ again." < and > are usually punctuation, e.g., in ->. But when used for templates, they should be considered pairs. -This function checks for < and > in the changed RANGES and apply +This function checks for < and > in the changed RANGES and applies appropriate text property to alter the syntax of template delimiters < and >'s." (goto-char beg) @@ -284,9 +284,9 @@ is actually the parent of point at the moment of indentation." "Return the start of the previous named sibling of NODE. This anchor handles the special case where the previous sibling -is a labeled_statement, in that case, return the child of the +is a labeled_statement; in that case, return the child of the labeled statement instead. (Actually, recursively go down until -the node isn't a labeled_statement.) Eg, +the node isn't a labeled_statement.) E.g., label: int x = 1; @@ -295,10 +295,11 @@ label: The anchor of \"int y = 2;\" should be \"int x = 1;\" rather than the labeled_statement. -Return nil if a) there is no prev-sibling, or 2) prev-sibling +Return nil if a) there is no prev-sibling, or b) prev-sibling doesn't have a child. -PARENT and BOL are like other anchor functions." +PARENT is NODE's parent, BOL is the beginning of non-whitespace +characters of the current line." (when-let ((prev-sibling (or (treesit-node-prev-sibling node t) (treesit-node-prev-sibling @@ -336,7 +337,7 @@ PARENT and BOL are like other anchor functions." (defun c-ts-mode--standalone-parent-skip-preproc (_n parent &rest _) "Like the standalone-parent anchor but skips preproc nodes. -PARENT is the same as other anchor functions." +PARENT is the parent of the current node." (save-excursion (treesit-node-start (treesit-parent-until @@ -353,13 +354,15 @@ PARENT is the same as other anchor functions." (defun c-ts-mode--standalone-grandparent (_node parent bol &rest args) "Like the standalone-parent anchor but pass it the grandparent. -PARENT, BOL, ARGS are the same as other anchor functions." +PARENT is NODE's parent, BOL is the beginning of non-whitespace +characters of the current line." (apply (alist-get 'standalone-parent treesit-simple-indent-presets) parent (treesit-node-parent parent) bol args)) (defun c-ts-mode--else-heuristic (node parent bol &rest _) "Heuristic matcher for when \"else\" is followed by a closing bracket. -NODE, PARENT, and BOL are the same as in other matchers." +PARENT is NODE's parent, BOL is the beginning of non-whitespace +characters of the current line." (and (null node) (save-excursion (forward-line -1) @@ -757,7 +760,7 @@ MODE is either `c' or `cpp'." (defun c-ts-mode--declarator-identifier (node &optional qualified) "Return the identifier of the declarator node NODE. -If QUALIFIED is non-nil, include the names space part of the +If QUALIFIED is non-nil, include the namespace part of the identifier and return a qualified_identifier." (pcase (treesit-node-type node) ;; Recurse. @@ -782,7 +785,7 @@ identifier and return a qualified_identifier." node))) (defun c-ts-mode--fontify-declarator (node override start end &rest _args) - "Fontify a declarator (whatever under the \"declarator\" field). + "Fontify a declarator (whatever is under the \"declarator\" field). For NODE, OVERRIDE, START, END, and ARGS, see `treesit-font-lock-rules'." (let* ((identifier (c-ts-mode--declarator-identifier node)) @@ -817,7 +820,7 @@ For NODE, OVERRIDE, START, END, and ARGS, see (defun c-ts-mode--fontify-variable (node override start end &rest _) "Fontify an identifier node if it is a variable. -Don't fontify if it is a function identifier. For NODE, +Don't fontify it if it is a function identifier. For NODE, OVERRIDE, START, END, and ARGS, see `treesit-font-lock-rules'." (when (not (equal (treesit-node-type (treesit-node-parent node)) @@ -938,7 +941,7 @@ Return nil if NODE is not a defun node or doesn't have a name." (defun c-ts-mode--defun-valid-p (node) "Return non-nil if NODE is a valid defun node. -Ie, NODE is not nested." +That is, NODE is not nested." (let ((top-level-p (lambda (node) (not (treesit-node-top-level node (rx (or "function_definition" @@ -977,8 +980,7 @@ Basically, if NODE is a class, return non-nil; if NODE is a function but is under a class, return non-nil; if NODE is a top-level function, return nil. -This is for the Class subindex in -`treesit-simple-imenu-settings'." +This is for the Class subindex in `treesit-simple-imenu-settings'." (pcase (treesit-node-type node) ;; The Class subindex only has class_specifier and ;; function_definition. @@ -989,7 +991,7 @@ This is for the Class subindex in (defun c-ts-mode--defun-skipper () "Custom defun skipper for `c-ts-mode' and friends. -Structs in C ends with a semicolon, but the semicolon is not +Structs in C end with a semicolon, but the semicolon is not considered part of the struct node, so point would stop before the semicolon. This function skips the semicolon." (when (looking-at (rx (* (or " " "\t")) ";")) @@ -1009,7 +1011,7 @@ the semicolon. This function skips the semicolon." (list node parent bol))) (defun c-ts-mode--emacs-defun-p (node) - "Return non-nil if NODE is a Lisp function defined using DEFUN. + "Return non-nil if NODE is a Lisp function defined via DEFUN. This function detects Lisp primitives defined in Emacs source files using the DEFUN macro." (and (equal (treesit-node-type node) "expression_statement") @@ -1030,15 +1032,15 @@ files using the DEFUN macro." "Return the defun node at point. In addition to regular C functions, this function recognizes -definitions of Lisp primitrives in Emacs source files using DEFUN, -if `c-ts-mode-emacs-sources-support' is non-nil. +definitions of Lisp primitrives in Emacs source files defined +via DEFUN, if `c-ts-mode-emacs-sources-support' is non-nil. Note that DEFUN is parsed by tree-sitter as two separate nodes, one for the declaration and one for the body; this function returns the declaration node. If RANGE is non-nil, return (BEG . END) where BEG end END -encloses the whole defun. This is for when the entire defun +enclose the whole defun. This is for when the entire defun is required, not just the declaration part for DEFUN." (when-let* ((node (treesit-defun-at-point)) (defun-range (cons (treesit-node-start node) @@ -1067,7 +1069,7 @@ is required, not just the declaration part for DEFUN." "Return the name of the current defun. This is used for `add-log-current-defun-function'. In addition to regular C functions, this function also recognizes -Emacs primitives defined using DEFUN in Emacs sources, +Emacs primitives defined via DEFUN in Emacs sources, if `c-ts-mode-emacs-sources-support' is non-nil." (or (treesit-add-log-current-defun) (c-ts-mode--defun-name (c-ts-mode--emacs-defun-at-point)))) @@ -1145,7 +1147,7 @@ For BOL see `treesit-simple-indent-rules'." (defun c-ts-mode--reverse-ranges (ranges beg end) "Reverse RANGES and return the new ranges between BEG and END. -Positions that were included RANGES are not in the returned +Positions that were included in RANGES are not in the returned ranges, and vice versa. Return nil if RANGES is nil. This way, passing the returned @@ -1287,7 +1289,7 @@ BEG and END are described in `treesit-range-rules'." This mode is independent from the classic cc-mode.el based `c-mode', so configuration variables of that mode, like -`c-basic-offset', doesn't affect this mode. +`c-basic-offset', don't affect this mode. To use tree-sitter C/C++ modes by default, evaluate @@ -1296,7 +1298,7 @@ To use tree-sitter C/C++ modes by default, evaluate (add-to-list \\='major-mode-remap-alist \\='(c-or-c++-mode . c-or-c++-ts-mode)) -in your configuration." +in your init files." :group 'c :after-hook (c-ts-mode-set-modeline) @@ -1348,7 +1350,7 @@ To use tree-sitter C/C++ modes by default, evaluate (add-to-list \\='major-mode-remap-alist \\='(c-or-c++-mode . c-or-c++-ts-mode)) -in your configuration. +in your init files. Since this mode uses a parser, unbalanced brackets might cause some breakage in indentation/fontification. Therefore, it's @@ -1443,7 +1445,7 @@ matching on file name insufficient for detecting major mode that should be used. This function attempts to use file contents to determine whether -the code is C or C++ and based on that chooses whether to enable +the code is C or C++, and based on that chooses whether to enable `c-ts-mode' or `c++-ts-mode'." (declare (obsolete c-or-c++-mode "30.1")) (interactive) diff --git a/lisp/treesit.el b/lisp/treesit.el index fa82ad898a9..2b4893e6129 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2237,7 +2237,7 @@ for invalid node. This is used by `treesit-beginning-of-defun' and friends.") (defvar-local treesit-defun-tactic 'nested - "Determines how does Emacs treat nested defuns. + "Determines how Emacs treats nested defuns. If the value is `top-level', Emacs only moves across top-level defuns, if the value is `nested', Emacs recognizes nested defuns.") @@ -2253,9 +2253,8 @@ If the value is nil, no skipping is performed.") (defvar-local treesit-defun-name-function nil "A function that is called with a node and returns its defun name or nil. If the node is a defun node, return the defun name, e.g., the -function name of a function. If the node is not a defun node, or -the defun node doesn't have a name, or the node is nil, return -nil.") +name of a function. If the node is not a defun node, or the +defun node doesn't have a name, or the node is nil, return nil.") (defvar-local treesit-add-log-defun-delimiter "." "The delimiter used to connect several defun names. @@ -2728,12 +2727,12 @@ function is called recursively." ;; TODO: In corporate into thing-at-point. (defun treesit-thing-at-point (thing tactic) - "Return the THING at point or nil if none is found. + "Return the THING at point, or nil if none is found. -THING can be a symbol, regexp, a predicate function, and more, +THING can be a symbol, a regexp, a predicate function, and more; see `treesit-thing-settings' for details. -Return the top-level THING if TACTIC is `top-level', return the +Return the top-level THING if TACTIC is `top-level'; return the smallest enclosing THING as POS if TACTIC is `nested'." (let ((node (treesit--thing-at (point) thing))) @@ -2742,11 +2741,11 @@ smallest enclosing THING as POS if TACTIC is `nested'." node))) (defun treesit-defun-at-point () - "Return the defun node at point or nil if none is found. + "Return the defun node at point, or nil if none is found. -Respects `treesit-defun-tactic': return the top-level defun if it -is `top-level', return the immediate parent defun if it is -`nested'. +Respects `treesit-defun-tactic': returns the top-level defun if it +is `top-level', otherwise return the immediate parent defun if it +is `nested'. Return nil if `treesit-defun-type-regexp' isn't set and `defun' isn't defined in `treesit-thing-settings'." -- cgit v1.2.3 From abc2d39e0102f8bb554d89da3c0ffe57188220ff Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Sat, 16 Mar 2024 17:11:24 +0000 Subject: Use 'regexp-opt' in 'dired-omit-regexp' In my benchmarking, for large dired buffers, using 'regexp-opt' provides around a 3x speedup in omitting. 'regexp-opt' takes around 5 milliseconds, so to avoid slowing down omitting in small dired buffers we cache the return value. Since omitting is now 3x faster, increase 'dired-omit-size-limit' by 3x. Also, document 'dired-omit-size-limit' better. * doc/misc/dired-x.texi (Omitting Variables): Document 'dired-omit-size-limit'. * etc/NEWS: Announce increase of 'dired-omit-size-limit'. * lisp/dired-x.el (dired-omit--extension-regexp-cache): Add. (dired-omit-regexp): Use 'regexp-opt'. (Bug#69775) (dired-omit-size-limit): Increase and improve docs. --- doc/misc/dired-x.texi | 9 +++++++++ etc/NEWS | 6 ++++++ lisp/dired-x.el | 26 ++++++++++++++++++++------ 3 files changed, 35 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index 4cad016a0f6..726b6653d0d 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -346,6 +346,15 @@ only match against the non-directory part of the file name. Set it to match the file name relative to the buffer's top-level directory. @end defvar +@defvar dired-omit-size-limit +If non-@code{nil}, @code{dired-omit-mode} will be effectively disabled +in directories whose listing has size (in bytes) larger than the value +of this option. Since omitting can be slow for very large directories, +this avoids having to wait before seeing the directory. This variable +is ignored when @code{dired-omit-mode} is called interactively, such as +by @code{C-x M-o}, so you can still enable omitting in the directory +after the initial display. + @cindex omitting additional files @defvar dired-omit-marker-char Temporary marker used by Dired to implement omitting. Should never be used diff --git a/etc/NEWS b/etc/NEWS index f4b4c30855c..e9cb455aa40 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -705,6 +705,12 @@ marked or clicked on files according to the OS conventions. For example, on systems supporting XDG, this runs 'xdg-open' on the files. +*** The default value of 'dired-omit-size-limit' was increased. +After performance improvements to omitting in large directories, the new +default value is 300k, up from 100k. This means 'dired-omit-mode' will +omit files in directories whose directory listing is up to 300 kilobytes +in size. + +++ *** 'dired-listing-switches' handles connection-local values if exist. This allows to customize different switches for different remote machines. diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 62fdd916e69..753d3054d2f 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -77,12 +77,17 @@ files not writable by you are visited read-only." (other :tag "non-writable only" if-file-read-only)) :group 'dired-x) -(defcustom dired-omit-size-limit 100000 - "Maximum size for the \"omitting\" feature. +(defcustom dired-omit-size-limit 300000 + "Maximum buffer size for `dired-omit-mode'. + +Omitting will be disabled if the directory listing exceeds this size in +bytes. This variable is ignored when `dired-omit-mode' is called +interactively. + If nil, there is no maximum size." :type '(choice (const :tag "no maximum" nil) integer) :group 'dired-x - :version "29.1") + :version "30.1") (defcustom dired-omit-case-fold 'filesystem "Determine whether \"omitting\" patterns are case-sensitive. @@ -506,14 +511,23 @@ status message." (re-search-forward dired-re-mark nil t)))) count))) +(defvar dired-omit--extension-regexp-cache + nil + "A cache of `regexp-opt' applied to `dired-omit-extensions'. + +This is a cons whose car is a list of strings and whose cdr is a +regexp produced by `regexp-opt'.") + (defun dired-omit-regexp () + (unless (equal dired-omit-extensions (car dired-omit--extension-regexp-cache)) + (setq dired-omit--extension-regexp-cache + (cons dired-omit-extensions (regexp-opt dired-omit-extensions)))) (concat (if dired-omit-files (concat "\\(" dired-omit-files "\\)") "") (if (and dired-omit-files dired-omit-extensions) "\\|" "") (if dired-omit-extensions (concat ".";; a non-extension part should exist - "\\(" - (mapconcat 'regexp-quote dired-omit-extensions "\\|") - "\\)$") + (cdr dired-omit--extension-regexp-cache) + "$") ""))) ;; Returns t if any work was done, nil otherwise. -- cgit v1.2.3 From 72972118e6f5831f200108cd7b80bf86538c265e Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Sun, 17 Mar 2024 12:01:59 -0700 Subject: Allow toggling "readable" mode in EWW Additionally, add an option to prevent adding a new history entry for each call of 'eww-readable' (bug#68254). * lisp/net/eww.el (eww-retrieve): * lisp/net/eww.el (eww-readable-adds-to-history): New option. (eww-retrieve): Make sure we call CALLBACK in all configurations. (eww-render): Simplify how to pass encoding. (eww--parse-html-region, eww-display-document): New functions, extracted from... (eww-display-html): ... here. (eww-document-base): New function. (eww-readable): Toggle "readable" mode interactively, like with a minor mode. Consult 'eww-readable-adds-to-history'. (eww-reload): Use 'eshell-display-document'. * test/lisp/net/eww-tests.el (eww-test--with-mock-retrieve): Fix indent. (eww-test/display/html, eww-test/readable/toggle-display): New tests. * doc/misc/eww.texi (Basics): Describe the new behavior. * etc/NEWS: Announce this change. --- doc/misc/eww.texi | 5 ++ etc/NEWS | 12 +++++ lisp/net/eww.el | 127 +++++++++++++++++++++++++++++---------------- test/lisp/net/eww-tests.el | 57 +++++++++++++++++++- 4 files changed, 155 insertions(+), 46 deletions(-) (limited to 'lisp') diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index d31fcf1802b..522034c874d 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -146,6 +146,11 @@ a new tab is created on the frame tab bar. which part of the document contains the ``readable'' text, and will only display this part. This usually gets rid of menus and the like. + When called interactively, this command toggles the display of the +readable parts. With a positive prefix argument, this command always +displays the readable parts, and with a zero or negative prefix, it +always displays the full page. + @findex eww-toggle-fonts @vindex shr-use-fonts @kindex F diff --git a/etc/NEWS b/etc/NEWS index e9cb455aa40..30eaaf40385 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1066,6 +1066,18 @@ entries newer than the current page. To change the behavior when browsing from "historical" pages, you can customize 'eww-before-browse-history-function'. ++++ +*** 'eww-readable' now toggles display of the readable parts of a web page. +When called interactively, 'eww-readable' toggles whether to display +only the readable parts of a page or the full page. With a positive +prefix argument, it always displays the readable parts, and with a zero +or negative prefix, it always displays the full page. + +--- +*** New option 'eww-readable-adds-to-history'. +When non-nil (the default), calling 'eww-readable' adds a new entry to +the EWW page history. + ** go-ts-mode +++ diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 54847bdf396..54b65d35164 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -275,6 +275,11 @@ parameter, and should return the (possibly) transformed URL." :type '(repeat function) :version "29.1") +(defcustom eww-readable-adds-to-history t + "If non-nil, calling `eww-readable' adds a new entry to the history." + :type 'boolean + :version "30.1") + (defface eww-form-submit '((((type x w32 ns haiku pgtk android) (class color)) ; Like default mode line :box (:line-width 2 :style released-button) @@ -464,11 +469,11 @@ For more information, see Info node `(eww) Top'." (defun eww-retrieve (url callback cbargs) (cond ((null eww-retrieve-command) - (url-retrieve url #'eww-render cbargs)) + (url-retrieve url callback cbargs)) ((eq eww-retrieve-command 'sync) (let ((data-buffer (url-retrieve-synchronously url))) (with-current-buffer data-buffer - (apply #'eww-render nil cbargs)))) + (apply callback nil cbargs)))) (t (let ((buffer (generate-new-buffer " *eww retrieve*")) (error-buffer (generate-new-buffer " *eww error*"))) @@ -673,9 +678,9 @@ The renaming scheme is performed in accordance with (insert (format "Direct link to the document" url)) (goto-char (point-min)) - (eww-display-html charset url nil point buffer encode)) + (eww-display-html (or encode charset) url nil point buffer)) ((eww-html-p (car content-type)) - (eww-display-html charset url nil point buffer encode)) + (eww-display-html (or encode charset) url nil point buffer)) ((equal (car content-type) "application/pdf") (eww-display-pdf)) ((string-match-p "\\`image/" (car content-type)) @@ -726,34 +731,40 @@ The renaming scheme is performed in accordance with (declare-function libxml-parse-html-region "xml.c" (start end &optional base-url discard-comments)) -(defun eww-display-html (charset url &optional document point buffer encode) +(defun eww--parse-html-region (start end &optional coding-system) + "Parse the HTML between START and END, returning the DOM as an S-expression. +Use CODING-SYSTEM to decode the region; if nil, decode as UTF-8. + +This replaces the region with the preprocessed HTML." + (setq coding-system (or coding-system 'utf-8)) + (with-restriction start end + (condition-case nil + (decode-coding-region (point-min) (point-max) coding-system) + (coding-system-error nil)) + ;; Remove CRLF and replace NUL with � before parsing. + (while (re-search-forward "\\(\r$\\)\\|\0" nil t) + (replace-match (if (match-beginning 1) "" "�") t t)) + (eww--preprocess-html (point-min) (point-max)) + (libxml-parse-html-region (point-min) (point-max)))) + +(defsubst eww-document-base (url dom) + `(base ((href . ,url)) ,dom)) + +(defun eww-display-document (document &optional point buffer) (unless (fboundp 'libxml-parse-html-region) (error "This function requires Emacs to be compiled with libxml2")) + (setq buffer (or buffer (current-buffer))) (unless (buffer-live-p buffer) (error "Buffer %s doesn't exist" buffer)) ;; There should be a better way to abort loading images ;; asynchronously. (setq url-queue nil) - (let ((document - (or document - (list - 'base (list (cons 'href url)) - (progn - (setq encode (or encode charset 'utf-8)) - (condition-case nil - (decode-coding-region (point) (point-max) encode) - (coding-system-error nil)) - (save-excursion - ;; Remove CRLF and replace NUL with � before parsing. - (while (re-search-forward "\\(\r$\\)\\|\0" nil t) - (replace-match (if (match-beginning 1) "" "�") t t))) - (eww--preprocess-html (point) (point-max)) - (libxml-parse-html-region (point) (point-max)))))) - (source (and (null document) - (buffer-substring (point) (point-max))))) + (let ((url (when (eq (car document) 'base) + (alist-get 'href (cadr document))))) + (unless url + (error "Document is missing base URL")) (with-current-buffer buffer (setq bidi-paragraph-direction nil) - (plist-put eww-data :source source) (plist-put eww-data :dom document) (let ((inhibit-read-only t) (inhibit-modification-hooks t) @@ -794,6 +805,16 @@ The renaming scheme is performed in accordance with (forward-line 1))))) (eww-size-text-inputs)))) +(defun eww-display-html (charset url &optional document point buffer) + (let ((source (buffer-substring (point) (point-max)))) + (with-current-buffer buffer + (plist-put eww-data :source source))) + (eww-display-document + (or document + (eww-document-base + url (eww--parse-html-region (point) (point-max) charset))) + point buffer)) + (defun eww-handle-link (dom) (let* ((rel (dom-attr dom 'rel)) (href (dom-attr dom 'href)) @@ -1055,30 +1076,47 @@ The renaming scheme is performed in accordance with "automatic" bidi-paragraph-direction))) -(defun eww-readable () - "View the main \"readable\" parts of the current web page. +(defun eww-readable (&optional arg) + "Toggle display of only the main \"readable\" parts of the current web page. This command uses heuristics to find the parts of the web page that -contains the main textual portion, leaving out navigation menus and -the like." - (interactive nil eww-mode) +contain the main textual portion, leaving out navigation menus and the +like. + +If called interactively, toggle the display of the readable parts. If +the prefix argument is positive, display the readable parts, and if it +is zero or negative, display the full page. + +If called from Lisp, toggle the display of the readable parts if ARG is +`toggle'. Display the readable parts if ARG is nil, omitted, or is a +positive number. Display the full page if ARG is a negative number. + +When `eww-readable-adds-to-history' is non-nil, calling this function +adds a new entry to `eww-history'." + (interactive (list (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + 'toggle)) + eww-mode) (let* ((old-data eww-data) - (dom (with-temp-buffer + (make-readable (cond + ((eq arg 'toggle) + (not (plist-get old-data :readable))) + ((and (numberp arg) (< arg 1)) + nil) + (t t))) + (dom (with-temp-buffer (insert (plist-get old-data :source)) - (condition-case nil - (decode-coding-region (point-min) (point-max) 'utf-8) - (coding-system-error nil)) - (eww--preprocess-html (point-min) (point-max)) - (libxml-parse-html-region (point-min) (point-max)))) + (eww--parse-html-region (point-min) (point-max)))) (base (plist-get eww-data :url))) - (eww-score-readability dom) - (eww-save-history) - (eww--before-browse) - (eww-display-html nil nil - (list 'base (list (cons 'href base)) - (eww-highest-readability dom)) - nil (current-buffer)) - (dolist (elem '(:source :url :title :next :previous :up :peer)) - (plist-put eww-data elem (plist-get old-data elem))) + (when make-readable + (eww-score-readability dom) + (setq dom (eww-highest-readability dom))) + (when eww-readable-adds-to-history + (eww-save-history) + (eww--before-browse) + (dolist (elem '(:source :url :title :next :previous :up :peer)) + (plist-put eww-data elem (plist-get old-data elem)))) + (eww-display-document (eww-document-base base dom)) + (plist-put eww-data :readable make-readable) (eww--after-page-change))) (defun eww-score-readability (node) @@ -1398,8 +1436,7 @@ just re-display the HTML already fetched." (if local (if (null (plist-get eww-data :dom)) (error "No current HTML data") - (eww-display-html 'utf-8 url (plist-get eww-data :dom) - (point) (current-buffer))) + (eww-display-document (plist-get eww-data :dom) (point))) (let ((parsed (url-generic-parse-url url))) (if (equal (url-type parsed) "file") ;; Use Tramp instead of url.el for files (since url.el diff --git a/test/lisp/net/eww-tests.el b/test/lisp/net/eww-tests.el index bd00893d503..a09e0a4f279 100644 --- a/test/lisp/net/eww-tests.el +++ b/test/lisp/net/eww-tests.el @@ -33,7 +33,7 @@ body.") "Evaluate BODY with a mock implementation of `eww-retrieve'. This avoids network requests during our tests. Additionally, prepare a temporary EWW buffer for our tests." - (declare (indent 1)) + (declare (indent 0)) `(cl-letf (((symbol-function 'eww-retrieve) (lambda (url callback args) (with-temp-buffer @@ -48,6 +48,24 @@ temporary EWW buffer for our tests." ;;; Tests: +(ert-deftest eww-test/display/html () + "Test displaying a simple HTML page." + (eww-test--with-mock-retrieve + (let ((eww-test--response-function + (lambda (url) + (concat "Content-Type: text/html\n\n" + (format "

Hello

%s" + url))))) + (eww "example.invalid") + ;; Check that the buffer contains the rendered HTML. + (should (equal (buffer-string) "Hello\n\n\nhttp://example.invalid/\n")) + (should (equal (get-text-property (point-min) 'face) + '(shr-text shr-h1))) + ;; Check that the DOM includes the `base'. + (should (equal (pcase (plist-get eww-data :dom) + (`(base ((href . ,url)) ,_) url)) + "http://example.invalid/"))))) + (ert-deftest eww-test/history/new-page () "Test that when visiting a new page, the previous one goes into the history." (eww-test--with-mock-retrieve @@ -176,5 +194,42 @@ This sets `eww-before-browse-history-function' to "http://one.invalid/"))) (should (= eww-history-position 0))))) +(ert-deftest eww-test/readable/toggle-display () + "Test toggling the display of the \"readable\" parts of a web page." + (eww-test--with-mock-retrieve + (let* ((shr-width most-positive-fixnum) + (shr-use-fonts nil) + (words (string-join + (make-list + 20 "All work and no play makes Jack a dull boy.") + " ")) + (eww-test--response-function + (lambda (_url) + (concat "Content-Type: text/html\n\n" + "" + "This is an uninteresting sentence." + "
" + words + "
" + "")))) + (eww "example.invalid") + ;; Make sure EWW renders the whole document. + (should-not (plist-get eww-data :readable)) + (should (string-prefix-p + "This is an uninteresting sentence." + (buffer-substring-no-properties (point-min) (point-max)))) + (eww-readable 'toggle) + ;; Now, EWW should render just the "readable" parts. + (should (plist-get eww-data :readable)) + (should (string-match-p + (concat "\\`" (regexp-quote words) "\n*\\'") + (buffer-substring-no-properties (point-min) (point-max)))) + (eww-readable 'toggle) + ;; Finally, EWW should render the whole document again. + (should-not (plist-get eww-data :readable)) + (should (string-prefix-p + "This is an uninteresting sentence." + (buffer-substring-no-properties (point-min) (point-max))))))) + (provide 'eww-tests) ;; eww-tests.el ends here -- cgit v1.2.3 From 4b0f5cdb01fbd05c8184a89fa8543eb5600fb4f8 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Mon, 18 Mar 2024 16:52:34 -0700 Subject: Add 'eww-readable-urls' * lisp/net/eww.el (eww-readable-urls): New option. (eww-default-readable-p): New function... (eww-display-html): ... use it. * test/lisp/net/eww-tests.el (eww-test/readable/default-readable): New test. * doc/misc/eww.texi (Basics): Document 'eww-readable-urls'. * etc/NEWS: Announce this change (bug#68254). --- doc/misc/eww.texi | 16 ++++++++++++++++ etc/NEWS | 6 ++++++ lisp/net/eww.el | 43 ++++++++++++++++++++++++++++++++++++++----- test/lisp/net/eww-tests.el | 12 ++++++++++++ 4 files changed, 72 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index 522034c874d..eec6b3c3299 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -151,6 +151,22 @@ readable parts. With a positive prefix argument, this command always displays the readable parts, and with a zero or negative prefix, it always displays the full page. +@vindex eww-readable-urls + If you want EWW to render a certain page in ``readable'' mode by +default, you can add a regular expression matching its URL to +@code{eww-readable-urls}. Each entry can either be a regular expression +in string form or a cons cell of the form +@w{@code{(@var{regexp} . @var{readability})}}. If @var{readability} is +non-@code{nil}, this behaves the same as the string form; otherwise, +URLs matching @var{regexp} will never be displayed in readable mode by +default. For example, you can use this to make all pages default to +readable mode, except for a few outliers: + +@example +(setq eww-readable-urls '(("https://example\\.com/" . nil) + ".*")) +@end example + @findex eww-toggle-fonts @vindex shr-use-fonts @kindex F diff --git a/etc/NEWS b/etc/NEWS index 30eaaf40385..c6b654a9d3b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1073,6 +1073,12 @@ only the readable parts of a page or the full page. With a positive prefix argument, it always displays the readable parts, and with a zero or negative prefix, it always displays the full page. ++++ +*** New option 'eww-readable-urls'. +This is a list of regular expressions matching the URLs where EWW should +display only the readable parts by default. For more details, see +"(eww) Basics" in the EWW manual. + --- *** New option 'eww-readable-adds-to-history'. When non-nil (the default), calling 'eww-readable' adds a new entry to diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 54b65d35164..39ea964d47a 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -275,6 +275,22 @@ parameter, and should return the (possibly) transformed URL." :type '(repeat function) :version "29.1") +(defcustom eww-readable-urls nil + "A list of regexps matching URLs to display in readable mode by default. +EWW will display matching URLs using `eww-readable' (which see). + +Each element can be one of the following forms: a regular expression in +string form or a cons cell of the form (REGEXP . READABILITY). If +READABILITY is non-nil, this behaves the same as the string form; +otherwise, URLs matching REGEXP will never be displayed in readable mode +by default." + :type '(repeat (choice (string :tag "Readable URL") + (cons :tag "URL and Readability" + (string :tag "URL") + (radio (const :tag "Readable" t) + (const :tag "Non-readable" nil))))) + :version "30.1") + (defcustom eww-readable-adds-to-history t "If non-nil, calling `eww-readable' adds a new entry to the history." :type 'boolean @@ -809,11 +825,15 @@ This replaces the region with the preprocessed HTML." (let ((source (buffer-substring (point) (point-max)))) (with-current-buffer buffer (plist-put eww-data :source source))) - (eww-display-document - (or document - (eww-document-base - url (eww--parse-html-region (point) (point-max) charset))) - point buffer)) + (unless document + (let ((dom (eww--parse-html-region (point) (point-max) charset))) + (when (eww-default-readable-p url) + (eww-score-readability dom) + (setq dom (eww-highest-readability dom)) + (with-current-buffer buffer + (plist-put eww-data :readable t))) + (setq document (eww-document-base url dom)))) + (eww-display-document document point buffer)) (defun eww-handle-link (dom) (let* ((rel (dom-attr dom 'rel)) @@ -1159,6 +1179,19 @@ adds a new entry to `eww-history'." (setq result highest)))) result)) +(defun eww-default-readable-p (url) + "Return non-nil if URL should be displayed in readable mode by default. +This consults the entries in `eww-readable-urls' (which see)." + (catch 'found + (let (result) + (dolist (regexp eww-readable-urls) + (if (consp regexp) + (setq result (cdr regexp) + regexp (car regexp)) + (setq result t)) + (when (string-match regexp url) + (throw 'found result)))))) + (defvar-keymap eww-mode-map "g" #'eww-reload ;FIXME: revert-buffer-function instead! "G" #'eww diff --git a/test/lisp/net/eww-tests.el b/test/lisp/net/eww-tests.el index a09e0a4f279..b83435e0bd9 100644 --- a/test/lisp/net/eww-tests.el +++ b/test/lisp/net/eww-tests.el @@ -231,5 +231,17 @@ This sets `eww-before-browse-history-function' to "This is an uninteresting sentence." (buffer-substring-no-properties (point-min) (point-max))))))) +(ert-deftest eww-test/readable/default-readable () + "Test that EWW displays readable parts of pages by default when applicable." + (eww-test--with-mock-retrieve + (let* ((eww-test--response-function + (lambda (_url) + (concat "Content-Type: text/html\n\n" + "Hello there"))) + (eww-readable-urls '("://example\\.invalid/"))) + (eww "example.invalid") + ;; Make sure EWW uses "readable" mode. + (should (plist-get eww-data :readable))))) + (provide 'eww-tests) ;; eww-tests.el ends here -- cgit v1.2.3 From 79c758187cef7fc1f93fd525b9d81be81ee2b2cc Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Thu, 7 Mar 2024 21:55:00 -0800 Subject: Recompute :map when image :scale, :rotation, or :flip changes Now, when transforming an image, its :map is recomputed to fit. Image map coordinates are integers, so when computing :map, coordinates are rounded. To prevent an image from drifting from its map after repeated transformations, 'create-image' now adds a new image property :original-map, which is combined with the image's transformation parameters to recompute :map. * lisp/image.el (image-recompute-map-p): Add user option to control whether :map is recomputed when an image is transformed. (create-image): Create :map from :original-map and vice versa. (image--delayed-change-size): Fix comment. (image--change-size, image-rotate, image-flip-horizontally, image-flip-vertically): Recompute image map after transformation and mention 'image-recompute-map-p' in docstring. (image--compute-map): Add function to compute a map from original map. (image--compute-original-map): Add function to compute an original map from map. (image--scale-map): Add function to scale a map based on :scale. (image--rotate-map): Add function to rotate a map based on :rotation. (image--rotate-coord): Add function to rotate a map coordinate pair. (image--flip-map): Add function to flip a map based on :flip. (image-increase-size, image-decrease-size, image-mouse-increase-size) (image-mouse-decrease-size): Mention 'image-recompute-map-p' in docstrings. * etc/NEWS: Add NEWS entry. * doc/lispref/display.texi (Image Descriptors): Document :original-map and new user option 'image-recompute-map-p'. * test/lisp/image-tests.el (image--compute-map-and-original-map): Test 'image--compute-map' and 'image--compute-original-map'. (image-tests--map-equal): Add equality predicate to compare image maps. (image-create-image-with-map): Test that 'create-image' adds :map and/or :original-map as appropriate. (image-transform-map): Test functions related to transforming maps. (Bug#69602) --- doc/lispref/display.texi | 24 +++++ etc/NEWS | 12 +++ lisp/image.el | 221 ++++++++++++++++++++++++++++++++++++++++++++--- test/lisp/image-tests.el | 144 ++++++++++++++++++++++++++++++ 4 files changed, 389 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index beca470d68a..b497967c445 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -6056,6 +6056,30 @@ to make things match up, you should either specify @code{:scale 1.0} when creating the image, or use the result of @code{image-compute-scaling-factor} to compute the elements of the map. + +When an image's @code{:scale}, @code{:rotation}, or @code{:flip} is +changed, @code{:map} will be recomputed based on the value of +@code{:original-map} and the values of those transformation. + +@item :original-map @var{original-map} +@cindex original image map +This specifies the untransformed image map which will be used to +recompute @code{:map} after the image's @code{:scale}, @code{:rotation}, +or @code{:flip} is changed. + +If @code{:original-map} is not specified when creating an image with +@code{create-image}, it will be computed based on the supplied +@code{:map}, as well as any of @code{:scale}, @code{:rotation}, or +@code{:flip} which are non-nil. + +Conversely, if @code{:original-map} is specified but @code{:map} is not, +@code{:map} will be computed based on @code{:original-map}, +@code{:scale}, @code{:rotation}, and @code{:flip}. + +@defopt image-recompute-map-p +Set this user option to nil to prevent Emacs from automatically +recomputing an image @code{:map} based on its @code{:original-map}. +@end defopt @end table @defun image-mask-p spec &optional frame diff --git a/etc/NEWS b/etc/NEWS index c6b654a9d3b..19588fe8eeb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1368,6 +1368,18 @@ without specifying a file, like this: (notifications-notify :title "I am playing music" :app-icon 'multimedia-player) +** Image + ++++ +*** Image :map property is now recomputed when image is transformed. +Now images with clickable maps work as expected after you run commands +such as `image-increase-size', `image-decrease-size', `image-rotate', +`image-flip-horizontally', and `image-flip-vertically'. + ++++ +*** New user option 'image-recompute-map-p' +Set this option to nil to prevent Emacs from recomputing image maps. + ** Image Dired *** New user option 'image-dired-thumb-naming'. diff --git a/lisp/image.el b/lisp/image.el index c13fea6c45c..55340ea03dc 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -560,6 +560,16 @@ Images should not be larger than specified by `max-image-size'." ('t t) ('nil nil) (func (funcall func image))))))) + ;; Add original map from map. + (when (and (plist-get props :map) + (not (plist-get props :original-map))) + (setq image (nconc image (list :original-map + (image--compute-original-map image))))) + ;; Add map from original map. + (when (and (plist-get props :original-map) + (not (plist-get props :map))) + (setq image (nconc image (list :map + (image--compute-map image))))) image))) (defun image--default-smoothing (image) @@ -1208,7 +1218,10 @@ has no effect." If N is 3, then the image size will be increased by 30%. More generally, the image size is multiplied by 1 plus N divided by 10. N defaults to 2, which increases the image size by 20%. -POSITION can be a buffer position or a marker, and defaults to point." +POSITION can be a buffer position or a marker, and defaults to point. + +When user option `image-recompute-map-p' is non-nil, the image's `:map' +is recomputed to fit the newly transformed image." (interactive "P") (image--delayed-change-size (if n (1+ (/ (prefix-numeric-value n) 10.0)) @@ -1220,7 +1233,7 @@ POSITION can be a buffer position or a marker, and defaults to point." (defun image--delayed-change-size (size position) ;; Wait for a bit of idle-time before actually performing the change, ;; so as to batch together sequences of closely consecutive size changes. - ;; `image--change-size' just changes one value in a plist. The actual + ;; `image--change-size' just changes two values in a plist. The actual ;; image resizing happens later during redisplay. So if those ;; consecutive calls happen without any redisplay between them, ;; the costly operation of image resizing should happen only once. @@ -1231,7 +1244,10 @@ POSITION can be a buffer position or a marker, and defaults to point." If N is 3, then the image size will be decreased by 30%. More generally, the image size is multiplied by 1 minus N divided by 10. N defaults to 2, which decreases the image size by 20%. -POSITION can be a buffer position or a marker, and defaults to point." +POSITION can be a buffer position or a marker, and defaults to point. + +When user option `image-recompute-map-p' is non-nil, the image's `:map' +is recomputed to fit the newly transformed image." (interactive "P") (image--delayed-change-size (if n (- 1 (/ (prefix-numeric-value n) 10.0)) @@ -1243,7 +1259,10 @@ POSITION can be a buffer position or a marker, and defaults to point." (defun image-mouse-increase-size (&optional event) "Increase the image size using the mouse-gesture EVENT. This increases the size of the image at the position specified by -EVENT, if any, by the default factor used by `image-increase-size'." +EVENT, if any, by the default factor used by `image-increase-size'. + +When user option `image-recompute-map-p' is non-nil, the image's `:map' +is recomputed to fit the newly transformed image." (interactive "e") (when (listp event) (save-window-excursion @@ -1253,7 +1272,10 @@ EVENT, if any, by the default factor used by `image-increase-size'." (defun image-mouse-decrease-size (&optional event) "Decrease the image size using the mouse-gesture EVENT. This decreases the size of the image at the position specified by -EVENT, if any, by the default factor used by `image-decrease-size'." +EVENT, if any, by the default factor used by `image-decrease-size'. + +When user option `image-recompute-map-p' is non-nil, the image's `:map' +is recomputed to fit the newly transformed image." (interactive "e") (when (listp event) (save-window-excursion @@ -1304,7 +1326,9 @@ POSITION can be a buffer position or a marker, and defaults to point." (new-image (image--image-without-parameters image)) (scale (image--current-scaling image new-image))) (setcdr image (cdr new-image)) - (plist-put (cdr image) :scale (* scale factor)))) + (plist-put (cdr image) :scale (* scale factor)) + (when (and (image-property image :original-map) image-recompute-map-p) + (setf (image-property image :map) (image--compute-map image))))) (defun image--image-without-parameters (image) (cons (pop image) @@ -1331,7 +1355,10 @@ POSITION can be a buffer position or a marker, and defaults to point." If nil, ANGLE defaults to 90. Interactively, rotate the image 90 degrees clockwise with no prefix argument, and counter-clockwise with a prefix argument. Note that most image types support -rotations by only multiples of 90 degrees." +rotations by only multiples of 90 degrees. + +When user option `image-recompute-map-p' is non-nil, the image's `:map' +is recomputed to fit the newly transformed image." (interactive (and current-prefix-arg '(-90))) (let ((image (image--get-imagemagick-and-warn))) (setf (image-property image :rotation) @@ -1339,7 +1366,9 @@ rotations by only multiples of 90 degrees." (or angle 90)) ;; We don't want to exceed 360 degrees rotation, ;; because it's not seen as valid in Exif data. - 360)))) + 360))) + (when (and (image-property image :original-map) image-recompute-map-p) + (setf (image-property image :map) (image--compute-map image)))) (set-transient-map image--repeat-map nil nil "Use %k for further adjustments")) @@ -1360,23 +1389,191 @@ changing the displayed image size does not affect the saved image." (read-file-name "Write image to file: "))))) (defun image-flip-horizontally () - "Horizontally flip the image under point." + "Horizontally flip the image under point. + +When user option `image-recompute-map-p' is non-nil, the image's `:map' +is recomputed to fit the newly transformed image." (interactive) (let ((image (image--get-image))) (image-flush image) (setf (image-property image :flip) - (not (image-property image :flip))))) + (not (image-property image :flip))) + (when (and (image-property image :original-map) image-recompute-map-p) + (setf (image-property image :map) (image--compute-map image))))) (defun image-flip-vertically () - "Vertically flip the image under point." + "Vertically flip the image under point. + +When user option `image-recompute-map-p' is non-nil, the image's `:map' +is recomputed to fit the newly transformed image." (interactive) (let ((image (image--get-image))) (image-rotate 180) (setf (image-property image :flip) - (not (image-property image :flip))))) + (not (image-property image :flip))) + (when (and (image-property image :original-map) image-recompute-map-p) + (setf (image-property image :map) (image--compute-map image))))) (define-obsolete-function-alias 'image-refresh #'image-flush "29.1") +;;; Map transformation + +(defcustom image-recompute-map-p t + "Recompute image map when scaling, rotating, or flipping an image." + :type 'boolean + :version "30.1") + +(defun image--compute-map (image) + "Compute map for IMAGE suitable to be used as its :map property. +Return a copy of :original-image transformed based on IMAGE's :scale, +:rotation, and :flip. When IMAGE's :original-map is nil, return nil. +When :rotation is not a multiple of 90, return copy of :original-map." + (pcase-let* ((original-map (image-property image :original-map)) + (map (copy-tree original-map t)) + (scale (or (image-property image :scale) 1)) + (rotation (or (image-property image :rotation) 0)) + (flip (image-property image :flip)) + ((and size `(,width . ,height)) (image-size image t))) + (when (and ; Handle only 90-degree rotations + (zerop (mod rotation 1)) + (zerop (% (truncate rotation) 90))) + ;; SIZE fits MAP after transformations. Scale MAP before + ;; flip and rotate operations, since both need MAP to fit SIZE. + (image--scale-map map scale) + ;; In rendered images, rotation is always applied before flip. + (image--rotate-map + map rotation (if (or (= 90 rotation) (= 270 rotation)) + ;; If rotated ±90°, swap width and height. + (cons height width) + size)) + ;; After rotation, there's no need to swap width and height. + (image--flip-map map flip size)) + map)) + +(defun image--compute-original-map (image) + "Return original map for IMAGE. +If IMAGE lacks :map property, return nil. +When :rotation is not a multiple of 90, return copy of :map." + (when (image-property image :map) + (let* ((image-copy (copy-tree image t)) + (map (image-property image-copy :map)) + (scale (or (image-property image-copy :scale) 1)) + (rotation (or (image-property image-copy :rotation) 0)) + (flip (image-property image-copy :flip)) + (size (image-size image-copy t))) + (when (and ; Handle only 90-degree rotations + (zerop (mod rotation 1)) + (zerop (% (truncate rotation) 90))) + ;; In rendered images, rotation is always applied before flip. + ;; To undo the transformation, flip before rotating. + ;; SIZE fits MAP before it is transformed back to ORIGINAL-MAP. + ;; Therefore, scale MAP after flip and rotate operations, since + ;; both need MAP to fit SIZE. + (image--flip-map map flip size) + (image--rotate-map map (- rotation) size) + (image--scale-map map (/ 1.0 scale))) + map))) + +(defun image--scale-map (map scale) + "Scale MAP according to SCALE. +Destructively modifies and returns MAP." + (unless (= 1 scale) + (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map) + (pcase-exhaustive type + ('rect + (setf (caar coords) (round (* (caar coords) scale))) + (setf (cdar coords) (round (* (cdar coords) scale))) + (setf (cadr coords) (round (* (cadr coords) scale))) + (setf (cddr coords) (round (* (cddr coords) scale)))) + ('circle + (setf (caar coords) (round (* (caar coords) scale))) + (setf (cdar coords) (round (* (cdar coords) scale))) + (setcdr coords (round (* (cdr coords) scale)))) + ('poly + (dotimes (i (length coords)) + (aset coords i + (round (* (aref coords i) scale)))))))) + map) + +(defun image--rotate-map (map rotation size) + "Rotate MAP according to ROTATION and SIZE. +Destructively modifies and returns MAP." + (unless (zerop rotation) + (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map) + (pcase-exhaustive type + ('rect + (let ( x0 y0 ; New upper left corner + x1 y1) ; New bottom right corner + (pcase (truncate (mod rotation 360)) ; Set new corners to... + (90 ; ...old bottom left and upper right + (setq x0 (caar coords) y0 (cddr coords) + x1 (cadr coords) y1 (cdar coords))) + (180 ; ...old bottom right and upper left + (setq x0 (cadr coords) y0 (cddr coords) + x1 (caar coords) y1 (cdar coords))) + (270 ; ...old upper right and bottom left + (setq x0 (cadr coords) y0 (cdar coords) + x1 (caar coords) y1 (cddr coords)))) + (setcar coords (image--rotate-coord x0 y0 rotation size)) + (setcdr coords (image--rotate-coord x1 y1 rotation size)))) + ('circle + (setcar coords (image--rotate-coord + (caar coords) (cdar coords) rotation size))) + ('poly + (dotimes (i (length coords)) + (when (= 0 (% i 2)) + (pcase-let ((`(,x . ,y) + (image--rotate-coord + (aref coords i) (aref coords (1+ i)) rotation size))) + (aset coords i x) + (aset coords (1+ i) y)))))))) + map) + +(defun image--rotate-coord (x y angle size) + "Rotate coordinates X and Y by ANGLE in image of SIZE. +ANGLE must be a multiple of 90. Returns a cons cell of rounded +coordinates (X1 Y1)." + (pcase-let* ((radian (* (/ angle 180.0) float-pi)) + (`(,width . ,height) size) + ;; y is positive, but we are in the bottom-right quadrant + (y (- y)) + ;; Rotate clockwise + (x1 (+ (* (sin radian) y) (* (cos radian) x))) + (y1 (- (* (cos radian) y) (* (sin radian) x))) + ;; Translate image back into bottom-right quadrant + (`(,x1 . ,y1) + (pcase (truncate (mod angle 360)) + (90 ; Translate right by height + (cons (+ x1 height) y1)) + (180 ; Translate right by width and down by height + (cons (+ x1 width) (- y1 height))) + (270 ; Translate down by width + (cons x1 (- y1 width))))) + ;; Invert y1 to make both x1 and y1 positive + (y1 (- y1))) + (cons (round x1) (round y1)))) + +(defun image--flip-map (map flip size) + "Horizontally flip MAP according to FLIP and SIZE. +Destructively modifies and returns MAP." + (when flip + (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map) + (pcase-exhaustive type + ('rect + (let ((x0 (- (car size) (cadr coords))) + (y0 (cdar coords)) + (x1 (- (car size) (caar coords))) + (y1 (cddr coords))) + (setcar coords (cons x0 y0)) + (setcdr coords (cons x1 y1)))) + ('circle + (setf (caar coords) (- (car size) (caar coords)))) + ('poly + (dotimes (i (length coords)) + (when (= 0 (% i 2)) + (aset coords i (- (car size) (aref coords i))))))))) + map) + (provide 'image) ;;; image.el ends here diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el index 80142d6d6de..6a5f03e38a0 100644 --- a/test/lisp/image-tests.el +++ b/test/lisp/image-tests.el @@ -153,4 +153,148 @@ (image-rotate -154.5) (should (equal image '(image :rotation 91.0))))) +;;;; Transforming maps + +(ert-deftest image-create-image-with-map () + "Test that `create-image' correctly adds :map and/or :original-map." + (skip-unless (display-images-p)) + (let ((data "foo") + (map '(((circle (1 . 1) . 1) a))) + (original-map '(((circle (2 . 2) . 2) a))) + (original-map-other '(((circle (3 . 3) . 3) a)))) + ;; Generate :original-map from :map. + (let* ((image (create-image data 'svg t :map map :scale 0.5)) + (got-original-map (image-property image :original-map))) + (should (equal got-original-map original-map))) + ;; Generate :map from :original-map. + (let* ((image (create-image + data 'svg t :original-map original-map :scale 0.5)) + (got-map (image-property image :map))) + (should (equal got-map map))) + ;; Use :original-map if both it and :map are specified. + (let* ((image (create-image + data 'svg t :map map + :original-map original-map-other :scale 0.5)) + (got-original-map (image-property image :original-map))) + (should (equal got-original-map original-map-other))))) + +(defun image-tests--map-equal (a b &optional tolerance) + "Return t if maps A and B have the same coordinates within TOLERANCE. +Since image sizes calculations vary on different machines, this function +allows for each image map coordinate in A to be within TOLERANCE to the +corresponding coordinate in B. When nil, TOLERANCE defaults to 5." + (unless tolerance (setq tolerance 5)) + (catch 'different + (cl-labels ((check-tolerance + (coord-a coord-b) + (unless (>= tolerance (abs (- coord-a coord-b))) + (throw 'different nil)))) + (dotimes (i (length a)) + (pcase-let ((`((,type-a . ,coords-a) ,_id ,_plist) (nth i a)) + (`((,type-b . ,coords-b) ,_id ,_plist) (nth i b))) + (unless (eq type-a type-b) + (throw 'different nil)) + (pcase-exhaustive type-a + ('rect + (check-tolerance (caar coords-a) (caar coords-b)) + (check-tolerance (cdar coords-a) (cdar coords-b)) + (check-tolerance (cadr coords-a) (cadr coords-b)) + (check-tolerance (cddr coords-a) (cddr coords-b))) + ('circle + (check-tolerance (caar coords-a) (caar coords-b)) + (check-tolerance (cdar coords-a) (cdar coords-b)) + (check-tolerance (cdar coords-a) (cdar coords-b))) + ('poly + (dotimes (i (length coords-a)) + (check-tolerance (aref coords-a i) (aref coords-b i)))))))) + t)) + +(ert-deftest image--compute-map-and-original-map () + "Test `image--compute-map' and `image--compute-original-map'." + (skip-unless (display-images-p)) + (let* ((svg-string "ABC") + (original-map + '(((circle (41 . 29) . 24) "a" (help-echo "A")) + ((rect (5 . 101) 77 . 149) "b" (help-echo "B")) + ((poly . [161 29 160 22 154 15 146 10 136 7 125 5 114 7 104 10 96 15 91 22 89 29 91 37 96 43 104 49 114 52 125 53 136 52 146 49 154 43 160 37]) "c" (help-echo "C")))) + (scaled-map + '(((circle (82 . 58) . 48) "a" (help-echo "A")) + ((rect (10 . 202) 154 . 298) "b" (help-echo "B")) + ((poly . [322 58 320 44 308 30 292 20 272 14 250 10 228 14 208 20 192 30 182 44 178 58 182 74 192 86 208 98 228 104 250 106 272 104 292 98 308 86 320 74]) "c" (help-echo "C")))) + (flipped-map + '(((circle (125 . 29) . 24) "a" (help-echo "A")) + ((rect (89 . 101) 161 . 149) "b" (help-echo "B")) + ((poly . [5 29 6 22 12 15 20 10 30 7 41 5 52 7 62 10 70 15 75 22 77 29 75 37 70 43 62 49 52 52 41 53 30 52 20 49 12 43 6 37]) "c" (help-echo "C")))) + (rotated-map + '(((circle (126 . 41) . 24) "a" (help-echo "A")) + ((rect (6 . 5) 54 . 77) "b" (help-echo "B")) + ((poly . [126 161 133 160 140 154 145 146 148 136 150 125 148 114 145 104 140 96 133 91 126 89 118 91 112 96 106 104 103 114 102 125 103 136 106 146 112 154 118 160]) "c" (help-echo "C")))) + (scaled-rotated-flipped-map + '(((circle (58 . 82) . 48) "a" (help-echo "A")) + ((rect (202 . 10) 298 . 154) "b" (help-echo "B")) + ((poly . [58 322 44 320 30 308 20 292 14 272 10 250 14 228 20 208 30 192 44 182 58 178 74 182 86 192 98 208 104 228 106 250 104 272 98 292 86 308 74 320]) "c" (help-echo "C")))) + (image (create-image svg-string 'svg t :map scaled-rotated-flipped-map + :scale 2 :rotation 90 :flip t))) + ;; Test that `image--compute-original-map' correctly generates + ;; original-map when creating an already transformed image. + (should (image-tests--map-equal (image-property image :original-map) + original-map)) + (setf (image-property image :flip) nil) + (setf (image-property image :rotation) 0) + (setf (image-property image :scale) 2) + (should (image-tests--map-equal (image--compute-map image) + scaled-map)) + (setf (image-property image :scale) 1) + (setf (image-property image :rotation) 90) + (should (image-tests--map-equal (image--compute-map image) + rotated-map)) + (setf (image-property image :rotation) 0) + (setf (image-property image :flip) t) + (should (image-tests--map-equal (image--compute-map image) + flipped-map)) + (setf (image-property image :scale) 2) + (setf (image-property image :rotation) 90) + (should (image-tests--map-equal (image--compute-map image) + scaled-rotated-flipped-map)) + + ;; Uncomment to test manually by interactively transforming the + ;; image and checking the map boundaries by hovering them. + + ;; (with-current-buffer (get-buffer-create "*test image map*") + ;; (erase-buffer) + ;; (insert-image image) + ;; (goto-char (point-min)) + ;; (pop-to-buffer (current-buffer))) + )) + +(ert-deftest image-transform-map () + "Test functions related to transforming image maps." + (let ((map '(((circle (4 . 3) . 2) "circle") + ((rect (3 . 6) 8 . 8) "rect") + ((poly . [6 11 7 13 2 14]) "poly"))) + (width 10) + (height 15)) + (should (equal (image--scale-map (copy-tree map t) 2) + '(((circle (8 . 6) . 4) "circle") + ((rect (6 . 12) 16 . 16) "rect") + ((poly . [12 22 14 26 4 28]) "poly")))) + (should (equal (image--rotate-map (copy-tree map t) 90 `(,width . ,height)) + '(((circle (12 . 4) . 2) "circle") + ((rect (7 . 3) 9 . 8) "rect") + ((poly . [4 6 2 7 1 2]) "poly")))) + (should (equal (image--flip-map (copy-tree map t) t `(,width . ,height)) + '(((circle (6 . 3) . 2) "circle") + ((rect (2 . 6) 7 . 8) "rect") + ((poly . [4 11 3 13 8 14]) "poly")))) + (let ((copy (copy-tree map t))) + (image--scale-map copy 2) + ;; Scale size because the map has been scaled. + (image--rotate-map copy 90 `(,(* 2 width) . ,(* 2 height))) + ;; Swap width and height because the map has been flipped. + (image--flip-map copy t `(,(* 2 height) . ,(* 2 width))) + (should (equal copy + '(((circle (6 . 8) . 4) "circle") + ((rect (12 . 6) 16 . 16) "rect") + ((poly . [22 12 26 14 28 4]) "poly"))))))) + ;;; image-tests.el ends here -- cgit v1.2.3 From 0f04aa06a69cb82eb66d5ffd46700ffdbd58b8f3 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 23 Mar 2024 16:11:07 -0400 Subject: (describe-package-1): Fix bug#69712 * lisp/emacs-lisp/package.el (describe-package-1): Improve the test to determine if `maintainers` contains a single cons or a list of conses. --- lisp/emacs-lisp/package.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index fe7b10f569a..ab1731aeb54 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2941,7 +2941,7 @@ Helper function for `describe-package'." (insert " ")) (insert "\n")) (when maintainers - (unless (proper-list-p maintainers) + (when (stringp (car maintainers)) (setq maintainers (list maintainers))) (package--print-help-section (if (cdr maintainers) "Maintainers" "Maintainer")) -- cgit v1.2.3 From 525bc083155030b58de08c8716fec9db1496aa9d Mon Sep 17 00:00:00 2001 From: "F. Moukayed" Date: Sun, 17 Mar 2024 16:43:36 +0000 Subject: Remove mishandled erc-control-default-{fg,bg} faces Partially revert those portions of 7b4ca9e609e "Leverage inverse-video for erc-inverse-face" that introduced and managed explicit faces for the "default" 99 color code. * lisp/erc/erc-goodies.el (erc-control-default-fg) (erc-control-default-bg): Remove unused faces originally meant to be new in ERC 5.6. (erc-get-fg-color-face, erc-get-bg-color-face): Return nil for n=99. (erc-controls-interpret, erc-controls-highlight): Preserve an interval's existing background so "if only the foreground color is set, the background color stays the same," as explained by https://modern.ircdocs.horse/formatting#color. (Bug#69860) Copyright-paperwork-exempt: yes --- lisp/erc/erc-goodies.el | 16 ++++------------ 1 file changed, 4 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index da14f5bd728..883f64d3109 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -673,14 +673,6 @@ The value `erc-interpret-controls-p' must also be t for this to work." "ERC underline face." :group 'erc-faces) -(defface erc-control-default-fg '((t :inherit default)) - "ERC foreground face for the \"default\" color code." - :group 'erc-faces) - -(defface erc-control-default-bg '((t :inherit default)) - "ERC background face for the \"default\" color code." - :group 'erc-faces) - ;; FIXME rename these to something like `erc-control-color-N-fg', ;; and deprecate the old names via `define-obsolete-face-alias'. (defface fg:erc-color-face0 '((t :foreground "White")) @@ -812,7 +804,7 @@ The value `erc-interpret-controls-p' must also be t for this to work." (intern (concat "bg:erc-color-face" (number-to-string n)))) ((< 15 n 99) (list :background (aref erc--controls-additional-colors (- n 16)))) - (t (erc-log (format " Wrong color: %s" n)) 'erc-control-default-fg)))) + (t (erc-log (format " Wrong color: %s" n)) nil)))) (defun erc-get-fg-color-face (n) "Fetches the right face for foreground color N (0-15)." @@ -828,7 +820,7 @@ The value `erc-interpret-controls-p' must also be t for this to work." (intern (concat "fg:erc-color-face" (number-to-string n)))) ((< 15 n 99) (list :foreground (aref erc--controls-additional-colors (- n 16)))) - (t (erc-log (format " Wrong color: %s" n)) 'erc-control-default-bg)))) + (t (erc-log (format " Wrong color: %s" n)) nil)))) ;;;###autoload(autoload 'erc-irccontrols-mode "erc-goodies" nil t) (define-erc-module irccontrols nil @@ -883,7 +875,7 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options." (setq s (replace-match "" nil nil s 1)) (cond ((and erc-interpret-mirc-color (or fg-color bg-color)) (setq fg fg-color) - (setq bg bg-color)) + (when bg-color (setq bg bg-color))) ((string= control "\C-b") (setq boldp (not boldp))) ((string= control "\C-]") @@ -944,7 +936,7 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'." (replace-match "" nil nil nil 1) (cond ((and erc-interpret-mirc-color (or fg-color bg-color)) (setq fg fg-color) - (setq bg bg-color)) + (when bg-color (setq bg bg-color))) ((string= control "\C-b") (setq boldp (not boldp))) ((string= control "\C-]") -- cgit v1.2.3 From b9bd78f78d62383f2ff84ceecf8e490193594f17 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 10 Mar 2024 23:09:59 -0700 Subject: Restore leading space to right-margin stamps in ERC * lisp/erc/erc-stamp.el (erc-insert-timestamp-right): Insert a single space character immediately before right-side stamps managed by `erc-stamp--display-margin-mode'. Include it as part of the `timestamp' field. This behavior was originally present in an earlier draft of the changes for bug#60936, mainly to favor symmetry between hard-wrapped fill styles and fill-wrap with regard to stamps. It was subsequently removed to simplify management, so that the `field' and `display' intervals aligned. * test/lisp/erc/erc-stamp-tests.el (erc-stamp--display-margin-mode--right): Update expected output. ; test/lisp/erc/resources/fill/snapshots/merge-01-start.eld: Add space. ; test/lisp/erc/resources/fill/snapshots/merge-02-right.eld: Add space. ; test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld: Add space. ; test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld: ; Add space. ; test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld: ; Add space. ; test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld: Add space. ; test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld: Add space. ; test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld: Add space. ; test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld: Add space. ; test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld: Add space. --- lisp/erc/erc-stamp.el | 1 + test/lisp/erc/erc-stamp-tests.el | 16 ++++++++-------- .../lisp/erc/resources/fill/snapshots/merge-01-start.eld | 2 +- .../lisp/erc/resources/fill/snapshots/merge-02-right.eld | 2 +- test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld | 2 +- .../fill/snapshots/merge-wrap-indicator-post-01.eld | 2 +- .../fill/snapshots/merge-wrap-indicator-pre-01.eld | 2 +- .../erc/resources/fill/snapshots/monospace-01-start.eld | 2 +- .../erc/resources/fill/snapshots/monospace-02-right.eld | 2 +- .../erc/resources/fill/snapshots/monospace-03-left.eld | 2 +- .../erc/resources/fill/snapshots/monospace-04-reset.eld | 2 +- .../erc/resources/fill/snapshots/spacing-01-mono.eld | 2 +- 12 files changed, 19 insertions(+), 18 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 44f92c5a7e2..bcb9b4aafef 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -623,6 +623,7 @@ printed just after each line's text (no alignment)." ((guard erc-stamp--display-margin-mode) (let ((s (propertize (substring-no-properties string) 'invisible erc-stamp--invisible-property))) + (insert " ") (put-text-property 0 (length string) 'display `((margin right-margin) ,s) string))) diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index a49173ffa2f..5fee21ec28f 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -168,11 +168,11 @@ (put-text-property 0 (length msg) 'wrap-prefix 10 msg) (erc-display-message nil nil (current-buffer) msg))) (goto-char (point-min)) - ;; Space not added (treated as opaque string). - (should (search-forward "msg one[" nil t)) - ;; Field covers stamp alone + ;; Leading space added as part of the stamp's field. + (should (search-forward "msg one [" nil t)) + ;; Field covers stamp and space. (should (eql ?e (char-before (field-beginning (point))))) - ;; Vanity props extended + ;; Vanity props extended. (should (get-text-property (field-beginning (point)) 'wrap-prefix)) (should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix)) (should (get-text-property (1- (field-end (point))) 'wrap-prefix)) @@ -183,10 +183,10 @@ (erc-timestamp-right-column 20)) (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t))) (erc-display-message nil nil (current-buffer) msg))) - ;; No hard wrap - (should (search-forward "oooo[" nil t)) - ;; Field starts at format string (right bracket) - (should (eql ?\[ (char-after (field-beginning (point))))) + ;; No hard wrap. + (should (search-forward "oooo [" nil t)) + ;; Field starts at managed space before format string. + (should (eql ?\s (char-after (field-beginning (point))))) (should (eql ?\n (char-after (field-end (point))))))))) ;; This concerns a proposed partial reversal of the changes resulting diff --git a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld index 3c32719a052..6ff7af218c0 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero.[07:00]\n one.\n two.\n three.\n four.\n five.\n six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n one.\n two.\n three.\n four.\n five.\n six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #5#) 460 467 (wrap-prefix #1# line-prefix #5#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #5#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 (8)))) 477 482 (wrap-prefix #1# line-prefix #7#) 482 488 (wrap-prefix #1# line-prefix #7#) 489 490 (erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 490 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 497 (wrap-prefix #1# line-prefix #8# display #9#) 497 501 (wrap-prefix #1# line-prefix #8#) 502 503 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 503 506 (wrap-prefix #1# line-prefix #10#) 506 514 (wrap-prefix #1# line-prefix #10#) 515 516 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 516 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 521 (wrap-prefix #1# line-prefix #11# display #9#) 521 526 (wrap-prefix #1# line-prefix #11#) 527 528 (erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 528 533 (wrap-prefix #1# line-prefix #12#) 533 540 (wrap-prefix #1# line-prefix #12#) 541 542 (erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 542 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 549 (wrap-prefix #1# line-prefix #13# display #9#) 549 553 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld index e2064b914c4..7d9822c80bc 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero.[07:00]\n one.\n two.\n three.\n four.\n five.\n six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18))) field erc-timestamp) 21 22 (wrap-prefix #1# line-prefix #2=(space :width (- 29 (4))) erc--msg notice erc--ts 0) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (wrap-prefix #1# line-prefix #2# field erc-timestamp display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (wrap-prefix #1# line-prefix #3=(space :width (- 29 (8))) erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix (space :width (- 29 (8)))) 349 350 (wrap-prefix #1# line-prefix #4=(space :width (- 29 (6))) erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (wrap-prefix #1# line-prefix (space :width (- 29 (18))) field erc-timestamp) 455 456 (wrap-prefix #1# line-prefix #5=(space :width (- 29 (6))) erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (wrap-prefix #1# line-prefix #5# field erc-timestamp display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (wrap-prefix #1# line-prefix #7=(space :width (- 29 (8))) erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (wrap-prefix #1# line-prefix #10=(space :width (- 29 (6))) erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (wrap-prefix #1# line-prefix #12=(space :width (- 29 (8))) erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n one.\n two.\n three.\n four.\n five.\n six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18))) field erc-timestamp) 21 22 (wrap-prefix #1# line-prefix #2=(space :width (- 29 (4))) erc--msg notice erc--ts 0) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (wrap-prefix #1# line-prefix #2# field erc-timestamp) 184 191 (wrap-prefix #1# line-prefix #2# field erc-timestamp display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (wrap-prefix #1# line-prefix #3=(space :width (- 29 (8))) erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix (space :width (- 29 (8)))) 350 351 (wrap-prefix #1# line-prefix #4=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (wrap-prefix #1# line-prefix (space :width (- 29 (18))) field erc-timestamp) 456 457 (wrap-prefix #1# line-prefix #5=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG) 457 460 (wrap-prefix #1# line-prefix #5#) 460 467 (wrap-prefix #1# line-prefix #5#) 467 468 (wrap-prefix #1# line-prefix #5# field erc-timestamp) 468 475 (wrap-prefix #1# line-prefix #5# field erc-timestamp display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (wrap-prefix #1# line-prefix #7=(space :width (- 29 (8))) erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG) 477 482 (wrap-prefix #1# line-prefix #7#) 482 488 (wrap-prefix #1# line-prefix #7#) 489 490 (wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG display #9="") 490 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 497 (wrap-prefix #1# line-prefix #8# display #9#) 497 501 (wrap-prefix #1# line-prefix #8#) 502 503 (wrap-prefix #1# line-prefix #10=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG) 503 506 (wrap-prefix #1# line-prefix #10#) 506 514 (wrap-prefix #1# line-prefix #10#) 515 516 (wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG display #9#) 516 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 521 (wrap-prefix #1# line-prefix #11# display #9#) 521 526 (wrap-prefix #1# line-prefix #11#) 527 528 (wrap-prefix #1# line-prefix #12=(space :width (- 29 (8))) erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG) 528 533 (wrap-prefix #1# line-prefix #12#) 533 540 (wrap-prefix #1# line-prefix #12#) 541 542 (wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG display #9#) 542 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 549 (wrap-prefix #1# line-prefix #13# display #9#) 549 553 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld index feaba85ec90..2d0e5a5965f 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero.[07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #10#) 499 505 (wrap-prefix #1# line-prefix #10#) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 507 510 (wrap-prefix #1# line-prefix #11# display #8#) 510 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 515 (wrap-prefix #1# line-prefix #11#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #12#) 518 521 (wrap-prefix #1# line-prefix #12#) 521 527 (wrap-prefix #1# line-prefix #12#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #13#) 532 539 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 477 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 482 (wrap-prefix #1# line-prefix #7# display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #10#) 501 507 (wrap-prefix #1# line-prefix #10#) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 509 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 514 (wrap-prefix #1# line-prefix #11# display #8#) 514 517 (wrap-prefix #1# line-prefix #11#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #12#) 520 523 (wrap-prefix #1# line-prefix #12#) 523 529 (wrap-prefix #1# line-prefix #12#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #13#) 534 541 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld index ed1488c8595..e019e60bb26 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero.[07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #10#) 499 505 (wrap-prefix #1# line-prefix #10#) 505 506 (display #("~\n" 0 2 (font-lock-face shadow))) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 507 510 (wrap-prefix #1# line-prefix #11# display #8#) 510 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 515 (wrap-prefix #1# line-prefix #11#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #12#) 518 521 (wrap-prefix #1# line-prefix #12#) 521 527 (wrap-prefix #1# line-prefix #12#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #13#) 532 539 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 477 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 482 (wrap-prefix #1# line-prefix #7# display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #10#) 501 507 (wrap-prefix #1# line-prefix #10#) 507 508 (display #("~\n" 0 2 (font-lock-face shadow))) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 509 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 514 (wrap-prefix #1# line-prefix #11# display #8#) 514 517 (wrap-prefix #1# line-prefix #11#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #12#) 520 523 (wrap-prefix #1# line-prefix #12#) 523 529 (wrap-prefix #1# line-prefix #12#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #13#) 534 541 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld index a3530a6c44d..615de982b1e 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero.[07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 #10=(2))) display #8=#("> " 0 1 (font-lock-face shadow))) 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #11#) 499 505 (wrap-prefix #1# line-prefix #11#) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 #10#)) display #8#) 507 510 (wrap-prefix #1# line-prefix #12# display #8#) 510 512 (wrap-prefix #1# line-prefix #12# display #8#) 512 515 (wrap-prefix #1# line-prefix #12#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #13=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #13#) 518 521 (wrap-prefix #1# line-prefix #13#) 521 527 (wrap-prefix #1# line-prefix #13#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #14=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #14#) 532 539 (wrap-prefix #1# line-prefix #14#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 #10=(2))) display #8=#("> " 0 1 (font-lock-face shadow))) 477 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 482 (wrap-prefix #1# line-prefix #7# display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #11#) 501 507 (wrap-prefix #1# line-prefix #11#) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 #10#)) display #8#) 509 512 (wrap-prefix #1# line-prefix #12# display #8#) 512 514 (wrap-prefix #1# line-prefix #12# display #8#) 514 517 (wrap-prefix #1# line-prefix #12#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #13=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #13#) 520 523 (wrap-prefix #1# line-prefix #13#) 523 529 (wrap-prefix #1# line-prefix #13#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #14=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #14#) 534 541 (wrap-prefix #1# line-prefix #14#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld index c94629cf357..0228e716731 100644 --- a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld +++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld index 127c0b29bc9..9ab89041b53 100644 --- a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld +++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 29 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 29 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 29 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 29 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld index a9f3f1d1904..87ea4692d9d 100644 --- a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld +++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 25 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 25 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 25 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 25 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld index c94629cf357..0228e716731 100644 --- a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld +++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld index 754d7989cea..ae364accdea 100644 --- a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld +++ b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n This buffer is for text.\n*** one two three\n*** four five six\n Somebody stop me\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 190 191 (line-spacing 0.5) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 348 349 (line-spacing 0.5) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 435 436 (line-spacing 0.5) 436 437 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 437 440 (wrap-prefix #1# line-prefix #5# display #6#) 440 442 (wrap-prefix #1# line-prefix #5# display #6#) 442 466 (wrap-prefix #1# line-prefix #5#) 466 467 (line-spacing 0.5) 467 468 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 468 484 (wrap-prefix #1# line-prefix #7#) 485 486 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 486 502 (wrap-prefix #1# line-prefix #8#) 502 503 (line-spacing 0.5) 503 504 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 504 507 (wrap-prefix #1# line-prefix #9#) 507 525 (wrap-prefix #1# line-prefix #9#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n This buffer is for text.\n*** one two three\n*** four five six\n Somebody stop me\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (line-spacing 0.5) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 349 350 (line-spacing 0.5) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 436 437 (line-spacing 0.5) 437 438 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 438 441 (wrap-prefix #1# line-prefix #5# display #6#) 441 443 (wrap-prefix #1# line-prefix #5# display #6#) 443 467 (wrap-prefix #1# line-prefix #5#) 467 468 (line-spacing 0.5) 468 469 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 469 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 487 503 (wrap-prefix #1# line-prefix #8#) 503 504 (line-spacing 0.5) 504 505 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 505 508 (wrap-prefix #1# line-prefix #9#) 508 526 (wrap-prefix #1# line-prefix #9#)) \ No newline at end of file -- cgit v1.2.3 From a46789b56af05e4cd31ab90495c9f2a4492a9b19 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 10 Mar 2024 23:09:59 -0700 Subject: Reuse command-indicator code for script lines in ERC * lisp/erc/erc-goodies.el (erc-load-irc-script-lines): Move here from main file and rework to always use `command-indicator' instead of only partially, when available. Also use internal "send-action" and "send-message" interfaces to defer command-handler output until command lines have been inserted. * lisp/erc/erc.el (erc-process-input-line): Redo doc string. (erc-process-script-line): Fold exceptionally overlong line. (erc-load-irc-script-lines): Move to erc-goodies.el. (Bug#67032) --- lisp/erc/erc-goodies.el | 42 +++++++++++++++++++++++++++++++++++ lisp/erc/erc.el | 58 +++++++++++++------------------------------------ 2 files changed, 57 insertions(+), 43 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 883f64d3109..fe44c3bdfcb 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -625,6 +625,48 @@ Do nothing if the variable `erc-command-indicator' is nil." erc--msg-props)))) (erc--refresh-prompt)))) +;;;###autoload +(defun erc-load-irc-script-lines (lines &optional force noexpand) + "Process a list of LINES as prompt input submissions. +If optional NOEXPAND is non-nil, do not expand script-specific +substitution sequences via `erc-process-script-line' and instead +process LINES as literal prompt input. With FORCE, bypass flood +protection." + ;; The various erc-cmd-CMDs were designed to return non-nil when + ;; their command line should be echoed. But at some point, these + ;; handlers began displaying their own output, which naturally + ;; appeared *above* the echoed command. This tries to intercept + ;; these insertions, deferring them until the command has returned + ;; and its command line has been printed. + (cl-assert (eq 'erc-mode major-mode)) + (let ((args (and erc-script-args + (if (string-match "^ " erc-script-args) + (substring erc-script-args 1) + erc-script-args)))) + (with-silent-modifications + (dolist (line lines) + (erc-log (concat "erc-load-script: CMD: " line)) + (unless (string-match (rx bot (* (syntax whitespace)) eot) line) + (unless noexpand + (setq line (erc-process-script-line line args))) + (let ((erc--current-line-input-split (erc--make-input-split line)) + calls insertp) + (add-function :around (local 'erc--send-message-nested-function) + (lambda (&rest args) (push args calls)) + '((name . erc-script-lines-fn) (depth . -80))) + (add-function :around (local 'erc--send-action-function) + (lambda (&rest args) (push args calls)) + '((name . erc-script-lines-fn) (depth . -80))) + (setq insertp + (unwind-protect (erc-process-input-line line force) + (remove-function (local 'erc--send-action-function) + 'erc-script-lines-fn) + (remove-function (local 'erc--send-message-nested-function) + 'erc-script-lines-fn))) + (when (and insertp erc-script-echo) + (erc--command-indicator-display line) + (dolist (call calls) + (apply (car call) (cdr call)))))))))) ;;; IRC control character processing. (defgroup erc-control-characters nil diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 3cc9bd54228..0750463a4e7 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4004,17 +4004,19 @@ erc-cmd-FOO, this returns a string /FOO." command-name))) (defun erc-process-input-line (line &optional force no-command) - "Translate LINE to an RFC1459 command and send it based. -Returns non-nil if the command is actually sent to the server, and nil -otherwise. - -If the command in the LINE is not bound as a function `erc-cmd-', -it is passed to `erc-cmd-default'. If LINE is not a command (i.e. doesn't -start with /) then it is sent as a message. - -An optional FORCE argument forces sending the line when flood -protection is in effect. The optional NO-COMMAND argument prohibits -this function from interpreting the line as a command." + "Dispatch a slash-command or chat-input handler from user-input LINE. +If simplistic validation fails, print an error and return nil. +Otherwise, defer to an appropriate handler. For \"slash\" commands, +like \"/JOIN\", expect a handler, like `erc-cmd-JOIN', to return non-nil +if LINE is fit for echoing as a command line when executing scripts. +For normal chat input, expect a handler to return non-nil if a message +was successfully processed as an outgoing \"PRIVMSG\". If LINE is a +slash command, and ERC can't find a corresponding handler of the form +`erc-cmd-', pass LINE to `erc-cmd-default', treating it as a +catch-all handler. Otherwise, for normal chat input, pass LINE and the +boolean argument FORCE to `erc-send-input-line-function'. With a +non-nil NO-COMMAND, always treat LINE as normal chat input rather than a +slash command." (let ((command-list (erc-extract-command-from-line line))) (if (and command-list (not no-command)) @@ -8512,7 +8514,8 @@ and so on." ((string-match "^%[Ss]$" esc) server) ((string-match "^%[Nn]$" esc) nick) ((string-match "^%\\(.\\)$" esc) (match-string 1 esc)) - (t (erc-log (format "BUG in erc-process-script-line: bad escape sequence: %S\n" esc)) + (t (erc-log (format "Bad escape sequence in %s: %S\n" + 'erc-process-script-line esc)) (message "BUG IN ERC: esc=%S" esc) ""))) (setq line tail) @@ -8531,37 +8534,6 @@ and so on." (buffer-string)))) (erc-load-irc-script-lines (erc-split-multiline-safe str) force))) -(defun erc-load-irc-script-lines (lines &optional force noexpand) - "Load IRC script LINES (a list of strings). - -If optional NOEXPAND is non-nil, do not expand script-specific -sequences, process the lines verbatim. Use this for multiline -user input." - (let* ((cb (current-buffer)) - (s "") - (sp (or (and (bound-and-true-p erc-command-indicator-mode) - (fboundp 'erc-command-indicator) - (erc-command-indicator)) - (erc-prompt))) - (args (and (boundp 'erc-script-args) erc-script-args))) - (if (and args (string-match "^ " args)) - (setq args (substring args 1))) - ;; prepare the prompt string for echo - (erc-put-text-property 0 (length sp) - 'font-lock-face 'erc-command-indicator-face sp) - (while lines - (setq s (car lines)) - (erc-log (concat "erc-load-script: CMD: " s)) - (unless (string-match "^\\s-*$" s) - (let ((line (if noexpand s (erc-process-script-line s args)))) - (if (and (erc-process-input-line line force) - erc-script-echo) - (progn - (erc-put-text-property 0 (length line) - 'font-lock-face 'erc-input-face line) - (erc-display-line (concat sp line) cb))))) - (setq lines (cdr lines))))) - ;; authentication (defun erc--unfun (maybe-fn) -- cgit v1.2.3 From ef859d8b1b285fd22b083955a0e878a74d72ff41 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 23 Mar 2024 19:21:26 -0400 Subject: edebug.el: Better strip instrumentation from backtraces Rework the code that "cleans" the backtrace for `edebug-pop-to-backtrace`. The main changes are the following: - Strip instrumentation from "everywhere" rather than trying to limit the effect to "code" and leave "data" untouched. This is a worthy goal, but it is quite difficult to do since code contains data (so we ended up touching data anyway) and data can also contain code. The risk of accidentally removing something because it happens to look like instrumentation is very low, whereas it was very common for instrumentation to remain in the backtrace. - Use a global hash-table to remember the work done, instead of using separate hash-table for each element. By using a weak hash-table we avoid the risk of leaks, and save a lot of work since there's often a lot of subexpressions that appear several times in the backtrace. * lisp/emacs-lisp/edebug.el (edebug-make-enter-wrapper): Tweak code layout so the comments are more clear. (edebug-unwrap): Remove redundant patterns for `closure` and `lambda`. Add `:closure-dont-trim-context` to the `edebug-enter` pattern, so it also gets removed (this should have been done in commit 750bc57cbb8d). (edebug--unwrap-cache): New var. (edebug-unwrap*): Use it. (edebug--unwrap1): Delete function. Merged into `edebug-unwrap*`. Also apply unwrapping to the contents of byte-code functions since they can refer to lambda expressions captured by the closure. (edebug--symbol-prefixed-p): Rename from `edebug--symbol-not-prefixed-p` and adjust meaning accordingly. (edebug--strip-instrumentation): Adjust accordingly and simplify a bit by unifying the "lambda" case and the "everything else" case. (edebug--unwrap-frame): Use `cl-callf` and unwrap arguments even if they've already been evaluated. --- lisp/emacs-lisp/edebug.el | 143 +++++++++++++++++++++++----------------------- 1 file changed, 73 insertions(+), 70 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 1d3db4a588d..b27ffbca908 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1229,10 +1229,12 @@ purpose by adding an entry to this alist, and setting ;; But the list will just be reversed. ,@(nreverse edebug-def-args)) 'nil) - ;; Make sure `forms' is not nil so we don't accidentally return - ;; the magic keyword. Mark the closure so we don't throw away - ;; unused vars (bug#59213). - #'(lambda () :closure-dont-trim-context ,@(or forms '(nil))))) + #'(lambda () + ;; Mark the closure so we don't throw away unused vars (bug#59213). + :closure-dont-trim-context + ;; Make sure `forms' is not nil so we don't accidentally return + ;; the magic keyword. + ,@(or forms '(nil))))) (defvar edebug-form-begin-marker) ; the mark for def being instrumented @@ -1270,55 +1272,48 @@ Does not unwrap inside vectors, records, structures, or hash tables." (pcase sexp (`(edebug-after ,_before-form ,_after-index ,form) form) - (`(lambda ,args (edebug-enter ',_sym ,_arglist - (function (lambda nil . ,body)))) - `(lambda ,args ,@body)) - (`(closure ,env ,args (edebug-enter ',_sym ,_arglist - (function (lambda nil . ,body)))) - `(closure ,env ,args ,@body)) - (`(edebug-enter ',_sym ,_args (function (lambda nil . ,body))) + (`(edebug-enter ',_sym ,_args + #'(lambda nil :closure-dont-trim-context . ,body)) (macroexp-progn body)) (_ sexp))) +(defconst edebug--unwrap-cache + (make-hash-table :test 'eq :weakness 'key) + "Hash-table containing the results of unwrapping cons cells. +These results are reused to avoid redundant work but also to avoid +infinite loops when the code/environment contains a circular object.") + (defun edebug-unwrap* (sexp) "Return the SEXP recursively unwrapped." - (let ((ht (make-hash-table :test 'eq))) - (edebug--unwrap1 sexp ht))) - -(defun edebug--unwrap1 (sexp hash-table) - "Unwrap SEXP using HASH-TABLE of things already unwrapped. -HASH-TABLE contains the results of unwrapping cons cells within -SEXP, which are reused to avoid infinite loops when SEXP is or -contains a circular object." - (let ((new-sexp (edebug-unwrap sexp))) - (while (not (eq sexp new-sexp)) - (setq sexp new-sexp - new-sexp (edebug-unwrap sexp))) - (if (consp new-sexp) - (let ((result (gethash new-sexp hash-table nil))) - (unless result - (let ((remainder new-sexp) - current) - (setq result (cons nil nil) - current result) - (while - (progn - (puthash remainder current hash-table) - (setf (car current) - (edebug--unwrap1 (car remainder) hash-table)) - (setq remainder (cdr remainder)) - (cond - ((atom remainder) - (setf (cdr current) - (edebug--unwrap1 remainder hash-table)) - nil) - ((gethash remainder hash-table nil) - (setf (cdr current) (gethash remainder hash-table nil)) - nil) - (t (setq current - (setf (cdr current) (cons nil nil))))))))) - result) - new-sexp))) + (while (not (eq sexp (setq sexp (edebug-unwrap sexp))))) + (cond + ((consp sexp) + (or (gethash sexp edebug--unwrap-cache nil) + (let ((remainder sexp) + (current (cons nil nil))) + (prog1 current + (while + (progn + (puthash remainder current edebug--unwrap-cache) + (setf (car current) + (edebug-unwrap* (car remainder))) + (setq remainder (cdr remainder)) + (cond + ((atom remainder) + (setf (cdr current) + (edebug-unwrap* remainder)) + nil) + ((gethash remainder edebug--unwrap-cache nil) + (setf (cdr current) (gethash remainder edebug--unwrap-cache nil)) + nil) + (t (setq current + (setf (cdr current) (cons nil nil))))))))))) + ((byte-code-function-p sexp) + (apply #'make-byte-code + (aref sexp 0) (aref sexp 1) + (vconcat (mapcar #'edebug-unwrap* (aref sexp 2))) + (nthcdr 3 (append sexp ())))) + (t sexp))) (defun edebug-defining-form (cursor form-begin form-end speclist) @@ -4239,13 +4234,13 @@ Remove frames for Edebug's functions and the lambdas in and after-index fields in both FRAMES and the returned list of deinstrumented frames, for those frames where the source code location is known." - (let (skip-next-lambda def-name before-index after-index results - (index (length frames))) + (let ((index (length frames)) + skip-next-lambda def-name before-index after-index results) (dolist (frame (reverse frames)) (let ((new-frame (copy-edebug--frame frame)) (fun (edebug--frame-fun frame)) (args (edebug--frame-args frame))) - (cl-decf index) + (cl-decf index) ;; FIXME: Not used? (pcase fun ('edebug-enter (setq skip-next-lambda t @@ -4255,38 +4250,46 @@ code location is known." (nth 1 (nth 0 args)) (nth 0 args)) after-index (nth 1 args))) - ((pred edebug--symbol-not-prefixed-p) - (edebug--unwrap-frame new-frame) - (edebug--add-source-info new-frame def-name before-index after-index) - (edebug--add-source-info frame def-name before-index after-index) - (push new-frame results) - (setq before-index nil - after-index nil)) - (`(,(or 'lambda 'closure) . ,_) + ;; Just skip all our own frames. + ((pred edebug--symbol-prefixed-p) nil) + (_ + (when (and skip-next-lambda + (not (memq (car-safe fun) '(closure lambda)))) + (warn "Edebug--strip-instrumentation expected an interpreted function:\n%S" fun)) (unless skip-next-lambda (edebug--unwrap-frame new-frame) - (edebug--add-source-info frame def-name before-index after-index) (edebug--add-source-info new-frame def-name before-index after-index) + (edebug--add-source-info frame def-name before-index after-index) (push new-frame results)) - (setq before-index nil + (setq before-index nil after-index nil skip-next-lambda nil))))) results)) -(defun edebug--symbol-not-prefixed-p (sym) - "Return non-nil if SYM is a symbol not prefixed by \"edebug-\"." +(defun edebug--symbol-prefixed-p (sym) + "Return non-nil if SYM is a symbol prefixed by \"edebug-\"." (and (symbolp sym) - (not (string-prefix-p "edebug-" (symbol-name sym))))) + (string-prefix-p "edebug-" (symbol-name sym)))) (defun edebug--unwrap-frame (frame) "Remove Edebug's instrumentation from FRAME. Strip it from the function and any unevaluated arguments." - (setf (edebug--frame-fun frame) (edebug-unwrap* (edebug--frame-fun frame))) - (unless (edebug--frame-evald frame) - (let (results) - (dolist (arg (edebug--frame-args frame)) - (push (edebug-unwrap* arg) results)) - (setf (edebug--frame-args frame) (nreverse results))))) + (cl-callf edebug-unwrap* (edebug--frame-fun frame)) + ;; We used to try to be careful to apply `edebug-unwrap' only to source + ;; expressions and not to values, so we did not apply unwrap to the arguments + ;; of the frame if they had already been evaluated. + ;; But this was not careful enough since `edebug-unwrap*' gleefully traverses + ;; its argument without paying attention to its syntactic structure so it + ;; also "mistakenly" descends into the values contained within the "source + ;; code". In practice this *very* rarely leads to undesired results. + ;; On the contrary, it's often useful to descend into values because they + ;; may contain interpreted closures and hence source code where we *do* + ;; want to apply `edebug-unwrap'. + ;; So based on this experience, we now also apply `edebug-unwrap*' to + ;; the already evaluated arguments. + ;;(unless (edebug--frame-evald frame) + (cl-callf (lambda (xs) (mapcar #'edebug-unwrap* xs)) + (edebug--frame-args frame))) (defun edebug--add-source-info (frame def-name before-index after-index) "Update FRAME with the additional info needed by an edebug--frame. -- cgit v1.2.3 From a496378c94176930583e63ef5c95477f092a872b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 23 Mar 2024 22:48:17 -0400 Subject: cl-preloaded.el: Improve docstrings of "kinds" * lisp/emacs-lisp/cl-preloaded.el (cl--class): Improve the docstring. (built-in-class): Add a docstring. --- lisp/emacs-lisp/cl-preloaded.el | 4 +++- lisp/emacs-lisp/cl-print.el | 2 +- lisp/emacs-lisp/nadvice.el | 2 +- 3 files changed, 5 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index f7757eae9c0..8428ec4beb7 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -260,7 +260,7 @@ (cl-defstruct (cl--class (:constructor nil) (:copier nil)) - "Type of descriptors for any kind of structure-like data." + "Abstract supertype of all type descriptors." ;; Intended to be shared between defstruct and defclass. (name nil :type symbol) ;The type name. (docstring nil :type string) @@ -306,6 +306,8 @@ (:constructor nil) (:constructor built-in-class--make (name docstring parents)) (:copier nil)) + "Type descriptors for built-in types. +The `slots' (and hence `index-table') are currently unused." ) (defmacro cl--define-built-in-type (name parents &optional docstring &rest slots) diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index c35353ec3d0..5e5eee1da9e 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -444,7 +444,7 @@ primitives such as `prin1'.") (defun cl-print--preprocess (object) (let ((print-number-table (make-hash-table :test 'eq :rehash-size 2.0))) - (if (fboundp 'print--preprocess) + (if (fboundp 'print--preprocess) ;Emacs≥26 ;; Use the predefined C version if available. (print--preprocess object) ;Fill print-number-table! (let ((cl-print--number-index 0)) diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 7524ab18e58..5326c520601 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -189,7 +189,7 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.") if (cl-assert (eq 'interactive (car if))) (let ((form (cadr if))) - (if (macroexp-const-p form) + (if (macroexp-const-p form) ;Common case: a string. if ;; The interactive is expected to be run in the static context ;; that the function captured. -- cgit v1.2.3 From 7206a620af2de7281d9c9299582241a10e79e1a3 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 24 Mar 2024 11:02:34 +0800 Subject: Don't define user-ptr type when user-ptrp is not present * lisp/emacs-lisp/cl-preloaded.el (user-ptr): Condition on presence of predicate function. --- lisp/emacs-lisp/cl-preloaded.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 8428ec4beb7..f27933ed054 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -356,8 +356,10 @@ The `slots' (and hence `index-table') are currently unused." (cl--define-built-in-type tree-sitter-compiled-query atom) (cl--define-built-in-type tree-sitter-node atom) (cl--define-built-in-type tree-sitter-parser atom) -(cl--define-built-in-type user-ptr atom - nil :predicate user-ptrp) ;; FIXME: Shouldn't it be called `user-ptr-p'? +(declare-function user-ptrp "data.c") +(unless (fboundp 'user-ptrp) + (cl--define-built-in-type user-ptr atom nil + :predicate user-ptrp)) ;; FIXME: Shouldn't it be called `user-ptr-p'? (cl--define-built-in-type font-object atom) (cl--define-built-in-type font-entity atom) (cl--define-built-in-type font-spec atom) -- cgit v1.2.3 From 30b1b0d7cd8e4d46a601e9737350cda970f6bab0 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 24 Mar 2024 11:05:31 +0800 Subject: ; * lisp/emacs-lisp/cl-preloaded.el (user-ptr): Fix typo. Author: --- lisp/emacs-lisp/cl-preloaded.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index f27933ed054..35a8d79a1cd 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -357,9 +357,11 @@ The `slots' (and hence `index-table') are currently unused." (cl--define-built-in-type tree-sitter-node atom) (cl--define-built-in-type tree-sitter-parser atom) (declare-function user-ptrp "data.c") -(unless (fboundp 'user-ptrp) +(when (fboundp 'user-ptrp) (cl--define-built-in-type user-ptr atom nil - :predicate user-ptrp)) ;; FIXME: Shouldn't it be called `user-ptr-p'? + ;; FIXME: Shouldn't it be called + ;; `user-ptr-p'? + :predicate user-ptrp)) (cl--define-built-in-type font-object atom) (cl--define-built-in-type font-entity atom) (cl--define-built-in-type font-spec atom) -- cgit v1.2.3 From c5de73a95a6ecefe46fe1ac07da8e83032be7f5b Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 24 Mar 2024 11:29:37 +0100 Subject: Fix native compilation for circular immediates (bug#67883) * test/src/comp-resources/comp-test-funcs.el (comp-test-67883-1-f): New function. * lisp/emacs-lisp/comp.el (comp--collect-rhs) (comp--ssa-rename-insn): Handle setimm aside to avoid unnecessary immediate manipulation. (comp--copy-insn-rec): Rename. (comp--copy-insn): New function. (comp--dead-assignments-func): Handle setimm aside to avoid unnecessary. --- lisp/emacs-lisp/comp.el | 18 +++++++++++++++--- test/src/comp-resources/comp-test-funcs.el | 3 +++ 2 files changed, 18 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 1df1e3b3ddb..4ddf90349d1 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1788,7 +1788,9 @@ into the C code forwarding the compilation unit." for insn in (comp-block-insns b) for (op . args) = insn if (comp--assign-op-p op) - do (comp--collect-mvars (cdr args)) + do (comp--collect-mvars (if (eq op 'setimm) + (cl-first args) + (cdr args))) else do (comp--collect-mvars args)))) @@ -2442,6 +2444,8 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." (setf (comp-vec-aref frame slot-n) mvar (cadr insn) mvar)))) (pcase insn + (`(setimm ,(pred targetp) ,_imm) + (new-lvalue)) (`(,(pred comp--assign-op-p) ,(pred targetp) . ,_) (let ((mvar (comp-vec-aref frame slot-n))) (setf (cddr insn) (cl-nsubst-if mvar #'targetp (cddr insn)))) @@ -2545,7 +2549,7 @@ Return t when one or more block was removed, nil otherwise." ;; native compiling all Emacs code-base. "Max number of scanned insn before giving-up.") -(defun comp--copy-insn (insn) +(defun comp--copy-insn-rec (insn) "Deep copy INSN." ;; Adapted from `copy-tree'. (if (consp insn) @@ -2562,6 +2566,13 @@ Return t when one or more block was removed, nil otherwise." (copy-comp-mvar insn) insn))) +(defun comp--copy-insn (insn) + "Deep copy INSN." + (pcase insn + (`(setimm ,mvar ,imm) + `(setimm ,(copy-comp-mvar mvar) ,imm)) + (_ (comp--copy-insn-rec insn)))) + (defmacro comp--apply-in-env (func &rest args) "Apply FUNC to ARGS in the current compilation environment." `(let ((env (cl-loop @@ -2903,7 +2914,8 @@ Return the list of m-var ids nuked." for (op arg0 . rest) = insn if (comp--assign-op-p op) do (push (comp-mvar-id arg0) l-vals) - (setf r-vals (nconc (comp--collect-mvar-ids rest) r-vals)) + (unless (eq op 'setimm) + (setf r-vals (nconc (comp--collect-mvar-ids rest) r-vals))) else do (setf r-vals (nconc (comp--collect-mvar-ids insn) r-vals)))) ;; Every l-value appearing that does not appear as r-value has no right to diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el index dc4abf50767..54f339f6373 100644 --- a/test/src/comp-resources/comp-test-funcs.el +++ b/test/src/comp-resources/comp-test-funcs.el @@ -559,6 +559,9 @@ (let ((time (make-comp-test-time :unix (time-convert (current-time) 'integer)))) (comp-test-67239-0-f "%F" time))) +(defun comp-test-67883-1-f () + '#1=(1 . #1#)) + ;;;;;;;;;;;;;;;;;;;; ;; Tromey's tests ;; -- cgit v1.2.3 From befa9fcaae29a6c9a283ba371c3c5234c7f644eb Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 20 Feb 2024 12:19:46 +0300 Subject: org-macro--set-templates: Prevent code evaluation * lisp/org/org-macro.el (org-macro--set-templates): Get rid of any risk to evaluate code when `org-macro--set-templates' is called as a part of major mode initialization. This way, no code evaluation is ever triggered when user merely opens the file or when `mm-display-org-inline' invokes Org major mode to fontify mime part preview in email messages. --- lisp/org/org-macro.el | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el index 776d162be12..0be51eec512 100644 --- a/lisp/org/org-macro.el +++ b/lisp/org/org-macro.el @@ -109,6 +109,13 @@ previous one, unless VALUE is nil. Return the updated list." (let ((new-templates nil)) (pcase-dolist (`(,name . ,value) templates) (let ((old-definition (assoc name new-templates))) + ;; This code can be evaluated unconditionally, as a part of + ;; loading Org mode. We *must not* evaluate any code present + ;; inside the Org buffer while loading. Org buffers may come + ;; from various sources, like received email messages from + ;; potentially malicious senders. Org mode might be used to + ;; preview such messages and no code evaluation from inside the + ;; received Org text should ever happen without user consent. (when (and (stringp value) (string-match-p "\\`(eval\\>" value)) ;; Pre-process the evaluation form for faster macro expansion. (let* ((args (org-macro--makeargs value)) @@ -121,7 +128,7 @@ previous one, unless VALUE is nil. Return the updated list." (cadr (read value)) (error (user-error "Invalid definition for macro %S" name))))) - (setq value (eval (macroexpand-all `(lambda ,args ,body)) t)))) + (setq value `(lambda ,args ,body)))) (cond ((and value old-definition) (setcdr old-definition value)) (old-definition) (t (push (cons name (or value "")) new-templates))))) -- cgit v1.2.3 From ccc188fcf98ad9166ee551fac9d94b2603c3a51b Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 20 Feb 2024 12:43:51 +0300 Subject: * lisp/files.el (untrusted-content): New variable. The new variable is to be used when buffer contents comes from untrusted source. --- lisp/files.el | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'lisp') diff --git a/lisp/files.el b/lisp/files.el index c0d26b2343c..5536af014f6 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -695,6 +695,14 @@ Also see the `permanently-enabled-local-variables' variable." Some modes may wish to set this to nil to prevent directory-local settings being applied, but still respect file-local ones.") +(defvar-local untrusted-content nil + "Non-nil means that current buffer originated from an untrusted source. +Email clients and some other modes may set this non-nil to mark the +buffer contents as untrusted. + +This variable might be subject to change without notice.") +(put 'untrusted-content 'permanent-local t) + ;; This is an odd variable IMO. ;; You might wonder why it is needed, when we could just do: ;; (setq-local enable-local-variables nil) -- cgit v1.2.3 From 937b9042ad7426acdcca33e3d931d8f495bdd804 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 20 Feb 2024 12:44:30 +0300 Subject: * lisp/gnus/mm-view.el (mm-display-inline-fontify): Mark contents untrusted. --- lisp/gnus/mm-view.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 2e1261c4c9c..5f234e5c006 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -504,6 +504,7 @@ If MODE is not set, try to find mode automatically." (setq coding-system (mm-find-buffer-file-coding-system))) (setq text (buffer-string)))) (with-temp-buffer + (setq untrusted-content t) (insert (cond ((eq charset 'gnus-decoded) (with-current-buffer (mm-handle-buffer handle) (buffer-string))) -- cgit v1.2.3 From 6f9ea396f49cbe38c2173e0a72ba6af3e03b271c Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 20 Feb 2024 12:47:24 +0300 Subject: org-latex-preview: Add protection when `untrusted-content' is non-nil * lisp/org/org.el (org--latex-preview-when-risky): New variable controlling how to handle LaTeX previews in Org files from untrusted origin. (org-latex-preview): Consult `org--latex-preview-when-risky' before generating previews. This patch adds a layer of protection when LaTeX preview is requested for an email attachment, where `untrusted-content' is set to non-nil. --- lisp/org/org.el | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) (limited to 'lisp') diff --git a/lisp/org/org.el b/lisp/org/org.el index c75afbf5a67..0f5d17deee2 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -1140,6 +1140,24 @@ the following lines anywhere in the buffer: :package-version '(Org . "8.0") :type 'boolean) +(defvar untrusted-content) ; defined in files.el +(defvar org--latex-preview-when-risky nil + "If non-nil, enable LaTeX preview in Org buffers from unsafe source. + +Some specially designed LaTeX code may generate huge pdf or log files +that may exhaust disk space. + +This variable controls how to handle LaTeX preview when rendering LaTeX +fragments that originate from incoming email messages. It has no effect +when Org mode is unable to determine the origin of the Org buffer. + +An Org buffer is considered to be from unsafe source when the +variable `untrusted-content' has a non-nil value in the buffer. + +If this variable is non-nil, LaTeX previews are rendered unconditionally. + +This variable may be renamed or changed in the future.") + (defcustom org-insert-mode-line-in-empty-file nil "Non-nil means insert the first line setting Org mode in empty files. When the function `org-mode' is called interactively in an empty file, this @@ -15695,6 +15713,7 @@ fragments in the buffer." (interactive "P") (cond ((not (display-graphic-p)) nil) + ((and untrusted-content (not org--latex-preview-when-risky)) nil) ;; Clear whole buffer. ((equal arg '(64)) (org-clear-latex-preview (point-min) (point-max)) -- cgit v1.2.3 From 2bc865ace050ff118db43f01457f95f95112b877 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 20 Feb 2024 14:59:20 +0300 Subject: org-file-contents: Consider all remote files unsafe * lisp/org/org.el (org-file-contents): When loading files, consider all remote files (like TRAMP-fetched files) unsafe, in addition to URLs. --- lisp/org/org.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/org/org.el b/lisp/org/org.el index 0f5d17deee2..76559c91cd3 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -4576,12 +4576,16 @@ from file or URL, and return nil. If NOCACHE is non-nil, do a fresh fetch of FILE even if cached version is available. This option applies only if FILE is a URL." (let* ((is-url (org-url-p file)) + (is-remote (condition-case nil + (file-remote-p file) + ;; In case of error, be safe. + (t t))) (cache (and is-url (not nocache) (gethash file org--file-cache)))) (cond (cache) - (is-url + ((or is-url is-remote) (if (org--should-fetch-remote-resource-p file) (condition-case error (with-current-buffer (url-retrieve-synchronously file) -- cgit v1.2.3 From 7a5d7be52c5f0690ee47f30bfad973827261abf2 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Fri, 23 Feb 2024 12:56:58 +0300 Subject: org--confirm-resource-safe: Fix prompt when prompting in non-file Org buffers * lisp/org/org.el (org--confirm-resource-safe): When called from non-file buffer, do not put stray "f" in the prompt. --- lisp/org/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/org/org.el b/lisp/org/org.el index 76559c91cd3..154388f79c6 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -4671,9 +4671,9 @@ returns non-nil if any of them match." (propertize domain 'face '(:inherit org-link :weight normal)) ") as safe.\n ") "") - (propertize "f" 'face 'success) (if current-file (concat + (propertize "f" 'face 'success) " to download this resource, and permanently mark all resources in " (propertize current-file 'face 'underline) " as safe.\n ") -- cgit v1.2.3 From ff6cc3d2cf0e17fc44ac7dfd259c74f96eafa1c4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 24 Mar 2024 09:36:24 -0400 Subject: * lisp/ldefs-boot.el: Regenerate. --- lisp/ldefs-boot.el | 45 +++++++++++++++++++++++++++++---------------- 1 file changed, 29 insertions(+), 16 deletions(-) (limited to 'lisp') diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 16a9df2c92e..60e7f6811bc 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -6961,13 +6961,22 @@ or call the function `desktop-save-mode'.") (autoload 'desktop-save-mode "desktop" "\ Toggle desktop saving (Desktop Save mode). -When Desktop Save mode is enabled, the state of Emacs is saved from -one session to another. In particular, Emacs will save the desktop when -it exits (this may prompt you; see the option `desktop-save'). The next -time Emacs starts, if this mode is active it will restore the desktop. +When Desktop Save mode is enabled, the state of Emacs is saved from one +session to another. The saved Emacs \"desktop configuration\" includes the +buffers, their file names, major modes, buffer positions, window and frame +configuration, and some important global variables. -To manually save the desktop at any time, use the command `\\[desktop-save]'. -To load it, use `\\[desktop-read]'. +To enable this feature for future sessions, customize `desktop-save-mode' +to t, or add this line in your init file: + + (desktop-save-mode 1) + +When this mode is enabled, Emacs will save the desktop when it exits +(this may prompt you, see the option `desktop-save'). The next time +Emacs starts, if this mode is active it will restore the desktop. + +To manually save the desktop at any time, use the command \\[desktop-save]. +To load it, use \\[desktop-read]. Once a desktop file exists, Emacs will auto-save it according to the option `desktop-auto-save-timeout'. @@ -13023,7 +13032,7 @@ For instance: (?l . \"ls\"))) Each %-spec may contain optional flag, width, and precision -modifiers, as follows: +specifiers, as follows: %character @@ -13036,7 +13045,7 @@ The following flags are allowed: * ^: Convert to upper case. * _: Convert to lower case. -The width and truncation modifiers behave like the corresponding +The width and precision specifiers behave like the corresponding ones in `format' when applied to %s. For example, \"%<010b\" means \"substitute into the output the @@ -17261,9 +17270,13 @@ use its file extension as image type. Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data. Optional PROPS are additional image attributes to assign to the image, -like, e.g. `:mask MASK'. If the property `:scale' is not given and the -display has a high resolution (more exactly, when the average width of a -character in the default font is more than 10 pixels), the image is +like, e.g. `:mask MASK'. See Info node `(elisp)Image Descriptors' for +the list of supported properties; see the nodes following that node +for properties specific to certain image types. + +If the property `:scale' is not given and the display has a high +resolution (more exactly, when the average width of a character +in the default font is more than 10 pixels), the image is automatically scaled up in proportion to the default font. Value is the image created, or nil if images of type TYPE are not supported. @@ -23870,8 +23883,8 @@ As with `pcase-let', BINDINGS are of the form (PATTERN EXP), but the EXP in each binding in BINDINGS can use the results of the destructuring bindings that precede it in BINDINGS' order. -Each EXP should match (i.e. be of compatible structure) to its -respective PATTERN; a mismatch may signal an error or may go +Each EXP should match its respective PATTERN (i.e. be of structure +compatible to PATTERN); a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil. (fn BINDINGS &rest BODY)" nil t) @@ -23884,8 +23897,8 @@ All EXPs are evaluated first, and then used to perform destructuring bindings by matching each EXP against its respective PATTERN. Then BODY is evaluated with those bindings in effect. -Each EXP should match (i.e. be of compatible structure) to its -respective PATTERN; a mismatch may signal an error or may go +Each EXP should match its respective PATTERN (i.e. be of structure +compatible to PATTERN); a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil. (fn BINDINGS &rest BODY)" nil t) @@ -32878,7 +32891,7 @@ Add archive file name handler to `file-name-handler-alist'." (when (and tramp-ar ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 6 2 29 2)) package--builtin-versions) +(push (purecopy '(tramp 2 6 3 -1)) package--builtin-versions) (register-definition-prefixes "trampver" '("tramp-")) -- cgit v1.2.3 From 83a6e80d66a4c6333e2bbb21d0428c432ddca881 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 24 Mar 2024 22:13:44 -0400 Subject: (byte-optimize-form-code-walker): Simplify a bit Eliminate a case that matches very rarely and where the default handling works just as well anyway. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Remove redundant case. --- lisp/emacs-lisp/byte-opt.el | 3 --- 1 file changed, 3 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index f6df40a2d9b..54997205edb 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -482,9 +482,6 @@ There can be multiple entries for the same NAME if it has several aliases.") (push name byte-optimize--dynamic-vars) `(,fn ,name . ,optimized-rest))) - (`(,(pred byte-code-function-p) . ,exps) - (cons fn (mapcar #'byte-optimize-form exps))) - ((guard (when for-effect (if-let ((tmp (byte-opt--fget fn 'side-effect-free))) (or byte-compile-delete-errors -- cgit v1.2.3 From f54b1d9f7b7a977ee4856c778a309c900ce9e8fa Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 25 Mar 2024 09:45:08 +0200 Subject: * lisp/vc/diff-mode.el (diff-setup-buffer-type): Remove "\n" from regexp. Remove extra "\n" from the end of the "diff --git.*" part of 'diff-outline-regexp' because "\n" is not used in outline-regexp and causes problems in such cases like when killing hunks in the diff buffer with outline-minor-mode that loses the outline icons because outline--fix-buttons-after-change and outline--fix-up-all-buttons are limited to the single line and can't match an outline line with a regexp that ends with "\n". --- lisp/vc/diff-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 0f393ba86a2..66043059d14 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -1619,7 +1619,7 @@ modified lines of the diff." nil))) (when (eq diff-buffer-type 'git) (setq diff-outline-regexp - (concat "\\(^diff --git.*\n\\|" diff-hunk-header-re "\\)"))) + (concat "\\(^diff --git.*\\|" diff-hunk-header-re "\\)"))) (setq-local outline-level #'diff--outline-level) (setq-local outline-regexp diff-outline-regexp)) -- cgit v1.2.3 From 7fba25cf5344f5c3507aedf59e6ae099e7662508 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 25 Mar 2024 15:51:07 +0200 Subject: Fix removal of bookmark's fringe mark in Info and Dired * lisp/bookmark.el (bookmark-buffer-file-name): Support Info buffers. (bookmark--remove-fringe-mark): Call 'bookmark-buffer-file-name' instead of using 'buffer-file-name', which could be nil. (Bug#69974) --- lisp/bookmark.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 60dd61a5ac8..bf2357207d8 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -515,10 +515,11 @@ See user option `bookmark-fringe-mark'." (non-essential t) overlays found temp) (when (and pos filename) - (setq filename (expand-file-name filename)) + (setq filename (abbreviate-file-name (expand-file-name filename))) (dolist (buf (buffer-list)) (with-current-buffer buf - (when (equal filename buffer-file-name) + (when (equal filename + (ignore-errors (bookmark-buffer-file-name))) (setq overlays (save-excursion (goto-char pos) @@ -1192,6 +1193,8 @@ it to the name of the bookmark currently being set, advancing (if (stringp dired-directory) dired-directory (car dired-directory))) + ((and (boundp 'Info-current-file) (stringp Info-current-file)) + Info-current-file) (t (error "Buffer not visiting a file or directory"))))) (defvar bookmark--watch-already-asked-mtime nil -- cgit v1.2.3 From 728bf2c9e5353e68b16808ae455223549c16efc6 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 26 Mar 2024 10:11:26 +0800 Subject: Prevent passwords from being recorded during text conversion * doc/lispref/commands.texi (Misc Events): Document new value of text-conversion-style. * java/org/gnu/emacs/EmacsService.java (EmacsService) : New constant. * java/org/gnu/emacs/EmacsView.java (onCreateInputConnection): Set TYPE_TEXT_VARIATION_PASSWORD and IME_FLAG_FORCE_ASII if mode is IC_MODE_PASSWORD. * lisp/subr.el (read-passwd): Set text-conversion-style to `password'. * src/androidgui.h (enum android_ic_mode): New value ANDROID_IC_MODE_PASSWORD. * src/androidterm.c (android_reset_conversion): Handle `password'. * src/buffer.c (syms_of_buffer) <&BVAR (current_buffer, text_conversion_style)>: Update doc string. * src/textconv.c (syms_of_textconv) : New DEFSYM. : Fix typos in doc string. --- doc/lispref/commands.texi | 9 ++++++++- java/org/gnu/emacs/EmacsService.java | 7 ++++--- java/org/gnu/emacs/EmacsView.java | 9 ++++++++- lisp/subr.el | 16 ++++++++++------ src/androidgui.h | 7 ++++--- src/androidterm.c | 2 ++ src/buffer.c | 7 +++++++ src/textconv.c | 3 ++- 8 files changed, 45 insertions(+), 15 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 6c8d42337d0..9ecdd23716c 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2464,7 +2464,7 @@ buffer-local variable @code{text-conversion-style}, which determines how an input method that wishes to make edits to buffer contents will behave. -This variable can have one of three values: +This variable can have one of four values: @table @code @item nil @@ -2475,6 +2475,13 @@ events will be sent instead of text conversion events. This means that the input method will be enabled, but @key{RET} will be sent whenever the input method wants to insert a new line. +@item password +This is largely identical to @code{action}, but also requests an input +method capable of inserting ASCII characters and instructs it not to +save input in locations from whence it might be subsequently retrieved +by features of the input method unfit to handle sensitive information, +such as text suggestions. + @item t This, or any other value, means that the input method will be enabled and make edits followed by @code{text-conversion} events. diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 4e863c750d3..446cd26a3dd 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -114,9 +114,10 @@ public final class EmacsService extends Service private ContentResolver resolver; /* Keep this in synch with androidgui.h. */ - public static final int IC_MODE_NULL = 0; - public static final int IC_MODE_ACTION = 1; - public static final int IC_MODE_TEXT = 2; + public static final int IC_MODE_NULL = 0; + public static final int IC_MODE_ACTION = 1; + public static final int IC_MODE_TEXT = 2; + public static final int IC_MODE_PASSWORD = 3; /* Display metrics used by font backends. */ public DisplayMetrics metrics; diff --git a/java/org/gnu/emacs/EmacsView.java b/java/org/gnu/emacs/EmacsView.java index 8398e4b784c..5b922212c0b 100644 --- a/java/org/gnu/emacs/EmacsView.java +++ b/java/org/gnu/emacs/EmacsView.java @@ -838,9 +838,16 @@ public final class EmacsView extends ViewGroup EmacsNative.requestSelectionUpdate (window.handle); } - if (mode == EmacsService.IC_MODE_ACTION) + if (mode == EmacsService.IC_MODE_ACTION + || mode == EmacsService.IC_MODE_PASSWORD) info.imeOptions |= EditorInfo.IME_ACTION_DONE; + if (mode == EmacsService.IC_MODE_PASSWORD) + { + info.imeOptions |= EditorInfo.IME_FLAG_FORCE_ASCII; + info.inputType |= InputType.TYPE_TEXT_VARIATION_PASSWORD; + } + /* Set the initial selection fields. */ info.initialSelStart = selection[0]; info.initialSelEnd = selection[1]; diff --git a/lisp/subr.el b/lisp/subr.el index 3de4412637f..90dbfc75d52 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3405,6 +3405,10 @@ with Emacs. Do not call it directly in your own packages." (+ i beg) (+ 1 i beg) 'help-echo "C-u: Clear password\nTAB: Toggle password visibility")))) +;; Actually in textconv.c. +(defvar overriding-text-conversion-style) +(declare-function set-text-conversion-style "textconv.c") + (defun read-passwd (prompt &optional confirm default) "Read a password, prompting with PROMPT, and return it. If optional CONFIRM is non-nil, read the password twice to make sure. @@ -3445,7 +3449,8 @@ by doing (clear-string STRING)." (add-hook 'post-command-hook #'read-passwd--hide-password nil t)) (unwind-protect (let ((enable-recursive-minibuffers t) - (read-hide-char (or read-hide-char ?*))) + (read-hide-char (or read-hide-char ?*)) + (overriding-text-conversion-style 'password)) (read-string prompt nil t default)) ; t = "no history" (when (buffer-live-p minibuf) (with-current-buffer minibuf @@ -3457,7 +3462,10 @@ by doing (clear-string STRING)." #'read-passwd--hide-password 'local) (kill-local-variable 'post-self-insert-hook) ;; And of course, don't keep the sensitive data around. - (erase-buffer)))))))) + (erase-buffer) + ;; Then restore the previous text conversion style. + (when (fboundp 'set-text-conversion-style) + (set-text-conversion-style text-conversion-style))))))))) (defvar read-number-history nil "The default history for the `read-number' function.") @@ -3867,10 +3875,6 @@ confusing to some users.") from--tty-menu-p) ; invoked via TTY menu use-dialog-box))) -;; Actually in textconv.c. -(defvar overriding-text-conversion-style) -(declare-function set-text-conversion-style "textconv.c") - (defun y-or-n-p (prompt) "Ask user a \"y or n\" question. Return t if answer is \"y\" and nil if it is \"n\". diff --git a/src/androidgui.h b/src/androidgui.h index d89aee51055..f941c7cc577 100644 --- a/src/androidgui.h +++ b/src/androidgui.h @@ -618,9 +618,10 @@ enum android_lookup_status enum android_ic_mode { - ANDROID_IC_MODE_NULL = 0, - ANDROID_IC_MODE_ACTION = 1, - ANDROID_IC_MODE_TEXT = 2, + ANDROID_IC_MODE_NULL = 0, + ANDROID_IC_MODE_ACTION = 1, + ANDROID_IC_MODE_TEXT = 2, + ANDROID_IC_MODE_PASSWORD = 3, }; enum android_stack_mode diff --git a/src/androidterm.c b/src/androidterm.c index ba9b6d3b8a9..c920375fdbe 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -6276,6 +6276,8 @@ android_reset_conversion (struct frame *f) if (NILP (style) || conversion_disabled_p ()) mode = ANDROID_IC_MODE_NULL; + else if (EQ (style, Qpassword)) + mode = ANDROID_IC_MODE_PASSWORD; else if (EQ (style, Qaction) || EQ (f->selected_window, f->minibuffer_window)) mode = ANDROID_IC_MODE_ACTION; diff --git a/src/buffer.c b/src/buffer.c index 07d19dfc078..9f954e1aba9 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5900,12 +5900,19 @@ Use Custom to set this variable and update the display. */); text_conversion_style), Qnil, doc: /* How the on screen keyboard's input method should insert in this buffer. + When nil, the input method will be disabled and an ordinary keyboard will be displayed in its place. + When the symbol `action', the input method will insert text directly, but will send `return' key events instead of inserting new line characters. Any other value means that the input method will insert text directly. +When the symbol `password', an input method capable of ASCII input will +be enabled, and will not save entered text where it will be retrieved +for text suggestions or other features not suited to handling sensitive +information, in addition to reporting `return' as when `action'. + If you need to make non-buffer local changes to this variable, use `overriding-text-conversion-style', which see. diff --git a/src/textconv.c b/src/textconv.c index 0941848dd09..9625c884e16 100644 --- a/src/textconv.c +++ b/src/textconv.c @@ -2318,6 +2318,7 @@ void syms_of_textconv (void) { DEFSYM (Qaction, "action"); + DEFSYM (Qpassword, "password"); DEFSYM (Qtext_conversion, "text-conversion"); DEFSYM (Qpush_mark, "push-mark"); DEFSYM (Qunderline, "underline"); @@ -2325,7 +2326,7 @@ syms_of_textconv (void) "overriding-text-conversion-style"); DEFVAR_LISP ("text-conversion-edits", Vtext_conversion_edits, - doc: /* List of buffers that were last edited as result of text conversion. + doc: /* List of buffers last edited as a result of text conversion. This list can be used while handling a `text-conversion' event to determine which changes have taken place. -- cgit v1.2.3 From 95d9e6eb6b48b9b51a0b9d7de4a0c4eeed6c7a70 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 26 Mar 2024 08:20:54 +0100 Subject: * Don't install unnecessary trampolines (bug#69573) (don't merge) * lisp/emacs-lisp/comp.el (comp-subr-trampoline-install): Check that subr-name actually matches the target subr. --- lisp/emacs-lisp/comp.el | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 6b65a375ea0..a3c6bb59469 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -714,13 +714,15 @@ This are essential for the trampoline machinery to work properly.") (when (memq subr-name comp-warn-primitives) (warn "Redefining `%s' might break native compilation of trampolines." subr-name)) - (unless (or (null native-comp-enable-subr-trampolines) - (memq subr-name native-comp-never-optimize-functions) - (gethash subr-name comp-installed-trampolines-h)) - (cl-assert (subr-primitive-p (symbol-function subr-name))) - (when-let ((trampoline (or (comp-trampoline-search subr-name) - (comp-trampoline-compile subr-name)))) - (comp--install-trampoline subr-name trampoline)))) + (let ((subr (symbol-function subr-name))) + (unless (or (not (string= subr-name (subr-name subr))) ;; (bug#69573) + (null native-comp-enable-subr-trampolines) + (memq subr-name native-comp-never-optimize-functions) + (gethash subr-name comp-installed-trampolines-h)) + (cl-assert (subr-primitive-p subr)) + (when-let ((trampoline (or (comp-trampoline-search subr-name) + (comp-trampoline-compile subr-name)))) + (comp--install-trampoline subr-name trampoline))))) (cl-defstruct (comp-vec (:copier nil)) -- cgit v1.2.3 From 8cc67dbcec0753c5579e63bf82bfe247debe222c Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 26 Mar 2024 11:14:08 +0100 Subject: Fix native comp prediction on null functionp tested objects * lisp/emacs-lisp/comp.el (comp-known-predicates) (comp-known-predicates-h): Update. (comp--pred-to-pos-cstr, comp--pred-to-neg-cstr): New functions. (comp--add-cond-cstrs): Make use of them. * test/src/comp-tests.el (comp-tests-type-spec-tests): Add a test. --- lisp/emacs-lisp/comp.el | 101 +++++++++++++++++++++++++++--------------------- test/src/comp-tests.el | 9 ++++- 2 files changed, 64 insertions(+), 46 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 4ddf90349d1..9976a58f893 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -193,49 +193,52 @@ Useful to hook into pass checkers.") ;; cl-macs.el. We can't use `cl-deftype-satisfies' directly as the ;; relation type <-> predicate is not bijective (bug#45576). (defconst comp-known-predicates - '((arrayp . array) - (atom . atom) - (bool-vector-p . bool-vector) - (booleanp . boolean) - (bufferp . buffer) - (char-table-p . char-table) - (characterp . fixnum) - (consp . cons) - (floatp . float) - (framep . frame) - (functionp . (or function symbol cons)) - (hash-table-p . hash-table) - (integer-or-marker-p . integer-or-marker) - (integerp . integer) - (keywordp . keyword) - (listp . list) - (markerp . marker) - (natnump . (integer 0 *)) - (null . null) - (number-or-marker-p . number-or-marker) - (numberp . number) - (numberp . number) - (obarrayp . obarray) - (overlayp . overlay) - (processp . process) - (sequencep . sequence) - (stringp . string) - (subrp . subr) - (symbol-with-pos-p . symbol-with-pos) - (symbolp . symbol) - (vectorp . vector) - (windowp . window)) - "Alist predicate -> matched type specifier.") + '((arrayp array) + (atom atom) + (bool-vector-p bool-vector) + (booleanp boolean) + (bufferp buffer) + (char-table-p char-table) + (characterp fixnum) + (consp cons) + (floatp float) + (framep frame) + (functionp (or function symbol cons) (not function)) + (hash-table-p hash-table) + (integer-or-marker-p integer-or-marker) + (integerp integer) + (keywordp keyword) + (listp list) + (markerp marker) + (natnump (integer 0 *)) + (null null) + (number-or-marker-p number-or-marker) + (numberp number) + (numberp number) + (obarrayp obarray) + (overlayp overlay) + (processp process) + (sequencep sequence) + (stringp string) + (subrp subr) + (symbol-with-pos-p symbol-with-pos) + (symbolp symbol) + (vectorp vector) + (windowp window)) + "(PREDICATE TYPE-IF-SATISFIED ?TYPE-IF-NOT-SATISFIED).") (defconst comp-known-predicates-h (cl-loop with comp-ctxt = (make-comp-cstr-ctxt) with h = (make-hash-table :test #'eq) - for (pred . type-spec) in comp-known-predicates - for cstr = (comp-type-spec-to-cstr type-spec) - do (puthash pred cstr h) + for (pred . type-specs) in comp-known-predicates + for pos-cstr = (comp-type-spec-to-cstr (car type-specs)) + for neg-cstr = (if (length> type-specs 1) + (comp-type-spec-to-cstr (cl-second type-specs)) + (comp-cstr-negation-make pos-cstr)) + do (puthash pred (cons pos-cstr neg-cstr) h) finally return h) - "Hash table function -> `comp-constraint'.") + "Hash table FUNCTION -> (POS-CSTR . NEG-CSTR).") (defun comp--known-predicate-p (predicate) "Return t if PREDICATE is known." @@ -243,10 +246,14 @@ Useful to hook into pass checkers.") (gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt))) t)) -(defun comp--pred-to-cstr (predicate) - "Given PREDICATE, return the corresponding constraint." - ;; FIXME: Unify those two hash tables? - (or (gethash predicate comp-known-predicates-h) +(defun comp--pred-to-pos-cstr (predicate) + "Given PREDICATE, return the corresponding positive constraint." + (or (car-safe (gethash predicate comp-known-predicates-h)) + (gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt)))) + +(defun comp--pred-to-neg-cstr (predicate) + "Given PREDICATE, return the corresponding negative constraint." + (or (cdr-safe (gethash predicate comp-known-predicates-h)) (gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt)))) (defconst comp-symbol-values-optimizable '(most-positive-fixnum @@ -2033,7 +2040,6 @@ TARGET-BB-SYM is the symbol name of the target block." (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks)) (cl-loop with target-mvar = (comp--cond-cstrs-target-mvar op (car insns-seq) b) - with cstr = (comp--pred-to-cstr fun) for branch-target-cell on blocks for branch-target = (car branch-target-cell) for negated in '(t nil) @@ -2041,7 +2047,10 @@ TARGET-BB-SYM is the symbol name of the target block." do (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) - (comp--emit-assume 'and target-mvar cstr block-target negated)) + (comp--emit-assume 'and target-mvar (if negated + (comp--pred-to-neg-cstr fun) + (comp--pred-to-pos-cstr fun)) + block-target nil)) finally (cl-return-from in-the-basic-block))) ;; Match predicate on the negated branch (unless). (`((set ,(and (pred comp-mvar-p) cmp-res) @@ -2052,7 +2061,6 @@ TARGET-BB-SYM is the symbol name of the target block." (cond-jump ,neg-cmp-res ,(pred comp-mvar-p) . ,blocks)) (cl-loop with target-mvar = (comp--cond-cstrs-target-mvar op (car insns-seq) b) - with cstr = (comp--pred-to-cstr fun) for branch-target-cell on blocks for branch-target = (car branch-target-cell) for negated in '(nil t) @@ -2060,7 +2068,10 @@ TARGET-BB-SYM is the symbol name of the target block." do (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) - (comp--emit-assume 'and target-mvar cstr block-target negated)) + (comp--emit-assume 'and target-mvar (if negated + (comp--pred-to-neg-cstr fun) + (comp--pred-to-pos-cstr fun)) + block-target nil)) finally (cl-return-from in-the-basic-block)))) (setf prev-insns-seq insns-seq)))) diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index fbcb6ca9560..b2fd2f68826 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -1496,7 +1496,14 @@ Return a list of results." (if (comp-foo-p x) x (error ""))) - 'comp-foo))) + 'comp-foo) + + ;; 80 + ((defun comp-tests-ret-type-spec-f (x) + (if (functionp x) + (error "") + x)) + '(not function)))) (defun comp-tests-define-type-spec-test (number x) `(comp-deftest ,(intern (format "ret-type-spec-%d" number)) () -- cgit v1.2.3 From 004f2493a542dd0b804a30e97fc612884ca440f4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 26 Mar 2024 13:14:15 -0400 Subject: cl-preloaded.el: Fix the type lattice We generally want types to form not just a DAG but a lattice. If objects can be both `keyword` and `symbol-with-pos`, this means there should be a more precise type describing this intersection. If we ever find the need for such a refinement, we could add such a `keyword-with-pos` type, but here I took the simpler route of treating `keyword` not as a proper built-in type but as a second-class type like `natnum`. While fixing this problem, also fix the problem we had where `functionp` was not quite adequate to characterize objects of type `function`, by introducing a new predicate `cl-functionp` for that. * lisp/emacs-lisp/cl-preloaded.el (cl-functionp): New function. (function): Use it. (keyword): Don't declare it as a built-in type. (user-ptrp): Remove redundant declaration. * lisp/emacs-lisp/cl-generic.el (cl--generic--unreachable-types): Delete constant. (cl-generic-generalizers): Remove corresponding test. * lisp/emacs-lisp/cl-macs.el (cl-deftype-satisfies): Add entry for `keyword` type. * lisp/emacs-lisp/comp.el (comp-known-predicates): Fix type for negative result of `characterp`. Remove duplicate `numberp` entry. Fix types for `keywordp` now that `keyword` is not a built-in type any more. * test/src/data-tests.el (data-tests--cl-type-of): Add a few cases. Remove workaround for `function`. --- etc/NEWS | 8 +++++--- lisp/emacs-lisp/cl-generic.el | 11 ++--------- lisp/emacs-lisp/cl-macs.el | 1 + lisp/emacs-lisp/cl-preloaded.el | 17 +++++++++++------ lisp/emacs-lisp/comp.el | 6 +++--- test/src/data-tests.el | 30 +++++++++++++++--------------- 6 files changed, 37 insertions(+), 36 deletions(-) (limited to 'lisp') diff --git a/etc/NEWS b/etc/NEWS index 73af6ab773e..25c4efa590f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1700,9 +1700,11 @@ This function is like 'type-of' except that it sometimes returns a more precise type. For example, for nil and t it returns 'null' and 'boolean' respectively, instead of just 'symbol'. -** New function `primitive-function-p`. -This is like `subr-primitive-p` except that it returns t only if the -argument is a function rather than a special-form. +** New functions `primitive-function-p` and `cl-functionp`. +`primitive-function-p` is like `subr-primitive-p` except that it returns +t only if the argument is a function rather than a special-form, +and `cl-functionp` is like `functionp` except it return nil +for lists and symbols. ** Built-in types have now corresponding classes. At the Lisp level, this means that things like (cl-find-class 'integer) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 62abe8d1589..8bda857afdd 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1332,11 +1332,6 @@ These match if the argument is `eql' to VAL." ;;; Dispatch on "normal types". -(defconst cl--generic--unreachable-types - ;; FIXME: Try to make that list empty? - '(keyword) - "Built-in classes on which we cannot dispatch for technical reasons.") - (defun cl--generic-type-specializers (tag &rest _) (and (symbolp tag) (let ((class (cl--find-class tag))) @@ -1350,14 +1345,12 @@ These match if the argument is `eql' to VAL." (cl-defmethod cl-generic-generalizers :extra "typeof" (type) "Support for dispatch on types. This currently works for built-in types and types built on top of records." - ;; FIXME: Add support for other types accepted by `cl-typep' such - ;; as `character', `face', `function', ... + ;; FIXME: Add support for other "types" accepted by `cl-typep' such + ;; as `character', `face', `keyword', ...? (or (and (symbolp type) (not (eq type t)) ;; Handled by the `t-generalizer'. (let ((class (cl--find-class type))) - (when (memq type cl--generic--unreachable-types) - (error "Dispatch on %S is currently not supported" type)) (memq (type-of class) '(built-in-class cl-structure-class eieio--class))) (list cl--generic-typeof-generalizer)) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index ab31946d8ab..051cd992fc1 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3467,6 +3467,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." '((base-char . characterp) ;Could be subtype of `fixnum'. (character . natnump) ;Could be subtype of `fixnum'. (command . commandp) ;Subtype of closure & subr. + (keyword . keywordp) ;Would need `keyword-with-pos`. (natnum . natnump) ;Subtype of fixnum & bignum. (real . numberp) ;Not clear where it would fit. )) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 35a8d79a1cd..6128db05c61 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -349,6 +349,14 @@ The `slots' (and hence `index-table') are currently unused." ;; so the DAG of OClosure types is "orthogonal" to the distinction ;; between interpreted and compiled functions. +(defun cl-functionp (object) + "Return non-nil if OBJECT is a member of type `function'. +This is like `functionp' except that it returns nil for all lists and symbols, +regardless if `funcall' would accept to call them." + (memq (cl-type-of object) + '(primitive-function subr-native-elisp module-function + interpreted-function byte-code-function))) + (cl--define-built-in-type t nil "Abstract supertype of everything.") (cl--define-built-in-type atom t "Abstract supertype of anything but cons cells." :predicate atom) @@ -356,11 +364,9 @@ The `slots' (and hence `index-table') are currently unused." (cl--define-built-in-type tree-sitter-compiled-query atom) (cl--define-built-in-type tree-sitter-node atom) (cl--define-built-in-type tree-sitter-parser atom) -(declare-function user-ptrp "data.c") (when (fboundp 'user-ptrp) (cl--define-built-in-type user-ptr atom nil - ;; FIXME: Shouldn't it be called - ;; `user-ptr-p'? + ;; FIXME: Shouldn't it be called `user-ptr-p'? :predicate user-ptrp)) (cl--define-built-in-type font-object atom) (cl--define-built-in-type font-entity atom) @@ -410,8 +416,6 @@ The `slots' (and hence `index-table') are currently unused." The size depends on the Emacs version and compilation options. For this build of Emacs it's %dbit." (1+ (logb (1+ most-positive-fixnum))))) -(cl--define-built-in-type keyword (symbol) - "Type of those symbols whose first char is `:'.") (cl--define-built-in-type boolean (symbol) "Type of the canonical boolean values, i.e. either nil or t.") (cl--define-built-in-type symbol-with-pos (symbol) @@ -431,7 +435,8 @@ For this build of Emacs it's %dbit." ;; Example of slots we could document. (car car) (cdr cdr)) (cl--define-built-in-type function (atom) - "Abstract supertype of function values.") + "Abstract supertype of function values." + :predicate cl-functionp) (cl--define-built-in-type compiled-function (function) "Abstract type of functions that have been compiled.") (cl--define-built-in-type byte-code-function (compiled-function) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 9976a58f893..2544be85bb2 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -193,13 +193,14 @@ Useful to hook into pass checkers.") ;; cl-macs.el. We can't use `cl-deftype-satisfies' directly as the ;; relation type <-> predicate is not bijective (bug#45576). (defconst comp-known-predicates + ;; FIXME: Auto-generate (most of) it from `cl-deftype-satifies'? '((arrayp array) (atom atom) (bool-vector-p bool-vector) (booleanp boolean) (bufferp buffer) (char-table-p char-table) - (characterp fixnum) + (characterp fixnum t) (consp cons) (floatp float) (framep frame) @@ -207,14 +208,13 @@ Useful to hook into pass checkers.") (hash-table-p hash-table) (integer-or-marker-p integer-or-marker) (integerp integer) - (keywordp keyword) + (keywordp symbol t) (listp list) (markerp marker) (natnump (integer 0 *)) (null null) (number-or-marker-p number-or-marker) (numberp number) - (numberp number) (obarrayp obarray) (overlayp overlay) (processp process) diff --git a/test/src/data-tests.el b/test/src/data-tests.el index daa49e671b5..753d74c02ec 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -845,10 +845,12 @@ comparing the subr with a much slower Lisp implementation." ;; Note: This doesn't work for list/vector structs since those types ;; are too difficult/unreliable to detect (so `cl-type-of' only says ;; it's a `cons' or a `vector'). - (dolist (val (list -2 10 (expt 2 128) nil t 'car + (dolist (val (list -2 10 (expt 2 128) nil t 'car :car (symbol-function 'car) (symbol-function 'progn) - (position-symbol 'car 7))) + (eval '(lambda (x) (+ x 1)) t) + (position-symbol 'car 7) + (position-symbol :car 7))) (let* ((type (cl-type-of val)) (class (cl-find-class type)) (alltypes (cl--class-allparents class)) @@ -858,19 +860,17 @@ comparing the subr with a much slower Lisp implementation." (dolist (parent alltypes) (should (cl-typep val parent)) (dolist (subtype (cl--class-children (cl-find-class parent))) - (unless (memq subtype alltypes) - (unless (memq subtype - ;; FIXME: Some types don't have any associated - ;; predicate, - '( font-spec font-entity font-object - finalizer condvar terminal - native-comp-unit interpreted-function - tree-sitter-compiled-query - tree-sitter-node tree-sitter-parser - ;; `functionp' also matches things of type - ;; `symbol' and `cons'. - function)) - (should-not (cl-typep val subtype))))))))) + (when (and (not (memq subtype alltypes)) + (built-in-class-p (cl-find-class subtype)) + (not (memq subtype + ;; FIXME: Some types don't have any associated + ;; predicate, + '( font-spec font-entity font-object + finalizer condvar terminal + native-comp-unit interpreted-function + tree-sitter-compiled-query + tree-sitter-node tree-sitter-parser)))) + (should-not (cl-typep val subtype)))))))) ;;; data-tests.el ends here -- cgit v1.2.3 From ed85132740b39c147647be1831abb64a3f514d57 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Tue, 26 Mar 2024 20:59:43 +0000 Subject: CC Mode: Handle C++20's if consteval * lisp/progmodes/cc-engine.el (c-after-conditional): Handle the new keyword in place of a paren sexp after `if'. * lisp/progmodes/cc-langs.el (c-negation-op-re) (c-paren-clause-kwds, c-paren-clause-key) (c-block-stmt-with-kwds, c-block-stmt-with-key): New lang-consts/vars. * if-11.cc, if-11.res: New test files. --- lisp/progmodes/cc-engine.el | 22 +++++++++++++++------- lisp/progmodes/cc-langs.el | 30 ++++++++++++++++++++++++++++++ 2 files changed, 45 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index ea4ee3d7b7c..8c505e9556a 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -12346,13 +12346,21 @@ comment at the start of cc-engine.el for more info." (zerop (c-backward-token-2 1 t lim)) t) (or (looking-at c-block-stmt-1-key) - (and (eq (char-after) ?\() - (zerop (c-backward-token-2 1 t lim)) - (if (looking-at c-block-stmt-hangon-key) - (zerop (c-backward-token-2 1 t lim)) - t) - (or (looking-at c-block-stmt-2-key) - (looking-at c-block-stmt-1-2-key)))) + (or + (and + (eq (char-after) ?\() + (zerop (c-backward-token-2 1 t lim)) + (if (looking-at c-block-stmt-hangon-key) + (zerop (c-backward-token-2 1 t lim)) + t) + (or (looking-at c-block-stmt-2-key) + (looking-at c-block-stmt-1-2-key))) + (and (looking-at c-paren-clause-key) + (zerop (c-backward-token-2 1 t lim)) + (if (looking-at c-negation-op-re) + (zerop (c-backward-token-2 1 t lim)) + t) + (looking-at c-block-stmt-with-key)))) (point)))) (defun c-after-special-operator-id (&optional lim) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index ae2389c75c2..06b919f26fd 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -1599,6 +1599,12 @@ operators." (c-lang-defvar c-assignment-op-regexp (c-lang-const c-assignment-op-regexp)) +(c-lang-defconst c-negation-op-re + ;; Regexp matching the negation operator. + t "!\\([^=]\\|$\\)") + +(c-lang-defvar c-negation-op-re (c-lang-const c-negation-op-re)) + (c-lang-defconst c-arithmetic-operators "List of all arithmetic operators, including \"+=\", etc." ;; Note: in the following, there are too many operators for AWK and IDL. @@ -3163,6 +3169,30 @@ Keywords here should also be in `c-block-stmt-1-kwds'." (c-lang-const c-block-stmt-2-kwds))))) (c-lang-defvar c-opt-block-stmt-key (c-lang-const c-opt-block-stmt-key)) +(c-lang-defconst c-paren-clause-kwds + "Keywords which can stand in the place of paren sexps in conditionals. +This applies only to conditionals in `c-block-stmt-with-kwds'." + t nil + c++ '("consteval")) + +(c-lang-defconst c-paren-clause-key + ;; Regexp matching a keyword in `c-paren-clause-kwds'. + t (c-make-keywords-re t + (c-lang-const c-paren-clause-kwds))) +(c-lang-defvar c-paren-clause-key (c-lang-const c-paren-clause-key)) + +(c-lang-defconst c-block-stmt-with-kwds + "Statement keywords which can be followed by a keyword instead of a parens. +Such a keyword is a member of `c-paren-clause-kwds." + t nil + c++ '("if")) + +(c-lang-defconst c-block-stmt-with-key + ;; Regexp matching a keyword in `c-block-stmt-with-kwds'. + t (c-make-keywords-re t + (c-lang-const c-block-stmt-with-kwds))) +(c-lang-defvar c-block-stmt-with-key (c-lang-const c-block-stmt-with-key)) + (c-lang-defconst c-simple-stmt-kwds "Statement keywords followed by an expression or nothing." t '("break" "continue" "goto" "return") -- cgit v1.2.3 From e5d824b632a68430535f6e94d911871eb0f3f772 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 26 Mar 2024 17:27:29 -0400 Subject: cl-preloaded.el: Partly revert last change The change caused type-check errors in auth-source where they use `:type function` constraints on object slots and expect those to be able to hold symbols. * lisp/emacs-lisp/cl-preloaded.el (function): Revert last change. * test/src/data-tests.el (data-tests--cl-type-of): Use `cl-functionp` rather than `functionp` to test `function`. --- lisp/emacs-lisp/cl-preloaded.el | 6 +++++- test/src/data-tests.el | 4 +++- 2 files changed, 8 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 6128db05c61..260478c3a39 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -436,7 +436,11 @@ For this build of Emacs it's %dbit." (car car) (cdr cdr)) (cl--define-built-in-type function (atom) "Abstract supertype of function values." - :predicate cl-functionp) + ;; FIXME: Historically, (cl-typep FOO 'function) called `functionp', + ;; so while `cl-functionp' would be the more correct predicate, it + ;; would breaks existing code :-( + ;; :predicate cl-functionp + ) (cl--define-built-in-type compiled-function (function) "Abstract type of functions that have been compiled.") (cl--define-built-in-type byte-code-function (compiled-function) diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 753d74c02ec..a1959f62fd3 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -870,7 +870,9 @@ comparing the subr with a much slower Lisp implementation." native-comp-unit interpreted-function tree-sitter-compiled-query tree-sitter-node tree-sitter-parser)))) - (should-not (cl-typep val subtype)))))))) + (cond + ((eq subtype 'function) (cl-functionp val)) + (t (should-not (cl-typep val subtype)))))))))) ;;; data-tests.el ends here -- cgit v1.2.3 From 48b6e6bd80f2783c6320db1f7e8fb0b3f44e2e9d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 26 Mar 2024 17:41:42 -0400 Subject: * lisp/help.el (help-function-arglist): Don't `substitute-command-keys` --- lisp/help.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/help.el b/lisp/help.el index bafe6032942..1ef46e394f3 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -2353,7 +2353,7 @@ the same names as used in the original source code, when possible." ((or (and (byte-code-function-p def) (integerp (aref def 0))) (subrp def) (module-function-p def)) (or (when preserve-names - (let* ((doc (condition-case nil (documentation def) (error nil))) + (let* ((doc (condition-case nil (documentation def 'raw) (error nil))) (docargs (if doc (car (help-split-fundoc doc nil)))) (arglist (if docargs (cdar (read-from-string (downcase docargs))))) -- cgit v1.2.3 From 5efa2ddf62d4876fb62f23b571f4cc0af5885639 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Tue, 26 Mar 2024 08:44:25 -0400 Subject: Correctly check buffer mtime when displaying xref matches This was just a typo: we were checking the modification time of current-buffer instead of checking the modification time of the passed-in buffer. This caused matches to not be shown if they weren't present in the current in-Emacs state of the buffer. This was easily reproduced by writing a string to a file outside Emacs, then searching for that string with e.g. project-find-regexp. The string would seemingly not be found, although in reality it was found, just not displayed. * lisp/progmodes/xref.el (xref--find-file-buffer): Check buf, not current-buffer (bug#70008). --- lisp/progmodes/xref.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 717b837a2e5..755c3db04fd 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -2176,7 +2176,7 @@ Such as the current syntax table and the applied syntax properties." (or (buffer-modified-p buf) (unless xref--hits-remote-id - (not (verify-visited-file-modtime (current-buffer)))))) + (not (verify-visited-file-modtime buf))))) ;; We can't use buffers whose contents diverge from disk (bug#54025). (setq buf nil)) (setq xref--last-file-buffer (cons file buf)))) -- cgit v1.2.3 From 1552f8345d8cbea282d171bffe5a22e330eeed37 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 28 Mar 2024 05:41:52 +0200 Subject: (project-current): Add binding for 'non-essential' * lisp/progmodes/project.el (project-current): Add binding for 'non-essential' (bug#69584). --- lisp/progmodes/project.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index ac18aceadcf..a10e24f3e28 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -229,7 +229,8 @@ See the doc string of `project-find-functions' for the general form of the project instance object." (unless directory (setq directory (or project-current-directory-override default-directory))) - (let ((pr (project--find-in-directory directory))) + (let ((pr (project--find-in-directory directory)) + (non-essential (not maybe-prompt))) (cond (pr) ((unless project-current-directory-override -- cgit v1.2.3 From f1fe13ea057237f5426c93876488cb95be86156c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 28 Mar 2024 00:06:00 -0400 Subject: (pcase-mutually-exclusive): Use auto-generated table MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The `pcase-mutually-exclusive-predicates` table was not very efficient since it grew like O(N²) with the number of predicates. Replace it with an O(N) table that's auto-generated from the `built-in-class` objects. * lisp/emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates): Delete variable. (pcase--subtype-bitsets): New function and constant. (pcase--mutually-exclusive-p): Use them. * lisp/emacs-lisp/cl-preloaded.el (built-in-class): Don't inline. --- lisp/emacs-lisp/cl-preloaded.el | 1 + lisp/emacs-lisp/pcase.el | 134 +++++++++++++++++++++--------------- test/lisp/emacs-lisp/pcase-tests.el | 14 ++++ 3 files changed, 93 insertions(+), 56 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 260478c3a39..d23ad3972a9 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -303,6 +303,7 @@ (cl-defstruct (built-in-class (:include cl--class) + (:noinline t) (:constructor nil) (:constructor built-in-class--make (name docstring parents)) (:copier nil)) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 40d917795e3..e2d0c0dc068 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -623,62 +623,83 @@ recording whether the var has been referenced by earlier parts of the match." (defun pcase--and (match matches) (if matches `(and ,match ,@matches) match)) -(defconst pcase-mutually-exclusive-predicates - '((symbolp . integerp) - (symbolp . numberp) - (symbolp . consp) - (symbolp . arrayp) - (symbolp . vectorp) - (symbolp . stringp) - (symbolp . byte-code-function-p) - (symbolp . compiled-function-p) - (symbolp . recordp) - (null . integerp) - (null . numberp) - (null . numberp) - (null . consp) - (null . arrayp) - (null . vectorp) - (null . stringp) - (null . byte-code-function-p) - (null . compiled-function-p) - (null . recordp) - (integerp . consp) - (integerp . arrayp) - (integerp . vectorp) - (integerp . stringp) - (integerp . byte-code-function-p) - (integerp . compiled-function-p) - (integerp . recordp) - (numberp . consp) - (numberp . arrayp) - (numberp . vectorp) - (numberp . stringp) - (numberp . byte-code-function-p) - (numberp . compiled-function-p) - (numberp . recordp) - (consp . arrayp) - (consp . atom) - (consp . vectorp) - (consp . stringp) - (consp . byte-code-function-p) - (consp . compiled-function-p) - (consp . recordp) - (arrayp . byte-code-function-p) - (arrayp . compiled-function-p) - (vectorp . byte-code-function-p) - (vectorp . compiled-function-p) - (vectorp . recordp) - (stringp . vectorp) - (stringp . recordp) - (stringp . byte-code-function-p) - (stringp . compiled-function-p))) - +(defun pcase--subtype-bitsets () + (let ((built-in-types ())) + (mapatoms (lambda (sym) + (let ((class (get sym 'cl--class))) + (when (and (built-in-class-p class) + (get sym 'cl-deftype-satisfies)) + (push (list sym + (get sym 'cl-deftype-satisfies) + (cl--class-allparents class)) + built-in-types))))) + ;; The "true" predicate for `function' type is `cl-functionp'. + (setcar (nthcdr 1 (assq 'function built-in-types)) 'cl-functionp) + ;; Sort the types from deepest in the hierarchy so all children + ;; are processed before their parent. It also gives lowest + ;; numbers to those types that are subtypes of the largest number + ;; of types, which minimize the need to use bignums. + (setq built-in-types (sort built-in-types + (lambda (x y) + (> (length (nth 2 x)) (length (nth 2 y)))))) + + (let ((bitsets (make-hash-table)) + (i 1)) + (dolist (x built-in-types) + ;; Don't dedicate any bit to those predicates which already + ;; have a bitset, since it means they're already represented + ;; by their subtypes. + (unless (and (nth 1 x) (gethash (nth 1 x) bitsets)) + (dolist (parent (nth 2 x)) + (let ((pred (nth 1 (assq parent built-in-types)))) + (unless (or (eq parent t) (null pred)) + (puthash pred (+ i (gethash pred bitsets 0)) + bitsets)))) + (setq i (+ i i)))) + + ;; Extra predicates that don't have matching types. + (dolist (pred-types '((functionp cl-functionp consp symbolp) + (keywordp symbolp) + (characterp fixnump) + (natnump integerp) + (facep symbolp stringp) + (plistp listp) + (cl-struct-p recordp) + ;; ;; FIXME: These aren't quite in the same + ;; ;; category since they'll signal errors. + (fboundp symbolp) + )) + (puthash (car pred-types) + (apply #'logior + (mapcar (lambda (pred) + (gethash pred bitsets)) + (cdr pred-types))) + bitsets)) + bitsets))) + +(defconst pcase--subtype-bitsets + (if (fboundp 'built-in-class-p) + (pcase--subtype-bitsets) + ;; Early bootstrap: we don't have the built-in classes yet, so just + ;; use an empty table for now. + (prog1 (make-hash-table) + ;; The empty table leads to significantly worse code, so upgrade + ;; to the real table as soon as possible (most importantly: before we + ;; start compiling code, and hence baking the result into files). + (with-eval-after-load 'cl-preloaded + (defconst pcase--subtype-bitsets (pcase--subtype-bitsets))))) + "Table mapping predicates to their set of types. +These are the set of built-in types for which they may return non-nil. +The sets are represented as bitsets (integers) where each bit represents +a specific leaf type. Which bit represents which type is unspecified.") + +;; Extra predicates (defun pcase--mutually-exclusive-p (pred1 pred2) - (or (member (cons pred1 pred2) - pcase-mutually-exclusive-predicates) - (member (cons pred2 pred1) - pcase-mutually-exclusive-predicates))) + (let ((subtypes1 (gethash pred1 pcase--subtype-bitsets))) + (when subtypes1 + (let ((subtypes2 (gethash pred2 pcase--subtype-bitsets))) + (when subtypes2 + (zerop (logand subtypes1 subtypes2))))))) (defun pcase--split-match (sym splitter match) (cond @@ -814,7 +835,8 @@ A and B can be one of: ((vectorp (cadr pat)) #'vectorp) ((compiled-function-p (cadr pat)) #'compiled-function-p)))) - (pcase--mutually-exclusive-p (cadr upat) otherpred)) + (and otherpred + (pcase--mutually-exclusive-p (cadr upat) otherpred))) '(:pcase--fail . nil)) ;; Since we turn (or 'a 'b 'c) into (pred (memq _ '(a b c))) ;; try and preserve the info we get from that memq test. diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el index d062965952a..c79adcdfec5 100644 --- a/test/lisp/emacs-lisp/pcase-tests.el +++ b/test/lisp/emacs-lisp/pcase-tests.el @@ -160,4 +160,18 @@ (should-error (pcase-setq a) :type '(wrong-number-of-arguments))) +(ert-deftest pcase-tests-mutually-exclusive () + (dolist (x '((functionp consp nil) + (functionp stringp t) + (compiled-function-p consp t) + (keywordp symbolp nil) + (keywordp symbol-with-pos-p nil) + (keywordp stringp t))) + (if (nth 2 x) + (should (pcase--mutually-exclusive-p (nth 0 x) (nth 1 x))) + (should-not (pcase--mutually-exclusive-p (nth 0 x) (nth 1 x)))) + (if (nth 2 x) + (should (pcase--mutually-exclusive-p (nth 1 x) (nth 0 x))) + (should-not (pcase--mutually-exclusive-p (nth 1 x) (nth 0 x)))))) + ;;; pcase-tests.el ends here. -- cgit v1.2.3 From 35ae2c576b8570da7b2e791991ad852c648be896 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 28 Mar 2024 11:34:25 +0200 Subject: ; * lisp/emacs-lisp/pcase.el (pcase--subtype-bitsets): Doc fix. --- lisp/emacs-lisp/pcase.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index e2d0c0dc068..23f1bac600c 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -688,8 +688,9 @@ recording whether the var has been referenced by earlier parts of the match." ;; start compiling code, and hence baking the result into files). (with-eval-after-load 'cl-preloaded (defconst pcase--subtype-bitsets (pcase--subtype-bitsets))))) - "Table mapping predicates to their set of types. -These are the set of built-in types for which they may return non-nil. + "Hash table mapping type predicates to their sets of types. +The table maps each type predicate, such as `numberp' and `stringp', +to the set of built-in types for which the predicate may return non-nil. The sets are represented as bitsets (integers) where each bit represents a specific leaf type. Which bit represents which type is unspecified.") -- cgit v1.2.3 From cdd7093e17a33a6efc4721af461af180e5af602d Mon Sep 17 00:00:00 2001 From: Vladimir Kazanov Date: Tue, 12 Mar 2024 11:14:54 +0000 Subject: Improve ert-font-lock assertion parser (Bug#69714) Fail on files with no assertions, parser now accepts multiple carets per line and face lists: * lisp/emacs-lisp/ert-font-lock.el: Assertion parser fix. * test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js: * test/lisp/emacs-lisp/ert-font-lock-tests.el (test-parse-comments--no-assertion-error) (test-syntax-highlight-inline--caret-negated-wrong-face) (test-macro-test--file-no-asserts): New test cases. * doc/misc/ert.texi (Syntax Highlighting Tests): More syntax examples. --- doc/misc/ert.texi | 45 +++++- lisp/emacs-lisp/ert-font-lock.el | 73 ++++++++-- .../ert-font-lock-resources/no-asserts.js | 2 + test/lisp/emacs-lisp/ert-font-lock-tests.el | 153 +++++++++++++++++---- 4 files changed, 228 insertions(+), 45 deletions(-) create mode 100644 test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js (limited to 'lisp') diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi index bd2ad495142..8767de71496 100644 --- a/doc/misc/ert.texi +++ b/doc/misc/ert.texi @@ -951,11 +951,13 @@ that assigns face properties to parts of the buffer. The @code{ert-font-lock} package makes it possible to introduce unit tests checking face assignment. Test assertions are included in code-level comments directly and can be read either from inline strings or files. +The parser expects the input string to contain at least one assertion. Test assertion parser extracts tests from comment-only lines. Every -comment assertion line starts either with a caret (@samp{^}) or an -arrow (@samp{<-}). A caret/arrow should be followed immediately by the -name of a face to be checked. +comment assertion line starts either with a caret (@samp{^}) or an arrow +(@samp{<-}). A single caret/arrow or carets should be followed +immediately by the name of a face or a list of faces to be checked +against the @code{:face} property at point. The test then checks if the first non-assertion column above the caret contains a face expected by the assertion: @@ -967,10 +969,43 @@ var variable = 11; // ^ font-lock-punctuation-face // this is not an assertion, it's just a comment // ^ font-lock-comment-face + +// multiple carets per line +// ^^^^ ^ ^ font-lock-comment-face +@end example + +Both symbol-only @code{:face} property values and assertion face values +are normalized to single element lists so assertions below are +equivalent: + +@example +// single +// ^ font-lock-comment-face +// single +// ^ (font-lock-comment-face) +@end example + +Assertions can be negated: + +@example +var variable = 11; +// ^ !font-lock-comment-face +@end example + +It is possible to specify face lists in assertions: + +@example +// TODO +// ^^^^ (font-lock-comment-face hl-todo) + var test = 1; +// ^ () +// ^ nil +// negation works as expected +// ^ !nil @end example -The arrow means that the first non-empty column of the assertion line -will be used for the check: +The arrow (@samp{<-}) means that the first non-empty column of the +assertion line will be used for the check: @example var variable = 1; diff --git a/lisp/emacs-lisp/ert-font-lock.el b/lisp/emacs-lisp/ert-font-lock.el index 29114712f92..e77c8945dc3 100644 --- a/lisp/emacs-lisp/ert-font-lock.el +++ b/lisp/emacs-lisp/ert-font-lock.el @@ -39,16 +39,33 @@ (require 'newcomment) (require 'pcase) -(defconst ert-font-lock--assertion-re +(defconst ert-font-lock--face-symbol-re + (rx (one-or-more (or alphanumeric "-" "_" "."))) + "A face symbol matching regex.") + +(defconst ert-font-lock--face-symbol-list-re + (rx "(" + (* whitespace) + (one-or-more + (seq (regexp ert-font-lock--face-symbol-re) + (* whitespace))) + ")") + "A face symbol list matching regex.") + +(defconst ert-font-lock--assertion-line-re (rx - ;; column specifiers + ;; leading column assertion (arrow/caret) (group (or "^" "<-")) - (one-or-more " ") + (zero-or-more whitespace) + ;; possible to have many carets on an assertion line + (group (zero-or-more (seq "^" (zero-or-more whitespace)))) ;; optional negation of the face specification (group (optional "!")) - ;; face symbol name - (group (one-or-more (or alphanumeric "-" "_" ".")))) - "An ert-font-lock assertion regex.") + (zero-or-more whitespace) + ;; face symbol name or a list of symbols + (group (or (regexp ert-font-lock--face-symbol-re) + (regexp ert-font-lock--face-symbol-list-re)))) + "An ert-font-lock assertion line regex.") (defun ert-font-lock--validate-major-mode (mode) "Validate if MODE is a valid major mode." @@ -212,7 +229,7 @@ be used through `ert'. (save-excursion (beginning-of-line) (skip-syntax-forward " ") - (re-search-forward ert-font-lock--assertion-re + (re-search-forward ert-font-lock--assertion-line-re (line-end-position) t 1))) (defun ert-font-lock--goto-first-char () @@ -252,8 +269,8 @@ be used through `ert'. (throw 'nextline t)) - ;; Collect the assertion - (when (re-search-forward ert-font-lock--assertion-re + ;; Collect the first line assertion (caret or arrow) + (when (re-search-forward ert-font-lock--assertion-line-re (line-end-position) t 1) (unless (> linetocheck -1) @@ -266,21 +283,38 @@ be used through `ert'. (- (match-beginning 1) (line-beginning-position)) (ert-font-lock--get-first-char-column))) ;; negate the face? - (negation (string-equal (match-string-no-properties 2) "!")) + (negation (string-equal (match-string-no-properties 3) "!")) ;; the face that is supposed to be in the position specified - (face (match-string-no-properties 3))) + (face (read (match-string-no-properties 4)))) + ;; Collect the first assertion on the line (push (list :line-checked linetocheck :line-assert curline :column-checked column-checked :face face :negation negation) - tests)))) + tests) + + ;; Collect all the other line carets (if present) + (goto-char (match-beginning 2)) + (while (equal (following-char) ?^) + (setq column-checked (- (point) (line-beginning-position))) + (push (list :line-checked linetocheck + :line-assert curline + :column-checked column-checked + :face face + :negation negation) + tests) + (forward-char) + (skip-syntax-forward " "))))) ;; next line (setq curline (1+ curline)) (forward-line 1)) + (unless tests + (user-error "No test assertions found")) + (reverse tests))) (defun ert-font-lock--point-at-line-and-column (line column) @@ -307,21 +341,30 @@ The function is meant to be run from within an ERT test." (let* ((line-checked (plist-get test :line-checked)) (line-assert (plist-get test :line-assert)) (column-checked (plist-get test :column-checked)) - (expected-face (intern (plist-get test :face))) + (expected-face (plist-get test :face)) (negation (plist-get test :negation)) (actual-face (get-text-property (ert-font-lock--point-at-line-and-column line-checked column-checked) 'face)) (line-str (ert-font-lock--get-line line-checked)) (line-assert-str (ert-font-lock--get-line line-assert))) - (when (not (eq actual-face expected-face)) + ;; normalize both expected and resulting face - these can be + ;; either symbols, nils or lists of symbols + (when (not (listp actual-face)) + (setq actual-face (list actual-face))) + (when (not (listp expected-face)) + (setq expected-face (list expected-face))) + + ;; fail when lists are not 'equal and the assertion is *not negated* + (when (and (not negation) (not (equal actual-face expected-face))) (ert-fail (list (format "Expected face %S, got %S on line %d column %d" expected-face actual-face line-checked column-checked) :line line-str :assert line-assert-str))) - (when (and negation (eq actual-face expected-face)) + ;; fail when lists are 'equal and the assertion is *negated* + (when (and negation (equal actual-face expected-face)) (ert-fail (list (format "Did not expect face %S face on line %d, column %d" actual-face line-checked column-checked) diff --git a/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js b/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js new file mode 100644 index 00000000000..5eae9af212f --- /dev/null +++ b/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js @@ -0,0 +1,2 @@ +var abc = function(d) { +}; diff --git a/test/lisp/emacs-lisp/ert-font-lock-tests.el b/test/lisp/emacs-lisp/ert-font-lock-tests.el index e0ba1e949b2..fa2e5dc4db7 100644 --- a/test/lisp/emacs-lisp/ert-font-lock-tests.el +++ b/test/lisp/emacs-lisp/ert-font-lock-tests.el @@ -138,13 +138,24 @@ print(\"Hello, world!\")" (forward-line) (should (ert-font-lock--line-comment-p)))) +(ert-deftest test-parse-comments--no-assertion-error () + (let* ((str " +not_an_assertion +random_symbol +")) + (with-temp-buffer + (insert str) + (javascript-mode) + + (should-error (ert-font-lock--parse-comments) :type 'user-error)))) + (ert-deftest test-parse-comments--single-line-error () (let* ((str "// ^ face.face1")) (with-temp-buffer (insert str) (javascript-mode) - (should-error (ert-font-lock--parse-comments))))) + (should-error (ert-font-lock--parse-comments) :type 'user-error)))) (ert-deftest test-parse-comments--single-line-single-caret () (let* ((str " @@ -159,7 +170,46 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 1)) (should (equal (car asserts) - '(:line-checked 2 :line-assert 3 :column-checked 3 :face "face.face1" :negation nil)))))) + '(:line-checked 2 :line-assert 3 :column-checked 3 :face face.face1 :negation nil)))))) + +(ert-deftest test-parse-comments--single-line-many-carets () + (let* ((str " +multiplecarets +//^^^ ^^ ^ face.face1 +") + asserts) + (with-temp-buffer + (insert str) + (javascript-mode) + + (setq asserts (ert-font-lock--parse-comments)) + (should (eql (length asserts) 6)) + (should (equal asserts + '((:line-checked 2 :line-assert 3 :column-checked 2 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 3 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 4 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 6 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 7 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 9 :face face.face1 :negation nil))))))) + +(ert-deftest test-parse-comments--face-list () + (let* ((str " +facelist +// ^ (face1 face2) +// ^ !(face3 face4) +// ^ (face5) +") + asserts) + (with-temp-buffer + (insert str) + (javascript-mode) + + (setq asserts (ert-font-lock--parse-comments)) + (should (eql (length asserts) 3)) + (should (equal asserts + '((:line-checked 2 :line-assert 3 :column-checked 3 :face (face1 face2) :negation nil) + (:line-checked 2 :line-assert 4 :column-checked 3 :face (face3 face4) :negation t) + (:line-checked 2 :line-assert 5 :column-checked 3 :face (face5) :negation nil))))))) (ert-deftest test-parse-comments--caret-negation () (let* ((str " @@ -175,11 +225,11 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 2)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face" :negation t) - (:line-checked 2 :line-assert 4 :column-checked 3 :face "face" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 3 :face face :negation t) + (:line-checked 2 :line-assert 4 :column-checked 3 :face face :negation nil))))))) -(ert-deftest test-parse-comments--single-line-multiple-carets () +(ert-deftest test-parse-comments--single-line-multiple-assert-lines () (let* ((str " first // ^ face1 @@ -196,12 +246,12 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 4)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face1" :negation nil) - (:line-checked 2 :line-assert 4 :column-checked 7 :face "face.face2" :negation nil) - (:line-checked 2 :line-assert 5 :column-checked 7 :face "face-face.face3" :negation nil) - (:line-checked 2 :line-assert 6 :column-checked 7 :face "face_face.face4" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 3 :face face1 :negation nil) + (:line-checked 2 :line-assert 4 :column-checked 7 :face face.face2 :negation nil) + (:line-checked 2 :line-assert 5 :column-checked 7 :face face-face.face3 :negation nil) + (:line-checked 2 :line-assert 6 :column-checked 7 :face face_face.face4 :negation nil))))))) -(ert-deftest test-parse-comments--multiple-line-multiple-carets () +(ert-deftest test-parse-comments--multiple-line-multiple-assert-lines () (let* ((str " first // ^ face1 @@ -218,9 +268,9 @@ third (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 3)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face1" :negation nil) - (:line-checked 4 :line-assert 5 :column-checked 3 :face "face2" :negation nil) - (:line-checked 4 :line-assert 6 :column-checked 5 :face "face3" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 3 :face face1 :negation nil) + (:line-checked 4 :line-assert 5 :column-checked 3 :face face2 :negation nil) + (:line-checked 4 :line-assert 6 :column-checked 5 :face face3 :negation nil))))))) (ert-deftest test-parse-comments--arrow-single-line-single () @@ -236,7 +286,7 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 1)) (should (equal (car asserts) - '(:line-checked 2 :line-assert 3 :column-checked 0 :face "face1" :negation nil)))))) + '(:line-checked 2 :line-assert 3 :column-checked 0 :face face1 :negation nil)))))) (ert-deftest test-parse-comments-arrow-multiple-line-single () @@ -254,9 +304,9 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 3)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 0 :face "face1" :negation nil) - (:line-checked 2 :line-assert 4 :column-checked 2 :face "face2" :negation nil) - (:line-checked 2 :line-assert 5 :column-checked 4 :face "face3" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 0 :face face1 :negation nil) + (:line-checked 2 :line-assert 4 :column-checked 2 :face face2 :negation nil) + (:line-checked 2 :line-assert 5 :column-checked 4 :face face3 :negation nil))))))) (ert-deftest test-parse-comments--non-assert-comment-single () (let* ((str " @@ -271,7 +321,7 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 1)) (should (equal (car asserts) - '(:line-checked 2 :line-assert 3 :column-checked 4 :face "comment-face" :negation nil)))))) + '(:line-checked 2 :line-assert 3 :column-checked 4 :face comment-face :negation nil)))))) (ert-deftest test-parse-comments--non-assert-comment-multiple () (let* ((str " @@ -288,9 +338,9 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 3)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 4 :face "comment-face" :negation nil) - (:line-checked 2 :line-assert 4 :column-checked 10 :face "comment-face" :negation nil) - (:line-checked 2 :line-assert 5 :column-checked 18 :face "comment-face" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 4 :face comment-face :negation nil) + (:line-checked 2 :line-assert 4 :column-checked 10 :face comment-face :negation nil) + (:line-checked 2 :line-assert 5 :column-checked 18 :face comment-face :negation nil))))))) (ert-deftest test-parse-comments--multiline-comment-single () @@ -308,7 +358,7 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 1)) (should (equal (car asserts) - '(:line-checked 3 :line-assert 4 :column-checked 3 :face "comment-face" :negation nil)))))) + '(:line-checked 3 :line-assert 4 :column-checked 3 :face comment-face :negation nil)))))) (ert-deftest test-parse-comments--multiline-comment-multiple () (let* ((str " @@ -327,13 +377,47 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 2)) (should (equal asserts - '((:line-checked 3 :line-assert 4 :column-checked 3 :face "comment-face" :negation nil) - (:line-checked 5 :line-assert 6 :column-checked 4 :face "comment-face" :negation nil))))))) + '((:line-checked 3 :line-assert 4 :column-checked 3 :face comment-face :negation nil) + (:line-checked 5 :line-assert 6 :column-checked 4 :face comment-face :negation nil))))))) ;;; Syntax highlighting assertion tests ;; -(ert-deftest test-syntax-highlight-inline--caret-multiple-faces () +(ert-deftest test-syntax-highlight-inline--nil-list () + (let ((str " +var abc = function(d) { +// ^ nil +// ^ !nil +}; + +")) + (with-temp-buffer + (insert str) + (javascript-mode) + (font-lock-ensure) + + (ert-font-lock--check-faces + (ert-font-lock--parse-comments))))) + +(ert-deftest test-syntax-highlight-inline--face-list () + (let ((str " +var abc = function(d) { +// ^ (test-face-2 test-face-1 font-lock-variable-name-face) +}; + +")) + (with-temp-buffer + (insert str) + (javascript-mode) + (font-lock-ensure) + + (add-face-text-property (point-min) (point-max) 'test-face-1) + (add-face-text-property (point-min) (point-max) 'test-face-2) + + (ert-font-lock--check-faces + (ert-font-lock--parse-comments))))) + +(ert-deftest test-syntax-highlight-inline--caret-multiple-assertions () (let ((str " var abc = function(d) { // ^ font-lock-variable-name-face @@ -364,6 +448,19 @@ var abc = function(d) { (should-error (ert-font-lock--check-faces (ert-font-lock--parse-comments)))))) +(ert-deftest test-syntax-highlight-inline--caret-negated-wrong-face () + (let* ((str " +var abc = function(d) { +// ^ !not-a-face +}; +")) + (with-temp-buffer + (insert str) + (javascript-mode) + (font-lock-ensure) + + (ert-font-lock--check-faces + (ert-font-lock--parse-comments))))) (ert-deftest test-syntax-highlight-inline--comment-face () (let* ((str " @@ -455,6 +552,12 @@ var abc = function(d) { javascript-mode "correct.js") +(ert-font-lock-deftest-file test-macro-test--file-no-asserts + "Check failing on files without assertions" + :expected-result :failed + javascript-mode + "no-asserts.js") + (ert-font-lock-deftest-file test-macro-test--file-failing "Test reading wrong assertions from a file" :expected-result :failed -- cgit v1.2.3 From b2793febcaa31bf21caff2d6461fd328f0892ad2 Mon Sep 17 00:00:00 2001 From: Rahguzar Date: Fri, 15 Mar 2024 18:46:46 +0100 Subject: Allow for auto updating only visible proced buffers (bug#69784) * lisp/proced.el (proced-auto-update-flag): Document 'visible' value and add it to the custom type. (proced-auto-update-timer, proced-toggle-auto-update): Take 'visible' value into account. --- lisp/proced.el | 46 +++++++++++++++++++++++++++++++--------------- 1 file changed, 31 insertions(+), 15 deletions(-) (limited to 'lisp') diff --git a/lisp/proced.el b/lisp/proced.el index 7d7de1e2ce3..1d257b6bd4d 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -362,9 +362,13 @@ of `proced-grammar-alist'." :type 'integer) (defcustom proced-auto-update-flag nil - "Non-nil for auto update of a Proced buffer. -Can be changed interactively via `proced-toggle-auto-update'." - :type 'boolean) + "Non-nil means auto update proced buffers. +Special value `visible' means only update proced buffers that are currently +displayed in a window. Can be changed interactively via +`proced-toggle-auto-update'." + :type '(radio (const :tag "Don't auto update" nil) + (const :tag "Only update visible proced buffers" visible) + (const :tag "Update all proced buffers" t))) (make-variable-buffer-local 'proced-auto-update-flag) (defcustom proced-tree-flag nil @@ -951,28 +955,40 @@ Proced buffers." "Auto-update Proced buffers using `run-at-time'. If there are no proced buffers, cancel the timer." - (unless (seq-filter (lambda (buf) - (with-current-buffer buf - (when (eq major-mode 'proced-mode) - (if proced-auto-update-flag - (proced-update t t)) - t))) - (buffer-list)) + (if-let (buffers (match-buffers '(derived-mode . proced-mode))) + (dolist (buf buffers) + (when-let ((flag (buffer-local-value 'proced-auto-update-flag buf)) + ((or (not (eq flag 'visible)) + (get-buffer-window buf 'visible)))) + (with-current-buffer buf + (proced-update t t)))) (cancel-timer proced-auto-update-timer) (setq proced-auto-update-timer nil))) (defun proced-toggle-auto-update (arg) "Change whether this Proced buffer is updated automatically. With prefix ARG, update this buffer automatically if ARG is positive, -otherwise do not update. Sets the variable `proced-auto-update-flag'. -The time interval for updates is specified via `proced-auto-update-interval'." +update the buffer only when the buffer is displayed in a window if ARG is 0, +otherwise do not update. Sets the variable `proced-auto-update-flag' by +cycling between nil, `visible' and t. The time interval for updates is +specified via `proced-auto-update-interval'." (interactive (list (or current-prefix-arg 'toggle)) proced-mode) (setq proced-auto-update-flag - (cond ((eq arg 'toggle) (not proced-auto-update-flag)) - (arg (> (prefix-numeric-value arg) 0)) + (cond ((eq arg 'toggle) + (cond ((not proced-auto-update-flag) 'visible) + ((eq proced-auto-update-flag 'visible) t) + (t nil))) + (arg + (setq arg (prefix-numeric-value arg)) + (message "%s" arg) + (cond ((> arg 0) t) + ((eq arg 0) 'visible) + (t nil))) (t (not proced-auto-update-flag)))) (message "Proced auto update %s" - (if proced-auto-update-flag "enabled" "disabled"))) + (cond ((eq proced-auto-update-flag 'visible) "enabled (only when buffer is visible)") + (proced-auto-update-flag "enabled (unconditionally)") + (t "disabled")))) ;;; Mark -- cgit v1.2.3 From a4da3971f2580c90fb3c6957eea2d0dbfb695879 Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Sat, 23 Mar 2024 13:29:17 -0700 Subject: copy-tree just image map, not entire image * lisp/image.el (image--compute-original-map): Copy only the image map. (Bug#69602) --- lisp/image.el | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/lisp/image.el b/lisp/image.el index 55340ea03dc..d7496485aca 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -1455,24 +1455,23 @@ When :rotation is not a multiple of 90, return copy of :original-map." If IMAGE lacks :map property, return nil. When :rotation is not a multiple of 90, return copy of :map." (when (image-property image :map) - (let* ((image-copy (copy-tree image t)) - (map (image-property image-copy :map)) - (scale (or (image-property image-copy :scale) 1)) - (rotation (or (image-property image-copy :rotation) 0)) - (flip (image-property image-copy :flip)) - (size (image-size image-copy t))) + (let* ((original-map (copy-tree (image-property image :map) t)) + (scale (or (image-property image :scale) 1)) + (rotation (or (image-property image :rotation) 0)) + (flip (image-property image :flip)) + (size (image-size image t))) (when (and ; Handle only 90-degree rotations (zerop (mod rotation 1)) (zerop (% (truncate rotation) 90))) ;; In rendered images, rotation is always applied before flip. - ;; To undo the transformation, flip before rotating. - ;; SIZE fits MAP before it is transformed back to ORIGINAL-MAP. - ;; Therefore, scale MAP after flip and rotate operations, since - ;; both need MAP to fit SIZE. - (image--flip-map map flip size) - (image--rotate-map map (- rotation) size) - (image--scale-map map (/ 1.0 scale))) - map))) + ;; To undo the transformation, flip before rotating. SIZE fits + ;; ORIGINAL-MAP before transformations are applied. Therefore, + ;; scale ORIGINAL-MAP after flip and rotate operations, since + ;; both need ORIGINAL-MAP to fit SIZE. + (image--flip-map original-map flip size) + (image--rotate-map original-map (- rotation) size) + (image--scale-map original-map (/ 1.0 scale))) + original-map))) (defun image--scale-map (map scale) "Scale MAP according to SCALE. -- cgit v1.2.3 From 6c1a11078b194ed536db17381aad9e159e486fee Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 28 Mar 2024 12:15:13 +0200 Subject: Fix a typo in flymake.el * lisp/progmodes/flymake.el (flymake--update-eol-overlays): Use 'save-restriction', not 'save-excursion'. (Bug#69984) --- lisp/progmodes/flymake.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index db00cc59c0e..779c612f479 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -744,7 +744,7 @@ associated `flymake-category' return DEFAULT." (defun flymake--update-eol-overlays () "Update the `before-string' property of end-of-line overlays." - (save-excursion + (save-restriction (widen) (dolist (o (overlays-in (point-min) (point-max))) (when (overlay-get o 'flymake--eol-overlay) -- cgit v1.2.3 From de9e913f9e2a1e01e5d091a553e98d75404a2246 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 28 Mar 2024 12:27:54 -0400 Subject: * lisp/emacs-lisp/cl-macs.el (list): Predefine predicate by hand --- lisp/emacs-lisp/cl-macs.el | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 051cd992fc1..a84ef4a34b2 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3470,6 +3470,10 @@ Of course, we really can't know that for sure, so it's just a heuristic." (keyword . keywordp) ;Would need `keyword-with-pos`. (natnum . natnump) ;Subtype of fixnum & bignum. (real . numberp) ;Not clear where it would fit. + ;; This one is redundant, but we keep it to silence a + ;; warning during the early bootstrap when `cl-seq.el' gets + ;; loaded before `cl-preloaded.el' is defined. + (list . listp) )) (put type 'cl-deftype-satisfies pred)) -- cgit v1.2.3 From bcf6dd6e266222a293e359430afdf3a2dc18369c Mon Sep 17 00:00:00 2001 From: Noah Peart Date: Tue, 26 Mar 2024 22:44:48 -0700 Subject: Add typescript-ts-mode indentation for interface bodies (bug#70023) * lisp/progmodes/typescript-ts-mode.el (typescript-ts-mode--indent-rules): Add indentation rule for interface bodies. --- lisp/progmodes/typescript-ts-mode.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 7021f012dcd..9c4c388c6b1 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -124,6 +124,7 @@ Argument LANGUAGE is either `typescript' or `tsx'." ((parent-is "object_type") parent-bol typescript-ts-mode-indent-offset) ((parent-is "enum_body") parent-bol typescript-ts-mode-indent-offset) ((parent-is "class_body") parent-bol typescript-ts-mode-indent-offset) + ((parent-is "interface_body") parent-bol typescript-ts-mode-indent-offset) ((parent-is "arrow_function") parent-bol typescript-ts-mode-indent-offset) ((parent-is "parenthesized_expression") parent-bol typescript-ts-mode-indent-offset) ((parent-is "binary_expression") parent-bol typescript-ts-mode-indent-offset) -- cgit v1.2.3 From 4cee95815b9d7d56f6f77abb1cc17e346c038685 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 28 Mar 2024 15:31:04 -0400 Subject: pp.el: Try and fix bug#70039 * lisp/emacs-lisp/pp.el (pp-fill): Avoid splitting `#N#` or `#[`. * test/lisp/emacs-lisp/pp-tests.el (pp-tests--sanity): New test. --- lisp/emacs-lisp/pp.el | 27 +++++++++++++++++---------- test/lisp/emacs-lisp/pp-tests.el | 19 +++++++++++++++++++ 2 files changed, 36 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 26c77d6b047..d586fc59939 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -166,12 +166,19 @@ it inserts and pretty-prints that arg at point." (interactive "r") (if (null end) (pp--object beg #'pp-fill) (goto-char beg) - (let ((end (copy-marker end t)) - (newline (lambda () - (skip-chars-forward ")]}") - (unless (save-excursion (skip-chars-forward " \t") (eolp)) - (insert "\n") - (indent-according-to-mode))))) + (let* ((end (copy-marker end t)) + (avoid-unbreakable + (lambda () + (and (memq (char-before) '(?# ?s ?f)) + (memq (char-after) '(?\[ ?\()) + (looking-back "#[sf]?" (- (point) 2)) + (goto-char (match-beginning 0))))) + (newline (lambda () + (skip-chars-forward ")]}") + (unless (save-excursion (skip-chars-forward " \t") (eolp)) + (funcall avoid-unbreakable) + (insert "\n") + (indent-according-to-mode))))) (while (progn (forward-comment (point-max)) (< (point) end)) (let ((beg (point)) @@ -198,10 +205,10 @@ it inserts and pretty-prints that arg at point." ;; reduce the indentation depth. ;; Similarly, we prefer to cut before a "." than after ;; it because it reduces the indentation depth. - (while (not (zerop (skip-chars-backward " \t({[',."))) - (and (memq (char-before) '(?# ?s ?f)) - (looking-back "#[sf]?" (- (point) 2)) - (goto-char (match-beginning 0)))) + (while + (progn + (funcall avoid-unbreakable) + (not (zerop (skip-chars-backward " \t({[',."))))) (if (bolp) ;; The sexp already starts on its own line. (progn (goto-char beg) nil) diff --git a/test/lisp/emacs-lisp/pp-tests.el b/test/lisp/emacs-lisp/pp-tests.el index 7f7c798cde8..7606183d645 100644 --- a/test/lisp/emacs-lisp/pp-tests.el +++ b/test/lisp/emacs-lisp/pp-tests.el @@ -66,4 +66,23 @@ (while (search-forward "." nil t) (should (not (eolp)))))) +(ert-deftest pp-tests--sanity () + (with-temp-buffer + (lisp-data-mode) + (let ((testdata "(a b c #1=#[0 \"\" [] 0] #s(foo #1# bar))")) + (let ((res (car (read-from-string testdata)))) + (dotimes (i (length testdata)) + (erase-buffer) + (insert testdata) + (let ((fill-column i)) + (pp-fill (point-min) (point-max)) + (goto-char (point-min)) + (condition-case err + (should (equal (read (current-buffer)) res)) + (invalid-read-syntax + (message "Invalid fill result with i=%d:\n%s" + i (buffer-string)) + (signal (car err) (cdr err)) + )))))))) + ;;; pp-tests.el ends here. -- cgit v1.2.3 From 1232ab31c656b8564984a758957466f90ac10501 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 10 Mar 2024 13:18:22 +0100 Subject: Add `value<` (bug#69709) It's a general-purpose polymorphic ordering function, like `<` but for any two values of the same type. * src/data.c (syms_of_data): Add the `type-mismatch` error. (bits_word_to_host_endian): Move... * src/lisp.h (bits_word_to_host_endian): ...here, and declare inline. * src/fns.c (Fstring_lessp): Extract the bulk of this function to... (string_cmp): ...this 3-way comparison function, for use elsewhere. (bool_vector_cmp, value_cmp, Fvaluelt): New. * lisp/emacs-lisp/byte-opt.el (side-effect-free-fns, pure-fns): Add `value<`, which is pure and side-effect-free. * test/src/fns-tests.el (fns-value<-ordered, fns-value<-unordered) (fns-value<-type-mismatch, fns-value<-symbol-with-pos) (fns-value<-circle, ert-deftest fns-value<-bool-vector): New tests. * doc/lispref/sequences.texi (Sequence Functions): * doc/lispref/numbers.texi (Comparison of Numbers): * doc/lispref/strings.texi (Text Comparison): Document the new value< function. * etc/NEWS: Announce. --- doc/lispref/numbers.texi | 1 + doc/lispref/sequences.texi | 35 ++++++ doc/lispref/strings.texi | 1 + etc/NEWS | 10 ++ lisp/emacs-lisp/byte-opt.el | 4 +- src/data.c | 26 +--- src/fns.c | 280 ++++++++++++++++++++++++++++++++++++++++---- src/lisp.h | 24 ++++ test/src/fns-tests.el | 218 ++++++++++++++++++++++++++++++++++ 9 files changed, 552 insertions(+), 47 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 99b456043b9..2c093ccd6bd 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -476,6 +476,7 @@ This function tests whether its arguments are numerically equal, and returns @code{t} if they are not, and @code{nil} if they are. @end defun +@anchor{definition of <} @defun < number-or-marker &rest number-or-markers This function tests whether each argument is strictly less than the following argument. It returns @code{t} if so, @code{nil} otherwise. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 74719d4779f..5bdf71fe02e 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -436,6 +436,41 @@ but their relative order is also preserved: @end example @end defun +@cindex comparing values +@cindex standard sorting order +@defun value< a b +This function returns non-@code{nil} if @var{a} comes before @var{b} in +the standard sorting order; this means that it returns @code{nil} when +@var{b} comes before @var{a}, or if they are equal or unordered. + +@var{a} and @var{b} must have the same type. Specifically: + +@itemize @bullet +@item +Numbers are compared using @code{<} (@pxref{definition of <}). +@item +Strings and symbols are compared using @code{string<} +(@pxref{definition of string<}). +@item +Conses, lists, vectors and records are compared lexicographically. +@item +Markers are compared first by buffer, then by position. +@item +Buffers and processes are compared by name. +@item +Other types are considered unordered and the return value will be @code{nil}. +@end itemize + +Examples: +@example +(value< -4 3.5) @result{} t +(value< "dog" "cat") @result{} nil +(value< 'yip 'yip) @result{} nil +(value< '(3 2) '(3 2 0)) @result{} t +(value< [3 2 1] [3 2 0]) @result{} nil +@end example +@end defun + Sometimes, computation of sort keys of list or vector elements is expensive, and therefore it is important to perform it the minimum number of times. By contrast, computing the sort keys of elements diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index a2285098aad..6a9dd589237 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -612,6 +612,7 @@ that collation implements. @end defun @cindex lexical comparison of strings +@anchor{definition of string<} @defun string< string1 string2 @c (findex string< causes problems for permuted index!!) This function compares two strings a character at a time. It diff --git a/etc/NEWS b/etc/NEWS index 696d744e342..73ffff9f2d3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1760,6 +1760,16 @@ precedence over the variable when present. Mostly used internally to do a kind of topological sort of inheritance hierarchies. ++++ +** New polymorphic comparison function 'value<'. +This function returns non-nil if the first argument is less than the +second. It works for any two values of the same type with reasonable +ordering for numbers, strings, symbols, bool-vectors, markers, buffers +and processes. Conses, lists, vectors and records are ordered +lexicographically. +It is intended as a convenient ordering predicate for sorting, and is +likely to be faster than hand-written Lisp functions. + ** New function 'sort-on'. This function implements the Schwartzian transform, and is appropriate for sorting lists when the computation of the sort key of a list diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 54997205edb..ea163723a3e 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1772,7 +1772,7 @@ See Info node `(elisp) Integer Basics'." string-version-lessp substring substring-no-properties sxhash-eq sxhash-eql sxhash-equal sxhash-equal-including-properties - take vconcat + take value< vconcat ;; frame.c frame-ancestor-p frame-bottom-divider-width frame-char-height frame-char-width frame-child-frame-border-width frame-focus @@ -1973,7 +1973,7 @@ See Info node `(elisp) Integer Basics'." hash-table-p identity length length< length= length> member memq memql nth nthcdr proper-list-p rassoc rassq safe-length string-bytes string-distance string-equal string-lessp - string-search string-version-lessp take + string-search string-version-lessp take value< ;; search.c regexp-quote ;; syntax.c diff --git a/src/data.c b/src/data.c index 69b990bed76..a86f86c52f5 100644 --- a/src/data.c +++ b/src/data.c @@ -3835,30 +3835,6 @@ count_trailing_zero_bits (bits_word val) } } -static bits_word -bits_word_to_host_endian (bits_word val) -{ -#ifndef WORDS_BIGENDIAN - return val; -#else - if (BITS_WORD_MAX >> 31 == 1) - return bswap_32 (val); - if (BITS_WORD_MAX >> 31 >> 31 >> 1 == 1) - return bswap_64 (val); - { - int i; - bits_word r = 0; - for (i = 0; i < sizeof val; i++) - { - r = ((r << 1 << (CHAR_BIT - 1)) - | (val & ((1u << 1 << (CHAR_BIT - 1)) - 1))); - val = val >> 1 >> (CHAR_BIT - 1); - } - return r; - } -#endif -} - DEFUN ("bool-vector-exclusive-or", Fbool_vector_exclusive_or, Sbool_vector_exclusive_or, 2, 3, 0, doc: /* Return A ^ B, bitwise exclusive or. @@ -4072,6 +4048,7 @@ syms_of_data (void) DEFSYM (Qminibuffer_quit, "minibuffer-quit"); DEFSYM (Qwrong_length_argument, "wrong-length-argument"); DEFSYM (Qwrong_type_argument, "wrong-type-argument"); + DEFSYM (Qtype_mismatch, "type-mismatch") DEFSYM (Qargs_out_of_range, "args-out-of-range"); DEFSYM (Qvoid_function, "void-function"); DEFSYM (Qcyclic_function_indirection, "cyclic-function-indirection"); @@ -4163,6 +4140,7 @@ syms_of_data (void) PUT_ERROR (Quser_error, error_tail, ""); PUT_ERROR (Qwrong_length_argument, error_tail, "Wrong length argument"); PUT_ERROR (Qwrong_type_argument, error_tail, "Wrong type argument"); + PUT_ERROR (Qtype_mismatch, error_tail, "Types do not match"); PUT_ERROR (Qargs_out_of_range, error_tail, "Args out of range"); PUT_ERROR (Qvoid_function, error_tail, "Symbol's function definition is void"); diff --git a/src/fns.c b/src/fns.c index 0a64e515402..7faf25b9088 100644 --- a/src/fns.c +++ b/src/fns.c @@ -27,6 +27,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include "lisp.h" #include "bignum.h" @@ -466,21 +467,10 @@ load_unaligned_size_t (const void *p) return x; } -DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0, - doc: /* Return non-nil if STRING1 is less than STRING2 in lexicographic order. -Case is significant. -Symbols are also allowed; their print names are used instead. */) - (Lisp_Object string1, Lisp_Object string2) +/* Return -1/0/1 to indicate the relation between string1 and string2. */ +static int +string_cmp (Lisp_Object string1, Lisp_Object string2) { - if (SYMBOLP (string1)) - string1 = SYMBOL_NAME (string1); - else - CHECK_STRING (string1); - if (SYMBOLP (string2)) - string2 = SYMBOL_NAME (string2); - else - CHECK_STRING (string2); - ptrdiff_t n = min (SCHARS (string1), SCHARS (string2)); if ((!STRING_MULTIBYTE (string1) || SCHARS (string1) == SBYTES (string1)) @@ -489,7 +479,9 @@ Symbols are also allowed; their print names are used instead. */) /* Each argument is either unibyte or all-ASCII multibyte: we can compare bytewise. */ int d = memcmp (SSDATA (string1), SSDATA (string2), n); - return d < 0 || (d == 0 && n < SCHARS (string2)) ? Qt : Qnil; + if (d) + return d; + return n < SCHARS (string2) ? -1 : n > SCHARS (string2); } else if (STRING_MULTIBYTE (string1) && STRING_MULTIBYTE (string2)) { @@ -523,7 +515,7 @@ Symbols are also allowed; their print names are used instead. */) if (b >= nb) /* One string is a prefix of the other. */ - return b < nb2 ? Qt : Qnil; + return b < nb2 ? -1 : b > nb2; /* Now back up to the start of the differing characters: it's the last byte not having the bit pattern 10xxxxxx. */ @@ -535,7 +527,7 @@ Symbols are also allowed; their print names are used instead. */) ptrdiff_t i1_byte = b, i2_byte = b; int c1 = fetch_string_char_advance_no_check (string1, &i1, &i1_byte); int c2 = fetch_string_char_advance_no_check (string2, &i2, &i2_byte); - return c1 < c2 ? Qt : Qnil; + return c1 < c2 ? -1 : c1 > c2; } else if (STRING_MULTIBYTE (string1)) { @@ -546,9 +538,9 @@ Symbols are also allowed; their print names are used instead. */) int c1 = fetch_string_char_advance_no_check (string1, &i1, &i1_byte); int c2 = SREF (string2, i2++); if (c1 != c2) - return c1 < c2 ? Qt : Qnil; + return c1 < c2 ? -1 : 1; } - return i1 < SCHARS (string2) ? Qt : Qnil; + return i1 < SCHARS (string2) ? -1 : i1 > SCHARS (string2); } else { @@ -559,12 +551,30 @@ Symbols are also allowed; their print names are used instead. */) int c1 = SREF (string1, i1++); int c2 = fetch_string_char_advance_no_check (string2, &i2, &i2_byte); if (c1 != c2) - return c1 < c2 ? Qt : Qnil; + return c1 < c2 ? -1 : 1; } - return i1 < SCHARS (string2) ? Qt : Qnil; + return i1 < SCHARS (string2) ? -1 : i1 > SCHARS (string2); } } +DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0, + doc: /* Return non-nil if STRING1 is less than STRING2 in lexicographic order. +Case is significant. +Symbols are also allowed; their print names are used instead. */) + (Lisp_Object string1, Lisp_Object string2) +{ + if (SYMBOLP (string1)) + string1 = SYMBOL_NAME (string1); + else + CHECK_STRING (string1); + if (SYMBOLP (string2)) + string2 = SYMBOL_NAME (string2); + else + CHECK_STRING (string2); + + return string_cmp (string1, string2) < 0 ? Qt : Qnil; +} + DEFUN ("string-version-lessp", Fstring_version_lessp, Sstring_version_lessp, 2, 2, 0, doc: /* Return non-nil if S1 is less than S2, as version strings. @@ -2908,6 +2918,233 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, return false; } + +/* Return -1/0/1 for the lexicographic relation between bool-vectors. */ +static int +bool_vector_cmp (Lisp_Object a, Lisp_Object b) +{ + ptrdiff_t na = bool_vector_size (a); + ptrdiff_t nb = bool_vector_size (b); + /* Skip equal words. */ + ptrdiff_t words_min = min (na, nb) / BITS_PER_BITS_WORD; + bits_word *ad = bool_vector_data (a); + bits_word *bd = bool_vector_data (b); + ptrdiff_t i = 0; + while (i < words_min && ad[i] == bd[i]) + i++; + na -= i * BITS_PER_BITS_WORD; + nb -= i * BITS_PER_BITS_WORD; + eassume (na >= 0 && nb >= 0); + if (nb == 0) + return na != 0; + if (na == 0) + return -1; + + bits_word aw = bits_word_to_host_endian (ad[i]); + bits_word bw = bits_word_to_host_endian (bd[i]); + bits_word xw = aw ^ bw; + if (xw == 0) + return na < nb ? -1 : na > nb; + + bits_word d = xw & -xw; /* Isolate first difference. */ + eassume (d != 0); + return (d & aw) ? 1 : -1; +} + +/* Return -1, 0 or 1 to indicate whether ab in the sense of value<. + In particular 0 does not mean equality in the sense of Fequal, only + that the arguments cannot be ordered yet they can be compared (same + type). */ +static int +value_cmp (Lisp_Object a, Lisp_Object b, int maxdepth) +{ + if (maxdepth < 0) + error ("Maximum depth exceeded in comparison"); + + tail_recurse: + /* Shortcut for a common case. */ + if (BASE_EQ (a, b)) + return 0; + + switch (XTYPE (a)) + { + case_Lisp_Int: + { + EMACS_INT ia = XFIXNUM (a); + if (FIXNUMP (b)) + return ia < XFIXNUM (b) ? -1 : 1; /* we know that a≠b */ + if (FLOATP (b)) + return ia < XFLOAT_DATA (b) ? -1 : ia > XFLOAT_DATA (b); + if (BIGNUMP (b)) + return -mpz_sgn (*xbignum_val (b)); + } + goto type_mismatch; + + case Lisp_Symbol: + if (BARE_SYMBOL_P (b)) + return string_cmp (XBARE_SYMBOL (a)->u.s.name, + XBARE_SYMBOL (b)->u.s.name); + if (CONSP (b) && NILP (a)) + return -1; + if (SYMBOLP (b)) + /* Slow-path branch when B is a symbol-with-pos. */ + return string_cmp (XBARE_SYMBOL (a)->u.s.name, XSYMBOL (b)->u.s.name); + goto type_mismatch; + + case Lisp_String: + if (STRINGP (b)) + return string_cmp (a, b); + goto type_mismatch; + + case Lisp_Cons: + /* FIXME: Optimise for difference in the first element? */ + FOR_EACH_TAIL (b) + { + int cmp = value_cmp (XCAR (a), XCAR (b), maxdepth - 1); + if (cmp != 0) + return cmp; + a = XCDR (a); + if (!CONSP (a)) + { + b = XCDR (b); + goto tail_recurse; + } + } + if (NILP (b)) + return 1; + else + goto type_mismatch; + goto tail_recurse; + + case Lisp_Vectorlike: + if (VECTORLIKEP (b)) + { + enum pvec_type ta = PSEUDOVECTOR_TYPE (XVECTOR (a)); + enum pvec_type tb = PSEUDOVECTOR_TYPE (XVECTOR (b)); + if (ta == tb) + switch (ta) + { + case PVEC_NORMAL_VECTOR: + case PVEC_RECORD: + { + ptrdiff_t len_a = ASIZE (a); + ptrdiff_t len_b = ASIZE (b); + if (ta == PVEC_RECORD) + { + len_a &= PSEUDOVECTOR_SIZE_MASK; + len_b &= PSEUDOVECTOR_SIZE_MASK; + } + ptrdiff_t len_min = min (len_a, len_b); + for (ptrdiff_t i = 0; i < len_min; i++) + { + int cmp = value_cmp (AREF (a, i), AREF (b, i), + maxdepth - 1); + if (cmp != 0) + return cmp; + } + return len_a < len_b ? -1 : len_a > len_b; + } + + case PVEC_BOOL_VECTOR: + return bool_vector_cmp (a, b); + + case PVEC_MARKER: + { + Lisp_Object buf_a = Fmarker_buffer (a); + Lisp_Object buf_b = Fmarker_buffer (b); + if (NILP (buf_a)) + return NILP (buf_b) ? 0 : -1; + if (NILP (buf_b)) + return 1; + int cmp = value_cmp (buf_a, buf_b, maxdepth - 1); + if (cmp != 0) + return cmp; + ptrdiff_t pa = XMARKER (a)->charpos; + ptrdiff_t pb = XMARKER (b)->charpos; + return pa < pb ? -1 : pa > pb; + } + + case PVEC_PROCESS: + a = Fprocess_name (a); + b = Fprocess_name (b); + goto tail_recurse; + + case PVEC_BUFFER: + { + /* Killed buffers lack names and sort before those alive. */ + Lisp_Object na = Fbuffer_name (a); + Lisp_Object nb = Fbuffer_name (b); + if (NILP (na)) + return NILP (nb) ? 0 : -1; + if (NILP (nb)) + return 1; + a = na; + b = nb; + goto tail_recurse; + } + + case PVEC_BIGNUM: + return mpz_cmp (*xbignum_val (a), *xbignum_val (b)); + + case PVEC_SYMBOL_WITH_POS: + /* Compare by name, enabled or not. */ + a = XSYMBOL_WITH_POS_SYM (a); + b = XSYMBOL_WITH_POS_SYM (b); + goto tail_recurse; + + default: + /* Treat other types as unordered. */ + return 0; + } + } + else if (BIGNUMP (a)) + return -value_cmp (b, a, maxdepth); + else if (SYMBOL_WITH_POS_P (a) && symbols_with_pos_enabled) + { + a = XSYMBOL_WITH_POS_SYM (a); + goto tail_recurse; + } + + goto type_mismatch; + + case Lisp_Float: + { + double fa = XFLOAT_DATA (a); + if (FLOATP (b)) + return fa < XFLOAT_DATA (b) ? -1 : fa > XFLOAT_DATA (b); + if (FIXNUMP (b)) + return fa < XFIXNUM (b) ? -1 : fa > XFIXNUM (b); + if (BIGNUMP (b)) + { + if (isnan (fa)) + return 0; + return -mpz_cmp_d (*xbignum_val (b), fa); + } + } + goto type_mismatch; + + default: + eassume (0); + } + type_mismatch: + xsignal2 (Qtype_mismatch, a, b); +} + +DEFUN ("value<", Fvaluelt, Svaluelt, 2, 2, 0, + doc: /* Return non-nil if A precedes B in standard value order. +A and B must have the same basic type. +Numbers are compared with `<'. +Strings and symbols are compared with `string-lessp'. +Lists, vectors, bool-vectors and records are compared lexicographically. +Markers are compared lexicographically by buffer and position. +Buffers and processes are compared by name. +Other types are considered unordered and the return value will be `nil'. */) + (Lisp_Object a, Lisp_Object b) +{ + int maxdepth = 20; /* FIXME: arbitrary value */ + return value_cmp (a, b, maxdepth) < 0 ? Qt : Qnil; +} + DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0, @@ -6589,6 +6826,7 @@ For best results this should end in a space. */); defsubr (&Seql); defsubr (&Sequal); defsubr (&Sequal_including_properties); + defsubr (&Svaluelt); defsubr (&Sfillarray); defsubr (&Sclear_string); defsubr (&Snconc); diff --git a/src/lisp.h b/src/lisp.h index f86758c88fb..5583a7e2e8e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1882,6 +1882,30 @@ bool_vector_bytes (EMACS_INT size) return (size + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR; } +INLINE bits_word +bits_word_to_host_endian (bits_word val) +{ +#ifndef WORDS_BIGENDIAN + return val; +#else + if (BITS_WORD_MAX >> 31 == 1) + return bswap_32 (val); + if (BITS_WORD_MAX >> 31 >> 31 >> 1 == 1) + return bswap_64 (val); + { + int i; + bits_word r = 0; + for (i = 0; i < sizeof val; i++) + { + r = ((r << 1 << (CHAR_BIT - 1)) + | (val & ((1u << 1 << (CHAR_BIT - 1)) - 1))); + val = val >> 1 >> (CHAR_BIT - 1); + } + return r; + } +#endif +} + INLINE bool BOOL_VECTOR_P (Lisp_Object a) { diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 7437c07f156..844000cdc76 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -1513,4 +1513,222 @@ (should-error (copy-alist "abc") :type 'wrong-type-argument)) +(ert-deftest fns-value<-ordered () + ;; values (X . Y) where X nil: `b' is now always a proper prefix of `a'. + (should-not (value< a b)) + (should (value< b a))) + (t + ;; nil -> t: `a' is now less than `b'. + (should (value< a b)) + (should-not (value< b a)))) + ;; Undo the flip. + (aset b i val))))))))))) + ;;; fns-tests.el ends here -- cgit v1.2.3 From cbd862865ff0a08d1214ac33590e7af80d10a0ac Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 22 Mar 2024 15:06:27 +0100 Subject: Remove `sort-on` (bug#69709) * lisp/sort.el (sort-on): * doc/lispref/sequences.texi (Sequence Functions): * etc/NEWS: Remove the `sort-on` function which is now completely superseded by the extended `sort` in features, ease of use, and performance. --- doc/lispref/sequences.texi | 40 ++++------------------------------------ etc/NEWS | 5 ----- lisp/sort.el | 21 --------------------- 3 files changed, 4 insertions(+), 62 deletions(-) (limited to 'lisp') diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 6322f17e77b..de83b96d748 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -440,6 +440,10 @@ where @var{predicate} is the @code{:lessp} argument. When using this form, sorting is always done in-place. @end defun +@xref{Sorting}, for more functions that perform sorting. See +@code{documentation} in @ref{Accessing Documentation}, for a useful +example of @code{sort}. + @cindex comparing values @cindex standard sorting order @anchor{definition of value<} @@ -476,42 +480,6 @@ Examples: @end example @end defun -Sometimes, computation of sort keys of list or vector elements is -expensive, and therefore it is important to perform it the minimum -number of times. By contrast, computing the sort keys of elements -inside the @var{predicate} function passed to @code{sort} will generally -perform this computation each time @var{predicate} is called with some -element. If you can separate the computation of the sort key of an -element into a function of its own, you can use the following sorting -function, which guarantees that the key will be computed for each list -or vector element exactly once. - -@cindex decorate-sort-undecorate -@cindex Schwartzian transform -@defun sort-on sequence predicate accessor -This function stably sorts @var{sequence}, which can be a list, a -vector, a bool-vector, or a string. It sorts by comparing the sort -keys of the elements using @var{predicate}. The comparison function -@var{predicate} accepts two arguments, the sort keys to compare, and -should return non-@code{nil} if the element corresponding to the first -key should sort before the element corresponding to the second key. The -function computes a sort key of each element by calling the -@var{accessor} function on that element; it does so exactly once for -each element of @var{sequence}. The @var{accessor} function is called -with a single argument, an element of @var{sequence}. - -This function implements what is known as @dfn{decorate-sort-undecorate} -paradigm, or the Schwartzian transform. It basically trades CPU for -memory, creating a temporary list with the computed sort keys, then -mapping @code{car} over the result of sorting that temporary list. -Unlike with @code{sort}, the return value is always a new list; the -original @var{sequence} is left intact. -@end defun - -@xref{Sorting}, for more functions that perform sorting. See -@code{documentation} in @ref{Accessing Documentation}, for a useful -example of @code{sort}. - @cindex sequence functions in seq @cindex seq library @cindex sequences, generalized diff --git a/etc/NEWS b/etc/NEWS index 4018df1fecb..6cefe11a2cc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1795,11 +1795,6 @@ sorts by the return value of 'age', then by 'size', then by 'cost'. The old signature, '(sort SEQ PREDICATE)', can still be used and sorts its input in-place as before. -** New function 'sort-on'. -This function implements the Schwartzian transform, and is appropriate -for sorting lists when the computation of the sort key of a list -element can be expensive. - ** New API for 'derived-mode-p' and control of the graph of major modes. *** 'derived-mode-p' now takes the list of modes as a single argument. diff --git a/lisp/sort.el b/lisp/sort.el index 4f0d759ef8a..2ee76b6e1e3 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -478,27 +478,6 @@ sRegexp specifying key within record: \nr") ;; if there was no such register (error (throw 'key nil)))))))))) -;;;###autoload -(defun sort-on (sequence predicate accessor) - "Sort SEQUENCE by calling PREDICATE on sort keys produced by ACCESSOR. -SEQUENCE should be the input sequence to sort. -Elements of SEQUENCE are sorted by keys which are obtained by -calling ACCESSOR on each element. ACCESSOR should be a function of -one argument, an element of SEQUENCE, and should return the key -value to be compared by PREDICATE for sorting the element. -PREDICATE is the function for comparing keys; it is called with two -arguments, the keys to compare, and should return non-nil if the -first key should sort before the second key. -The return value is always a new list. -This function has the performance advantage of evaluating -ACCESSOR only once for each element in the input SEQUENCE, and is -therefore appropriate when computing the key by ACCESSOR is an -expensive operation. This is known as the \"decorate-sort-undecorate\" -paradigm, or the Schwartzian transform." - (mapcar #'car - (sort (mapcar #'(lambda (x) (cons x (funcall accessor x))) sequence) - #'(lambda (x y) (funcall predicate (cdr x) (cdr y)))))) - (defvar sort-columns-subprocess t) -- cgit v1.2.3 From b20866c4b3aa1446efda252bd5c3fa54f68c5d7f Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 24 Mar 2024 18:18:41 +0100 Subject: Better `sort` ignored-return-value warning * lisp/emacs-lisp/bytecomp.el (byte-compile-form) (bytecomp--actually-important-return-value-p): Special handling of `sort` that takes into account that it may return an important value depending on the :in-place keyword argument. --- lisp/emacs-lisp/bytecomp.el | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 7af568cfe34..2b5eb34e571 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3445,6 +3445,7 @@ lambda-expression." ((and (or sef (function-get (car form) 'important-return-value)) ;; Don't warn for arguments to `ignore'. (not (eq byte-compile--for-effect 'for-effect-no-warn)) + (bytecomp--actually-important-return-value-p form) (byte-compile-warning-enabled-p 'ignored-return-value (car form))) (byte-compile-warn-x @@ -3471,6 +3472,15 @@ lambda-expression." (if byte-compile--for-effect (byte-compile-discard))))) +(defun bytecomp--actually-important-return-value-p (form) + "Whether FORM is really a call with a return value that should not go unused. +This assumes the function has the `important-return-value' property." + (cond ((eq (car form) 'sort) + ;; For `sort', we only care about non-destructive uses. + (and (zerop (% (length form) 2)) ; new-style call + (not (plist-get (cddr form) :in-place)))) + (t t))) + (let ((important-return-value-fns '( ;; These functions are side-effect-free except for the @@ -3478,9 +3488,11 @@ lambda-expression." mapcar mapcan mapconcat assoc plist-get plist-member - ;; It's safe to ignore the value of `sort' and `nreverse' + ;; It's safe to ignore the value of `nreverse' ;; when used on arrays, but most calls pass lists. - nreverse sort + nreverse + + sort ; special handling (non-destructive calls only) match-data -- cgit v1.2.3 From 6f7cb96543285dc8e37135abaec87d0b9a40e2e2 Mon Sep 17 00:00:00 2001 From: Sam Steingold Date: Fri, 29 Mar 2024 10:36:43 -0400 Subject: Support `shell-resync-dirs' on msys bash (Bug#70012) * lisp/shell.el (w32-application-type): Declare. (shell-mode): Set `shell-dirstack-query' to `pwd -W` when using msys bash. --- lisp/shell.el | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'lisp') diff --git a/lisp/shell.el b/lisp/shell.el index c5cfbd985ed..8a5218ae847 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -606,6 +606,9 @@ Shell buffers. It implements `shell-completion-execonly' for (defvar sh-shell-file) +(declare-function w32-application-type nil ; "src/w32proc.c" + (program) t) + (define-derived-mode shell-mode comint-mode "Shell" "Major mode for interacting with an inferior shell. \\ @@ -754,6 +757,11 @@ command." ((string-equal shell "ksh") "echo $PWD ~-") ;; Bypass any aliases. TODO all shells could use this. ((string-equal shell "bash") "command dirs") + ((and (string-equal shell "bash.exe") + (eq system-type 'windows-nt) + (eq (w32-application-type (executable-find "bash.exe")) + 'msys)) + "command pwd -W") ((string-equal shell "zsh") "dirs -l") (t "dirs"))) ;; Bypass a bug in certain versions of bash. -- cgit v1.2.3 From 42322257ba9abdb8bcc2aceb34a27f261df070aa Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 29 Mar 2024 18:26:38 +0300 Subject: ; * lisp/shell.el (w32-application-type): Fix 'declare-function'. --- lisp/shell.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/shell.el b/lisp/shell.el index 8a5218ae847..cd49d289403 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -606,7 +606,7 @@ Shell buffers. It implements `shell-completion-execonly' for (defvar sh-shell-file) -(declare-function w32-application-type nil ; "src/w32proc.c" +(declare-function w32-application-type "w32proc.c" (program) t) (define-derived-mode shell-mode comint-mode "Shell" -- cgit v1.2.3 From dd3e13469d75851f3d7907e3373d45032382a5f5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 29 Mar 2024 15:32:48 -0400 Subject: * lisp/cedet/semantic/tag.el (semantic-tag): New type --- lisp/cedet/semantic/tag.el | 3 +++ 1 file changed, 3 insertions(+) (limited to 'lisp') diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el index 18a0b4caee2..a0843dd5df9 100644 --- a/lisp/cedet/semantic/tag.el +++ b/lisp/cedet/semantic/tag.el @@ -349,6 +349,9 @@ If TAG is unlinked, but has a :filename property, then that is used." ;; If an error occurs, then it most certainly is not a tag. (error nil))) +;; Used in `semantic-utest-ia.el'. +(cl-deftype semantic-tag () `(satisfies semantic-tag-p)) + (defsubst semantic-tag-of-class-p (tag class) "Return non-nil if class of TAG is CLASS." (eq (semantic-tag-class tag) class)) -- cgit v1.2.3 From 717e7edc2ac1e4e04019319da19c5386077dfbea Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 29 Mar 2024 15:36:45 -0400 Subject: * lisp/emacs-lisp/comp.el (comp--add-cond-cstrs): Consolidate 2 cases --- lisp/emacs-lisp/comp.el | 36 +++++++++++------------------------- 1 file changed, 11 insertions(+), 25 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 2544be85bb2..2ec55ed98ee 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -2036,37 +2036,23 @@ TARGET-BB-SYM is the symbol name of the target block." (,(pred comp--call-op-p) ,(and (pred comp--known-predicate-p) fun) ,op)) - ;; (comment ,_comment-str) - (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks)) - (cl-loop - with target-mvar = (comp--cond-cstrs-target-mvar op (car insns-seq) b) - for branch-target-cell on blocks - for branch-target = (car branch-target-cell) - for negated in '(t nil) - when (comp--mvar-used-p target-mvar) - do - (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) - (setf (car branch-target-cell) (comp-block-name block-target)) - (comp--emit-assume 'and target-mvar (if negated - (comp--pred-to-neg-cstr fun) - (comp--pred-to-pos-cstr fun)) - block-target nil)) - finally (cl-return-from in-the-basic-block))) - ;; Match predicate on the negated branch (unless). - (`((set ,(and (pred comp-mvar-p) cmp-res) - (,(pred comp--call-op-p) - ,(and (pred comp--known-predicate-p) fun) - ,op)) - (set ,neg-cmp-res (call eq ,cmp-res ,(pred comp-cstr-null-p))) - (cond-jump ,neg-cmp-res ,(pred comp-mvar-p) . ,blocks)) + . ,(or + ;; (comment ,_comment-str) + (and `((cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks)) + (let negated-branch nil)) + (and `((set ,neg-cmp-res + (call eq ,cmp-res ,(pred comp-cstr-null-p))) + (cond-jump ,neg-cmp-res ,(pred comp-mvar-p) . ,blocks)) + (let negated-branch t)))) (cl-loop with target-mvar = (comp--cond-cstrs-target-mvar op (car insns-seq) b) for branch-target-cell on blocks for branch-target = (car branch-target-cell) - for negated in '(nil t) + for negated in (if negated-branch '(nil t) '(t nil)) when (comp--mvar-used-p target-mvar) do - (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) + (let ((block-target (comp--add-cond-cstrs-target-block + b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) (comp--emit-assume 'and target-mvar (if negated (comp--pred-to-neg-cstr fun) -- cgit v1.2.3 From 946d4aad1dfb244352dfd0845a8bc3078fe9bca4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 30 Mar 2024 10:00:02 +0300 Subject: Avoid errors in Info-search-case-sensitively in DIR buffers * lisp/info.el (Info-search): Don't run the "try other subfiles" code if there are no subfiles. This happens, for example, in DIR files. (Bug#70058) --- lisp/info.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/info.el b/lisp/info.el index 1c6df9a6ee5..5817737ca92 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -2056,7 +2056,7 @@ If DIRECTION is `backward', search in the reverse direction." (re-search-forward regexp nil t)) (signal 'user-search-failed (list regexp)))))) - (if (and bound (not found)) + (if (and (or bound (not Info-current-subfile)) (not found)) (signal 'user-search-failed (list regexp))) (unless (or found bound) -- cgit v1.2.3 From 21af3a9d9706baa417298e70260efa3fce72c6f1 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 30 Mar 2024 15:05:30 +0800 Subject: Disable VC in special directories on Android * lisp/vc/vc-hooks.el (vc-registered, vc-backend): Return nil without invoking any backend if FILE or FILE-OR-LIST sits within /content or /assets. --- lisp/vc/vc-hooks.el | 80 +++++++++++++++++++++++++++++++---------------------- 1 file changed, 47 insertions(+), 33 deletions(-) (limited to 'lisp') diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 75f68dd80d1..8f212e96933 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -326,30 +326,37 @@ This function performs the check each time it is called. To rely on the result of a previous call, use `vc-backend' instead. If the file was previously registered under a certain backend, then that backend is tried first." - (let (handler) - (cond - ((and (file-name-directory file) - (string-match vc-ignore-dir-regexp (file-name-directory file))) - nil) - ((setq handler (find-file-name-handler file 'vc-registered)) - ;; handler should set vc-backend and return t if registered - (funcall handler 'vc-registered file)) - (t - ;; There is no file name handler. - ;; Try vc-BACKEND-registered for each handled BACKEND. - (catch 'found - (let ((backend (vc-file-getprop file 'vc-backend))) - (mapc - (lambda (b) - (and (vc-call-backend b 'registered file) - (vc-file-setprop file 'vc-backend b) - (throw 'found t))) - (if (or (not backend) (eq backend 'none)) - vc-handled-backends - (cons backend vc-handled-backends)))) - ;; File is not registered. - (vc-file-setprop file 'vc-backend 'none) - nil))))) + ;; Subprocesses (and with them, VC backends) can't run from /contents + ;; or /actions, which are fictions maintained by Emacs that do not + ;; exist in the filesystem. + (if (and (eq system-type 'android) + (string-match-p "/\\(content\\|assets\\)[/$]" + (expand-file-name file))) + nil + (let (handler) + (cond + ((and (file-name-directory file) + (string-match vc-ignore-dir-regexp (file-name-directory file))) + nil) + ((setq handler (find-file-name-handler file 'vc-registered)) + ;; handler should set vc-backend and return t if registered + (funcall handler 'vc-registered file)) + (t + ;; There is no file name handler. + ;; Try vc-BACKEND-registered for each handled BACKEND. + (catch 'found + (let ((backend (vc-file-getprop file 'vc-backend))) + (mapc + (lambda (b) + (and (vc-call-backend b 'registered file) + (vc-file-setprop file 'vc-backend b) + (throw 'found t))) + (if (or (not backend) (eq backend 'none)) + vc-handled-backends + (cons backend vc-handled-backends)))) + ;; File is not registered. + (vc-file-setprop file 'vc-backend 'none) + nil)))))) (defun vc-backend (file-or-list) "Return the version control type of FILE-OR-LIST, nil if it's not registered. @@ -357,15 +364,22 @@ If the argument is a list, the files must all have the same back end." ;; `file' can be nil in several places (typically due to the use of ;; code like (vc-backend buffer-file-name)). (cond ((stringp file-or-list) - (let ((property (vc-file-getprop file-or-list 'vc-backend))) - ;; Note that internally, Emacs remembers unregistered - ;; files by setting the property to `none'. - (cond ((eq property 'none) nil) - (property) - ;; vc-registered sets the vc-backend property - (t (if (vc-registered file-or-list) - (vc-file-getprop file-or-list 'vc-backend) - nil))))) + ;; Subprocesses (and with them, VC backends) can't run from + ;; /contents or /actions, which are fictions maintained by + ;; Emacs that do not exist in the filesystem. + (if (and (eq system-type 'android) + (string-match-p "/\\(content\\|assets\\)[/$]" + (expand-file-name file-or-list))) + nil + (let ((property (vc-file-getprop file-or-list 'vc-backend))) + ;; Note that internally, Emacs remembers unregistered + ;; files by setting the property to `none'. + (cond ((eq property 'none) nil) + (property) + ;; vc-registered sets the vc-backend property + (t (if (vc-registered file-or-list) + (vc-file-getprop file-or-list 'vc-backend) + nil)))))) ((and file-or-list (listp file-or-list)) (vc-backend (car file-or-list))) (t -- cgit v1.2.3